diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2020-11-01 13:18:38 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2020-11-01 13:18:38 -0700 |
| commit | 12e1bc6b16755daf87c97b4c7e4daee67b0276ca (patch) | |
| tree | bca0f32a17e9bbe442ecefae32d798fbb25b670a | |
| parent | 8086a82f24a5d3cb9cad9ce98d93ffa38b1188fb (diff) | |
| parent | 7baf8cae0f54502fc2b21c01e133308b746cd7a0 (diff) | |
| download | emacs-12e1bc6b16755daf87c97b4c7e4daee67b0276ca.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
1137 files changed, 33600 insertions, 16433 deletions
diff --git a/.gitignore b/.gitignore index 8480045d915..f7a877e6476 100644 --- a/.gitignore +++ b/.gitignore @@ -157,7 +157,7 @@ test/manual/etags/regexfile test/manual/etags/ETAGS test/manual/etags/CTAGS test/manual/indent/*.new -test/data/mml-sec/random_seed +test/lisp/gnus/mml-sec-resources/random_seed # ctags, etags. TAGS @@ -169,6 +169,12 @@ GSYMS GRTAGS GTAGS +# auto-generated compilation database +compile_commands.json + +# ccls, a LSP-compliant server for C +/.ccls-cache + # GNU idutils. ID diff --git a/CONTRIBUTE b/CONTRIBUTE index 4e42c7aafcc..cb09391c324 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -257,13 +257,12 @@ them right the first time, so here are guidelines for formatting them: - There is no standard or recommended way to identify revisions in ChangeLog entries. Using Git SHA1 values limits the usability of the references to Git, and will become much less useful if Emacs - switches to a different VCS. So we recommend against that. + switches to a different VCS. So we recommend against doing only that. One way to identify revisions is by quoting their summary line. - Another is with an action stamp - an RFC3339 date followed by ! - followed by the committer's email - for example, - "2014-01-16T05:43:35Z!esr@thyrsus.com". Often, "my previous commit" - will suffice. + Prefixing the summary with the commit date can give useful context + (use 'git show -s "--pretty=format:%cd \"%s\"" --date=short HASH' to + produce that). Often, "my previous commit" will suffice. - There is no need to mention files such as NEWS and MAINTAINERS, or to indicate regeneration of files such as 'lib/gnulib.mk', in the diff --git a/ChangeLog.1 b/ChangeLog.1 index 08343f0fd41..b01a316f741 100644 --- a/ChangeLog.1 +++ b/ChangeLog.1 @@ -12,7 +12,7 @@ "/usr/include/glib-2.0/glib/gmem.h: ... warning: unknown attribute '__alloc_size__' ignored". Use -Werror when checking for -nopie; otherwise clang warns about -nopie instead of failing, and then - later it warns everytime the build uses -nopie. + later it warns every time the build uses -nopie. 2015-04-03 Ulrich Müller <ulm@gentoo.org> @@ -1657,7 +1657,7 @@ 2013-12-08 Paul Eggert <eggert@cs.ucla.edu> - * configure.ac: Simplify supression of GTK deprecation warning. + * configure.ac: Simplify suppression of GTK deprecation warning. Move -DGDK_DISABLE_DEPRECATION_WARNINGS out of the command line and into config.h, to shorten the command line when doing 'make'. Don't AC_SUBST GTK_CFLAGS, as this is not needed. @@ -3528,7 +3528,7 @@ Port to Solaris 8. Without this change, 'configure' fails because the recently-added wait3 prototype in config.h messes up later 'configure' tests. - Fix this problem by droping wait3 and WRETCODE, as they're + Fix this problem by dropping wait3 and WRETCODE, as they're no longer needed on hosts that are current porting targets. * configure.ac (wait3, WRETCODE): Remove, fixing a FIXME. All uses changed to waitpid and WEXITSTATUS. diff --git a/ChangeLog.2 b/ChangeLog.2 index 9e875c561db..5e9b8b901e0 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -485,7 +485,7 @@ Clarify major mode switching * doc/emacs/modes.texi (Major Modes): - * doc/lispref/modes.texi (Modes, Major Modes): Explictly say that each + * doc/lispref/modes.texi (Modes, Major Modes): Explicitly say that each buffer has exactly one major mode and can't be "turned off", only switched away from (Bug#25357). @@ -1661,7 +1661,7 @@ `re_match_2_internal' uses pointers to the lisp objects that it searches. Since it may call malloc when growing the "fail stack", these pointers may be invalidated while searching, resulting in memory - curruption (Bug #24358). + corruption (Bug #24358). To fix this, we check the pointer that the lisp object (as specified by re_match_object) points to before and after growing the stack, and @@ -2681,7 +2681,7 @@ * doc/misc/ses.texi (Quick Tutorial): Mention the '!' 'ses-range' modifier as an alternative to 'ses+'. - (Advanced Features): Add a refernce to node 'Nonrelocatable + (Advanced Features): Add a reference to node 'Nonrelocatable references' concerning function 'ses-rename-cell'. (Standard formula functions): Mention the '!' 'ses-range' modifier as an alternative to 'ses-delete-blanks'. @@ -3983,7 +3983,7 @@ 2016-05-10 Dmitry Gutov <dgutov@yandex.ru> - Don't treat JS spread as contination method call + Don't treat JS spread as continuation method call * lisp/progmodes/js.el (js--indent-operator-re): Allow only one dot (bug#23492). @@ -4530,7 +4530,7 @@ cursor-type doc fix * src/buffer.c (syms_of_buffer): Mention that cursor-type's - WIDHT/HEIGHT can't exceed the frame char size (bug#19215). + WIDTH/HEIGHT can't exceed the frame char size (bug#19215). (cherry picked from commit 77c5f4554ebb3b7c7d49bc881e45a550f6c93987) @@ -4599,7 +4599,7 @@ 2016-05-01 Lars Ingebrigtsen <larsi@gnus.org> - Explictly explain that package-initialize loads the packages + Explicitly explain that package-initialize loads the packages * lisp/emacs-lisp/package.el (package-initialize): Be explicit in saying that `package-initialize' obviates adjusting the @@ -5985,7 +5985,7 @@ 2016-03-30 Alan Mackenzie <acm@muc.de> - Finish fixing a cacheing bug in CC Mode (see 2016-03-09) + Finish fixing a caching bug in CC Mode (see 2016-03-09) * lisp/progmodes/cc-cmds.el: (c-beginning-of-defun, c-end-of-defun): Remove superfluous invocations of c-self-bind-state-cache. @@ -6609,7 +6609,7 @@ 2016-03-14 Alan Mackenzie <acm@muc.de> - Fix a cacheing bug, which led to inordinately slow c-beginning-of-defun. + Fix a caching bug, which led to inordinately slow c-beginning-of-defun. * lisp/progmodes/cc-defs.el (c-self-bind-state-cache): New macro. @@ -6624,7 +6624,7 @@ 2016-03-14 Alan Mackenzie <acm@muc.de> - Fix a cacheing bug, which led to inordinately slow c-beginning-of-defun. + Fix a caching bug, which led to inordinately slow c-beginning-of-defun. * lisp/progmodes/cc-defs.el (c-self-bind-state-cache): New macro. @@ -7145,7 +7145,7 @@ Prevent infinite loop on not-well-formed xml. (Bug#16344) - * lisp/xml.el (xml-parse-tag-1): Prevent inifinite loop. (Bug#16344) + * lisp/xml.el (xml-parse-tag-1): Prevent infinite loop. (Bug#16344) * test/automated/xml-parse-tests.el (xml-parse-tests--bad-data): Add test cases for Bug#16344. @@ -9269,7 +9269,7 @@ This is related to the autogen.sh changes made by Paul Eggert in commit d766ca8f (2016-02-01) and commit cedd7cad (2016-02-01), and to - my edits today to http://www.emacswiki.org/emacs/GitForEmacsDevs and + my edits today to https://www.emacswiki.org/emacs/GitForEmacsDevs and to emacswiki.org/emacs/GitQuickStartForEmacsDevs. See also the thread "Recommend these .gitconfig settings for git integrity." at https://lists.gnu.org/r/emacs-devel/2016-01/threads.html#01802. @@ -9956,7 +9956,7 @@ * lisp/files.el (dir-locals-find-file): Refactor return values Returning a cache remains unchanged, but the case of returning a - file (or pattern) is now changed to return the contaning + file (or pattern) is now changed to return the containing directory. (dir-locals-read-from-file): Rename to `dir-locals-read-from-dir' @@ -10856,7 +10856,7 @@ 2016-01-18 Alan Mackenzie <acm@muc.de> - Desktop: protect users against inadvertant upgrading of desktop file. + Desktop: protect users against inadvertent upgrading of desktop file. An upgraded (version 208) desktop file cannot be read in Emacs < 25. @@ -11212,7 +11212,7 @@ 2016-01-13 Eli Zaretskii <eliz@gnu.org> - Document the new deafault value of 'load-read-function' + Document the new default value of 'load-read-function' * doc/lispref/loading.texi (How Programs Do Loading): Document the change in the default value of 'load-read-function'. @@ -13444,7 +13444,7 @@ (gdb-send): Recognize various ways of exiting from Python and Guile interpreters and returning to GDB. For details, see https://lists.gnu.org/r/emacs-devel/2015-12/msg00693.html - and http://stackoverflow.com/questions/31514741. + and https://stackoverflow.com/questions/31514741. 2015-12-16 Paul Eggert <eggert@cs.ucla.edu> @@ -19985,7 +19985,7 @@ * src/intervals.h: Don’t include dispextern.h, composite.h. * src/keyboard.c: Don’t include sysstdio.h, disptab.h, puresize.h. Include coding.h. - * src/keyboard.h: Don’t incldue systime.h. + * src/keyboard.h: Don’t include systime.h. * src/keymap.c: Don’t include charset.h, frame.h. * src/lread.c: Include dispextern.h and systime.h. Don’t include frame.h. Include systime.h. @@ -21808,7 +21808,7 @@ 2015-09-26 Paul Eggert <eggert@cs.ucla.edu> * admin/MAINTAINERS: Add self, plus list some more files - sans maintaners. + sans maintainers. 2015-09-26 Zachary Kanfer <zkanfer@gmail.com> (tiny change) @@ -22530,7 +22530,7 @@ Omit unnecessary \ before paren in C docstrings Although \( is needed in docstrings in Elisp code, it is not needed in - docstrings in C code, since C function definitiions do not start with + docstrings in C code, since C function definitions do not start with a parenthesis. The backslashes made the docstrings a bit harder to read and to format in columns. Also, some C docstrings had ( in column 1 and this did not appear to be causing any problems. So, @@ -23731,7 +23731,7 @@ * lisp/progmodes/etags.el (etags-tags-completion-table): Allow even one non-regular character before the implicit tag name. - Reported at http://emacs.stackexchange.com/questions/15269/. + Reported at https://emacs.stackexchange.com/questions/15269/. 2015-09-06 Thomas Fitzsimmons <fitzsim@fitzsim.org> @@ -24607,7 +24607,7 @@ Tweak startup screen quoting * lisp/startup.el (normal-splash-screen): Use standard - "M-" abbrevation rather than a confusingly-different one. + "M-" abbreviation rather than a confusingly-different one. (normal-no-mouse-startup-screen): Follow ‘text-quoting-style’. 2015-08-27 Paul Eggert <eggert@cs.ucla.edu> @@ -27510,7 +27510,7 @@ Allocate and use slightly-larger cost vectors, ones based on FRAME_TOTAL_LINES instead of FRAME_LINES. - Fix uninitalized value in encode_coding_object + Fix uninitialized value in encode_coding_object * src/coding.c (encode_coding_object): Also initialize coding->src_pos and coding->src_pos_byte when NILP (src_object). This avoids later use of uninitialized storage. @@ -29884,7 +29884,7 @@ file names due to deleted PWD. * src/xsmfns.c (x_session_initialize): Avoid libSM crash - when starup directory is missing. (Bug#18851) + when startup directory is missing. (Bug#18851) (errno.h): Include it. 2015-06-13 Paul Eggert <eggert@cs.ucla.edu> @@ -30029,7 +30029,7 @@ because '(format "%S" '(` FOO))' returns "(\\` FOO)". A comment in src/lread.c's read1 function says that the backslash will be needed starting in Emacs 25, which implies that 'format' is - correct and the old pcase documention was wrong to omit the backslash. + correct and the old pcase documentation was wrong to omit the backslash. * lisp/emacs-lisp/nadvice.el (advice--make-docstring): * lisp/help-fns.el (help-fns--signature): * lisp/help.el (help-add-fundoc-usage): @@ -30117,7 +30117,7 @@ (bug#20730). * lisp/progmodes/sh-script.el: Better handle nested quotes. - (sh-here-doc-open-re): Don't mis-match the <<< operator (bug#20683). + (sh-here-doc-open-re): Don't mismatch the <<< operator (bug#20683). (sh-font-lock-quoted-subshell): Make sure double quotes within single quotes don't mistakenly end prematurely the surrounding string. @@ -31364,7 +31364,7 @@ 2015-05-25 Eli Zaretskii <eliz@gnu.org> - Fix last change in etags.c that broke tagging compresed files + Fix last change in etags.c that broke tagging compressed files * lib-src/etags.c (process_file_name) [MSDOS || DOS_NT]: Fix quoting of decompression shell command for MS-Windows/MS-DOS. @@ -32680,7 +32680,7 @@ (verilog-beg-of-statement): Fix indenting for some forms of constraintsm bug433. Reported by Brad Parker. Fix indentation of continued assignment incorrect if first line ends with ']', bug437. - Reported by Dan Dever. Fix indention of cover inside an + Reported by Dan Dever. Fix indentation of cover inside an ifdef, bug 862. Reported by Bernd Beuster. Fix labeling do-while blocks, bug842. (verilog-preprocessor-re): Fix fork/end UNMATCHED warning, bug859. @@ -35272,7 +35272,7 @@ 2015-04-11 Artur Malabarba <bruce.connor.am@gmail.com> Speed up byte-compilation and autoload generation by avoiding mode-hooks - This prevents emacs-lisp-mode-hook from being run everytime an + This prevents emacs-lisp-mode-hook from being run every time an autoload file is generated, which can account for a fraction of package installation time depending on the hooks the user has configured. diff --git a/ChangeLog.3 b/ChangeLog.3 index 1a530118995..0f363100794 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -315,7 +315,7 @@ * lisp/net/gnutls.el (gnutls-trustfiles): Update the names of the systems in the comments. Reported by Richard Stallman <rms@gnu.org> in - https://lists.gnu.org/archive/html/emacs-devel/2020-07/msg00455.html. + https://lists.gnu.org/r/emacs-devel/2020-07/msg00455.html. 2020-07-17 Eli Zaretskii <eliz@gnu.org> @@ -611,8 +611,8 @@ of 2019-10-13T15:36:02Z!contovob@tcd.ie. For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg00550.html - https://lists.gnu.org/archive/html/emacs-devel/2020-06/msg00473.html + https://lists.gnu.org/r/emacs-devel/2019-10/msg00550.html + https://lists.gnu.org/r/emacs-devel/2020-06/msg00473.html * doc/lispref/nonascii.texi (Specifying Coding Systems): Use more specific cross-reference to progn even if info.el displays it @@ -727,8 +727,8 @@ Minor improvements to EDE and EIEIO manuals For discussion, see the following threads: - https://lists.gnu.org/archive/html/emacs-devel/2020-05/msg00630.html - https://lists.gnu.org/archive/html/emacs-devel/2020-06/msg00099.html + https://lists.gnu.org/r/emacs-devel/2020-05/msg00630.html + https://lists.gnu.org/r/emacs-devel/2020-06/msg00099.html * doc/misc/ede.texi (ede-generic-project): Clean up example. * doc/misc/eieio.texi (Accessing Slots): Document slot-value as a @@ -1573,7 +1573,7 @@ * etc/NEWS: Rearrange image sections. - https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg01315.html + https://lists.gnu.org/r/emacs-devel/2020-04/msg01315.html 2020-04-22 Paul Eggert <eggert@cs.ucla.edu> @@ -1616,7 +1616,7 @@ * doc/emacs/files.texi (Image Mode): Mention image-auto-resize and image-auto-resize-on-window-resize. - https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg01160.html + https://lists.gnu.org/r/emacs-devel/2020-04/msg01160.html 2020-04-21 Juri Linkov <juri@linkov.net> @@ -1669,7 +1669,7 @@ 2020-04-20 Juri Linkov <juri@linkov.net> - * doc/emacs/windows.texi (Window Convenience): Decribe more windmove features. + * doc/emacs/windows.texi (Window Convenience): Describe more windmove features. * doc/emacs/windows.texi (Window Convenience): Add descriptions of windmove-display-default-keybindings, @@ -1904,7 +1904,7 @@ Improve an example in w32 FAQ * doc/misc/efaq-w32.texi (Font names): Modify the expression to - insert a lits of all installed fonts so as to avoid producing too + insert a list of all installed fonts so as to avoid producing too long lines. Suggested by ndame <ndame@protonmail.com>. 2020-04-15 Stefan Monnier <monnier@iro.umontreal.ca> @@ -1944,7 +1944,7 @@ These changes fix actual or latent bugs in regexps that match file names, such as PATTERN arguments to 'directory-files'. See - https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg00265.html + https://lists.gnu.org/r/emacs-devel/2020-04/msg00265.html * admin/authors.el (authors-obsolete-files-regexps) (authors-renamed-files-regexps): @@ -2036,7 +2036,7 @@ Clarify documentation on inhibit-modification-hooks intended usage Cf. bug#40332 and the discussion at - https://lists.gnu.org/archive/html/emacs-devel/2020-03/msg00921.html + https://lists.gnu.org/r/emacs-devel/2020-03/msg00921.html * doc/lispref/text.texi (Change Hooks): * src/insdel.c (syms_of_insdel): Clarify the intended usage of @@ -2173,9 +2173,9 @@ LENGTH (i). This happens when delete_interval is called from set_intervals_multibyte_1, because the caller zeroes out the total_length field of the interval to be deleted. See - https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg00131.html + https://lists.gnu.org/r/emacs-devel/2020-04/msg00131.html for more details. See also a related old discussion at - https://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00399.html. + https://lists.gnu.org/r/emacs-devel/2012-07/msg00399.html. 2020-04-08 Eli Zaretskii <eliz@gnu.org> @@ -2212,7 +2212,7 @@ like GNOME shell that use invisible outer frame borders. For further information see the thread starting with - https://lists.gnu.org/archive/html/emacs-devel/2020-01/msg00343.html + https://lists.gnu.org/r/emacs-devel/2020-01/msg00343.html * src/frame.c (syms_of_frame): New symbol Qxg_frame_set_char_size_4. * src/gtkutil.c (xg_frame_set_char_size): Hide child frame @@ -2253,7 +2253,7 @@ * lisp/emacs-lisp/re-builder.el (reb-while): Take the current value of the counter instead of its name. (reb-mark-non-matching-parenthesis): Bind n-reb to 0 at the start and - don't wrongly treat it as dynamicly bound. + don't wrongly treat it as dynamically bound. 2020-04-03 Philipp Stephani <phst@google.com> @@ -2771,7 +2771,7 @@ and will be *the* mailing list for discussions and announcements about ERC going forward. The other two lists, erc-announce and erc-commit, are now retired. For more details, see the announcement at - <https://lists.gnu.org/archive/html/emacs-erc/2020-03/msg00001.html>. + <https://lists.gnu.org/r/emacs-erc/2020-03/msg00001.html>. 2020-03-06 Roland Winkler <winkler@gnu.org> @@ -3447,7 +3447,7 @@ 2020-02-10 Alan Mackenzie <acm@muc.de> - c-end-of-macro: Handle block coment lines with unescaped NLs correctly + c-end-of-macro: Handle block comment lines with unescaped NLs correctly * lisp/progmodes/cc-langs.el (c-last-open-c-comment-start-on-line-re): Make obsolete, and supersede by ... @@ -4133,7 +4133,7 @@ 2020-01-17 Dmitry Gutov <dgutov@yandex.ru> - Honor tags-case-fold-search during xref identifer completion + Honor tags-case-fold-search during xref identifier completion * etc/NEWS: New entry. @@ -5120,7 +5120,7 @@ * lisp/progmodes/xref.el (xref--find-buffer-visiting): Speed up by using get-file-buffer. (xref--collect-matches): Remove the condition on remote-id. - (https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00753.html) + (https://lists.gnu.org/r/emacs-devel/2019-12/msg00753.html) 2019-12-27 Dmitry Gutov <dgutov@yandex.ru> @@ -5245,10 +5245,10 @@ Improve vc--add-line, vc--remove-regexp * lisp/vc/vc.el (vc--add-line): Create file if it does not exist. - Use existing buffer to avoid discrepancies with filesytem. Make sure + Use existing buffer to avoid discrepancies with filesystem. Make sure that the file ends with a newline. (vc--remove-line): Do not create file if it does not exist. Use - existing buffer to avoid discrepancies with filesytem. (bug#37185) + existing buffer to avoid discrepancies with filesystem. (bug#37185) 2019-12-24 Dmitry Gutov <dgutov@yandex.ru> @@ -5437,7 +5437,7 @@ Fix bug in flex completion style's sorting and simplify - This previous commit targetting this function introduced a bug whereby + This previous commit targeting this function introduced a bug whereby the completion table's sorting function wouldn't be called. That is fixed by this commit, which also simplifies the function further: it now skips re-sorting the completions completely if there is no @@ -5634,7 +5634,7 @@ Speed up vc-dir-update * lisp/vc/vc-dir.el (vc-dir-update): Speed up. - (https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00568.html) + (https://lists.gnu.org/r/emacs-devel/2019-12/msg00568.html) 2019-12-20 Alan Mackenzie <acm@muc.de> @@ -6779,7 +6779,7 @@ frame-monitor-workarea (and display-monitor-attributes-list). For details on why some GTK menus were empty please see thread - https://lists.gnu.org/archive/html/emacs-devel/2019-11/msg01061.html + https://lists.gnu.org/r/emacs-devel/2019-11/msg01061.html * src/gtkutil.c (menubar_map_cb, xg_update_frame_menubar): Scale up req.height so that the menu bar's height is in device pixels as @@ -6900,7 +6900,7 @@ so in case of the active minibuffer, calling minibuffer-message will allow sit-for to wait the complete timeout, because discard-input will discard all initial events that prevent sit-for from waiting during startup. - https://lists.gnu.org/archive/html/emacs-devel/2019-11/msg00581.html + https://lists.gnu.org/r/emacs-devel/2019-11/msg00581.html 2019-11-30 Alan Mackenzie <acm@muc.de> @@ -6939,7 +6939,7 @@ Use run-with-idle-timer instead of debounce for responsive image scaling. * lisp/emacs-lisp/timer.el (debounce, debounce-reduce): Revert macro addition. - https://lists.gnu.org/archive/html/emacs-devel/2019-11/msg01133.html + https://lists.gnu.org/r/emacs-devel/2019-11/msg01133.html * lisp/image.el (image-increase-size, image-decrease-size): Use run-with-idle-timer. @@ -8251,7 +8251,7 @@ (do-after-load-evaluation): Replace run-with-timer with run-with-idle-timer to give a chance for the minibuffer to handle initial events before sit-for. - https://lists.gnu.org/archive/html/emacs-devel/2019-11/msg00581.html + https://lists.gnu.org/r/emacs-devel/2019-11/msg00581.html 2019-11-17 Juri Linkov <juri@linkov.net> @@ -8342,7 +8342,7 @@ * lisp/simple.el (eval-expression-print-maximum-character): Use choice type. - https://lists.gnu.org/archive/html/emacs-devel/2019-11/msg00433.html + https://lists.gnu.org/r/emacs-devel/2019-11/msg00433.html 2019-11-16 Juri Linkov <juri@linkov.net> @@ -8423,7 +8423,7 @@ When using this option and editing input, some transient situations may arise that lead to file-name shadowing, but that shouldn't - necessarily lead to auto-delete behaviour, which will be suprising. + necessarily lead to auto-delete behaviour, which will be surprising. In '/foo/x/bar', if the user deletes the 'x', shadowing occurs, but probably shouldn't. So, somewhat like ido-mode, only auto-tidy @@ -8589,7 +8589,7 @@ changing point-min. It wasn't necessary for vertical-motion to work, and it had some adverse effects on how font-lock rules were applied - (https://lists.gnu.org/archive/html/emacs-devel/2019-11/msg00522.html). + (https://lists.gnu.org/r/emacs-devel/2019-11/msg00522.html). This can also be an alternative fix for bug#38049. 2019-11-14 Alan Mackenzie <acm@muc.de> @@ -9194,7 +9194,7 @@ Use read-char-from-minibuffer instead of read-char-choice. Remove special handling of original window scrolling that is now supported in the minibuffer. This fixes - https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg01020.html + https://lists.gnu.org/r/emacs-devel/2019-10/msg01020.html (files--ask-user-about-large-file): Use read-char-from-minibuffer instead of read-char-choice. @@ -9585,7 +9585,7 @@ Call vc-file-clearprops on new file too for the case when old and new files were renamed to each other back and forth. - https://lists.gnu.org/archive/html/emacs-devel/2019-11/msg00069.html + https://lists.gnu.org/r/emacs-devel/2019-11/msg00069.html 2019-11-06 Juri Linkov <juri@linkov.net> @@ -9718,7 +9718,7 @@ 'package-menu-refresh', make internal and non-interactive. (package-menu-mode-map, package-menu-mode-menu, package-menu-mode) (list-packages): Use the above. (Bug#35504) - (package-menu-refresh): Redefine as obsolete fuction alias for + (package-menu-refresh): Redefine as obsolete function alias for 'revert-buffer'. * doc/emacs/package.texi (Package Menu): Document it. * etc/NEWS: Announce it. @@ -11092,7 +11092,7 @@ (tab-line-mode--turn-on): New function. (tab-line-exclude-modes): New defcustom. (tab-line-exclude): New buffer-local variable. - https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg00988.html + https://lists.gnu.org/r/emacs-devel/2019-10/msg00988.html * lisp/dired.el (dired-mark-pop-up): Set tab-line-exclude to nil. Don't set tab-line-format. (Bug#37699) @@ -11191,7 +11191,7 @@ * lisp/minibuffer.el (completions-common-part): Adjust description and change default value. - (completions-first-difference): Ajust docstring. + (completions-first-difference): Adjust docstring. (completion-pcm--hilit-commonality): Don't use completions-first-difference. @@ -12738,7 +12738,7 @@ * lisp/speedbar.el (speedbar-check-vc-this-line): Normalize boolean result. (speedbar-this-file-in-vc): Use `run-hook-with-args-until-success' - to check for files under versin control. Doc fix. + to check for files under version control. Doc fix. 2019-10-16 Michael Albinus <michael.albinus@gmx.de> @@ -13701,7 +13701,7 @@ "\\|\r" from regular expression. * lisp/progmodes/cc-mode.el (c-make-mode-syntax-table): Correct the name of - the hook normal-erase-is-backspace-MODE-hook from a non-existant hook name. + the hook normal-erase-is-backspace-MODE-hook from a non-existent hook name. 2019-10-11 Lars Ingebrigtsen <larsi@gnus.org> @@ -15039,7 +15039,7 @@ 2019-10-04 Eric Abrahamsen <eric@ericabrahamsen.net> - Don't manipulate gnus-newsrc-alist if it hasn't been initalized + Don't manipulate gnus-newsrc-alist if it hasn't been initialized * lisp/gnus/gnus-group.el (gnus-group-set-info): Packages that use Gnus summary mode without actually booting Gnus might end up in this @@ -15340,7 +15340,7 @@ Implementation for VC projects that uses 'git ls-files' or 'hg status --all' for listing. With gratitude to Tassilo Horn who has done most of the legwork and wrote the first version of the code - (https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg00069.html). + (https://lists.gnu.org/r/emacs-devel/2019-10/msg00069.html). (project--vc-list-files): New function, to be used by the above. (project--find-regexp-in-files): Silence warnings about nonexistent files. @@ -15458,7 +15458,7 @@ * lisp/progmodes/cc-engine.el (c-forward-decl-or-cast-1): New variable got-function-name-prefix, which is set when an operator like * (but not &) - precedes the putative identifer in parentheses. Test this variable when + precedes the putative identifier in parentheses. Test this variable when deciding whether or not to "move the type backwards" to the previous identifier. @@ -16583,7 +16583,7 @@ Verilog-Mode collected updates. * lisp/progmodes/verilog-mode.el (verilog-auto-inst-param): Add regexp - paramter to AUTOINSTPARAM to select which parameters to export. Reported + parameter to AUTOINSTPARAM to select which parameters to export. Reported by Vish S. (verilog-build-defun-re): Fix `verilog-goto-defun' to find automatic function/tasks, bug1492. Reported by Enze Chi. @@ -17981,7 +17981,7 @@ 'query-replace-regexp undo: Update next-replacement after undo' (30c4f35a6fc8a6507930923766c3126ac1c2063f) - See https://lists.gnu.org/archive/html/emacs-devel/2019-09/msg00364.html + See https://lists.gnu.org/r/emacs-devel/2019-09/msg00364.html * lisp/replace.el(perform-replace): Rename variable to next-replacement-replaced. @@ -19170,7 +19170,7 @@ * lisp/net/nsm.el (nsm-protocol-check--renegotiation-info-ext): Don't check when using TLS1.3, renegotiation has been removed from TLS. Reported in - <https://lists.gnu.org/archive/html/help-gnu-emacs/2019-09/msg00005.html> + <https://lists.gnu.org/r/help-gnu-emacs/2019-09/msg00005.html> 2019-09-04 Paul Eggert <eggert@cs.ucla.edu> @@ -19320,7 +19320,7 @@ Avoid macros in pdumper.c when it’s easy Problem with DUMP_SET_REFERRER mentioned by Pip Cet at end of: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00548.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00548.html * src/pdumper.c (DANGEROUS, EMACS_RELOC_TYPE_BITS) (EMACS_RELOC_LENGTH_BITS, DUMP_RELOC_TYPE_BITS) (DUMP_RELOC_ALIGNMENT_BITS, DUMP_RELOC_OFFSET_BITS) @@ -21681,7 +21681,7 @@ method. Set up any user-defined fringe bitmaps in addition to the standard bitmaps. Suggested by Liam Quinlan <liamkquinlan@gmail.com> in - https://lists.gnu.org/archive/html/emacs-devel/2019-08/msg00259.html. + https://lists.gnu.org/r/emacs-devel/2019-08/msg00259.html. (w32_reset_fringes) [HAVE_NTGUI]: Do nothing if the frame's redisplay_interface doesn't implement the @@ -22067,7 +22067,7 @@ Suggested by Oleh Krehel and implemented by Basil Contovounesios in the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00547.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00547.html * lisp/array.el (xor): Move unused function from here... * lisp/subr.el: ...to here, and improve. @@ -22790,7 +22790,7 @@ 2019-08-03 Lars Ingebrigtsen <larsi@gnus.org> - Tweak tango-dark-theme hightlight face + Tweak tango-dark-theme highlight face * etc/themes/tango-dark-theme.el (class): Make highlight a bit less yellow to make the cursor visible on it (bug#19189). @@ -22940,14 +22940,14 @@ CC Mode: Fix error in macro cache. This fixes bug #36802 * lisp/progmodes/cc-engine.el (c-invalidate-macro-cache): Add in a cond arm - to handle the change position being less than the recorded CPP contruct end. + to handle the change position being less than the recorded CPP construct end. 2019-08-02 Basil L. Contovounesios <contovob@tcd.ie> Make gravatar.el more configurable For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00528.html * etc/NEWS: Announce changes in gravatar.el user options. @@ -22973,7 +22973,7 @@ Fix some minor gravatar.el issues For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00528.html * lisp/image/gravatar.el (gravatar-hash): Trim leading and trailing whitespace in given address, as per the Gravatar docs. (gravatar-retrieve-synchronously): Silence call to @@ -22986,7 +22986,7 @@ DRY in gravatar.el For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00528.html * lisp/image/gravatar.el (gravatar-data->image): Remove. (gravatar-retrieve, gravatar-retrieve-synchronously): Reuse url-fetch-from-cache and gravatar-retrieved to reduce duplication. @@ -22999,7 +22999,7 @@ Use lexical-binding for Gravatar support For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00528.html * lisp/gnus/gnus-gravatar.el: Use lexical-binding. Link custom group 'gnus-gravatar' to 'gravatar'. (gnus-gravatar-size, gnus-gravatar-too-ugly): Doc fix. @@ -23177,7 +23177,7 @@ Fix property stripping in image-file-yank-handler Fix proposed by Martin Rudalics <rudalics@gmx.at> in: - https://lists.gnu.org/archive/html/emacs-devel/2008-12/msg00945.html + https://lists.gnu.org/r/emacs-devel/2008-12/msg00945.html * lisp/image-file.el (image-file-yank-handler): Handle case when yank-excluded-properties is t. @@ -23268,7 +23268,7 @@ Add example for removing scroll bars/fringes from mini windows (Bug#8868) * doc/lispref/display.texi (Fringe Size/Pos): Mention example - for how to permenantly remove fringes from minibuffer windows. + for how to permanently remove fringes from minibuffer windows. (Scroll Bars): Add example for how to permanently remove scroll bars and fringes from minibuffer windows. @@ -23719,7 +23719,7 @@ 2019-07-30 Lars Ingebrigtsen <larsi@gnus.org> - Fix syntax error in previus calc-forms change + Fix syntax error in previous calc-forms change * lisp/calc/calc-forms.el (calc-time): Fix previous decoded time change. @@ -28310,7 +28310,7 @@ This changeset also rearranges native image transform code for other platforms to make it cleaner, and also removes the support for native cropping. For the discussions, see - https://lists.gnu.org/archive/html/emacs-devel/2019-06/msg00242.html + https://lists.gnu.org/r/emacs-devel/2019-06/msg00242.html * src/w32term.c (w32_image_rotations_p, transform): New functions. (w32_draw_image_foreground): If image rotation is requested @@ -28832,8 +28832,8 @@ Remove gnus-bug from report-emacs-bug TODO entry For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg01196.html - https://lists.gnu.org/archive/html/emacs-devel/2019-06/msg00967.html + https://lists.gnu.org/r/emacs-devel/2019-04/msg01196.html + https://lists.gnu.org/r/emacs-devel/2019-06/msg00967.html * etc/TODO: Remove gnus-bug from list of obsolete bug-reporting commands now that it is implemented in terms of report-emacs-bug. @@ -29144,7 +29144,7 @@ * lib/strnlen.c, m4/strnlen.m4: New files, copied from Gnulib. * lwlib/lwlib.c (lw_separator_p): * src/json.c (json_has_prefix): - Use strncmp to avoid unecessary work with strlen + memcmp. + Use strncmp to avoid unnecessary work with strlen + memcmp. * src/process.c (set_socket_option): Use SBYTES instead of strlen. 2019-06-25 Emilio C. Lopes <eclig@gmx.net> (tiny change) @@ -30260,7 +30260,7 @@ 2019-06-20 Lars Ingebrigtsen <larsi@gnus.org> - Leave the emtpy info and lib/sys in extraclean + Leave the empty info and lib/sys in extraclean * lib/Makefile.in: Ditto. @@ -30878,7 +30878,7 @@ 2019-06-19 Lars Ingebrigtsen <larsi@gnus.org> - Tweak progess reporting in finder-compile-keywords + Tweak progress reporting in finder-compile-keywords * lisp/finder.el (finder-compile-keywords): Use progress reporter to report the processing. @@ -31189,7 +31189,7 @@ Output progress messages when scraping autoloads during bootstrap * lisp/emacs-lisp/byte-run.el (byte-compile-info-message): New - function to outout informational messages during byte compilation. + function to output informational messages during byte compilation. * lisp/emacs-lisp/autoload.el (update-directory-autoloads): Use it to report progress when scraping autoloads during bootstrap (which @@ -32559,7 +32559,7 @@ Fix compilation warnings in rfc2104 - * lisp/net/rfc2104.el (rfc2104-hash): Remove superflous calls to + * lisp/net/rfc2104.el (rfc2104-hash): Remove superfluous calls to string-make-unibyte and avoid two compilation warnings. 2019-06-12 Lars Ingebrigtsen <larsi@gnus.org> @@ -34140,7 +34140,7 @@ 2019-06-01 Alan Mackenzie <acm@muc.de> - Debug and disentangle the literal cacheing in CC Mode + Debug and disentangle the literal caching in CC Mode (Final Commit) @@ -34156,11 +34156,11 @@ 2019-06-01 Alan Mackenzie <acm@muc.de> - * lisp/progmodes/cc-engine.el: Permute certain literal cacheing functions + * lisp/progmodes/cc-engine.el: Permute certain literal caching functions 2019-06-01 Alan Mackenzie <acm@muc.de> - Tidy up the literal cacheing in CC Mode, optimizing c-full-pp-to-literal + Tidy up the literal caching in CC Mode, optimizing c-full-pp-to-literal (Intermediate commit) @@ -34424,7 +34424,7 @@ if the sought position is in a literal, and lies between the literal start and the entry's position. (c-cache-to-parse-ps-state, c-parse-ps-state-below): Amend such that instead - of cacheing a state for a position after a backslash or first character of a + of caching a state for a position after a backslash or first character of a 2-character comment delimiter, this is done for the previous character position. @@ -35048,7 +35048,7 @@ Fix url-copy-file argument handling For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00500.html + https://lists.gnu.org/r/emacs-devel/2019-05/msg00500.html * lisp/url/url-handlers.el: Update autoloaded docstrings. Quote function symbols as such. (url-handler-regexp): Make grouping construct shy. @@ -35208,7 +35208,7 @@ Use lexical-binding in tempo.el and add tests For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00395.html + https://lists.gnu.org/r/emacs-devel/2019-05/msg00395.html * lisp/tempo.el: Use lexical-binding. (tempo-define-template): Expand documentation to mention `tempo-user-elements'. @@ -35265,8 +35265,8 @@ Improve C and Elisp Git diff hunk headers For discussion, see the following threads: - https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00457.html - https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00369.html + https://lists.gnu.org/r/emacs-devel/2019-03/msg00457.html + https://lists.gnu.org/r/emacs-devel/2019-05/msg00369.html * autogen.sh: Extend the built-in Git xfuncname pattern 'cpp' to match preprocessor and DEFUN macros, and the 'elisp' pattern to @@ -35278,7 +35278,7 @@ Thanks to Basil L. Contovounesios for additional cleanups. For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00177.html + https://lists.gnu.org/r/emacs-devel/2019-05/msg00177.html * lisp/delim-col.el: Use lexical-binding. @@ -35308,7 +35308,7 @@ w32--os-description: Fix previous change - * lisp/w32-fns.el (w32--os-description): Fix inadvertant "o" added + * lisp/w32-fns.el (w32--os-description): Fix inadvertent "o" added to the end of the function name in the previous patch (bug#35807). 2019-05-20 Lars Ingebrigtsen <larsi@gnus.org> @@ -35798,8 +35798,8 @@ Remove XEmacs audio checks from mm-decode.el For discussion, see the following threads: - https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg01087.html - https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00584.html + https://lists.gnu.org/r/emacs-devel/2019-03/msg01087.html + https://lists.gnu.org/r/emacs-devel/2019-05/msg00584.html * lisp/gnus/mm-decode.el (mm-inline-media-tests): Remove no-op media tests for XEmacs features. @@ -36178,7 +36178,7 @@ Add docstring to project--read-file-cpd-relative For discussion, see thread starting at: - https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00460.html + https://lists.gnu.org/r/emacs-devel/2019-05/msg00460.html * lisp/progmodes/project.el (project--read-file-cpd-relative): Describe arglist as promised by user option project-read-file-name-function. @@ -36353,7 +36353,7 @@ 2019-05-15 John Shahid <jvshahid@gmail.com> - Avoid infinitly looping in tramp-interrupt-process (bug#35506) + Avoid infinitely looping in tramp-interrupt-process (bug#35506) * lisp/net/tramp.el (tramp-interrupt-process): Remove with-timeout. Instead pass a timeout to tramp-accept-process-output. @@ -36457,7 +36457,7 @@ Allow customizing the display of project file names when reading To hopefully resolve a long-running discussion - (https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00162.html). + (https://lists.gnu.org/r/emacs-devel/2019-05/msg00162.html). * lisp/progmodes/project.el (project-read-file-name-function): New variable. @@ -37629,7 +37629,7 @@ * lisp/progmodes/xref.el (xref--read-identifier): Abort on empty input if there is no default - (https://lists.gnu.org/archive/html/help-gnu-emacs/2019-05/msg00012.html). + (https://lists.gnu.org/r/help-gnu-emacs/2019-05/msg00012.html). 2019-05-02 Alan Mackenzie <acm@muc.de> @@ -38137,7 +38137,7 @@ This should not be necessary, and is merely a precaution. For background, see: - https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00639.html + https://lists.gnu.org/r/emacs-devel/2019-04/msg00639.html * src/frame.c: * src/xdisp.c: Check for existence of terminal hooks before use. @@ -38458,7 +38458,7 @@ Fix some corner cases in the recognition of C++ raw strings. These are where changing the identifier in a raw string delimiter causes - different delimiters to match eachother. + different delimiters to match each other. * lisp/progmodes/cc-engine.el (c-raw-string-end-delim-disrupted): New variable. @@ -39037,7 +39037,7 @@ Improve pure and side-effect-free docs For discussion, see thread starting at: - https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00316.html + https://lists.gnu.org/r/emacs-devel/2019-04/msg00316.html * doc/lispref/customize.texi (Composite Types): Do not overspecify :match-alternatives predicates. * doc/lispref/eval.texi (Intro Eval): Anchor definition of "side @@ -40266,7 +40266,7 @@ Optimize byte-compilation of proper-list-p For discussion, see thread starting at: - https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00316.html + https://lists.gnu.org/r/emacs-devel/2019-04/msg00316.html * lisp/emacs-lisp/byte-opt.el: Optimize proper-list-p as a predicate. * lisp/subr.el: Mark proper-list-p as pure, and side-effect and @@ -40585,7 +40585,7 @@ * lisp/printing.el: Use lexical-binding Require easy-menu instead of adding declarations. - Remove backward compatiblity. Remove redundant ':group' args. + Remove backward compatibility. Remove redundant ':group' args. (pr-region-active-p): Use use-region-p. (pr-set-keymap-name): Delete function and callers. (pr-set-keymap-parents): Delete function; use set-keymap-parent instead. @@ -41012,7 +41012,7 @@ this function can be used to find JSXExpressionContainers within JSX. Fix bug where an enclosing JSXElement couldn’t be found when point was at the start of its JSXClosingElement. Return the JSXClosingElement’s - position as well, so the JSXClosingElement can be indentified when + position as well, so the JSXClosingElement can be identified when indenting and be indented like the matching JSXOpeningElement. (js-jsx--at-enclosing-tag-child-p): js-jsx--enclosing-tag-pos now @@ -41453,7 +41453,7 @@ Fix more regexp oddities Problems reported by Mattias Engdegård in: - https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00178.html + https://lists.gnu.org/r/emacs-devel/2019-04/msg00178.html * lisp/progmodes/sh-script.el (sh-get-indent-info): Reorder skip-chars-forward arg so that it does not look like a regexp. * lisp/progmodes/verilog-mode.el (verilog-sk-define-signal): @@ -41479,7 +41479,7 @@ * lisp/frame.el (display-planes): Use logb over truncate + log Suggested by Basil L. Contovounesios: - https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-03/msg01052.html + https://lists.gnu.org/r/bug-gnu-emacs/2019-03/msg01052.html 2019-04-06 Alexander Gramiak <agrambot@gmail.com> @@ -41786,7 +41786,7 @@ (gnus-dup-suppress-articles): DRY. For discussion, see thread starting at: - https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00974.html + https://lists.gnu.org/r/emacs-devel/2019-03/msg00974.html 2019-04-02 Wilson Snyder <wsnyder@wsnyder.org> @@ -41930,7 +41930,7 @@ Lisp_Fwd * and then back again, because the compiler can then assume that the pointer is aligned for union Lisp_Fwd * when accessing the struct Lisp_Objfwd * components, and this assumption might - be incorrect becase we don't force that alignment. + be incorrect because we don't force that alignment. * src/lisp.h (lispfwd): New type, replacing ... (union Lisp_Fwd): ... this type, which was removed. All uses changed. @@ -41980,7 +41980,7 @@ Do not set indent-line-function in text-mode For discussion, see thread starting at: - https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg01012.html + https://lists.gnu.org/r/emacs-devel/2019-03/msg01012.html * lisp/textmodes/text-mode.el (text-mode): Do not reset indent-line-function to its global default value of indent-relative. * doc/lispref/modes.texi (Example Major Modes): @@ -42626,7 +42626,7 @@ i18n: Add function ngettext for pluralization. * lisp/international/mule-cmds.el (ngettext): New function. - https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00586.html + https://lists.gnu.org/r/emacs-devel/2019-03/msg00586.html * lisp/replace.el (flush-lines, how-many, occur-1, occur-engine) (perform-replace): Use ngettext. @@ -42909,7 +42909,7 @@ This reverts commit 3eb93c07f7a60ac9ce8a16f10c3afd5a3a31243a. There was no consensus for that commit, see - https://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00150.html. + https://lists.gnu.org/r/emacs-devel/2016-01/msg00150.html. Also, reverting this commit should fix Bug#31238. 2019-03-21 Eli Zaretskii <eliz@gnu.org> @@ -44031,8 +44031,8 @@ * src/marker.c (buf_bytepos_to_charpos): Remove the assertion regarding bytepos always at the head byte of a multibyte sequence. For the reasons, see - http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00100.html - http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00102.html + https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00100.html + https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00102.html 2019-03-05 Wilson Snyder <wsnyder@wsnyder.org> @@ -45211,7 +45211,7 @@ * lisp/progmodes/sql.el (sql-add-product): Correct argument spec. (sql-set-product-feature): Handle all cases as intended. - (sql-get-product-feature): Fetch varaiable value by `eval'. + (sql-get-product-feature): Fetch variable value by `eval'. * test/lisp/progmodes/sql-tests.el (sql-test-feature-value-[a-d]): New test variables. (sql-test-product-feature-harness): New test macro. @@ -45541,7 +45541,7 @@ * lisp/startup.el (command-line): Pass 'early-init.el', with an explicit .el extension, to load-user-init-file. Reported by Radon Rosborough <radon.neon@gmail.com> in - http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00314.html. + https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00314.html. 2019-02-15 Stefan Monnier <monnier@iro.umontreal.ca> @@ -46161,7 +46161,7 @@ Rename multifile.el to fileloop.el * lisp/multifile.el: Rename to fileloop.el as discussed in - https://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00475.html. + https://lists.gnu.org/r/emacs-devel/2018-12/msg00475.html. Update symbol prefixes and all callers 2019-02-07 Aurelien Aptel <aaptel@suse.com> @@ -46939,7 +46939,7 @@ image-mode: Make parameters buffer-local Image parameters were treated as image specific, but because they - actually were global variables, their behaviour transfered to new + actually were global variables, their behaviour transferred to new images. * lisp/image-mode.el (image-transform-resize, image-transform-scale) (image-transform-rotation): Declare with defvar-local. (Bug#33990) @@ -47560,7 +47560,7 @@ but that only affects a small corner case of c-toggle-auto-newline, which is not turned on by default. - See https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00360.html + See https://lists.gnu.org/r/emacs-devel/2019-01/msg00360.html for more information. * lisp/progmodes/cc-cmds.el (c--disable-fix-of-bug-33794): New @@ -47838,7 +47838,7 @@ * src/frame.c (make_initial_frame): don't reset Vframe_list. (init_frame_once_for_pdumper, init_frame_once): new functions. (syms_of_frame): remove redundant staticpro. - * src/fringe.c (init_fringe_once_for_pdumper): new functin. + * src/fringe.c (init_fringe_once_for_pdumper): new function. (init_fringe_once): call it. * src/ftcrfont.c (syms_of_ftcrfont_for_pdumper): new function. (syms_of_ftcrfont): call it. @@ -47846,7 +47846,7 @@ (syms_of_ftfont): call it. * src/ftxfont.c (syms_of_ftxfont_for_pdumper): new function. (syms_of_ftxfont): call it. - * src/gmalloc.c: adjust for pdumper througout + * src/gmalloc.c: adjust for pdumper throughout (DUMPED): remove weird custom dumped indicator. * src/gnutls.c (syms_of_gnutls): pdumper note for gnutls_global_initialized. @@ -48290,7 +48290,7 @@ signal an error (due to generating a too-large bignum) contrary to its documentation. Fix things to remove the theoretical possibility, so that list lengths are always fixnums (and so - that list lenghts are always ptrdiff_t values too, since that + that list lengths are always ptrdiff_t values too, since that is assumed internally anyway). * src/alloc.c (Fcons): Do not allocate so many conses that a list length won’t fit into ptrdiff_t or into fixnum. @@ -48686,7 +48686,7 @@ Adapt test/README - * test/README: Speak about continous integration tests on hydra + * test/README: Speak about continuous integration tests on hydra and emba. 2019-01-03 Andrey Kotlarski <m00naticus@gmail.com> @@ -49008,7 +49008,7 @@ * lisp/progmodes/project.el (project--completing-read-strict): Extract the common parent directory of all files first - (https://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00444.html). + (https://lists.gnu.org/r/emacs-devel/2018-12/msg00444.html). 2018-12-28 Michael Albinus <michael.albinus@gmx.de> @@ -50599,7 +50599,7 @@ (tramp-gvfs-handle-file-writable-p) (tramp-gvfs-handle-write-region): Move to tramp.el. - * lisp/net/tramp-rclone.el: Dont't require `tramp-adb' and + * lisp/net/tramp-rclone.el: Don't require `tramp-adb' and `tramp-gvfs' anymore. (tramp-rclone-file-name-handler-alist): Use `tramp-handle-expand-file-name', `tramp-handle-file-local-copy', @@ -50624,7 +50624,7 @@ the correct directory in emacs_wd, which is now initialized way earlier in the startup process, when init_environment was not yet called. For details, see the problems reported in - http://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00068.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00068.html. Reported by Angelo Graziosi <angelo.g0@libero.it>. 2018-12-06 Juri Linkov <juri@linkov.net> @@ -52313,7 +52313,7 @@ * lib-src/emacsclient.c (set_local_socket): Don't ignore socket ownership when run by root. - Ref: http://lists.gnu.org/r/emacs-devel/2018-11/msg00019.html + Ref: https://lists.gnu.org/r/emacs-devel/2018-11/msg00019.html 2018-11-13 Eli Zaretskii <eliz@gnu.org> @@ -52604,7 +52604,7 @@ Advertise new hi-lock 'M-s h' key prefix in lisp/bindings.el - https://lists.gnu.org/archive/html/emacs-devel/2015-07/msg00104.html + https://lists.gnu.org/r/emacs-devel/2015-07/msg00104.html 2018-11-07 Juri Linkov <juri@linkov.net> @@ -53573,7 +53573,7 @@ always inserts an expressions even if no abbrevs need to be saved and making only write-abbrev-file check that a table has any abbrevs to save before calling insert-abbrev-table-description. This duplicates - the work of filtering the table for savable abbrevs, but the benefit + the work of filtering the table for saveable abbrevs, but the benefit of keeping the API is worth it. * doc/lispref/abbrevs.texi (Abbrev Tables): Update documentation. @@ -54667,7 +54667,7 @@ Fix a previous commit Suggested by Stefan Monnier here: - https://lists.gnu.org/archive/html/emacs-devel/2018-09/msg00783.html + https://lists.gnu.org/r/emacs-devel/2018-09/msg00783.html * lisp/replace.el (occur--parse-occur-buffer): Since point is at the beginning of the buffer, use `point'. @@ -56960,7 +56960,7 @@ New 'configure' arg --with-mini-gmp - * configure.ac: It lets the builder override default of whther + * configure.ac: It lets the builder override default of whether mini-gmp is used. Use AC_SEARCH_LIBS as per Autoconf manual. 2018-08-11 Paul Eggert <eggert@cs.ucla.edu> @@ -57139,7 +57139,7 @@ alias for thai-iso8859-11. Instead, reinstate the original definition of tis620-2533, but without eight-bit-control in the :superset attribute. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00117.html + https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00117.html and the surrounding discussions. * lisp/international/fontset.el (font-encoding-alist) (font-encoding-charset-alist): Reinstate tis620-2533 charset. @@ -57449,7 +57449,7 @@ * lisp/calendar/todo-mode.el (todo-jump-to-category): Improve code by using bound-and-true-p. This leaves a byte-compiler warning unsilenced, but ideally, there shouldn't be a warning here (see - https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00131.html). + https://lists.gnu.org/r/emacs-devel/2018-08/msg00131.html). (todo--fifiles-history): New variable. (todo-find-filtered-items-file): Use it to fix the filtered items files history list for completing-read. @@ -57782,7 +57782,7 @@ Fix some documentation formatting nits * doc/misc/ert.texi (Running Tests Interactively): Correct - Elisp manual titile in xref. + Elisp manual title in xref. * doc/lispref/edebug.texi (Edebug Misc): Use single argument form of xref. * doc/lispref/debugging.texi (Backtraces): Add comma and @@ -57831,7 +57831,7 @@ Add commands to go to source if available, and to show and hide Edebug's instrumentation. Make Edebug pop to backtraces instead of - displaying them, which makes Edebug consistant with the behavior of + displaying them, which makes Edebug consistent with the behavior of ERT and the Lisp Debugger. * doc/lispref/edebug.texi (Edebug Misc): Document when and how you can jump to source code from an Edebug backtrace. Document @@ -58282,7 +58282,7 @@ "******" - It's slighly easier to visually count the number of characters in the second + It's slightly easier to visually count the number of characters in the second string (Bug#32220). * lisp/subr.el (read-passwd): Prefer ?* as default char instead of ?. @@ -59002,7 +59002,7 @@ (epg-config--program-alist) <OpenPGP>: Require a version in 1.4.3..2.0 or 2.1.6+., not just anything above 1.4.3. (epg-check-configuration): Accept a list of required version - intervals, in addtion to just a single minimum. + intervals, in addition to just a single minimum. 2018-07-15 Paul Eggert <eggert@Penguin.CS.UCLA.EDU> @@ -59294,7 +59294,7 @@ Fix custom-available-themes file expansion For discussion, see thread starting at - https://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00222.html. + https://lists.gnu.org/r/emacs-devel/2018-05/msg00222.html. * lisp/custom.el: (custom-available-themes): Use directory-files instead of performing arbitrary wildcard expansion in file names. (custom-theme--load-path): Document return value. @@ -59320,8 +59320,8 @@ * etc/themes/whiteboard-theme.el: * etc/themes/wombat-theme.el: Disable no-byte-compile. - https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00614.html - https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00060.html + https://lists.gnu.org/r/emacs-devel/2018-01/msg00614.html + https://lists.gnu.org/r/emacs-devel/2018-02/msg00060.html 2018-07-13 Basil L. Contovounesios <contovob@tcd.ie> @@ -59330,8 +59330,8 @@ * lisp/custom.el (load-theme): Load byte-compiled file of safe themes when available. - https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00614.html - https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00060.html + https://lists.gnu.org/r/emacs-devel/2018-01/msg00614.html + https://lists.gnu.org/r/emacs-devel/2018-02/msg00060.html 2018-07-13 Robert Pluim <rpluim@gmail.com> @@ -59562,7 +59562,7 @@ * lisp/vc/smerge-mode.el (smerge-refine-regions): Bind write-region-inhibit-fsync to t. This was reported in - https://github.com/magit/magit/pull/2834 to give a noticable speedup. + https://github.com/magit/magit/pull/2834 to give a noticeable speedup. 2018-07-12 Noam Postavsky <npostavs@gmail.com> @@ -59629,11 +59629,11 @@ Add predicate proper-list-p For discussion, see emacs-devel thread starting at - https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00460.html. + https://lists.gnu.org/r/emacs-devel/2018-04/msg00460.html. * lisp/subr.el (proper-list-p): New function. Implementation suggested by Paul Eggert <eggert@cs.ucla.edu> in - https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html. + https://lists.gnu.org/r/emacs-devel/2018-06/msg00138.html. * doc/lispref/lists.texi (List Elements): * etc/NEWS: Document proper-list-p. * lisp/org/ob-core.el (org-babel-insert-result): @@ -60017,7 +60017,7 @@ * src/w32proc.c (syms_of_ntproc) <w32-pipe-read-delay>: Set to zero. For the details, see this discussion: - http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00711.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00711.html. * src/w32.c (_sys_read_ahead): Update the commentary for w32-pipe-read-delay usage. @@ -60247,7 +60247,7 @@ Clean up redundant code from previous checkins - * src/gnutls.c (gnutls_verify_boot): Remove reduntant setting of + * src/gnutls.c (gnutls_verify_boot): Remove redundant setting of p->gnutls_certificates, which is now performed by gnutls_deinit_certificates. @@ -60559,7 +60559,7 @@ Mark a specific electric-pair-mode test as an expected failure - See https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00535.html + See https://lists.gnu.org/r/emacs-devel/2018-06/msg00535.html * test/lisp/electric-tests.el (electric-pair-whitespace-chomping-2-at-point-4-in-c++-mode-in-strings): @@ -61556,7 +61556,7 @@ Don't have shr bug out on degenerate <img> tags - * lisp/net/shr.el (shr-tag-img): Protect against contructs like + * lisp/net/shr.el (shr-tag-img): Protect against constructs like <img src=" ">. 2018-06-10 Stefan Monnier <monnier@iro.umontreal.ca> @@ -62100,7 +62100,7 @@ Obsolete Flymake's flymake-diagnostic-types-alist - That varaiable was an association between symbols and properties, + That variable was an association between symbols and properties, effecively duplicating symbol's property lists. It is simpler to just put properties on symbols. Backward compatibility to the old variable has been kept. @@ -62471,7 +62471,7 @@ * lisp/subr.el (string-to-unibyte): No longer obsolete. See the emacs-devel discussion around this message: - http://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00656.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00656.html. * etc/NEWS: Announce the change. @@ -62491,7 +62491,7 @@ with C sources. The green light for this change had already been given some time ago in - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00385.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00385.html * src/Makefile.in (check-syntax): New target. (.PHONY): Add check-syntax. @@ -62803,7 +62803,7 @@ (tramp-smb-conf, tramp-smb-winexe-program) (tramp-smb-winexe-shell-command) (tramp-smb-winexe-shell-command-switch): - Dont't require 'tramp. (Bug#31558) + Don't require 'tramp. (Bug#31558) * lisp/net/tramp.el (tramp-ignored-file-name-regexp): Use type regexp. @@ -63250,7 +63250,7 @@ * lisp/eshell/esh-opt.el (eshell--process-args): Refactor usage of args to eshell--args, as we rely on modifications from eshell--process-option and vice versa. These modifications were not - being propogated in the (if (= ai 0)) case, since popping the first + being propagated in the (if (= ai 0)) case, since popping the first element of a list doesn't destructively modify the underlying list object. @@ -63512,7 +63512,7 @@ * lisp/international/fontset.el (font-encoding-alist): Fix the GB18030 entry to encode characters correctly when passing them to the xfont back-end. (Bug#31315) See also - http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. + https://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. 2018-05-04 Noam Postavsky <npostavs@gmail.com> @@ -64089,7 +64089,7 @@ 2018-04-20 Michael Albinus <michael.albinus@gmx.de> - Revert "* etc/HELLO: Add langugae Emoji. Use utf-8 coding." + Revert "* etc/HELLO: Add language Emoji. Use utf-8 coding." This reverts commit c4cfb5d20487f9912f5896b3f1d291fe7ccc9804. @@ -64132,7 +64132,7 @@ * lisp/international/mule-cmds.el (view-hello-file): Use utf-8 coding. - * etc/HELLO: Add langugae Emoji. Use utf-8 coding. + * etc/HELLO: Add language Emoji. Use utf-8 coding. 2018-04-19 Glenn Morris <rgm@gnu.org> @@ -64326,7 +64326,7 @@ Use next-error-found to set next-error-last-buffer. - https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00207.html + https://lists.gnu.org/r/emacs-devel/2018-04/msg00207.html * lisp/simple.el (next-error-buffer): New buffer-local variable instead of making buffer-local next-error-last-buffer. (Bug#20489) @@ -65267,7 +65267,7 @@ (eww-display-html): ... and don't get it here, because it's gone by now. - Test URL: http://www.gnu.org/s/hyperbole/#summary + Test URL: https://www.gnu.org/s/hyperbole/#summary 2018-04-13 Robert Pluim <rpluim@gmail.com> @@ -65537,7 +65537,7 @@ 2018-04-11 Daniel Dehennin <daniel.dehennin@baby-gnu.org> - Gnus Group Mail Spliting on mailing-list headers + Gnus Group Mail Splitting on mailing-list headers * doc/misc/gnus.texi: Document the new `list' split abbreviation and `match-list' group parameter (bug#25346). @@ -65717,7 +65717,7 @@ ‘sgml-quote’ do that. While at it, fix entiteis not being unquoted if they lack closing - semicolon (e.g. ‘&’) occuring at the very end of a region. + semicolon (e.g. ‘&’) occurring at the very end of a region. Even though unlikely, make ‘sgml-quote’ handle this scenario. * lisp/textmodes/sgml-mode.el (sgml-quote): Handle quotation marks and @@ -65735,7 +65735,7 @@ 2018-04-05 Tino Calancha <tino.calancha@gmail.com> - Require secrets.el iif Emacs has dbusbind support + Require secrets.el if Emacs has dbusbind support * test/lisp/net/secrets-tests.el: Require secrets.el if and only if, Emacs has been compiled with dbusbind support. @@ -65794,7 +65794,7 @@ and disabled by `disabled'. (search-exit-option): Doc fix. (isearch-post-command-hook): Check for isearch-forward. - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00438.html + https://lists.gnu.org/r/emacs-devel/2018-03/msg00438.html 2018-04-04 Juri Linkov <juri@linkov.net> @@ -66167,7 +66167,7 @@ Don't wait for visible frames to become visible For discussion, see thread starting at - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00807.html. + https://lists.gnu.org/r/emacs-devel/2018-03/msg00807.html. * src/xterm.c (x_make_frame_visible): Check FRAME_VISIBLE_P before calling x_wait_for_event. @@ -67190,22 +67190,22 @@ * lisp/emacs-lisp/package.el (package-enable-at-startup): Update docstring to note that packages are now made available before loading the init file, rather than afterwards. See - https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00632.html + https://lists.gnu.org/r/emacs-devel/2018-02/msg00632.html (package-load-list): Refer to "making available" rather than "loading" for packages. See - https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00298.html + https://lists.gnu.org/r/emacs-devel/2018-02/msg00298.html * lisp/startup.el (command-line): Call `custom-reevaluate-setting' on predefined variables before loading the early init file and before `package-initialize' is called. This prevents `Info-default-directory-list' from being unbound when `package-initialize' tries to access it during startup. See - https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00545.html + https://lists.gnu.org/r/emacs-devel/2018-02/msg00545.html * lisp/emacs-lisp/package.el (package-initialize): Issue a warning if called twice. - See: https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00626.html - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00301.html + See: https://lists.gnu.org/r/emacs-devel/2018-02/msg00626.html + https://lists.gnu.org/r/emacs-devel/2018-03/msg00301.html 2018-03-18 Glenn Morris <rgm@gnu.org> @@ -67236,7 +67236,7 @@ Date: Fri, 16 Mar 2018 10:23:31 -0500 Message-ID: <87po44jb7w.fsf@red-bean.com> - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00555.html + https://lists.gnu.org/r/emacs-devel/2018-03/msg00555.html 2018-03-18 Nicolas Petton <nicolas@petton.fr> @@ -67885,7 +67885,7 @@ * doc/emacs/search.texi: Replace search-exit-option option nil with append. - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00202.html + https://lists.gnu.org/r/emacs-devel/2018-03/msg00202.html 2018-03-08 Charles A. Roelli <charles@aurox.ch> @@ -68097,7 +68097,7 @@ * doc/emacs/search.texi (Not Exiting Isearch): Document new values ‘shift-move’ and ‘move’ of search-exit-option. - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00013.html + https://lists.gnu.org/r/emacs-devel/2018-03/msg00013.html 2018-03-03 Glenn Morris <rgm@gnu.org> @@ -68177,7 +68177,7 @@ but the Emacs 24 byte compiler doesn't recognize that define-obsolete-variable-alias defines a variable). - [1]: https://lists.gnu.org/archive/html/emacs-devel/2018-02/msg00826.html + [1]: https://lists.gnu.org/r/emacs-devel/2018-02/msg00826.html 2018-03-01 Glenn Morris <rgm@gnu.org> @@ -68976,11 +68976,11 @@ Discussion on emacs-devel leading up to this change (approximately 150 messages): - - https://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00154.html - - https://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00433.html - - https://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00023.html - - https://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00599.html - - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00332.html + - https://lists.gnu.org/r/emacs-devel/2017-08/msg00154.html + - https://lists.gnu.org/r/emacs-devel/2017-08/msg00433.html + - https://lists.gnu.org/r/emacs-devel/2017-09/msg00023.html + - https://lists.gnu.org/r/emacs-devel/2017-09/msg00599.html + - https://lists.gnu.org/r/emacs-devel/2017-10/msg00332.html * lisp/startup.el (early-init-file): New variable. (load-user-init-file): New function. @@ -69399,7 +69399,7 @@ mode_line_help_echo. (wset_mode_line_help_echo): New function. * src/w32fns.c (Fx_show_tip): Normalize the FRAME argument - bevore storing it in tip_last_frame (Bug#30399). + before storing it in tip_last_frame (Bug#30399). * src/xdisp.c (display_mode_lines): Calculate mode line default help echo string here and store it in the window's mode_line_help_echo slot (Bug#30182). @@ -69410,7 +69410,7 @@ * src/xfns.c (x_hide_tip): Rewrite the GTK+ part to correctly handle the transition from GTK+ system to Emacs tooltips and vice-versa (Bug#30399). - (Fx_show_tip): Normalize the FRAME argument bevore storing it + (Fx_show_tip): Normalize the FRAME argument before storing it in tip_last_frame (Bug#30399). 2018-02-10 Michael Albinus <michael.albinus@gmx.de> @@ -70827,7 +70827,7 @@ TO_CHARPOS, but didn't yet produce glyphs for that buffer position, because the last call to PRODUCE_GLYPHS at this position was for an object other than the buffer. For further details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. 2018-01-19 Reuben Thomas <rrt@sc3d.org> @@ -71454,7 +71454,7 @@ In the macro expansion of the example above, right after: (setq k (+ k 1)) - evaluate the rest of the body forms iif the condition + evaluate the rest of the body forms if the condition (< k 2) is still valid. @@ -73761,7 +73761,7 @@ Merge from origin/emacs-26 - a89f0b6f33 maint: shorten https://lists.gnu.org/archive/html/... links + a89f0b6f33 maint: shorten https://lists.gnu.org/r/... links 8be3aee281 Merge from Gnulib 265cee553f Work around GCC bug 80776 on Fedora 27 x86 dc7a97fb84 Tweak copy-file, rename-file doc @@ -74031,7 +74031,7 @@ * lisp/emacs-lisp/copyright.el (copyright-update-year): Enlarge the scope of save-excursion. Reported in: - https://lists.gnu.org/archive/html/emacs-devel/2017-04/msg00271.html + https://lists.gnu.org/r/emacs-devel/2017-04/msg00271.html 2017-11-19 Vibhav Pant <vibhavp@gmail.com> @@ -76193,7 +76193,7 @@ Clarify Gravatar docs For discussion, see the following thread: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00528.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00528.html * doc/misc/gnus.texi (X-Face): Fix cross-reference. (Gravatars): * lisp/gnus/gnus-gravatar.el (gnus-gravatar-too-ugly): @@ -76247,7 +76247,7 @@ This explanation was given by Eli Zaretskii on emacs-devel. For discussion, see: - https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00294.html + https://lists.gnu.org/r/emacs-devel/2019-07/msg00294.html * src/buffer.c (syms_of_buffer): Add warning to doc string of bidi-display-reordering to explain that it should only be used for @@ -76433,7 +76433,7 @@ 2019-08-29 Michael Albinus <michael.albinus@gmx.de> - Fix accidential change in tramp-tests; do not merge with master + Fix accidental change in tramp-tests; do not merge with master * lisp/net/trampver.el: Change version to "2.3.5.26.3". (customize-package-emacs-version-alist): Add Tramp version @@ -76537,7 +76537,7 @@ * lisp/subr.el (definition-prefixes): Reflow docstring. - * lisp/svg.el (svg-create): Doc fix to allow arg higlighting. + * lisp/svg.el (svg-create): Doc fix to allow arg highlighting. (svg-gradient, svg-rectangle): Improve docstring formatting. 2019-06-15 Eli Zaretskii <eliz@gnu.org> @@ -77164,7 +77164,7 @@ Backport: Improve pure and side-effect-free docs For discussion, see thread starting at: - https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00316.html + https://lists.gnu.org/r/emacs-devel/2019-04/msg00316.html * doc/lispref/customize.texi (Composite Types): Do not overspecify :match-alternatives predicates. * doc/lispref/eval.texi (Intro Eval): Anchor definition of "side @@ -78845,7 +78845,7 @@ * doc/misc/ediff.texi (Major Entry Points): Update and clarify the documentation of 'ediff-windows-wordwise' and 'ediff-regions-wordwise'. See the discussion starting at - https://lists.gnu.org/archive/html/help-gnu-emacs/2018-11/msg00197.html + https://lists.gnu.org/r/help-gnu-emacs/2018-11/msg00197.html for the details. 2019-01-07 Eli Zaretskii <eliz@gnu.org> @@ -80362,7 +80362,7 @@ Fix math-imaginary-i check Reported by Bastian Erdnüß at - <https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00300.html>. + <https://lists.gnu.org/r/emacs-devel/2018-08/msg00300.html>. * lisp/calc/calc-cplx.el (math-imaginary-i): Check for a value of (polar 1 <quarter-circle>). @@ -80561,7 +80561,7 @@ * configure.ac: Add -Wabi to the list of disabled warning options. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. 2018-08-10 Filipp Gunbin <fgunbin@fastmail.fm> @@ -80935,7 +80935,7 @@ * lisp/emacs-lisp/rx.el (rx): Clarify and improve the doc string. For the details, see the discussion starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. 2018-07-19 Eli Zaretskii <eliz@gnu.org> @@ -81058,7 +81058,7 @@ reject :server and :nowait (Bug#31903)", the sense of the SERVER check was accidentally reversed so that we ended up looking for the wrong ADDRESS. Reported by T.V Raman in - <https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00437.html>. + <https://lists.gnu.org/r/emacs-devel/2018-07/msg00437.html>. 2018-07-12 Eli Zaretskii <eliz@gnu.org> @@ -81072,7 +81072,7 @@ Improve documentation of Flyspell For the background, see - http://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. + https://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. * doc/emacs/fixit.texi (Spelling): Add a couple of caveats. * lisp/textmodes/flyspell.el: Update commentary. @@ -81111,8 +81111,8 @@ lists. For discussion, see the following emacs-devel subthreads: - https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00112.html - https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html + https://lists.gnu.org/r/emacs-devel/2018-06/msg00112.html + https://lists.gnu.org/r/emacs-devel/2018-06/msg00138.html 2018-07-10 John Shahid <jvshahid@gmail.com> @@ -81220,8 +81220,8 @@ Fix (length NON-SEQUENCE) documentation Suggested by Eli Zaretskii <eliz@gnu.org> in the following threads: - https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00171.html - https://lists.gnu.org/archive/html/emacs-devel/2018-07/msg00206.html + https://lists.gnu.org/r/emacs-devel/2018-07/msg00171.html + https://lists.gnu.org/r/emacs-devel/2018-07/msg00206.html * doc/lispref/sequences.texi (Sequence Functions): Mention that 'length' signals a 'wrong-type-argument' also when given a @@ -81400,7 +81400,7 @@ * lisp/vc/vc-git.el (vc-git-dir-status-goto-stage): Call 'git ls-files -u' for the ls-files-conflict stage - (https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00885.html). + (https://lists.gnu.org/r/emacs-devel/2018-06/msg00885.html). 2018-06-27 Eli Zaretskii <eliz@gnu.org> @@ -81461,7 +81461,7 @@ See discussion: - https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00826.html + https://lists.gnu.org/r/emacs-devel/2018-06/msg00826.html From: Eli Zaretskii Subject: Re: [Emacs-diffs] \ emacs-26 9a53b6d: Say how to override a primitive interactive spec @@ -81508,7 +81508,7 @@ From this thread on Emacs Devel: - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00923.html + https://lists.gnu.org/r/emacs-devel/2018-03/msg00923.html From: Eli Zaretskii To: Karl Fogel CC: Juri Linkov, Emacs Devel @@ -81781,7 +81781,7 @@ * lisp/info.el: Explain in commentary why some commands start with "info-" and others with "Info-". See also - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. 2018-06-13 Michael Albinus <michael.albinus@gmx.de> @@ -82094,7 +82094,7 @@ * lisp/eshell/esh-opt.el (eshell--process-args): Refactor usage of args to eshell--args, as we rely on modifications from eshell--process-option and vice versa. These modifications were not - being propogated in the (if (= ai 0)) case, since popping the first + being propagated in the (if (= ai 0)) case, since popping the first element of a list doesn't destructively modify the underlying list object. @@ -82175,7 +82175,7 @@ Don't wait for visible frames to become visible For discussion, see thread starting at - https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00807.html. + https://lists.gnu.org/r/emacs-devel/2018-03/msg00807.html. * src/xterm.c (x_make_frame_visible): Check FRAME_VISIBLE_P before calling x_wait_for_event. @@ -82336,7 +82336,7 @@ * lisp/international/fontset.el (font-encoding-alist): Fix the GB18030 entry to encode characters correctly when passing them to the xfont back-end. (Bug#31315) See also - http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. + https://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. (cherry picked from commit bbe2cadc544e63e9378350621887f8fb9bbcc236) @@ -82460,7 +82460,7 @@ TO_CHARPOS, but didn't yet produce glyphs for that buffer position, because the last call to PRODUCE_GLYPHS at this position was for an object other than the buffer. For further details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. (cherry picked from commit c0154ac7c3423f68d8f3a2e85a756c9759219039) @@ -82609,7 +82609,7 @@ (tramp-smb-conf, tramp-smb-winexe-program) (tramp-smb-winexe-shell-command) (tramp-smb-winexe-shell-command-switch): - Dont't require 'tramp. (Bug#31558) + Don't require 'tramp. (Bug#31558) * lisp/net/tramp.el (tramp-accept-process-output): * lisp/net/tramp-adb.el (tramp-adb-handle-start-file-process): @@ -82939,7 +82939,7 @@ Fix inaccuracies in "Shell Ring" node of Emacs manual * doc/emacs/misc.texi (Shell Ring): Don't mention 'M-s' and don't - insist on Shell history commands being "jsut like" similar + insist on Shell history commands being "just like" similar commands that operate on minibuffer history. Reported by Jorge <jorge+list@disroot.org> in emacs-manual-bugs. @@ -83153,7 +83153,7 @@ (Note for Novices): * doc/lispref/tips.texi (Key Binding Conventions): Fix use of @key. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00390.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00390.html. 2018-04-19 Eli Zaretskii <eliz@gnu.org> @@ -83239,7 +83239,7 @@ * src/process.c (Fmake_pipe_process): Set up the decoding and encoding buffers. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00295.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00295.html. 2018-04-13 Robert Pluim <rpluim@gmail.com> @@ -84015,7 +84015,7 @@ * doc/lispref/variables.texi (Local Variables): Make more clear that local bindings of 'let' are in effect only within the body. Suggested by Marcin Borkowski <mbork@mbork.pl>, see - http://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00217.html + https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00217.html for the details. * doc/emacs/programs.texi (Matching): Fix a typo. Reported by @@ -85543,7 +85543,7 @@ * doc/lispref/customize.texi (Custom Themes): Clarify .el preference. - https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00824.html. + https://lists.gnu.org/r/emacs-devel/2018-01/msg00824.html. 2018-02-02 Eli Zaretskii <eliz@gnu.org> @@ -85790,7 +85790,7 @@ * doc/emacs/text.texi (Words): Improve wording. Reported by Marcin Borkowski <mbork@mbork.pl> in - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00784.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00784.html. 2018-01-28 Martin Rudalics <rudalics@gmx.at> @@ -86006,7 +86006,7 @@ This is part two of a two part fix for the GTK scaling problems. See the thread starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html for an explanation of why it has been added to Emacs 26. * src/gtkutil.c (xg_set_geometry): Scale down the coordinates that we @@ -86019,7 +86019,7 @@ This is part one of a two part fix for the GTK scaling problems. See the thread starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html for an explanation of why it has been added to Emacs 26. * src/xfns.c (Fx_display_monitor_attributes_list): Take scaling factor @@ -86163,7 +86163,7 @@ being compiled is specified by an absolute file name. This avoids problems with ACL copying from temporary-file-directory on FreeBSD. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00513.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00513.html. 2018-01-19 Eli Zaretskii <eliz@gnu.org> @@ -86356,7 +86356,7 @@ * doc/lispref/variables.texi (File Local Variables): Mention the autoload cookie as a means of defining safe values for variables. - See http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html + See https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html for the details. * doc/lispref/compile.texi (Compiler Errors): Document 'byte-compile-error-on-warn'. @@ -86750,7 +86750,7 @@ scroll-margin when scrolling down, i.e. moving window-start towards the beginning of the buffer. Reported by zhang cc <ccsmile2008@outlook.com> in - http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00894.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00894.html. 2017-12-29 Eli Zaretskii <eliz@gnu.org> @@ -86991,7 +86991,7 @@ Clarify what selecting a window means for keyboard input, and that input focus may need to be considered when selecting windows on other frames. See - http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00372.html for more details. 2017-12-22 Eli Zaretskii <eliz@gnu.org> @@ -87530,7 +87530,7 @@ * lisp/progmodes/prog-mode.el (prog-indentation-context): Un-document all elements but the first. (prog-widen): Remove. - (http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00321.html) + (https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00321.html) * doc/lispref/text.texi (Mode-Specific Indent): Update. @@ -87675,7 +87675,7 @@ Import the latest IVD_Sequences.txt * admin/unidata/IVD_Sequences.txt: New version from - http://www.unicode.org/ivd/, the 2017-12-12 version of the Unicode + https://www.unicode.org/ivd/, the 2017-12-12 version of the Unicode Ideographic Variation Database. * src/macuvs.h: Regenerated. @@ -87989,7 +87989,7 @@ * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Pass basename of target-file to make-temp-file, in case target-file includes a leading directory that might not exist under TMPDIR. See - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00680.html + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00680.html for the details. 2017-12-02 Michael Albinus <michael.albinus@gmx.de> @@ -88280,7 +88280,7 @@ 2017-11-26 Paul Eggert <eggert@cs.ucla.edu> - maint: shorten https://lists.gnu.org/archive/html/... links + maint: shorten https://lists.gnu.org/r/... links 2017-11-26 Paul Eggert <eggert@cs.ucla.edu> @@ -88288,7 +88288,7 @@ This incorporates: 2017-11-23 stat: work around Solaris bug with tv_nsec < 0 - 2017-11-12 maint: shorten https://lists.gnu.org/archive/html/... links + 2017-11-12 maint: shorten https://lists.gnu.org/r/... links * build-aux/config.sub, doc/misc/texinfo.tex, lib/allocator.h: * lib/fstatat.c, lib/intprops.h, lib/lstat.c, lib/signal.in.h: * lib/stat-time.h, lib/stdio-impl.h, lib/stdio.in.h: @@ -88670,7 +88670,7 @@ * lisp/calc/calc-aent.el (math-read-token): Make sure the match against "0[xX][0-9a-fA-F]+" is found at math-exp-pos. See - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00174.html + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00174.html for the details. 2017-11-18 Eli Zaretskii <eliz@gnu.org> @@ -88984,7 +88984,7 @@ * lisp/files.el (find-file, find-file-other-window) (find-file-other-frame): Mention file-name-at-point-functions in the doc string. Reported by Florian Weimer <fw@deneb.enyo.de> in - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00224.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00224.html. * doc/emacs/mini.texi (Minibuffer History): Document file-name-at-point-functions and its effect on M-n when typing @@ -89542,7 +89542,7 @@ arbitrary buffers where this variable's value doesn't make sense. For a way to trigger a problem due to this, see discussion starting in - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00645.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00645.html * lisp/textmodes/tex-mode.el (tex-chktex): Use with-current-buffer. @@ -90003,7 +90003,7 @@ 2017-10-27 Eli Zaretskii <eliz@gnu.org> - Improve documentation of how faces are applied to display stings + Improve documentation of how faces are applied to display strings * doc/lispref/display.texi (Displaying Faces): Describe how the faces of the "underlying" text affect overlay and display strings. @@ -90150,13 +90150,13 @@ * configure.ac (CYGWIN_OBJ): Leave empty on QNX. Problem reported by Elad Lahav in: - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00750.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00750.html 2017-10-26 Dmitry Gutov <dgutov@yandex.ru> Fix two js indentation problems - Fix intentation problems reported in + Fix indentation problems reported in https://github.com/mooz/js2-mode/issues/463. * lisp/progmodes/js.el (js--continued-expression-p): Check syntax state after /. @@ -90242,9 +90242,9 @@ Port to QNX Simplified version of a patch proposed by Elad Lahav in: - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00716.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00716.html which is based on a previous patch I proposed in: - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00707.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00707.html * configure.ac (opsys, CFLAGS, LIBS_SYSTEM, hybrid_malloc) (system_alloc, FIRST_PTY_LETTER, CYGWIN_OBJ): Set appropriately for QNX. @@ -90637,7 +90637,7 @@ Augment Flymake API for third-party extensions See - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00619.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00619.html * doc/misc/flymake.texi (Flymake error types): Rewrite example. @@ -91060,9 +91060,9 @@ Do not under-align pseudovectors Problem reported by Fabrice Popineau in: - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00357.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00357.html Also see diagnosis by Eli Zaretskii in: - https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00476.html + https://lists.gnu.org/r/emacs-devel/2017-10/msg00476.html * src/alloc.c (vector_alignment): Now a multiple of alignof (max_align_t). @@ -92604,7 +92604,7 @@ flymake.el knows nothing about line/column diagnostics (except for backward-compatible flymake-ler-make-ler, which must yet be tested). - It’s also the backend’s reponsibility to compute a BEG and END + It’s also the backend’s responsibility to compute a BEG and END positions for the diagnostic in the relevant buffer. * lisp/progmodes/flymake-proc.el @@ -92739,7 +92739,7 @@ For essential properties like `severity', `priority', etc, a default value is produced. Some properties like `evaporate' cannot be - overriden. + overridden. * lisp/progmodes/flymake.el (flymake--diag): Rename from flymake-ler. @@ -93382,7 +93382,7 @@ Bring back the busy wait after x_make_frame_visible (Bug#25521) - But wait specfically for a MapNotify event, and only for a + But wait specifically for a MapNotify event, and only for a configurable amount of time. * src/xterm.c (syms_of_xterm) [x-wait-for-event-timeout]: New variable. @@ -94709,7 +94709,7 @@ (tramp-test12-rename-file, tramp-test15-copy-directory) (tramp-test21-file-links): Extend tests. (tramp-test13-make-directory, tramp-test14-delete-directory): - Specifiy error symbol in `should-error'. + Specify error symbol in `should-error'. 2017-09-12 Mark Oteiza <mvoteiza@udel.edu> @@ -94735,7 +94735,7 @@ Include sxhash of object with printed bytecode - This printing, while succint, is rather opaque. At least give an + This printing, while succinct, is rather opaque. At least give an immediate clue of whether different byte code printouts are for the same or different byte code objects. * lisp/emacs-lisp/cl-print.el (cl-print-object): Add object sxhash to @@ -95280,7 +95280,7 @@ Problem reported by Angelo Graziosi in: https://lists.gnu.org/r/emacs-devel/2017-09/msg00045.html - * autogen.sh (git_config): Do not execut 'git' if $do_git fails. + * autogen.sh (git_config): Do not execute 'git' if $do_git fails. 2017-09-07 Glenn Morris <rgm@gnu.org> @@ -97350,7 +97350,7 @@ Improve make-temp-file performance on local files For the motivation behind this patch, please see Bug#28023 and: - http://emacshorrors.com/posts/make-temp-name.html + https://emacshorrors.com/posts/make-temp-name.html Although, given the recent changes to Tramp, the related security problem in make-temp-file is already fixed, make-temp-file still has several unnecessary system calls. In the typical case on GNU/Linux, @@ -97597,13 +97597,13 @@ 2017-08-09 Tino Calancha <tino.calancha@gmail.com> - dired-delete-file: Dont't ask for empty dirs + dired-delete-file: Don't ask for empty dirs * lisp/dired.el (dired--yes-no-all-quit-help): New defun. - (dired-delete-file): Use it. Dont't ask for empty dirs (Bug#27940). + (dired-delete-file): Use it. Don't ask for empty dirs (Bug#27940). * test/lisp/dired-tests.el (dired-test-with-temp-dirs): - New auxiliar macro. + New auxiliary macro. (dired-test-bug27940): Add new test. 2017-08-09 Tino Calancha <tino.calancha@gmail.com> @@ -97928,7 +97928,7 @@ Show help message when user inputs 'help'. (dired-do-flagged-delete): Bind locally dired-recursive-deletes so that we can overwrite its global value. - Wrapp the loop within a catch '--delete-cancel to catch when + Wrap the loop within a catch '--delete-cancel to catch when the user abort the directtry deletion. * doc/emacs/dired.texi (Dired Deletion): Update manual. * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 26.1): @@ -98908,7 +98908,7 @@ * lisp/net/shr.el (shr-put-image): Display svg images as svg (bug#27799). I suspect the previous change was checked in by - accident in conjuction with some other svg changes. + accident in conjunction with some other svg changes. 2017-07-23 Michael Albinus <michael.albinus@gmx.de> @@ -99358,7 +99358,7 @@ * doc/misc/ses.texi (Configuring what printer function applies): Add description of keys for completing local printer symbols and listing local printers in a help buffer. - (Formulas): Add decription for key to list the named cell + (Formulas): Add description for key to list the named cell symbols in a help buffer. * lisp/ses.el (ses-completion-keys): New constant. @@ -100624,7 +100624,7 @@ * src/image.c (xbm_scan): * src/lread.c (read_escape): * src/regex.c (ISXDIGIT) [emacs]: - Use char_hexdigit insted of doing it by hand. + Use char_hexdigit instead of doing it by hand. 2017-07-06 Paul Eggert <eggert@cs.ucla.edu> @@ -100970,7 +100970,7 @@ Fix bug in yesterday's CC Mode commit. * lisp/progmodes/cc-mode.el (c-quoted-number-head-before-point): Check a - search has succeded before using the match data. + search has succeeded before using the match data. (c-quoted-number-head-before-point, c-quoted-number-head-after-point): Specify that the position of the extremity of the head or tail is in the match data. @@ -101677,13 +101677,13 @@ * src/nsfns.m (frame_parm_handler): Add entry for x_set_no_special_glyphs. (Fx_create_frame): Handle 'no-special-glyphs' parameter. - Intitialize new cursor types for dragging frame borders. + Initialize new cursor types for dragging frame borders. * src/nsterm.h (struct ns_output): Add new cursor types for dragging frame borders. * src/w32fns.c (w32_frame_parm_handlers): Add entry for x_set_no_special_glyphs. (Fx_create_frame): Handle 'no-special-glyphs' parameter. - Intitialize new cursor types for dragging frame borders. + Initialize new cursor types for dragging frame borders. * src/w32term.h (struct w32_output): Add new cursor types for dragging frame borders. * src/window.c (coordinates_in_window) @@ -103780,7 +103780,7 @@ Correct and isolate the todo-mode test environment This avoids having to set todo-mode variables globally in the test - file and prevents any exisiting user todo-mode files from influencing + file and prevents any existing user todo-mode files from influencing the tests. * test/lisp/calendar/todo-mode-tests.el: @@ -104671,7 +104671,7 @@ Fix and improve UI of scroll bar menu (bug#27047) In addition, since the Emacs manual writes "scroll bar", "tool - bar" and "menu bar", use this convention in the Show/Hide menues + bar" and "menu bar", use this convention in the Show/Hide menus and tooltips as well. * lisp/menu-bar.el (menu-bar-showhide-scroll-bar-menu): Make @@ -104823,7 +104823,7 @@ Remove s_client usage from tls.el * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client. - Ref http://bugs.debian.org/766397 + Ref https://bugs.debian.org/766397 https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html @@ -105415,7 +105415,7 @@ specifies how emacs should use tramp to find remote files. * doc/emacs/misc.texi (TCP Emacs server): New subsection describing - the various knobs to tune server.el for TCP opereation. + the various knobs to tune server.el for TCP operation. (emacsclient Options): Reference "TCP Emacs server" from description of --server-file. Document the new '--tramp' / '-T' options. * doc/emacs/emacs.texi (Top): Update the top-level menu. @@ -107262,7 +107262,7 @@ Remove s_client usage from tls.el * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client. - Ref http://bugs.debian.org/766397 + Ref https://bugs.debian.org/766397 https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html 2017-04-25 Glenn Morris <rgm@gnu.org> @@ -107412,7 +107412,7 @@ instead of the sexp beginning position. Saving the CONTAINING-SEXP-START returned by `calculate-lisp-indent' is no longer needed. Don't bother stopping if we don't descend below init-depth, - since we now alway scan the whole buffer (via syntax-ppss) anyway. + since we now always scan the whole buffer (via syntax-ppss) anyway. * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp): Add blank line to test case. @@ -107708,7 +107708,7 @@ * lisp/emacs-lisp/ert.el (ert--expand-should-1): Avoid errors related to undefined byte-compile-macro-environment. Somehow masked until very recently because loading seq (eg) - loads bytecomp. http://hydra.nixos.org/build/51730765 + loads bytecomp. https://hydra.nixos.org/build/51730765 2017-04-18 Eli Zaretskii <eliz@gnu.org> @@ -108380,7 +108380,7 @@ * test/lisp/emacs-lisp/package-tests.el (with-package-test): Also bind package-gnupghome-dir, see eg - http://hydra.nixos.org/build/51462182 . + https://hydra.nixos.org/build/51462182 . 2017-04-11 Martin Rudalics <rudalics@gmx.at> @@ -109144,7 +109144,7 @@ * doc/lispref/records.texi (Records): reference it. Document behavior when type slot is a record. - * admin/alloc-colors.c (Fmake_record, Frecord): mention type desciptors. + * admin/alloc-colors.c (Fmake_record, Frecord): mention type descriptors. 2017-04-06 Stefan Monnier <monnier@iro.umontreal.ca> @@ -110325,7 +110325,7 @@ * lisp/progmodes/sql.el: Version 3.6 - (sql-login-params): Added :must-match for completition of + (sql-login-params): Added :must-match for completion of `server' and `database' login parameters. (sql-sqlite-login-params, sql-postgres-login-params): Set :must-match to `confirm'. @@ -113197,7 +113197,7 @@ The [5ec3a584: Generate upcase and downcase tables from Unicode data] commit broke bootstrap from a truly clean tree (e.g. a fresh clone or one created with ‘make extraclean’), see - <http://hydra.nixos.org/build/48774928>. + <https://hydra.nixos.org/build/48774928>. The failure was caused by characters.el trying to read Unicode property tables which aren’t available so early in the build process. @@ -113373,7 +113373,7 @@ casefiddle-tests-case-table, casefiddle-tests-casing-character, casefiddle-tests-casing, casefiddle-tests-casing-byte8, casefiddle-tests-casing-byte8-with-changes): New tests. - (casefiddle-tests--test-casing): New helper function for runnig + (casefiddle-tests--test-casing): New helper function for running some of the tests. 2017-02-15 Michal Nazarewicz <mina86@mina86.com> @@ -113897,7 +113897,7 @@ * lisp/eshell/esh-proc.el (eshell-sentinel): If called while still handling output of the process, make sure to close the pipes only later, - so that the next process in the pipeline recieves EOF only after getting + so that the next process in the pipeline receives EOF only after getting all its input (Bug#25549). 2017-02-09 Katsumi Yamaoka <yamaoka@jpl.org> @@ -114927,7 +114927,7 @@ 2017-01-28 Yuri D'Elia <wavexx@thregr.org> - Subject: Check Bcc after the Messag hook has run + Subject: Check Bcc after the Message hook has run * lisp/gnus/message.el (message-send): If the hook modifies the message (mml tags or headers), we should check bcc on the @@ -116519,7 +116519,7 @@ Clarify major mode switching * doc/emacs/modes.texi (Major Modes): - * doc/lispref/modes.texi (Modes, Major Modes): Explictly say that each + * doc/lispref/modes.texi (Modes, Major Modes): Explicitly say that each buffer has exactly one major mode and can't be "turned off", only switched away from (Bug#25357). @@ -119501,7 +119501,7 @@ merge from trunk - this merges frmo trunk and fixes various build issues. + this merges from trunk and fixes various build issues. this needed a few ugly tweaks. this hangs in "make check" now @@ -120142,7 +120142,7 @@ Since 2016-06-26 "Fix test-completion with completion-regexp-list", when calling test-completion with an alist collection, the predicate was - recieving the string value instead of the alist entry (Bug#24966). + receiving the string value instead of the alist entry (Bug#24966). * src/minibuf.c (Ftest_completion): Don't modify the found element, just test STRING against `completion-regexp-list'. @@ -122075,7 +122075,7 @@ Support zstd compressed files * lisp/jka-cmpr-hook.el (jka-compr-compression-info-list): Add - zstd compression info: <http://facebook.github.io/zstd/>. + zstd compression info: <https://facebook.github.io/zstd/>. (jka-compr-mode-alist-additions): Handle .tzst suffix for zstd compressed tar archives. (Bug#24853) @@ -124470,7 +124470,7 @@ 2016-09-12 Michal Nazarewicz <mina86@mina86.com> - Fix compiler thinking width and height may be unitialized in frame.c + Fix compiler thinking width and height may be uninitialized in frame.c This fixes the following warning: @@ -124486,7 +124486,7 @@ 2016-09-12 Michal Nazarewicz <mina86@mina86.com> - Fix compiler thinking tmpdir may be unitialized in emacsclient + Fix compiler thinking tmpdir may be uninitialized in emacsclient This fixes the following warning: @@ -124669,7 +124669,7 @@ Invert y coord of NS image files (bug#7847) - * src/nsterm.m (ns_dumpglyphs_image): Invert y co-ordinate of the image + * src/nsterm.m (ns_dumpglyphs_image): Invert y coordinate of the image when compositing. 2016-09-10 Noam Postavsky <npostavs@gmail.com> @@ -124701,7 +124701,7 @@ determine which class is failing. This happens when failure is caused by ‘(should (equal (point) (point-max)))’ not being met. - With per-character class tests, it is immidiatelly obvious which test + With per-character class tests, it is immediately obvious which test causes issues plus tests for all classes are run even if some of them fail. @@ -125756,7 +125756,7 @@ * lisp/emacs-lisp/map.el (map--dispatch): Fix docstring - The docstring referenced a non-existant parameter, as well as a + The docstring referenced a non-existent parameter, as well as a parameter that has been renamed since the docstring was written. Fix both errors, fixing (Bug#24182). @@ -125828,7 +125828,7 @@ * lisp/window.el (window--state-put-2): Set 'noforce argument when restoring a window's start position. This avoids that the - effect of `set-window-point' gets overidden by that of + effect of `set-window-point' gets overridden by that of `set-window-start' (Bug#24240). 2016-08-17 Alan Mackenzie <acm@muc.de> @@ -126205,7 +126205,7 @@ * doc/misc/ses.texi (Quick Tutorial): Mention the '!' 'ses-range' modifier as an alternative to 'ses+'. - (Advanced Features): Add a refernce to node 'Nonrelocatable + (Advanced Features): Add a reference to node 'Nonrelocatable references' concerning function 'ses-rename-cell'. (Standard formula functions): Mention the '!' 'ses-range' modifier as an alternative to 'ses-delete-blanks'. @@ -126449,7 +126449,7 @@ 2016-08-06 Michael Albinus <michael.albinus@gmx.de> - Add missing dcstrings in Tramp, remove chec for obsolee methods + Add missing dcstrings in Tramp, remove check for obsolee methods * lisp/net/tramp.el (tramp-progress-reporter-update) (tramp-unload-file-name-handlers, tramp-get-local-uid) @@ -128859,7 +128859,7 @@ Call `file-name-directory' also for remote NEWNAME. * test/lisp/net/tramp-tests.el (tramp-test15-copy-directory): - Do not skip for tramp-smb.el. Test als COPY-CONTENTS case. + Do not skip for tramp-smb.el. Test also COPY-CONTENTS case. (tramp-test24-file-name-completion): Improve check for hostname completion. (tramp--test-rsync-p): New defun. @@ -129664,7 +129664,7 @@ * lisp/international/ucs-normalize.el (ucs-normalize-hfs-nfd-pre-write-conversion): - Prevent compiler warning for unused arguments, add coment. + Prevent compiler warning for unused arguments, add comment. 2016-06-10 Paul Eggert <eggert@cs.ucla.edu> @@ -130352,7 +130352,7 @@ * lisp/wid-edit.el (link): Remove :follow-link property (bug#22434) - * lisp/recentf.el (recentf-dialog-mode-map): Remove unecessary mapping. + * lisp/recentf.el (recentf-dialog-mode-map): Remove unnecessary mapping. 2016-05-29 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -131429,7 +131429,7 @@ 4c5a00b Make package-install-from-buffer not move point 9596ea1 ; Revert "* emacs-lisp/lisp-mnt.el (lm-header): save-excursion" f79c352 Redo the fix for bug#21839 - 8d2f78c Don't treat JS spread as contination method call + 8d2f78c Don't treat JS spread as continuation method call 2016-05-12 Chris Feng <chris.w.feng@gmail.com> @@ -132526,7 +132526,7 @@ cursor-type doc fix * src/buffer.c (syms_of_buffer): Mention that cursor-type's - WIDHT/HEIGHT can't exceed the frame char size (bug#19215). + WIDTH/HEIGHT can't exceed the frame char size (bug#19215). 2016-04-30 Lars Ingebrigtsen <larsi@gnus.org> @@ -132608,7 +132608,7 @@ 2016-04-30 Lars Ingebrigtsen <larsi@gnus.org> - Explictly explain that package-initialize loads the packages + Explicitly explain that package-initialize loads the packages * lisp/emacs-lisp/package.el (package-initialize): Be explicit in saying that `package-initialize' obviates adjusting the @@ -132892,7 +132892,7 @@ Fix definition of nobreak-space * lisp/faces.el (nobreak-space): The definition to - nobreak-space was inadvertantly changed by the previous checkin. + nobreak-space was inadvertently changed by the previous checkin. 2016-04-28 Lars Ingebrigtsen <larsi@gnus.org> @@ -133217,9 +133217,9 @@ calling `vc-state' on default-directory (VC state is undefined for directories). Check that `vc-state' returns nil where it returned `unregistered' before. Remove all checks comparing - invocations with the backend passed in explictly and without. + invocations with the backend passed in explicitly and without. (vc-test--working-revision): Remove all checks comparing - invocations with the backend passed in explictly and without. + invocations with the backend passed in explicitly and without. Update comments, and add a new one. 2016-04-24 Paul Eggert <eggert@cs.ucla.edu> @@ -133845,7 +133845,7 @@ 2016-04-10 Etienne Prud'homme <e.e.f.prudhomme@gmail.com> (tiny change) - Fix alignement rule for CSS + Fix alignment rule for CSS * lisp/align.el (align-rules-list): Support CSS properties that have multiple words. @@ -134121,7 +134121,7 @@ a3daa34 Teach M-x disassemble a default argument. e30c3e9 Fix EOL decoding in vc-annotate with SVN back-end on MS-Windows df441b3 Fix OS X specific settings in tramp-tests - 2244331 Finish fixing a cacheing bug in CC Mode (see 2016-03-09) + 2244331 Finish fixing a caching bug in CC Mode (see 2016-03-09) # Conflicts: # lisp/net/tramp-sh.el @@ -134272,7 +134272,7 @@ 0403620 Don't misindent arguments of a method call inside continuation e6776f8 * src/keyboard.c (echo_keystrokes_p): Don't test cursor_in_ec... 8475f3d ASCII-only etc/NEWS etc. - 5cc6919 Fix a cacheing bug, which led to inordinately slow c-beginnin... + 5cc6919 Fix a caching bug, which led to inordinately slow c-beginnin... 0ce37ea Fix Isearch prompt when invoked with an argument f3033d4 Fix a typo in the Emacs manual 4235d2d Curved quotes in etc/NEWS etc. @@ -137965,7 +137965,7 @@ 2016-02-10 Lars Ingebrigtsen <larsi@gnus.org> - Remove som XEmacs compat code from message.el + Remove some XEmacs compat code from message.el * lisp/gnus/message.el: Remove some XEmacs compat code. @@ -138403,7 +138403,7 @@ a header while with nil argument moves to the indented text of header's value. (message-beginning-of-line): Function is now aware of folded headers and - either moves point to the indention of a header or, in visual-line-mode, + either moves point to the indentation of a header or, in visual-line-mode, searches for the beginning of the header. 2016-02-08 Michal Nazarewicz <mina86@mina86.com> @@ -139254,7 +139254,7 @@ (History): XEmacs support has been removed. (GVFS based methods, Remote processes): Do not use emacsgvfs flag. (Auto-save and Backup): Use both syntax versions. - (File name Syntax): Remark on IPv6 adresses is valid for + (File name Syntax): Remark on IPv6 addresses is valid for unified syntax only. * doc/misc/trampver.texi: Do not set emacsgvfs flag. @@ -140661,7 +140661,7 @@ put-text-property cannot be plainly (point), you need a ses-goto-print call before - - Second, the range itself was computed erronously, only the first + - Second, the range itself was computed erroneously, only the first char was affected instead of the full cell width. This was not noticeable prior to changes (Deprecate `intangible' and `point-entered' properties) made by Stefan on 2015-04-13T19:51:15Z @@ -142220,7 +142220,7 @@ the problems described in bug#20674 regarding the interaction with modes such as darkroom-mode and olivetti-mode. - A similar fix was commited to nlinum.el in ELPA.git's + A similar fix was committed to nlinum.el in ELPA.git's e7f5f549fbfb740b911fb7f33b42381ecece56d8 * lisp/linum.el (linum-delete-overlays): Restore margins more @@ -147,7 +147,9 @@ lisp/ps-mule.el defines the *.bdf font files required for printing each character set. The intlfonts distribution contains its own installation instructions, -in the intlfonts/README file. +in the intlfonts/README file. See also the Emacs Frequently Asked +Questions info pages "(efaq) How to add fonts" for installation +instructions. * Image support libraries diff --git a/admin/ChangeLog.1 b/admin/ChangeLog.1 index 3cbc9ebbd44..64c65bdd12c 100644 --- a/admin/ChangeLog.1 +++ b/admin/ChangeLog.1 @@ -181,7 +181,7 @@ * grammars/c.by (opt-brackets-after-symbol): New. (multi-stage-dereference): Use it. Add rules for explicit - matching the last dereference. We cannot just juse + matching the last dereference. We cannot just use 'namespace-symbol' as a single rule, since this would match too greedy and mess with parsing default values of variables. @@ -1258,7 +1258,7 @@ 2012-06-13 Andreas Schwab <schwab@linux-m68k.org> * make-emacs: Rename --union-type to --check-lisp-type. - Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE. + Define CHECK_LISP_OBJECT_TYPE instead of USE_LISP_UNION_TYPE. * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Rename from USE_LISP_UNION_TYPE. @@ -1629,10 +1629,10 @@ 2010-09-05 Juanma Barranquero <lekktu@gmail.com> * unidata/BidiMirroring.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt + https://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt * unidata/UnicodeData.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt + https://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt 2010-08-09 Andreas Schwab <schwab@linux-m68k.org> @@ -1668,7 +1668,7 @@ * unidata/bidimirror.awk: New file. * unidata/BidiMirroring.txt: New file from - http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt. + https://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt. * unidata/Makefile.in (../../src/bidimirror.h): New target. (all): Depend on ../../src/biditype.h and ../../src/bidimirror.h. @@ -1685,7 +1685,7 @@ 2010-06-09 Juanma Barranquero <lekktu@gmail.com> * unidata/UnicodeData.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d5.txt + https://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d5.txt 2010-05-27 Glenn Morris <rgm@gnu.org> @@ -2031,7 +2031,7 @@ * unidata/unidata-gen.el: New file. * unidata/UnicodeData.txt: New file. Copied from - http://www.unicode.org on 2006-05-23. + https://www.unicode.org on 2006-05-23. * unidata/.cvsignore: New file. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index f7ec181bf9c..53afe87a0f8 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -213,6 +213,7 @@ Paul Eggert src/* (except for *.m, *w32*, bitmaps, files others want to maintain) Michael Albinus + .gitlab-ci.yml src/inotify.c lisp/autorevert.el lisp/eshell/em-tramp.el diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README index fe1d07f4f98..c3205672d19 100644 --- a/admin/charsets/mapfiles/README +++ b/admin/charsets/mapfiles/README @@ -20,7 +20,7 @@ Available at: * PTCP154 Available at: - <http://www.iana.org/assignments/charset-reg/PTCP154> + <https://www.iana.org/assignments/charset-reg/PTCP154> * Uni2JIS @@ -50,8 +50,8 @@ Available at: * CP720.map and CP858.map Created manually by looking at these pages: - <http://en.wikipedia.org/wiki/Code_page_720>. - <http://en.wikipedia.org/wiki/Code_page_859>. + <https://en.wikipedia.org/wiki/Code_page_720>. + <https://en.wikipedia.org/wiki/Code_page_859>. The text in that page is under the terms of the GNU Free Documentation License. diff --git a/admin/cus-test.el b/admin/cus-test.el index 842240946eb..b4e4b426515 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -347,7 +347,7 @@ Optional argument ALL non-nil means list all (non-obsolete) Lisp files." ;; Hack to remove leading "./". (mapcar (lambda (e) (substring e 2)) (apply 'process-lines find-program - "-name" "obsolete" "-prune" "-o" + "." "-name" "obsolete" "-prune" "-o" "-name" "[^.]*.el" ; ignore .dir-locals.el (if all '("-print") @@ -370,7 +370,9 @@ This function is suitable for batch mode. E.g., invoke in the Emacs source directory. Normally only tests options belonging to files in loaddefs.el. -If optional argument ALL is non-nil, test all files with defcustoms." +If optional argument ALL is non-nil, test all files with defcustoms. + +Returns a list of variables with suspicious types." (interactive) (and noninteractive command-line-args-left @@ -382,9 +384,12 @@ If optional argument ALL is non-nil, test all files with defcustoms." (message "Running %s" 'cus-test-apropos) (cus-test-apropos "") (if (not cus-test-errors) - (message "No problems found") + (progn + (message "No problems found") + nil) (message "The following options might have problems:") - (cus-test-message cus-test-errors))) + (cus-test-message cus-test-errors) + cus-test-errors)) (defun cus-test-deps () "Run a verbose version of `custom-load-symbol' on all atoms. diff --git a/admin/find-gc.el b/admin/find-gc.el index 9bab3776a51..7de2474b828 100644 --- a/admin/find-gc.el +++ b/admin/find-gc.el @@ -73,8 +73,8 @@ Also store it in `find-gc-unsafe-list'." (find-unsafe-funcs 'Fgarbage_collect) (setq find-gc-unsafe-list (sort find-gc-unsafe-list - (function (lambda (x y) - (string-lessp (car x) (car y))))))) + (lambda (x y) + (string-lessp (car x) (car y)))))) ;;; This does a depth-first search to find all functions that can ;;; ultimately call the function "target". The result is an a-list diff --git a/admin/release-process b/admin/release-process index 73879b13f08..4d973d33610 100644 --- a/admin/release-process +++ b/admin/release-process @@ -195,6 +195,17 @@ pt-br Rodrigo Real ru Alex Ott sk Miroslav Vaško +** Update some files from their upstream. + +Some files in Emacs are copies of data files maintained elsewhere. +Make sure that they are reasonably up-to-date. + +- etc/publicsuffix.txt +https://publicsuffix.org/list/public_suffix_list.dat + +- leim/SKK-DIC/SKK-JISYO.L +https://raw.githubusercontent.com/skk-dev/dict/master/SKK-JISYO.L + * BUGS ** Check for modes which bind M-s that conflicts with a new global binding M-s diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 73453cb9e47..510bb7959f1 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -77,7 +77,7 @@ ;; 2nd: function to call to get a property value, ;; or an index number of C function to decode the value, ;; or nil if the value can be directly got from the table. -;; 3nd: function to call to put a property value, +;; 3rd: function to call to put a property value, ;; or an index number of C function to encode the value, ;; or nil if the value can be directly stored in the table. ;; 4th: function to call to get a description of a property value, or nil @@ -1177,7 +1177,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-describe-general-category (val) (cdr (assq val - '((nil . "Uknown") + '((nil . "Unknown") (Lu . "Letter, Uppercase") (Ll . "Letter, Lowercase") (Lt . "Letter, Titlecase") diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs index 336029fb710..96712f0b32e 100755 --- a/build-aux/update-subdirs +++ b/build-aux/update-subdirs @@ -26,7 +26,7 @@ for file in *; do *.elc | *.el | term | RCS | CVS | Old | . | .. | =* | *~ | *.orig | *.rej) ;; *) - if [ -d $file ]; then + if [ -d "$file" ]; then if [ "$file" = "obsolete" ]; then subdirs="$subdirs \"$file\"" else diff --git a/configure.ac b/configure.ac index 0bcff587e8a..f0c8e5210f9 100644 --- a/configure.ac +++ b/configure.ac @@ -453,7 +453,7 @@ OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing]) OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([native-image-api], [don't use native image APIs (GDI+ on Windows)]) -OPTION_DEFAULT_IFAVAILABLE([json], [don't compile with native JSON support]) +OPTION_DEFAULT_IFAVAILABLE([json], [compile with native JSON support]) OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping]) @@ -724,7 +724,7 @@ case "${canonical}" in *-apple-darwin* ) case "${canonical}" in *-apple-darwin[0-9].*) unported=yes ;; - i[3456]86-* | x86_64-* | arm-* ) ;; + i[3456]86-* | x86_64-* | arm-* | aarch64-* ) ;; * ) unported=yes ;; esac opsys=darwin @@ -785,10 +785,7 @@ case "${canonical}" in *-nto-qnx* ) opsys=qnxnto test -z "$CC" && CC=qcc - CFLAGS="$CFLAGS -D__NO_EXT_QNX" - if test "$with_unexec" = yes; then - LDFLAGS="-N2MB $LDFLAGS" - fi + LDFLAGS="-N2M $LDFLAGS" ;; ## Intel 386 machines where we don't care about the manufacturer. diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1 index 3513c6616f0..cf641beec1f 100644 --- a/doc/emacs/ChangeLog.1 +++ b/doc/emacs/ChangeLog.1 @@ -2206,7 +2206,7 @@ Describe group levels more clearly. (Gnus Group Buffer, Gnus Summary Buffer): New nodes, split from Summary of Gnus. - (Document View): Copyedits. Move zoom commads to DocView + (Document View): Copyedits. Move zoom commands to DocView Navigation node. (DocView Navigation, DocView Searching, DocView Slicing) (DocView Conversion): Nodes renamed from Navigation, etc. @@ -10290,7 +10290,7 @@ * buffers.texi (Misc Buffer): Explain use of M-x rename-uniquely for multiple compile and grep buffers. - (Indirect Buffers): Don't recommand clone-indirect-buffer + (Indirect Buffers): Don't recommend clone-indirect-buffer for multiple compile and grep buffers. 2004-02-29 Juanma Barranquero <lektu@terra.es> diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi index 21bf8c53325..e3766aae9e8 100644 --- a/doc/emacs/abbrevs.texi +++ b/doc/emacs/abbrevs.texi @@ -28,6 +28,7 @@ Automatic Typing}. * Abbrev Concepts:: Fundamentals of defined abbrevs. * Defining Abbrevs:: Defining an abbrev, so it will expand when typed. * Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion. +* Abbrevs Suggestions:: Get automatic suggestions about defined abbrevs. * Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs. * Saving Abbrevs:: Saving the entire list of abbrevs for another session. * Dynamic Abbrevs:: Abbreviations for words already in the buffer. @@ -223,6 +224,38 @@ changing this function you can make arbitrary changes to the abbrev expansion. @xref{Abbrev Expansion,,, elisp, The Emacs Lisp Reference Manual}. +@node Abbrevs Suggestions +@section Abbrevs Suggestions + + You can get abbrev suggestions when you manually type text for which +there is currently an active defined abbrev. For example, if there is +an abbrev @samp{foo} with the expansion @samp{find outer otter}, and +you manually type @samp{find outer otter}, Emacs can notice this and +show a hint in the echo area when you have stopped typing. + +@vindex abbrev-suggest + To enable the abbrev suggestion feature, customize the option +@code{abbrev-suggest} to a non-@code{nil} value. + +@vindex abbrev-suggest-hint-threshold + The variable @code{abbrev-suggest-hint-threshold} controls when to +suggest an abbrev to the user. This variable defines the minimum +savings (in terms of the number of characters the user will not have +to type) required for Emacs to suggest using an abbrev. For example, +if the user types @samp{foo bar} (seven characters) and there is an +abbrev @samp{fubar} defined (five characters), the user will not get +any suggestion unless the threshold is set to the number 2 or lower. +With the default value 3, the user would not get any suggestion in +this example, because the savings in using the abbrev are below +the threshold. If you always want to get abbrev suggestions, set this +variable's value to zero. + +@findex abbrev-suggest-show-report + The command @code{abbrev-suggest-show-report} displays a buffer with +all the abbrev suggestions shown during the current editing session. +This can be useful if you get several abbrev suggestions and don't +remember them all. + @node Editing Abbrevs @section Examining and Editing Abbrevs diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index c6224885df3..4658cd4723e 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -13,16 +13,15 @@ written substantial portions. Others too numerous to mention have reported and fixed bugs, and added features to many parts of Emacs. We thank them for their generosity as well. -This list is intended to mention every contributor of a major package or -feature we currently distribute; if you know of someone we have omitted, -please make a bug report. More comprehensive information is -available in the @file{ChangeLog} files, summarized in the file -@file{etc/AUTHORS} in the distribution. +This list is intended to mention every contributor of a major package +or feature; if you know of someone we have omitted, please make a bug +report. More comprehensive information is available in the +@file{ChangeLog} files, summarized in the file @file{etc/AUTHORS} in +the distribution. @c We should list here anyone who has contributed a new package, @c and anyone who has made major enhancements in Emacs @c that many users would notice and consider important. -@c Remove things that are no longer distributed. @c Note this file is only used ifnottex; otherwise a shorter version in @c emacs.texi is used. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 0b685fafe9c..2e03d0c04a3 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -311,13 +311,16 @@ Position 1 is the beginning of the buffer. @kindex M-g M-g @kindex M-g g @findex goto-line +@findex goto-line-relative Read a number @var{n} and move point to the beginning of line number @var{n} (@code{goto-line}). Line 1 is the beginning of the buffer. If point is on or just after a number in the buffer, that is the default for @var{n}. Just type @key{RET} in the minibuffer to use it. You can also specify @var{n} by giving @kbd{M-g M-g} a numeric prefix argument. @xref{Select Buffer}, for the behavior of @kbd{M-g M-g} when you give it -a plain prefix argument. +a plain prefix argument. Alternatively, you can use the command +@code{goto-line-relative} to move point to the line relative to the +accessible portion of the narrowed buffer. @item M-g @key{TAB} @kindex M-g TAB @@ -461,6 +464,15 @@ Normally, this command undoes the last change, moving point back to where it was before the change. The undo command applies only to changes in the buffer; you can't use it to undo cursor motion. + On a terminal that supports the @key{Control} modifier on all other +keys, the easiest way to invoke @code{undo} is with @kbd{C-/}, since +that doesn't need the @key{Shift} modifier. On terminals which allow +only the ASCII control characters, @kbd{C-/} does not exist, but for +many of them @kbd{C-/} still works because it actually sends @kbd{C-_} +to Emacs, while many others allow you to omit the @key{Shift} modifier +when you type @kbd{C-_} (in effect pressing @kbd{C--}), making that +the most convenient way to invoke @code{undo}. + Although each editing command usually makes a separate entry in the undo records, very simple commands may be grouped together. Sometimes, an entry may cover just part of a complex command. diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 89ed470c055..537c6536085 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -697,6 +697,17 @@ forward order after the file name, as in @samp{file|top/middle}. If @code{uniquify-buffer-name-style} is set to @code{nil}, the buffer names simply get @samp{<2>}, @samp{<3>}, etc.@: appended. + The value of @code{uniquify-buffer-name-style} can be set to a +customized function with two arguments @var{base} and +@var{extra-strings} where @var{base} is a string and +@var{extra-strings} is a list of strings. For example the current +implementation for @code{post-forward-angle-brackets} could be: + +@example +(defun my-post-forward-angle-brackets (base extra-string) + (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\")) +@end example + Which rule to follow for putting the directory names in the buffer name is not very important if you are going to @emph{look} at the buffer names before you type one. But as an experienced user, if you diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 7074bd45d71..3e09f243226 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -213,6 +213,8 @@ Select a buffer to be used by next invocation of @code{next-error} and @kindex M-g n @kindex C-x ` @findex next-error +@findex next-error-message +@vindex next-error-message-highlight @vindex next-error-highlight @vindex next-error-highlight-no-select To visit errors sequentially, type @w{@kbd{C-x `}} @@ -427,11 +429,16 @@ M-n}}, @key{RET}, and so forth, just like compilation errors. @xref{Compilation Mode}, for detailed description of commands and key bindings available in the @file{*grep*} buffer. +@vindex grep-match-regexp Some grep programs accept a @samp{--color} option to output special markers around matches for the purpose of highlighting. You can make use of this feature by setting @code{grep-highlight-matches} to @code{t}. When displaying a match in the source buffer, the exact match will be highlighted, instead of the entire source line. +Highlighting is provided via matching the @acronym{ANSI} escape +sequences emitted by @command{grep}. The matching of the sequences is +controlled by @code{grep-match-regexp}, which can be customized to +accommodate different @command{grep} programs. As with compilation commands (@pxref{Compilation}), while the grep command runs, the mode line shows the running number of matches found @@ -1665,21 +1672,26 @@ abbreviation of the output according to the variables argument of @code{-1} overrides the effect of @code{eval-expression-print-length}. + @kbd{C-x C-e} (@code{eval-last-sexp}) treats @code{defvar} +expressions specially. Normally, evaluating a @code{defvar} +expression does nothing if the variable it defines already has a +value. But this command unconditionally resets the variable to the +initial value specified by the @code{defvar}; this is convenient for +debugging Emacs Lisp programs. @code{defcustom} and @code{defface} +expressions are treated similarly. Note the other commands documented +in this section, except @code{eval-defun}, do not have this special +feature. + @kindex C-M-x @r{(Emacs Lisp mode)} @findex eval-defun The @code{eval-defun} command is bound to @kbd{C-M-x} in Emacs Lisp mode. It evaluates the top-level Lisp expression containing or following point, and prints the value in the echo area. In this context, a top-level expression is referred to as a ``defun'', but it -need not be an actual @code{defun} (function definition). In -particular, this command treats @code{defvar} expressions specially. -Normally, evaluating a @code{defvar} expression does nothing if the -variable it defines already has a value. But this command -unconditionally resets the variable to the initial value specified by -the @code{defvar}; this is convenient for debugging Emacs Lisp -programs. @code{defcustom} and @code{defface} expressions are treated -similarly. Note that the other commands documented in this section do -not have this special feature. +need not be an actual @code{defun} (function definition). + + This command handles @code{defvar}/@code{defcustom}/@code{defface} +forms the same way that @code{eval-last-sexp} does. With a prefix argument, @kbd{C-M-x} instruments the function definition for Edebug, the Emacs Lisp Debugger. @xref{Instrumenting, diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index a512fd14c80..fb60caa773b 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1582,6 +1582,13 @@ starts with @kbd{@key{ESC} [}.) If Emacs understands your terminal type properly, it automatically handles such sequences as single input events. + Key sequences that consist of @kbd{C-c} followed by a letter (upper +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 +never being shadowed by other Emacs bindings. + @node Prefix Keymaps @subsection Prefix Keymaps @@ -2679,7 +2686,7 @@ basename.) Emacs can also look in an XDG-compatible location for @file{init.el}, the default is the directory @file{~/.config/emacs}. This can be -overriden by setting @env{XDG_CONFIG_HOME} in your environment, its +overridden by setting @env{XDG_CONFIG_HOME} in your environment, its value replaces @file{~/.config} in the name of the default XDG init file. However @file{~/.emacs.d}, @file{~/.emacs}, and @file{~/.emacs.el} are always preferred if they exist, which means diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 19aaca962da..fdc4703e86f 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -109,6 +109,16 @@ the minibuffer (@pxref{Minibuffer History}). You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file}) a directory's name. +@findex dired-jump +@findex dired-jump-other-window +@kindex C-x C-j +@kindex C-x 4 C-j + Typing @kbd{C-x C-j} (@code{dired-jump}) in any buffer will open a +Dired buffer and move point to the line corresponding to the current +file. In Dired, move up a level and go to the previous directory's +line. Typing @kbd{C-x 4 C-j} (@code{dired-jump-other-window} has the +same effect but opens a new window for the Dired buffer. + The variable @code{dired-listing-switches} specifies the options to give to @command{ls} for listing the directory; this string @emph{must} contain @samp{-l}. If you use a prefix argument with the @@ -119,6 +129,17 @@ options (that is, single characters) requiring no arguments, and long options (starting with @samp{--}) whose arguments are specified with @samp{=}. +@vindex dired-switches-in-mode-line + Dired displays in the mode line an indication of what were the +switches used to invoke @command{ls}. By default, Dired will try to +determine whether the switches indicate sorting by name or date, and +will say so in the mode line. If the @code{dired-switches-in-mode-line} +variable is @code{as-is}, the switches will be shown verbatim. If +this variable's value is an integer, the switch display will be +truncated to that length. This variable can also be a function, which +will be called with @code{dired-actual-switches} as the only +parameter, and should return a string to display in the mode line. + @vindex dired-use-ls-dired If your @command{ls} program supports the @samp{--dired} option, Dired automatically passes it that option; this causes @command{ls} to diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index e7b8745a044..7dadb0966f2 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -244,6 +244,7 @@ point vertically in the window, but there are several ways to alter this behavior. @vindex scroll-conservatively +@vindex scroll-minibuffer-conservatively If you set @code{scroll-conservatively} to a small number @var{n}, then moving point just a little off the screen (no more than @var{n} lines) causes Emacs to scroll just enough to bring point back on @@ -255,6 +256,9 @@ moves; Emacs always scrolls text just enough to bring point into view, either at the top or bottom of the window depending on the scroll direction. By default, @code{scroll-conservatively} is@tie{}0, which means to always center point in the window. +This said, in minibuffer windows, scrolling is always conservative by +default because @code{scroll-minibuffer-conservatively} is non-nil, +which takes precedence over @code{scroll-conservatively}. @vindex scroll-step Another way to control automatic scrolling is to customize the @@ -1173,31 +1177,34 @@ right-to-left paragraphs. @cindex mode, display-fill-column-indicator @findex display-fill-column-indicator-mode @findex global-display-fill-column-indicator-mode - Emacs can add an indicator to display a fill column position. The -fill column indicator is a useful functionality especially in -@code{prog-mode} to indicate the position of a specific column. + Emacs can display an indication of the @code{fill-column} position +(@pxref{Fill Commands}). The fill-column indicator is a useful +functionality especially in @code{prog-mode} and its descendants +(@pxref{Major Modes}) to indicate the position of a specific column +that has some special meaning for formatting the source code of a +program. + + To activate the fill-column indication display, use the minor modes +@w{@kbd{M-x display-fill-column-indicator-mode}} and +@w{@kbd{M-x global-display-fill-column-indicator-mode}}, which enable +the indicator locally or globally, respectively. - You can set the buffer-local variables +Alternatively, you can set the two buffer-local variables @code{display-fill-column-indicator} and @code{display-fill-column-indicator-character} to activate the -indicator and control how it looks, respectively. +indicator and control the character used for the indication. Note +that both variables must be non-@code{nil} for the indication to be +displayed. (Turning on the minor mode sets both these variables.) -Alternatively you can type @w{@kbd{M-x display-fill-column-indicator-mode}} -or @w{@kbd{M-x global-display-fill-column-indicator-mode}} which -enables the indicator locally or globally, respectively, and also -chooses the character to use if none is already set. It is possible -to use the first one to activate the indicator in a hook and the -second one to enable it globally. - -There are 2 buffer local variables and 1 face to customize this mode: +There are 2 buffer local variables and a face to customize this mode: @table @code @item display-fill-column-indicator-column @vindex display-fill-column-indicator-column Specifies the column number where the indicator should be set. It can -take positive numerical values for the column or the special value -@code{t} which means that the variable @code{fill-column} will be -used. +take positive numerical values for the column, or the special value +@code{t}, which means that the value of the variable +@code{fill-column} will be used. Any other value disables the indicator. The default value is @code{t}. @@ -1205,18 +1212,18 @@ Any other value disables the indicator. The default value is @code{t}. @vindex display-fill-column-indicator-character Specifies the character used for the indicator. This character can be any valid character including Unicode ones if the font supports them. - -When the mode is enabled through the functions -@code{display-fill-column-indicator-mode} or -@code{global-display-fill-column-indicator-mode}, the initialization -functions check if this variable is non-@code{nil}, otherwise the -initialization tries to set it to @code{U+2502} or @samp{|}. +The value @code{nil} disables the indicator. When the mode is enabled +through the functions @code{display-fill-column-indicator-mode} or +@code{global-display-fill-column-indicator-mode}, they will use the +character specified by this variable, if it is non-@code{nil}; +otherwise Emacs will use the character @samp{U+2502 VERTICAL LINE}, +falling back to @samp{|} if @code{U+2502} cannot be displayed. @item fill-column-indicator @vindex fill-column-indicator Specifies the face used to display the indicator. It inherits its -default values from the face @code{shadow} but without background -color. To change the indicator color you need only set the foreground +default values from the face @code{shadow}, but without background +color. To change the indicator color, you need only set the foreground color of this face. @end table @@ -1452,9 +1459,10 @@ the displayed column number to count from one, you may set @cindex narrowing, and line number display If you have narrowed the buffer (@pxref{Narrowing}), the displayed line number is relative to the accessible portion of the buffer. -Thus, it isn't suitable as an argument to @code{goto-line}. (Use -@code{what-line} command to see the line number relative to the whole -file.) +Thus, it isn't suitable as an argument to @code{goto-line}. (The +command @code{what-line} shows the line number relative to the whole +file.) You can use @code{goto-line-relative} command to move point to +the line relative to the accessible portion of the narrowed buffer. @vindex line-number-display-limit If the buffer is very large (larger than the value of @@ -1604,7 +1612,8 @@ can cause problems if they are entered into a buffer without your realization, e.g., by yanking; for instance, source code compilers typically do not treat non-@acronym{ASCII} spaces as whitespace characters. To deal with this problem, Emacs displays such characters -specially: it displays @code{U+00A0} (no-break space) with the +specially: it displays @code{U+00A0} (no-break space) and other +characters from the Unicode horizontal space class with the @code{nobreak-space} face, and it displays @code{U+00AD} (soft hyphen), @code{U+2010} (hyphen), and @code{U+2011} (non-breaking hyphen) with the @code{nobreak-hyphen} face. To disable this, change diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 6aed7bd92a5..bd40e10052d 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -108,10 +108,9 @@ Cover art by Etienne Suvasa; cover design by Matt Lee. @node Top @top The Emacs Editor -Emacs is the extensible, customizable, self-documenting real-time -display editor. This manual describes how to edit with Emacs and -some of the ways to customize it; it corresponds to GNU Emacs version -@value{EMACSVER}. +Emacs is the advanced, extensible, customizable, self-documenting +editor. This manual describes how to edit with Emacs and some of the +ways to customize it; it corresponds to GNU Emacs version @value{EMACSVER}. @c See 'manual-html-mono' and 'manual-html-node' in admin/admin.el. @ifset WWW_GNU_ORG @@ -908,6 +907,7 @@ Abbrevs * Abbrev Concepts:: Fundamentals of defined abbrevs. * Defining Abbrevs:: Defining an abbrev, so it will expand when typed. * Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion. +* Abbrevs Suggestions:: Get automatic suggestions about defined abbrevs. * Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs. * Saving Abbrevs:: Saving the entire list of abbrevs for another session. * Dynamic Abbrevs:: Abbreviations for words already in the buffer. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 2fa1ecc003d..eb4353b6784 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -921,6 +921,7 @@ Manual}). For customizations, see the Custom group @code{time-stamp}. @node Reverting @section Reverting a Buffer @findex revert-buffer +@findex revert-buffer-with-fine-grain @cindex drastic changes @cindex reread a file @@ -941,6 +942,19 @@ reverted changes as a single modification to the buffer's undo history aliases to bring the reverted changes back, if you happen to change your mind. +@vindex revert-buffer-with-fine-grain-max-seconds + To revert a buffer more conservatively, you can use the command +@code{revert-buffer-with-fine-grain}. This command acts like +@code{revert-buffer}, but it tries to be as non-destructive as +possible, making an effort to preserve all markers, properties and +overlays in the buffer. Since reverting this way can be very slow +when you have made a large number of changes, you can modify the +variable @code{revert-buffer-with-fine-grain-max-seconds} to +specify a maximum amount of seconds that replacing the buffer +contents this way should take. Note that it is not ensured that the +whole execution of @code{revert-buffer-with-fine-grain} won't take +longer than this. + Some kinds of buffers that are not associated with files, such as Dired buffers, can also be reverted. For them, reverting means recalculating their contents. Buffers created explicitly with @@ -1615,6 +1629,10 @@ Convert the entire buffer to unified diff format unified format to context format. When the mark is active, convert only the hunks within the region. +@item C-c C-l +@findex diff-refresh-hunk +Re-generate the current hunk (@code{diff-refresh-hunk}). + @item C-c C-w @findex diff-ignore-whitespace-hunk Re-generate the current hunk, disregarding changes in whitespace diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index b74887612b9..1a44d8dc628 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -214,22 +214,24 @@ speed is linked to how fast you move the wheel. This mode also supports increasing or decreasing the height of the default face, by default bound to scrolling with the @key{Ctrl} modifier. +Emacs also supports horizontal scrolling with the @key{Shift} modifier. + @vindex mouse-wheel-tilt-scroll @vindex mouse-wheel-flip-direction -Emacs can also support horizontal scrolling if your mouse's wheel can -be tilted, or if your touchpad supports it. This feature is off by -default; the variable @code{mouse-wheel-tilt-scroll} turns it on, if -you customize it to a non-@code{nil} value. By default, tilting the -mouse wheel scrolls the window's view horizontally in the direction of -the tilt: e.g., tilting to the right scrolls the window to the right, -so that the text displayed in the window moves horizontally to the -left. If you'd like to reverse the direction of horizontal scrolling, -customize the variable @code{mouse-wheel-flip-direction} to a -non-@code{nil} value. +If your mouse's wheel can be tilted, or if your touchpad supports it, +then you can also enable horizontal scrolling by customizing the +variable @code{mouse-wheel-tilt-scroll} to a non-@code{nil} value. +By default, tilting the mouse wheel scrolls the window's view +horizontally in the direction of the tilt: e.g., tilting to the right +scrolls the window to the right, so that the text displayed in the +window moves horizontally to the left. If you'd like to reverse the +direction of horizontal scrolling, customize the variable +@code{mouse-wheel-flip-direction} to a non-@code{nil} value. When the mouse pointer is over an image in Image mode, @pxref{Image Mode}, scrolling the mouse wheel with the @key{Ctrl} modifier scales the image -under the mouse pointer. +under the mouse pointer, and scrolling the mouse wheel with the +@key{Shift} modifier scrolls the image horizontally. @node Word and Line Mouse diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 06ad5a583d2..c5b59e54928 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -275,6 +275,13 @@ name is defined as a Lisp function. Type @kbd{C-g} to cancel the @kbd{C-h f} command if you don't really want to view the documentation. +@findex shortdoc-display-group + You can get an overview of functions relevant for a particular topic +by using the @kbd{M-x shortdoc-display-group} command. This will +prompt you for an area of interest, e.g., @code{string}, and pop you +to a buffer where many of the functions relevant for handling strings +are listed. + @kindex C-h v @findex describe-variable @kbd{C-h v} (@code{describe-variable}) is like @kbd{C-h f} but @@ -573,10 +580,13 @@ command works depend on the major mode. @kindex C-h l @findex view-lossage +@findex lossage-size If something surprising happens, and you are not sure what you typed, use @kbd{C-h l} (@code{view-lossage}). @kbd{C-h l} displays your last -300 input keystrokes and the commands they invoked. If you see -commands that you are not familiar with, you can use @kbd{C-h k} or +input keystrokes and the commands they invoked. By default, Emacs +stores the last 300 keystrokes; if you wish, you can change this number with +the command @code{lossage-size}. +If you see commands that you are not familiar with, you can use @kbd{C-h k} or @kbd{C-h f} to find out what they do. @kindex C-h e diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index d0360ac333b..d6395ef155d 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -250,6 +250,13 @@ Completion}). If the value is @code{nil}, then @key{TAB} indents the current line only if point is at the left margin or in the line's indentation; otherwise, it inserts a tab character. +@vindex tab-first-completion + If @code{tab-always-indent} is @code{complete}, whether to expand or +indent can be further customized via the @code{tab-first-completion} +variable. For instance, if that variable is @code{eol}, only complete +if point is at the end of a line. @xref{Mode-Specific Indent,,, +elisp, The Emacs Lisp Reference Manual} for further details. + @cindex Electric Indent mode @cindex mode, Electric Indent @findex electric-indent-mode diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index a9b0da5aff6..1f10b68b8a7 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1458,7 +1458,7 @@ working tree to match the branch you switch to. Bazaar also supports co-located branches, in which case the @kbd{bzr switch} command will switch branches in the current directory. With Subversion, you switch to another branch using the @kbd{svn switch} command. With -Mercurial, command @kbd{hg update} is used to swith to another +Mercurial, command @kbd{hg update} is used to switch to another branch. The VC command to switch to another branch in the current directory diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index c8b21e701c7..4865ee17518 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -3028,6 +3028,11 @@ point (@code{dired-at-point}). @code{find-file-read-only-other-frame}. @item C-x 5 d @var{directory} @key{RET} @code{ffap-dired-other-frame}, analogous to @code{dired-other-frame}. +@kindex C-x t C-f @r{(FFAP)} +@item C-x t C-f @var{filename} @key{return} +@code{ffap-other-tab}, analogous to @code{find-file-other-tab}. +@item C-x t C-r @var{filename} @key{return} +@code{ffap-read-only-other-tab}, analogous to @code{find-file-read-only-other-tab}. @item M-x ffap-next Search buffer for next file name or URL, then find that file or URL. @item S-mouse-3 diff --git a/doc/emacs/msdos-xtra.texi b/doc/emacs/msdos-xtra.texi index 230e918c842..045ac6c4605 100644 --- a/doc/emacs/msdos-xtra.texi +++ b/doc/emacs/msdos-xtra.texi @@ -563,7 +563,7 @@ finishes. Spell checking also works, by means of special support for synchronous invocation of the @code{ispell} program. This is slower than the -asynchronous invocation on other platforms +asynchronous invocation on other platforms. Instead of the Shell mode, which doesn't work on MS-DOS, you can use the @kbd{M-x eshell} command. This invokes the Eshell package that diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 6eff0ca0d22..b78019020a6 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -1215,11 +1215,8 @@ system can encode. If @code{file-name-coding-system} is @code{nil}, Emacs uses a default coding system determined by the selected language environment, -and stored in the @code{default-file-name-coding-system} variable. -@c FIXME? Is this correct? What is the "default language environment"? -In the default language environment, non-@acronym{ASCII} characters in -file names are not encoded specially; they appear in the file system -using the internal Emacs representation. +and stored in the @code{default-file-name-coding-system} variable +(normally UTF-8). @cindex file-name encoding, MS-Windows @vindex w32-unicode-filenames diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 453d9eb4010..56e8ee1363a 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -222,6 +222,12 @@ lower, equal or higher version than the one specified. Filter package list by non-empty mark (@code{package-menu-filter-marked}). This shows only the packages that have been marked to be installed or deleted. +@item / u +@kindex / u @r{(Package Menu)} +@findex package-menu-filter-upgradable +Filter package list to show only packages for which there are +available upgrades (@code{package-menu-filter-upgradable}). + @item / / @kindex / / @r{(Package Menu)} @findex package-menu-filter-clear diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 1c33d7dccc7..f0dd62dad45 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1291,6 +1291,12 @@ ways. This abnormal hook holds documentation functions. It acts as a collection of backends for ElDoc. This is what modes should use to register their documentation functions with ElDoc. + +@vindex eldoc-display-truncation-message +@item eldoc-display-truncation-message +If non-@code{nil} (the default), display a verbose message about how +to view a complete documentation (if it has been truncated in the echo +area). If @code{nil}, just mark truncated messages with @samp{...}. @end table @node Hideshow diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 2e094f3ad92..91b433f1738 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1662,6 +1662,7 @@ reused. @cindex @code{query-replace} face @cindex @code{lazy-highlight} face, in replace @vindex query-replace-highlight +@vindex query-replace-highlight-submatches @vindex query-replace-lazy-highlight @vindex query-replace-show-replacement These commands highlight the current match using the face @@ -1674,6 +1675,10 @@ other matches using @code{lazy-highlight} just like incremental search string for the current match in the minibuffer. If you want to keep special sequences @samp{\&} and @samp{\@var{n}} unexpanded, customize @code{query-replace-show-replacement} variable. +Like @code{search-highlight-submatches} highlights subexpressions in +incremental search (@pxref{Search Customizations}), the variable +@code{query-replace-highlight-submatches} defines whether to highlight +subexpressions in the regexp replacement commands. @vindex query-replace-skip-read-only The variable @code{query-replace-skip-read-only}, if set @@ -1977,6 +1982,29 @@ performs case folding and lax-whitespace matching. using the @code{isearch} face. This highlighting can be disabled by setting the variable @code{search-highlight} to @code{nil}. +@vindex search-highlight-submatches + When searching for regular expressions (with @kbd{C-M-s}, for +instance), subexpressions receive special highlighting depending on +the @code{search-highlight-submatches} variable. If this variable's +value is @code{nil}, no special highlighting is done, but if the value +is non-@code{nil}, text that matches @samp{\( @dots{} \)} constructs +(a.k.a.@: ``subexpressions'') in the regular expression will be +highlighted with distinct faces. By default, two distinct faces are +defined, named @code{isearch-group-1} and @code{isearch-group-2}. +With these two faces, odd-numbered subexpressions will be highlighted +using the @code{isearch-group-1} face and even-numbered subexpressions +will be highlighted using the @code{isearch-group-2} face. For +instance, when searching for @samp{foo-\([0-9]+\)\([a-z]+\)}, the part +matched by @samp{[0-9]+} will be highlighted with the +@code{isearch-group-1} face, and the part matched by @samp{[a-z]+} +will be highlighted using @code{isearch-group-2}. If you define +additional faces using the same numbering scheme, i.e.@: +@code{isearch-group-3}, @code{isearch-group-4}, @dots{}, then the face +@code{isearch-group-@var{M}} will be used to highlight the @var{M}'th, +@code{@var{N}+@var{M}}'th, @code{2@var{N}+@var{M}}'th, @dots{} +subexpressions, where @var{N} is the total number of faces of the form +@code{isearch-group-@var{M}}. + @cindex lazy highlighting customizations @vindex isearch-lazy-highlight @cindex @code{lazy-highlight} face diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 281e24421c2..c77dcf7fbce 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1207,6 +1207,17 @@ everything except the top @var{n} levels of heading lines. Note that it completely reveals all the @var{n} top levels and the body lines before the first heading. +@cindex cycle visibility, in Outline mode +@findex outline-cycle +@findex outline-cycle-buffer + Outline also provides two convenience commands to cycle the +visibility of each section and the whole buffer. Typing +@kbd{@key{TAB}} (@code{outline-cycle}) on a heading cycles the current +section between ``hide all'', ``subheadings'', and ``show all'' +states. Typing @kbd{S-@key{TAB}} (@code{outline-cycle-buffer}) cycles +the whole buffer between ``only top-level headings'', ``all headings +and subheadings'', and ``show all'' states. + @anchor{Outline Search} @findex reveal-mode @vindex search-invisible diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index 33f67f2b442..dbd1a075573 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -721,18 +721,24 @@ will be sent to the Emacs maintainers at @ifhtml @url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, bug-gnu-emacs}. @end ifhtml -(If you want to suggest an improvement or new feature, use the same -address.) If you cannot send mail from inside Emacs, you can copy the +If you cannot send mail from inside Emacs, you can copy the text of your report to your normal mail client (if your system supports it, you can type @kbd{C-c M-i} to have Emacs do this for you) and send it to that address. Or you can simply send an email to that address describing the problem. -Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and -stored in the GNU Bug Tracker at @url{https://debbugs.gnu.org}. Please -include a valid reply email address, in case we need to ask you for -more information about your report. Submissions are moderated, so -there may be a delay before your report appears. +If you want to submit code to Emacs (to fix a problem or implement a +new feature), the easiest way to do this is to send a patch to the +Emacs issue tracker. This is done with the @kbd{M-x +submit-emacs-patch} command, and works much the same as when reporting +bugs. + +In any case, your report will be sent to the @samp{bug-gnu-emacs} +mailing list, and stored in the GNU Bug Tracker at +@url{https://debbugs.gnu.org}. Please include a valid reply email +address, in case we need to ask you for more information about your +report. Submissions are moderated, so there may be a delay before +your report appears. You do not need to know how the GNU Bug Tracker works in order to report a bug, but if you want to, you can read the tracker's online diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 9aefe1da17a..b13b16285c7 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -227,7 +227,7 @@ supports it in developing GNU and promoting software freedom.'' @c learn Emacs Lisp starting with the Emacs Lisp Reference Manual. @c @c Richard Stallman <rms@gnu.org>, -@c https://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00374.html +@c https://lists.gnu.org/r/emacs-devel/2018-05/msg00374.html @shortcontents @contents @@ -17523,7 +17523,7 @@ Here is the definition: ;;; Line to top of window; ;;; replace three keystroke sequence C-u 0 C-l (defun line-to-top-of-window () - "Move the line point is on to top of window." + "Move the line that point is on to top of window." (interactive) (recenter 0)) @end group diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 33528fc7fec..28603436284 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -596,8 +596,8 @@ and features that react to buffer modifications, use the Execute @var{body} pretending it does not modify the buffer. This includes checking whether the buffer's file is locked (@pxref{File Locks}), running buffer modification hooks (@pxref{Change Hooks}), -etc. Note that if @var{body} actually modifies the buffer text, its -undo data may become corrupted. +etc. Note that if @var{body} actually modifies the buffer text (as +opposed to its text properties), its undo data may become corrupted. @end defmac @node Modification Time diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 25f657404f3..ebfda01671e 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -930,9 +930,8 @@ was specified to run but remapped into another command. @defun this-command-keys This function returns a string or vector containing the key sequence -that invoked the present command, plus any previous commands that -generated the prefix argument for this command. Any events read by the -command using @code{read-event} without a timeout get tacked on to the end. +that invoked the present command. Any events read by the command +using @code{read-event} without a timeout get tacked on to the end. However, if the command has called @code{read-key-sequence}, it returns the last read key sequence. @xref{Key Sequence Input}. The @@ -943,7 +942,7 @@ fit in a string. @xref{Input Events}. @group (this-command-keys) ;; @r{Now use @kbd{C-u C-x C-e} to evaluate that.} - @result{} "^U^X^E" + @result{} "^X^E" @end group @end example @end defun @@ -1346,10 +1345,11 @@ button. @xref{Repeat Events}. To access the contents of a mouse position list in the @var{position} slot of a click event, you should typically use the -functions documented in @ref{Accessing Mouse}. The explicit format of -the list depends on where the click occurred. For clicks in the text -area, mode line, header line, tab line, or in the fringe or marginal -areas, the mouse position list has the form +functions documented in @ref{Accessing Mouse}. + +The explicit format of the list depends on where the click occurred. +For clicks in the text area, mode line, header line, tab line, or in +the fringe or marginal areas, the mouse position list has the form @example (@var{window} @var{pos-or-area} (@var{x} . @var{y}) @var{timestamp} @@ -1479,6 +1479,45 @@ handle), @code{up} (the up arrow at one end of the scroll bar), or @c The 'top', 'bottom', and 'end-scroll' codes don't seem to be used. @end table +For clicks on the frame's internal border (@pxref{Frame Layout}), +@var{position} has this form: + +@example + (@var{frame} @var{part} (@var{X} . @var{Y}) @var{timestamp}) +@end example + +@table @asis +@item @var{frame} +The frame whose internal border was clicked on. + +@item @var{part} +The part of the internal border which was clicked on. This can be one +of the following: + +@table @code +@item nil +The frame does not have an internal border. This usually happens on +text-mode frames. This can also happen on GUI frames with internal +border if the frame doesn't have its @code{drag-internal-border} +parameter (@pxref{Mouse Dragging Parameters}) set to a non-@code{nil} +value. + +@item left-edge +@itemx top-edge +@itemx right-edge +@itemx bottom-edge +The click was on the corresponding border at an offset of at least one +canonical character from the border's nearest corner. + +@item top-left-corner +@itemx top-right-corner +@itemx bottom-right-corner +@itemx bottom-left-corner +The click was on the corresponding corner of the internal border. +@end table + +@end table + @node Drag Events @subsection Drag Events @@ -2469,16 +2508,22 @@ button-down events entirely. It also reshuffles focus events and miscellaneous window events so that they never appear in a key sequence with any other events. -@cindex @code{tab-line} prefix key -@cindex @code{header-line} prefix key -@cindex @code{mode-line} prefix key -@cindex @code{vertical-line} prefix key -@cindex @code{horizontal-scroll-bar} prefix key -@cindex @code{vertical-scroll-bar} prefix key -@cindex @code{menu-bar} prefix key -@cindex @code{tab-bar} prefix key -@cindex mouse events, in special parts of frame -When mouse events occur in special parts of a window, such as a mode +@cindex @code{tab-line}, prefix key +@cindex @code{header-line}, prefix key +@cindex @code{mode-line}, prefix key +@cindex @code{vertical-line}, prefix key +@cindex @code{horizontal-scroll-bar}, prefix key +@cindex @code{vertical-scroll-bar}, prefix key +@cindex @code{menu-bar}, prefix key +@cindex @code{tab-bar}, prefix key +@cindex @code{left-margin}, prefix key +@cindex @code{right-margin}, prefix key +@cindex @code{left-fringe}, prefix key +@cindex @code{right-fringe}, prefix key +@cindex @code{right-divider}, prefix key +@cindex @code{bottom-divider}, prefix key +@cindex mouse events, in special parts of window or frame +When mouse events occur in special parts of a window or frame, such as a mode line or a scroll bar, the event type shows nothing special---it is the same symbol that would normally represent that combination of mouse button and modifier keys. The information about the window part is kept @@ -2486,9 +2531,11 @@ elsewhere in the event---in the coordinates. But @code{read-key-sequence} translates this information into imaginary prefix keys, all of which are symbols: @code{tab-line}, @code{header-line}, @code{horizontal-scroll-bar}, @code{menu-bar}, @code{tab-bar}, @code{mode-line}, -@code{vertical-line}, and @code{vertical-scroll-bar}. You can define -meanings for mouse clicks in special window parts by defining key -sequences using these imaginary prefix keys. +@code{vertical-line}, @code{vertical-scroll-bar}, @code{left-margin}, +@code{right-margin}, @code{left-fringe}, @code{right-fringe}, +@code{right-divider}, and @code{bottom-divider}. You can define meanings for +mouse clicks in special window parts by defining key sequences using these +imaginary prefix keys. For example, if you call @code{read-key-sequence} and then click the mouse on the window's mode line, you get two events, like this: diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index e979fda41eb..ad8afaae608 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -164,7 +164,7 @@ echo area, but if @var{arg} is non-@code{nil}, it inserts the result in the current buffer after the form it has compiled. @end deffn -@deffn Command byte-compile-file filename &optional load +@deffn Command byte-compile-file filename This function compiles a file of Lisp code named @var{filename} into a file of byte-code. The output file's name is made by changing the @samp{.el} suffix into @samp{.elc}; if @var{filename} does not end in @@ -180,9 +180,6 @@ input file is read. This command returns @code{t} if there were no errors and @code{nil} otherwise. When called interactively, it prompts for the file name. -If @var{load} is non-@code{nil}, this command loads the compiled file -after compiling it. Interactively, @var{load} is the prefix argument. - @example @group $ ls -l push* diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index c35444f5817..85912470795 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -124,6 +124,11 @@ Link to the documentation of a variable; @var{variable} is a string which specifies the name of the variable to describe with @code{describe-variable} when the user invokes this link. +@item (face-link @var{face}) +Link to the documentation of a face; @var{face} is a string which +specifies the name of the face to describe with @code{describe-face} +when the user invokes this link. + @item (custom-group-link @var{group}) Link to another customization group. Invoking it creates a new customization buffer for @var{group}. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 29a0ab71ea4..3fea604184c 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -147,7 +147,7 @@ set @code{debug-ignored-errors} to @code{nil}. If this variable has a non-@code{nil} value (the default), running the command @code{eval-expression} causes @code{debug-on-error} to be temporarily bound to @code{t}. @xref{Lisp Eval,, Evaluating -Emacs-Lisp Expressions, emacs, The GNU Emacs Manual}. +Emacs Lisp Expressions, emacs, The GNU Emacs Manual}. If @code{eval-expression-debug-on-error} is @code{nil}, then the value of @code{debug-on-error} is not changed during @code{eval-expression}. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index d3adb62c1bd..6fc8587fe52 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1970,36 +1970,45 @@ This function returns the width in columns of the string @var{string}, if it were displayed in the current buffer and the selected window. @end defun -@defun truncate-string-to-width string width &optional start-column padding ellipsis -This function returns the part of @var{string} that fits within -@var{width} columns, as a new string. +@defun truncate-string-to-width string width &optional start-column padding ellipsis ellipsis-text-property +This function returns a new string that is a truncation of @var{string} +which fits within @var{width} columns on display. -If @var{string} does not reach @var{width}, then the result ends where -@var{string} ends. If one multi-column character in @var{string} -extends across the column @var{width}, that character is not included in -the result. Thus, the result can fall short of @var{width} but cannot -go beyond it. +If @var{string} is narrower than @var{width}, the result is equal to +@var{string}; otherwise excess characters are omitted from the result. +If a multi-column character in @var{string} exceeds the goal +@var{width}, that character is omitted from the result. Thus, the +result can sometimes fall short of @var{width}, but cannot go beyond +it. The optional argument @var{start-column} specifies the starting column. If this is non-@code{nil}, then the first @var{start-column} columns of -the string are omitted from the value. If one multi-column character in +the string are omitted from the result. If one multi-column character in @var{string} extends across the column @var{start-column}, that -character is not included. +character is omitted. The optional argument @var{padding}, if non-@code{nil}, is a padding -character added at the beginning and end of the result string, to extend -it to exactly @var{width} columns. The padding character is used at the -end of the result if it falls short of @var{width}. It is also used at -the beginning of the result if one multi-column character in +character added at the beginning and end of the result string, to +extend it to exactly @var{width} columns. The padding character is +appended at the end of the result if it falls short of @var{width}, as +many times as needed to reach @var{width}. It is also prepended at +the beginning of the result if a multi-column character in @var{string} extends across the column @var{start-column}. -@vindex truncate-string-ellipsis If @var{ellipsis} is non-@code{nil}, it should be a string which will -replace the end of @var{string} (including any padding) if it extends -beyond @var{width}, unless the display width of @var{string} is equal -to or less than the display width of @var{ellipsis}. If -@var{ellipsis} is non-@code{nil} and not a string, it stands for -the value of the variable @code{truncate-string-ellipsis}. +replace the end of @var{string} when it is truncated. In this case, +more charcaters will be removed from @var{string} to free enough space +for @var{ellipsis} to fit within @var{width} columns. However, if +the display width of @var{string} is less than the display width of +@var{ellipsis}, @var{ellipsis} will not be appended to the result. If +@var{ellipsis} is non-@code{nil} and not a string, it stands for the +value returned by the function @code{truncate-string-ellipsis}, +described below. + +The optional argument @var{ellipsis-text-property}, if non-@code{nil}, +means hide the excess parts of @var{string} with a @code{display} text +property (@pxref{Display Property}) showing the ellipsis, instead of +actually truncating the string. @example (truncate-string-to-width "\tab\t" 12 4) @@ -2009,6 +2018,16 @@ the value of the variable @code{truncate-string-ellipsis}. @end example @end defun +@defun truncate-string-ellipsis +This function returns the string to be used as an ellipses in +@code{truncate-string-to-width} and other similar contexts. The value +is that of the variable @code{truncate-string-ellipsis}, if it's +non-@code{nil}, the string with the single character @sc{U+2026 +HORIZONTAL ELLIPSIS} if that character can be displayed on the +selected frame, and the string @samp{...} otherwise. +@end defun + + The following function returns the size in pixels of text as if it were displayed in a given window. This function is used by @code{fit-window-to-buffer} and @code{fit-frame-to-buffer} @@ -2182,21 +2201,24 @@ actual line height can never be less than the default. @kindex line-height @r{(text property)} A newline can have a @code{line-height} text or overlay property that controls the total height of the display line ending in that -newline. +newline. The property value can be one of several forms: - If the property value is @code{t}, the newline character has no +@table @code +@item t +If the property value is @code{t}, the newline character has no effect on the displayed height of the line---the visible contents alone determine the height. The @code{line-spacing} property, described below, is also ignored in this case. This is useful for tiling small images (or image slices) without adding blank areas between the images. - - If the property value is a list of the form @code{(@var{height} -@var{total})}, that adds extra space @emph{below} the display line. -First Emacs uses @var{height} as a height spec to control extra space -@emph{above} the line; then it adds enough space @emph{below} the line -to bring the total line height up to @var{total}. In this case, any -value of @code{line-spacing} property for the newline is ignored. +@item (@var{height} @var{total}) +If the property value is a list of the form shown, that adds extra +space @emph{below} the display line. First Emacs uses @var{height} as +a height spec to control extra space @emph{above} the line; then it +adds enough space @emph{below} the line to bring the total line height +up to @var{total}. In this case, any value of @code{line-spacing} +property for the newline is ignored. +@end table @cindex height spec Any other kind of property value is a height spec, which translates @@ -3646,12 +3668,16 @@ the charset @code{japanese-jisx0208}. @end defun @defun char-displayable-p char -This function returns @code{t} if Emacs ought to be able to display -@var{char}. More precisely, if the selected frame's fontset has a -font to display the character set that @var{char} belongs to. +This function returns non-@code{nil} if Emacs ought to be able to +display @var{char}. Or more precisely, if the selected frame's fontset +has a font to display the character set that @var{char} belongs to. Fontsets can specify a font on a per-character basis; when the fontset does that, this function's value may not be accurate. + +This function may return non-@code{nil} even when there is no font +available, since it also checks whether the coding system for the text +terminal can encode the character (@pxref{Terminal I/O Encoding}). @end defun @node Low-Level Font @@ -6926,6 +6952,9 @@ such as @code{forward-button} and @code{backward-button} are additionally available in the keymap stored in @code{button-buffer-map}; a mode which uses buttons may want to use @code{button-buffer-map} as a parent keymap for its keymap. +Alternatively, the @code{button-mode} can be switched on for much the +same effect: It's a minor mode that does nothing else than install +@code{button-buffer-map} as a minor mode keymap. If the button has a non-@code{nil} @code{follow-link} property, and @code{mouse-1-click-follows-link} is set, a quick @key{mouse-1} click @@ -8008,7 +8037,7 @@ positions do not increase monotonically with string or buffer position. In performing this @dfn{bidirectional reordering}, Emacs follows the Unicode Bidirectional Algorithm (a.k.a.@: @acronym{UBA}), which is described in Annex #9 of the Unicode standard -(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full +(@url{https://www.unicode.org/reports/tr9/}). Emacs provides a ``Full Bidirectionality'' class implementation of the @acronym{UBA}, consistent with the requirements of the Unicode Standard v9.0. Note, however, that the way Emacs displays continuation lines when text @@ -8259,7 +8288,7 @@ different. Emacs provides a primitive that applications can use to detect instances of text whose bidirectional properties were overridden so as to make a left-to-right character display as if it were a -right-to-left character, or vise versa. +right-to-left character, or vice versa. @defun bidi-find-overridden-directionality from to &optional object This function looks at the text of the specified @var{object} between diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 6404e068dae..6e9ec47f7b0 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -863,19 +863,20 @@ to a non-@code{nil} value. @end example @noindent -Custom printing prints this as @samp{Result: #1=(#1# y)}. The -@samp{#1=} notation labels the structure that follows it with the label -@samp{1}, and the @samp{#1#} notation references the previously labeled -structure. This notation is used for any shared elements of lists or -vectors. +If @code{print-circle} is non-@code{nil}, printing functions (e.g., +@code{prin1}) will print @code{a} as @samp{#1=(#1# y)}. The +@samp{#1=} notation labels the structure that follows it with the +label @samp{1}, and the @samp{#1#} notation references the previously +labeled structure. This notation is used for any shared elements of +lists or vectors. @defopt edebug-print-circle If non-@code{nil}, Edebug binds @code{print-circle} to this value while printing results. The default value is @code{t}. @end defopt - Other programs can also use custom printing; see @file{cust-print.el} -for details. + See @xref{Output Functions} for further details about how printing +can be customized. @node Trace Buffer @subsection Trace Buffer diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 92cbc2a1c91..fc66d1c085d 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -548,7 +548,7 @@ the functions in the list @code{after-insert-file-functions}. (@pxref{Coding Systems}) used for decoding the file's contents, including end-of-line conversion. However, if the file contains null bytes, it is by default visited without any code conversions. -@xref{Lisp and Coding Systems, inhibit-nul-byte-detection}. +@xref{Lisp and Coding Systems, inhibit-null-byte-detection}. If @var{visit} is non-@code{nil}, this function additionally marks the buffer as unmodified and sets up various fields in the buffer so that it @@ -2926,11 +2926,11 @@ absolute file names. Otherwise, it returns the names relative to the specified directory. If @var{match-regexp} is non-@code{nil}, this function returns only -those file names that contain a match for that regular expression---the -other file names are excluded from the list. On case-insensitive -filesystems, the regular expression matching is case-insensitive. +those file names whose non-directory part contain a match for that +regular expression---the other file names are excluded from the list. +On case-insensitive filesystems, the regular expression matching is +case-insensitive. -@c Emacs 19 feature If @var{nosort} is non-@code{nil}, @code{directory-files} does not sort the list, so you get the file names in no particular order. Use this if you want the utmost possible speed and don't care what order the files @@ -3007,6 +3007,19 @@ corresponding argument to @code{file-attributes} (@pxref{Definition of file-attributes}). @end defun +@defvr Constant directory-files-no-dot-files-regexp +This regular expression matches any file name except @samp{.} and +@samp{..}. More precisely, it matches parts of any nonempty string +except those two. It is useful as the @var{match-regexp} argument to +@code{directory-files} and @code{directory-files-and-attributes}: + +@example +(directory-files "/foo" nil directory-files-no-dot-files-regexp) +@end example + +returns @code{nil}, if directory @samp{/foo} is empty. +@end defvr + @defun file-expand-wildcards pattern &optional full This function expands the wildcard pattern @var{pattern}, returning a list of file names that match it. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 22d32c00d9b..e3d0fdeb277 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3526,6 +3526,13 @@ This abnormal hook exists for the benefit of packages like @file{xt-mouse.el} that need to do mouse handling at the Lisp level. @end defvar +@defvar tty-menu-calls-mouse-position-function +If non-@code{nil}, TTY menus will call @code{mouse-position-function} +as described above. This exists for cases where +@code{mouse-position-function} is not safe to be called by the TTY +menus, such as if it could trigger redisplay. +@end defvar + @defun set-mouse-position frame x y This function @dfn{warps the mouse} to position @var{x}, @var{y} in frame @var{frame}. The arguments @var{x} and @var{y} are integers, diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 26b212d05eb..e8e22078d9b 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -762,6 +762,11 @@ arguments, rather than a single list. We say that @code{apply} @dfn{spreads} this list so that each individual element becomes an argument. +@code{apply} with a single argument is special: the first element of +the argument, which must be a non-empty list, is called as a function +with the remaining elements as individual arguments. Passing two or +more arguments will be faster. + @code{apply} returns the result of calling @var{function}. As with @code{funcall}, @var{function} must either be a Lisp function or a primitive function; special forms and macros do not make sense in @@ -789,6 +794,11 @@ primitive function; special forms and macros do not make sense in (apply 'append '((a b c) nil (x y z) nil)) @result{} (a b c x y z) @end group + +@group +(apply '(+ 3 4)) + @result{} 7 +@end group @end example For an interesting example of using @code{apply}, see @ref{Definition diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index d4505d5c3ff..2fa54e3b66b 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -37,6 +37,7 @@ Help, emacs, The GNU Emacs Manual}. * Describing Characters:: Making printable descriptions of non-printing characters and key sequences. * Help Functions:: Subroutines used by Emacs help facilities. +* Documentation Groups:: Listing functions by groups. @end menu @node Documentation Basics @@ -794,3 +795,165 @@ If this variable is non-@code{nil}, commands defined with echo area at first, and display the longer @var{help-text} strings only if the user types the help character again. @end defopt + + +@node Documentation Groups +@section Documentation Groups +@cindex documentation groups +@cindex groups of functions +@cindex function groups + +Emacs can list functions based on various groupings. For instance, +@code{string-trim} and @code{mapconcat} are ``string'' functions, so +@kbd{M-x shortdoc-display-group RET string RET} will give an overview +of functions that operate on strings. + +The documentation groups are created with the +@code{define-short-documentation-group} macro. + +@defmac define-short-documentation-group group &rest functions +Define @var{group} as a group of functions, and provide short +summaries of using those functions. The optional argument +@var{functions} is a list whose elements are of the form: + +@lisp +(@var{func} @var{keyword} @var{val} @dots{}) +@end lisp + +The following keywords are recognized: + +@table @code + +@item :eval +The value should be a form that has no side effect when evaluated. +The form will be used in the documentation by printing it with +@code{prin1} (@pxref{Output Functions}). However, if the form is a +string, it will be inserted as-is, and the string will then be +@code{read} to yield the form. In any case, the form will then be +evaluated, and the result used. For instance: + +@example +:eval (concat "foo" "bar" "zot") +:eval "(make-string 5 ?x)" +@end example + +@noindent +will be printed as + +@example +(concat "foo" "bar" "zot") +@result{} "foobarzot" +(make-string 5 ?x) +@result{} "xxxxx" +@end example + +(The reason for allowing both Lisp forms and strings here is so that +printing could be controlled in the few cases where a certain +presentation of the form is wished for. In the example, @samp{?x} +would otherwise have been printed as @samp{120} if it hadn't been +included in a string.) + +@item :no-eval + +This is like @code{:eval}, except that the form will not be evaluated. +In these cases, a @code{:result} element of some kind (see below) +should be included. + +@example +:no-eval (file-symlink-p "/tmp/foo") +:eg-result t +@end example + +@item :no-eval* +Like @code{:no-eval}, but alaways inserts @samp{[it depends]} as the +result. + +@example +:no-eval* (buffer-string) +@end example + +will result in: + +@example +(buffer-string) +@click{} [it depends] +@end example + +@item :no-value +Like @code{:no-eval}, but is used when the function in question has no +well-defined return value, and is used for side effect only. + +@item :result +Used to output the result from non-evaluating example forms. + +@example +:no-eval (setcar list 'c) +:result c +@end example + +@item :eg-result +Used to output an example result from non-evaluating example forms. + +@example +:no-eval (looking-at "f[0-9]") +:eg-result t +@end example + +@item :result-string +@itemx :eg-result-string +These two are the same as @code{:result} and @code{:eg-result}, +respectively, but are inserted as is. This is useful when the result +is unreadable or should be on a particular form: + +@example +:no-eval (find-file "/tmp/foo") +:eg-result-string "#<buffer foo>" +:no-eval (default-file-modes) +:eg-result-string "#o755" +@end example + +@item :no-manual +Indicates that this function is not documented in the manual. + +@item :args +By default, the function's actual argument list is shown. If +@code{:args} is present, they are used instead. + +@example +:args (regexp string) +@end example + +@end table + +Here's a very short example: + +@lisp +(define-short-documentation-group string + "Creating Strings" + (substring + :eval (substring "foobar" 0 3) + :eval (substring "foobar" 3)) + (concat + :eval (concat "foo" "bar" "zot"))) +@end lisp + +The first argument is the name of the group to be defined, and then +follows any number of function descriptions. + +@end defmac + +A function can belong to any number of documentation groups. + +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 +@var{elem} should be a function descriptions, as described above. +@var{group} is the function group, and @var{section} is what section +in the function group to insert the function into. + +If @var{group} doesn't exist, it will be created. If @var{section} +doesn't exist, it will be added to the end of the function group. +@end defun diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index d70c3543f2a..bb25983aa4b 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1425,28 +1425,46 @@ violations of the above requirements. @xref{Initial Options,,,emacs, The GNU Emacs Manual}. Using the module @acronym{API}, it is possible to define more complex -function and data types: interactive functions, inline functions, -macros, etc. However, the resulting C code will be cumbersome and -hard to read. Therefore, we recommend that you limit the module code -which creates functions and data structures to the absolute minimum, -and leave the rest for a Lisp package that will accompany your module, -because doing these additional tasks in Lisp is much easier, and will -produce a much more readable code. For example, given a module -function @code{module-func} defined as above, one way of making an -interactive command @code{module-cmd} based on it is with the -following simple Lisp wrapper: +function and data types: inline functions, macros, etc. However, the +resulting C code will be cumbersome and hard to read. Therefore, we +recommend that you limit the module code which creates functions and +data structures to the absolute minimum, and leave the rest for a Lisp +package that will accompany your module, because doing these +additional tasks in Lisp is much easier, and will produce a much more +readable code. For example, given a module function +@code{module-func} defined as above, one way of making a macro +@code{module-macro} based on it is with the following simple Lisp +wrapper: @lisp -(defun module-cmd (&rest args) - "Documentation string for the command." - (interactive @var{spec}) - (apply 'module-func args)) +(defmacro module-macro (&rest args) + "Documentation string for the macro." + (module-func args)) @end lisp The Lisp package which goes with your module could then load the module using the @code{load} primitive (@pxref{Dynamic Modules}) when the package is loaded into Emacs. +By default, module functions created by @code{make_function} are not +interactive. To make them interactive, you can use the following +function. + +@deftypefun void make_interactive (emacs_env *@var{env}, emacs_value @var{function}, emacs_value @var{spec}) +This function, which is available since Emacs 28, makes the function +@var{function} interactive using the interactive specification +@var{spec}. Emacs interprets @var{spec} like the argument to the +@code{interactive} form. @ref{Using Interactive}, and +@pxref{Interactive Codes}. @var{function} must be an Emacs module +function returned by @code{make_function}. +@end deftypefun + +Note that there is no native module support for retrieving the +interactive specification of a module function. Use the function +@code{interactive-form} for that. @ref{Using Interactive}. It is not +possible to make a module function non-interactive once you have made +it interactive using @code{make_interactive}. + @anchor{Module Function Finalizers} If you want to run some code when a module function object (i.e., an object returned by @code{make_function}) is garbage-collected, you can @@ -1836,6 +1854,12 @@ raises the @code{overflow-error} error condition if @var{len} is negative or exceeds the maximum length of an Emacs string. @end deftypefn +@deftypefn Function emacs_value make_unibyte_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len}) +This function is like @code{make_string}, but has no restrictions on +the values of the bytes in the C string, and can be used to pass +binary data to Emacs in the form of a unibyte string. +@end deftypefn + The @acronym{API} does not provide functions to manipulate Lisp data structures, for example, create lists with @code{cons} and @code{list} (@pxref{Building Lists}), extract list members with @code{car} and @@ -2041,7 +2065,7 @@ I/O,,,libc}. @cindex nonlocal exits, in modules Emacs Lisp supports nonlocal exits, whereby program control is -transfered from one point in a program to another remote point. +transferred from one point in a program to another remote point. @xref{Nonlocal Exits}. Thus, Lisp functions called by your module might exit nonlocally by calling @code{signal} or @code{throw}, and your module functions must handle such nonlocal exits properly. Such diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 8e4fbc7c31f..a4b479597ea 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -87,7 +87,9 @@ you are criticizing. @cindex bugs @cindex suggestions -Please send comments and corrections using @kbd{M-x report-emacs-bug}. +Please send comments and corrections using @kbd{M-x +report-emacs-bug}. If you wish to contribute new code (or send a +patch to fix a problem), use @kbd{M-x submit-emacs-patch}). @node Lisp History @section Lisp History @@ -249,7 +251,8 @@ indicated with @samp{@equiv{}}. Many of the examples in this manual print text when they are evaluated. If you execute example code in a Lisp Interaction buffer -(such as the buffer @file{*scratch*}), the printed text is inserted into +(such as the buffer @file{*scratch*}) by typing @kbd{C-j} after the +closing parenthesis of the example, the printed text is inserted into the buffer. If you execute the example by other means (such as by evaluating the function @code{eval-region}), the printed text is displayed in the echo area. diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 6833af9c262..e5364152d52 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -577,7 +577,7 @@ macro, then an error is signaled with data @code{"Autoloading failed to define function @var{function-name}"}. @findex update-file-autoloads -@findex update-directory-autoloads +@findex make-directory-autoloads @cindex magic autoload comment @cindex autoload cookie @anchor{autoload cookie} @@ -590,7 +590,7 @@ writes a corresponding @code{autoload} call into @file{loaddefs.el}. file generated by @code{update-file-autoloads} can be changed from the above defaults, see below.) Building Emacs loads @file{loaddefs.el} and thus calls @code{autoload}. -@kbd{M-x update-directory-autoloads} is even more powerful; it updates +@kbd{M-x make-directory-autoloads} is even more powerful; it updates autoloads for all files in the current directory. The same magic comment can copy any kind of form into @@ -1063,7 +1063,7 @@ It then restores any autoloads formerly associated with those symbols. (Loading saves these in the @code{autoload} property of the symbol.) Before restoring the previous definitions, @code{unload-feature} runs -@code{remove-hook} to remove functions in the library from certain +@code{remove-hook} to remove functions defined by the library from certain hooks. These hooks include variables whose names end in @samp{-hook} (or the deprecated suffix @samp{-hooks}), plus those listed in @code{unload-feature-special-hooks}, as well as @@ -1071,7 +1071,7 @@ hooks. These hooks include variables whose names end in @samp{-hook} function because important hooks refer to functions that are no longer defined. -Standard unloading activities also undoes ELP profiling of functions +Standard unloading activities also undo ELP profiling of functions in that library, unprovides any features provided by the library, and cancels timers held in variables defined by the library. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index cca06c70a51..e5a0233b3c7 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -316,8 +316,22 @@ input before returning it. However, @code{read-no-blanks-input} (see below), as well as @code{read-minibuffer} and related functions (@pxref{Object from Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all -functions that do minibuffer input with completion, discard text -properties unconditionally, regardless of the value of this variable. +functions that do minibuffer input with completion, remove the @code{face} +property unconditionally, regardless of the value of this variable. + +If this variable is non-@code{nil}, most text properties on strings +from the completion table are preserved---but only on the part of the +strings that were completed. + +@lisp +(let ((minibuffer-allow-text-properties t)) + (completing-read "String: " (list (propertize "foobar" 'data 'zot)))) +=> #("foobar" 3 6 (data zot)) +@end lisp + +In this example, the user typed @samp{foo} and then hit the @kbd{TAB} +key, so the text properties are only preserved on the last three +characters. @end defvar @defvar minibuffer-local-map @@ -440,6 +454,8 @@ case no default values are displayed. If @var{default} is @code{nil}, there is no default value, and therefore no ``default value'' string is included in the result value. +If @var{default} is a non-@code{nil} list, the first element of the +list is used in the prompt. @end defun @node Object from Minibuffer @@ -2458,9 +2474,10 @@ changes size automatically. In that case the window resizing commands @defopt max-mini-window-height This option provides a maximum height for resizing minibuffer windows -automatically. A floating-point number specifies a fraction of the -frame's height; an integer specifies the maximum number of lines. The -default value is 0.25. +automatically. A floating-point number specifies the maximum height +as a fraction of the frame's height; an integer specifies the maximum +height in units of the frame's canonical character height +(@pxref{Frame Font}). The default value is 0.25. @end defopt Note that the values of the above two variables take effect at display @@ -2484,8 +2501,10 @@ frame is the buffer whose contents will be shown the next time that window is redisplayed. The function is expected to fit the frame to the buffer in some appropriate way. -Any other non-@code{nil} value means to resize minibuffer-only frames -by calling @code{fit-frame-to-buffer} (@pxref{Resizing Windows}). +Any other non-@code{nil} value means to resize minibuffer-only frames by +calling @code{fit-mini-frame-to-buffer}, a function that behaves like +@code{fit-frame-to-buffer} (@pxref{Resizing Windows}) but does not strip +leading or trailing empty lines from the buffer text. @end defopt diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index fa5f18e2023..98aa94e90d4 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -35,10 +35,11 @@ user. For related topics such as keymaps and syntax tables, see @section Hooks @cindex hooks - A @dfn{hook} is a variable where you can store a function or functions -to be called on a particular occasion by an existing program. Emacs -provides hooks for the sake of customization. Most often, hooks are set -up in the init file (@pxref{Init File}), but Lisp programs can set them also. + A @dfn{hook} is a variable where you can store a function or +functions (@pxref{What Is a Function}) to be called on a particular +occasion by an existing program. Emacs provides hooks for the sake of +customization. Most often, hooks are set up in the init file +(@pxref{Init File}), but Lisp programs can set them also. @xref{Standard Hooks}, for a list of some standard hook variables. @cindex normal hook @@ -56,27 +57,36 @@ minor mode functions also run a mode hook at the end. But hooks are used in other contexts too. For example, the hook @code{suspend-hook} runs just before Emacs suspends itself (@pxref{Suspending Emacs}). - The recommended way to add a hook function to a hook is by calling -@code{add-hook} (@pxref{Setting Hooks}). The hook functions may be any -of the valid kinds of functions that @code{funcall} accepts (@pxref{What -Is a Function}). Most normal hook variables are initially void; -@code{add-hook} knows how to deal with this. You can add hooks either -globally or buffer-locally with @code{add-hook}. - @cindex abnormal hook If the hook variable's name does not end with @samp{-hook}, that indicates it is probably an @dfn{abnormal hook}. That means the hook functions are called with arguments, or their return values are used in some way. The hook's documentation says how the functions are -called. You can use @code{add-hook} to add a function to an abnormal -hook, but you must write the function to follow the hook's calling -convention. By convention, abnormal hook names end in @samp{-functions}. +called. Any functions added to an abnormal hook must follow the +hook's calling convention. By convention, abnormal hook names end in +@samp{-functions}. @cindex single-function hook -If the variable's name ends in @samp{-function}, then its value is -just a single function, not a list of functions. @code{add-hook} cannot be -used to modify such a @emph{single function hook}, and you have to use -@code{add-function} instead (@pxref{Advising Functions}). +If the name of the variable ends in @samp{-predicate} or +@samp{-function} (singular) then its value must be a function, not a +list of functions. As with abnormal hooks, the expected arguments and +meaning of the return value vary across such @emph{single function +hooks}. The details are explained in each variable's docstring. + + Since hooks (both multi and single function) are variables, their +values can be modified with @code{setq} or temporarily with +@code{let}. However, it is often useful to add or remove a particular +function from a hook while preserving any other functions it might +have. For multi function hooks, the recommended way of doing this is +with @code{add-hook} and @code{remove-hook} (@pxref{Setting Hooks}). +Most normal hook variables are initially void; @code{add-hook} knows +how to deal with this. You can add hooks either globally or +buffer-locally with @code{add-hook}. For hooks which hold only a +single function, @code{add-hook} is not appropriate, but you can use +@code{add-function} (@pxref{Advising Functions}) to combine new +functions with the hook. Note that some single function hooks may be +@code{nil} which @code{add-function} cannot deal with, so you must +check for that before calling @code{add-function}. @menu * Running Hooks:: How to run a hook. @@ -1729,7 +1739,8 @@ The command named @var{mode} first performs the standard actions such as setting the variable named @var{mode} and then executes the @var{body} forms, if any. It then runs the mode hook variable @code{@var{mode}-hook} and finishes by evaluating any form in -@code{:after-hook}. +@code{:after-hook}. (Note that all of this, including running the +hook, is done both when the mode is enabled and disabled.) @end defmac The initial value must be @code{nil} except in cases where (1) the @@ -1795,10 +1806,11 @@ don't need any. @defmac define-globalized-minor-mode global-mode mode turn-on keyword-args@dots{} body@dots{} This defines a global toggle named @var{global-mode} whose meaning is -to enable or disable the buffer-local minor mode @var{mode} in all -buffers. It also executes the @var{body} forms. To turn on the minor -mode in a buffer, it uses the function @var{turn-on}; to turn off the -minor mode, it calls @var{mode} with @minus{}1 as argument. +to enable or disable the buffer-local minor mode @var{mode} in all (or +some; see below) buffers. It also executes the @var{body} forms. To +turn on the minor mode in a buffer, it uses the function +@var{turn-on}; to turn off the minor mode, it calls @var{mode} with +@minus{}1 as argument. Globally enabling the mode also affects buffers subsequently created by visiting files, and buffers that use a major mode other than @@ -1819,6 +1831,38 @@ also define a non-globalized version, so that people can use (or disable) it in individual buffers. This also allows them to disable a globally enabled minor mode in a specific major mode, by using that mode's hook. + +If given a @code{:predicate} keyword, a user option called the same as +the global mode variable, but with @code{-modes} instead of +@code{-mode} at the end will be created. The variable is used as a +predicate that specifies which major modes the minor mode should be +activated in. Valid values include @code{t} (use in all major modes, +@code{nil} (use in no major modes), or a list of mode names (or +@code{(not mode-name ...)}) elements (as well as @code{t} and +@code{nil}). + +@example +(c-mode (not mail-mode message-mode) text-mode) +@end example + +This means ``use in modes derived from @code{c-mode}, and not in +modes derived from @code{message-mode} or @code{mail-mode}, but do use +in modes derived from @code{text-mode}, and otherwise no other +modes''. + +@example +((not c-mode) t) +@end example + +This means ``don't use modes derived from @code{c-mode}, but use +everywhere else''. + +@example +(text-mode) +@end example + +This means ``use in modes derived from @code{text-mode}, but nowhere +else''. (There's an implicit @code{nil} element at the end.) @end defmac @@ -2166,6 +2210,29 @@ Mode line construct for miscellaneous information. By default, this shows the information specified by @code{global-mode-string}. @end defvar +@defvar mode-line-position-line-format +The format used to display line numbers when @code{line-number-mode} +(@pxref{Optional Mode Line,,, emacs, The GNU Emacs Manual}) is +switched on. @samp{%l} in the format will be replaced with the line +number. +@end defvar + +@defvar mode-line-position-column-format +The format used to display column numbers when +@code{column-number-mode} (@pxref{Optional Mode Line,,, emacs, The GNU +Emacs Manual}) is switched on. @samp{%c} in the format will be +replaced with the column number, and this is zero-based if +@code{column-number-indicator-zero-based} is non-@code{nil}, and +one-based if @code{column-number-indicator-zero-based} is @code{nil}. +@end defvar + +@defvar mode-line-position-column-line-format +The format used to display column numbers when both +@code{line-number-mode} and @code{column-number-mode} are switched on. +See the previous two variables for the meaning of the @samp{%l} and +@samp{%c} format specs. +@end defvar + @defvar minor-mode-alist @anchor{Definition of minor-mode-alist} This variable holds an association list whose elements specify how the @@ -3270,7 +3337,7 @@ is disabled, @code{font-lock-face} has no effect on the display. also use the normal Font Lock machinery. But if the mode does not use the normal Font Lock machinery, it should not set the variable @code{font-lock-defaults}. In this case the @code{face} property will -not be overriden, so using the @code{face} property could work too. +not be overridden, so using the @code{face} property could work too. However, using @code{font-lock-face} is generally preferable as it allows the user to control the fontification by toggling @code{font-lock-mode}, and lets the code work regardless of whether diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index c6c78ec096e..97bc85f152e 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -722,7 +722,10 @@ The value of this variable is a char-table that specifies, for each character, a symbol whose name is the script to which the character belongs, according to the Unicode Standard classification of the Unicode code space into script-specific blocks. This char-table has a -single extra slot whose value is the list of all script symbols. +single extra slot whose value is the list of all script symbols. Note +that Emacs' classification of characters into scripts is not a 1-for-1 +reflection of the Unicode standard, e.g. there is no @samp{symbol} +script in Unicode. @end defvar @defvar char-width-table @@ -1379,7 +1382,7 @@ operates on the contents of @var{string} instead of bytes in the buffer. @end defun @cindex null bytes, and decoding text -@defvar inhibit-nul-byte-detection +@defvar inhibit-null-byte-detection If this variable has a non-@code{nil} value, null bytes are ignored when detecting the encoding of a region or a string. This allows the encoding of text that contains null bytes to be correctly detected, diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index f018ef4c7c0..9a5bff5a5b2 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -450,6 +450,10 @@ numbers. It compares numbers by type and numeric value, so that @code{(eql 1.0 1)} returns @code{nil}, but @code{(eql 1.0 1.0)} and @code{(eql 1 1)} both return @code{t}. This can be used to compare large integers as well as small ones. +Floating-point values with the same sign, exponent and fraction are @code{eql}. +This differs from numeric comparison: @code{(eql 0.0 -0.0)} returns +@code{nil} and @code{(eql 0.0e+NaN 0.0e+NaN)} returns @code{t}, +whereas @code{=} does the opposite. @end defun @defun /= number-or-marker1 number-or-marker2 diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 504f0dfb23e..2c30d8ad892 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1901,7 +1901,10 @@ The integer number of hours. The integer number of minutes. @item %s @itemx %S -The integer number of seconds. +The number of seconds. If the optional @samp{,} parameter is used, +it's a floating point number, and the number after the @samp{,} +specifies how many decimals to be used. @samp{%,2s} means ``use two +decimals''. @item %z Non-printing control flag. When it is used, other specifiers must be given in the order of decreasing size, i.e., years before days, hours diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 4002004cd6f..5fefab99d4c 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -603,6 +603,11 @@ This function works by calling @code{call-process}, so program output is decoded in the same way as for @code{call-process}. @end defun +@defun process-lines-ignore-status program &rest args +This function is just like @code{process-lines}, but does not signal +an error if @var{program} exits with a non-zero exit status. +@end defun + @node Asynchronous Processes @section Creating an Asynchronous Process @cindex asynchronous subprocess @@ -1571,7 +1576,8 @@ from previous output. @defun set-process-buffer process buffer This function sets the buffer associated with @var{process} to @var{buffer}. If @var{buffer} is @code{nil}, the process becomes -associated with no buffer. +associated with no buffer; if non-@code{nil}, the process mark will be +set to point to the end of @var{buffer}. @end defun @defun get-buffer-process buffer-or-name @@ -1833,7 +1839,7 @@ system comes from @code{coding-system-for-read}, if that is non-@code{nil}; or else from the defaulting mechanism (@pxref{Default Coding Systems}). If the text output by a process contains null bytes, Emacs by default uses @code{no-conversion} for it; see -@ref{Lisp and Coding Systems, inhibit-nul-byte-detection}, for how to +@ref{Lisp and Coding Systems, inhibit-null-byte-detection}, for how to control this behavior. @strong{Warning:} Coding systems such as @code{undecided}, which diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index b6242c539b7..592b876644c 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -2542,7 +2542,7 @@ and replace them, the best way is to write an explicit loop using description of @code{replace-match}. However, replacing matches in a string is more complex, especially -if you want to do it efficiently. So Emacs provides a function to do +if you want to do it efficiently. So Emacs provides two functions to do this. @defun replace-regexp-in-string regexp rep string &optional fixedcase literal subexp start @@ -2566,6 +2566,13 @@ replacement string. The match data at this point are the result of matching @var{regexp} against a substring of @var{string}. @end defun +@defun string-replace fromstring tostring instring +This function replaces all occurrences of @var{fromstring} with +@var{tostring} in @var{instring} and returns the result. It may +return one of its arguments unchanged, a constant string or a new +string. Case is significant, and text properties are ignored. +@end defun + If you want to write a command along the lines of @code{query-replace}, you can use @code{perform-replace} to do the work. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index ca52369bd0c..952834bd4e3 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -658,8 +658,13 @@ for which @var{predicate} returns @code{nil}. @var{initial-value} and the first element of @var{sequence}, then calling @var{function} with that result and the second element of @var{sequence}, then with that result and the third element of @var{sequence}, etc. -@var{function} should be a function of two arguments. If -@var{sequence} is empty, this returns @var{initial-value} without +@var{function} should be a function of two arguments. + +@var{function} is called with two arguments. @var{intial-value} +(and then the accumulated value) is used as the first argument, and +the elements in @var{sequence} are used for the second argument. + +If @var{sequence} is empty, this returns @var{initial-value} without calling @var{function}. @example diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index d40ec8db105..f171f137790 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -859,7 +859,7 @@ exceeding this limit is abbreviated with an ellipsis. A value of These are the values for @code{print-length} and @code{print-level} used by @code{eval-expression}, and thus, indirectly, by many interactive evaluation commands (@pxref{Lisp Eval,, Evaluating -Emacs-Lisp Expressions, emacs, The GNU Emacs Manual}). +Emacs Lisp Expressions, emacs, The GNU Emacs Manual}). @end defopt These variables are used for detecting and reporting circular @@ -902,3 +902,11 @@ variable. The string should hold a @samp{%}-specification to be used in the C function @code{sprintf}. For further restrictions on what you can use, see the variable's documentation string. @end defvar + +@defvar integer-output-format +This variable specifies how to print integer numbers. The default is +@code{nil}, meaning use the decimal format. When bound to @code{t}, +print integers as characters when an integer represents a character +(@pxref{Basic Char Syntax}). When bound to the number @code{16}, +print non-negative integers in the hexadecimal format. +@end defvar diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 8de6255478b..0f157c39d63 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -656,6 +656,16 @@ optional argument @var{ignore-case} is non-@code{nil}, the comparison ignores case differences. @end defun +@defun string-search needle haystack &optional start-pos +Return the position of the first instance of @var{needle} in +@var{haystack}, both of which are strings. If @var{start-pos} is +non-@code{nil}, start searching from that position in @var{needle}. +Return @code{nil} if no match was found. +This function only considers the characters in the strings when doing +the comparison; text properties are ignored. Matching is always +case-sensitive. +@end defun + @defun compare-strings string1 start1 end1 string2 start2 end2 &optional ignore-case This function compares a specified part of @var{string1} with a specified part of @var{string2}. The specified part of @var{string1} diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 9eb99a0ac92..b99b5de0b31 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -256,10 +256,11 @@ look in the standard syntax table to find the syntax of this character. @item Generic comment delimiters: @samp{!} -Characters that start or end a special kind of comment. @emph{Any} -generic comment delimiter matches @emph{any} generic comment -delimiter, but they cannot match a comment starter or comment ender; -generic comment delimiters can only match each other. +(This syntax class is also known as ``comment-fence''.) Characters +that start or end a special kind of comment. @emph{Any} generic +comment delimiter matches @emph{any} generic comment delimiter, but +they cannot match a comment starter or comment ender; generic comment +delimiters can only match each other. This syntax class is primarily meant for use with the @code{syntax-table} text property (@pxref{Syntax Properties}). You @@ -268,10 +269,11 @@ first and last characters of the range @code{syntax-table} properties identifying them as generic comment delimiters. @item Generic string delimiters: @samp{|} -Characters that start or end a string. This class differs from the -string quote class in that @emph{any} generic string delimiter can -match any other generic string delimiter; but they do not match -ordinary string quote characters. +(This syntax class is also known as ``string-fence''.) Characters +that start or end a string. This class differs from the string quote +class in that @emph{any} generic string delimiter can match any other +generic string delimiter; but they do not match ordinary string quote +characters. This syntax class is primarily meant for use with the @code{syntax-table} text property (@pxref{Syntax Properties}). You @@ -575,6 +577,15 @@ position before @var{end}. However, it should not call @code{syntax-ppss-flush-cache}; so, it is not allowed to call @code{syntax-ppss} on some position and later modify the buffer at an earlier position. + +@strong{Caution:} When this variable is non-@code{nil}, Emacs removes +@code{syntax-table} text properties arbitrarily and relies on +@code{syntax-propertize-function} to reapply them. Thus if this +facility is used at all, the function must apply @strong{all} +@code{syntax-table} text properties used by the major mode. In +particular, Modes derived from a CC Mode mode must not use this +variable, since CC Mode uses other means to apply and remove these +text properties. @end defvar @defvar syntax-propertize-extend-region-functions diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 3a4cf6b5723..550e7feee2e 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -2427,6 +2427,30 @@ already indented, it calls @code{completion-at-point} to complete the text at point (@pxref{Completion in Buffers}). @end defopt +@defopt tab-first-completion +If @code{tab-always-indent} is @code{complete}, whether to expand or +indent can be further customized via the @code{tab-first-completion} +variable. The following values can be used: +@table @code +@item eol +Only complete if point is at the end of a line. + +@item word +Complete unless the next character has word syntax. + +@item word-or-paren +Complete unless the next character has word syntax or is a +parenthesis. + +@item word-or-paren-or-punct +Complete unless the next character has word syntax, or is a +parenthesis, or is punctuation. +@end table + +In any case, typing @kbd{TAB} a second time always results in +completion. +@end defopt + @cindex literate programming @cindex multi-mode indentation Some major modes need to support embedded regions of text whose @@ -2542,7 +2566,7 @@ the beginning of the line (if @var{nochange-regexp} is non-@code{nil}). This section describes two commands that indent the current line based on the contents of previous lines. -@deffn Command indent-relative &optional unindented-ok +@deffn Command indent-relative &optional first-only unindented-ok This command inserts whitespace at point, extending to the same column as the next @dfn{indent point} of the previous nonblank line. An indent point is a non-whitespace character following whitespace. The @@ -2558,6 +2582,9 @@ nothing (if @var{unindented-ok} is non-@code{nil}) or calls of the last column of a short line of text, this command ordinarily moves point to the next tab stop by inserting whitespace. +If @var{first-only} is non-@code{nil}, only the first indent point is +considered. + The return value of @code{indent-relative} is unpredictable. In the following example, point is at the beginning of the second @@ -3069,7 +3096,7 @@ construct each part with @code{propertize} and then combine them with @code{buffer-substring-no-properties}, which copies text from the buffer but does not copy its properties. -@findex with-silent-modifications +@findex with-silent-modifications, and changes in text properties If you wish to add text properties to a buffer or remove them without marking the buffer as modified, you can wrap the calls above in the @code{with-silent-modifications} macro. @xref{Buffer diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 1826e8f7b42..40d01d47468 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -95,6 +95,11 @@ If one prefix is insufficient, your package can use two or three alternative common prefixes, so long as they make sense. @item +We recommend enabling @code{lexical-binding} in new code, and +converting existing Emacs Lisp code to enable @code{lexical-binding} +if it doesn't already. @xref{Using Lexical Binding}. + +@item Put a call to @code{provide} at the end of each separate Lisp file. @xref{Named Features}. @@ -278,8 +283,9 @@ implementing such clickable links. @cindex keys, reserved Don't define @kbd{C-c @var{letter}} as a key in Lisp programs. Sequences consisting of @kbd{C-c} and a letter (either upper or lower -case) are reserved for users; they are the @strong{only} sequences -reserved for users, so do not block them. +case; @acronym{ASCII} or non-@acronym{ASCII}) are reserved for users; +they are the @strong{only} sequences reserved for users, so do not +block them. Changing all the Emacs major modes to respect this convention was a lot of work; abandoning this convention would make that work go to @@ -960,7 +966,7 @@ Using multiple top-level code sections has the advantage that it avoids introducing an additional nesting level but it also means that the section named @samp{Code} does not contain all the code, which is awkward. To avoid that, you should put no code at all inside that -section; that way it can be considered a seperator instead of a +section; that way it can be considered a separator instead of a section heading. Finally, we recommend that you don't end headings with a colon or any @@ -990,7 +996,7 @@ explains these conventions, starting with an example: @smallexample @group -;;; foo.el --- Support for the Foo programming language +;;; foo.el --- Support for the Foo programming language -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2020 Your Name @end group @@ -1013,14 +1019,14 @@ explains these conventions, starting with an example: The very first line should have this format: @example -;;; @var{filename} --- @var{description} +;;; @var{filename} --- @var{description} -*- lexical-binding: t; -*- @end example @noindent -The description should be contained in one line. If the file -needs a @samp{-*-} specification, put it after @var{description}. -If this would make the first line too long, use a Local Variables -section at the end of the file. +The description should be contained in one line. If the file needs to +set more variables in the @samp{-*-} specification, add it after +@code{lexical-binding}. If this would make the first line too long, use +a Local Variables section at the end of the file. The copyright notice usually lists your name (if you wrote the file). If you have an employer who claims copyright on your work, you diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 94c8c88796f..095ea9dce24 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -934,6 +934,7 @@ Lisp programs. * Dynamic Binding Tips:: Avoiding problems with dynamic binding. * Lexical Binding:: A different type of local variable binding. * Using Lexical Binding:: How to enable lexical binding. +* Converting to Lexical Binding:: Convert existing code to lexical binding. @end menu @node Dynamic Binding @@ -1242,9 +1243,10 @@ for those that are only special in the current lexical scope. @end defun The use of a special variable as a formal argument in a function is -discouraged. Doing so gives rise to unspecified behavior when lexical -binding mode is enabled (it may use lexical binding sometimes, and -dynamic binding other times). +not supported. + +@node Converting to Lexical Binding +@subsection Converting to Lexical Binding Converting an Emacs Lisp program to lexical binding is easy. First, add a file-local variable setting of @code{lexical-binding} to @@ -1264,11 +1266,62 @@ variable. If a non-special variable is bound but not used within a variable. The byte-compiler will also issue a warning if you use a special variable as a function argument. - (To silence byte-compiler warnings about unused variables, just use -a variable name that starts with an underscore. The byte-compiler -interprets this as an indication that this is a variable known not to + A warning about a reference or an assignment to a free variable is +usually a clear sign that that variable should be marked as +dynamically scoped, so you need to add an appropriate @code{defvar} +before the first use of that variable. + + A warning about an unused variable may be a good hint that the +variable was intended to be dynamically scoped (because it is actually +used, but in another function), but it may also be an indication that +the variable is simply really not used and could simply be removed. +So you need to find out which case it is, and based on that, either +add a @code{defvar} or remove the variable altogether. If removal is +not possible or not desirable (typically because it is a formal +argument and that we cannot or don't want to change all the callers), +you can also add a leading underscore to the variable's name to +indicate to the compiler that this is a variable known not to be used.) +@subsubheading Cross-file variable checking + +@strong{Note:} This is an experimental feature that may change or +disappear without prior notice. + +The byte-compiler can also warn about lexical variables that are +special in other Emacs Lisp files, often indicating a missing +@code{defvar} declaration. This useful but somewhat specialised check +requires three steps: + +@enumerate +@item +Byte-compile all files whose special variable declarations may be of +interest, with the environment variable @env{EMACS_GENERATE_DYNVARS} +set to a nonempty string. These are typically all the files in the +same package or related packages or Emacs subsystems. The process +will generate a file whose name ends in @file{.dynvars} for each +compiled Emacs Lisp file. + +@item +Concatenate the @file{.dynvars} files into a single file. + +@item +Byte-compile the files that need to be checked, this time with +the environment variable @env{EMACS_DYNVARS_FILE} set to the name +of the aggregated file created in step 2. +@end enumerate + +Here is an example illustrating how this could be done, assuming that +a Unix shell and @command{make} are used for byte-compilation: + +@example +$ rm *.elc # force recompilation +$ EMACS_GENERATE_DYNVARS=1 make # generate .dynvars +$ cat *.dynvars > ~/my-dynvars # combine .dynvars +$ rm *.elc # force recompilation +$ EMACS_DYNVARS_FILE=~/my-dynvars make # perform checks +@end example + @node Buffer-Local Variables @section Buffer-Local Variables @cindex variable, buffer-local @@ -2332,6 +2385,14 @@ equivalent to the following: (defvaralias @var{obsolete-name} @var{current-name} @var{docstring}) (make-obsolete-variable @var{obsolete-name} @var{current-name} @var{when}) @end example + +This macro evaluates all its parameters, and both @var{obsolete-name} +and @var{current-name} should be symbols, so a typical usage would +look like: + +@lisp +(define-obsolete-variable-alias 'foo-thing 'bar-thing "27.1") +@end lisp @end defmac @defun indirect-variable variable diff --git a/doc/man/ebrowse.1 b/doc/man/ebrowse.1 index 686658b20f8..330c1ea523e 100644 --- a/doc/man/ebrowse.1 +++ b/doc/man/ebrowse.1 @@ -1,5 +1,5 @@ .\" See section COPYING for copyright and redistribution information. -.TH EBROWSE 1 +.TH EBROWSE 1 "2008-12-14" "GNU Emacs" "GNU" .SH NAME ebrowse \- create a class hierarchy database .SH SYNOPSIS @@ -98,3 +98,7 @@ document into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. . + +.\" Local Variables: +.\" time-stamp-pattern: "3/.TH EBROWSE 1 \"%Y-%02m-%02d\" \"GNU Emacs\" \"GNU\"$" +.\" End: diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in index 5a164e98cd3..3a5758e1aaa 100644 --- a/doc/man/emacs.1.in +++ b/doc/man/emacs.1.in @@ -1,5 +1,5 @@ .\" See section COPYING for copyright and redistribution information. -.TH EMACS 1 "2007 April 13" "GNU Emacs @version@" +.TH EMACS 1 "2020-04-05" "GNU Emacs @version@" "GNU" . . .SH NAME @@ -673,3 +673,7 @@ document into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. . + +.\" Local Variables: +.\" time-stamp-pattern: "3/.TH EMACS 1 \"%Y-%02m-%02d\" \"GNU Emacs @version@\" \"GNU\"$" +.\" End: diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index 3bdaafbfc54..ba64efa282c 100644 --- a/doc/man/emacsclient.1 +++ b/doc/man/emacsclient.1 @@ -1,5 +1,5 @@ .\" See section COPYING for conditions for redistribution. -.TH EMACSCLIENT 1 +.TH EMACSCLIENT 1 "2020-10-18" "GNU Emacs" "GNU" .\" NAME should be all caps, SECTION should be 1-8, maybe w/ subsection .\" other params are allowed: see man(7), man(1) .SH NAME @@ -12,8 +12,6 @@ This manual page documents briefly the .BR emacsclient command. Full documentation is available in the GNU Info format; see below. -This manual page was originally written for the Debian GNU/Linux -distribution, but is not specific to that system. .PP .B emacsclient works in conjunction with the built-in Emacs server. @@ -63,45 +61,45 @@ is treated as column 1. This option applies only to the next file specified. .TP .B \-a, \-\-alternate-editor=COMMAND -if the Emacs server is not running, run the specified shell command instead. +If the Emacs server is not running, run the specified shell command instead. This can also be specified via the ALTERNATE_EDITOR environment variable. If the value of ALTERNATE_EDITOR is the empty string, run "emacs \-\-daemon" to start Emacs in daemon mode, and try to connect to it. .TP .B -c, \-\-create-frame -create a new frame instead of trying to use the current Emacs frame +Create a new frame instead of trying to use the current Emacs frame. .TP .B \-F, \-\-frame-parameters=ALIST -set the parameters of a newly-created frame. +Set the parameters of a newly-created frame. .TP .B \-d, \-\-display=DISPLAY -tell the server to display the files on the given display. +Tell the server to display the files on the given display. .TP .B \-e, \-\-eval -do not visit files but instead evaluate the arguments as Emacs +Do not visit files but instead evaluate the arguments as Emacs Lisp expressions. .TP .B \-f, \-\-server-file=FILENAME -use TCP configuration file FILENAME for communication. +Use TCP configuration file FILENAME for communication. This can also be specified via the EMACS_SERVER_FILE environment variable. .TP .B \-n, \-\-no-wait -returns +Return immediately without waiting for you to "finish" the buffer in Emacs. If combined with --eval, this option is ignored. .TP .B \-nw, \-t, \-\-tty -open a new Emacs frame on the current terminal +Open a new Emacs frame on the current terminal. .TP .B \-s, \-\-socket-name=FILENAME -use socket named FILENAME for communication. +Use socket named FILENAME for communication. This can also be specified via the EMACS_SOCKET_NAME environment variable. .TP .B \-V, \-\-version -print version information and exit +Print version information and exit. .TP .B \-H, \-\-help -print this usage information message and exit +Print this usage information message and exit. .SH "EXIT STATUS" Normally, the exit status is 0. If emacsclient shuts down due to Emacs signaling an error, the exit status is 1. @@ -110,7 +108,12 @@ The program is documented fully in .IR "Using Emacs as a Server" available via the Info system. .SH AUTHOR -This manual page was written by Stephane Bortzmeyer <bortzmeyer@debian.org>, -for the Debian GNU/Linux system (but may be used by others). +This manual page was originally written by Stephane Bortzmeyer +<bortzmeyer@debian.org>, for the Debian GNU/Linux system, but is not +specific to that system. .SH COPYING This manual page is in the public domain. + +.\" Local Variables: +.\" time-stamp-pattern: "3/.TH EMACSCLIENT 1 \"%Y-%02m-%02d\" \"GNU Emacs\" \"GNU\"$" +.\" End: diff --git a/doc/man/etags.1 b/doc/man/etags.1 index e10fb840caf..8053e863fce 100644 --- a/doc/man/etags.1 +++ b/doc/man/etags.1 @@ -1,5 +1,5 @@ .\" See section COPYING for copyright and redistribution information. -.TH etags 1 "23nov2001" "GNU Tools" "GNU Tools" +.TH ETAGS 1 "2019-06-24" "GNU Tools" "GNU" .de BP .sp .ti -.2i @@ -296,3 +296,7 @@ Permission is granted to copy and distribute translations of this document into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. + +.\" Local Variables: +.\" time-stamp-pattern: "3/.TH ETAGS 1 \"%Y-%02m-%02d\" \"GNU Tools\" \"GNU\"$" +.\" End: diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1 index a85971bdaf6..f74e51f400e 100644 --- a/doc/misc/ChangeLog.1 +++ b/doc/misc/ChangeLog.1 @@ -502,7 +502,7 @@ * org.texi (@LaTeX{} specific attributes): Update manual. * org.texi (Top, Exporting): Org has its own documentation and - should therefore be removed from "Other build-in back-ends". + should therefore be removed from "Other built-in back-ends". 2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> @@ -1161,7 +1161,7 @@ (Special agenda views): Mention the "agenda*" agenda view. * org.texi (Repeated tasks): Document how to ignore a repeater - when using both a scheduled and a deadline timetamp. + when using both a scheduled and a deadline timestamp. * org.texi (Global and local cycling): Wrap in a new subsection. (Initial visibility, Catching invisible edits): New subsections. @@ -3515,7 +3515,7 @@ 2012-01-03 Rafael Laboissiere <rafael@laboissiere.net> (tiny change) * org.texi (External links): Add footnote on how the behavior - of the text search in Org files are controled by the variable + of the text search in Org files are controlled by the variable `org-link-search-must-match-exact-headline'. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -6262,7 +6262,7 @@ information - it's hard to keep up-to-date, and adds nothing. Similarly with direct links to mailing lists. (Spell-checkers): Rename node from Ispell. Mention Aspell and Hunspell. - (Mailcrypt): Remove section - mailcrypt has not been updated in mnay + (Mailcrypt): Remove section - mailcrypt has not been updated in many years, and Emacs comes with tools for this now. (Patch): Remove section - this is a standard tool. (Using function keys under X): Remove section. @@ -6493,7 +6493,7 @@ specified in a property. (Text areas in HTML export): New section. (External links): Add examples for text search and ID links. - (Built-in table editor): Remove the descriptio of `C-c + (Built-in table editor): Remove the description of `C-c C-q', it not longer works. (Literal examples): Document that a space must follow the colon in short examples. diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 7f536ad9529..f4fb7d2ee64 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -69,7 +69,7 @@ INFO_COMMON = auth autotype bovine calc ccmode cl \ dbus dired-x ebrowse ede ediff edt 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 newsticker nxml-mode octave-mode \ + mairix-el message mh-e modus-themes newsticker nxml-mode octave-mode \ org pcl-cvs pgg rcirc remember reftex sasl \ sc semantic ses sieve smtpmail speedbar srecode todo-mode tramp \ url vhdl-mode vip viper widget wisent woman diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 1dab29b8a5a..6a6f585ce20 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -18077,7 +18077,7 @@ zeros with @kbd{d z}. @xref{Radix Modes}. @cindex Word size for binary operations The Calculator maintains a current @dfn{word size} @expr{w}, an -arbitrary positive or negative integer. For a positive word size, all +arbitrary integer. For a positive word size, all of the binary operations described here operate modulo @expr{2^w}. In particular, negative arguments are converted to positive integers modulo @expr{2^w} by all binary functions. @@ -18092,6 +18092,9 @@ to inclusive. Either mode accepts inputs in any range; the sign of @expr{w} affects only the results produced. +If the word size is zero, binary operations work on the entire number +without clipping, as if the word size had been negative infinity. + @kindex b c @pindex calc-clip @tindex clip @@ -18221,6 +18224,10 @@ and @samp{rash} operations is totally independent from whether the word size is positive or negative.) With a negative prefix argument, this performs a standard left shift. +When the word size is zero, logical and arithmetic shift operations +are identical: a negative value shifted right remains negative, since +there is an infinite supply of ones to shift in. + @kindex b t @pindex calc-rotate-binary @tindex rot @@ -18230,6 +18237,8 @@ word size) is dropped off the left and shifted in on the right. With a numeric prefix argument, the number is rotated that many bits to the left or right. +Rotation is not possible with a zero word size. + @xref{Set Operations}, for the @kbd{b p} and @kbd{b u} commands that pack and unpack binary integers into sets. (For example, @kbd{b u} unpacks the number @samp{2#11001} to the set of bit-numbers @@ -34743,15 +34752,15 @@ is defined by @smallexample (put 'calcFunc-ln\' 'math-derivative-1 - (function (lambda (u) (math-div 1 u)))) + (lambda (u) (math-div 1 u))) @end smallexample The two-argument @code{log} function has two derivatives, @smallexample (put 'calcFunc-log\' 'math-derivative-2 ; d(log(x,b)) / dx - (function (lambda (x b) ... ))) + (lambda (x b) ... )) (put 'calcFunc-log\'2 'math-derivative-2 ; d(log(x,b)) / db - (function (lambda (x b) ... ))) + (lambda (x b) ... )) @end smallexample @end defun @@ -34818,7 +34827,7 @@ as properties in a manner similar to derivatives: @smallexample (put 'calcFunc-ln 'math-inverse - (function (lambda (x) (list 'calcFunc-exp x)))) + (lambda (x) (list 'calcFunc-exp x))) @end smallexample This function can call @samp{(math-solve-get-sign @var{x})} to create diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index b5f26e004b0..2b38544dc87 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -4818,7 +4818,7 @@ For example: @example (defun make-adder (n) (lexical-let ((n n)) - (function (lambda (m) (+ n m))))) + (lambda (m) (+ n m)))) (setq add17 (make-adder 17)) (funcall add17 4) @result{} 21 diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index a68cb26a3e5..5a1dd55248d 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -59,10 +59,11 @@ another. An overview of D-Bus can be found at * Type Conversion:: Mapping Lisp types and D-Bus types. * Synchronous Methods:: Calling methods in a blocking way. * Asynchronous Methods:: Calling methods non-blocking. -* Receiving Method Calls:: Offering own methods. +* Register Objects:: Offering own services. * Signals:: Sending and receiving signals. * Alternative Buses:: Alternative buses and environments. * Errors and Events:: Errors and events. +* Monitoring Messages:: Monitoring messages. * Index:: Index including concepts, functions, variables. * GNU Free Documentation License:: The license for this documentation. @@ -162,12 +163,13 @@ registered names. Internally they use the basic interface @defun dbus-list-activatable-names &optional bus This function returns the D-Bus service names, which can be activated -for @var{bus}. It must be either the symbol @code{:system} (the -default) or the symbol @code{:session}. An activatable service is +for @var{bus}. It must be either the keyword @code{:system} (the +default) or the keyword @code{:session}. An activatable service is described in a service registration file. Under GNU/Linux, such files are located at @file{/usr/share/dbus-1/system-services/} (for the @code{:system} bus) or @file{/usr/share/dbus-1/services/}. An -activatable service is not necessarily registered at @var{bus} already. +activatable service is not necessarily registered at @var{bus} +already. The result is a list of strings, which is @code{nil} when there are no activatable service names at all. Example: @@ -186,7 +188,7 @@ there are no registered service names at all. Well known names are strings like @samp{org.freedesktop.DBus}. Names starting with @samp{:} are unique names for services. -@var{bus} must be either the symbol @code{:system} or the symbol +@var{bus} must be either the keyword @code{:system} or the keyword @code{:session}. @end defun @@ -196,7 +198,7 @@ known name in @var{bus}. A service has a known name if it doesn't start with @samp{:}. The result is a list of strings, which is @code{nil} when there are no known names at all. -@var{bus} must be either the symbol @code{:system} or the symbol +@var{bus} must be either the keyword @code{:system} or the keyword @code{:session}. @end defun @@ -206,7 +208,7 @@ For a given service, registered at D-Bus @var{bus} under the name result is a list of strings, or @code{nil} when there are no queued names for @var{service} at all. -@var{bus} must be either the symbol @code{:system} or the symbol +@var{bus} must be either the keyword @code{:system} or the keyword @code{:session}. @var{service} must be a known service name as string. @end defun @@ -217,7 +219,7 @@ For a given service, registered at D-Bus @var{bus} under the name owner. The result is a string, or @code{nil} when there is no name owner of @var{service}. -@var{bus} must be either the symbol @code{:system} or the symbol +@var{bus} must be either the keyword @code{:system} or the keyword @code{:session}. @var{service} must be a known service name as string. @end defun @@ -228,7 +230,7 @@ registered at D-Bus @var{bus}. If @var{service} has not yet started, it is autostarted if possible. The result is either @code{t} or @code{nil}. -@var{bus} must be either the symbol @code{:system} or the symbol +@var{bus} must be either the keyword @code{:system} or the keyword @code{:session}. @var{service} must be a string. @var{timeout}, a nonnegative integer, specifies the maximum number of milliseconds before @code{dbus-ping} must return. The default value is 25,000. @@ -256,7 +258,7 @@ it, you can instead write: This function returns the unique name, under which Emacs is registered at D-Bus @var{bus}, as a string. -@var{bus} must be either the symbol @code{:system} or the symbol +@var{bus} must be either the keyword @code{:system} or the keyword @code{:session}. @end defun @@ -375,7 +377,7 @@ must be strings. This function returns all interfaces and sub-nodes of @var{service}, registered at object path @var{path} at bus @var{bus}. -@var{bus} must be either the symbol @code{:system} or the symbol +@var{bus} must be either the keyword @code{:system} or the keyword @code{:session}. @var{service} must be a known service name, and @var{path} must be a valid object path. The last two parameters are strings. The result, the introspection data, is a string in XML @@ -732,8 +734,8 @@ A @var{property} value can be retrieved by the function @defun dbus-get-property bus service path interface property This function returns the value of @var{property} of @var{interface}. It will be checked at @var{bus}, @var{service}, @var{path}. The -result can be any valid D-Bus value, or @code{nil} if there is no -@var{property}. Example: +result can be any valid D-Bus value. If there is no @var{property}, +or @var{property} cannot be read, an error is raised. Example: @lisp (dbus-get-property @@ -744,26 +746,28 @@ result can be any valid D-Bus value, or @code{nil} if there is no @end lisp @end defun -@defun dbus-set-property bus service path interface property value +@defun dbus-set-property bus service path interface property [type] value This function sets the value of @var{property} of @var{interface} to @var{value}. It will be checked at @var{bus}, @var{service}, -@var{path}. When the value is successfully set, this function returns -@var{value}. Otherwise, it returns @code{nil}. Example: +@var{path}. @var{value} can be preceded by a @var{type} keyword. +When the value is successfully set, this function returns @var{value}. +Example: @lisp (dbus-set-property :session "org.kde.kaccess" "/MainApplication" - "com.trolltech.Qt.QApplication" "doubleClickInterval" 500) + "com.trolltech.Qt.QApplication" "doubleClickInterval" :uint16 500) @result{} 500 @end lisp @end defun @defun dbus-get-all-properties bus service path interface -This function returns all properties of @var{interface}. It will be -checked at @var{bus}, @var{service}, @var{path}. The result is a list -of cons. Every cons contains the name of the property, and its value. -If there are no properties, @code{nil} is returned. Example: +This function returns all readable properties of @var{interface}. It +will be checked at @var{bus}, @var{service}, @var{path}. The result +is a list of cons cells. Every cons cell contains the name of the +property, and its value. If there are no properties, @code{nil} is +returned. Example: @lisp (dbus-get-all-properties @@ -781,9 +785,9 @@ If there are no properties, @code{nil} is returned. Example: @defun dbus-get-all-managed-objects bus service path This function returns all objects at @var{bus}, @var{service}, @var{path}, and the children of @var{path}. The result is a list of -objects. Every object is a cons of an existing path name, and the -list of available interface objects. An interface object is another -cons, whose car is the interface name and cdr is the list of +objects. Every object is a cons cell of an existing path name, and +the list of available interface objects. An interface object is +another cons, whose car is the interface name and cdr is the list of properties as returned by @code{dbus-get-all-properties} for that path and interface. Example: @@ -997,8 +1001,8 @@ Other Lisp objects, like symbols or hash tables, are not accepted as input parameters. If it is necessary to use another D-Bus type, a corresponding type -symbol can be prepended to the corresponding Lisp object. Basic D-Bus -types are represented by the type symbols @code{:byte}, +keyword can be prepended to the corresponding Lisp object. Basic +D-Bus types are represented by the type keywords @code{:byte}, @code{:boolean}, @code{:int16}, @code{:uint16}, @code{:int32}, @code{:uint32}, @code{:int64}, @code{:uint64}, @code{:double}, @code{:string}, @code{:object-path}, @code{:signature} and @@ -1023,15 +1027,22 @@ but different to (dbus-call-method @dots{} :int32 @var{nat-number} :signature @var{string}) @end lisp -The value for a byte D-Bus type can be any integer in the range 0 -through 255. If a character is used as argument, modifiers -represented outside this range are stripped off. For example, -@code{:byte ?x} is equal to @code{:byte ?\M-x}, but it is not equal to -@code{:byte ?\C-x} or @code{:byte ?\M-\C-x}. Signed and unsigned -integer D-Bus types expect a corresponding integer value. +The value for a D-Bus byte type can be any natural number. If the +number is larger than 255, it is truncated to the least significant +byte. For example, @code{:byte 1025} is equal to @code{:byte 1}. If +a character is used as argument, modifiers represented outside this +range are stripped off. For example, @code{:byte ?x} is equal to +@code{:byte ?\M-x}, but it is not equal to @code{:byte ?\C-x} or +@code{:byte ?\M-\C-x}. + +Signed and unsigned D-Bus integer types expect a corresponding integer +value. A unix file descriptor is restricted to the values 0@dots{}9. + +If typed explicitly, a non-@code{nil} boolean value like +@code{:boolean 'symbol} is handled like @code{t} or @code{:boolean t}. A D-Bus compound type is always represented as a list. The @sc{car} -of this list can be the type symbol @code{:array}, @code{:variant}, +of this list can be the type keyword @code{:array}, @code{:variant}, @code{:struct} or @code{:dict-entry}, which would result in a corresponding D-Bus container. @code{:array} is optional, because this is the default compound D-Bus type for a list. @@ -1069,7 +1080,7 @@ elements of this array. Example: (format ; Body. "This is a test notification, raised from\n%S" (emacs-version)) '(:array) ; No actions (empty array of strings). - '(:array :signature "@{sv@}") ; No hints + '(:array :signature "@{sv@}") ; No hints ; (empty array of dictionary entries). :int32 -1) ; Default timeout. @@ -1206,7 +1217,7 @@ parameters from the object. @defun dbus-call-method bus service path interface method &optional :timeout timeout &rest args @anchor{dbus-call-method} This function calls @var{method} on the D-Bus @var{bus}. @var{bus} is -either the symbol @code{:system} or the symbol @code{:session}. +either the keyword @code{:system} or the keyword @code{:session}. @var{service} is the D-Bus service name to be used. @var{path} is the D-Bus object path, @var{service} is registered at. @var{interface} is @@ -1299,8 +1310,8 @@ emulate the @code{lshal} command on GNU/Linux systems: @defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout &rest args This function calls @var{method} on the D-Bus @var{bus} -asynchronously. @var{bus} is either the symbol @code{:system} or the -symbol @code{:session}. +asynchronously. @var{bus} is either the keyword @code{:system} or the +keyword @code{:session}. @var{service} is the D-Bus service name to be used. @var{path} is the D-Bus object path, @var{service} is registered at. @var{interface} is @@ -1340,11 +1351,17 @@ message arrives, and @var{handler} is called. Example: @end defun -@node Receiving Method Calls -@chapter Offering own methods. +@node Register Objects +@chapter Offering own services. @cindex method calls, returning @cindex returning method calls +@c https://wiki.ubuntu.com/DebuggingDBus + +You can offer an own service in D-Bus, which will be visible by other +D-Bus clients. See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html} +for a discussion of the design. + In order to register methods on the D-Bus, Emacs has to request a well known name on the D-Bus under which it will be available for other clients. Names on the D-Bus can be registered and unregistered using @@ -1354,7 +1371,7 @@ the following functions: This function registers the known name @var{service} on D-Bus @var{bus}. -@var{bus} is either the symbol @code{:system} or the symbol +@var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @var{service} is the service name to be registered on the D-Bus. It @@ -1390,7 +1407,7 @@ We already are the primary owner. This function unregisters all objects from D-Bus @var{bus}, that were registered by Emacs for @var{service}. -@var{bus} is either the symbol @code{:system} or the symbol +@var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @var{service} is the D-Bus service name of the D-Bus. It must be a @@ -1437,7 +1454,7 @@ The interface namespace @code{org.gnu.Emacs} used by Emacs. With this function, an application registers @var{method} on the D-Bus @var{bus}. -@var{bus} is either the symbol @code{:system} or the symbol +@var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @var{service} is the D-Bus service name of the D-Bus object @@ -1462,11 +1479,11 @@ cons cell, @var{handler} can return this object directly, instead of returning a list containing the object. If @var{handler} returns a reply message with an empty argument list, -@var{handler} must return the symbol @code{:ignore} in order -to distinguish it from @code{nil} (the boolean false). +@var{handler} must return the keyword @code{:ignore} in order to +distinguish it from @code{nil} (the boolean false). If @var{handler} detects an error, it shall return the list -@code{(:error @var{error-name} @var{error-message)}}. +@code{(:error @var{error-name} @var{error-message})}. @var{error-name} is a namespaced string which characterizes the error type, and @var{error-message} is a free text string. Alternatively, any Emacs signal @code{dbus-error} in @var{handler} raises a D-Bus @@ -1561,11 +1578,11 @@ The test then runs @end example @end defun -@defun dbus-register-property bus service path interface property access value &optional emits-signal dont-register-service +@defun dbus-register-property bus service path interface property access [type] value &optional emits-signal dont-register-service With this function, an application declares a @var{property} on the D-Bus @var{bus}. -@var{bus} is either the symbol @code{:system} or the symbol +@var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @var{service} is the D-Bus service name of the D-Bus. It must be a @@ -1578,10 +1595,12 @@ discussion of @var{dont-register-service} below). @var{property} is the name of the property of @var{interface}. @var{access} indicates, whether the property can be changed by other -services via D-Bus. It must be either the symbol @code{:read}, -@code{:write} or @code{:readwrite}. @var{value} is the initial value -of the property, it can be of any valid type (@xref{dbus-call-method}, -for details). +services via D-Bus. It must be either the keyword @code{:read}, +@code{:write} or @code{:readwrite}. + +@var{value} is the initial value of the property, it can be of any +valid type (@xref{dbus-call-method}, for details). @var{value} can be +preceded by a @var{type} keyword. If @var{property} already exists on @var{path}, it will be overwritten. For properties with access type @code{:read} this is the @@ -1603,7 +1622,9 @@ are constructed incrementally by adding single methods or properties at a time, @var{dont-register-service} can be used to prevent other clients from discovering the still incomplete interface. -@noindent Example: +@code{dbus-register-property} returns a Lisp object, which can be used +as argument in @code{dbus-unregister-object} for removing the +registration for @var{property}. Example: @lisp (dbus-register-property @@ -1668,9 +1689,9 @@ It is also possible to apply the @code{dbus-get-property}, @defun dbus-unregister-object object This function unregisters @var{object} from the D-Bus. @var{object} must be the result of a preceding @code{dbus-register-method}, -@code{dbus-register-property} or @code{dbus-register-signal} call -(@pxref{Signals}). It returns @code{t} if @var{object} has been -unregistered, @code{nil} otherwise. +@code{dbus-register-property}, @code{dbus-register-signal} +(@pxref{Signals}) or @code{dbus-register-monitor} call. It returns +@code{t} if @var{object} has been unregistered, @code{nil} otherwise. When @var{object} identifies the last method or property, which is registered for the respective service, Emacs releases its association @@ -1690,7 +1711,7 @@ This function is similar to @code{dbus-call-method}. The difference is, that there are no returning output parameters. The function emits @var{signal} on the D-Bus @var{bus}. @var{bus} is -either the symbol @code{:system} or the symbol @code{:session}. It +either the keyword @code{:system} or the keyword @code{:session}. It doesn't matter whether another object has registered for @var{signal}. Signals can be unicast or broadcast messages. For broadcast messages, @@ -1718,7 +1739,7 @@ arguments. They are converted into D-Bus types as described in With this function, an application registers for a signal on the D-Bus @var{bus}. -@var{bus} is either the symbol @code{:system} or the symbol +@var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @var{service} is the D-Bus service name used by the sending D-Bus @@ -1820,18 +1841,17 @@ Until now, we have spoken about the system and the session buses, which are the default buses to be connected to. However, it is possible to connect to any bus with a known address. This is a UNIX domain or TCP/IP socket. Everywhere, where a @var{bus} is mentioned -as argument of a function (the symbol @code{:system} or the symbol +as argument of a function (the keyword @code{:system} or the keyword @code{:session}), this address can be used instead. The connection to this bus must be initialized first. @defun dbus-init-bus bus &optional private This function establishes the connection to D-Bus @var{bus}. -@var{bus} can be either the symbol @code{:system} or the symbol +@var{bus} can be either the keyword @code{:system} or the keyword @code{:session}, or it can be a string denoting the address of the -corresponding bus. For the system and session buses, this function -is called when loading @file{dbus.el}, there is no need to call it -again. +corresponding bus. For the system and session buses, this function is +called when loading @file{dbus.el}, there is no need to call it again. The function returns the number of connections this Emacs session has established to the @var{bus} under the same unique name @@ -1843,11 +1863,12 @@ established. When @var{private} is non-@code{nil}, a new connection is established instead of reusing an existing one. It results in a new unique name -at the bus. This can be used, if it is necessary to distinguish from -another connection used in the same Emacs process, like the one -established by GTK+. It should be used with care for at least the -@code{:system} and @code{:session} buses, because other Emacs Lisp -packages might already use this connection to those buses. +at the @var{bus}. This can be used, if it is necessary to distinguish +from another connection used in the same Emacs process, like the one +established by GTK+. If @var{bus} is the keyword @code{:system} or +the keyword @code{:session}, the new private connection is identified +by the keywords @code{:system-private} or @code{:session-private}, +respectively. Example: You initialize a connection to the AT-SPI bus on your host: @@ -1890,7 +1911,7 @@ is supported depends on the bus daemon configuration, however. This function sets the value of the @var{bus} environment @var{variable} to @var{value}. -@var{bus} is either a Lisp symbol, @code{:system} or @code{:session}, +@var{bus} is either a Lisp keyword, @code{:system} or @code{:session}, or a string denoting the bus address. Both @var{variable} and @var{value} should be strings. @@ -1946,8 +1967,9 @@ appended to the @code{dbus-error}. @defspec dbus-ignore-errors forms@dots{} This executes @var{forms} exactly like a @code{progn}, except that -@code{dbus-error} errors are ignored during the @var{forms}. These -errors can be made visible when @code{dbus-debug} is set to @code{t}. +@code{dbus-error} errors are ignored during the @var{forms} (the macro +returns @code{nil} then). These errors can be made visible when +@code{dbus-debug} is set to non-@code{nil}. @end defspec Incoming D-Bus messages are handled as Emacs events, @pxref{Misc @@ -1955,27 +1977,37 @@ Events, , , elisp}. They are retrieved only, when Emacs runs in interactive mode. The generated event has this form: @lisp -(dbus-event @var{bus} @var{type} @var{serial} @var{service} @var{path} @var{interface} @var{member} @var{handler} - &rest @var{args}) +(dbus-event @var{bus} @var{type} @var{serial} @var{service} @var{destination} @var{path} @var{interface} @var{member} + @var{handler} &rest @var{args}) @end lisp @var{bus} identifies the D-Bus the message is coming from. It is -either the symbol @code{:system} or the symbol @code{:session}. +either a Lisp keyword, @code{:system}, @code{:session}, +@code{:system-private} or @code{:session-private}, or a string +denoting the bus address. @var{type} is the D-Bus message type which has caused the event. It can be @code{dbus-message-type-invalid}, @code{dbus-message-type-method-call}, @code{dbus-message-type-method-return}, @code{dbus-message-type-error}, or @code{dbus-message-type-signal}. -@var{serial} is the serial number of the received D-Bus message. +@var{serial} is the serial number of the received D-Bus message, +unless @var{type} is equal @code{dbus-message-type-error}. @var{service} and @var{path} are the unique name and the object path -of the D-Bus object emitting the message. @var{interface} and -@var{member} denote the message which has been sent. +of the D-Bus object emitting the message. @var{destination} is the +D-Bus name the message is dedicated to, or @code{nil} in case the +message is a broadcast signal. + +@var{interface} and @var{member} denote the message which has been +sent. When @var{type} is @code{dbus-message-type-error}, @var{member} +is the error name. @var{handler} is the callback function which has been registered for -this message (@pxref{Signals}). When a @code{dbus-event} event -arrives, @var{handler} is called with @var{args} as arguments. +this message (@pxref{Signals}). @var{args} are the typed arguments as +returned from the message. They are passed to @var{handler} without +type information, when it is called during event handling in +@code{dbus-handle-event}. In order to inspect the @code{dbus-event} data, you could extend the definition of the callback function in @ref{Signals}: @@ -1990,7 +2022,7 @@ callback function in order to retrieve the information from the event. @defun dbus-event-bus-name event This function returns the bus name @var{event} is coming from. The -result is either the symbol @code{:system} or the symbol +result is either the keyword @code{:system} or the keyword @code{:session}. @end defun @@ -2009,6 +2041,11 @@ This function returns the unique name of the D-Bus object @var{event} is coming from. @end defun +@defun dbus-event-destination-name event +This function returns the unique name of the D-Bus object @var{event} +is dedicated to. +@end defun + @defun dbus-event-path-name event This function returns the object path of the D-Bus object @var{event} is coming from. @@ -2024,10 +2061,20 @@ This function returns the member name of the D-Bus object @var{event} is coming from. It is either a signal name or a method name. @end defun +@defun dbus-event-handler event +This function returns the handler the D-Bus object @var{event} is +applied with. +@end defun + +@defun dbus-event-arguments event +This function returns the arguments the D-Bus object @var{event} is +carrying on. +@end defun + D-Bus errors are not propagated during event handling, because it is usually not desired. D-Bus errors in events can be made visible by -setting the variable @code{dbus-debug} to @code{t}. They can also be -handled by a hook function. +setting the variable @code{dbus-debug} to non-@code{nil}. They can +also be handled by a hook function. @defvar dbus-event-error-functions This hook variable keeps a list of functions, which are called when a @@ -2054,6 +2101,57 @@ D-Bus applications running. They should therefore check carefully, whether a given D-Bus error is related to them. +@node Monitoring Messages +@chapter Monitoring messages. +@cindex monitoring + +@defun dbus-register-monitor bus &optional handler &key type sender destination path interface member +This function registers @var{handler} for monitoring messages on the +D-Bus @var{bus}. + +@var{bus} is either a Lisp keyword, @code{:system} or @code{:session}, +or a string denoting the bus address. + +@findex dbus-monitor-handler +@var{handler} is the function to be called when a D-Bus event to be +monitored arrives. It is called with the @var{args} slot of the D-Bus +event (@pxref{Errors and Events}), which are stripped off the type +keywords. If @var{handler} is @code{nil}, the default handler +@code{dbus-monitor-handler} is applied. This default handler behaves +similar to the @command{dbus-monitor} program. + +The other arguments are keyword-value pairs. @code{:type @var{type}} +defines the message type to be monitored. If given, it must be equal +one of the strings @samp{method_call}, @samp{method_return}, +@samp{error} or @samp{signal}. + +@code{:sender @var{sender}} and @code{:destination @var{destination}} +are D-Bus names. They can be unique names, or well-known service +names. + +@code{:path @var{path}} is the D-Bus object to be monitored. +@code{:interface @var{interface}} is the name of an interface, and +@code{:member @var{member}} is either a method name, a signal name, or +an error name. + +@code{dbus-register-monitor} returns a Lisp object, which can be used +as argument in @code{dbus-unregister-object} for removing the monitor. + +The following form shows all D-Bus events on the session bus in buffer +@samp{*D-Bus Monitor*}: + +@lisp +(dbus-register-monitor :session) +@end lisp + +And this form restricts the monitoring on D-Bus errors: + +@lisp +(dbus-register-monitor :session nil :type "error") +@end lisp +@end defun + + @node Index @unnumbered Index diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index d7497806602..243b59b242a 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -150,10 +150,8 @@ Commands using file marking @noindent @file{dired-x.el} binds some functions to keys in Dired Mode (@pxref{Key -Index}) and also binds @kbd{C-x C-j} and @kbd{C-x 4 C-j} @emph{globally} to -@code{dired-jump} (@pxref{Miscellaneous Commands}). Optionally, it -also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} to -@code{dired-x-find-file} and @code{dired-x-find-file-other-window}, +Index}). Optionally, it also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} +to @code{dired-x-find-file} and @code{dired-x-find-file-other-window}, respectively (@pxref{Find File At Point}). @node Technical Details @@ -204,32 +202,10 @@ when you first type @kbd{C-x d}). @ifnottex @menu -* Optional Installation Dired Jump:: * Optional Installation File At Point:: @end menu @end ifnottex -@node Optional Installation Dired Jump -@section Optional Installation Dired Jump - -@cindex autoloading @code{dired-jump} and @code{dired-jump-other-window} - -In order to have @code{dired-jump} and @code{dired-jump-other-window} -(@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and -@code{dired-x} have been properly loaded you should set-up an autoload -for these functions. In your @file{.emacs} file put - -@example -(autoload 'dired-jump "dired-x" - "Jump to Dired buffer corresponding to current buffer." t) - -(autoload 'dired-jump-other-window "dired-x" - "Like \\[dired-jump] (dired-jump) but in other window." t) - -(define-key global-map "\C-x\C-j" 'dired-jump) -(define-key global-map "\C-x4\C-j" 'dired-jump-other-window) -@end example - @node Optional Installation File At Point @section Optional Installation File At Point @@ -919,28 +895,6 @@ inserted subdirectories. @table @code -@item dired-jump -@findex dired-jump -@kindex C-x C-j -@cindex jumping to Dired listing containing file. -Bound to @kbd{C-x C-j}. Jump back to Dired: If in a file, edit the current -directory and move to file's line. If in Dired already, pop up a level and -go to old directory's line. In case the proper Dired file line cannot be -found, refresh the Dired buffer and try again. - -@item dired-jump-other-window -@findex dired-jump-other-window -@kindex C-x 4 C-j -Bound to @kbd{C-x 4 C-j}. Like @code{dired-jump}, but to other window. - -These functions can be autoloaded so they work even though @file{dired-x.el} -has not been loaded yet (@pxref{Optional Installation Dired Jump}). - -@vindex dired-bind-jump -If the variable @code{dired-bind-jump} is @code{nil}, @code{dired-jump} will not be -bound to @kbd{C-x C-j} and @code{dired-jump-other-window} will not be bound to -@kbd{C-x 4 C-j}. - @item dired-vm @cindex reading mail. @kindex V diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index 412176986cc..63e3595a509 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -2436,7 +2436,7 @@ Argument @var{THIS} is the project to convert @var{PATH} to. @end deffn @deffn Method ede-name :AFTER this -Return the name of @var{THIS} targt. +Return the name of @var{THIS} target. @end deffn @deffn Method ede-target-buffer-in-sourcelist :AFTER this buffer source diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi index aeb5a261e49..b0200b47456 100644 --- a/doc/misc/edt.texi +++ b/doc/misc/edt.texi @@ -841,7 +841,7 @@ keys, as well. (For example, some people use it to bind the VT200 seldom used back-tick key (@samp{`}) to the function @samp{ESC-prefix} so it will behave like an @key{ESC} key.) The second function, @code{edt-bind-gold-key}, is used to bind emacs commands to gold key -sequences involving alpha-numeric keys, special character keys, and +sequences involving alphanumeric keys, special character keys, and control keys. The third function, @code{edt-bind-function-key}, is terminal dependent diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index bbfc86b111e..c875d58ef16 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -1188,9 +1188,9 @@ MS Windows, but this has still been insufficient to keep up with changes in printing technology from text and postscript based printers connected via ports that can be accessed directly, to graphical printers that are only accessible via USB@. For details, see -@uref{http://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs -Wiki}, @uref{http://www.emacswiki.org/emacs/PrintWithWebBrowser}, and -@uref{http://www.emacswiki.org/emacs/PrintFromWindowsExplorer}. +@uref{https://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs +Wiki}, @uref{https://www.emacswiki.org/emacs/PrintWithWebBrowser}, and +@uref{https://www.emacswiki.org/emacs/PrintFromWindowsExplorer}. @c ------------------------------------------------------------ @node Sub-processes @@ -1414,7 +1414,7 @@ continue to use bash as your subshell: @cindex cygwin mount points, using within Emacs The package -@uref{http://www.emacswiki.org/emacs/cygwin-mount.el, +@uref{https://www.emacswiki.org/emacs/cygwin-mount.el, cygwin-mount.el} teaches Emacs about Cygwin mount points. @node Dired ls @@ -1793,7 +1793,7 @@ do not need to add its installation directory to the @env{PATH}. @cindex Emacs distribution, checking digital signatures GNU Privacy Guard is a Free replacement for PGP, with Windows binaries -available. See @uref{http://www.gnupg.org/}. +available. See @uref{https://www.gnupg.org/}. @node Mouse wheel @section Why doesn't my wheel mouse work in Emacs? @@ -2131,7 +2131,7 @@ suggestions} for improving the interaction of perldb and Emacs. @cindex subprocesses, cygwin tools @vindex exec-path -@uref{http://www.cygwin.com/}. +@uref{https://www.cygwin.com/}. Cygwin is a popular complete POSIX emulation environment for Windows. Most of its tools can be used with Emacs, and it covers a wide range @@ -2281,7 +2281,7 @@ and you can view the FAQ by typing @kbd{C-h C-f}. Other resources include: @itemize @item @uref{https://www.gnu.org/software/emacs/, The Emacs homepage} @item @uref{https://www.gnu.org/software/emacs/manual/, Other Emacs manuals} -@item @uref{http://www.emacswiki.org/, Emacs Wiki} +@item @uref{https://www.emacswiki.org/, Emacs Wiki} @end itemize @node Mailing lists diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 3c1244101f4..1bc9d41f9bb 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -27,7 +27,7 @@ The same conditions apply to any derivative of the FAQ as apply to the FAQ itself. Every copy of the FAQ must include this notice or an approved translation, information on who is currently maintaining the FAQ and how to contact them (including their e-mail address), and information on where the -latest version of the FAQ is archived (including FTP information). +latest version of the FAQ is archived. The FAQ may be copied and redistributed under these conditions, except that the FAQ may not be embedded in a larger literary work unless that work @@ -400,7 +400,7 @@ archive can be browsed over the web at @uref{https://lists.gnu.org/r/, the GNU mail archive}. Web-based Usenet search services, such as -@uref{http://groups.google.com/groups/dir?q=gnu&, Google}, also +@uref{https://groups.google.com/groups/dir?q=gnu&, Google}, also archive the @code{gnu.*} groups. @node Reporting bugs @@ -865,7 +865,7 @@ Bulletin}, are at @uref{https://www.gnu.org/bulletins/bulletins.html} and -@uref{http://www.cs.pdx.edu/~trent/gnu/gnu.html} +@uref{https://www.cs.pdx.edu/~trent/gnu/gnu.html} @node Help installing Emacs @section Where can I get help in installing Emacs? @@ -1525,13 +1525,12 @@ customize, with completion. @cindex Syntax highlighting on a TTY @cindex Console, colors -In Emacs 21.1 and later, colors and faces are supported in non-windowed mode, -i.e., on Unix and GNU/Linux text-only terminals and consoles, and when -invoked as @samp{emacs -nw} on X, and MS-Windows. (Colors and faces were -supported in the MS-DOS port since Emacs 19.29.) Emacs automatically -detects color support at startup and uses it if available. If you think -that your terminal supports colors, but Emacs won't use them, check the -@code{termcap} entry for your display type for color-related +Colors and faces are supported in non-windowed mode, i.e., on Unix and +GNU/Linux text-only terminals and consoles, and when invoked as +@samp{emacs -nw} on X, MS-DOS and MS-Windows. Emacs automatically +detects color support at startup and uses it if available. If you +think that your terminal supports colors, but Emacs won't use them, +check the @code{termcap} entry for your display type for color-related capabilities. The command @kbd{M-x list-colors-display} pops up a window which @@ -2540,12 +2539,12 @@ To disable or change the way backups are made, @pxref{Backup Names,,, emacs, The GNU Emacs Manual}. @cindex Backup files in a single directory -Beginning with Emacs 21.1, 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 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}. +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 +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}. @node Disabling auto-save-mode @section How do I disable @code{auto-save-mode}? @@ -2719,8 +2718,7 @@ menus}), use: @cindex FAQ, @code{font-lock-mode} @code{font-lock-mode} is the standard way to have Emacs perform syntax -highlighting in the current buffer. It is enabled by default in Emacs -22.1 and later. +highlighting in the current buffer. It is enabled by default. With @code{font-lock-mode} turned on, different types of text will appear in different colors. For instance, in a programming mode, @@ -2730,13 +2728,6 @@ a third. To turn @code{font-lock-mode} off within an existing buffer, use @kbd{M-x font-lock-mode @key{RET}}. -In Emacs 21 and earlier versions, you could use the following code in -your @file{.emacs} file to turn on @code{font-lock-mode} globally: - -@lisp -(global-font-lock-mode 1) -@end lisp - Highlighting a buffer with @code{font-lock-mode} can take quite a while, and cause an annoying delay in display, so several features exist to work around this. @@ -3054,7 +3045,7 @@ if ("$term" == emacs) set term=dumb @cindex Debugging @file{.emacs} file An error occurred while loading either your @file{.emacs} file or the -system-wide file @file{site-lisp/default.el}. Emacs 21.1 and later pops the +system-wide file @file{site-lisp/default.el}. Emacs pops the @file{*Messages*} buffer, and puts there some additional information about the error, to provide some hints for debugging. @@ -3622,7 +3613,7 @@ For a list of other MS-DOS implementations of Emacs (and Emacs look-alikes), consult the list of ``Emacs implementations and literature,'' available at -@uref{http://www.finseth.com/emacs.html} +@uref{https://www.finseth.com/emacs.html} Note that while many of these programs look similar to Emacs, they often lack certain features, such as the Emacs Lisp extension language. @@ -3673,7 +3664,6 @@ See the file @file{nextstep/INSTALL} in the distribution. * Compose Character:: * Binding combinations of modifiers and function keys:: * Meta key does not work in xterm:: -* ExtendChar key does not work as Meta:: * SPC no longer completes file names:: @end menu @@ -3869,12 +3859,11 @@ You may be able to get a keyboard that is completely programmable, or a terminal emulator that supports remapping of any key to any other key. @item -With Emacs 21.1 and later, you can control the effect of the -@key{Backspace} and @key{Delete} keys, on both dumb terminals and a -windowed displays, by customizing the option -@code{normal-erase-is-backspace-mode}, or by invoking @kbd{M-x -normal-erase-is-backspace}. See the documentation of these symbols -(@pxref{Emacs Lisp documentation}) for more info. +You can control the effect of the @key{Backspace} and @key{Delete} +keys, on both dumb terminals and a windowed displays, by customizing +the option @code{normal-erase-is-backspace-mode}, or by invoking +@kbd{M-x normal-erase-is-backspace}. See the documentation of these +symbols (@pxref{Emacs Lisp documentation}) for more info. @item It is possible to swap the @key{Backspace} and @key{DEL} keys inside @@ -3925,9 +3914,9 @@ many modes that have local bindings of @key{DEL} that will interfere. @end itemize -When Emacs 21 or later runs on a windowed display, it binds the -@key{Delete} key to a command which deletes the character at point, to -make Emacs more consistent with keyboard operation on these systems. +When Emacs runs on a windowed display, it binds the @key{Delete} key +to a command which deletes the character at point, to make Emacs more +consistent with keyboard operation on these systems. For more information about troubleshooting this problem, see @ref{DEL Does Not Delete, , If @key{DEL} Fails to Delete, emacs, The GNU Emacs @@ -4149,29 +4138,6 @@ You might have to replace @samp{Meta} with @samp{Alt}. @end itemize -@node ExtendChar key does not work as Meta -@section Why doesn't my @key{ExtendChar} key work as a @key{Meta} key under HP-UX 8.0 and 9.x? -@cindex @key{ExtendChar} key as @key{Meta} -@cindex @key{Meta}, using @key{ExtendChar} for -@cindex HP-UX, the @key{ExtendChar} key - -This is a result of an internationalization extension in X11R4 and the -fact that HP is now using this extension. Emacs assumes that the -@code{XLookupString} function returns the same result regardless of the -@key{Meta} key state which is no longer necessarily true. Until Emacs -is fixed, the temporary kludge is to run this command after each time -the X server is started but preferably before any xterm clients are: - -@example -xmodmap -e 'remove mod1 = Mode_switch' -@end example - -@c FIXME: Emacs 21 supports I18N in X11; does that mean that this bug is -@c solved? - -This will disable the use of the extra keysyms systemwide, which may be -undesirable if you actually intend to use them. - @node SPC no longer completes file names @section Why doesn't @key{SPC} complete file names anymore? @cindex @kbd{SPC} file name completion diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 9180b4ec205..316a1baf576 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -476,7 +476,7 @@ to launch any external programs, set this variable to @code{nil} or @vindex mm-inline-font-lock If non-@code{nil}, inlined parts that support font locking (for instance, patches or code snippets) will be font-locked. This may be -overriden by callers that have their own ways of enabling/inhibiting +overridden by callers that have their own ways of enabling/inhibiting font locking. @end table diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index a35225256b6..cb2e83270e6 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -140,12 +140,12 @@ out. @item Connect to Freenode -Run @kbd{M-x erc}. Use ``irc.freenode.net'' as the IRC server, ``6667'' -as the port, and choose a nickname. +Run @kbd{M-x erc}. Use ``chat.freenode.net'' as the IRC server, +``6667'' as the port, and choose a nickname. @item Get used to the interface -Switch to the ``irc.freenode.net:6667'' buffer, if you're not already +Switch to the ``chat.freenode.net:6667'' buffer, if you're not already there. You will see first some messages about checking for ident, and then a bunch of other messages that describe the current IRC server. @@ -162,9 +162,10 @@ channel. If you would like to be able to talk with people privately on the Freenode network, you will have to ``register'' your nickname. To do -so, switch to the ``irc.freenode.net:6667'' buffer and type ``/msg +so, switch to the ``chat.freenode.net:6667'' buffer and type ``/msg NickServ register <password>'', replacing ``<password>'' with your -desired password. It should tell you that the operation was successful. +desired password. It should tell you that the operation was +successful. @item Talk to people in the channel @@ -518,7 +519,7 @@ That is, if called with the following arguments, @var{server} and parameters. @example -(erc :server "irc.freenode.net" :full-name "Harry S Truman") +(erc :server "chat.freenode.net" :full-name "Harry S Truman") @end example @end defun @@ -694,7 +695,8 @@ stuff, to the current ERC buffer." ;; This causes ERC to connect to the Freenode network upon hitting ;; C-c e f. Replace MYNICK with your IRC nick. (global-set-key "\C-cef" (lambda () (interactive) - (erc :server "irc.freenode.net" :port "6667" + (erc :server "chat.freenode.net" + :port "6667" :nick "MYNICK"))) ;; This causes ERC to connect to the IRC server on your own machine (if @@ -718,7 +720,7 @@ stuff, to the current ERC buffer." (setq erc-autojoin-channels-alist '(("freenode.net" "#emacs" "#erc"))) ;; Rename server buffers to reflect the current network name instead -;; of SERVER:PORT (e.g., "freenode" instead of "irc.freenode.net:6667"). +;; of SERVER:PORT (e.g., "freenode" instead of "chat.freenode.net:6667"). ;; This is useful when using a bouncer like ZNC where you have multiple ;; connections to the same server. (setq erc-rename-buffers t) diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 85be112402c..1bccbd7261a 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -93,14 +93,20 @@ default one, which is normally called @file{*eww*}. @findex eww-quit @findex eww-reload @findex eww-copy-page-url +@findex shr-maybe-probe-and-copy-url @kindex q @kindex w @kindex g If loading the URL was successful the buffer @file{*eww*} is opened and the web page is rendered in it. You can leave EWW by pressing @kbd{q} or exit the browser by calling @kbd{eww-quit}. To reload the -web page hit @kbd{g} (@code{eww-reload}). Pressing @kbd{w} -(@code{eww-copy-page-url}) will copy the current URL to the kill ring. +web page hit @kbd{g} (@code{eww-reload}). + + Pressing @kbd{w} when point is on a link will call +@code{shr-maybe-probe-and-copy-url}, which copies this link's +@acronym{URL} to the kill ring. If point is not on a link, pressing +@kbd{w} calls @code{eww-copy-page-url}, which will copy the current +page's URL to the kill ring instead. @findex eww-open-in-new-buffer @kindex M-RET @@ -212,6 +218,22 @@ in an external browser by customizing @node Advanced @chapter Advanced +@findex eww-retrieve-command + EWW normally uses @code{url-retrieve} to fetch the @acronym{HTML} +before rendering it. It can sometimes be convenient to use an +external program to do this, and @code{eww-retrieve-command} should +then be a list that specifies a command and the parameters. For +instance, to use the Chromium browser, you could say something like +this: + +@lisp +(setq eww-retrieve-command + '("chromium" "--headless" "--dump-dom")) +@end lisp + +The command should return the @acronym{HTML} on standard output, and +the data should use @acronym{UTF-8} as the charset. + @findex eww-view-source @kindex v @cindex Viewing Source diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 19dcb19de74..b4757938e99 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -103,7 +103,7 @@ should also display a tool-tip with the same information. @code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are commands that allow easy navigation to the next/previous erroneous -regions, respectively. If might be a good idea to map them to @kbd{M-n} +regions, respectively. It might be a good idea to map them to @kbd{M-n} and @kbd{M-p} in @code{flymake-mode}, by adding to your init file: @lisp @@ -465,7 +465,7 @@ string containing the text contained between those positions (if any), after the change was performed. @item @code{:changes-start} and @code{:changes-end} -The value is, repectively, the minimum and maximum buffer positions +The value is, respectively, the minimum and maximum buffer positions touched by the recent changes. These are provided for convenience and only if @code{:recent-changes} is also provided. diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi index 1b94bf90f66..20b0904ad1a 100644 --- a/doc/misc/forms.texi +++ b/doc/misc/forms.texi @@ -658,15 +658,6 @@ displayed record. You cannot delete or modify the fixed, explanatory text that comes from string formatting elements, but you can modify the actual field contents. -@ignore -@c This is for the Emacs 18 version only. -If the contents of the forms cannot be recognized properly, this is -signaled using a descriptive text. @xref{Error Messages}, for more info. -The cursor will indicate the last part of the forms which was -successfully parsed. It's important to avoid entering field contents -that would cause confusion with the field-separating fixed text. -@end ignore - If the variable @code{forms-modified-record-filter} is non-@code{nil}, it is called as a function before the new data is written to the data file. The function receives one argument, a vector that contains the @@ -795,23 +786,6 @@ The first element of a list which is an element of A list element was supplied in @code{forms-format-list} which was not a string, number or list. -@ignore -@c This applies to Emacs 18 only. -@c Error messages generated while a modified form is being analyzed. - -@item Parse error: not looking at `...' -When re-parsing the contents of a forms, the text shown could not -be found. - -@item Parse error: cannot find `...' -When re-parsing the contents of a forms, the text shown, which -separates two fields, could not be found. - -@item Parse error: cannot parse adjacent fields @var{xx} and @var{yy} -Fields @var{xx} and @var{yy} were not separated by text, so could not be -parsed again. -@end ignore - @item Warning: this record has @var{xx} fields instead of @var{yy} The number of fields in this record in the data file did not match @code{forms-number-of-fields}. Missing fields will be made empty. diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 9c1d2d0160a..adb812f5728 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -1757,7 +1757,7 @@ more then one article." (let ((archive-name (format "nnml:1.%s" - (replace-in-string gnus-newsgroup-name "^.*:" "")))) + (replace-regexp-in-string "^.*:" "" gnus-newsgroup-name)))) (gnus-summary-copy-article n archive-name))) @end example @noindent @@ -2144,7 +2144,7 @@ I need real-time help, where to find it? @subsubheading Answer -Point your IRC client to irc.freenode.net, channel #gnus. +Point your IRC client to chat.freenode.net, channel #gnus. @node FAQ 9 - Tuning Gnus @subsection Tuning Gnus diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 789b1dea52a..69ac05d5aa9 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -842,7 +842,6 @@ Formatting Variables * Formatting Fonts:: Making the formatting look colorful and nice. * Positioning Point:: Moving point to a position after an operation. * Tabulation:: Tabulating your output. -* Wide Characters:: Dealing with wide characters. Image Enhancements @@ -1738,12 +1737,6 @@ of doing your job. Note that this variable is used before @vindex gnus-no-groups-message Message displayed by Gnus when no groups are available. -@item gnus-use-backend-marks -@vindex gnus-use-backend-marks -If non-@code{nil}, Gnus will store article marks both in the -@file{.newsrc.eld} file and in the backends. This will slow down -group operation some. - @end table @@ -11980,6 +11973,11 @@ anything that isn't a newsgroup. This means that no external images will be fetched as a result of reading mail, so that nobody can use web bugs (and the like) to track whether you've read email. +@vindex gnus-global-groups +If you have specific private groups that you want to have treated as +if they were public groups, you can add the name of that group to the +@code{gnus-global-groups} list. + Also @pxref{Misc Article} for @code{gnus-inhibit-images}. @item gnus-html-cache-directory @@ -19491,6 +19489,11 @@ Variable to control whether use the locally stored @acronym{NOV} and articles when plugged, e.g., essentially using the Agent as a cache. The default is non-@code{nil}, which means to use the Agent as a cache. +@item gnus-agent-eagerly-store-articles +@vindex gnus-agent-eagerly-store-articles +If non-@code{nil} (which is the default), store all articles read in +agentized groups in the Agent cache. + @item gnus-agent-go-online @vindex gnus-agent-go-online If @code{gnus-agent-go-online} is @code{nil}, the Agent will never @@ -19908,7 +19911,7 @@ Substring matching. Fuzzy matching (@pxref{Fuzzy Matching}). @item r -Regexp matching +Regexp matching. @end table @item date @@ -19936,6 +19939,21 @@ Equal to number. @item > Greater than number. @end table + +@item body-strings + +These match types are available on the @samp{head} and @code{body} +``header types''. + +@table @kbd + +@item z +Substring matching. + +@item p +Regexp matching. +@end table + @end table @item @@ -19971,7 +19989,8 @@ To make things a bit more complicated, there are shortcuts. If you use a capital letter on either the second or third keys, Gnus will use defaults for the remaining one or two keystrokes. The defaults are ``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s -t}, and @kbd{I a R} is the same as @kbd{I a r t}. +t}, and @kbd{I a R} is the same as @kbd{I a r t}. (These shortcuts +are not available for the body matches.) These functions take both the numerical prefix and the symbolic prefix (@pxref{Symbolic Prefixes}). A numerical prefix says how much to lower @@ -20347,6 +20366,24 @@ this will match articles that were posted when it was April 1st where the article was posted from. Time zones are such wholesome fun for the whole family, eh?) +Finally, two actually useful match types for dates: @code{<} and +@code{>}. These will allow scoring on the relative age (in days) of +the articles. Here's an example score file using the method: + +@example +(("date" + (7 10 nil <) + (7 -10 nil >) + (14 -10 nil >))) +@end example + +This results in articles less than a week old getting a 10 point +increase, articles older than a week getting a 10 point decrease, and +articles older than two weeks getting a cumulative 20 point decrease. + +The day can also be a floating point number: To score articles less +than an hour old, you can say @samp{(0.04 10 nil <)}. + @item Head, Body, All These three match keys use the same match types as the @code{From} (etc.)@: header uses. @@ -20377,6 +20414,36 @@ key will lead to creation of @file{ADAPT} files.) @end enumerate @cindex score file atoms +@item score-fn +The value of this entry should be one or more user-defined function +names in parentheses. Each function will be called in order and the +returned value is required to be an integer. + +@example +(score-fn (custom-scoring)) +@end example + +The user-defined function is called with an associative list with the +keys @code{number subject from date id refs chars lines xref extra} +followed by the article's score before the function is run. + +The following (somewhat contrived) example shows how to use a +user-defined function that increases an article's score by 10 if the +year of the article's date is also mentioned in its subject. + +@example +(defun custom-scoring (article-alist score) + (let ((subject (cdr (assoc 'subject article-alist))) + (date (cdr (assoc 'date article-alist)))) + (if (string-match (number-to-string + (nth 5 (parse-time-string date))) + subject) + 10))) +@end example + +@code{score-fn} entries are permanent and can only be added or +modified directly in the @code{SCORE} file. + @item mark The value of this entry should be a number. Any articles with a score lower than this number will be marked as read. @@ -21384,8 +21451,8 @@ be nice. Gnus has various ways of finding articles that match certain criteria (from a particular author, on a certain subject, etc.). The simplest method is to enter a group and then either "limit" the summary buffer -to the desired articles using the limiting commands (@xref{Limiting}), -or searching through messages in the summary buffer (@xref{Searching +to the desired articles using the limiting commands (@pxref{Limiting}), +or searching through messages in the summary buffer (@pxref{Searching for Articles}). Limiting commands and summary buffer searching work on subsets of the @@ -21434,19 +21501,29 @@ maintained outside of Gnus. @subsection Basic Usage In the group buffer typing @kbd{G G} will search the group on the -current line by calling @code{gnus-group-make-search-group}. This prompts -for a query string, creates an ephemeral @code{nnselect} group containing -the articles that match this query, and takes you to a summary buffer -showing these articles. Articles may then be read, moved and deleted -using the usual commands. - -The @code{nnselect} group made in this way is an @code{ephemeral} -group, and will disappear upon exit from the group. However changes -made in the group are permanently reflected in the real groups from -which the articles are drawn. It is occasionally convenient to view -articles found through searching in their original group. You can -@emph{warp} (i.e., jump) to the original group for the article on the -current line with @kbd{A W}, aka @code{gnus-warp-to-article}. +current line by calling @code{gnus-group-read-ephemeral-search-group}. +This prompts for a query string, creates an ephemeral @code{nnselect} +group containing the articles that match this query, and takes you to +a summary buffer showing these articles. Articles may then be read, +moved and deleted using the usual commands. + +The @code{nnselect} group made in this way is @code{ephemeral}: it +will disappear upon exit from the group. However changes made in the +group are permanently reflected in the real groups from which the +articles are drawn. If you want to create a @emph{persistent} group +that sticks around after exit from the summary buffer, you can call +@code{gnus-group-make-search-group} (bound to @kbd{G g}). + +So you just performed a search whose results are so fabulous you +wished you had done a persistent search rather than an ephemeral one? +No problem; you can create such a group by calling +@code{gnus-summary-make-group-from-search} (bound to @kbd{C-c C-p}) +from the ephemeral summary buffer. + +It is occasionally convenient to view articles found through searching +in their original group. You can @emph{warp} (i.e., jump) to the +original group for the article on the current line with @kbd{A W}, aka +@code{gnus-warp-to-article}. You say you want to search more than just the group on the current line? No problem: just process-mark the groups you want to search. You want @@ -21454,16 +21531,17 @@ even more? Calling for an nnir search with the cursor on a topic heading will search all the groups under that heading. Still not enough? OK, in the server buffer -@code{gnus-group-make-search-group} (now bound to @kbd{G}) will search -all groups from the server on the current line. Too much? Want to -ignore certain groups when searching, like spam groups? Just +@code{gnus-group-read-ephemeral-search-group} (now bound to @kbd{G}) +will search all groups from the server on the current line. Too much? +Want to ignore certain groups when searching, like spam groups? Just customize @code{nnir-ignored-newsgroups}. One more thing: individual search engines may have special search -features. You can access these special features by giving a prefix-arg -to @code{gnus-group-make-search-group}. If you are searching multiple -groups with different search engines you will be prompted for the -special search features for each engine separately. +features. You can access these special features by giving a +prefix-arg to @code{gnus-group-read-ephemeral-search-group}. If you +are searching multiple groups with different search engines you will +be prompted for the special search features for each engine +separately. @node Setting up nnir @@ -22606,7 +22684,6 @@ lots of percentages everywhere. * Formatting Fonts:: Making the formatting look colorful and nice. * Positioning Point:: Moving point to a position after an operation. * Tabulation:: Tabulating your output. -* Wide Characters:: Dealing with wide characters. @end menu Currently Gnus uses the following formatting variables: @@ -22861,23 +22938,6 @@ This is the soft tabulator. 50 will be removed. This is the hard tabulator. -@node Wide Characters -@subsection Wide Characters - -Fixed width fonts in most countries have characters of the same width. -Some countries, however, use Latin characters mixed with wider -characters---most notable East Asian countries. - -The problem is that when formatting, Gnus assumes that if a string is 10 -characters wide, it'll be 10 Latin characters wide on the screen. In -these countries, that's not true. - -@vindex gnus-use-correct-string-widths -To help fix this, you can set @code{gnus-use-correct-string-widths} to -@code{t}. This makes buffer generation slower, but the results will be -prettier. The default value is @code{nil}. - - @node Window Layout @section Window Layout @cindex window layout @@ -23859,10 +23919,10 @@ The following variables customize the appearance of the smileys: @item smiley-style @vindex smiley-style Specifies the smiley style. Predefined smiley styles include -@code{low-color} (small 13x14 pixel, three-color images), @code{medium} -(more colorful images, 16x16 pixel), and @code{grayscale} (grayscale -images, 14x14 pixel). The default depends on the height of the default -face. +@code{emoji} (use emoji characters), @code{low-color} (small 13x14 +pixel, three-color images), @code{medium} (more colorful images, 16x16 +pixel), and @code{grayscale} (grayscale images, 14x14 pixel). The +default depends on the height of the default face. @item smiley-data-directory @vindex smiley-data-directory @@ -29361,7 +29421,7 @@ collection of @acronym{NOV} lines. @item @acronym{NOV} @cindex @acronym{NOV} @acronym{NOV} stands for News OverView, which is a type of news server -header which provide datas containing the condensed header information +header which provide data containing the condensed header information of articles. They are produced by the server itself; in the @code{nntp} back end Gnus uses the ones that the @acronym{NNTP} server makes, but Gnus makes them by itself for some backends (in particular, @code{nnml}). diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 5cb6b19181c..538c088282b 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -247,15 +247,15 @@ Here are a number of screenshots showing IDLWAVE in action: @itemize @bullet @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_nav.gif,An IDLWAVE buffer} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_nav.gif,An IDLWAVE buffer} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_keys.gif,A keyword being completed} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_keys.gif,A keyword being completed} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_help.gif,Online help text.} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_help.gif,Online help text.} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_ri.gif,Routine information displayed} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_ri.gif,Routine information displayed} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_bp.gif,Debugging code +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_bp.gif,Debugging code stopped at a breakpoint} @end itemize @end ifnottex diff --git a/doc/misc/info.texi b/doc/misc/info.texi index f3ab305e350..85e04a99608 100644 --- a/doc/misc/info.texi +++ b/doc/misc/info.texi @@ -798,17 +798,17 @@ in cross references and node names if it differs from the current file, so you can always know that you are going to be switching to another manual and which one. -However, Emacs normally hides some other text in cross-references. -If you put your mouse over the cross reference, then the information -appearing in a separate box (tool tip) or in the echo area will show -the full cross-reference including the file name and the node name of -the cross reference. If you have a mouse, just leave it over the -cross reference @xref{Top,, Overview of Texinfo, texinfo, Texinfo: -The GNU Documentation Format}, and watch what happens. If you -always like to have that information visible without having to move -your mouse over the cross reference, use @kbd{M-x visible-mode}, or -set @code{Info-hide-note-references} to a value other than @code{t} -(@pxref{Emacs Info Variables}). +Emacs normally hides some text in cross references. If you put your +mouse over the cross reference, then the information appearing in a +separate box (tool tip) or in the echo area will show the full +cross reference, including the file name and the node name of the +cross reference if it leads to another file. If you have a mouse, +just leave it over the next cross reference: @xref{Top,, Overview of +Texinfo, texinfo, Texinfo: The GNU Documentation Format}, and watch +what happens. If you always like to have that information visible +without having to move your mouse over the cross reference, use +@kbd{M-x visible-mode}, or set @code{Info-hide-note-references} to a +value other than @code{t} (@pxref{Emacs Info Variables}). @format >> Now type @kbd{n} to learn more commands. @@ -1227,12 +1227,20 @@ not scroll with the rest of the buffer, making these links always visible. @item Info-hide-note-references -As explained in earlier nodes, the Emacs version of Info normally -hides some text in menus and cross-references. You can completely -disable this feature, by setting this option to @code{nil}. Setting -it to a value that is neither @code{nil} nor @code{t} produces an -intermediate behavior, hiding a limited amount of text, but showing -all text that could potentially be useful. +As explained in earlier sections, the Emacs version of Info normally +hides some text in menus and cross references. It also replaces the +@samp{*note} prefix of each cross reference with a more grammatically +correct @samp{see}. This is the effect of the default value of this +option, @code{t}. Setting this option to @code{nil} disables both +hiding and replacing of the original cross reference text, and Emacs +will then display them as they are in the Info file. If you set it to +the value @code{hide}, Emacs will do the same as with @code{t}, but +will also remove @samp{*note} without replacing it with anything. +Setting it to any other non-@code{nil} value produces an intermediate +behavior, hiding a limited amount of text, but showing all text that +could potentially be useful, including the name of the node that is +the target of the cross reference and its file if it is different from +the current file. @item Info-scroll-prefer-subnodes If set to a non-@code{nil} value, @key{SPC} and @key{BACKSPACE} (or diff --git a/doc/misc/modus-themes.texi b/doc/misc/modus-themes.texi new file mode 100644 index 00000000000..de3ccd27c4b --- /dev/null +++ b/doc/misc/modus-themes.texi @@ -0,0 +1,2834 @@ +\input texinfo @c -*- texinfo -*- +@c %**start of header +@setfilename ../../info/modus-themes.info +@settitle Modus themes for GNU Emacs +@include docstyle.texi +@documentencoding UTF-8 +@documentlanguage en +@c %**end of header + +@include emacsver.texi + +@dircategory Emacs misc features +@direntry +* Modus Themes: (modus-themes). Highly accessible themes (WCAG AAA). +@end direntry + +@finalout +@titlepage +@title Modus themes for GNU Emacs +@author Protesilaos Stavrou (@email{info@@protesilaos.com}) +@end titlepage + +@ifnottex +@node Top +@top Modus themes for GNU Emacs + +This manual, written by Protesilaos Stavrou, describes the customization +options for the @samp{modus-operandi} and @samp{modus-vivendi} themes, and provides +every other piece of information pertinent to them. + +The documentation furnished herein corresponds to version 0.13.0, +released on 2020-10-08. Any reference to a newer feature which does +not yet form part of the latest tagged commit, is explicitly marked as +such. + +Copyright (C) 2020 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this +document under the terms of the GNU Free Documentation License, +Version 1.3 or any later version published by the Free Software +Foundation; with no Invariant Sections, with no Front-Cover Texts, +and with no Back-Cover Texts. + +@end quotation + +@end ifnottex + +@menu +* Overview:: +* Installation:: +* Enable and load:: +* Customization Options:: +* Advanced customization (do-it-yourself):: +* Face coverage:: +* Notes for individual packages:: +* Contributing:: +* Acknowledgements:: +* Meta:: +* External projects (ports):: +* GNU Free Documentation License:: + +@detailmenu +--- The Detailed Node Listing --- + +Overview + +* How do the themes look like:: +* Learn about the latest changes:: + +Installation + +* Install from the archives:: +* Install on GNU/Linux:: + +Install on GNU/Linux + +* Debian 11 Bullseye:: +* GNU Guix:: + +Enable and load + +* Load automatically:: +* Load at a given time or at sunset/sunrise:: +* Toggle between the themes on demand:: +* Configure options prior to loading:: + +Customization Options + +* Bold constructs:: Toggle bold constructs in code +* Slanted constructs:: Toggle slanted constructs (italics) in code +* Syntax highlighting:: Toggle subtle coloration in programming modes +* No mixed fonts:: Toggle mixing of font families +* Link underline:: Toggle underlined text in links +* Command prompts:: Choose among plain, subtle, or intense prompts +* Mode line:: Choose among plain, three-dimension, or moody-compliant styles +* Completion UIs:: Choose among standard, moderate, or opinionated looks +* Fringes:: Choose among plain, subtle, or intense fringe visibility +* Line highlighting:: Toggle intense style for current line highlighting +* Matching parentheses:: Toggle intense style for matching delimiters/parentheses +* Diffs:: Choose among intense, desaturated, or text-only diffs +* Org mode blocks:: Choose among plain, greyscale, or rainbow styles +* Heading styles:: Choose among several styles, also per heading level +* Scaled headings:: Toggle scaling of headings +* Headings' font:: Toggle proportionately spaced fonts in headings + +Scaled headings + +* Scaled heading sizes:: Specify rate of increase for scaled headings + +Advanced customization (do-it-yourself) + +* Tweak colors (DIY):: Declare your own palette overrides +* Font configs (DIY):: Optimise for mixed typeface buffers +* Org user faces (DIY):: Extend styles for org-mode keywords and priorities + +Face coverage + +* Supported packages:: Full list of covered face groups +* Covered indirectly:: +* Will NOT be supported:: + +Notes for individual packages + +* Note on company-mode overlay pop-up:: +* Note for ERC escaped color sequences:: +* Note for powerline or spaceline:: +* Note on shr colors:: +* Note for Helm grep:: +* Note on vc-annotate-background-mode:: + +Contributing + +* Sources of the themes:: +* Issues you can help with:: +* Merge requests:: Legal considerations for code patches + +@end detailmenu +@end menu + +@node Overview +@chapter Overview + +The Modus themes are designed for accessible readability. They conform +with the highest standard for color contrast between any given +combination of background and foreground values. This corresponds to +the WCAG AAA standard, which specifies a minimum rate of distance in +relative luminance of 7:1. + +Modus Operandi (@samp{modus-operandi}) is a light theme, while Modus Vivendi +(@samp{modus-vivendi}) is dark. Each theme's color palette is designed to +meet the needs of the numerous interfaces that are possible in the Emacs +computing environment. + +The overarching objective of this project is to always offer accessible +color combinations. There shall never be a compromise on this +principle. If there arises an inescapable trade-off between readability +and stylistic considerations, we will always opt for the former. + +To ensure that users have a consistently accessible experience, the +themes strive to achieve as close to full face coverage as possible +(see @ref{Face coverage}). + +Starting with version 0.12.0 and onwards, the themes are built into GNU +Emacs (current version is 0.13.0). + +@menu +* How do the themes look like:: +* Learn about the latest changes:: +@end menu + +@node How do the themes look like +@section How do the themes look like + +Check the web page with @uref{https://protesilaos.com/modus-themes-pictures/, the screen shots}. There are lots of scenarios on +display that draw attention to details and important aspects in the +design of the themes. They also showcase the numerous customization +options. + +@xref{Customization Options}. + +@node Learn about the latest changes +@section Learn about the latest changes + +Please refer to the @uref{https://protesilaos.com/modus-themes-changelog, web page with the change log}. It is comprehensive +and covers everything that goes into every tagged release of the themes. + +@node Installation +@chapter Installation + +The Modus themes are distributed with Emacs starting with version 28.1. +On older versions of Emacs, they can be installed using Emacs' package +manager or manually from their code repository. + +Modus Operandi (light theme) and Modus Vivendi (dark) are normally +distributed as standalone packages in Emacs-specific archives. There +also exist packages for GNU/Linux distributions. + +@menu +* Install from the archives:: +* Install on GNU/Linux:: +@end menu + +@node Install from the archives +@section Install from the archives + +@samp{modus-operandi-theme} and @samp{modus-vivendi-theme} are +available from the GNU ELPA archive, which is configured by default. + +Prior to querying any package archive, make sure to have updated the +index, with @samp{M-x package-refresh-contents}. Then all you need to do is +type @samp{M-x package-install} and specify the theme of your choice. + +@node Install on GNU/Linux +@section Install on GNU/Linux + +The themes are also available from the archives of some GNU/Linux +distributions. These should correspond to a tagged release rather than +building directly from the latest Git commit. It all depends on the +distro's packaging policies. + +@menu +* Debian 11 Bullseye:: +* GNU Guix:: +@end menu + +@node Debian 11 Bullseye +@subsection Debian 11 Bullseye + +The two themes are distributed as a single package for Debian and its +derivatives. Currently in the unstable and testing suites and should be +available in time for Debian 11 Bullseye (next stable). + +Get them with: + +@example +sudo apt install elpa-modus-themes +@end example + +@node GNU Guix +@subsection GNU Guix + +Users of either the Guix System (the distro) or just Guix (the package +manager) can get each theme as a standalone package. + +@example +guix package -i emacs-modus-operandi-theme +@end example + +And/or: + +@example +guix package -i emacs-modus-vivendi-theme +@end example + +@node Enable and load +@chapter Enable and load + +This section documents how to load the theme of your choice and how to +further control its initialization. It also includes some sample code +snippets that could help you in the task, especially if you intend to +use both Modus Operandi and Modus Vivendi. + +@menu +* Load automatically:: +* Load at a given time or at sunset/sunrise:: +* Toggle between the themes on demand:: +* Configure options prior to loading:: +@end menu + +@node Load automatically +@section Load automatically + +A simple way to load the theme from your Emacs initialization file is to +include either of the following expressions: + +@lisp +(load-theme 'modus-operandi t) ; Light theme +(load-theme 'modus-vivendi t) ; Dark theme +@end lisp + +Make sure to remove any other theme that is being loaded, otherwise you +might run into unexpected issues. + +Note that you can always @samp{M-x disable-theme} and specify an item. The +command does exactly what its name suggests. To deactivate all enabled +themes at once, in case you have multiple of them enabled, you may +evaluate the expression: + +@lisp +(mapc #'disable-theme custom-enabled-themes) +@end lisp + +@node Load at a given time or at sunset/sunrise +@section Load at a given time or at sunset/sunrise + +It is possible to schedule a time during the day at or after which a +given theme will be loaded.@footnote{Contributed on Reddit by user @samp{b3n} +@uref{https://www.reddit.com/r/emacs/comments/gdtqov/weekly_tipstricketc_thread/fq9186h/}.} + +@lisp +;; Light for the day +(load-theme 'modus-operandi t t) +(run-at-time "05:00" (* 60 60 24) + (lambda () + (enable-theme 'modus-operandi))) + +;; Dark for the night +(load-theme 'modus-vivendi t t) +(run-at-time "21:00" (* 60 60 24) + (lambda () + (enable-theme 'modus-vivendi))) +@end lisp + +A modified version of the above technique is to use the sunrise and +sunset as references, instead of specifying a fixed hour value.@footnote{Contributed directly by André Alexandre Gomes @uref{https://gitlab.com/aadcg}.} +If you set @samp{calendar-latitude} and @samp{calendar-longitude} (defined in the +built-in @samp{solar.el} library---read it with @samp{M-x find-library}), you can +automatically switch between both themes at the appropriate time-of-day. +Note that @emph{those calendar variables need to be set before loading the +themes}. + +@lisp +;; Define coordinates +(setq calendar-latitude 35.17 + calendar-longitude 33.36) + +;; Light at sunrise +(load-theme 'modus-operandi t t) +(run-at-time (nth 1 (split-string (sunrise-sunset))) + (* 60 60 24) + (lambda () + (enable-theme 'modus-operandi))) + +;; Dark at sunset +(load-theme 'modus-vivendi t t) +(run-at-time (nth 4 (split-string (sunrise-sunset))) + (* 60 60 24) + (lambda () + (enable-theme 'modus-vivendi))) +@end lisp + +For the sake of completeness, the @samp{load-theme} call in these snippets is +slightly different than the one shown in @ref{Load automatically}, because it +does not enable the theme directly: the subsequent @samp{enable-theme} does +that when needed. + +@node Toggle between the themes on demand +@section Toggle between the themes on demand + +With both themes available, it is possible to design a simple command to +switch between them on demand. + +@lisp +(defun modus-themes-toggle () + "Toggle between `modus-operandi' and `modus-vivendi' themes." + (interactive) + (if (eq (car custom-enabled-themes) 'modus-operandi) + (progn + (disable-theme 'modus-operandi) + (load-theme 'modus-vivendi t)) + (disable-theme 'modus-vivendi) + (load-theme 'modus-operandi t))) +@end lisp + +You could use @samp{(mapc #'disable-theme custom-enabled-themes)} instead of +disabling a single target, but you get the idea. + +@node Configure options prior to loading +@section Configure options prior to loading + +If you plan to use both themes and wish to apply styles consistently +(see @ref{Customization Options}), you could define wrapper functions around +the standard @samp{load-theme} command. These extend the simple function we +presented in @ref{Toggle between the themes on demand}. + +Here is a comprehensive setup (the values assigned to the variables are +just for the sake of this demonstration):@footnote{The @samp{defmacro} and @samp{dolist} +method were contributed on Reddit by user @samp{b3n}, +@uref{https://www.reddit.com/r/emacs/comments/gqsz8u/weekly_tipstricketc_thread/fsfakhg/}.} + +@lisp +(defmacro modus-themes-format-sexp (sexp &rest objects) + `(eval (read (format ,(format "%S" sexp) ,@@objects)))) + +(dolist (theme '("operandi" "vivendi")) + (modus-themes-format-sexp + (defun modus-%1$s-theme-load () + (setq modus-%1$s-theme-slanted-constructs t + modus-%1$s-theme-bold-constructs t + modus-%1$s-theme-fringes 'subtle ; @{nil,'subtle,'intense@} + modus-%1$s-theme-mode-line '3d ; @{nil,'3d,'moody@} + modus-%1$s-theme-faint-syntax nil + modus-%1$s-theme-intense-hl-line nil + modus-%1$s-theme-intense-paren-match nil + modus-%1$s-theme-no-link-underline t + modus-%1$s-theme-no-mixed-fonts nil + modus-%1$s-theme-prompts nil ; @{nil,'subtle,'intense@} + modus-%1$s-theme-completions 'moderate ; @{nil,'moderate,'opinionated@} + modus-%1$s-theme-diffs nil ; @{nil,'desaturated,'fg-only@} + modus-%1$s-theme-org-blocks 'greyscale ; @{nil,'greyscale,'rainbow@} + modus-%1$s-theme-headings ; Read further below in the manual for this one + '((1 . section) + (2 . line) + (t . rainbow-line-no-bold)) + modus-%1$s-theme-variable-pitch-headings nil + modus-%1$s-theme-scale-headings t + modus-%1$s-theme-scale-1 1.1 + modus-%1$s-theme-scale-2 1.15 + modus-%1$s-theme-scale-3 1.21 + modus-%1$s-theme-scale-4 1.27 + modus-%1$s-theme-scale-5 1.33) + (load-theme 'modus-%1$s t)) + theme)) + +(defun modus-themes-toggle () + "Toggle between `modus-operandi' and `modus-vivendi' themes." + (interactive) + (if (eq (car custom-enabled-themes) 'modus-operandi) + (progn + (disable-theme 'modus-operandi) + (modus-vivendi-theme-load)) + (disable-theme 'modus-vivendi) + (modus-operandi-theme-load))) +@end lisp + +@node Customization Options +@chapter Customization Options + +The Modus themes are highly configurable, though they should work well +without any further tweaks. + +By default, all customization options are set to @samp{nil}. + +All customization options need to be evaluated before loading their +theme (@pxref{Enable and load}). + +@menu +* Bold constructs:: Toggle bold constructs in code +* Slanted constructs:: Toggle slanted constructs (italics) in code +* Syntax highlighting:: Toggle subtle coloration in programming modes +* No mixed fonts:: Toggle mixing of font families +* Link underline:: Toggle underlined text in links +* Command prompts:: Choose among plain, subtle, or intense prompts +* Mode line:: Choose among plain, three-dimension, or moody-compliant styles +* Completion UIs:: Choose among standard, moderate, or opinionated looks +* Fringes:: Choose among plain, subtle, or intense fringe visibility +* Line highlighting:: Toggle intense style for current line highlighting +* Matching parentheses:: Toggle intense style for matching delimiters/parentheses +* Diffs:: Choose among intense, desaturated, or text-only diffs +* Org mode blocks:: Choose among plain, greyscale, or rainbow styles +* Heading styles:: Choose among several styles, also per heading level +* Scaled headings:: Toggle scaling of headings +* Headings' font:: Toggle proportionately spaced fonts in headings +@end menu + +@node Bold constructs +@section Option for more bold constructs + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-bold-constructs} +@item +@samp{modus-vivendi-theme-bold-constructs} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Display several constructs in bold weight. This concerns keywords and +other important aspects of code syntax. It also affects certain mode +line indicators and command-line prompts. + +The default is to only use a bold weight when it is required. + +Additionally, and while not necessary, to define the precise weight for +bold constructs, you can change the typographic intensity of the @samp{bold} +face. The standard is a bold weight. It requires no further +intervention. Assuming though that your typeface of choice supports a +``semibold'' weight, adding the following snippet to your init file should +suffice. + +@lisp +(set-face-attribute 'bold nil :weight 'semibold) +@end lisp + +Note that if you are switching themes, you need to re-evaluate this +expression after the new theme is loaded. + +@node Slanted constructs +@section Option for more slanted constructs + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-slanted-constructs} +@item +@samp{modus-vivendi-theme-slanted-constructs} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Choose to render more faces in slanted text (italics). This typically +affects documentation strings and code comments. + +The default is to not use italics unless it is absolutely necessary. + +@node Syntax highlighting +@section Option for faint code syntax highlighting + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-faint-syntax} +@item +@samp{modus-vivendi-theme-faint-syntax} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Use less saturated colors in programming modes for highlighting code +syntax. The default is to use saturated colors. + +This option essentially affects the font-lock faces, so it may also have +implications in other places that are hard-wired to rely directly on +them instead of specifying their own faces (which could inherit from +font-lock if that is the intent). The author is aware of @samp{vc-dir} as a +case in point. + +@node No mixed fonts +@section Option for no font mixing + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-no-mixed-fonts} +@item +@samp{modus-vivendi-theme-no-mixed-fonts} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +By default, the themes configure some spacing-sensitive faces, such as +Org tables and code blocks, to always inherit from the @samp{fixed-pitch} face. +This is to ensure that those constructs remain monospaced when users opt +for something like the built-in @kbd{M-x variable-pitch-mode}. Otherwise the +layout would appear broken. To disable this behaviour, set the option +to @samp{t}. + +Users may prefer to use another package for handling mixed typeface +configurations, rather than letting the theme do it, perhaps because a +purpose-specific package has extra functionality. Two possible options +are @samp{org-variable-pitch} and @samp{mixed-pitch}. + +@node Link underline +@section Option for no link underline + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-no-link-underline} +@item +@samp{modus-vivendi-theme-no-link-underline} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Remove the underline effect from links, symbolic links, and buttons. +The default is to apply an underline. + +@node Command prompts +@section Option for command prompt styles + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-prompts} +@item +@samp{modus-vivendi-theme-prompts} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{subtle} +@item +@samp{intense} +@end enumerate + +The symbols ``subtle'' and ``intense'' will apply a combination of accented +background and foreground to the minibuffer and other REPL prompts (like +@samp{M-x shell} and @samp{M-x eshell}). The difference between the two is that the +latter has a more pronounced/noticeable effect than the former. + +The default does not use any background for such prompts, while relying +exclusively on an accented foreground color. + +@node Mode line +@section Option for mode line presentation + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-mode-line} +@item +@samp{modus-vivendi-theme-mode-line} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{3d} +@item +@samp{moody} +@end enumerate + +The default value (@samp{nil}) produces a two-dimensional effect both for the +active and inactive modelines. The differences between the two are +limited to distinct shades of greyscale values, with the active being +more intense than the inactive. + +A @samp{3d} symbol will make the active modeline look like a three-dimensional +rectangle. Inactive modelines remain 2D, though they are slightly toned +down relative to the default. This aesthetic is the same as what you +get when you run Emacs without any customizations (@kbd{emacs -Q} on the +command line). + +While @samp{moody} removes all box effects from the modelines and applies +underline and overline properties instead. It also tones down a bit the +inactive modelines. This is meant to optimize things for use with the +@uref{https://github.com/tarsius/moody, moody package} (hereinafter referred to as ``Moody''), though it can work +fine even without it. + +Note that Moody does not expose any faces that the themes could style +directly. Instead it re-purposes existing ones to render its tabs and +ribbons. As such, there may be cases where the contrast ratio falls +below the 7:1 target that the themes conform with (WCAG AAA). To hedge +against this, we configure a fallback foreground for the @samp{moody} option, +which will come into effect when the background of the modeline changes +to something less accessible, such as Moody ribbons (read the doc string +of @samp{set-face-attribute}, specifically @samp{:distant-foreground}). This fallback +comes into effect when Emacs determines that the background and +foreground of the given construct are too close to each other in terms +of color distance. In effect, users would need to experiment with the +variable @samp{face-near-same-color-threshold} to trigger the fallback color. +We find that a value of @samp{45000} would suffice, contrary to the default +@samp{30000}. Do not set the value too high, because that would have the +adverse effect of always overriding the default color (which has been +carefully designed to be highly accessible). + +Furthermore, because Moody expects an underline and overline instead of +a box style, it is recommended you also include this in your setup: + +@lisp +(setq x-underline-at-descent-line t) +@end lisp + +@node Completion UIs +@section Option for completion framework aesthetics + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-completions} +@item +@samp{modus-vivendi-theme-completions} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{moderate} +@item +@samp{opinionated} +@end enumerate + +This is a special option that has different effects depending on the +completion UI@. The interfaces can be grouped in two categories, based +on their default aesthetics: (i) those that only or mostly use +foreground colors for their interaction model, and (ii) those that +combine background and foreground values for some of their metaphors. +The former category encompasses Icomplete, Ido, Selectrum as well as +pattern matching styles like Orderless and Flx. The latter covers Helm, +Ivy, and similar. + +A value of @samp{nil} will respect the metaphors of each completion framework. + +The symbol @samp{moderate} will apply a combination of background and +foreground that is fairly subtle. For Icomplete and friends this +constitutes a departure from their default aesthetics, however the +difference is small. While Helm et al will appear slightly different +than their original looks, as they are toned down a bit. + +The symbol @samp{opinionated} will apply color combinations that refashion the +completion UI@. For the Icomplete camp this means that intense +background and foreground combinations are used: in effect their looks +emulate those of Ivy and co. in their original style. Whereas the other +group of packages will revert to an even more nuanced aesthetic with +some additional changes to the choice of hues. + +To appreciate the scope of this customization option, you should spend +some time with every one of the @samp{nil} (default), @samp{moderate}, and @samp{opinionated} +possibilities. + +@node Fringes +@section Option for fringe visibility + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-fringes} +@item +@samp{modus-vivendi-theme-fringes} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{subtle} +@item +@samp{intense} +@end enumerate + +The ``subtle'' symbol will apply a greyscale background that is visible, +yet close enough to the main background color. While the ``intense'' +symbol will use a more noticeable greyscale background. + +The default is to use the same color as that of the main background, +meaning that the fringes are not obvious though they still occupy the +space given to them by @samp{fringe-mode}. + +@node Line highlighting +@section Option for line highlighting (hl-line-mode) + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-intense-hl-line} +@item +@samp{modus-vivendi-theme-intense-hl-line} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Draw the current line of @samp{hl-line-mode} or its global equivalent in a more +prominent background color. This would also affect several packages +that enable @samp{hl-line-mode}, such as @samp{elfeed} and @samp{mu4e}. + +The default is to use a more subtle gray. + +@node Matching parentheses +@section Option for parenthesis matching (show-paren-mode) + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-intense-paren-match} +@item +@samp{modus-vivendi-theme-intense-paren-match} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Apply a more intense background to the matching parentheses (or +delimiters). This affects tools such as the built-in @samp{show-paren-mode}. +The default is to use a subtle warm color for the background of those +overlays. + +@node Diffs +@section Option for diff buffer looks + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-diffs} +@item +@samp{modus-vivendi-theme-diffs} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{desaturated} +@item +@samp{fg-only} +@end enumerate + +By default the themes will apply richly colored backgrounds to the +output of diffs, such as those of @samp{diff-mode}, @samp{ediff}, @samp{smerge-mode}, and +@samp{magit}. These are color combinations of an accented background and +foreground so that, for example, added lines have a pronounced green +background with an appropriate shade of green for the affected text. +Word-wise or ``refined'' changes follow this pattern but use different +shades of those colors to remain distinct. + +A @samp{desaturated} value tones down all relevant color values. It still +combines an accented background with an appropriate foreground, yet its +overall impression is very subtle. Refined changes are a bit more +intense to fulfil their intended function, though still less saturated +than default. + +While @samp{fg-only} will remove all accented backgrounds and instead rely on +color-coded text to denote changes. For instance, added lines use an +intense green foreground, while their background is the same as the rest +of the buffer. Word-wise highlights still use a background value which +is, nonetheless, more subtle than its default equivalent. + +Concerning @samp{magit}, an extra set of tweaks are introduced for the effect +of highlighting the current diff hunk, so as to remain consistent with +the overall experience of that mode. Expect changes that are consistent +with the overall intent of the aforementioned. + +@node Org mode blocks +@section Option for org-mode block styles + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-org-blocks} +@item +@samp{modus-vivendi-theme-org-blocks} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{greyscale} +@item +@samp{rainbow} +@end enumerate + +The default is to use the same background as the rest of the buffer for +the contents of the block. + +A value of @samp{greyscale} will apply a subtle neutral gray background to the +block's contents. It will also extend to the edge of the window the +background of the ``begin'' and ``end'' block delimiter lines (only relevant +for Emacs versions >= 27 where the 'extend' keyword is recognised by +@samp{set-face-attribute}). + +While @samp{rainbow} will instead use an accented background for the contents +of the block. The exact color will depend on the programming language +and is controlled by the @samp{org-src-block-faces} variable (refer to the +theme's source code for the current association list). This is most +suitable for users who work on literate programming documents that mix +and match several languages. + +Note that the ``rainbow'' blocks may require you to also reload the +major-mode so that the colors are applied properly: use @kbd{M-x org-mode} or +@kbd{M-x org-mode-restart} to refresh the buffer. Or start typing in each +code block (inefficient at scale, but it still works). + +@node Heading styles +@section Option for headings' overall style + +This is defined as an alist and, therefore, uses a different approach +than other customization options documented in this manual. + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-headings} +@item +@samp{modus-vivendi-theme-headings} +@end itemize + +Possible values, which can be specified for each heading level (examples +further below): + +@itemize +@item +nil (default fallback option---covers all heading levels) +@item +@samp{t} (default style for a single heading, when the fallback differs) +@item +@samp{no-bold} +@item +@samp{line} +@item +@samp{line-no-bold} +@item +@samp{rainbow} +@item +@samp{rainbow-line} +@item +@samp{rainbow-line-no-bold} +@item +@samp{highlight} +@item +@samp{highlight-no-bold} +@item +@samp{rainbow-highlight} +@item +@samp{rainbow-highlight-no-bold} +@item +@samp{section} +@item +@samp{section-no-bold} +@item +@samp{rainbow-section} +@item +@samp{rainbow-section-no-bold} +@end itemize + +To control faces per level from 1-8, use something like this (same for +@samp{modus-vivendi-theme-headings}): + +@lisp +(setq modus-operandi-theme-headings + '((1 . section) + (2 . line) + (3 . highlight) + (t . rainbow-no-bold))) +@end lisp + +The above uses the @samp{section} value for heading levels 1, the @samp{line} for +headings 2, @samp{highlight} for 3. All other levels fall back to +@samp{rainbow-line-no-bold}. + +To set a uniform value for all heading levels, use this pattern: + +@lisp +;; A given style for every heading +(setq modus-operandi-theme-headings + '((t . rainbow-line-no-bold))) + +;; Default aesthetic for every heading +(setq modus-operandi-theme-headings + '((t . nil))) +@end lisp + +The default style for headings uses a fairly desaturated foreground +value in combination with a bold typographic weight. To specify this +style for a given level N (assuming you wish to have another fallback +option), just specify the value @samp{t} like this: + +@lisp +(setq modus-operandi-theme-headings + '((1 . t) + (2 . line) + (t . rainbow-line-no-bold))) +@end lisp + +A description of all other possible styles: + +@itemize +@item +@samp{no-bold} retains the default text color while removing the typographic +weight. + +@item +@samp{line} is the same as the default plus an overline over the heading. + +@item +@samp{line-no-bold} is the same as @samp{line} without bold weight. + +@item +@samp{rainbow} uses a more colorful foreground in combination with bold +weight. + +@item +@samp{rainbow-line} is the same as @samp{rainbow} plus an overline. + +@item +@samp{rainbow-line-no-bold} is the same as @samp{rainbow-line} without the bold +weight. + +@item +@samp{highlight} retains the default style of a fairly desaturated foreground +combined with a bold weight and adds to it a subtle accented +background. + +@item +@samp{highlight-no-bold} is the same as @samp{highlight} without a bold weight. + +@item +@samp{rainbow-highlight} is the same as @samp{highlight} but with a more colorful +foreground. + +@item +@samp{rainbow-highlight-no-bold} is the same as @samp{rainbow-highlight} without a +bold weight. + +@item +@samp{section} retains the default looks and adds to them both an overline +and a slightly accented background. It is, in effect, a combination +of the @samp{line} and @samp{highlight} values. + +@item +@samp{section-no-bold} is the same as @samp{section} without a bold weight. + +@item +@samp{rainbow-section} is the same as @samp{section} but with a more colorful +foreground. + +@item +@samp{rainbow-section-no-bold} is the same as @samp{rainbow-section} without a bold +weight.`` +@end itemize + +@node Scaled headings +@section Option for scaled headings + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-scale-headings} +@item +@samp{modus-vivendi-theme-scale-headings} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Make headings larger in height relative to the main text. This is +noticeable in modes like Org. The default is to use the same size for +headings and body copy. + +@menu +* Scaled heading sizes:: Specify rate of increase for scaled headings +@end menu + +@node Scaled heading sizes +@subsection Control the scale of headings + +In addition to toggles for enabling scaled headings, users can also +specify a number of their own. + +@itemize +@item +If it is a floating point, say, @samp{1.5}, it is interpreted as a multiple +of the base font size. This is the recommended method. + +@item +If it is an integer, it is read as an absolute font height. The +number is basically the point size multiplied by ten. So if you want +it to be @samp{18pt} you must pass @samp{180}. Please understand that setting an +absolute value is discouraged, as it will break the layout when you +try to change font sizes with the built-in @samp{text-scale-adjust} command +(see @ref{Font configs (DIY), , Font configurations}). +@end itemize + +Below are the variables in their default values, using the floating +point paradigm. The numbers are very conservative, but you are free to +change them to your liking, such as @samp{1.2}, @samp{1.4}, @samp{1.6}, @samp{1.8}, @samp{2.0}---or use a +resource for finding a consistent scale: + +@lisp +(setq modus-operandi-theme-scale-1 1.05 + modus-operandi-theme-scale-2 1.1 + modus-operandi-theme-scale-3 1.15 + modus-operandi-theme-scale-4 1.2 + modus-operandi-theme-scale-5 1.3) + +(setq modus-vivendi-theme-scale-1 1.05 + modus-vivendi-theme-scale-2 1.1 + modus-vivendi-theme-scale-3 1.15 + modus-vivendi-theme-scale-4 1.2 + modus-vivendi-theme-scale-5 1.3) +@end lisp + +Note that in earlier versions of Org, scaling would only increase the +size of the heading, but not of keywords that were added to it, like +``TODO''. The issue has been fixed upstream: +@uref{https://protesilaos.com/codelog/2020-09-24-org-headings-adapt/}. + +@node Headings' font +@section Option for variable-pitch font in headings + +Symbol names: + +@itemize +@item +@samp{modus-operandi-theme-variable-pitch-headings} +@item +@samp{modus-vivendi-theme-variable-pitch-headings} +@end itemize + +Possible values: + +@enumerate +@item +@samp{nil} (default) +@item +@samp{t} +@end enumerate + +Choose to apply a proportionately spaced, else ``variable-pitch'', +typeface to headings (such as in Org mode). The default is to use the +main font family. + +@ref{Font configs (DIY), , Font configurations for Org (and others)}. + +@node Advanced customization (do-it-yourself) +@chapter Advanced customization (do-it-yourself) + +Unlike the predefined customization options which follow a +straightforward pattern of allowing the user to quickly specify their +preference, the themes also provide a more flexible, albeit difficult, +mechanism to control things with precision (see @ref{Customization Options}). + +This section is of interest only to users who are prepared to maintain +their own local tweaks and who are willing to deal with any possible +incompatibilities between versioned releases of the themes. As such, +they are labelled as ``do-it-yourself'' or ``DIY''. + +@menu +* Tweak colors (DIY):: Declare your own palette overrides +* Font configs (DIY):: Optimise for mixed typeface buffers +* Org user faces (DIY):: Extend styles for org-mode keywords and priorities +@end menu + +@node Tweak colors (DIY) +@section Full access to the themes' palette + +The variables are: + +@itemize +@item +@samp{modus-operandi-theme-override-colors-alist} +@item +@samp{modus-vivendi-theme-override-colors-alist} +@end itemize + +Users can specify an association list that maps the names of color +variables to hexadecimal RGB values (in the form of @samp{#RRGGBB}). This +means that it is possible to override the entire palette or subsets +thereof (see the source code for the actual names and values). + +Example: + +@lisp +;; Redefine the values of those three variables for the given theme +(setq modus-vivendi-theme-override-colors-alist + '(("magenta" . "#ffaabb") + ("magenta-alt" . "#ee88ff") + ("magenta-alt-other" . "#bbaaff"))) +@end lisp + +If you want to be creative, you can define a minor mode that refashions +the themes on demand. The following is a minor mode that gets activated +on demand. We combine it with the function to switch between Modus +Operandi and Modus Vivendi (@pxref{Toggle between the themes on demand}, for +a basic command, and/or @pxref{Configure options prior to loading}, for a more +comprehensive setup). + +@lisp +(define-minor-mode modus-themes-alt-mode + "Override Modus themes' palette variables with custom values. + +This is intended as a proof-of-concept. It is, nonetheless, a +perfectly accessible alternative, conforming with the design +principles of the Modus themes. It still is not as good as the +default colors." + :init-value nil + :global t + (if modus-themes-alt-mode + (setq modus-operandi-theme-override-colors-alist + '(("bg-main" . "#fefcf4") + ("bg-dim" . "#faf6ef") + ("bg-alt" . "#f7efe5") + ("bg-hl-line" . "#f4f0e3") + ("bg-active" . "#e8dfd1") + ("bg-inactive" . "#f6ece5") + ("bg-region" . "#c6bab1") + ("bg-header" . "#ede3e0") + ("bg-tab-bar" . "#dcd3d3") + ("bg-tab-active" . "#fdf6eb") + ("bg-tab-inactive" . "#c8bab8") + ("fg-unfocused" . "#55556f")) + modus-vivendi-theme-override-colors-alist + '(("bg-main" . "#100b17") + ("bg-dim" . "#161129") + ("bg-alt" . "#181732") + ("bg-hl-line" . "#191628") + ("bg-active" . "#282e46") + ("bg-inactive" . "#1a1e39") + ("bg-region" . "#393a53") + ("bg-header" . "#202037") + ("bg-tab-bar" . "#262b41") + ("bg-tab-active" . "#120f18") + ("bg-tab-inactive" . "#3a3a5a") + ("fg-unfocused" . "#9a9aab"))) + (setq modus-operandi-theme-override-colors-alist nil + modus-vivendi-theme-override-colors-alist nil))) + +(defun modus-themes-toggle (&optional arg) + "Toggle between `modus-operandi' and `modus-vivendi' themes. + +With optional \\[universal-argument] prefix, enable +`modus-themes-alt-mode' for the loaded theme." + (interactive "P") + (if arg + (modus-themes-alt-mode 1) + (modus-themes-alt-mode -1)) + (if (eq (car custom-enabled-themes) 'modus-operandi) + (progn + (disable-theme 'modus-operandi) + (load-theme 'modus-vivendi t)) + (disable-theme 'modus-vivendi) + (load-theme 'modus-operandi t))) +@end lisp + +@printindex cp + +@node Font configs (DIY) +@section Font configurations for Org (and others) + +The themes are designed to cope well with mixed font settings (@ref{No mixed fonts, , Option +for no font mixing}). Currently this applies to @samp{org-mode} and +@samp{markdown-mode}. + +In practice it means that the user can safely opt for a more +prose-friendly proportionately spaced typeface as their default, while +letting spacing-sensitive elements like tables and inline code always +use a monospaced font, by inheriting from the @samp{fixed-pitch} face. + +Users can try the built-in @kbd{M-x variable-pitch-mode} to see the effect in +action. + +To make everything use your desired font families, you need to configure +the @samp{variable-pitch} (proportional spacing) and @samp{fixed-pitch} (monospaced) +faces respectively. It may also be convenient to set your main typeface +by configuring the @samp{default} face the same way. + +Put something like this in your initialization file (make sure to read +the documentation of @samp{set-face-attribute}, with @kbd{M-x describe-function}): + +@lisp +;; Main typeface +(set-face-attribute 'default nil :family "DejaVu Sans Mono" :height 110) + +;; Proportionately spaced typeface +(set-face-attribute 'variable-pitch nil :family "DejaVu Serif" :height 1.0) + +;; Monospaced typeface +(set-face-attribute 'fixed-pitch nil :family "DejaVu Sans Mono" :height 1.0) +@end lisp + +Note the differences in the @samp{:height} property. The @samp{default} face must +specify an absolute value, which is the point size × 10. So if you want +to use a font at point size @samp{11}, you set the height at @samp{110}.@footnote{@samp{:height} +values do not need to be rounded to multiples of ten: the likes of @samp{115} +are perfectly valid—some typefaces will change to account for those +finer increments.} Whereas every other face must have a value that is +relative to the default, represented as a floating point (if you use an +integer, say, @samp{15} then that means an absolute height). This is of +paramount importantance: it ensures that all fonts can scale gracefully +when using something like the @samp{text-scale-adjust} command which only +operates on the base font size (i.e. the @samp{default} face's absolute +height). + +An alternative syntax for the @samp{default} face, is to pass all typeface +parameters directly to a @samp{font} property.@footnote{Has the benefit of +accepting @samp{fontconfig} parameters (GNU/Linux), such as @samp{"DejaVu Sans +Mono-11:hintstyle=hintslight:autohint=false"}. +@uref{https://www.freedesktop.org/software/fontconfig/fontconfig-user.html}} +Note that here we use a standard point size: + +@lisp +(set-face-attribute 'default nil :font "DejaVu Sans Mono-11") +@end lisp + +Again, remember to only ever specify an absolute height for the @samp{default}. + +@printindex cp + +@node Org user faces (DIY) +@section Org user faces (DIY) + +Users of @samp{org-mode} have the option to configure various keywords and +priority cookies to better match their workflow. User options are +@samp{org-todo-keyword-faces} and @samp{org-priority-faces}. + +As those are meant to be custom faces, it would be futile to have the +themes try to guess what each user would want to use, which keywords to +target, and so on. Instead, we can provide guidelines on how to +customize things to one's liking with the intent of retaining the +overall aesthetics of the theme. + +Please bear in mind that the end result of those is not controlled by +the active theme but by how Org maps faces to its constructs. Editing +those while @samp{org-mode} is active requires @kbd{M-x org-mode-restart} for changes +to take effect. + +Let us assume you wish to visually differentiate your keywords. You +have something like this: + +@lisp +(setq org-todo-keywords + '((sequence "TODO(t)" "|" "DONE(D)" "CANCEL(C)") + (sequence "MEET(m)" "|" "MET(M)") + (sequence "STUDY(s)" "|" "STUDIED(S)") + (sequence "WRITE(w)" "|" "WROTE(W)"))) +@end lisp + +You could then use a variant of the following to inherit from a face +that uses the styles you want and also to preserve the properties +applied by the @samp{org-todo} face: + +@lisp +(setq org-todo-keyword-faces + '(("MEET" . '(font-lock-preprocessor-face org-todo)) + ("STUDY" . '(font-lock-variable-name-face org-todo)) + ("WRITE" . '(font-lock-type-face org-todo)))) +@end lisp + +This will refashion the keywords you specify, while letting the other +items in @samp{org-todo-keywords} use their original styles (which are defined +in the @samp{org-todo} and @samp{org-done} faces). + +If you want back the defaults, try specifying just the @samp{org-todo} face: + +@lisp +(setq org-todo-keyword-faces + '(("MEET" . org-todo) + ("STUDY" . org-todo) + ("WRITE" . org-todo))) +@end lisp + +When you inherit from multiple faces, you need to quote the list as +shown further above. The order is important: the last item is applied +over the previous ones. If you do not want to blend multiple faces, you +do not need a quoted list. A pattern of @samp{keyword . face} would suffice. + +Both approaches can be used simultaneously, as illustrated in this +configuration of the priority cookies: + +@lisp +(setq org-priority-faces + '((?A . '(org-scheduled-today org-priority)) + (?B . org-priority) + (?C . '(shadow org-priority)))) +@end lisp + +To find all the faces that are loaded in your current Emacs session, use +@kbd{M-x list-faces-display}. Also try @kbd{M-x describe-variable} and then specify +the name of each of those Org variables demonstrated above. Their +documentation strings will offer you further guidance. + +Furthermore, consider reading the ``Notes for aspiring Emacs theme +developers'', published on 2020-08-28 by me (Protesilaos Stavrou): +@uref{https://protesilaos.com/codelog/2020-08-28-notes-emacs-theme-devs/}. + +@printindex cp + +@printindex cp + +@node Face coverage +@chapter Face coverage + +Modus Operandi and Modus Vivendi try to provide as close to full face +coverage as possible. This is necessary to ensure a consistently +accessible reading experience across all possible interfaces. + +@menu +* Supported packages:: Full list of covered face groups +* Covered indirectly:: +* Will NOT be supported:: +@end menu + +@node Supported packages +@section Full support for packages or face groups + +This list will always be updated to reflect the current state of the +project. The idea is to offer an overview of the known status of all +affected face groups. The items with an appended asterisk @samp{*} tend to +have lots of extensions, so the ``full support'' may not be 100% true… + +@itemize +@item +ace-window +@item +ag +@item +alert +@item +all-the-icons +@item +annotate +@item +anzu +@item +apropos +@item +apt-sources-list +@item +artbollocks-mode +@item +auctex and @TeX{} +@item +auto-dim-other-buffers +@item +avy +@item +awesome-tray +@item +binder +@item +bm +@item +bongo +@item +boon +@item +breakpoint (provided by the built-in @samp{gdb-mi.el} library) +@item +buffer-expose +@item +calendar and diary +@item +calfw +@item +centaur-tabs +@item +change-log and log-view (such as @samp{vc-print-log} and @samp{vc-print-root-log}) +@item +cider +@item +circe +@item +color-rg +@item +column-enforce-mode +@item +company-mode* +@item +company-posframe +@item +compilation-mode +@item +completions +@item +counsel* +@item +counsel-css +@item +counsel-notmuch +@item +counsel-org-capture-string +@item +cov +@item +cperl-mode +@item +csv-mode +@item +ctrlf +@item +custom (@kbd{M-x customize}) +@item +dap-mode +@item +dashboard (emacs-dashboard) +@item +deadgrep +@item +debbugs +@item +define-word +@item +deft +@item +dictionary +@item +diff-hl +@item +diff-mode +@item +dim-autoload +@item +dir-treeview +@item +dired +@item +dired-async +@item +dired-git +@item +dired-git-info +@item +dired-narrow +@item +dired-subtree +@item +diredfl +@item +disk-usage +@item +doom-modeline +@item +dynamic-ruler +@item +easy-jekyll +@item +easy-kill +@item +ebdb +@item +ediff +@item +eglot +@item +el-search +@item +eldoc-box +@item +elfeed +@item +elfeed-score +@item +emms +@item +enhanced-ruby-mode +@item +epa +@item +equake +@item +erc +@item +eros +@item +ert +@item +eshell +@item +eshell-fringe-status +@item +eshell-git-prompt +@item +eshell-prompt-extras (epe) +@item +eshell-syntax-highlighting +@item +evil* (evil-mode) +@item +evil-goggles +@item +evil-visual-mark-mode +@item +eww +@item +eyebrowse +@item +fancy-dabbrev +@item +flycheck +@item +flycheck-color-mode-line +@item +flycheck-indicator +@item +flycheck-posframe +@item +flymake +@item +flyspell +@item +flyspell-correct +@item +flx +@item +freeze-it +@item +frog-menu +@item +focus +@item +fold-this +@item +font-lock (generic syntax highlighting) +@item +forge +@item +fountain (fountain-mode) +@item +geiser +@item +git-commit +@item +git-gutter (and variants) +@item +git-lens +@item +git-rebase +@item +git-timemachine +@item +git-walktree +@item +gnus +@item +golden-ratio-scroll-screen +@item +helm* +@item +helm-ls-git +@item +helm-switch-shell +@item +helm-xref +@item +helpful +@item +highlight-blocks +@item +highlight-defined +@item +highlight-escape-sequences (@samp{hes-mode}) +@item +highlight-indentation +@item +highlight-numbers +@item +highlight-symbol +@item +highlight-tail +@item +highlight-thing +@item +hl-defined +@item +hl-fill-column +@item +hl-line-mode +@item +hl-todo +@item +hydra +@item +hyperlist +@item +ibuffer +@item +icomplete +@item +icomplete-vertical +@item +ido-mode +@item +iedit +@item +iflipb +@item +imenu-list +@item +indium +@item +info +@item +info-colors +@item +interaction-log +@item +ioccur +@item +isearch, occur, etc. +@item +ivy* +@item +ivy-posframe +@item +jira (org-jira) +@item +journalctl-mode +@item +js2-mode +@item +julia +@item +jupyter +@item +kaocha-runner +@item +keycast +@item +line numbers (@samp{display-line-numbers-mode} and global variant) +@item +lsp-mode +@item +lsp-ui +@item +magit +@item +magit-imerge +@item +man +@item +markdown-mode +@item +markup-faces (@samp{adoc-mode}) +@item +mentor +@item +messages +@item +minibuffer-line +@item +minimap +@item +modeline +@item +mood-line +@item +moody +@item +mpdel +@item +mu4e +@item +mu4e-conversation +@item +multiple-cursors +@item +neotree +@item +no-emoji +@item +notmuch +@item +num3-mode +@item +nxml-mode +@item +objed +@item +orderless +@item +org* +@item +org-journal +@item +org-noter +@item +org-pomodoro +@item +org-recur +@item +org-roam +@item +org-superstar +@item +org-table-sticky-header +@item +org-treescope +@item +origami +@item +outline-mode +@item +outline-minor-faces +@item +package (@kbd{M-x list-packages}) +@item +page-break-lines +@item +paradox +@item +paren-face +@item +parrot +@item +pass +@item +persp-mode +@item +perspective +@item +phi-grep +@item +phi-search +@item +pkgbuild-mode +@item +pomidor +@item +powerline +@item +powerline-evil +@item +proced +@item +prodigy +@item +racket-mode +@item +rainbow-blocks +@item +rainbow-identifiers +@item +rainbow-delimiters +@item +rcirc +@item +regexp-builder (also known as @samp{re-builder}) +@item +rg (rg.el) +@item +ripgrep +@item +rmail +@item +ruler-mode +@item +sallet +@item +selectrum +@item +semantic +@item +sesman +@item +shell-script-mode +@item +show-paren-mode +@item +side-notes +@item +skewer-mode +@item +smart-mode-line +@item +smartparens +@item +smerge +@item +spaceline +@item +speedbar +@item +spell-fu +@item +stripes +@item +suggest +@item +switch-window +@item +swiper +@item +swoop +@item +sx +@item +symbol-overlay +@item +syslog-mode +@item +table (built-in table.el) +@item +telephone-line +@item +term +@item +tomatinho +@item +transient (pop-up windows such as Magit's) +@item +trashed +@item +treemacs +@item +tty-menu +@item +tuareg +@item +typescript +@item +undo-tree +@item +vc (built-in mode line status for version control) +@item +vc-annotate (@kbd{C-x v g}) +@item +vdiff +@item +vimish-fold +@item +visible-mark +@item +visual-regexp +@item +volatile-highlights +@item +vterm +@item +wcheck-mode +@item +web-mode +@item +wgrep +@item +which-function-mode +@item +which-key +@item +whitespace-mode +@item +window-divider-mode +@item +winum +@item +writegood-mode +@item +woman +@item +xah-elisp-mode +@item +xref +@item +xterm-color (and ansi-colors) +@item +yaml-mode +@item +yasnippet +@item +ztree +@end itemize + +Plus many other miscellaneous faces that are provided by the upstream +GNU Emacs distribution. + +@node Covered indirectly +@section Covered indirectly + +These do not require any extra styles because they are configured to +inherit from some basic faces. Please confirm. + +@itemize +@item +edit-indirect +@item +evil-owl +@item +perl-mode +@item +php-mode +@item +rjsx-mode +@item +swift-mode +@end itemize + +@node Will NOT be supported +@section Will NOT be supported + +I have thus far identified a single package that does fit into the +overarching objective of this project: @uref{https://github.com/hlissner/emacs-solaire-mode, solaire}. It basically tries to +cast a less intense background on the main file-visiting buffers, so +that secondary elements like sidebars can have the default (pure +white/black) background. + +I will only cover this package if it ever supports the inverse effect: +less intense colors (but still accessible) for ancillary interfaces +and the intended styles for the content you are actually working on. + +@node Notes for individual packages +@chapter Notes for individual packages + +This section covers information that may be of interest to users of +individual packages. + +@menu +* Note on company-mode overlay pop-up:: +* Note for ERC escaped color sequences:: +* Note for powerline or spaceline:: +* Note on shr colors:: +* Note for Helm grep:: +* Note on vc-annotate-background-mode:: +@end menu + +@node Note on company-mode overlay pop-up +@section Note on company-mode overlay pop-up + +By default, the @samp{company-mode} pop-up that lists completion candidates is +drawn using an overlay. This creates alignment issues every time it is +placed above a piece of text that has a different height than the +default. + +The solution recommended by the project's maintainer is to use an +alternative front-end for drawing the pop-up which uses child frames +instead of overlays.@footnote{@uref{https://github.com/company-mode/company-mode/issues/1010}}@footnote{@uref{https://github.com/tumashu/company-posframe/}} + +@node Note for ERC escaped color sequences +@section Note for ERC escaped color sequences + +The built-in IRC client @samp{erc} has the ability to colorise any text using +escape sequences that start with @samp{^C} (inserted with @samp{C-q C-c}) and are +followed by a number for the foreground and background.@footnote{This page +explains the basics, though it is not specific to Emacs: +@uref{https://www.mirc.com/colors.html}} Possible numbers are 0-15, with the +first entry being the foreground and the second the background, +separated by a comma. Like this @samp{^C1,6}. The minimum setup is this: + +@lisp +(add-to-list 'erc-modules 'irccontrols) +(setq erc-interpret-controls-p t + erc-interpret-mirc-color t) +@end lisp + +As this allows users to make arbitrary combinations, it is impossible to +guarantee a consistently high contrast ratio. All we can we do is +provide guidance on the combinations that satisfy the accessibility +standard of the themes: + +@table @asis +@item Modus Operandi +Use foreground color 1 for all backgrounds from +2-15. Like so: @samp{C-q C-c1,N} where @samp{N} is the background. + +@item Modus Vivendi +Use foreground color 0 for all backgrounds from +2-13. Use foreground @samp{1} for backgrounds 14, 15. +@end table + +Colors 0 and 1 are white and black respectively. So combine them +together, if you must. + +@node Note for powerline or spaceline +@section Note for powerline or spaceline + +Both Powerline and Spaceline package users will likely need to use the +command @samp{powerline-reset} whenever they make changes to their themes +and/or modeline setup. + +@node Note on shr colors +@section Note on shr colors + +Emacs' HTML rendering mechanism (@samp{shr}) may need explicit configuration to +respect the theme's colors instead of whatever specifications the +webpage provides. Consult @kbd{C-h v shr-use-colors}. + +@node Note for Helm grep +@section Note for Helm grep + +There is one face from the Helm package that is meant to highlight the +matches of a grep or grep-like command (@samp{ag} or @samp{ripgrep}). It is +@samp{helm-grep-match}. However, this face can only apply when the user does +not pass @samp{--color=always} as a command-line option for their command. + +Here is the docstring for that face, which is defined in the +@samp{helm-grep.el} library (view a library with @samp{M-x find-library}). + +@quotation +Face used to highlight grep matches. Have no effect when grep backend +use ``--color='' + +@end quotation + +The user must either remove @samp{--color} from the flags passed to the grep +function, or explicitly use @samp{--color=never} (or equivalent). Helm +provides user-facing customization options for controlling the grep +function's parameters, such as @samp{helm-grep-default-command} and +@samp{helm-grep-git-grep-command}. + +When @samp{--color=always} is in effect, the grep output will use red text in +bold letter forms to present the matching part in the list of +candidates. That style still meets the contrast ratio target of >= 7:1 +(accessibility standard WCAG AAA), because it draws the reference to +ANSI color number 1 (red) from the already-supported array of +@samp{ansi-color-names-vector}. + +@node Note on vc-annotate-background-mode +@section Note on vc-annotate-background-mode + +Due to the unique way @samp{vc-annotate} (@kbd{C-x v g}) applies colors, support for +its background mode (@samp{vc-annotate-background-mode}) is disabled at the +theme level. + +Normally, such a drastic measure should not belong in a theme: assuming +the user's preferences is bad practice. However, it has been deemed +necessary in the interest of preserving color contrast accessibility +while still supporting a useful built-in tool. + +If there actually is a way to avoid such a course of action, without +prejudice to the accessibility standard of this project, then please +report as much or send patches (see @ref{Contributing}). + +@node Contributing +@chapter Contributing + +This section documents the canonical sources of the themes and the ways +in which you can contribute to their ongoing development. + +@menu +* Sources of the themes:: +* Issues you can help with:: +* Merge requests:: Legal considerations for code patches +@end menu + +@node Sources of the themes +@section Sources of the themes + +The @samp{modus-operandi} and @samp{modus-vivendi} themes are built into Emacs. +Currently they are in the project's @samp{master} branch, which is tracking the +next development release target. + +The source code of the themes is @uref{https://gitlab.com/protesilaos/modus-themes/, available on Gitlab}, for the time +being. A @uref{https://github.com/protesilaos/modus-themes/, mirror on Github} is also on offer. + +An HTML version of this manual is available as an extension to the +@uref{https://protesilaos.com/modus-themes/, author's personal website} (does not rely on any non-free code). + +@node Issues you can help with +@section Issues you can help with + +A few tasks you can help with: + +@itemize +@item +Suggest refinements to packages that are covered. +@item +Report packages not covered thus far. +@item +Report bugs, inconsistencies, shortcomings. +@item +Help expand the documentation of covered-but-not-styled packages. +@item +Suggest refinements to the color palette. +@item +Help expand this document or any other piece of documentation. +@item +Merge requests for code refinements. +@end itemize + +@xref{Merge requests, , Patches require copyright assignment to the FSF}. + +It would be great if your feedback also includes some screenshots, GIFs, +or short videos, as well as further instructions to reproduce a given +setup. Though this is not a requirement. + +Whatever you do, bear in mind the overarching objective of the Modus +themes: to keep a contrast ratio that is greater or equal to 7:1 between +background and foreground colors. If a compromise is ever necessary +between aesthetics and accessibility, it shall always be made in the +interest of the latter. + +@node Merge requests +@section Patches require copyright assignment to the FSF + +Code contributions are most welcome. For any major edit (more than 15 +lines, or so, in aggregate per person), you need to make a copyright +assignment to the Free Software Foundation. This is necessary because +the themes are part of the upstream Emacs distribution: the FSF must at +all times be in a position to enforce the GNU General Public License. + +Copyright assignment is a simple process. Check the request form below +(please adapt it accordingly). You must write an email to the address +mentioned in the form and then wait for the FSF to send you a legal +agreement. Sign the document and file it back to them. This could all +happen via email and take about a week. You are encouraged to go +through this process. You only need to do it once. It will allow you +to make contributions to Emacs in general. + +@example +Please email the following information to assign@@gnu.org, and we +will send you the assignment form for your past and future changes. + +Please use your full legal name (in ASCII characters) as the subject +line of the message. +---------------------------------------------------------------------- +REQUEST: SEND FORM FOR PAST AND FUTURE CHANGES + +[What is the name of the program or package you're contributing to?] + +GNU Emacs + +[Did you copy any files or text written by someone else in these changes? +Even if that material is free software, we need to know about it.] + +Copied a few snippets from the same files I edited. Their author, +Protesilaos Stavrou, has already assigned copyright to the Free Software +Foundation. + +[Do you have an employer who might have a basis to claim to own +your changes? Do you attend a school which might make such a claim?] + + +[For the copyright registration, what country are you a citizen of?] + + +[What year were you born?] + + +[Please write your email address here.] + + +[Please write your postal address here.] + + + + + +[Which files have you changed so far, and which new files have you written +so far?] + +Changed a couple of themes that are part of the Emacs source code: + +./etc/themes/modus-operandi-theme.el +./etc/themes/modus-vivendi-theme.el +@end example + +@node Acknowledgements +@chapter Acknowledgements + +The Modus themes are a collective effort. Every contribution counts. + +@table @asis +@item Author/maintainer +Protesilaos Stavrou. + +@item Code contributions +Anders Johansson, Basil L@. Contovounesios, +Markus Beppler, Matthew Stevenson. + +@item Ideas and user feedback +Aaron Jensen, Adam Spiers, Alex Griffin, +Alex Peitsinis, Alexey Shmalko, Anders Johansson, André Alexandre +Gomes, Arif Rezai, Basil L@. Contovounesios, Damien Cassou, Dario +Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Gerry +Agbobada, Gianluca Recchia, Iris Garcia, Len Trigg, Manuel Uberti, +Mark Burton, Markus Beppler, Michael Goldenberg, Murilo Pereira, +Nicolas De Jaeghere, Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, +Shreyas Ragavan, Tassilo Horn, Thibaut Verron, Trey Merkley, Uri +Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben, +Fourchaux, Fredrik, Moesasji, Nick, TheBlob42, dinko, doolio, jixiuf, +okamsn, tycho garen. + +@item Packaging +Dhavan Vaidya (Debian), Stefan Kangas (core Emacs), +Stefan Monnier (GNU Elpa). + +@item Inspiration for certain features +Fabrice Niessen (leuven-theme), +Bozhidar Batsov (zenburn-theme). +@end table + +@node Meta +@chapter Meta + +If you are curious about the principles that govern the development of +this project read the essay @uref{https://protesilaos.com/codelog/2020-03-17-design-modus-themes-emacs/, On the design of the Modus themes} +(2020-03-17). + +Here are some more publications for those interested in the kind of work +that goes into this project (sometimes the commits also include details +of this sort): + +@itemize +@item +@uref{https://protesilaos.com/codelog/2020-05-10-modus-operandi-palette-review/, Modus Operandi theme subtle palette review} (2020-05-10) +@item +@uref{https://protesilaos.com/codelog/2020-06-13-modus-vivendi-palette-review/, Modus Vivendi theme subtle palette review} (2020-06-13) +@item +@uref{https://protesilaos.com/codelog/2020-07-04-modus-themes-faint-colours/, Modus themes: new ``faint syntax'' option} (2020-07-04) +@item +@uref{https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/, Modus themes: major review of ``nuanced'' colours} (2020-07-08) +@item +@uref{https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/, Modus themes: review of blue colours} (2020-09-14) +@end itemize + +And here are the canonical sources for this project's documentation: + +@table @asis +@item Manual +@uref{https://protesilaos.com/modus-themes} +@item Change Log +@uref{https://protesilaos.com/modus-themes-changelog} +@item Screenshots +@uref{https://protesilaos.com/modus-themes-pictures} +@end table + +@node External projects (ports) +@chapter External projects (ports) + +The present section documents projects that extend the scope of the +Modus themes. The following list will be updated whenever relevant +information is brought to my attention. If you already have or intend +to produce such a port, feel welcome @uref{https://protesilaos.com/contact, to contact me}. + +@table @asis +@item Modus exporter +This is @uref{https://github.com/polaris64/modus-exporter, an Elisp library written by Simon Pugnet}. +Licensed under the terms of the GNU General Public License. It is +meant to capture the color values of the active Modus theme (Operandi +or Vivendi) and output it as a valid theme for some other application. +@end table + +@node GNU Free Documentation License +@appendix GNU Free Documentation License + +@example + GNU Free Documentation License + Version 1.3, 3 November 2008 + + + Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. + <https://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +0. PREAMBLE + +The purpose of this License is to make a manual, textbook, or other +functional and useful document "free" in the sense of freedom: to +assure everyone the effective freedom to copy and redistribute it, +with or without modifying it, either commercially or noncommercially. +Secondarily, this License preserves for the author and publisher a way +to get credit for their work, while not being considered responsible +for modifications made by others. + +This License is a kind of "copyleft", which means that derivative +works of the document must themselves be free in the same sense. It +complements the GNU General Public License, which is a copyleft +license designed for free software. + +We have designed this License in order to use it for manuals for free +software, because free software needs free documentation: a free +program should come with manuals providing the same freedoms that the +software does. But this License is not limited to software manuals; +it can be used for any textual work, regardless of subject matter or +whether it is published as a printed book. We recommend this License +principally for works whose purpose is instruction or reference. + + +1. APPLICABILITY AND DEFINITIONS + +This License applies to any manual or other work, in any medium, that +contains a notice placed by the copyright holder saying it can be +distributed under the terms of this License. Such a notice grants a +world-wide, royalty-free license, unlimited in duration, to use that +work under the conditions stated herein. The "Document", below, +refers to any such manual or work. Any member of the public is a +licensee, and is addressed as "you". You accept the license if you +copy, modify or distribute the work in a way requiring permission +under copyright law. + +A "Modified Version" of the Document means any work containing the +Document or a portion of it, either copied verbatim, or with +modifications and/or translated into another language. + +A "Secondary Section" is a named appendix or a front-matter section of +the Document that deals exclusively with the relationship of the +publishers or authors of the Document to the Document's overall +subject (or to related matters) and contains nothing that could fall +directly within that overall subject. (Thus, if the Document is in +part a textbook of mathematics, a Secondary Section may not explain +any mathematics.) The relationship could be a matter of historical +connection with the subject or with related matters, or of legal, +commercial, philosophical, ethical or political position regarding +them. + +The "Invariant Sections" are certain Secondary Sections whose titles +are designated, as being those of Invariant Sections, in the notice +that says that the Document is released under this License. If a +section does not fit the above definition of Secondary then it is not +allowed to be designated as Invariant. The Document may contain zero +Invariant Sections. If the Document does not identify any Invariant +Sections then there are none. + +The "Cover Texts" are certain short passages of text that are listed, +as Front-Cover Texts or Back-Cover Texts, in the notice that says that +the Document is released under this License. A Front-Cover Text may +be at most 5 words, and a Back-Cover Text may be at most 25 words. + +A "Transparent" copy of the Document means a machine-readable copy, +represented in a format whose specification is available to the +general public, that is suitable for revising the document +straightforwardly with generic text editors or (for images composed of +pixels) generic paint programs or (for drawings) some widely available +drawing editor, and that is suitable for input to text formatters or +for automatic translation to a variety of formats suitable for input +to text formatters. A copy made in an otherwise Transparent file +format whose markup, or absence of markup, has been arranged to thwart +or discourage subsequent modification by readers is not Transparent. +An image format is not Transparent if used for any substantial amount +of text. A copy that is not "Transparent" is called "Opaque". + +Examples of suitable formats for Transparent copies include plain +ASCII without markup, Texinfo input format, LaTeX input format, SGML +or XML using a publicly available DTD, and standard-conforming simple +HTML, PostScript or PDF designed for human modification. Examples of +transparent image formats include PNG, XCF and JPG. Opaque formats +include proprietary formats that can be read and edited only by +proprietary word processors, SGML or XML for which the DTD and/or +processing tools are not generally available, and the +machine-generated HTML, PostScript or PDF produced by some word +processors for output purposes only. + +The "Title Page" means, for a printed book, the title page itself, +plus such following pages as are needed to hold, legibly, the material +this License requires to appear in the title page. For works in +formats which do not have any title page as such, "Title Page" means +the text near the most prominent appearance of the work's title, +preceding the beginning of the body of the text. + +The "publisher" means any person or entity that distributes copies of +the Document to the public. + +A section "Entitled XYZ" means a named subunit of the Document whose +title either is precisely XYZ or contains XYZ in parentheses following +text that translates XYZ in another language. (Here XYZ stands for a +specific section name mentioned below, such as "Acknowledgements", +"Dedications", "Endorsements", or "History".) To "Preserve the Title" +of such a section when you modify the Document means that it remains a +section "Entitled XYZ" according to this definition. + +The Document may include Warranty Disclaimers next to the notice which +states that this License applies to the Document. These Warranty +Disclaimers are considered to be included by reference in this +License, but only as regards disclaiming warranties: any other +implication that these Warranty Disclaimers may have is void and has +no effect on the meaning of this License. + +2. VERBATIM COPYING + +You may copy and distribute the Document in any medium, either +commercially or noncommercially, provided that this License, the +copyright notices, and the license notice saying this License applies +to the Document are reproduced in all copies, and that you add no +other conditions whatsoever to those of this License. You may not use +technical measures to obstruct or control the reading or further +copying of the copies you make or distribute. However, you may accept +compensation in exchange for copies. If you distribute a large enough +number of copies you must also follow the conditions in section 3. + +You may also lend copies, under the same conditions stated above, and +you may publicly display copies. + + +3. COPYING IN QUANTITY + +If you publish printed copies (or copies in media that commonly have +printed covers) of the Document, numbering more than 100, and the +Document's license notice requires Cover Texts, you must enclose the +copies in covers that carry, clearly and legibly, all these Cover +Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on +the back cover. Both covers must also clearly and legibly identify +you as the publisher of these copies. The front cover must present +the full title with all words of the title equally prominent and +visible. You may add other material on the covers in addition. +Copying with changes limited to the covers, as long as they preserve +the title of the Document and satisfy these conditions, can be treated +as verbatim copying in other respects. + +If the required texts for either cover are too voluminous to fit +legibly, you should put the first ones listed (as many as fit +reasonably) on the actual cover, and continue the rest onto adjacent +pages. + +If you publish or distribute Opaque copies of the Document numbering +more than 100, you must either include a machine-readable Transparent +copy along with each Opaque copy, or state in or with each Opaque copy +a computer-network location from which the general network-using +public has access to download using public-standard network protocols +a complete Transparent copy of the Document, free of added material. +If you use the latter option, you must take reasonably prudent steps, +when you begin distribution of Opaque copies in quantity, to ensure +that this Transparent copy will remain thus accessible at the stated +location until at least one year after the last time you distribute an +Opaque copy (directly or through your agents or retailers) of that +edition to the public. + +It is requested, but not required, that you contact the authors of the +Document well before redistributing any large number of copies, to +give them a chance to provide you with an updated version of the +Document. + + +4. MODIFICATIONS + +You may copy and distribute a Modified Version of the Document under +the conditions of sections 2 and 3 above, provided that you release +the Modified Version under precisely this License, with the Modified +Version filling the role of the Document, thus licensing distribution +and modification of the Modified Version to whoever possesses a copy +of it. In addition, you must do these things in the Modified Version: + +A. Use in the Title Page (and on the covers, if any) a title distinct + from that of the Document, and from those of previous versions + (which should, if there were any, be listed in the History section + of the Document). You may use the same title as a previous version + if the original publisher of that version gives permission. +B. List on the Title Page, as authors, one or more persons or entities + responsible for authorship of the modifications in the Modified + Version, together with at least five of the principal authors of the + Document (all of its principal authors, if it has fewer than five), + unless they release you from this requirement. +C. State on the Title page the name of the publisher of the + Modified Version, as the publisher. +D. Preserve all the copyright notices of the Document. +E. Add an appropriate copyright notice for your modifications + adjacent to the other copyright notices. +F. Include, immediately after the copyright notices, a license notice + giving the public permission to use the Modified Version under the + terms of this License, in the form shown in the Addendum below. +G. Preserve in that license notice the full lists of Invariant Sections + and required Cover Texts given in the Document's license notice. +H. Include an unaltered copy of this License. +I. Preserve the section Entitled "History", Preserve its Title, and add + to it an item stating at least the title, year, new authors, and + publisher of the Modified Version as given on the Title Page. If + there is no section Entitled "History" in the Document, create one + stating the title, year, authors, and publisher of the Document as + given on its Title Page, then add an item describing the Modified + Version as stated in the previous sentence. +J. Preserve the network location, if any, given in the Document for + public access to a Transparent copy of the Document, and likewise + the network locations given in the Document for previous versions + it was based on. These may be placed in the "History" section. + You may omit a network location for a work that was published at + least four years before the Document itself, or if the original + publisher of the version it refers to gives permission. +K. For any section Entitled "Acknowledgements" or "Dedications", + Preserve the Title of the section, and preserve in the section all + the substance and tone of each of the contributor acknowledgements + and/or dedications given therein. +L. Preserve all the Invariant Sections of the Document, + unaltered in their text and in their titles. Section numbers + or the equivalent are not considered part of the section titles. +M. Delete any section Entitled "Endorsements". Such a section + may not be included in the Modified Version. +N. Do not retitle any existing section to be Entitled "Endorsements" + or to conflict in title with any Invariant Section. +O. Preserve any Warranty Disclaimers. + +If the Modified Version includes new front-matter sections or +appendices that qualify as Secondary Sections and contain no material +copied from the Document, you may at your option designate some or all +of these sections as invariant. To do this, add their titles to the +list of Invariant Sections in the Modified Version's license notice. +These titles must be distinct from any other section titles. + +You may add a section Entitled "Endorsements", provided it contains +nothing but endorsements of your Modified Version by various +parties--for example, statements of peer review or that the text has +been approved by an organization as the authoritative definition of a +standard. + +You may add a passage of up to five words as a Front-Cover Text, and a +passage of up to 25 words as a Back-Cover Text, to the end of the list +of Cover Texts in the Modified Version. Only one passage of +Front-Cover Text and one of Back-Cover Text may be added by (or +through arrangements made by) any one entity. If the Document already +includes a cover text for the same cover, previously added by you or +by arrangement made by the same entity you are acting on behalf of, +you may not add another; but you may replace the old one, on explicit +permission from the previous publisher that added the old one. + +The author(s) and publisher(s) of the Document do not by this License +give permission to use their names for publicity for or to assert or +imply endorsement of any Modified Version. + + +5. COMBINING DOCUMENTS + +You may combine the Document with other documents released under this +License, under the terms defined in section 4 above for modified +versions, provided that you include in the combination all of the +Invariant Sections of all of the original documents, unmodified, and +list them all as Invariant Sections of your combined work in its +license notice, and that you preserve all their Warranty Disclaimers. + +The combined work need only contain one copy of this License, and +multiple identical Invariant Sections may be replaced with a single +copy. If there are multiple Invariant Sections with the same name but +different contents, make the title of each such section unique by +adding at the end of it, in parentheses, the name of the original +author or publisher of that section if known, or else a unique number. +Make the same adjustment to the section titles in the list of +Invariant Sections in the license notice of the combined work. + +In the combination, you must combine any sections Entitled "History" +in the various original documents, forming one section Entitled +"History"; likewise combine any sections Entitled "Acknowledgements", +and any sections Entitled "Dedications". You must delete all sections +Entitled "Endorsements". + + +6. COLLECTIONS OF DOCUMENTS + +You may make a collection consisting of the Document and other +documents released under this License, and replace the individual +copies of this License in the various documents with a single copy +that is included in the collection, provided that you follow the rules +of this License for verbatim copying of each of the documents in all +other respects. + +You may extract a single document from such a collection, and +distribute it individually under this License, provided you insert a +copy of this License into the extracted document, and follow this +License in all other respects regarding verbatim copying of that +document. + + +7. AGGREGATION WITH INDEPENDENT WORKS + +A compilation of the Document or its derivatives with other separate +and independent documents or works, in or on a volume of a storage or +distribution medium, is called an "aggregate" if the copyright +resulting from the compilation is not used to limit the legal rights +of the compilation's users beyond what the individual works permit. +When the Document is included in an aggregate, this License does not +apply to the other works in the aggregate which are not themselves +derivative works of the Document. + +If the Cover Text requirement of section 3 is applicable to these +copies of the Document, then if the Document is less than one half of +the entire aggregate, the Document's Cover Texts may be placed on +covers that bracket the Document within the aggregate, or the +electronic equivalent of covers if the Document is in electronic form. +Otherwise they must appear on printed covers that bracket the whole +aggregate. + + +8. TRANSLATION + +Translation is considered a kind of modification, so you may +distribute translations of the Document under the terms of section 4. +Replacing Invariant Sections with translations requires special +permission from their copyright holders, but you may include +translations of some or all Invariant Sections in addition to the +original versions of these Invariant Sections. You may include a +translation of this License, and all the license notices in the +Document, and any Warranty Disclaimers, provided that you also include +the original English version of this License and the original versions +of those notices and disclaimers. In case of a disagreement between +the translation and the original version of this License or a notice +or disclaimer, the original version will prevail. + +If a section in the Document is Entitled "Acknowledgements", +"Dedications", or "History", the requirement (section 4) to Preserve +its Title (section 1) will typically require changing the actual +title. + + +9. TERMINATION + +You may not copy, modify, sublicense, or distribute the Document +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense, or distribute it is void, and +will automatically terminate your rights under this License. + +However, if you cease all violation of this License, then your license +from a particular copyright holder is reinstated (a) provisionally, +unless and until the copyright holder explicitly and finally +terminates your license, and (b) permanently, if the copyright holder +fails to notify you of the violation by some reasonable means prior to +60 days after the cessation. + +Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + +Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, receipt of a copy of some or all of the same material does +not give you any rights to use it. + + +10. FUTURE REVISIONS OF THIS LICENSE + +The Free Software Foundation may publish new, revised versions of the +GNU Free Documentation License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in +detail to address new problems or concerns. See +https://www.gnu.org/licenses/. + +Each version of the License is given a distinguishing version number. +If the Document specifies that a particular numbered version of this +License "or any later version" applies to it, you have the option of +following the terms and conditions either of that specified version or +of any later version that has been published (not as a draft) by the +Free Software Foundation. If the Document does not specify a version +number of this License, you may choose any version ever published (not +as a draft) by the Free Software Foundation. If the Document +specifies that a proxy can decide which future versions of this +License can be used, that proxy's public statement of acceptance of a +version permanently authorizes you to choose that version for the +Document. + +11. RELICENSING + +"Massive Multiauthor Collaboration Site" (or "MMC Site") means any +World Wide Web server that publishes copyrightable works and also +provides prominent facilities for anybody to edit those works. A +public wiki that anybody can edit is an example of such a server. A +"Massive Multiauthor Collaboration" (or "MMC") contained in the site +means any set of copyrightable works thus published on the MMC site. + +"CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 +license published by Creative Commons Corporation, a not-for-profit +corporation with a principal place of business in San Francisco, +California, as well as future copyleft versions of that license +published by that same organization. + +"Incorporate" means to publish or republish a Document, in whole or in +part, as part of another Document. + +An MMC is "eligible for relicensing" if it is licensed under this +License, and if all works that were first published under this License +somewhere other than this MMC, and subsequently incorporated in whole or +in part into the MMC, (1) had no cover texts or invariant sections, and +(2) were thus incorporated prior to November 1, 2008. + +The operator of an MMC Site may republish an MMC contained in the site +under CC-BY-SA on the same site at any time before August 1, 2009, +provided the MMC is eligible for relicensing. + + +ADDENDUM: How to use this License for your documents + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and +license notices just after the title page: + + Copyright (c) YEAR YOUR NAME. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. + A copy of the license is included in the section entitled "GNU + Free Documentation License". + +If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, +replace the "with...Texts." line with this: + + with the Invariant Sections being LIST THEIR TITLES, with the + Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST. + +If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + +If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, +to permit their use in free software. +@end example + +@bye diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 495d562f50b..b7e05feb0f1 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -3753,7 +3753,7 @@ A link should be enclosed in double brackets and may contain descriptive text to be displayed instead of the URL (see @ref{Link Format}), for example: @example -[[http://www.gnu.org/software/emacs/][GNU Emacs]] +[[https://www.gnu.org/software/emacs/][GNU Emacs]] @end example @@ -22361,7 +22361,7 @@ Marco Wahl wrote @samp{ol-eww.el}. @display Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. -@uref{http://fsf.org/} +@uref{https://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -22786,7 +22786,7 @@ The Free Software Foundation may publish new, revised versions of the GNU Free Documentation License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. See -@uref{http://www.gnu.org/copyleft/}. +@uref{https://www.gnu.org/copyleft/}. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index c3df33eb9aa..d1951f581c9 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -1389,7 +1389,7 @@ bugs, please report them separately. If you have problems using PCL-CVS or other questions, send them to the @url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, help-gnu-emacs mailing list}. This is a good place to get help, as is -the @url{http://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}. +the @url{https://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}. If you have ideas for improvements, or if you have written some extensions to this package, we would like to hear from you. We hope that diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi index 5daa16fb27e..261897b735c 100644 --- a/doc/misc/pgg.texi +++ b/doc/misc/pgg.texi @@ -94,7 +94,7 @@ and that you are familiar with its basic functions. By default, PGG uses GnuPG@. If you are new to such a system, I recommend that you should look over the GNU Privacy Handbook (GPH) -which is available at @uref{http://www.gnupg.org/documentation/}. +which is available at @uref{https://www.gnupg.org/documentation/}. When using GnuPG, we recommend the use of the @code{gpg-agent} program, which is distributed with versions 2.0 and later of GnuPG@. diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index 75f9cc63a2e..2054ca5860d 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -126,7 +126,7 @@ Here's a typical example: @cindex redirection to random servers When you connect to the Freenode network (@code{http://freenode.net/}), you point your IRC client at the -server @code{irc.freenode.net}. That server will redirect your client +server @code{chat.freenode.net}. That server will redirect your client to a random server on the network, such as @code{zelazny.freenode.net}. @cindex channel name @@ -176,7 +176,7 @@ using a different nick. This will prompt you for four things: What server do you want to connect to? All the servers in a particular network are equivalent. Some networks use a round-robin system where a single server redirects new connections to a random server in the -network. @code{irc.freenode.net} is such a server for the Freenode +network. @code{chat.freenode.net} is such a server for the Freenode network. Freenode provides the network ``for the Free and Open Source Software communities, for not-for-profit organizations and for related communities and organizations.'' @@ -211,7 +211,7 @@ Emacs, or join @code{#rcirc}, the channel about @code{rcirc}. @cindex server buffer When you have answered these questions, @code{rcirc} will create a server -buffer, which will be named something like @file{*irc.freenode.net*}, +buffer, which will be named something like @file{*chat.freenode.net*}, and a channel buffer for each of the channels you wanted to join. @kindex RET @@ -482,7 +482,7 @@ Here's an example of how to set it: @end example By default you will be connected to the @code{rcirc} support channel: -@code{#rcirc} on @code{irc.freenode.net}. +@code{#rcirc} on @code{chat.freenode.net}. @table @code @item :nick diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi index 26979e4cb11..c2b2be2282e 100644 --- a/doc/misc/semantic.texi +++ b/doc/misc/semantic.texi @@ -269,7 +269,7 @@ preprocessors. @item semantic/grammar.el @itemx semantic/bovine/grammar.el The ``bovine'' grammar. This is the first grammar mode written for -@semantic{} and is useful for simple creating simple parsers. +@semantic{} and is useful for creating simple parsers. @item semantic/wisent.el @itemx semantic/wisent/wisent.el diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 0d2a1fdbc8f..0a26e9f702c 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -1088,7 +1088,7 @@ where each line of input produces a line of output.} } % The -2 in the arguments here gives all the input to TeX catcode 12 % (other) or 10 (space), preventing undefined control sequence errors. See - % https://lists.gnu.org/archive/html/bug-texinfo/2019-08/msg00031.html + % https://lists.gnu.org/r/bug-texinfo/2019-08/msg00031.html % \endgroup \def\pdfescapestring#1{\directlua{PDFescstr('\luaescapestring{#1}')}} diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index bdf3b403d80..6738ed5123d 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -384,7 +384,7 @@ After one of the above commands, @file{~/emacs/tramp} will containing the latest version of @value{tramp}. @noindent -To fetch updates from the repository, use git pull: +To fetch updates from the repository, use @code{git pull}: @example @group @@ -1622,7 +1622,7 @@ support this command. @subsection Tunneling with ssh -With ssh, you could use the @code{ProxyCommand} entry in +With @command{ssh}, you could use the @option{ProxyCommand} entry in @file{~/.ssh/config}: @example @@ -1709,9 +1709,9 @@ Integration for LXD containers. A container is accessed via @item magit-tramp @cindex method @option{git} @cindex @option{git} method -Browsing git repositories with @code{magit}. A versioned file is +Browsing Git repositories with @code{magit}. A versioned file is accessed via @file{@trampfn{git,rev@@root-dir,/path/to/file}}. -@samp{rev} is a git revision, and @samp{root-dir} is a virtual host +@samp{rev} is a Git revision, and @samp{root-dir} is a virtual host name for the root directory, specified in @code{magit-tramp-hosts-alist}. @@ -1802,8 +1802,8 @@ in such files, it can return host names only. @item @code{tramp-parse-sconfig} @findex tramp-parse-sconfig -This function returns the host nicknames defined by @code{Host} entries -in @file{~/.ssh/config} style files. +This function returns the host nicknames defined by @option{Host} +entries in @file{~/.ssh/config} style files. @item @code{tramp-parse-shostkeys} @findex tramp-parse-shostkeys @@ -2280,6 +2280,12 @@ example below: @end group @end lisp +@vindex password-word-equivalents +This user option is, by default, initialised from +@code{password-word-equivalents} when @value{tramp} is loaded, and it +is usually more convenient to add new passphrases to that user option +instead of altering this user option. + Similar localization may be necessary for handling wrong password prompts, for which @value{tramp} uses @code{tramp-wrong-passwd-regexp}. @@ -2719,7 +2725,7 @@ corresponding password; otherwise there is no way to decrypt your encrypted files. @defopt tramp-crypt-save-encfs-config-remote -If this user option is non-nil (the default), the @option{encfs} +If this user option is non-@code{nil} (the default), the @option{encfs} configuration file @file{.encfs6.xml} is also kept in the encrypted remote directory. It depends on you, whether you regard the password protection of this file as sufficient. The advantage would be, that @@ -3083,19 +3089,6 @@ Example: @end group @end example -During file name completion, remote directory contents are re-read -regularly to account for any changes in the file system that may -affect the completion candidates. Such re-reads can account for -changes to the file system by applications outside Emacs -(@pxref{Connection caching}). - -@defopt tramp-completion-reread-directory-timeout -The timeout is number of seconds since last remote command for -rereading remote directory contents. A value of 0 re-reads -immediately during file name completion, @code{nil} uses cached -directory contents. -@end defopt - @node Ad-hoc multi-hops @section Declaring multiple hops in the file name @@ -3144,7 +3137,7 @@ to user @code{root} on host @code{remotehost}, starting with an @option{ssh} session on host @code{remotehost}: @samp{@value{prefix}ssh@value{postfixhop}%h|su@value{postfixhop}remotehost@value{postfix}}. -On the other hand, if a trailing hop does not specifiy a host name, +On the other hand, if a trailing hop does not specify a host name, the host name of the previous hop is reused. Therefore, the following file name is equivalent to the previous example: @samp{@value{prefix}ssh@value{postfixhop}remotehost|su@value{postfixhop}@value{postfix}}. @@ -3180,7 +3173,7 @@ or a string describing the signal, when the process has been interrupted. Since it cannot be determined reliably whether a remote process has been interrupted, @code{process-file} returns always the exit code. When the user option -@code{process-file-return-signal-string} is non-nil, +@code{process-file-return-signal-string} is non-@code{nil}, @code{process-file} regards all exit codes greater than 128 as an indication that the process has been interrupted, and returns a respective string. @@ -3311,8 +3304,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")} with a hard-coded, fixed name. Note that using @code{:0} for X11 display name here will not work as expected. -An alternate approach is specify @code{ForwardX11 yes} or -@code{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local +An alternate approach is specify @option{ForwardX11 yes} or +@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local host. @@ -3386,22 +3379,22 @@ continuous output. @vindex shell-file-name @vindex shell-command-switch -@code{shell-command} uses the variables @code{shell-file-name} and -@code{shell-command-switch} in order to determine which shell to run. -For remote hosts, their default values are @file{/bin/sh} and -@option{-c}, respectively (except for the @option{adb} method, which -uses @file{/system/bin/sh}). Like the variables in the previous -section, these variables can be changed via connection-local -variables. +@code{shell-command} uses the user option @code{shell-file-name} and +the variable @code{shell-command-switch} in order to determine which +shell to run. For remote hosts, their default values are +@file{/bin/sh} and @option{-c}, respectively (except for the +@option{adb} method, which uses @file{/system/bin/sh}). Like the +variables in the previous section, these variables can be changed via +connection-local variables. @vindex async-shell-command-width @vindex COLUMNS@r{, environment variable} -If Emacs supports the variable @code{async-shell-command-width} (since -@w{Emacs 27}), @value{tramp} cares about its value for asynchronous -shell commands. It specifies the number of display columns for -command output. For synchronous shell commands, a similar effect can -be achieved by adding the environment variable @env{COLUMNS} to -@code{tramp-remote-process-environment}. +If Emacs supports the user option @code{async-shell-command-width} +(since @w{Emacs 27}), @value{tramp} cares about its value for +asynchronous shell commands. It specifies the number of display +columns for command output. For synchronous shell commands, a similar +effect can be achieved by adding the environment variable +@env{COLUMNS} to @code{tramp-remote-process-environment}. @subsection Running @code{eshell} on a remote host @@ -3577,7 +3570,7 @@ It works only for connection methods defined in @file{tramp-sh.el} and It does not support interactive user authentication. With @option{ssh}-based methods, this can be avoided by using a password agent like @command{ssh-agent}, using public key authentication, or -using @code{ControlMaster} options. +using @option{ControlMaster} options. @item It cannot be killed via @code{interrupt-process}. @@ -3600,7 +3593,7 @@ In order to gain even more performance, it is recommended to bind @code{tramp-verbose} to 0 when running @code{make-process} or @code{start-file-process}. Furthermore, you might set @code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to -bypass @value{tramp}'s handling of the @code{ControlMaster} options, +bypass @value{tramp}'s handling of the @option{ControlMaster} options, and use your own settings in @file{~/.ssh/config}. @@ -3675,8 +3668,8 @@ On all buffers, which have a @code{buffer-file-name} matching prompted for modification in the minibuffer. The buffers are marked modified, and must be saved explicitly. -If user option @code{tramp-confirm-rename-file-names} is nil, changing -the file name happens without confirmation. This requires a +If user option @code{tramp-confirm-rename-file-names} is @code{nil}, +changing the file name happens without confirmation. This requires a matching entry in @code{tramp-default-rename-alist}. Remote buffers related to the remote connection identified by @@ -3715,8 +3708,8 @@ Tramp infers by default, such as @samp{@trampfn{method,user@@host,}}). name of @code{source} when calling @code{tramp-rename-files}. @code{source} could also be a Lisp form, which will be evaluated. The -result must be a string or nil, which is interpreted as a regular -expression which always matches. +result must be a string or @code{nil}, which is interpreted as a +regular expression which always matches. Example entries: @@ -4120,9 +4113,6 @@ files are not independently updated outside @value{tramp}'s control. That cache cleanup will be necessary if the remote directories or files are updated independent of @value{tramp}. -Set @code{tramp-completion-reread-directory-timeout} to @code{nil} to -speed up completions, @ref{File name completion}. - Disable version control to avoid delays: @lisp @@ -4274,8 +4264,8 @@ first saving to a temporary file. @vindex tramp-local-host-regexp When connecting to a local host, @value{tramp} uses some internal -optimizations. They fail, when there is a chrooted environment. In -order to disable those optimizations, set user option +optimizations. They fail when Emacs runs in a chrooted environment. +In order to disable those optimizations, set user option @code{tramp-local-host-regexp} to @code{nil}. @@ -4296,17 +4286,17 @@ Host * @item -@value{tramp} does not use default @command{ssh} @code{ControlPath} +@value{tramp} does not use default @command{ssh} @option{ControlPath} -@value{tramp} overwrites @code{ControlPath} settings when initiating +@value{tramp} overwrites @option{ControlPath} settings when initiating @command{ssh} sessions. @value{tramp} does this to fend off a stall if a master session opened outside the Emacs session is no longer open. That is why @value{tramp} prompts for the password again even if there is an @command{ssh} already open. @vindex tramp-ssh-controlmaster-options -Some @command{ssh} versions support a @code{ControlPersist} option, -which allows you to set the @code{ControlPath} provided the variable +Some @command{ssh} versions support a @option{ControlPersist} option, +which allows you to set the @option{ControlPath} provided the variable @code{tramp-ssh-controlmaster-options} is customized as follows: @lisp @@ -4331,12 +4321,16 @@ this @code{nil} setting: (customize-set-variable 'tramp-use-ssh-controlmaster-options nil) @end lisp +This shall also be set to @code{nil} if you use the +@option{ProxyCommand} or @option{ProxyJump} options in your +@command{ssh} configuration. + @item On multi-hop connections, @value{tramp} does not use @command{ssh} -@code{ControlMaster} +@option{ControlMaster} -In order to use the @code{ControlMaster} option, @value{tramp} must +In order to use the @option{ControlMaster} option, @value{tramp} must check whether the @command{ssh} client supports this option. This is only possible on the local host, for the first hop. @value{tramp} does not use this option on proxy hosts. @@ -4359,7 +4353,7 @@ supported on your proxy host. @item @value{tramp} does not connect to Samba or MS Windows hosts running -SMB1 connection protocol. +SMB1 connection protocol @vindex tramp-smb-options Recent versions of @command{smbclient} do not support old connection @@ -4518,6 +4512,21 @@ HISTFILE=/dev/null @item +Where are remote files trashed to? + +Emacs can trash file instead of deleting them, @ref{Misc File Ops, +Trashing , , emacs}. Remote files are always trashed to the local +trash, except remote encrypted files (@pxref{Keeping files +encrypted}), which are deleted anyway. + +If Emacs is configured to use the XDG conventions for the trash +directory, remote files cannot be restored with the respective tools, +because those conventions don't specify remote paths. Such files must +be restored by moving them manually from +@file{$@{XDG_DATA_HOME@}/Trash/files/}, if needed. + + +@item How to shorten long file names when typing in @value{tramp}? Adapt several of these approaches to reduce typing. If the full name @@ -4586,7 +4595,7 @@ completion can further reduce key strokes: @kbd{C-x C-f @value{prefix}ssh@value{postfixhop}x @key{TAB}}. @item -Use environment variables to expand long strings +Use environment variables to expand long strings: For long file names, set up environment variables that are expanded in the minibuffer. Environment variables are set either outside Emacs or @@ -4857,6 +4866,18 @@ remote files}. @item +I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs c.d} + +@value{tramp} comes with compatibility code for different Emacs +versions. When you see this warning, you don't use the Emacs built-in +version of @value{tramp}. In case you have installed @value{tramp} +from GNU ELPA, you must delete and reinstall it. +@ifset installchapter +In case you have installed it from its Git repository, @ref{Recompilation}. +@end ifset + + +@item How to disable other packages from calling @value{tramp}? There are packages that call @value{tramp} without the user ever diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index bccfa0ab6c1..3ce27a12a04 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1740,6 +1740,28 @@ Get the item which @var{widget} is assumed to toggle. This is only meaningful for radio buttons or checkboxes in a list. @end defun +@defun widget-choose title items &optional event +Prompt the user to choose an item from a list of options. + +@var{title} is the name of the list of options. @var{items} should be +a menu, with its items in the simple format or in the extended format. +@xref{Defining Menus,, Defining Menus, elisp, the Emacs Lisp Reference +Manual}. Independently of the format, you don't have to provide a +title for the menu, just pass the desired title in @var{title}. The +optional @var{event} is an input event. If @var{event} is a mouse +event and the number of elements in @var{items} is less than the user +option @code{widget-menu-max-size}, then @code{widget-choose} uses a +popup menu to prompt the user. Otherwise, @code{widget-choose} uses +the minibuffer. + +When @var{items} is a keymap menu, the returned value is the symbol in +the key vector, as in the argument of @code{define-key} +(@pxref{Changing Key Bindings,,,elisp, the Emacs Lisp Reference +Manual}). When @var{items} is a list whose selectable items are of +the form (@var{name} . @var{value}) (i.e., the simplified format), +then the return value is the @var{value} of the chosen element. +@end defun + @node Widget Wishlist @chapter Wishlist @cindex todo diff --git a/etc/ChangeLog.1 b/etc/ChangeLog.1 index 1229b8fec15..5a7cd59c979 100644 --- a/etc/ChangeLog.1 +++ b/etc/ChangeLog.1 @@ -1670,7 +1670,7 @@ * images/icons/allout-widgets-light-bg: Icons for new allout-widgets.el. - * images/icons/README: Include coypright and GPL 3 license for + * images/icons/README: Include copyright and GPL 3 license for new icons. 2011-02-16 Michael Albinus <michael.albinus@gmx.de> @@ -2203,7 +2203,7 @@ 2009-08-13 Kenichi Handa <handa@m17n.org> - * NEWS: Mention the new coding systme `utf-8-hfs' and many + * NEWS: Mention the new coding system `utf-8-hfs' and many functions for Unicode normalization. 2009-08-09 CHENG Gao <chenggao@gmail.com> diff --git a/etc/HELLO b/etc/HELLO index e0345cb7ab9..9ea7ebc2de3 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -7,88 +7,91 @@ some of the character sets that Emacs supports. Non-ASCII examples: - Europe: <x-charset><param>latin-iso8859-1</param>¡Hola!, Grüß Gott, Hyvää päivää,</x-charset><x-charset><param>latin-iso8859-15</param> Tere õhtust,</x-charset><x-charset><param>latin-iso8859-3</param> Bonġu - Cześć!,</x-charset><x-charset><param>latin-iso8859-2</param> Dobrý den,</x-charset><x-charset><param>cyrillic-iso8859-5</param> Здравствуйте!,</x-charset><x-charset><param>greek-iso8859-7</param> Γειά σας,</x-charset><x-charset><param>mule-unicode-0100-24ff</param> გამარჯობა</x-charset> - Africa:<x-charset><param>mule-unicode-0100-24ff</param> </x-charset><x-charset><param>ethiopic</param>ሠላም</x-charset> - Middle/Near East:<x-charset><param>hebrew-iso8859-8</param> שָׁלוֹם,</x-charset><x-charset><param>mule-unicode-0100-24ff</param> السّلام عليكم</x-charset> - South Asia:<x-charset><param>mule-unicode-0100-24ff</param> નમસ્તે, नमस्ते, ನಮಸ್ಕಾರ, നമസ്കാരം, ଶୁଣିବେ, - ආයුබෝවන්, வணக்கம், నమస్కారం,</x-charset><x-charset><param>tibetan</param> བཀྲ་ཤིས་བདེ་ལེགས༎</x-charset> - South East Asia:<x-charset><param>mule-unicode-0100-24ff</param> ជំរាបសួរ,</x-charset><x-charset><param>lao</param> ສະບາຍດີ,</x-charset><x-charset><param>mule-unicode-0100-24ff</param> မင်္ဂလာပါ,</x-charset><x-charset><param>thai-tis620</param> สวัสดีครับ,</x-charset><x-charset><param>vietnamese-viscii-lower</param> </x-charset><x-charset><param>vietnamese-viscii-upper</param>C</x-charset><x-charset><param>vietnamese-viscii-lower</param>hào bạn</x-charset> + Europe: <x-charset><param>latin-iso8859-1</param>¡Hola!, Grüß Gott, Hyvää päivää,</x-charset> Tere õhtust,<x-charset><param>latin-iso8859-3</param> Bonġu + Cześć!,</x-charset><x-charset><param>latin-iso8859-2</param> Dobrý den,</x-charset><x-charset><param>cyrillic-iso8859-5</param> Здравствуйте!,</x-charset><x-charset><param>greek-iso8859-7</param> Γειά σας,</x-charset> გამარჯობა + Africa: <x-charset><param>ethiopic</param>ሠላም</x-charset> + Middle/Near East:<x-charset><param>hebrew-iso8859-8</param> שָׁלוֹם,</x-charset> السّلام عليكم + South Asia: નમસ્તે, नमस्ते, ನಮಸ್ಕಾರ, നമസ്കാരം, ଶୁଣିବେ, + ආයුබෝවන්, வணக்கம், నమస్కారం,<x-charset><param>tibetan</param> བཀྲ་ཤིས་བདེ་ལེགས༎</x-charset> + South East Asia: ជំរាបសួរ,<x-charset><param>lao</param> ສະບາຍດີ,</x-charset> မင်္ဂလာပါ,<x-charset><param>thai-tis620</param> สวัสดีครับ,</x-charset><x-charset><param>vietnamese-viscii-lower</param> </x-charset><x-charset><param>vietnamese-viscii-upper</param>C</x-charset><x-charset><param>vietnamese-viscii-lower</param>hào bạn</x-charset> East Asia:<x-charset><param>chinese-gb2312</param> 你好,</x-charset><x-charset><param>chinese-big5-1</param> 早晨,</x-charset><x-charset><param>japanese-jisx0208</param> こんにちは,</x-charset><x-charset><param>korean-ksc5601</param> 안녕하세요</x-charset> - Misc:<x-charset><param>latin-iso8859-3</param> Eĥoŝanĝo ĉiuĵaŭde,</x-charset><x-charset><param>mule-unicode-2500-33ff</param> ⠓⠑⠇⠇⠕,</x-charset><x-charset><param>mule-unicode-0100-24ff</param> ∀ p ∈ world • hello p </x-charset><x-charset><param>mule-unicode-2500-33ff</param>□</x-charset> + Misc:<x-charset><param>latin-iso8859-3</param> Eĥoŝanĝo ĉiuĵaŭde,</x-charset> ⠓⠑⠇⠇⠕, ∀ p ∈ world • hello p □ CJK variety:<x-charset><param>chinese-gb2312</param> GB(元气,开发),</x-charset><x-charset><param>chinese-big5-1</param> BIG5(元氣,開發),</x-charset><x-charset><param>japanese-jisx0208</param> JIS(元気,開発),</x-charset><x-charset><param>korean-ksc5601</param> KSC(元氣,開發)</x-charset> Unicode charset:<x-charset><param>unicode</param> Eĥoŝanĝo ĉiuĵaŭde, Γειά σας, שלום, Здравствуйте!</x-charset> LANGUAGE (NATIVE NAME) HELLO ---------------------- ----- -<x-charset><param>mule-unicode-0100-24ff</param>Amharic (አማርኛ) ሠላም +Amharic (አማርኛ) ሠላም Arabic (العربيّة) السّلام عليكم Armenian (հայերեն) Բարև ձեզ +Belarusian (беларуская) Прывітанне Bengali (বাংলা) নমস্কার -</x-charset><x-charset><param>mule-unicode-2500-33ff</param>Braille ⠓⠑⠇⠇⠕ -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Burmese (မြန်မာ) မင်္ဂလာပါ -</x-charset>C printf ("Hello, world!\n"); -<x-charset><param>unicode</param>Cherokee (ᏣᎳᎩ ᎦᏬᏂᎯᏍᏗ) ᎣᏏᏲ / ᏏᏲ +Braille ⠓⠑⠇⠇⠕ +Burmese (မြန်မာ) မင်္ဂလာပါ +C printf ("Hello, world!\n"); +Cherokee (ᏣᎳᎩ ᎦᏬᏂᎯᏍᏗ) ᎣᏏᏲ / ᏏᏲ Comanche /kəˈmæntʃiː/ Haa marʉ́awe Cree (ᓀᐦᐃᔭᐍᐏᐣ) ᑕᓂᓯ / ᐙᒋᔮ -</x-charset><x-charset><param>latin-iso8859-2</param>Czech (čeština) Dobrý den -</x-charset><x-charset><param>latin-iso8859-1</param>Danish (dansk) Hej / Goddag / Halløj +Czech (čeština) Dobrý den +Danish (dansk) Hej / Goddag / Halløj Dutch (Nederlands) Hallo / Dag -</x-charset><x-charset><param>unicode</param>Efik /ˈɛfɪk/ Mɔkɔm +Efik /ˈɛfɪk/ Mɔkɔm + +Egyptian Hieroglyphs (𓂋𓏤𓈖𓆎𓅓𓏏𓊖) 𓅓𓊵𓏏𓊪, 𓇍𓇋𓂻𓍘𓇋 Emacs emacs --no-splash -f view-hello-file Emoji 👋 -</x-charset>English <x-charset><param>ipa</param>/ˈɪŋɡlɪʃ/</x-charset> Hello -<x-charset><param>latin-iso8859-3</param>Esperanto Saluton (Eĥoŝanĝo ĉiuĵaŭde) -</x-charset><x-charset><param>latin-iso8859-15</param>Estonian (eesti keel) Tere päevast / Tere õhtust -</x-charset><x-charset><param>latin-iso8859-1</param>Finnish (suomi) Hei / Hyvää päivää +English /ˈɪŋɡlɪʃ/ Hello +Esperanto Saluton (Eĥoŝanĝo ĉiuĵaŭde) +Estonian (eesti keel) Tere päevast / Tere õhtust +Finnish (suomi) Hei / Hyvää päivää French (français) Bonjour / Salut -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Georgian (ქართული) გამარჯობა -</x-charset><x-charset><param>latin-iso8859-1</param>German (Deutsch) Guten Tag / Grüß Gott -</x-charset><x-charset><param>greek-iso8859-7</param>Greek (ελληνικά) Γειά σας -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Greek, ancient (ἑλληνική) Οὖλέ τε καὶ μέγα χαῖρε +Georgian (ქართული) გამარჯობა +German (Deutsch) Guten Tag / Grüß Gott +Greek (ελληνικά) Γειά σας +Greek, ancient (ἑλληνική) Οὖλέ τε καὶ μέγα χαῖρε Gujarati (ગુજરાતી) નમસ્તે -</x-charset><x-charset><param>hebrew-iso8859-8</param>Hebrew (עִבְרִית) שָׁלוֹם -</x-charset><x-charset><param>latin-iso8859-2</param>Hungarian (magyar) Szép jó napot! -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Hindi (हिंदी) नमस्ते / नमस्कार । -</x-charset><x-charset><param>unicode</param>Inuktitut (ᐃᓄᒃᑎᑐᑦ) ᐊᐃ - -</x-charset><x-charset><param>latin-iso8859-1</param>Italian (italiano) Ciao / Buon giorno -</x-charset>Javanese (Jawa) System.out.println("Sugeng siang!"); -<x-charset><param>mule-unicode-0100-24ff</param>Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ +Hebrew (עִבְרִית) שָׁלוֹם +Hungarian (magyar) Szép jó napot! +Hindi (हिंदी) नमस्ते / नमस्कार । +Inuktitut (ᐃᓄᒃᑎᑐᑦ) ᐊᐃ + +Italian (italiano) Ciao / Buon giorno +Javanese (ꦧꦱꦗꦮꦶ) console.log("ꦲꦭꦺꦴ"); +Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ Khmer (ភាសាខ្មែរ) ជំរាបសួរ -</x-charset><x-charset><param>lao</param>Lao (ພາສາລາວ) ສະບາຍດີ / ຂໍໃຫ້ໂຊກດີ -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Malayalam (മലയാളം) നമസ്കാരം -</x-charset><x-charset><param>unicode</param>Maldivian (ދިވެހި) އައްސަލާމު ޢަލައިކުމް / ކިހިނެހް؟ - -</x-charset><x-charset><param>latin-iso8859-3</param>Maltese (il-Malti) Bonġu / Saħħa -</x-charset><x-charset><param>unicode</param>Mathematics ∀ p ∈ world • hello p □ -</x-charset><x-charset><param>cyrillic-iso8859-5</param>Mongolian (монгол хэл) Сайн байна уу? -</x-charset><x-charset><param>latin-iso8859-1</param>Norwegian (norsk) Hei / God dag -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Oriya (ଓଡ଼ିଆ) ଶୁଣିବେ -</x-charset><x-charset><param>latin-iso8859-2</param>Polish (język polski) Dzień dobry! / Cześć! -</x-charset><x-charset><param>cyrillic-iso8859-5</param>Russian (русский) Здра́вствуйте! -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Sinhala (සිංහල) ආයුබෝවන් -</x-charset><x-charset><param>latin-iso8859-2</param>Slovak (slovenčina) Dobrý deň +Lao (ພາສາລາວ) ສະບາຍດີ / ຂໍໃຫ້ໂຊກດີ +Malayalam (മലയാളം) നമസ്കാരം +Maldivian (ދިވެހި) އައްސަލާމު ޢަލައިކުމް / ކިހިނެހް؟ + +Maltese (il-Malti) Bonġu / Saħħa +Mathematics ∀ p ∈ world • hello p □ +Mongolian (монгол хэл) Сайн байна уу? +Norwegian (norsk) Hei / God dag +Oriya (ଓଡ଼ିଆ) ଶୁଣିବେ +Polish (język polski) Dzień dobry! / Cześć! +Russian (русский) Здра́вствуйте! +Sinhala (සිංහල) ආයුබෝවන් +Slovak (slovenčina) Dobrý deň Slovenian (slovenščina) Pozdravljeni! -Spanish (espa</x-charset><x-charset><param>latin-iso8859-1</param>ñol) ¡Hola! +Spanish (español) ¡Hola! Swedish (svenska) Hej / Goddag / Hallå -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Tamil (தமிழ்) வணக்கம் +Tamil (தமிழ்) வணக்கம் Telugu (తెలుగు) నమస్కారం -</x-charset>TaiViet (ꪁꪫꪱꪣ ꪼꪕ) ꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ +TaiViet (ꪁꪫꪱꪣ ꪼꪕ) ꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ + +Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ +Tibetan (བོད་སྐད་) བཀྲ་ཤིས་བདེ་ལེགས༎ +Tigrigna (ትግርኛ) ሰላማት +Turkish (Türkçe) Merhaba +Ukrainian (українська) Вітаю +Vietnamese (tiếng Việt) Chào bạn -<x-charset><param>thai-tis620</param>Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ -</x-charset><x-charset><param>tibetan</param>Tibetan (བོད་སྐད་) བཀྲ་ཤིས་བདེ་ལེགས༎ -</x-charset><x-charset><param>mule-unicode-0100-24ff</param>Tigrigna (ትግርኛ) ሰላማት -</x-charset><x-charset><param>latin-iso8859-9</param>Turkish (Türkçe) Merhaba -</x-charset><x-charset><param>cyrillic-iso8859-5</param>Ukrainian (українська) Вітаю -</x-charset><x-charset><param>vietnamese-viscii-lower</param>Vietnamese (tiếng </x-charset><x-charset><param>vietnamese-viscii-upper</param>V</x-charset><x-charset><param>vietnamese-viscii-lower</param>iệt) </x-charset><x-charset><param>vietnamese-viscii-upper</param>Chào bạn -</x-charset> <x-charset><param>japanese-jisx0208</param>Japanese (日本語) こんにちは</x-charset> <x-charset><param>katakana-jisx0201</param>/ ｺﾝﾆﾁﾊ </x-charset><x-charset><param>chinese-gb2312</param>Chinese (中文,普通话,汉语) 你好 @@ -97,7 +100,7 @@ Telugu (తెలుగు) నమస్కారం </x-charset> -<x-charset><param>unicode</param> + Copyright (C) 2001-2020 Free Software Foundation, Inc. @@ -123,8 +126,8 @@ along with GNU Emacs. If not, see <<https://www.gnu.org/licenses/>. ;;; Local Variables: -;;; tab-width: 32 +;;; tab-width: 42 ;;; bidi-display-reordering: t ;;; coding: utf-8 ;;; inhibit-compacting-font-caches: t -;;; End:</x-charset> +;;; End: @@ -85,6 +85,33 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 +** Minibuffer scrolling is now conservative by default. +This is controlled by the new variable 'scroll-minibuffer-conservatively'. + ++++ +** New system for displaying documentation for groups of functions. +This can either be used by saying 'M-x shortdoc-display-group' and +choosing a group, or clicking a button in the *Help* buffers when +looking at the doc string of a function that belongs to one of these +groups. + +** New variable 'redisplay-skip-initial-frame' to enable batch redisplay tests. +Setting it to nil forces the redisplay to do its job even in the +initial frame used in batch mode. + +--- +** Support for the 'strike-through' face attribute on TTY frames. +If your terminal's termcap or terminfo database entry has the 'smxx' +capability defined, Emacs will now emit the prescribed escape +sequences necessary to render faces with the 'strike-through' +attribute on TTY frames. + ++++ +** Emacs now defaults to UTF-8 instead of ISO-8859-1. +This is only for the default, where the user has set no 'LANG' (or +similar) variable or environment. This change should lead to no +user-visible changes for normal usage. + +++ ** New variables that hold default buffer names for shell output. The new constants 'shell-command-buffer-name' and @@ -121,6 +148,36 @@ the mouse cursor is on the scroll bars, fringes, margins, header line, and mode line. ('mwheel-mode' is enabled by default on most graphical displays.) +--- +** Mouse wheel scrolling now defaults to one line at a time. + ++++ +** Mouse wheel scrolling with Shift modifier now scrolls horizontally. +This works in text buffers and over images. + +--- +** The default value of 'frame-title-format' and 'icon-title-format' has changed. +These variables are used to display the title bar of visible frames +and the title bar of an iconified frame. They now show the name of +the current buffer and the text "GNU Emacs" instead of the value of +'invocation-name'. To get the old behavior back, add the following to +your init file: + + (setq frame-title-format '(multiple-frames "%b" + ("" invocation-name "@" system-name))) + ++++ +** 'nobreak-char-display' now also affects all non-ASCII space characters. +Previously, this was limited only to NO-BREAK-SPACE and hyphen +characters. Now it also covers the rest of the non-ASCII Unicode +space characters. + +--- +** Prefer "chat.freenode.net" to "irc.freenode.net". +"chat.freenode.net" has been the preferred address for connecting to the +freenode IRC network for years now. Occurrences of "irc.freenode.net" +have been replaced with "chat.freenode.net" throughout Emacs. + * Editing Changes in Emacs 28.1 @@ -132,6 +189,12 @@ would have to type 'M-: M-p' to edit and redo the expression. Now Emacs will echo the message and allow the user to continue editing. +++ +** 'eval-last-sexp' now handles 'defvar'/'defcustom'/'defface' specially. +This command would previously not redefine values defined by these +forms, but this command has now been changed to work more like +'eval-defun', and reset the values as specified. + ++++ ** New command 'undo-redo'. It undoes previous undo commands, but doesn't record itself as an undoable command. @@ -148,14 +211,17 @@ Each buffer will keep a separate history of line numbers used with line numbers that were previously jumped to. +++ +** New command 'goto-line-relative' to use in a narrowed buffer. +It moves point to the line relative to the accessible portion of the +narrowed buffer. 'M-g M-g' in Info is rebound to this command. +When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed +buffer to be able to move point to the inaccessible portion. +'goto-line-relative' is bound to 'C-x n g'. + ++++ ** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x' shows equivalent key bindings for all commands that have them. ---- -** Movement commands in 'gomoku-mode' are fixed. -'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and -horizontal movements now stop at the edge of the board. - ** Autosaving via 'auto-save-visited-mode' can now be inhibited by setting the variable 'auto-save-visited-mode' buffer-locally to nil. @@ -164,9 +230,44 @@ setting the variable 'auto-save-visited-mode' buffer-locally to nil. description of the properties. Likewise 'button-describe' does the same for a button. +** Obsolete commands are no longer hidden from command completion. +Completion of command names now considers obsolete aliases as +candidates. Invoking a command via an obsolete alias now mentions the +obsolescence fact and shows the new name of the command. + ++++ +** New command 'revert-buffer-with-fine-grain'. +Revert a buffer trying to be as non-destructive as possible, +preserving markers, properties and overlays. The new variable +'revert-buffer-with-fine-grain-max-seconds' specifies the maximum +number of seconds that 'revert-buffer-with-fine-grain' should spend +trying to be non-destructive. + +** Outline + ++++ +*** New commands to cycle heading visibility. +Typing 'TAB' on a heading cycles the current section between "hide +all", "subheadings", and "show all" state. Typing 'S-TAB' anywhere in +the buffer cycles the whole buffer between "only top-level headings", +"all headings and subheadings", and "show all" states. + * Changes in Specialized Modes and Packages in Emacs 28.1 +** Python mode + +*** 'C-c C-r' can now be used on arbitrary regions. +The command previously extended the start of the region to the start +of the line, but will now actually send the marked region, as +documented. + +** Ruby mode + +*** 'ruby-use-smie' is declared obsolete. +SMIE is now always enabled and 'ruby-use-smie' only controls whether +indentation is done using SMIE or with the old ad-hoc code. + --- ** Specific warnings can now be disabled from the warning buffer. When a warning is displayed to the user, the resulting buffer now has @@ -202,10 +303,18 @@ of the next command to be displayed in a new frame. It's bound to the command 'other-tab-prefix' that requests the buffer of the next command to be displayed in a new tab. ++++ +*** New command 'C-x t C-r' to open file read-only in other tab. + *** The tab bar is frame-local when 'tab-bar-show' is a number. Show/hide the tab bar independently for each frame, according to the value of 'tab-bar-show'. +--- +*** The tabs in the tab line can now be scrolled using horizontal scroll. +If your mouse or trackpad supports it, you can now scroll tabs when +the mouse pointer is in the tab line by scrolling left or right. + ** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and 'previous-error-no-select' bound to 'p'. @@ -222,6 +331,9 @@ and variables. ** Archive mode +--- +*** Archive Mode can now parse ".squashfs" files. + *** Can now modify members of 'ar' archives. *** Display of summaries unified between backends. @@ -253,6 +365,13 @@ time zones will use a form like "+0100" instead of "CET". ** Dired ++++ +*** New user option 'dired-switches-in-mode-line'. +This user option controls how 'ls' switches are displayed in the mode +line, and allows truncating them (to preserve space on the mode line) +or showing them literally, either instead of, or in addition to, +displaying "by name" or "by date" sort order. + --- *** Broken and circular links are shown with the 'dired-broken-symlink' face. @@ -285,6 +404,19 @@ details of marking the file at the end of the region. *** State changing VC operations are supported in Dired on files and directories with the help of new command 'dired-vc-next-action'. ++++ +*** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'. +The 'dired-jump' and 'dired-jump-other-window' commands have been +moved from the 'dired-x' package to 'dired'. The user option +'dired-bind-jump' no longer has any effect and is now obsolete. +The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default. + +To get the old behavior of 'dired-bind-jump' back and unbind the above +keys, add the following to your init file: + +(global-set-key "\C-x\C-j" nil) +(global-set-key "\C-x4\C-j" nil) + ** Change Logs and VC *** More VC commands can be used from non-file buffers. @@ -294,6 +426,14 @@ their 'default-directory' under VC. *** New command 'vc-dir-root' uses the root directory without asking. +--- +*** The responsible VC backend is now the most specific one. +'vc-responsible-backend' loops over the backends in +'vc-handled-backends' to determine which backend is responsible for a +specific (unregistered) file. Previously the first matching backend +was chosen, but now the one with the most specific path is chosen (in +case there's a directory handled by one backend inside another). + *** New commands 'vc-dir-mark-registered-files' (bound to '* r') and 'vc-dir-mark-unregistered-files'. @@ -317,18 +457,52 @@ tags to be considered as well. ** Gnus +++ +*** New value for user option 'smiley-style'. +Smileys can now be rendered with emojis instead of small images when +using the new 'emoji' value in 'smiley-style'. + ++++ +*** New user option 'gnus-agent-eagerly-store-articles'. +If non-nil (which is the default), the Gnus Agent will store all read +articles in the Agent cache. + ++++ +*** New user option 'gnus-global-groups'. +Gnus handles private groups differently from public (i.e., NNTP-like) +groups. Most importantly, Gnus doesn't download external images from +mail-like groups. This can be overridden by putting group names in +'gnus-global-groups': Any group present in that list will be treated +like a public group. + ++++ +*** New scoring types for the Date header. +You can now score based on the relative age of an article with the new +'<' and '>' date scoring types. + ++++ +*** User-defined scoring is now possible. +The new type is 'score-fn'. More information in the Gnus manual node +"(gnus) Score File Format". + ++++ *** New backend 'nnselect'. The newly added 'nnselect' backend allows creating groups from an arbitrary list of articles that may come from multiple groups and servers. These groups generally behave like any other group: they may be ephemeral or persistent, and allow article marking, moving, deletion, etc. 'nnselect' groups may be created like any other group, -but there is also a convenience function for the common case of +but there are three convenience functions for the common case of obtaining the list of articles as a result of a search: 'gnus-group-make-search-group' ('G g') that will prompt for an 'nnir' -search query and create a dedicated group for that search. As part of -this addition, the user option 'nnir-summary-line-format' has been -removed; its functionality is now available directly in the +search query and create a persistent group for that search; +'gnus-group-read-ephemeral-search-group' ('G G') that will prompt for +an 'nnir' search query and create an ephemeral group for that search; +and 'gnus-summary-make-group-from-search' ('C-c C-p') that will create +a persistent group with the search parameters of a current ephemeral +search group. + +As part of this addition, the user option 'nnir-summary-line-format' +has been removed; its functionality is now available directly in the 'gnus-summary-line-format' specs '%G' and '%g'. The user option 'gnus-refer-thread-use-nnir' has been renamed to 'gnus-refer-thread-use-search'. @@ -386,7 +560,7 @@ changed so that all the recipients are put in the "To" header in these instances. +++ -*** New function to start Emacs in Message mode to send an email. +*** New command to start Emacs in Message mode to send an email. Emacs can be defined as a handler for the "x-scheme-handler/mailto" MIME type with the following command: "emacs -f message-mailto %u". An "emacs-mail.desktop" file has been included, suitable for @@ -416,14 +590,40 @@ take the actual screenshot, and defaults to "ImageMagick import". A server entry retrieved by auth-source can request a desired smtp authentication mechanism by setting a value for the key 'smtp-auth'. +** Grep + ++++ +*** New user option 'grep-match-regexp' matches grep markers to highlight. +Grep emits SGR ANSI escape sequences to color its output. The new +user option 'grep-match-regexp' holds the regular expression to match +the appropriate markers in order to provide highlighting in the source +buffer. The user option can be customized to accommodate other +grep-like tools. + +--- +*** The 'lgrep' command now ignores directories. +On systems where the grep command supports it, directories will be +skipped. + ** Help +--- +*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation. + +++ *** New command 'describe-keymap' describes keybindings in a keymap. --- +*** New keybinding 'C-h R' prompts for a manual to display and displays it. + ++++ +** New command 'lossage-size'. +It allows users to set the maximum number of keystrokes and commands +recorded for the purpose of 'view-lossage'. + +--- *** The command 'view-lossage' can now be invoked from the menu bar. -The menu-bar Help menu now has a "Show Recent Inputs" item under the +The menu bar "Help" menu now has a "Show Recent Inputs" item under the "Describe" sub-menu. ** Ispell @@ -439,6 +639,16 @@ defaulting to active region when used interactively. ** The old non-SMIE indentation of 'sh-mode' has been removed. --- +** The 'list-bookmark' menu is now based on 'tabulated-list-mode'. +The interactive bookmark list will now benefit from features in +'tabulated-list-mode' like sorting columns or changing column width. + +Support for the optional "inline" header line, allowing for a header +without using 'header-line-format', has been dropped. Consequently, +the variables 'bookmark-bmenu-use-header-line' and +'bookmark-bmenu-inline-header-height' are now declared obsolete. + +--- ** The sb-image.el library is now marked obsolete. This file was a compatibility kludge which is no longer needed. @@ -458,9 +668,16 @@ supplied error message. which appends a unique suffix to the Edebug name of the current definition. -+++ ** ElDoc ++++ +*** New user option 'eldoc-echo-area-display-truncation-message'. +If non-nil (the default), eldoc will display a message saying +something like "(Documentation truncated. Use `M-x eldoc-doc-buffer' +to see rest)" when a message has been truncated. If nil, truncated +messages will be marked with just "..." at the end. + ++++ *** New hook 'eldoc-documentation-functions'. This hook is intended to be used for registering doc string functions. These functions don't need to produce the doc string right away, they @@ -468,6 +685,14 @@ may arrange for it to be produced asynchronously. The results of all doc string functions are accessible to the user through the user option 'eldoc-documentation-strategy'. +*** New hook 'eldoc-display-functions'. +This hook is intended to be used for displaying doc strings. The +functions receive the doc string composed according to +'eldoc-documentation-strategy' and are tasked with displaying it to +the user. Examples of such functions would use the echo area, a +separate buffer, or a tooltip. + ++++ *** New user option 'eldoc-documentation-strategy'. The built-in choices available for this user option let users compose the results of 'eldoc-documentation-functions' in various ways, even @@ -481,6 +706,13 @@ by the ElDoc library itself. Functions in 'eldoc-documentation-functions' don't need to worry about consulting it when producing a doc string. +** Shell + +--- +*** New command in 'shell-mode': 'narrow-to-prompt'. +This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the +command line under point (and any following output). + ** Eshell --- @@ -507,6 +739,11 @@ preferred over the eudcb-mab.el backend. like cell phones, tablets or cameras. +++ +*** Trashed remote files are moved to the local trash directory. +All remote files, which are trashed, are moved to the local trash +directory. Except remote encrypted files, which are always deleted. + ++++ *** New command 'tramp-crypt-add-directory'. This command marks a remote directory to contain only encrypted files. See the "(tramp) Keeping files encrypted" node of the Tramp manual for @@ -538,7 +775,7 @@ equivalent to '(map (:sym sym))'. ** Package +++ -*** New functions to filter the package list. +*** New commands to filter the package list. The filter command key bindings are as follows: key binding @@ -549,6 +786,7 @@ key binding / s package-menu-filter-by-status / v package-menu-filter-by-version / m package-menu-filter-marked +/ u package-menu-filter-upgradable / / package-menu-filter-clear --- @@ -595,6 +833,9 @@ required, but the recommended solution is to use a correctly matching regexp instead. --- +*** Messages from ShellCheck are now recognized. + +--- *** Messages from Visual Studio that mention column numbers are now recognized. ** Hi Lock mode @@ -638,6 +879,14 @@ current environment. Its default value matches localized abbreviations of the "reply" prefix on the Subject line in various languages. +--- +*** New user option 'shr-offer-extend-specpdl'. +If this is nil, rendering of HTML in the email message body that +requires to enlarge 'max-specpdl-size', the number of Lisp variable +bindings, will be aborted, and Emacs will not ask you whether to +enlarge 'max-specpdl-size' to complete the rendering. The default is +t, which preserves the original behavior. + ** Apropos *** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'. @@ -695,12 +944,12 @@ Formerly, one could do the same by setting 'browse-url-browser-function' to such an alist. This usage is still supported but deprecated. -*** Categorization of browsing functions in internal vs. external. -All standard browsing functions such as 'browse-url-firefox', +*** Categorization of browsing commands in internal vs. external. +All standard browsing commands such as 'browse-url-firefox', 'browse-url-mail', or 'eww' have been categorized into internal (URL is browsed in Emacs) or external (an external application is spawned with the URL). This is done by adding a 'browse-url-browser-kind' -symbol property to the browsing functions. With a new command +symbol property to the browsing commands. With a new command 'browse-url-with-browser-kind', an URL can explicitly be browsed with either an internal or external browser. @@ -774,7 +1023,12 @@ background colors or transparency, such as xbm, pbm, svg, png and gif. ** EWW +++ -*** New Emacs command line convenience function. +*** New user option 'eww-retrieve-command'. +This can be used to download data via an external command. If nil +(the default), then 'url-retrieve' is used. + ++++ +*** New Emacs command line convenience command. The 'eww-browse' command has been added, which allows you to register Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the supplied URL. Usage example: "emacs -f eww-browse https://gnu.org". @@ -864,6 +1118,10 @@ The 'erc-current-nick-highlight-type', 'erc-pal-highlight-type', 'erc-dangerous-host-highlight-type' variables now support a 'message' type for highlighting the entire message but not the sender's nick. +*** erc-status-sidebar.el is now part of ERC. +The 'erc-status-sidebar' package which provides a HexChat-like +activity overview sidebar for joined IRC channels is now part of ERC. + ** Battery --- @@ -907,9 +1165,15 @@ custom rules, see the variables 'bug-reference-setup-from-vc-alist', It's bound to the 'C-c C-c f' keystroke, and prompts for a local file name. ---- ** Recentf -The recentf files are no longer backed up. + +--- +*** The recentf files are no longer backed up. + +--- +*** 'recentf-auto-cleanup' time string now repeats. +When 'recentf-auto-cleanup' is set to a time string, it now repeats +every day, rather than only running once after the mode is turned on. ** Calc @@ -921,6 +1185,17 @@ work more traditionally, with 'C-d' deleting the next character. Likewise, point isn't moved to the end of the string before inserting digits. ++++ +*** Setting the word size to zero disables word clipping. +The word size normally clips the results of certain bit-oriented +operations such as shifts and bitwise XOR. A word size of zero, set +by 'b w', makes the operation have effect on the whole argument values +and the result is not truncated in any way. + +--- +*** The '/' operator now has higher precedence in (La)TeX input mode. +It no longer has lower precedence than '+' and '-'. + ** term-mode --- @@ -936,9 +1211,119 @@ based on the current window size. In previous versions of Emacs, this was always done (and that could lead to odd displays when resizing the window after starting). This variable defaults to nil. +** Widget + ++++ +*** 'widget-choose' now supports menus in extended format. + +--- +*** The 'editable-list' widget now supports moving items up and down. +You can now move items up and down by deleting and then reinserting +them, using the 'DEL' and 'INS' buttons respectively. This is useful +in Custom buffers, for example, to change the order of the elements in +a list. + +** Diff + +--- +*** New 'diff-mode' font locking face 'diff-error'. +This face is used for error messages from 'diff'. + ++++ +*** New command 'diff-refresh-hunk'. +This new command (bound to 'C-c C-l') regenerates the current hunk. + ** Miscellaneous +++ +*** 'format-seconds' can now be used for sub-second times. +The new optional "," parameter has been added, and +'(format-seconds "%mm %,1ss" 66.4)' will now result in "1m 6.4s". + +--- +*** 'global-display-fill-column-indicator-mode' skips some buffers. +By default, turning on 'global-display-fill-column-indicator-mode' +doesn't turn on 'display-fill-column-indicator-mode' in special-mode +buffers. This can be controlled by customizing the variable +'global-display-fill-column-indicator-modes'. + +--- +*** New user option 'compilation-search-all-directories'. +When doing parallel builds, directories and compilation errors may +arrive in the *compilation* buffer out-of-order. If this variable is +non-nil (the default), Emacs will now search backwards in the buffer +for any directory the file with errors may be in. If nil, this won't +be done (and this restores how this previously worked). + ++++ +*** New user option 'next-error-message-highlight'. +In addition to a fringe arrow, 'next-error' error may now optionally +highlight the current error message in the 'next-error' buffer. +This user option can be also customized to keep highlighting on all +visited errors, so you can have an overview what errors were already visited. + ++++ +*** New user option 'tab-first-completion'. +If 'tab-always-indent' is 'complete', this new user option can be used to +further tweak whether to complete or indent. + +--- +*** 'zap-up-to-char' now uses 'read-char-from-minibuffer'. +This allows navigating through the history of characters that have +been input. This is mostly useful for characters that have complex +input methods where inputting the character again may involve many +keystrokes. + ++++ +*** Interactive regular expression search now uses faces for sub-groups. +E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face +on the part of the regexp that matches the sub-expression "[0-9]+". +By default, there are two faces for sub-group highlighting, but you +can define more faces whose names are of the form 'isearch-group-N', +where N are successive numbers above 2. + +This is controlled by the 'search-highlight-submatches' user option. +This feature is available only on terminals that have enough colors to +distinguish between sub-expression highlighting. + ++++ +*** Interactive regular expression replace now uses faces for sub-groups. +Like 'search-highlight-submatches', this is controlled by the new user option +'query-replace-highlight-submatches'. + +--- +*** New user option 'reveal-auto-hide'. +If non-nil (the default), revealed text is automatically hidden when +point leaves the text. If nil, the text is not hidden again. Instead +'M-x reveal-hide-revealed' can be used to hide all the revealed text. + ++++ +*** New user options to control the look of line/column numbers in the mode line. +'mode-line-position-line-format' is the line number format (when +'line-number-mode' is on), 'mode-line-position-column-format' is +the column number format (when 'column-number-mode' is on), and +'mode-line-position-column-line-format' is the combined format (when +both modes are on). + ++++ +*** New command 'submit-emacs-patch'. +This works like 'report-emacs-bug', but is more geared towards sending +patches to the Emacs issue tracker. + ++++ +*** New minor mode 'button-mode'. +This minor mode does nothing else than install 'button-buffer-map' as +a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate +to buttons), and can be used in any view-mode-like buffer that has +buttons in it. + +--- +*** 'icomplete-show-matches-on-no-input' behavior change. +Previously, choosing a different completion with commands like 'C-.' +and then hitting 'RET' would choose the default completion. Doing +this will now choose the completion under point. + ++++ *** The user can now customize how "default" values are prompted for. The new utility function 'format-prompt' has been added which uses the new 'minibuffer-default-prompt-format' user option to format "default" @@ -948,10 +1333,6 @@ number [10]", or not have the default displayed at all, like "Enter a number". (This requires that all callers are altered to use 'format-prompt', though.) ---- -*** New 'diff-mode' font locking face 'diff-error'. -This face is used for error messages from diff. - +++ *** New global mode 'global-goto-address-mode'. This will enable 'goto-address-mode' in all buffers. @@ -1004,9 +1385,24 @@ never be narrower than 19 characters. When the bookmark.el library is loaded, a customize choice is added to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. +--- +*** Movement commands in 'gomoku-mode' are fixed. +'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and +horizontal movements now stop at the edge of the board. + +** xterm-mouse mode + +--- +*** TTY menu navigation is now supported in 'xterm-mouse-mode'. +TTY menus support mouse navigation and selection when 'xterm-mouse-mode' +is active. When run on a terminal, clicking on the menu bar with the +mouse now pops up a TTY menu by default instead of running the command +'tmm-menubar'. To restore the old behavior, set the user option +'tty-menu-open-use-tmm' to non-nil. + ** xwidget-webkit mode -*** New xwidget functions. +*** New xwidget commands. 'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title' (return the current title), and 'xwidget-webkit-goto-history' (goto a point in history). @@ -1036,6 +1432,10 @@ easily bind this menu to 'down-mouse-3' (usually the right mouse button) instead of 'mouse-2' (the default) by customizing the new user option 'flyspell-use-mouse-3-for-menu'. +--- +*** The current dictionary is now displayed in the minor mode lighter. +Clicking the dictionary name changes the current dictionary. + ** Time --- @@ -1044,7 +1444,7 @@ instead of 'mouse-2' (the default) by customizing the new user option several time zones. It is hoped that the new names are more discoverable. -The following functions have been renamed: +The following commands have been renamed: 'display-time-world' to 'world-clock' 'display-time-world-mode' to 'world-clock-mode' @@ -1064,11 +1464,47 @@ The old names are now obsolete. ** D-Bus +++ +*** Property values can be typed explicitly. +'dbus-register-property' and 'dbus-set-property' accept now optional +type symbols. Both functions propagate D-Bus errors. + ++++ *** Registered properties can have the new access type ':write'. +++ *** In case of problems, handlers can emit proper D-Bus error messages now. ++++ +*** D-Bus errors, which have been converted from incoming D-Bus error +messages, contain the error name of that message now. + ++++ +*** D-Bus messages can be monitored with new function 'dbus-register-monitor'. + ++++ +*** D-Bus events have changed their internal structure. +They carry now the destination and the error-name of an event. They +also keep the type information of their arguments. Use the +'dbus-event-*' accessor functions. + +** CPerl Mode + +--- +*** The command 'cperl-set-style' offers the new value "PBP". +This value customizes Emacs to use the style recommended in Damian +Conway's book "Perl Best Practices" for indentation and formatting +of conditionals. + +** Abbrev mode + ++++ +*** Emacs can now suggest to use an abbrev based on text you type. +A new user option, 'abbrev-suggest', enables the new abbrev suggestion +feature. When enabled, if a user manually types a piece of text that +could have saved enough typing by using an abbrev, a hint will be +displayed in the echo area, mentioning the abbrev that could have been +used instead. + * New Modes and Packages in Emacs 28.1 @@ -1084,9 +1520,11 @@ mode, as are other data files produced by Emacs. It's a library to create, query, navigate and display hierarchy structures. ** New themes 'modus-vivendi' and 'modus-operandi'. -These themes are designed for colour-contrast accessibility. You can -load the new themes using 'M-x customize-themes' or 'load-theme' from -your init file. +These themes are designed to conform with the highest standard for +color-contrast accessibility (WCAG AAA). You can load either of them +using 'M-x customize-themes' or 'load-theme' from your init file. +Consult the Modus Themes Info manual for more information on the user +options they provide. * Incompatible Editing Changes in Emacs 28.1 @@ -1101,6 +1539,15 @@ directory instead of the default directory. * Incompatible Lisp Changes in Emacs 28.1 +** 'set-process-buffer' now updates the process mark. +The mark will be set to point to the end of the new buffer. + ++++ +** Some properties from completion tables are now preserved. +If 'minibuffer-allow-text-properties' is non-nil, doing completion +over a table of strings with properties will no longer remove all the +properties before returning. This affects things like 'completing-read'. + ** 'equal' no longer examines some contents of window configurations. Instead, it considers window configurations to be equal only if they are 'eq'. To compare contents, use 'compare-window-configurations' @@ -1138,6 +1585,11 @@ This is no longer supported, and setting this variable has no effect. ** The macro 'with-displayed-buffer-window' is now obsolete. Use macro 'with-current-buffer-window' with action alist entry 'body-function'. ++++ +** 'byte-compile-file' optional argument LOAD is now obsolete. +To load the file after byte-compiling, add a call to 'load' from Lisp +or use 'M-x emacs-lisp-byte-compile-and-load' interactively. + ** The metamail.el library is now marked obsolete. --- @@ -1163,8 +1615,8 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'completion-base-size', 'completion-common-substring', 'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit', 'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook', -'detect-coding-with-priority', 'dirtrack-debug', -'dirtrack-debug-toggle', 'dynamic-completion-table', +'define-mode-overload-implementation', 'detect-coding-with-priority', +'dirtrack-debug', 'dirtrack-debug-toggle', 'dynamic-completion-table', 'easy-menu-precalculate-equivalent-keybindings', 'epa-display-verify-result', 'epg-passphrase-callback-function', 'eshell-report-bug', 'eval-next-after-load', 'exchange-dot-and-mark', @@ -1184,17 +1636,88 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'pre-abbrev-expand-hook', 'princ-list', 'print-help-return-message', 'process-filter-multibyte-p', 'read-file-name-predicate', 'remember-buffer', 'rmail-highlight-face', 'rmail-message-filter', +'semantic-after-idle-scheduler-reparse-hooks', +'semantic-after-toplevel-bovinate-hook', +'semantic-before-idle-scheduler-reparse-hooks', +'semantic-before-toplevel-bovination-hook', +'semantic-bovinate-from-nonterminal-full', +'semantic-bovinate-region-until-error', 'semantic-bovinate-toplevel', +'semantic-bovination-working-type', +'semantic-decorate-pending-decoration-hooks', +'semantic-edits-incremental-reparse-failed-hooks', +'semantic-eldoc-current-symbol-info', 'semantic-expand-nonterminal', +'semantic-file-token-stream', 'semantic-find-dependency', +'semantic-find-nonterminal', 'semantic-flex', 'semantic-flex-buffer', +'semantic-flex-keyword-get', 'semantic-flex-keyword-p', +'semantic-flex-keyword-put', 'semantic-flex-keywords', +'semantic-flex-list', 'semantic-flex-make-keyword-table', +'semantic-flex-map-keywords', 'semantic-flex-token-end', +'semantic-flex-token-start', 'semantic-flex-token-text', +'semantic-imenu-bucketize-type-parts', +'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token', +'semantic-init-db-hooks', 'semantic-init-hooks', +'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal', +'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name', +'semantic-nonterminal-leaf', 'semantic-nonterminal-protection', +'semantic-something-to-stream', 'semantic-tag-make-assoc-list', +'semantic-token-type-parent', 'semantic-toplevel-bovine-cache', +'semantic-toplevel-bovine-table', 'semanticdb-mode-hooks', 'set-coding-priority', 'set-process-filter-multibyte', 'shadows-compare-text-p', 'shell-dirtrack-toggle', 't-mouse-mode', 'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell', 'url-generate-unique-filename', 'url-temporary-directory', 'vc-arch-command', 'vc-default-working-revision' (variable), 'vc-mtn-command', 'vc-revert-buffer', 'vc-workfile-version', -'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font'. +'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font', +'wisent-lex-make-token-table'. * Lisp Changes in Emacs 28.1 +** New variable 'integer-output-format' determines how to print integer values. +When this variable is bound to the value 't', integers are printed by +printing functions as characters when an integer represents a character. +When bound to the number 16, non-negative integers are printed in the +hexadecimal format. + ++++ +** 'define-globalized-minor-mode' now takes a ':predicate' parameter. +This can be used to control which major modes the minor mode should be +used in. + ++++ +** 'truncate-string-ellipsis' now uses '…' by default. +Modes that use 'truncate-string-to-width' with non-nil, non-string +argument 'ellipsis', will now indicate truncation using '…' when +the selected frame can display it, and using "..." otherwise. + ++++ +*** New command 'make-directory-autoloads'. +This does the same as the old command 'update-directory-autoloads', +but has different semantics: Instead of passing in the output file via +the dynamically bound 'generated-autoload-file' variable, the output +file is now a explicit parameter. + ++++ +*** New function 'string-search'. +This function takes two string parameters and returns the position of +the first instance of the former string in the latter. + ++++ +*** New function 'string-replace'. +This function works along the line of 'replace-regexp-in-string', but +matching on strings instead of regexps, and does not change the global +match state. + ++++ +*** New function 'process-lines-ignore-status'. +This is like 'process-lines', but does not signal an error if the +return status is non-zero. 'process-lines-handling-status' has also +been added, and takes a callback to handle the return status. + +--- +*** 'ascii' is now a coding system alias for 'us-ascii'. + +++ *** New function 'file-backup-file-names'. This function returns the list of file names of all the backup files @@ -1224,19 +1747,29 @@ file mode specification into symbolic form. ** The variable 'force-new-style-backquotes' has been removed. This removes the final remaining trace of old-style backquotes. -** The module header 'emacs-module.h' now contains type aliases +** Changes in handling dynamic modules + +*** The module header 'emacs-module.h' now contains type aliases 'emacs_function' and 'emacs_finalizer' for module functions and finalizers, respectively. -** Module functions can now install an optional finalizer that is +*** Module functions can now be made interactive. +Use 'make_interactive' to give a module function an interactive +specification. + +*** Module functions can now install an optional finalizer that is called when the function object is garbage-collected. Use 'set_function_finalizer' to set the finalizer and 'get_function_finalizer' to retrieve it. -** Modules can now open a channel to an existing pipe process using +*** Modules can now open a channel to an existing pipe process using the new module function 'open_channel'. Modules can use this functionality to asynchronously send data back to Emacs. +*** A new module API 'make_unibyte_string' is provided. +It can be used to create Lisp strings with arbitrary byte sequences +(a.k.a. "raw bytes"). + ** 'file-modes', 'set-file-modes', and 'set-file-times' now have an optional argument specifying whether to follow symbolic links. @@ -1296,6 +1829,37 @@ truncating precision field, such as "%.2a". This can be used to parse RGB color specs in several formats and convert them to a list '(R G B)' of primary color values. +--- +** User option 'uniquify-buffer-name-style' can now be a function. +This user option can be one of the predefined styles or a function to +personalize the uniquified buffer name. + ++++ +** New variable 'tty-menu-calls-mouse-position-function'. +This controls whether 'mouse-position-function' is called by functions +that retrieve the mouse position when that happens during TTY menu +handling. Lisp programs that set 'mouse-position-function' should +also set this variable non-nil if they are compatible with the tty +menu handling. + ++++ +** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'. + ++++ +** New byte-compiler check for missing dynamic variable declarations. +It is meant as an (experimental) aid for converting Emacs Lisp code +to lexical binding, where dynamic (special) variables bound in one +file can affect code in another. For details, see the manual section +"(Elisp) Converting to Lexical Binding". + +--- +** 'unload-feature' now also tries to undo additions to buffer-local hooks. + +--- +** Some functions are no longer considered safe by 'unsafep': +'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal' +and 'play-sound-file'. + * Changes in Emacs 28.1 on Non-Free Operating Systems @@ -1337,6 +1901,9 @@ To turn this on, set the variable 'w32-use-native-image-API' to a non-nil value. Please report any bugs you find while using the native image API via 'M-x report-emacs-bug'. +--- +** The user option 'make-pointer-invisible' is now honored on macOS. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17 index 8ca61a0a3bb..c4ff83bb706 100644 --- a/etc/NEWS.1-17 +++ b/etc/NEWS.1-17 @@ -1944,7 +1944,7 @@ It's Beat CCA Week. described by dot and mark, at its corners; the existing text is pushed to the right. clear-rectangle: - replace the rectangle described by dot ane mark + replace the rectangle described by dot and mark with blanks. The previous text is deleted. delete-rectangle: delete the text of the specified rectangle, diff --git a/etc/NEWS.27 b/etc/NEWS.27 index 5ef54309893..f0b5dd088af 100644 --- a/etc/NEWS.27 +++ b/etc/NEWS.27 @@ -22,6 +22,47 @@ When you add a new item, use the appropriate mark if you are sure it applies, and please also update docstrings as needed. +* Installation Changes in Emacs 27.2 + + +* Startup Changes in Emacs 27.2 + + +* Changes in Emacs 27.2 + +This is a bug-fix release with no new features. + + +* Lisp Changes in Emacs 27.2 + +*** The behavior of the user option 'resize-mini-frames' has changed. +If set to non-nil, resize the mini frame using the new function +'fit-mini-frame-to-buffer' which won't skip leading or trailing empty +lines of the buffer. + + +* Editing Changes in Emacs 27.2 + + +* Changes in Specialized Modes and Packages in Emacs 27.2 + +** Tramp + +*** The user option 'tramp-completion-reread-directory-timeout' is made obsolete. + + +* New Modes and Packages in Emacs 27.2 + + +* Incompatible Lisp Changes in Emacs 27.2 + + +* Lisp Changes in Emacs 27.2 + + +* Changes in Emacs 27.2 on Non-Free Operating Systems + + * Installation Changes in Emacs 27.1 ** Emacs now uses GMP, the GNU Multiple Precision library. @@ -202,7 +243,7 @@ it won't work right without some adjustment: Units that are ordered after 'emacs.service' will only be started after Emacs has finished initialization and is ready for use, and Emacs needs to be built with systemd support. (If your Emacs is -installed in a non-standard location and you copied the emacs.service +installed in a non-standard location and you copied the "emacs.service" file to e.g. "~/.config/systemd/user/", you will need to copy the new version of the file again.) @@ -622,7 +663,7 @@ same as the 'C-x C-+' and 'C-x C--' commands. This new command (which inserts an <a id="foo">_</a> skeleton) is bound to 'C-c C-c #'. -** New command 'font-lock-refontify'. +** New command 'font-lock-debug-fontify'. This is an interactive convenience function to be used when developing font locking for a mode. It recomputes the font locking data and then re-fontifies the buffer. @@ -1101,7 +1142,7 @@ prefer to rely upon existing Emacs facilities for formatting code but the 'sql-indent' package provides facilities to aid more casual SQL developers layout queries and complex expressions. -**** 'sql-use-indent-support' (default t) enables SQL indention support. +**** 'sql-use-indent-support' (default t) enables SQL indentation support. The 'sql-indent' package from ELPA must be installed to get the indentation support in 'sql-mode' and 'sql-interactive-mode'. diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP index 77a1752a4a4..5ac3b6b1741 100644 --- a/etc/NEXTSTEP +++ b/etc/NEXTSTEP @@ -27,7 +27,7 @@ the absence of any other determinant, we are using the term created these APIs, and because all of the classes and functions still begin with the letters "NS". -(See http://en.wikipedia.org/wiki/Nextstep) +(See https://en.wikipedia.org/wiki/Nextstep) This Emacs port was first released in the early 1990's on the NeXT computer, and was successively updated to OpenStep, Rhapsody, Mac OS diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 67537f6e33b..8ed92ab75e0 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -181,6 +181,10 @@ Configure checks for the correct version, but this problem could occur if a binary built against a shared libungif is run on a system with an older version. +** SVG images may be cropped incorrectly with librsvg 2.45 and below. +Librsvg 2.46 and above have improved geometry code which Emacs is able +to take advantage of. + ** Emacs aborts inside the function 'tparam1'. This can happen if Emacs was built without terminfo support, but the @@ -786,7 +790,7 @@ build emacs with Cairo enabled ("configure --with-cairo" and have the appropriate Cairo development packages installed) as this configuration does not suffer from this problem. See <https://github.com/googlefonts/Inconsolata/issues/42> and -<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-01/msg00456.html> +<https://lists.gnu.org/r/bug-gnu-emacs/2020-01/msg00456.html> for more discussion. ** Under X, an unexpected monospace font is used as the default font. @@ -967,6 +971,19 @@ index 5504171..431adf8 100644 If you can't modify that file directly, copy it to the directory ~/.m17n.d/ (create it if it doesn't exist), and apply the patch. +** On MS-Windows, some characters display as boxes with hex code. + +Also, some characters could display with wrong fonts. + +This can happen if Emacs was compiled without HarfBuzz support, and/or +if the HarfBuzz DLLs are not available at run time. Emacs will then +fall back to the Uniscribe as its shaping engine; Uniscribe was +deprecated by Microsoft, and sometimes fails to display correctly when +modern fonts are used, such as Noto Emoji or Ebrima. + +The solution is to switch to a configuration that uses HarfBuzz as its +shaping engine, where these problems don't exist. + * Internationalization problems ** M-{ does not work on a Spanish PC keyboard. @@ -402,7 +402,7 @@ built-in. See the discussion of bug#39799 for more details about this task. Another relevant resource is the Unicode Technical Standard #51 -"Unicode Emoji" (http://www.unicode.org/reports/tr51/). +"Unicode Emoji" (https://www.unicode.org/reports/tr51/). ** Extend text-properties and overlays @@ -497,7 +497,7 @@ https://savannah.nongnu.org/projects/emacs-rtf/, which is still in very early stages. Another place to look is the Wikipedia article at -http://en.wikipedia.org/wiki/Rich_Text_Format. It currently points to +https://en.wikipedia.org/wiki/Rich_Text_Format. It currently points to the latest spec of RTF v1.9.1 at https://web.archive.org/web/20190708132914/http://www.kleinlercher.at/tools/Windows_Protocols/Word2007RTFSpec9.pdf @@ -525,7 +525,7 @@ Save backtraces when errors happen during specified filters, specified timers, and specified hooks. ** Install mmc@maruska.dyndns.org's no-flicker change -https://lists.gnu.org/archive/html/emacs-devel/2005-12/msg00699.html +https://lists.gnu.org/r/emacs-devel/2005-12/msg00699.html I don't know if this is still relevant. I can't reach the URLs in the above message thread and double-buffering may have solved some @@ -849,7 +849,7 @@ designed to be compatible with multiple Emacs ports. (See the scratch/nsxwidget branch, and the discussion around Objective-C code and GCC at -https://lists.gnu.org/archive/html/emacs-devel/2019-08/msg00072.html) +https://lists.gnu.org/r/emacs-devel/2019-08/msg00072.html ) **** Respect 'frame-inhibit-implied-resize' When the variable 'frame-inhibit-implied-resize' is non-nil, frames @@ -924,17 +924,14 @@ features of that interface could be implemented NS. **** Smooth scrolling -- maybe not a good idea Today, by default, scrolling with a trackpad makes the text move in -steps of five lines. (Scrolling with SHIFT scrolls one line at a time.) +steps of one line. (Scrolling with SHIFT scrolls horizontally.) The "mac" port provides smooth, pixel-based, scrolling. This is a very -popular features. However, there are drawbacks to this method: what +popular feature. However, there are drawbacks to this method: what happens if only a fraction of a line is visible at the top of a window, is the partially visible text considered part of the window or not? (Technically, what should 'window-start' return.) -An alternative would be to make one-line scrolling the default on NS -(or in Emacs in general). - Note: This feature might not be allowed to be implemented until also implemented in Emacs for a free system. diff --git a/etc/compilation.txt b/etc/compilation.txt index 11aefc6bc6f..7e406389d44 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -153,7 +153,7 @@ Failing Scenarios: cucumber foo/cucumber.feature:6 # Scenario: assertion false (Test::Unit) cucumber foo/cucumber.feature:9 # Scenario: assertion false (RSpec) cucumber foo/cucumber.feature:12 # Scenario: backtrace in step definition -cucumber foo/cucumber.feature:15 # Scenario: deeep backtrace in step definition +cucumber foo/cucumber.feature:15 # Scenario: deep backtrace in step definition 5 scenarios (4 failed, 1 undefined) 5 steps (4 failed, 1 undefined) @@ -536,6 +536,14 @@ cc-1070 cc: WARNING File = linkl.c, Line = 38 cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3 +* ShellCheck + +In autogen.sh line 38: +autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.ac` +^----------^ SC2034: autoconf_min appears unused. Verify use (or export if used externally). + ^-- SC2006: Use $(...) notation instead of legacy backticked `...`. + + * Sun Ada (VADS, Solaris) symbol: sun-ada diff --git a/etc/emacs.service b/etc/emacs.service index 0dc2418269e..c99c6779f58 100644 --- a/etc/emacs.service +++ b/etc/emacs.service @@ -8,7 +8,7 @@ Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/ [Service] Type=notify -ExecStart=@emacs emacsd --fg-daemon +ExecStart=emacs --fg-daemon ExecStop=emacsclient --eval "(kill-emacs)" # The location of the SSH auth socket varies by distribution, and some # set it from PAM, so don't override by default. diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index ee0269c3a28..bcde6728b5c 100644 --- a/etc/publicsuffix.txt +++ b/etc/publicsuffix.txt @@ -1,10 +1,15 @@ // This Source Code Form is subject to the terms of the Mozilla Public // License, v. 2.0. If a copy of the MPL was not distributed with this -// file, You can obtain one at http://mozilla.org/MPL/2.0/. +// file, You can obtain one at https://mozilla.org/MPL/2.0/. + +// Please pull this list from, and only from https://publicsuffix.org/list/public_suffix_list.dat, +// rather than any other VCS sites. Pulling from any other URL is not guaranteed to be supported. + +// Instructions on pulling and using this list can be found at https://publicsuffix.org/list/. // ===BEGIN ICANN DOMAINS=== -// ac : http://en.wikipedia.org/wiki/.ac +// ac : https://en.wikipedia.org/wiki/.ac ac com.ac edu.ac @@ -13,11 +18,11 @@ net.ac mil.ac org.ac -// ad : http://en.wikipedia.org/wiki/.ad +// ad : https://en.wikipedia.org/wiki/.ad ad nom.ad -// ae : http://en.wikipedia.org/wiki/.ae +// ae : https://en.wikipedia.org/wiki/.ae // see also: "Domain Name Eligibility Policy" at http://www.aeda.ae/eng/aepolicy.php ae co.ae @@ -28,7 +33,7 @@ ac.ae gov.ae mil.ae -// aero : see http://www.information.aero/index.php?id=66 +// aero : see https://www.information.aero/index.php?id=66 aero accident-investigation.aero accident-prevention.aero @@ -74,7 +79,6 @@ exchange.aero express.aero federation.aero flight.aero -freight.aero fuel.aero gliding.aero government.aero @@ -150,10 +154,15 @@ mil.al net.al org.al -// am : http://en.wikipedia.org/wiki/.am +// am : https://www.amnic.net/policy/en/Policy_EN.pdf am +co.am +com.am +commune.am +net.am +org.am -// ao : http://en.wikipedia.org/wiki/.ao +// ao : https://en.wikipedia.org/wiki/.ao // http://www.dns.ao/REGISTR.DOC ao ed.ao @@ -163,10 +172,10 @@ co.ao pb.ao it.ao -// aq : http://en.wikipedia.org/wiki/.aq +// aq : https://en.wikipedia.org/wiki/.aq aq -// ar : https://nic.ar/normativa-vigente.xhtml +// ar : https://nic.ar/nic-argentina/normativa-vigente ar com.ar edu.ar @@ -174,11 +183,12 @@ gob.ar gov.ar int.ar mil.ar +musica.ar net.ar org.ar tur.ar -// arpa : http://en.wikipedia.org/wiki/.arpa +// arpa : https://en.wikipedia.org/wiki/.arpa // Confirmed by registry <iana-questions@icann.org> 2008-06-18 arpa e164.arpa @@ -188,22 +198,23 @@ iris.arpa uri.arpa urn.arpa -// as : http://en.wikipedia.org/wiki/.as +// as : https://en.wikipedia.org/wiki/.as as gov.as -// asia : http://en.wikipedia.org/wiki/.asia +// asia : https://en.wikipedia.org/wiki/.asia asia -// at : http://en.wikipedia.org/wiki/.at +// at : https://en.wikipedia.org/wiki/.at // Confirmed by registry <it@nic.at> 2008-06-17 at ac.at co.at gv.at or.at +sth.ac.at -// au : http://en.wikipedia.org/wiki/.au +// au : https://en.wikipedia.org/wiki/.au // http://www.auda.org.au/ au // 2LDs @@ -229,6 +240,8 @@ vic.au wa.au // 3LDs act.edu.au +catholic.edu.au +// eq.edu.au - Removed at the request of the Queensland Department of Education nsw.edu.au nt.edu.au qld.edu.au @@ -244,15 +257,18 @@ sa.gov.au tas.gov.au vic.gov.au wa.gov.au +// 4LDs +// education.tas.edu.au - Removed at the request of the Department of Education Tasmania +schools.nsw.edu.au -// aw : http://en.wikipedia.org/wiki/.aw +// aw : https://en.wikipedia.org/wiki/.aw aw com.aw -// ax : http://en.wikipedia.org/wiki/.ax +// ax : https://en.wikipedia.org/wiki/.ax ax -// az : http://en.wikipedia.org/wiki/.az +// az : https://en.wikipedia.org/wiki/.az az com.az net.az @@ -267,20 +283,16 @@ name.az pro.az biz.az -// ba : http://en.wikipedia.org/wiki/.ba +// ba : http://nic.ba/users_data/files/pravilnik_o_registraciji.pdf ba -org.ba -net.ba +com.ba edu.ba gov.ba mil.ba -unsa.ba -unbi.ba -co.ba -com.ba -rs.ba +net.ba +org.ba -// bb : http://en.wikipedia.org/wiki/.bb +// bb : https://en.wikipedia.org/wiki/.bb bb biz.bb co.bb @@ -293,19 +305,19 @@ org.bb store.bb tv.bb -// bd : http://en.wikipedia.org/wiki/.bd +// bd : https://en.wikipedia.org/wiki/.bd *.bd -// be : http://en.wikipedia.org/wiki/.be +// be : https://en.wikipedia.org/wiki/.be // Confirmed by registry <tech@dns.be> 2008-06-08 be ac.be -// bf : http://en.wikipedia.org/wiki/.bf +// bf : https://en.wikipedia.org/wiki/.bf bf gov.bf -// bg : http://en.wikipedia.org/wiki/.bg +// bg : https://en.wikipedia.org/wiki/.bg // https://www.register.bg/user/static/rules/en/index.html bg a.bg @@ -345,7 +357,7 @@ z.bg 8.bg 9.bg -// bh : http://en.wikipedia.org/wiki/.bh +// bh : https://en.wikipedia.org/wiki/.bh bh com.bh edu.bh @@ -353,7 +365,7 @@ net.bh org.bh gov.bh -// bi : http://en.wikipedia.org/wiki/.bi +// bi : https://en.wikipedia.org/wiki/.bi // http://whois.nic.bi/ bi co.bi @@ -362,10 +374,10 @@ edu.bi or.bi org.bi -// biz : http://en.wikipedia.org/wiki/.biz +// biz : https://en.wikipedia.org/wiki/.biz biz -// bj : http://en.wikipedia.org/wiki/.bj +// bj : https://en.wikipedia.org/wiki/.bj bj asso.bj barreau.bj @@ -379,91 +391,228 @@ gov.bm net.bm org.bm -// bn : http://en.wikipedia.org/wiki/.bn -*.bn +// bn : http://www.bnnic.bn/faqs +bn +com.bn +edu.bn +gov.bn +net.bn +org.bn -// bo : http://www.nic.bo/ +// bo : https://nic.bo/delegacion2015.php#h-1.10 bo com.bo edu.bo -gov.bo gob.bo int.bo org.bo net.bo mil.bo tv.bo +web.bo +// Social Domains +academia.bo +agro.bo +arte.bo +blog.bo +bolivia.bo +ciencia.bo +cooperativa.bo +democracia.bo +deporte.bo +ecologia.bo +economia.bo +empresa.bo +indigena.bo +industria.bo +info.bo +medicina.bo +movimiento.bo +musica.bo +natural.bo +nombre.bo +noticias.bo +patria.bo +politica.bo +profesional.bo +plurinacional.bo +pueblo.bo +revista.bo +salud.bo +tecnologia.bo +tksat.bo +transporte.bo +wiki.bo // br : http://registro.br/dominio/categoria.html // Submitted by registry <fneves@registro.br> br +9guacu.br +abc.br adm.br adv.br agr.br +aju.br am.br +anani.br +aparecida.br +app.br arq.br art.br ato.br b.br +barueri.br +belem.br +bhz.br +bib.br bio.br blog.br bmd.br +boavista.br +bsb.br +campinagrande.br +campinas.br +caxias.br cim.br cng.br cnt.br com.br +contagem.br coop.br +coz.br +cri.br +cuiaba.br +curitiba.br +def.br +des.br +det.br +dev.br ecn.br eco.br edu.br emp.br +enf.br eng.br esp.br etc.br eti.br far.br +feira.br flog.br +floripa.br fm.br fnd.br +fortal.br fot.br +foz.br fst.br g12.br +geo.br ggf.br +goiania.br gov.br +// gov.br 26 states + df https://en.wikipedia.org/wiki/States_of_Brazil +ac.gov.br +al.gov.br +am.gov.br +ap.gov.br +ba.gov.br +ce.gov.br +df.gov.br +es.gov.br +go.gov.br +ma.gov.br +mg.gov.br +ms.gov.br +mt.gov.br +pa.gov.br +pb.gov.br +pe.gov.br +pi.gov.br +pr.gov.br +rj.gov.br +rn.gov.br +ro.gov.br +rr.gov.br +rs.gov.br +sc.gov.br +se.gov.br +sp.gov.br +to.gov.br +gru.br imb.br ind.br inf.br +jab.br +jampa.br +jdf.br +joinville.br jor.br jus.br leg.br lel.br +log.br +londrina.br +macapa.br +maceio.br +manaus.br +maringa.br mat.br med.br mil.br +morena.br mp.br mus.br +natal.br net.br +niteroi.br *.nom.br not.br ntr.br odo.br +ong.br org.br +osasco.br +palmas.br +poa.br ppg.br pro.br psc.br psi.br +pvh.br qsl.br radio.br rec.br +recife.br +rep.br +ribeirao.br +rio.br +riobranco.br +riopreto.br +salvador.br +sampa.br +santamaria.br +santoandre.br +saobernardo.br +saogonca.br +seg.br +sjc.br slg.br +slz.br +sorocaba.br srv.br taxi.br +tc.br +tec.br teo.br +the.br tmp.br trd.br tur.br tv.br +udi.br vet.br +vix.br vlog.br wiki.br zlg.br @@ -476,7 +625,7 @@ org.bs edu.bs gov.bs -// bt : http://en.wikipedia.org/wiki/.bt +// bt : https://en.wikipedia.org/wiki/.bt bt com.bt edu.bt @@ -488,14 +637,14 @@ org.bt // Submitted by registry <jarle@uninett.no> bv -// bw : http://en.wikipedia.org/wiki/.bw +// bw : https://en.wikipedia.org/wiki/.bw // http://www.gobin.info/domainname/bw.doc // list of other 2nd level tlds ? bw co.bw org.bw -// by : http://en.wikipedia.org/wiki/.by +// by : https://en.wikipedia.org/wiki/.by // http://tld.by/rules_2006_en.html // list of other 2nd level tlds ? by @@ -509,7 +658,7 @@ com.by // http://hoster.by/ of.by -// bz : http://en.wikipedia.org/wiki/.bz +// bz : https://en.wikipedia.org/wiki/.bz // http://www.belizenic.bz/ bz com.bz @@ -518,7 +667,7 @@ org.bz edu.bz gov.bz -// ca : http://en.wikipedia.org/wiki/.ca +// ca : https://en.wikipedia.org/wiki/.ca ca // ca geographical names ab.ca @@ -535,31 +684,31 @@ pe.ca qc.ca sk.ca yk.ca -// gc.ca: http://en.wikipedia.org/wiki/.gc.ca +// gc.ca: https://en.wikipedia.org/wiki/.gc.ca // see also: http://registry.gc.ca/en/SubdomainFAQ gc.ca -// cat : http://en.wikipedia.org/wiki/.cat +// cat : https://en.wikipedia.org/wiki/.cat cat -// cc : http://en.wikipedia.org/wiki/.cc +// cc : https://en.wikipedia.org/wiki/.cc cc -// cd : http://en.wikipedia.org/wiki/.cd +// cd : https://en.wikipedia.org/wiki/.cd // see also: https://www.nic.cd/domain/insertDomain_2.jsp?act=1 cd gov.cd -// cf : http://en.wikipedia.org/wiki/.cf +// cf : https://en.wikipedia.org/wiki/.cf cf -// cg : http://en.wikipedia.org/wiki/.cg +// cg : https://en.wikipedia.org/wiki/.cg cg -// ch : http://en.wikipedia.org/wiki/.ch +// ch : https://en.wikipedia.org/wiki/.ch ch -// ci : http://en.wikipedia.org/wiki/.ci +// ci : https://en.wikipedia.org/wiki/.ci // http://www.nic.ci/index.php?page=charte ci org.ci @@ -578,25 +727,27 @@ presse.ci md.ci gouv.ci -// ck : http://en.wikipedia.org/wiki/.ck +// ck : https://en.wikipedia.org/wiki/.ck *.ck !www.ck -// cl : http://en.wikipedia.org/wiki/.cl +// cl : https://www.nic.cl +// Confirmed by .CL registry <hsalgado@nic.cl> cl -gov.cl -gob.cl +aprendemas.cl co.cl +gob.cl +gov.cl mil.cl -// cm : http://en.wikipedia.org/wiki/.cm plus bug 981927 +// cm : https://en.wikipedia.org/wiki/.cm plus bug 981927 cm co.cm com.cm gov.cm net.cm -// cn : http://en.wikipedia.org/wiki/.cn +// cn : https://en.wikipedia.org/wiki/.cn // Submitted by registry <tanyaling@cnnic.cn> cn ac.cn @@ -645,7 +796,7 @@ hk.cn mo.cn tw.cn -// co : http://en.wikipedia.org/wiki/.co +// co : https://en.wikipedia.org/wiki/.co // Submitted by registry <tecnico@uniandes.edu.co> co arts.co @@ -662,10 +813,10 @@ org.co rec.co web.co -// com : http://en.wikipedia.org/wiki/.com +// com : https://en.wikipedia.org/wiki/.com com -// coop : http://en.wikipedia.org/wiki/.coop +// coop : https://en.wikipedia.org/wiki/.coop coop // cr : http://www.nic.cr/niccr_publico/showRegistroDominiosScreen.do @@ -678,7 +829,7 @@ go.cr or.cr sa.cr -// cu : http://en.wikipedia.org/wiki/.cu +// cu : https://en.wikipedia.org/wiki/.cu cu com.cu edu.cu @@ -687,7 +838,7 @@ net.cu gov.cu inf.cu -// cv : http://en.wikipedia.org/wiki/.cv +// cv : https://en.wikipedia.org/wiki/.cv cv // cw : http://www.una.cw/cw_registry/ @@ -698,12 +849,14 @@ edu.cw net.cw org.cw -// cx : http://en.wikipedia.org/wiki/.cx +// cx : https://en.wikipedia.org/wiki/.cx // list of other 2nd level tlds ? cx gov.cx -// cy : http://en.wikipedia.org/wiki/.cy +// cy : http://www.nic.cy/ +// Submitted by registry Panayiotou Fotia <cydns@ucy.ac.cy> +cy ac.cy biz.cy com.cy @@ -718,22 +871,22 @@ press.cy pro.cy tm.cy -// cz : http://en.wikipedia.org/wiki/.cz +// cz : https://en.wikipedia.org/wiki/.cz cz -// de : http://en.wikipedia.org/wiki/.de +// de : https://en.wikipedia.org/wiki/.de // Confirmed by registry <ops@denic.de> (with technical // reservations) 2008-07-01 de -// dj : http://en.wikipedia.org/wiki/.dj +// dj : https://en.wikipedia.org/wiki/.dj dj -// dk : http://en.wikipedia.org/wiki/.dk +// dk : https://en.wikipedia.org/wiki/.dk // Confirmed by registry <robert@dk-hostmaster.dk> 2008-06-17 dk -// dm : http://en.wikipedia.org/wiki/.dm +// dm : https://en.wikipedia.org/wiki/.dm dm com.dm net.dm @@ -741,7 +894,7 @@ org.dm edu.dm gov.dm -// do : http://en.wikipedia.org/wiki/.do +// do : https://en.wikipedia.org/wiki/.do do art.do com.do @@ -754,16 +907,18 @@ org.do sld.do web.do -// dz : http://en.wikipedia.org/wiki/.dz +// dz : http://www.nic.dz/images/pdf_nic/charte.pdf dz +art.dz +asso.dz com.dz +edu.dz +gov.dz org.dz net.dz -gov.dz -edu.dz -asso.dz pol.dz -art.dz +soc.dz +tm.dz // ec : http://www.nic.ec/reg/paso1.asp // Submitted by registry <vabboud@nic.ec> @@ -781,7 +936,7 @@ gov.ec gob.ec mil.ec -// edu : http://en.wikipedia.org/wiki/.edu +// edu : https://en.wikipedia.org/wiki/.edu edu // ee : http://www.eenet.ee/EENet/dom_reeglid.html#lisa_B @@ -797,7 +952,7 @@ aip.ee org.ee fie.ee -// eg : http://en.wikipedia.org/wiki/.eg +// eg : https://en.wikipedia.org/wiki/.eg eg com.eg edu.eg @@ -809,7 +964,7 @@ net.eg org.eg sci.eg -// er : http://en.wikipedia.org/wiki/.er +// er : https://en.wikipedia.org/wiki/.er *.er // es : https://www.nic.es/site_ingles/ingles/dominios/index.html @@ -820,7 +975,7 @@ org.es gob.es edu.es -// et : http://en.wikipedia.org/wiki/.et +// et : https://en.wikipedia.org/wiki/.et et com.et gov.et @@ -831,42 +986,56 @@ name.et info.et net.et -// eu : http://en.wikipedia.org/wiki/.eu +// eu : https://en.wikipedia.org/wiki/.eu eu -// fi : http://en.wikipedia.org/wiki/.fi +// fi : https://en.wikipedia.org/wiki/.fi fi -// aland.fi : http://en.wikipedia.org/wiki/.ax +// aland.fi : https://en.wikipedia.org/wiki/.ax // This domain is being phased out in favor of .ax. As there are still many // domains under aland.fi, we still keep it on the list until aland.fi is // completely removed. // TODO: Check for updates (expected to be phased out around Q1/2009) aland.fi -// fj : http://en.wikipedia.org/wiki/.fj -*.fj - -// fk : http://en.wikipedia.org/wiki/.fk +// fj : http://domains.fj/ +// Submitted by registry <garth.miller@cocca.org.nz> 2020-02-11 +fj +ac.fj +biz.fj +com.fj +gov.fj +info.fj +mil.fj +name.fj +net.fj +org.fj +pro.fj + +// fk : https://en.wikipedia.org/wiki/.fk *.fk -// fm : http://en.wikipedia.org/wiki/.fm +// fm : https://en.wikipedia.org/wiki/.fm +com.fm +edu.fm +net.fm +org.fm fm -// fo : http://en.wikipedia.org/wiki/.fo +// fo : https://en.wikipedia.org/wiki/.fo fo // fr : http://www.afnic.fr/ -// domaines descriptifs : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-descriptifs +// domaines descriptifs : https://www.afnic.fr/medias/documents/Cadre_legal/Afnic_Naming_Policy_12122016_VEN.pdf fr -com.fr asso.fr +com.fr +gouv.fr nom.fr prd.fr -presse.fr tm.fr -// domaines sectoriels : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-sectoriels +// domaines sectoriels : https://www.afnic.fr/en/products-and-services/the-fr-tld/sector-based-fr-domains-4.html aeroport.fr -assedic.fr avocat.fr avoues.fr cci.fr @@ -874,7 +1043,6 @@ chambagri.fr chirurgiens-dentistes.fr experts-comptables.fr geometre-expert.fr -gouv.fr greta.fr huissier-justice.fr medecin.fr @@ -883,14 +1051,16 @@ pharmacien.fr port.fr veterinaire.fr -// ga : http://en.wikipedia.org/wiki/.ga +// ga : https://en.wikipedia.org/wiki/.ga ga // gb : This registry is effectively dormant // Submitted by registry <Damien.Shaw@ja.net> gb -// gd : http://en.wikipedia.org/wiki/.gd +// gd : https://en.wikipedia.org/wiki/.gd +edu.gd +gov.gd gd // ge : http://www.nic.net.ge/policy_en.pdf @@ -903,7 +1073,7 @@ mil.ge net.ge pvt.ge -// gf : http://en.wikipedia.org/wiki/.gf +// gf : https://en.wikipedia.org/wiki/.gf gf // gg : http://www.channelisles.net/register-domains/ @@ -913,7 +1083,7 @@ co.gg net.gg org.gg -// gh : http://en.wikipedia.org/wiki/.gh +// gh : https://en.wikipedia.org/wiki/.gh // see also: http://www.nic.gh/reg_now.php // Although domains directly at second level are not possible at the moment, // they have been possible for some time and may come back. @@ -933,7 +1103,7 @@ mod.gi edu.gi org.gi -// gl : http://en.wikipedia.org/wiki/.gl +// gl : https://en.wikipedia.org/wiki/.gl // http://nic.gl gl co.gl @@ -955,7 +1125,7 @@ gov.gn org.gn net.gn -// gov : http://en.wikipedia.org/wiki/.gov +// gov : https://en.wikipedia.org/wiki/.gov gov // gp : http://www.nic.gp/index.php?lang=en @@ -967,7 +1137,7 @@ edu.gp org.gp asso.gp -// gq : http://en.wikipedia.org/wiki/.gq +// gq : https://en.wikipedia.org/wiki/.gq gq // gr : https://grweb.ics.forth.gr/english/1617-B-2005.html @@ -979,7 +1149,7 @@ net.gr org.gr gov.gr -// gs : http://en.wikipedia.org/wiki/.gs +// gs : https://en.wikipedia.org/wiki/.gs gs // gt : http://www.gt/politicas_de_registro.html @@ -992,13 +1162,23 @@ mil.gt net.gt org.gt -// gu : http://gadao.gov.gu/registration.txt -*.gu - -// gw : http://en.wikipedia.org/wiki/.gw +// gu : http://gadao.gov.gu/register.html +// University of Guam : https://www.uog.edu +// Submitted by uognoc@triton.uog.edu +gu +com.gu +edu.gu +gov.gu +guam.gu +info.gu +net.gu +org.gu +web.gu + +// gw : https://en.wikipedia.org/wiki/.gw gw -// gy : http://en.wikipedia.org/wiki/.gy +// gy : https://en.wikipedia.org/wiki/.gy // http://registry.gy/ gy co.gy @@ -1008,7 +1188,7 @@ gov.gy net.gy org.gy -// hk : https://www.hkdnr.hk +// hk : https://www.hkirc.hk // Submitted by registry <hk.tech@hkirc.hk> hk com.hk @@ -1033,7 +1213,7 @@ org.hk 組織.hk 組织.hk -// hm : http://en.wikipedia.org/wiki/.hm +// hm : https://en.wikipedia.org/wiki/.hm hm // hn : http://www.nic.hn/politicas/ps02,,05.html @@ -1107,7 +1287,7 @@ tozsde.hu utazas.hu video.hu -// id : https://register.pandi.or.id/ +// id : https://pandi.id/en/domain/registration-requirements/ id ac.id biz.id @@ -1118,10 +1298,11 @@ mil.id my.id net.id or.id +ponpes.id sch.id web.id -// ie : http://en.wikipedia.org/wiki/.ie +// ie : https://en.wikipedia.org/wiki/.ie ie gov.ie @@ -1149,7 +1330,7 @@ plc.co.im tt.im tv.im -// in : http://en.wikipedia.org/wiki/.in +// in : https://en.wikipedia.org/wiki/.in // see also: https://registry.in/Policies // Please note, that nic.in is not an official eTLD, but used by most // government institutions. @@ -1167,10 +1348,10 @@ res.in gov.in mil.in -// info : http://en.wikipedia.org/wiki/.info +// info : https://en.wikipedia.org/wiki/.info info -// int : http://en.wikipedia.org/wiki/.int +// int : https://en.wikipedia.org/wiki/.int // Confirmed by registry <iana-questions@icann.org> 2008-06-18 int eu.int @@ -1215,14 +1396,12 @@ gov.is org.is int.is -// it : http://en.wikipedia.org/wiki/.it +// it : https://en.wikipedia.org/wiki/.it it gov.it edu.it -// Reserved geo-names: -// http://www.nic.it/documenti/regolamenti-e-linee-guida/regolamento-assegnazione-versione-6.0.pdf -// There is also a list of reserved geo-names corresponding to Italian municipalities -// http://www.nic.it/documenti/appendice-c.pdf, but it is not included here. +// Reserved geo-names (regions and provinces): +// https://www.nic.it/sites/default/files/archivio/docs/Regulation_assignation_v7.1.pdf // Regions abr.it abruzzo.it @@ -1276,6 +1455,12 @@ sicily.it taa.it tos.it toscana.it +trentin-sud-tirol.it +trentin-süd-tirol.it +trentin-sudtirol.it +trentin-südtirol.it +trentin-sued-tirol.it +trentin-suedtirol.it trentino-a-adige.it trentino-aadige.it trentino-alto-adige.it @@ -1283,9 +1468,12 @@ trentino-altoadige.it trentino-s-tirol.it trentino-stirol.it trentino-sud-tirol.it +trentino-süd-tirol.it trentino-sudtirol.it +trentino-südtirol.it trentino-sued-tirol.it trentino-suedtirol.it +trentino.it trentinoa-adige.it trentinoaadige.it trentinoalto-adige.it @@ -1293,9 +1481,17 @@ trentinoaltoadige.it trentinos-tirol.it trentinostirol.it trentinosud-tirol.it +trentinosüd-tirol.it trentinosudtirol.it +trentinosüdtirol.it trentinosued-tirol.it trentinosuedtirol.it +trentinsud-tirol.it +trentinsüd-tirol.it +trentinsudtirol.it +trentinsüdtirol.it +trentinsued-tirol.it +trentinsuedtirol.it tuscany.it umb.it umbria.it @@ -1310,7 +1506,13 @@ valleaosta.it valled-aosta.it valledaosta.it vallee-aoste.it +vallée-aoste.it +vallee-d-aoste.it +vallée-d-aoste.it valleeaoste.it +valléeaoste.it +valleedaoste.it +valléedaoste.it vao.it vda.it ven.it @@ -1343,6 +1545,9 @@ at.it av.it avellino.it ba.it +balsan-sudtirol.it +balsan-südtirol.it +balsan-suedtirol.it balsan.it bari.it barletta-trani-andria.it @@ -1357,13 +1562,21 @@ bl.it bn.it bo.it bologna.it +bolzano-altoadige.it bolzano.it +bozen-sudtirol.it +bozen-südtirol.it +bozen-suedtirol.it bozen.it br.it brescia.it brindisi.it bs.it bt.it +bulsan-sudtirol.it +bulsan-südtirol.it +bulsan-suedtirol.it +bulsan.it bz.it ca.it cagliari.it @@ -1381,7 +1594,9 @@ catanzaro.it cb.it ce.it cesena-forli.it +cesena-forlì.it cesenaforli.it +cesenaforlì.it ch.it chieti.it ci.it @@ -1412,7 +1627,9 @@ florence.it fm.it foggia.it forli-cesena.it +forlì-cesena.it forlicesena.it +forlìcesena.it fr.it frosinone.it ge.it @@ -1543,6 +1760,7 @@ sp.it sr.it ss.it suedtirol.it +südtirol.it sv.it ta.it taranto.it @@ -1561,7 +1779,6 @@ trani-barletta-andria.it traniandriabarletta.it tranibarlettaandria.it trapani.it -trentino.it trento.it treviso.it trieste.it @@ -1613,10 +1830,10 @@ gov.jo mil.jo name.jo -// jobs : http://en.wikipedia.org/wiki/.jobs +// jobs : https://en.wikipedia.org/wiki/.jobs jobs -// jp : http://en.wikipedia.org/wiki/.jp +// jp : https://en.wikipedia.org/wiki/.jp // http://jprs.co.jp/en/jpdomain.html // Submitted by registry <info@jprs.jp> jp @@ -2545,11 +2762,8 @@ arao.kumamoto.jp aso.kumamoto.jp choyo.kumamoto.jp gyokuto.kumamoto.jp -hitoyoshi.kumamoto.jp kamiamakusa.kumamoto.jp -kashima.kumamoto.jp kikuchi.kumamoto.jp -kosa.kumamoto.jp kumamoto.kumamoto.jp mashiki.kumamoto.jp mifune.kumamoto.jp @@ -2634,7 +2848,6 @@ iwanuma.miyagi.jp kakuda.miyagi.jp kami.miyagi.jp kawasaki.miyagi.jp -kesennuma.miyagi.jp marumori.miyagi.jp matsushima.miyagi.jp minamisanriku.miyagi.jp @@ -3420,8 +3633,17 @@ uenohara.yamanashi.jp yamanakako.yamanashi.jp yamanashi.yamanashi.jp -// ke : http://www.kenic.or.ke/index.php?option=com_content&task=view&id=117&Itemid=145 -*.ke +// ke : http://www.kenic.or.ke/index.php/en/ke-domains/ke-domains +ke +ac.ke +co.ke +go.ke +info.ke +me.ke +mobi.ke +ne.ke +or.ke +sc.ke // kg : http://www.domain.kg/dmn_n.html kg @@ -3445,7 +3667,7 @@ gov.ki info.ki com.ki -// km : http://en.wikipedia.org/wiki/.km +// km : https://en.wikipedia.org/wiki/.km // http://www.domaine.km/documents/charte.doc km org.km @@ -3458,7 +3680,7 @@ mil.km ass.km com.km // These are only mentioned as proposed suggestions at domaine.km, but -// http://en.wikipedia.org/wiki/.km says they're available for registration: +// https://en.wikipedia.org/wiki/.km says they're available for registration: coop.km asso.km presse.km @@ -3468,7 +3690,7 @@ pharmaciens.km veterinaire.km gouv.km -// kn : http://en.wikipedia.org/wiki/.kn +// kn : https://en.wikipedia.org/wiki/.kn // http://www.dot.kn/domainRules.html kn net.kn @@ -3485,7 +3707,7 @@ org.kp rep.kp tra.kp -// kr : http://en.wikipedia.org/wiki/.kr +// kr : https://en.wikipedia.org/wiki/.kr // see also: http://domain.nida.or.kr/eng/registration.jsp kr ac.kr @@ -3519,8 +3741,16 @@ jeonnam.kr seoul.kr ulsan.kr -// kw : http://en.wikipedia.org/wiki/.kw -*.kw +// kw : https://www.nic.kw/policies/ +// Confirmed by registry <nic.tech@citra.gov.kw> +kw +com.kw +edu.kw +emb.kw +gov.kw +ind.kw +net.kw +org.kw // ky : http://www.icta.ky/da_ky_reg_dom.php // Confirmed by registry <kysupport@perimeterusa.com> 2008-06-17 @@ -3531,7 +3761,7 @@ com.ky org.ky net.ky -// kz : http://en.wikipedia.org/wiki/.kz +// kz : https://en.wikipedia.org/wiki/.kz // see also: http://www.nic.kz/rules/index.jsp kz org.kz @@ -3541,7 +3771,7 @@ gov.kz mil.kz com.kz -// la : http://en.wikipedia.org/wiki/.la +// la : https://en.wikipedia.org/wiki/.la // Submitted by registry <gavin.brown@nic.la> la int.la @@ -3553,7 +3783,7 @@ per.la com.la org.la -// lb : http://en.wikipedia.org/wiki/.lb +// lb : https://en.wikipedia.org/wiki/.lb // Submitted by registry <randy@psg.com> lb com.lb @@ -3562,7 +3792,7 @@ gov.lb net.lb org.lb -// lc : http://en.wikipedia.org/wiki/.lc +// lc : https://en.wikipedia.org/wiki/.lc // see also: http://www.nic.lc/rules.htm lc com.lc @@ -3572,10 +3802,10 @@ org.lc edu.lc gov.lc -// li : http://en.wikipedia.org/wiki/.li +// li : https://en.wikipedia.org/wiki/.li li -// lk : http://www.nic.lk/seclevpr.html +// lk : https://www.nic.lk/index.php/domain-registration/lk-domain-naming-structure lk gov.lk sch.lk @@ -3602,12 +3832,20 @@ gov.lr org.lr net.lr -// ls : http://en.wikipedia.org/wiki/.ls +// ls : http://www.nic.ls/ +// Confirmed by registry <lsadmin@nic.ls> ls +ac.ls +biz.ls co.ls +edu.ls +gov.ls +info.ls +net.ls org.ls +sc.ls -// lt : http://en.wikipedia.org/wiki/.lt +// lt : https://en.wikipedia.org/wiki/.lt lt // gov.lt : http://www.gov.lt/index_en.php gov.lt @@ -3639,7 +3877,7 @@ med.ly org.ly id.ly -// ma : http://en.wikipedia.org/wiki/.ma +// ma : https://en.wikipedia.org/wiki/.ma // http://www.anrt.ma/fr/admin/download/upload/file_fr782.pdf ma co.ma @@ -3654,10 +3892,10 @@ mc tm.mc asso.mc -// md : http://en.wikipedia.org/wiki/.md +// md : https://en.wikipedia.org/wiki/.md md -// me : http://en.wikipedia.org/wiki/.me +// me : https://en.wikipedia.org/wiki/.me me co.me net.me @@ -3680,13 +3918,13 @@ mil.mg com.mg co.mg -// mh : http://en.wikipedia.org/wiki/.mh +// mh : https://en.wikipedia.org/wiki/.mh mh -// mil : http://en.wikipedia.org/wiki/.mil +// mil : https://en.wikipedia.org/wiki/.mil mil -// mk : http://en.wikipedia.org/wiki/.mk +// mk : https://en.wikipedia.org/wiki/.mk // see also: http://dns.marnet.net.mk/postapka.php mk com.mk @@ -3698,7 +3936,7 @@ inf.mk name.mk // ml : http://www.gobin.info/domainname/ml-template.doc -// see also: http://en.wikipedia.org/wiki/.ml +// see also: https://en.wikipedia.org/wiki/.ml ml com.ml edu.ml @@ -3708,10 +3946,10 @@ net.ml org.ml presse.ml -// mm : http://en.wikipedia.org/wiki/.mm +// mm : https://en.wikipedia.org/wiki/.mm *.mm -// mn : http://en.wikipedia.org/wiki/.mn +// mn : https://en.wikipedia.org/wiki/.mn mn gov.mn edu.mn @@ -3725,17 +3963,17 @@ org.mo edu.mo gov.mo -// mobi : http://en.wikipedia.org/wiki/.mobi +// mobi : https://en.wikipedia.org/wiki/.mobi mobi // mp : http://www.dot.mp/ // Confirmed by registry <dcamacho@saipan.com> 2008-06-17 mp -// mq : http://en.wikipedia.org/wiki/.mq +// mq : https://en.wikipedia.org/wiki/.mq mq -// mr : http://en.wikipedia.org/wiki/.mr +// mr : https://en.wikipedia.org/wiki/.mr mr gov.mr @@ -3755,7 +3993,7 @@ edu.mt net.mt org.mt -// mu : http://en.wikipedia.org/wiki/.mu +// mu : https://en.wikipedia.org/wiki/.mu mu com.mu net.mu @@ -4134,8 +4372,6 @@ niepce.museum norfolk.museum north.museum nrw.museum -nuernberg.museum -nuremberg.museum nyc.museum nyny.museum oceanographic.museum @@ -4317,7 +4553,7 @@ zoology.museum ירושלים.museum иком.museum -// mv : http://en.wikipedia.org/wiki/.mv +// mv : https://en.wikipedia.org/wiki/.mv // "mv" included because, contra Wikipedia, google.mv exists. mv aero.mv @@ -4368,9 +4604,17 @@ edu.my mil.my name.my -// mz : http://www.gobin.info/domainname/mz-template.doc -*.mz -!teledata.mz +// mz : http://www.uem.mz/ +// Submitted by registry <antonio@uem.mz> +mz +ac.mz +adv.mz +co.mz +edu.mz +gov.mz +mil.mz +net.mz +org.mz // na : http://www.na-nic.com.na/ // http://www.info.na/domain/ @@ -4399,14 +4643,15 @@ name // nc : http://www.cctld.nc/ nc asso.nc +nom.nc -// ne : http://en.wikipedia.org/wiki/.ne +// ne : https://en.wikipedia.org/wiki/.ne ne -// net : http://en.wikipedia.org/wiki/.net +// net : https://en.wikipedia.org/wiki/.net net -// nf : http://en.wikipedia.org/wiki/.nf +// nf : https://en.wikipedia.org/wiki/.nf nf com.nf net.nf @@ -4433,36 +4678,33 @@ org.ng sch.ng // ni : http://www.nic.ni/ +ni +ac.ni +biz.ni +co.ni com.ni -gob.ni edu.ni -org.ni -nom.ni -net.ni -mil.ni -co.ni -biz.ni -web.ni -int.ni -ac.ni +gob.ni in.ni info.ni +int.ni +mil.ni +net.ni +nom.ni +org.ni +web.ni -// nl : http://en.wikipedia.org/wiki/.nl +// nl : https://en.wikipedia.org/wiki/.nl // https://www.sidn.nl/ // ccTLD for the Netherlands nl -// BV.nl will be a registry for dutch BV's (besloten vennootschap) -bv.nl - -// no : http://www.norid.no/regelverk/index.en.html -// The Norwegian registry has declined to notify us of updates. The web pages -// referenced below are the official source of the data. There is also an -// announce mailing list: -// https://postlister.uninett.no/sympa/info/norid-diskusjon +// no : https://www.norid.no/en/om-domenenavn/regelverk-for-no/ +// Norid geographical second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-b/ +// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/ +// Norid category second-level domains managed by parties other than Norid : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-d/ no -// Norid generic domains : http://www.norid.no/regelverk/vedlegg-c.en.html +// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/ fhs.no vgs.no fylkesbibl.no @@ -4470,13 +4712,13 @@ folkebibl.no museum.no idrett.no priv.no -// Non-Norid generic domains : http://www.norid.no/regelverk/vedlegg-d.en.html +// Norid category second-level domains managed by parties other than Norid : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-d/ mil.no stat.no dep.no kommune.no herad.no -// no geographical names : http://www.norid.no/regelverk/vedlegg-b.en.html +// Norid geographical second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-b/ // counties aa.no ah.no @@ -5237,10 +5479,10 @@ org.nr net.nr com.nr -// nu : http://en.wikipedia.org/wiki/.nu +// nu : https://en.wikipedia.org/wiki/.nu nu -// nz : http://en.wikipedia.org/wiki/.nz +// nz : https://en.wikipedia.org/wiki/.nz // Submitted by registry <jay@nzrs.net.nz> nz ac.nz @@ -5260,7 +5502,7 @@ org.nz parliament.nz school.nz -// om : http://en.wikipedia.org/wiki/.om +// om : https://en.wikipedia.org/wiki/.om om co.om com.om @@ -5272,7 +5514,10 @@ net.om org.om pro.om -// org : http://en.wikipedia.org/wiki/.org +// onion : https://tools.ietf.org/html/rfc7686 +onion + +// org : https://en.wikipedia.org/wiki/.org org // pa : http://www.nic.pa/ @@ -5307,7 +5552,7 @@ com.pf org.pf edu.pf -// pg : http://en.wikipedia.org/wiki/.pg +// pg : https://en.wikipedia.org/wiki/.pg *.pg // ph : http://www.domains.ph/FAQ2.asp @@ -5557,7 +5802,7 @@ org.pn edu.pn net.pn -// post : http://en.wikipedia.org/wiki/.post +// post : https://en.wikipedia.org/wiki/.post post // pr : http://www.nic.pr/index.asp?f=1 @@ -5572,22 +5817,26 @@ pro.pr biz.pr info.pr name.pr -// these aren't mentioned on nic.pr, but on http://en.wikipedia.org/wiki/.pr +// these aren't mentioned on nic.pr, but on https://en.wikipedia.org/wiki/.pr est.pr prof.pr ac.pr -// pro : http://www.nic.pro/support_faq.htm +// pro : http://registry.pro/get-pro pro +aaa.pro aca.pro +acct.pro +avocat.pro bar.pro cpa.pro +eng.pro jur.pro law.pro med.pro -eng.pro +recht.pro -// ps : http://en.wikipedia.org/wiki/.ps +// ps : https://en.wikipedia.org/wiki/.ps // http://www.nic.ps/registration/policy.html#reg ps edu.ps @@ -5609,7 +5858,7 @@ publ.pt com.pt nome.pt -// pw : http://en.wikipedia.org/wiki/.pw +// pw : https://en.wikipedia.org/wiki/.pw pw co.pw ne.pw @@ -5669,156 +5918,19 @@ gov.rs in.rs org.rs -// ru : http://www.cctld.ru/ru/docs/aktiv_8.php -// Industry domains +// ru : https://cctld.ru/files/pdf/docs/en/rules_ru-rf.pdf +// Submitted by George Georgievsky <gug@cctld.ru> ru -ac.ru -com.ru -edu.ru -int.ru -net.ru -org.ru -pp.ru -// Geographical domains -adygeya.ru -altai.ru -amur.ru -arkhangelsk.ru -astrakhan.ru -bashkiria.ru -belgorod.ru -bir.ru -bryansk.ru -buryatia.ru -cbg.ru -chel.ru -chelyabinsk.ru -chita.ru -chukotka.ru -chuvashia.ru -dagestan.ru -dudinka.ru -e-burg.ru -grozny.ru -irkutsk.ru -ivanovo.ru -izhevsk.ru -jar.ru -joshkar-ola.ru -kalmykia.ru -kaluga.ru -kamchatka.ru -karelia.ru -kazan.ru -kchr.ru -kemerovo.ru -khabarovsk.ru -khakassia.ru -khv.ru -kirov.ru -koenig.ru -komi.ru -kostroma.ru -krasnoyarsk.ru -kuban.ru -kurgan.ru -kursk.ru -lipetsk.ru -magadan.ru -mari.ru -mari-el.ru -marine.ru -mordovia.ru -// mosreg.ru Bug 1090800 - removed at request of Aleksey Konstantinov <konstantinovav@mosreg.ru> -msk.ru -murmansk.ru -nalchik.ru -nnov.ru -nov.ru -novosibirsk.ru -nsk.ru -omsk.ru -orenburg.ru -oryol.ru -palana.ru -penza.ru -perm.ru -ptz.ru -rnd.ru -ryazan.ru -sakhalin.ru -samara.ru -saratov.ru -simbirsk.ru -smolensk.ru -spb.ru -stavropol.ru -stv.ru -surgut.ru -tambov.ru -tatarstan.ru -tom.ru -tomsk.ru -tsaritsyn.ru -tsk.ru -tula.ru -tuva.ru -tver.ru -tyumen.ru -udm.ru -udmurtia.ru -ulan-ude.ru -vladikavkaz.ru -vladimir.ru -vladivostok.ru -volgograd.ru -vologda.ru -voronezh.ru -vrn.ru -vyatka.ru -yakutia.ru -yamal.ru -yaroslavl.ru -yekaterinburg.ru -yuzhno-sakhalinsk.ru -// More geographical domains -amursk.ru -baikal.ru -cmw.ru -fareast.ru -jamal.ru -kms.ru -k-uralsk.ru -kustanai.ru -kuzbass.ru -mytis.ru -nakhodka.ru -nkz.ru -norilsk.ru -oskol.ru -pyatigorsk.ru -rubtsovsk.ru -snz.ru -syzran.ru -vdonsk.ru -zgrad.ru -// State domains -gov.ru -mil.ru -// Technical domains -test.ru -// rw : http://www.nic.rw/cgi-bin/policy.pl +// rw : https://www.ricta.org.rw/sites/default/files/resources/registry_registrar_contract_0.pdf rw -gov.rw -net.rw -edu.rw ac.rw -com.rw co.rw -int.rw +coop.rw +gov.rw mil.rw -gouv.rw +net.rw +org.rw // sa : http://www.nic.net.sa/ sa @@ -5860,7 +5972,7 @@ tv.sd gov.sd info.sd -// se : http://en.wikipedia.org/wiki/.se +// se : https://en.wikipedia.org/wiki/.se // Submitted by registry <patrik.wallstrom@iis.se> se a.se @@ -5920,14 +6032,14 @@ gov.sh org.sh mil.sh -// si : http://en.wikipedia.org/wiki/.si +// si : https://en.wikipedia.org/wiki/.si si // sj : No registrations at this time. // Submitted by registry <jarle@uninett.no> sj -// sk : http://en.wikipedia.org/wiki/.sk +// sk : https://en.wikipedia.org/wiki/.sk // list of 2nd level domains ? sk @@ -5940,10 +6052,10 @@ edu.sl gov.sl org.sl -// sm : http://en.wikipedia.org/wiki/.sm +// sm : https://en.wikipedia.org/wiki/.sm sm -// sn : http://en.wikipedia.org/wiki/.sn +// sn : https://en.wikipedia.org/wiki/.sn sn art.sn com.sn @@ -5953,15 +6065,28 @@ org.sn perso.sn univ.sn -// so : http://www.soregistry.com/ +// so : http://sonic.so/policies/ so com.so +edu.so +gov.so +me.so net.so org.so -// sr : http://en.wikipedia.org/wiki/.sr +// sr : https://en.wikipedia.org/wiki/.sr sr +// ss : https://registry.nic.ss/ +// Submitted by registry <technical@nic.ss> +ss +biz.ss +com.ss +edu.ss +gov.ss +net.ss +org.ss + // st : http://www.nic.st/html/policyrules/ st co.st @@ -5977,40 +6102,8 @@ principe.st saotome.st store.st -// su : http://en.wikipedia.org/wiki/.su +// su : https://en.wikipedia.org/wiki/.su su -adygeya.su -arkhangelsk.su -balashov.su -bashkiria.su -bryansk.su -dagestan.su -grozny.su -ivanovo.su -kalmykia.su -kaluga.su -karelia.su -khakassia.su -krasnodar.su -kurgan.su -lenug.su -mordovia.su -msk.su -murmansk.su -nalchik.su -nov.su -obninsk.su -penza.su -pokrovsk.su -sochi.su -spb.su -togliatti.su -troitsk.su -tula.su -tuva.su -vladikavkaz.su -vladimir.su -vologda.su // sv : http://www.svnet.org.sv/niveldos.pdf sv @@ -6020,12 +6113,12 @@ gob.sv org.sv red.sv -// sx : http://en.wikipedia.org/wiki/.sx +// sx : https://en.wikipedia.org/wiki/.sx // Submitted by registry <jcvignes@openregistry.com> sx gov.sx -// sy : http://en.wikipedia.org/wiki/.sy +// sy : https://en.wikipedia.org/wiki/.sy // see also: http://www.gobin.info/domainname/sy.doc sy edu.sy @@ -6035,31 +6128,31 @@ mil.sy com.sy org.sy -// sz : http://en.wikipedia.org/wiki/.sz +// sz : https://en.wikipedia.org/wiki/.sz // http://www.sispa.org.sz/ sz co.sz ac.sz org.sz -// tc : http://en.wikipedia.org/wiki/.tc +// tc : https://en.wikipedia.org/wiki/.tc tc -// td : http://en.wikipedia.org/wiki/.td +// td : https://en.wikipedia.org/wiki/.td td -// tel: http://en.wikipedia.org/wiki/.tel +// tel: https://en.wikipedia.org/wiki/.tel // http://www.telnic.org/ tel -// tf : http://en.wikipedia.org/wiki/.tf +// tf : https://en.wikipedia.org/wiki/.tf tf -// tg : http://en.wikipedia.org/wiki/.tg +// tg : https://en.wikipedia.org/wiki/.tg // http://www.nic.tg/ tg -// th : http://en.wikipedia.org/wiki/.th +// th : https://en.wikipedia.org/wiki/.th // Submitted by registry <krit@thains.co.th> th ac.th @@ -6088,10 +6181,10 @@ org.tj test.tj web.tj -// tk : http://en.wikipedia.org/wiki/.tk +// tk : https://en.wikipedia.org/wiki/.tk tk -// tl : http://en.wikipedia.org/wiki/.tl +// tl : https://en.wikipedia.org/wiki/.tl tl gov.tl @@ -6106,7 +6199,7 @@ gov.tm mil.tm edu.tm -// tn : http://en.wikipedia.org/wiki/.tn +// tn : https://en.wikipedia.org/wiki/.tn // http://whois.ati.tn/ tn com.tn @@ -6130,7 +6223,7 @@ agrinet.tn defense.tn turen.tn -// to : http://en.wikipedia.org/wiki/.to +// to : https://en.wikipedia.org/wiki/.to // Submitted by registry <egullich@colo.to> to com.to @@ -6140,40 +6233,36 @@ org.to edu.to mil.to -// subTLDs: https://www.nic.tr/forms/eng/policies.pdf -// and: https://www.nic.tr/forms/politikalar.pdf -// Submitted by <mehmetgurevin@gmail.com> +// tr : https://nic.tr/ +// https://nic.tr/forms/eng/policies.pdf +// https://nic.tr/index.php?USRACTN=PRICELST tr -com.tr -info.tr -biz.tr -net.tr -org.tr -web.tr -gen.tr -tv.tr av.tr -dr.tr bbs.tr -name.tr -tel.tr -gov.tr bel.tr -pol.tr +biz.tr +com.tr +dr.tr +edu.tr +gen.tr +gov.tr +info.tr mil.tr k12.tr -edu.tr kep.tr - +name.tr +net.tr +org.tr +pol.tr +tel.tr +tsk.tr +tv.tr +web.tr // Used by Northern Cyprus nc.tr - // Used by government agencies of Northern Cyprus gov.nc.tr -// travel : http://en.wikipedia.org/wiki/.travel -travel - // tt : http://www.nic.tt/ tt co.tt @@ -6194,12 +6283,12 @@ name.tt gov.tt edu.tt -// tv : http://en.wikipedia.org/wiki/.tv +// tv : https://en.wikipedia.org/wiki/.tv // Not listing any 2LDs as reserved since none seem to exist in practice, // Wikipedia notwithstanding. tv -// tw : http://en.wikipedia.org/wiki/.tw +// tw : https://en.wikipedia.org/wiki/.tw tw edu.tw gov.tw @@ -6257,7 +6346,6 @@ cv.ua dn.ua dnepropetrovsk.ua dnipropetrovsk.ua -dominic.ua donetsk.ua dp.ua if.ua @@ -6325,7 +6413,7 @@ ne.ug com.ug org.ug -// uk : http://en.wikipedia.org/wiki/.uk +// uk : https://en.wikipedia.org/wiki/.uk // Submitted by registry <Michael.Daly@nominet.org.uk> uk ac.uk @@ -6340,7 +6428,7 @@ plc.uk police.uk *.sch.uk -// us : http://en.wikipedia.org/wiki/.us +// us : https://en.wikipedia.org/wiki/.us us dni.us fed.us @@ -6451,7 +6539,7 @@ k12.ok.us k12.or.us k12.pa.us k12.pr.us -k12.ri.us +// k12.ri.us Removed at request of Kim Cournoyer <netsupport@staff.ri.net> k12.sc.us // k12.sd.us Bug 934131 - Removed at request of James Booze <James.Booze@k12.sd.us> k12.tn.us @@ -6528,7 +6616,7 @@ lib.ca.us lib.co.us lib.ct.us lib.dc.us -lib.de.us +// lib.de.us Issue #243 - Moved to Private section at request of Ed Moore <Ed.Moore@lib.de.us> lib.fl.us lib.ga.us lib.gu.us @@ -6581,6 +6669,17 @@ lib.wy.us pvt.k12.ma.us chtr.k12.ma.us paroch.k12.ma.us +// Merit Network, Inc. maintains the registry for =~ /(k12|cc|lib).mi.us/ and the following +// see also: http://domreg.merit.edu +// see also: whois -h whois.domreg.merit.edu help +ann-arbor.mi.us +cog.mi.us +dst.mi.us +eaton.mi.us +gen.mi.us +mus.mi.us +tec.mi.us +washtenaw.mi.us // uy : http://www.nic.org.uy/ uy @@ -6598,10 +6697,10 @@ com.uz net.uz org.uz -// va : http://en.wikipedia.org/wiki/.va +// va : https://en.wikipedia.org/wiki/.va va -// vc : http://en.wikipedia.org/wiki/.vc +// vc : https://en.wikipedia.org/wiki/.vc // Submitted by registry <kshah@ca.afilias.info> vc com.vc @@ -6632,7 +6731,7 @@ store.ve tec.ve web.ve -// vg : http://en.wikipedia.org/wiki/.vg +// vg : https://en.wikipedia.org/wiki/.vg vg // vi : http://www.nic.vi/newdomainform.htm @@ -6661,7 +6760,7 @@ name.vn pro.vn health.vn -// vu : http://en.wikipedia.org/wiki/.vu +// vu : https://en.wikipedia.org/wiki/.vu // http://www.vunic.vu/ vu com.vu @@ -6672,7 +6771,7 @@ org.vu // wf : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf wf -// ws : http://en.wikipedia.org/wiki/.ws +// ws : https://en.wikipedia.org/wiki/.ws // http://samoanic.ws/index.dhtml ws com.ws @@ -6702,6 +6801,9 @@ yt // xn--54b7fta0cc ("Bangla", Bangla) : BD বাংলা +// xn--90ae ("bg", Bulgarian) : BG +бг + // xn--90ais ("bel", Belarusian/Russian Cyrillic) : BY // Operated by .by registry бел @@ -6723,6 +6825,17 @@ yt // http://www.dotmasr.eg/ مصر +// xn--e1a4c ("eu", Cyrillic) : EU +// https://eurid.eu +ею + +// xn--qxa6a ("eu", Greek) : EU +// https://eurid.eu +ευ + +// xn--mgbah1a3hjkrd ("Mauritania", Arabic) : MR +موريتانيا + // xn--node ("ge", Georgian Mkhedruli) : GE გე @@ -6731,13 +6844,53 @@ yt ελ // xn--j6w193g ("Hong Kong", Chinese) : HK -// https://www2.hkirc.hk/register/rules.jsp +// https://www.hkirc.hk +// Submitted by registry <hk.tech@hkirc.hk> +// https://www.hkirc.hk/content.jsp?id=30#!/34 香港 +公司.香港 +教育.香港 +政府.香港 +個人.香港 +網絡.香港 +組織.香港 + +// xn--2scrj9c ("Bharat", Kannada) : IN +// India +ಭಾರತ + +// xn--3hcrj9c ("Bharat", Oriya) : IN +// India +ଭାରତ + +// xn--45br5cyl ("Bharatam", Assamese) : IN +// India +ভাৰত + +// xn--h2breg3eve ("Bharatam", Sanskrit) : IN +// India +भारतम् + +// xn--h2brj9c8c ("Bharot", Santali) : IN +// India +भारोत + +// xn--mgbgu82a ("Bharat", Sindhi) : IN +// India +ڀارت + +// xn--rvc1e0am3e ("Bharatam", Malayalam) : IN +// India +ഭാരതം // xn--h2brj9c ("Bharat", Devanagari) : IN // India भारत +// xn--mgbbh1a ("Bharat", Kashmiri) : IN +// India +بارت + // xn--mgbbh1a71e ("Bharat", Arabic) : IN // India بھارت @@ -6784,11 +6937,11 @@ yt қаз // xn--fzc2c9e2c ("Lanka", Sinhalese-Sinhala) : LK -// http://nic.lk +// https://nic.lk ලංකා // xn--xkc2al3hye2a ("Ilangai", Tamil) : LK -// http://nic.lk +// https://nic.lk இலங்கை // xn--mgbc0a9azcg ("Morocco/al-Maghrib", Arabic) : MA @@ -6836,7 +6989,8 @@ yt ак.срб // xn--p1ai ("rf", Russian-Cyrillic) : RU -// http://www.cctld.ru/en/docs/rulesrf.php +// https://cctld.ru/files/pdf/docs/en/rules_ru-rf.pdf +// Submitted by George Georgievsky <gug@cctld.ru> рф // xn--wgbl6a ("Qatar", Arabic) : QA @@ -6875,6 +7029,12 @@ yt // xn--o3cw4h ("Thai", Thai) : TH // http://www.thnic.co.th ไทย +ศึกษา.ไทย +ธุรกิจ.ไทย +รัฐบาล.ไทย +ทหาร.ไทย +เน็ต.ไทย +องค์กร.ไทย // xn--pgbs0dh ("Tunisia", Arabic) : TN // http://nic.tn @@ -6903,7 +7063,7 @@ xxx // ye : http://www.y.net.ye/services/domain_name.htm *.ye -// za : http://www.zadna.org.za/content/page/domain-information +// za : https://www.zadna.org.za/content/page/domain-information/ ac.za agric.za alt.za @@ -6915,6 +7075,7 @@ law.za mil.za net.za ngo.za +nic.za nis.za nom.za org.za @@ -6922,15 +7083,35 @@ school.za tm.za web.za -// zm : http://en.wikipedia.org/wiki/.zm -*.zm - -// zw : http://en.wikipedia.org/wiki/.zw -*.zw - - -// List of new gTLDs imported from https://newgtlds.icann.org/newgtlds.csv on 2016-01-04T22:39:54Z - +// zm : https://zicta.zm/ +// Submitted by registry <info@zicta.zm> +zm +ac.zm +biz.zm +co.zm +com.zm +edu.zm +gov.zm +info.zm +mil.zm +net.zm +org.zm +sch.zm + +// zw : https://www.potraz.gov.zw/ +// Confirmed by registry <bmtengwa@potraz.gov.zw> 2017-01-25 +zw +ac.zw +co.zw +gov.zw +mil.zw +org.zw + + +// newGTLDs + +// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2020-10-08T17:45:32Z +// This list is auto-generated, don't edit it manually. // aaa : 2015-02-26 American Automobile Association, Inc. aaa @@ -6955,13 +7136,13 @@ abc // able : 2015-06-25 Able Inc. able -// abogado : 2014-04-24 Top Level Domain Holdings Limited +// abogado : 2014-04-24 Minds + Machines Group Limited abogado // abudhabi : 2015-07-30 Abu Dhabi Systems and Information Centre abudhabi -// academy : 2013-11-07 Half Oaks, LLC +// academy : 2013-11-07 Binky Moon, LLC academy // accenture : 2014-08-15 Accenture plc @@ -6970,16 +7151,13 @@ accenture // accountant : 2014-11-20 dot Accountant Limited accountant -// accountants : 2014-03-20 Knob Town, LLC +// accountants : 2014-03-20 Binky Moon, LLC accountants // aco : 2015-01-08 ACO Severin Ahlmann GmbH & Co. KG aco -// active : 2014-05-01 The Active Network, Inc -active - -// actor : 2013-12-12 United TLD Holdco Ltd. +// actor : 2013-12-12 Dog Beach, LLC actor // adac : 2015-07-16 Allgemeiner Deutscher Automobil-Club e.V. (ADAC) @@ -7006,25 +7184,19 @@ afl // africa : 2014-03-24 ZA Central Registry NPC trading as Registry.Africa africa -// africamagic : 2015-03-05 Electronic Media Network (Pty) Ltd -africamagic - // agakhan : 2015-04-23 Fondation Aga Khan (Aga Khan Foundation) agakhan -// agency : 2013-11-14 Steel Falls, LLC +// agency : 2013-11-14 Binky Moon, LLC agency // aig : 2014-12-18 American International Group, Inc. aig -// aigo : 2015-08-06 aigo Digital Technology Co,Ltd. -aigo - // airbus : 2015-07-30 Airbus S.A.S. airbus -// airforce : 2014-03-06 United TLD Holdco Ltd. +// airforce : 2014-03-06 Dog Beach, LLC airforce // airtel : 2014-10-24 Bharti Airtel Limited @@ -7051,12 +7223,15 @@ allstate // ally : 2015-06-18 Ally Financial Inc. ally -// alsace : 2014-07-02 REGION D ALSACE +// alsace : 2014-07-02 Region Grand Est alsace // alstom : 2015-07-30 ALSTOM alstom +// amazon : 2019-12-19 Amazon Registry Services, Inc. +amazon + // americanexpress : 2015-07-31 American Express Travel Related Services Company, Inc. americanexpress @@ -7081,16 +7256,16 @@ analytics // android : 2014-08-07 Charleston Road Registry Inc. android -// anquan : 2015-01-08 QIHOO 360 TECHNOLOGY CO. LTD. +// anquan : 2015-01-08 Beijing Qihu Keji Co., Ltd. anquan // anz : 2015-07-31 Australia and New Zealand Banking Group Limited anz -// aol : 2015-09-17 AOL Inc. +// aol : 2015-09-17 Oath Inc. aol -// apartments : 2014-12-11 June Maple, LLC +// apartments : 2014-12-11 Binky Moon, LLC apartments // app : 2015-05-14 Charleston Road Registry Inc. @@ -7108,55 +7283,58 @@ arab // aramco : 2014-11-20 Aramco Services Company aramco -// archi : 2014-02-06 STARTING DOT LIMITED +// archi : 2014-02-06 Afilias Limited archi -// army : 2014-03-06 United TLD Holdco Ltd. +// army : 2014-03-06 Dog Beach, LLC army +// art : 2016-03-24 UK Creative Ideas Limited +art + // arte : 2014-12-11 Association Relative à la Télévision Européenne G.E.I.E. arte // asda : 2015-07-31 Wal-Mart Stores, Inc. asda -// associates : 2014-03-06 Baxter Hill, LLC +// associates : 2014-03-06 Binky Moon, LLC associates // athleta : 2015-07-30 The Gap, Inc. athleta -// attorney : 2014-03-20 +// attorney : 2014-03-20 Dog Beach, LLC attorney -// auction : 2014-03-20 +// auction : 2014-03-20 Dog Beach, LLC auction // audi : 2015-05-21 AUDI Aktiengesellschaft audi -// audible : 2015-06-25 Amazon EU S.à r.l. +// audible : 2015-06-25 Amazon Registry Services, Inc. audible -// audio : 2014-03-20 Uniregistry, Corp. +// audio : 2014-03-20 UNR Corp. audio // auspost : 2015-08-13 Australian Postal Corporation auspost -// author : 2014-12-18 Amazon EU S.à r.l. +// author : 2014-12-18 Amazon Registry Services, Inc. author -// auto : 2014-11-13 +// auto : 2014-11-13 XYZ.COM LLC auto // autos : 2014-01-09 DERAutos, LLC autos -// avianca : 2015-01-08 Aerovias del Continente Americano S.A. Avianca +// avianca : 2015-01-08 Avianca Holdings S.A. avianca -// aws : 2015-06-25 Amazon EU S.à r.l. +// aws : 2015-06-25 Amazon Registry Services, Inc. aws // axa : 2013-12-19 AXA SA @@ -7165,7 +7343,7 @@ axa // azure : 2014-12-18 Microsoft Corporation azure -// baby : 2015-04-09 Johnson & Johnson Services, Inc. +// baby : 2015-04-09 XYZ.COM LLC baby // baidu : 2015-01-08 Baidu, Inc. @@ -7177,7 +7355,7 @@ banamex // bananarepublic : 2015-07-31 The Gap, Inc. bananarepublic -// band : 2014-06-12 +// band : 2014-06-12 Dog Beach, LLC band // bank : 2014-09-25 fTLD Registry Services LLC @@ -7198,7 +7376,7 @@ barclays // barefoot : 2015-06-11 Gallo Vineyards, Inc. barefoot -// bargains : 2013-11-14 Half Hallow, LLC +// bargains : 2013-11-14 Binky Moon, LLC bargains // baseball : 2015-10-29 MLB Advanced Media DH, LLC @@ -7231,10 +7409,10 @@ bcn // beats : 2015-05-14 Beats Electronics, LLC beats -// beauty : 2015-12-03 L'Oréal +// beauty : 2015-12-03 XYZ.COM LLC beauty -// beer : 2014-01-09 Top Level Domain Holdings Limited +// beer : 2014-01-09 Minds + Machines Group Limited beer // bentley : 2014-12-18 Bentley Motors Limited @@ -7249,7 +7427,7 @@ best // bestbuy : 2015-07-31 BBY Solutions, Inc. bestbuy -// bet : 2015-05-07 Afilias plc +// bet : 2015-05-07 Afilias Limited bet // bharti : 2014-01-09 Bharti Enterprises (Holding) Private Limited @@ -7261,31 +7439,28 @@ bible // bid : 2013-12-19 dot Bid Limited bid -// bike : 2013-08-27 Grand Hollow, LLC +// bike : 2013-08-27 Binky Moon, LLC bike // bing : 2014-12-18 Microsoft Corporation bing -// bingo : 2014-12-04 Sand Cedar, LLC +// bingo : 2014-12-04 Binky Moon, LLC bingo -// bio : 2014-03-06 STARTING DOT LIMITED +// bio : 2014-03-06 Afilias Limited bio // black : 2014-01-16 Afilias Limited black -// blackfriday : 2014-01-16 Uniregistry, Corp. +// blackfriday : 2014-01-16 UNR Corp. blackfriday -// blanco : 2015-07-16 BLANCO GmbH + Co KG -blanco - // blockbuster : 2015-07-30 Dish DBS Corporation blockbuster -// blog : 2015-05-14 PRIMER NIVEL S.A. +// blog : 2015-05-14 Knock Knock WHOIS There, LLC blog // bloomberg : 2014-07-17 Bloomberg IP Holdings LLC @@ -7300,9 +7475,6 @@ bms // bmw : 2014-01-09 Bayerische Motoren Werke Aktiengesellschaft bmw -// bnl : 2014-07-24 Banca Nazionale del Lavoro -bnl - // bnpparibas : 2014-05-29 BNP Paribas bnpparibas @@ -7312,43 +7484,40 @@ boats // boehringer : 2015-07-09 Boehringer Ingelheim International GmbH boehringer -// bofa : 2015-07-31 NMS Services, Inc. +// bofa : 2015-07-31 Bank of America Corporation bofa // bom : 2014-10-16 Núcleo de Informação e Coordenação do Ponto BR - NIC.br bom -// bond : 2014-06-05 Bond University Limited +// bond : 2014-06-05 ShortDot SA bond // boo : 2014-01-30 Charleston Road Registry Inc. boo -// book : 2015-08-27 Amazon EU S.à r.l. +// book : 2015-08-27 Amazon Registry Services, Inc. book // booking : 2015-07-16 Booking.com B.V. booking -// boots : 2015-01-08 THE BOOTS COMPANY PLC -boots - // bosch : 2015-06-18 Robert Bosch GMBH bosch // bostik : 2015-05-28 Bostik SA bostik -// boston : 2015-12-10 Boston Globe Media Partners, LLC +// boston : 2015-12-10 Boston TLD Management, LLC boston -// bot : 2014-12-18 Amazon EU S.à r.l. +// bot : 2014-12-18 Amazon Registry Services, Inc. bot -// boutique : 2013-11-14 Over Galley, LLC +// boutique : 2013-11-14 Binky Moon, LLC boutique -// box : 2015-11-12 NS1 Limited +// box : 2015-11-12 .BOX INC. box // bradesco : 2014-12-18 Banco Bradesco S.A. @@ -7360,7 +7529,7 @@ bridgestone // broadway : 2014-12-22 Celebrate Broadway, Inc. broadway -// broker : 2014-12-11 IG Group Holdings PLC +// broker : 2014-12-11 Dotbroker Registry Limited broker // brother : 2015-01-29 Brother Industries, Ltd. @@ -7369,7 +7538,7 @@ brother // brussels : 2014-02-06 DNS.be vzw brussels -// budapest : 2013-11-21 Top Level Domain Holdings Limited +// budapest : 2013-11-21 Minds + Machines Group Limited budapest // bugatti : 2015-07-23 Bugatti International SA @@ -7378,13 +7547,13 @@ bugatti // build : 2013-11-07 Plan Bee LLC build -// builders : 2013-11-07 Atomic Madison, LLC +// builders : 2013-11-07 Binky Moon, LLC builders -// business : 2013-11-07 Spring Cross, LLC +// business : 2013-11-07 Binky Moon, LLC business -// buy : 2014-12-18 Amazon EU S.à r.l. +// buy : 2014-12-18 Amazon Registry Services, Inc. buy // buzz : 2013-10-02 DOTSTRATEGY CO. @@ -7393,25 +7562,28 @@ buzz // bzh : 2014-02-27 Association www.bzh bzh -// cab : 2013-10-24 Half Sunset, LLC +// cab : 2013-10-24 Binky Moon, LLC cab -// cafe : 2015-02-11 Pioneer Canyon, LLC +// cafe : 2015-02-11 Binky Moon, LLC cafe // cal : 2014-07-24 Charleston Road Registry Inc. cal -// call : 2014-12-18 Amazon EU S.à r.l. +// call : 2014-12-18 Amazon Registry Services, Inc. call // calvinklein : 2015-07-30 PVH gTLD Holdings LLC calvinklein -// camera : 2013-08-27 Atomic Maple, LLC +// cam : 2016-04-21 AC Webconnecting Holding B.V. +cam + +// camera : 2013-08-27 Binky Moon, LLC camera -// camp : 2013-11-07 Delta Dynamite, LLC +// camp : 2013-11-07 Binky Moon, LLC camp // cancerresearch : 2014-05-15 Australian Cancer Research Foundation @@ -7423,37 +7595,34 @@ canon // capetown : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry capetown -// capital : 2014-03-06 Delta Mill, LLC +// capital : 2014-03-06 Binky Moon, LLC capital // capitalone : 2015-08-06 Capital One Financial Corporation capitalone -// car : 2015-01-22 +// car : 2015-01-22 XYZ.COM LLC car // caravan : 2013-12-12 Caravan International, Inc. caravan -// cards : 2013-12-05 Foggy Hollow, LLC +// cards : 2013-12-05 Binky Moon, LLC cards -// care : 2014-03-06 Goose Cross +// care : 2014-03-06 Binky Moon, LLC care // career : 2013-10-09 dotCareer LLC career -// careers : 2013-10-02 Wild Corner, LLC +// careers : 2013-10-02 Binky Moon, LLC careers -// cars : 2014-11-13 +// cars : 2014-11-13 XYZ.COM LLC cars -// cartier : 2014-06-23 Richemont DNS Inc. -cartier - -// casa : 2013-11-21 Top Level Domain Holdings Limited +// casa : 2013-11-21 Minds + Machines Group Limited casa // case : 2015-09-03 CNH Industrial N.V. @@ -7462,13 +7631,13 @@ case // caseih : 2015-09-03 CNH Industrial N.V. caseih -// cash : 2014-03-06 Delta Lake, LLC +// cash : 2014-03-06 Binky Moon, LLC cash -// casino : 2014-12-18 Binky Sky, LLC +// casino : 2014-12-18 Binky Moon, LLC casino -// catering : 2013-12-05 New Falls. LLC +// catering : 2013-12-05 Binky Moon, LLC catering // catholic : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) @@ -7489,7 +7658,7 @@ cbs // ceb : 2015-04-09 The Corporate Executive Board Company ceb -// center : 2013-11-07 Tin Mill, LLC +// center : 2013-11-07 Binky Moon, LLC center // ceo : 2013-11-07 CEOTLD Pty Ltd @@ -7501,7 +7670,7 @@ cern // cfa : 2014-08-28 CFA Institute cfa -// cfd : 2014-12-11 IG Group Holdings PLC +// cfd : 2014-12-11 DotCFD Registry Limited cfd // chanel : 2015-04-09 Chanel International B.V. @@ -7510,37 +7679,34 @@ chanel // channel : 2014-05-08 Charleston Road Registry Inc. channel -// chase : 2015-04-30 JPMorgan Chase & Co. +// charity : 2018-04-11 Binky Moon, LLC +charity + +// chase : 2015-04-30 JPMorgan Chase Bank, National Association chase -// chat : 2014-12-04 Sand Fields, LLC +// chat : 2014-12-04 Binky Moon, LLC chat -// cheap : 2013-11-14 Sand Cover, LLC +// cheap : 2013-11-14 Binky Moon, LLC cheap // chintai : 2015-06-11 CHINTAI Corporation chintai -// chloe : 2014-10-16 Richemont DNS Inc. -chloe - -// christmas : 2013-11-21 Uniregistry, Corp. +// christmas : 2013-11-21 UNR Corp. christmas // chrome : 2014-07-24 Charleston Road Registry Inc. chrome -// chrysler : 2015-07-30 FCA US LLC. -chrysler - -// church : 2014-02-06 Holly Fields, LLC +// church : 2014-02-06 Binky Moon, LLC church // cipriani : 2015-02-19 Hotel Cipriani Srl cipriani -// circle : 2014-12-18 Amazon EU S.à r.l. +// circle : 2014-12-18 Amazon Registry Services, Inc. circle // cisco : 2014-12-22 Cisco Technology, Inc. @@ -7555,31 +7721,31 @@ citi // citic : 2014-01-09 CITIC Group Corporation citic -// city : 2014-05-29 Snow Sky, LLC +// city : 2014-05-29 Binky Moon, LLC city // cityeats : 2014-12-11 Lifestyle Domain Holdings, Inc. cityeats -// claims : 2014-03-20 Black Corner, LLC +// claims : 2014-03-20 Binky Moon, LLC claims -// cleaning : 2013-12-05 Fox Shadow, LLC +// cleaning : 2013-12-05 Binky Moon, LLC cleaning -// click : 2014-06-05 Uniregistry, Corp. +// click : 2014-06-05 UNR Corp. click -// clinic : 2014-03-20 Goose Park, LLC +// clinic : 2014-03-20 Binky Moon, LLC clinic // clinique : 2015-10-01 The Estée Lauder Companies Inc. clinique -// clothing : 2013-08-27 Steel Lake, LLC +// clothing : 2013-08-27 Binky Moon, LLC clothing -// cloud : 2015-04-16 ARUBA S.p.A. +// cloud : 2015-04-16 Aruba PEC S.p.A. cloud // club : 2013-11-08 .CLUB DOMAINS, LLC @@ -7588,19 +7754,19 @@ club // clubmed : 2015-06-25 Club Méditerranée S.A. clubmed -// coach : 2014-10-09 Koko Island, LLC +// coach : 2014-10-09 Binky Moon, LLC coach -// codes : 2013-10-31 Puff Willow, LLC +// codes : 2013-10-31 Binky Moon, LLC codes -// coffee : 2013-10-17 Trixy Cover, LLC +// coffee : 2013-10-17 Binky Moon, LLC coffee // college : 2014-01-16 XYZ.COM LLC college -// cologne : 2014-02-05 NetCologne Gesellschaft für Telekommunikation mbH +// cologne : 2014-02-05 dotKoeln GmbH cologne // comcast : 2015-07-23 Comcast IP Holdings I, LLC @@ -7609,64 +7775,67 @@ comcast // commbank : 2014-06-26 COMMONWEALTH BANK OF AUSTRALIA commbank -// community : 2013-12-05 Fox Orchard, LLC +// community : 2013-12-05 Binky Moon, LLC community -// company : 2013-11-07 Silver Avenue, LLC +// company : 2013-11-07 Binky Moon, LLC company -// compare : 2015-10-08 iSelect Ltd +// compare : 2015-10-08 Registry Services, LLC compare -// computer : 2013-10-24 Pine Mill, LLC +// computer : 2013-10-24 Binky Moon, LLC computer // comsec : 2015-01-08 VeriSign, Inc. comsec -// condos : 2013-12-05 Pine House, LLC +// condos : 2013-12-05 Binky Moon, LLC condos -// construction : 2013-09-16 Fox Dynamite, LLC +// construction : 2013-09-16 Binky Moon, LLC construction -// consulting : 2013-12-05 +// consulting : 2013-12-05 Dog Beach, LLC consulting -// contact : 2015-01-08 Top Level Spectrum, Inc. +// contact : 2015-01-08 Dog Beach, LLC contact -// contractors : 2013-09-10 Magic Woods, LLC +// contractors : 2013-09-10 Binky Moon, LLC contractors -// cooking : 2013-11-21 Top Level Domain Holdings Limited +// cooking : 2013-11-21 Minds + Machines Group Limited cooking // cookingchannel : 2015-07-02 Lifestyle Domain Holdings, Inc. cookingchannel -// cool : 2013-11-14 Koko Lake, LLC +// cool : 2013-11-14 Binky Moon, LLC cool -// corsica : 2014-09-25 Collectivité Territoriale de Corse +// corsica : 2014-09-25 Collectivité de Corse corsica -// country : 2013-12-19 Top Level Domain Holdings Limited +// country : 2013-12-19 DotCountry LLC country -// coupon : 2015-02-26 Amazon EU S.à r.l. +// coupon : 2015-02-26 Amazon Registry Services, Inc. coupon -// coupons : 2015-03-26 Black Island, LLC +// coupons : 2015-03-26 Binky Moon, LLC coupons // courses : 2014-12-04 OPEN UNIVERSITIES AUSTRALIA PTY LTD courses -// credit : 2014-03-20 Snow Shadow, LLC +// cpa : 2019-06-10 American Institute of Certified Public Accountants +cpa + +// credit : 2014-03-20 Binky Moon, LLC credit -// creditcard : 2014-03-20 Binky Frostbite, LLC +// creditcard : 2014-03-20 Binky Moon, LLC creditcard // creditunion : 2015-01-22 CUNA Performance Resources, LLC @@ -7684,19 +7853,19 @@ crs // cruise : 2015-12-10 Viking River Cruises (Bermuda) Ltd. cruise -// cruises : 2013-12-05 Spring Way, LLC +// cruises : 2013-12-05 Binky Moon, LLC cruises // csc : 2014-09-25 Alliance-One Services, Inc. csc -// cuisinella : 2014-04-03 SALM S.A.S. +// cuisinella : 2014-04-03 SCHMIDT GROUPE S.A.S. cuisinella // cymru : 2014-05-08 Nominet UK cymru -// cyou : 2015-01-22 Beijing Gamease Age Digital Technology Co., Ltd. +// cyou : 2015-01-22 ShortDot SA cyou // dabur : 2014-02-06 Dabur India Limited @@ -7705,13 +7874,16 @@ dabur // dad : 2014-01-23 Charleston Road Registry Inc. dad -// dance : 2013-10-24 United TLD Holdco Ltd. +// dance : 2013-10-24 Dog Beach, LLC dance +// data : 2016-06-02 Dish DBS Corporation +data + // date : 2014-11-20 dot Date Limited date -// dating : 2013-12-05 Pine Fest, LLC +// dating : 2013-12-05 Binky Moon, LLC dating // datsun : 2014-03-27 NISSAN MOTOR CO., LTD. @@ -7723,22 +7895,22 @@ day // dclk : 2014-11-20 Charleston Road Registry Inc. dclk -// dds : 2015-05-07 Top Level Domain Holdings Limited +// dds : 2015-05-07 Minds + Machines Group Limited dds -// deal : 2015-06-25 Amazon EU S.à r.l. +// deal : 2015-06-25 Amazon Registry Services, Inc. deal -// dealer : 2014-12-22 Dealer Dot Com, Inc. +// dealer : 2014-12-22 Intercap Registry Inc. dealer -// deals : 2014-05-22 Sand Sunset, LLC +// deals : 2014-05-22 Binky Moon, LLC deals -// degree : 2014-03-06 +// degree : 2014-03-06 Dog Beach, LLC degree -// delivery : 2014-09-11 Steel Station, LLC +// delivery : 2014-09-11 Binky Moon, LLC delivery // dell : 2014-10-24 Dell Inc. @@ -7750,13 +7922,13 @@ deloitte // delta : 2015-02-19 Delta Air Lines, Inc. delta -// democrat : 2013-10-24 United TLD Holdco Ltd. +// democrat : 2013-10-24 Dog Beach, LLC democrat -// dental : 2014-03-20 Tin Birch, LLC +// dental : 2014-03-20 Binky Moon, LLC dental -// dentist : 2014-03-20 +// dentist : 2014-03-20 Dog Beach, LLC dentist // desi : 2013-11-14 Desi Networks LLC @@ -7771,22 +7943,22 @@ dev // dhl : 2015-07-23 Deutsche Post AG dhl -// diamonds : 2013-09-22 John Edge, LLC +// diamonds : 2013-09-22 Binky Moon, LLC diamonds -// diet : 2014-06-26 Uniregistry, Corp. +// diet : 2014-06-26 UNR Corp. diet -// digital : 2014-03-06 Dash Park, LLC +// digital : 2014-03-06 Binky Moon, LLC digital -// direct : 2014-04-10 Half Trail, LLC +// direct : 2014-04-10 Binky Moon, LLC direct -// directory : 2013-09-20 Extra Madison, LLC +// directory : 2013-09-20 Binky Moon, LLC directory -// discount : 2014-03-06 Holly Hill, LLC +// discount : 2014-03-06 Binky Moon, LLC discount // discover : 2015-07-23 Discover Financial Services @@ -7804,21 +7976,15 @@ dnp // docs : 2014-10-16 Charleston Road Registry Inc. docs -// dodge : 2015-07-30 FCA US LLC. -dodge +// doctor : 2016-06-02 Binky Moon, LLC +doctor -// dog : 2014-12-04 Koko Mill, LLC +// dog : 2014-12-04 Binky Moon, LLC dog -// doha : 2014-09-18 Communications Regulatory Authority (CRA) -doha - -// domains : 2013-10-17 Sugar Cross, LLC +// domains : 2013-10-17 Binky Moon, LLC domains -// doosan : 2014-04-03 Doosan Corporation -doosan - // dot : 2015-05-21 Dish DBS Corporation dot @@ -7828,9 +7994,6 @@ download // drive : 2015-03-05 Charleston Road Registry Inc. drive -// dstv : 2015-03-12 MultiChoice (Proprietary) Limited -dstv - // dtv : 2015-06-04 Dish DBS Corporation dtv @@ -7843,10 +8006,7 @@ duck // dunlop : 2015-07-02 The Goodyear Tire & Rubber Company dunlop -// duns : 2015-08-06 The Dun & Bradstreet Corporation -duns - -// dupont : 2015-06-25 E.I. du Pont de Nemours and Company +// dupont : 2015-06-25 E. I. du Pont de Nemours and Company dupont // durban : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry @@ -7855,8 +8015,8 @@ durban // dvag : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG dvag -// dwg : 2015-07-23 Autodesk, Inc. -dwg +// dvr : 2016-05-26 DISH Technologies L.L.C. +dvr // earth : 2014-12-04 Interlink Co., Ltd. earth @@ -7864,40 +8024,37 @@ earth // eat : 2014-01-23 Charleston Road Registry Inc. eat +// eco : 2016-07-08 Big Room Inc. +eco + // edeka : 2014-12-18 EDEKA Verband kaufmännischer Genossenschaften e.V. edeka -// education : 2013-11-07 Brice Way, LLC +// education : 2013-11-07 Binky Moon, LLC education -// email : 2013-10-31 Spring Madison, LLC +// email : 2013-10-31 Binky Moon, LLC email // emerck : 2014-04-03 Merck KGaA emerck -// emerson : 2015-07-23 Emerson Electric Co. -emerson - -// energy : 2014-09-11 Binky Birch, LLC +// energy : 2014-09-11 Binky Moon, LLC energy -// engineer : 2014-03-06 United TLD Holdco Ltd. +// engineer : 2014-03-06 Dog Beach, LLC engineer -// engineering : 2014-03-06 Romeo Canyon +// engineering : 2014-03-06 Binky Moon, LLC engineering -// enterprises : 2013-09-20 Snow Oaks, LLC +// enterprises : 2013-09-20 Binky Moon, LLC enterprises -// epost : 2015-07-23 Deutsche Post AG -epost - // epson : 2014-12-04 Seiko Epson Corporation epson -// equipment : 2013-08-27 Corn Station, LLC +// equipment : 2013-08-27 Binky Moon, LLC equipment // ericsson : 2015-07-09 Telefonaktiebolaget L M Ericsson @@ -7909,12 +8066,9 @@ erni // esq : 2014-05-08 Charleston Road Registry Inc. esq -// estate : 2013-08-27 Trixy Park, LLC +// estate : 2013-08-27 Binky Moon, LLC estate -// esurance : 2015-07-23 Esurance Insurance Company -esurance - // etisalat : 2015-09-03 Emirates Telecommunications Corporation (trading as Etisalat) etisalat @@ -7924,22 +8078,19 @@ eurovision // eus : 2013-12-12 Puntueus Fundazioa eus -// events : 2013-12-05 Pioneer Maple, LLC +// events : 2013-12-05 Binky Moon, LLC events -// everbank : 2014-05-15 EverBank -everbank - -// exchange : 2014-03-06 Spring Falls, LLC +// exchange : 2014-03-06 Binky Moon, LLC exchange -// expert : 2013-11-21 Magic Pass, LLC +// expert : 2013-11-21 Binky Moon, LLC expert -// exposed : 2013-12-05 Victor Beach, LLC +// exposed : 2013-12-05 Binky Moon, LLC exposed -// express : 2015-02-11 Sea Sunset, LLC +// express : 2015-02-11 Binky Moon, LLC express // extraspace : 2015-05-14 Extra Space Storage LLC @@ -7948,7 +8099,7 @@ extraspace // fage : 2014-12-18 Fage International S.A. fage -// fail : 2014-03-06 Atomic Pipe, LLC +// fail : 2014-03-06 Binky Moon, LLC fail // fairwinds : 2014-11-13 FairWinds Partners, LLC @@ -7957,25 +8108,25 @@ fairwinds // faith : 2014-11-20 dot Faith Limited faith -// family : 2015-04-02 +// family : 2015-04-02 Dog Beach, LLC family -// fan : 2014-03-06 +// fan : 2014-03-06 Dog Beach, LLC fan -// fans : 2014-11-07 Asiamix Digital Limited +// fans : 2014-11-07 ZDNS International Limited fans -// farm : 2013-11-07 Just Maple, LLC +// farm : 2013-11-07 Binky Moon, LLC farm // farmers : 2015-07-09 Farmers Insurance Exchange farmers -// fashion : 2014-07-03 Top Level Domain Holdings Limited +// fashion : 2014-07-03 Minds + Machines Group Limited fashion -// fast : 2014-12-18 Amazon EU S.à r.l. +// fast : 2014-12-18 Amazon Registry Services, Inc. fast // fedex : 2015-08-06 Federal Express Corporation @@ -7996,7 +8147,7 @@ fiat // fidelity : 2015-07-30 Fidelity Brokerage Services LLC fidelity -// fido : 2015-08-06 Rogers Communications Partnership +// fido : 2015-08-06 Rogers Communications Canada Inc. fido // film : 2015-01-08 Motion Picture Domain Registry Pty Ltd @@ -8005,82 +8156,82 @@ film // final : 2014-10-16 Núcleo de Informação e Coordenação do Ponto BR - NIC.br final -// finance : 2014-03-20 Cotton Cypress, LLC +// finance : 2014-03-20 Binky Moon, LLC finance -// financial : 2014-03-06 Just Cover, LLC +// financial : 2014-03-06 Binky Moon, LLC financial -// fire : 2015-06-25 Amazon EU S.à r.l. +// fire : 2015-06-25 Amazon Registry Services, Inc. fire -// firestone : 2014-12-18 Bridgestone Corporation +// firestone : 2014-12-18 Bridgestone Licensing Services, Inc firestone // firmdale : 2014-03-27 Firmdale Holdings Limited firmdale -// fish : 2013-12-12 Fox Woods, LLC +// fish : 2013-12-12 Binky Moon, LLC fish -// fishing : 2013-11-21 Top Level Domain Holdings Limited +// fishing : 2013-11-21 Minds + Machines Group Limited fishing -// fit : 2014-11-07 Top Level Domain Holdings Limited +// fit : 2014-11-07 Minds + Machines Group Limited fit -// fitness : 2014-03-06 Brice Orchard, LLC +// fitness : 2014-03-06 Binky Moon, LLC fitness -// flickr : 2015-04-02 Yahoo! Domain Services Inc. +// flickr : 2015-04-02 Flickr, Inc. flickr -// flights : 2013-12-05 Fox Station, LLC +// flights : 2013-12-05 Binky Moon, LLC flights // flir : 2015-07-23 FLIR Systems, Inc. flir -// florist : 2013-11-07 Half Cypress, LLC +// florist : 2013-11-07 Binky Moon, LLC florist -// flowers : 2014-10-09 Uniregistry, Corp. +// flowers : 2014-10-09 UNR Corp. flowers -// flsmidth : 2014-07-24 FLSmidth A/S -flsmidth - // fly : 2014-05-08 Charleston Road Registry Inc. fly // foo : 2014-01-23 Charleston Road Registry Inc. foo +// food : 2016-04-21 Lifestyle Domain Holdings, Inc. +food + // foodnetwork : 2015-07-02 Lifestyle Domain Holdings, Inc. foodnetwork -// football : 2014-12-18 Foggy Farms, LLC +// football : 2014-12-18 Binky Moon, LLC football // ford : 2014-11-13 Ford Motor Company ford -// forex : 2014-12-11 IG Group Holdings PLC +// forex : 2014-12-11 Dotforex Registry Limited forex -// forsale : 2014-05-22 +// forsale : 2014-05-22 Dog Beach, LLC forsale // forum : 2015-04-02 Fegistry, LLC forum -// foundation : 2013-12-05 John Dale, LLC +// foundation : 2013-12-05 Binky Moon, LLC foundation // fox : 2015-09-11 FOX Registry, LLC fox -// free : 2015-12-10 Amazon EU S.à r.l. +// free : 2015-12-10 Amazon Registry Services, Inc. free // fresenius : 2015-07-30 Fresenius Immobilien-Verwaltungs-GmbH @@ -8107,22 +8258,25 @@ fujitsu // fujixerox : 2015-07-23 Xerox DNHC LLC fujixerox -// fund : 2014-03-20 John Castle, LLC +// fun : 2016-01-14 DotSpace Inc. +fun + +// fund : 2014-03-20 Binky Moon, LLC fund -// furniture : 2014-03-20 Lone Fields, LLC +// furniture : 2014-03-20 Binky Moon, LLC furniture -// futbol : 2013-09-20 +// futbol : 2013-09-20 Dog Beach, LLC futbol -// fyi : 2015-04-02 Silver Tigers, LLC +// fyi : 2015-04-02 Binky Moon, LLC fyi // gal : 2013-11-07 Asociación puntoGAL gal -// gallery : 2013-09-13 Sugar House, LLC +// gallery : 2013-09-13 Binky Moon, LLC gallery // gallo : 2015-06-11 Gallo Vineyards, Inc. @@ -8131,18 +8285,21 @@ gallo // gallup : 2015-02-19 Gallup, Inc. gallup -// game : 2015-05-28 Uniregistry, Corp. +// game : 2015-05-28 UNR Corp. game -// games : 2015-05-28 Foggy Beach, LLC +// games : 2015-05-28 Dog Beach, LLC games // gap : 2015-07-31 The Gap, Inc. gap -// garden : 2014-06-26 Top Level Domain Holdings Limited +// garden : 2014-06-26 Minds + Machines Group Limited garden +// gay : 2019-05-23 Top Level Design, LLC +gay + // gbiz : 2014-07-17 Charleston Road Registry Inc. gbiz @@ -8152,7 +8309,7 @@ gdn // gea : 2014-12-04 GEA Group Aktiengesellschaft gea -// gent : 2014-01-23 COMBELL GROUP NV/SA +// gent : 2014-01-23 COMBELL NV gent // genting : 2015-03-12 Resorts World Inc Pte. Ltd. @@ -8164,13 +8321,13 @@ george // ggee : 2014-01-09 GMO Internet, Inc. ggee -// gift : 2013-10-17 Uniregistry, Corp. +// gift : 2013-10-17 DotGift, LLC gift -// gifts : 2014-07-03 Goose Sky, LLC +// gifts : 2014-07-03 Binky Moon, LLC gifts -// gives : 2014-03-06 United TLD Holdco Ltd. +// gives : 2014-03-06 Dog Beach, LLC gives // giving : 2014-11-13 Giving Limited @@ -8179,13 +8336,13 @@ giving // glade : 2015-07-23 Johnson Shareholdings, Inc. glade -// glass : 2013-11-07 Black Cover, LLC +// glass : 2013-11-07 Binky Moon, LLC glass // gle : 2014-07-24 Charleston Road Registry Inc. gle -// global : 2014-04-17 Dot GLOBAL AS +// global : 2014-04-17 Dot Global Domain Registry Limited global // globo : 2013-12-19 Globo Comunicação e Participações S.A @@ -8194,6 +8351,9 @@ globo // gmail : 2014-05-01 Charleston Road Registry Inc. gmail +// gmbh : 2016-01-29 Binky Moon, LLC +gmbh + // gmo : 2014-01-09 GMO Internet, Inc. gmo @@ -8203,21 +8363,18 @@ gmx // godaddy : 2015-07-23 Go Daddy East, LLC godaddy -// gold : 2015-01-22 June Edge, LLC +// gold : 2015-01-22 Binky Moon, LLC gold // goldpoint : 2014-11-20 YODOBASHI CAMERA CO.,LTD. goldpoint -// golf : 2014-12-18 Lone falls, LLC +// golf : 2014-12-18 Binky Moon, LLC golf // goo : 2014-12-18 NTT Resonant Inc. goo -// goodhands : 2015-07-31 Allstate Fire and Casualty Insurance Company -goodhands - // goodyear : 2015-07-02 The Goodyear Tire & Rubber Company goodyear @@ -8230,28 +8387,28 @@ google // gop : 2014-01-16 Republican State Leadership Committee, Inc. gop -// got : 2014-12-18 Amazon EU S.à r.l. +// got : 2014-12-18 Amazon Registry Services, Inc. got -// gotv : 2015-03-12 MultiChoice (Proprietary) Limited -gotv - // grainger : 2015-05-07 Grainger Registry Services, LLC grainger -// graphics : 2013-09-13 Over Madison, LLC +// graphics : 2013-09-13 Binky Moon, LLC graphics -// gratis : 2014-03-20 Pioneer Tigers, LLC +// gratis : 2014-03-20 Binky Moon, LLC gratis // green : 2014-05-08 Afilias Limited green -// gripe : 2014-03-06 Corn Sunset, LLC +// gripe : 2014-03-06 Binky Moon, LLC gripe -// group : 2014-08-15 Romeo Town, LLC +// grocery : 2016-06-16 Wal-Mart Stores, Inc. +grocery + +// group : 2014-08-15 Binky Moon, LLC group // guardian : 2015-07-30 The Guardian Life Insurance Company of America @@ -8263,16 +8420,16 @@ gucci // guge : 2014-08-28 Charleston Road Registry Inc. guge -// guide : 2013-09-13 Snow Moon, LLC +// guide : 2013-09-13 Binky Moon, LLC guide -// guitars : 2013-11-14 Uniregistry, Corp. +// guitars : 2013-11-14 UNR Corp. guitars -// guru : 2013-08-27 Pioneer Cypress, LLC +// guru : 2013-08-27 Binky Moon, LLC guru -// hair : 2015-12-03 L'Oréal +// hair : 2015-12-03 XYZ.COM LLC hair // hamburg : 2014-02-20 Hamburg Top-Level-Domain GmbH @@ -8281,7 +8438,7 @@ hamburg // hangout : 2014-11-13 Charleston Road Registry Inc. hangout -// haus : 2013-12-05 +// haus : 2013-12-05 Dog Beach, LLC haus // hbo : 2015-07-30 HBO Registry Services, Inc. @@ -8296,10 +8453,10 @@ hdfcbank // health : 2015-02-11 DotHealth, LLC health -// healthcare : 2014-06-12 Silver Glen, LLC +// healthcare : 2014-06-12 Binky Moon, LLC healthcare -// help : 2014-06-26 Uniregistry, Corp. +// help : 2014-06-26 UNR Corp. help // helsinki : 2015-02-05 City of Helsinki @@ -8314,7 +8471,7 @@ hermes // hgtv : 2015-07-02 Lifestyle Domain Holdings, Inc. hgtv -// hiphop : 2014-03-06 Uniregistry, Corp. +// hiphop : 2014-03-06 UNR Corp. hiphop // hisamitsu : 2015-07-16 Hisamitsu Pharmaceutical Co.,Inc. @@ -8323,22 +8480,22 @@ hisamitsu // hitachi : 2014-10-31 Hitachi, Ltd. hitachi -// hiv : 2014-03-13 +// hiv : 2014-03-13 UNR Corp. hiv // hkt : 2015-05-14 PCCW-HKT DataCom Services Limited hkt -// hockey : 2015-03-19 Half Willow, LLC +// hockey : 2015-03-19 Binky Moon, LLC hockey -// holdings : 2013-08-27 John Madison, LLC +// holdings : 2013-08-27 Binky Moon, LLC holdings -// holiday : 2013-11-07 Goose Woods, LLC +// holiday : 2013-11-07 Binky Moon, LLC holiday -// homedepot : 2015-04-02 Homer TLC, Inc. +// homedepot : 2015-04-02 Home Depot Product Authority, LLC homedepot // homegoods : 2015-07-16 The TJX Companies, Inc. @@ -8353,39 +8510,39 @@ homesense // honda : 2014-12-18 Honda Motor Co., Ltd. honda -// honeywell : 2015-07-23 Honeywell GTLD LLC -honeywell - -// horse : 2013-11-21 Top Level Domain Holdings Limited +// horse : 2013-11-21 Minds + Machines Group Limited horse +// hospital : 2016-10-20 Binky Moon, LLC +hospital + // host : 2014-04-17 DotHost Inc. host -// hosting : 2014-05-29 Uniregistry, Corp. +// hosting : 2014-05-29 UNR Corp. hosting -// hot : 2015-08-27 Amazon EU S.à r.l. +// hot : 2015-08-27 Amazon Registry Services, Inc. hot // hoteles : 2015-03-05 Travel Reservations SRL hoteles +// hotels : 2016-04-07 Booking.com B.V. +hotels + // hotmail : 2014-12-18 Microsoft Corporation hotmail -// house : 2013-11-07 Sugar Park, LLC +// house : 2013-11-07 Binky Moon, LLC house // how : 2014-01-23 Charleston Road Registry Inc. how -// hsbc : 2014-10-24 HSBC Holdings PLC +// hsbc : 2014-10-24 HSBC Global Services (UK) Limited hsbc -// htc : 2015-04-02 HTC corporation -htc - // hughes : 2015-07-30 Hughes Satellite Systems Corporation hughes @@ -8404,7 +8561,7 @@ icbc // ice : 2014-10-30 IntercontinentalExchange, Inc. ice -// icu : 2015-01-08 One.com A/S +// icu : 2015-01-08 ShortDot SA icu // ieee : 2015-07-23 IEEE Global LLC @@ -8413,25 +8570,25 @@ ieee // ifm : 2014-01-30 ifm electronic gmbh ifm -// iinet : 2014-07-03 Connect West Pty. Ltd. -iinet - // ikano : 2015-07-09 Ikano S.A. ikano // imamat : 2015-08-06 Fondation Aga Khan (Aga Khan Foundation) imamat -// imdb : 2015-06-25 Amazon EU S.à r.l. +// imdb : 2015-06-25 Amazon Registry Services, Inc. imdb -// immo : 2014-07-10 Auburn Bloom, LLC +// immo : 2014-07-10 Binky Moon, LLC immo -// immobilien : 2013-11-07 United TLD Holdco Ltd. +// immobilien : 2013-11-07 Dog Beach, LLC immobilien -// industries : 2013-12-05 Outer House, LLC +// inc : 2018-03-10 Intercap Registry Inc. +inc + +// industries : 2013-12-05 Binky Moon, LLC industries // infiniti : 2014-03-27 NISSAN MOTOR CO., LTD. @@ -8443,36 +8600,30 @@ ing // ink : 2013-12-05 Top Level Design, LLC ink -// institute : 2013-11-07 Outer Maple, LLC +// institute : 2013-11-07 Binky Moon, LLC institute // insurance : 2015-02-19 fTLD Registry Services LLC insurance -// insure : 2014-03-20 Pioneer Willow, LLC +// insure : 2014-03-20 Binky Moon, LLC insure -// intel : 2015-08-06 Intel Corporation -intel - -// international : 2013-11-07 Wild Way, LLC +// international : 2013-11-07 Binky Moon, LLC international // intuit : 2015-07-30 Intuit Administrative Services, Inc. intuit -// investments : 2014-03-20 Holly Glen, LLC +// investments : 2014-03-20 Binky Moon, LLC investments // ipiranga : 2014-08-28 Ipiranga Produtos de Petroleo S.A. ipiranga -// irish : 2014-08-07 Dot-Irish LLC +// irish : 2014-08-07 Binky Moon, LLC irish -// iselect : 2015-02-11 iSelect Ltd -iselect - // ismaili : 2015-08-06 Fondation Aga Khan (Aga Khan Foundation) ismaili @@ -8491,9 +8642,6 @@ itv // iveco : 2015-09-03 CNH Industrial N.V. iveco -// iwc : 2014-06-23 Richemont DNS Inc. -iwc - // jaguar : 2014-11-13 Jaguar Land Rover Ltd jaguar @@ -8509,18 +8657,15 @@ jcp // jeep : 2015-07-30 FCA US LLC. jeep -// jetzt : 2014-01-09 New TLD Company AB +// jetzt : 2014-01-09 Binky Moon, LLC jetzt -// jewelry : 2015-03-05 Wild Bloom, LLC +// jewelry : 2015-03-05 Binky Moon, LLC jewelry -// jio : 2015-04-02 Affinity Names, Inc. +// jio : 2015-04-02 Reliance Industries Limited jio -// jlc : 2014-12-04 Richemont DNS Inc. -jlc - // jll : 2015-04-02 Jones Lang LaSalle Incorporated jll @@ -8533,25 +8678,25 @@ jnj // joburg : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry joburg -// jot : 2014-12-18 Amazon EU S.à r.l. +// jot : 2014-12-18 Amazon Registry Services, Inc. jot -// joy : 2014-12-18 Amazon EU S.à r.l. +// joy : 2014-12-18 Amazon Registry Services, Inc. joy -// jpmorgan : 2015-04-30 JPMorgan Chase & Co. +// jpmorgan : 2015-04-30 JPMorgan Chase Bank, National Association jpmorgan // jprs : 2014-09-18 Japan Registry Services Co., Ltd. jprs -// juegos : 2014-03-20 Uniregistry, Corp. +// juegos : 2014-03-20 UNR Corp. juegos // juniper : 2015-07-30 JUNIPER NETWORKS, INC. juniper -// kaufen : 2013-11-07 United TLD Holdco Ltd. +// kaufen : 2013-11-07 Dog Beach, LLC kaufen // kddi : 2014-09-12 KDDI CORPORATION @@ -8578,16 +8723,16 @@ kim // kinder : 2014-11-07 Ferrero Trading Lux S.A. kinder -// kindle : 2015-06-25 Amazon EU S.à r.l. +// kindle : 2015-06-25 Amazon Registry Services, Inc. kindle -// kitchen : 2013-09-20 Just Goodbye, LLC +// kitchen : 2013-09-20 Binky Moon, LLC kitchen // kiwi : 2013-09-20 DOT KIWI LIMITED kiwi -// koeln : 2014-01-09 NetCologne Gesellschaft für Telekommunikation mbH +// koeln : 2014-01-09 dotKoeln GmbH koeln // komatsu : 2015-01-08 Komatsu Ltd. @@ -8611,18 +8756,12 @@ kred // kuokgroup : 2015-04-09 Kerry Trading Co. Limited kuokgroup -// kyknet : 2015-03-05 Electronic Media Network (Pty) Ltd -kyknet - // kyoto : 2014-11-07 Academic Institution: Kyoto Jyoho Gakuen kyoto -// lacaixa : 2014-01-09 CAIXA D'ESTALVIS I PENSIONS DE BARCELONA +// lacaixa : 2014-01-09 Fundación Bancaria Caixa d’Estalvis i Pensions de Barcelona, “la Caixa” lacaixa -// ladbrokes : 2015-08-06 LADBROKES INTERNATIONAL PLC -ladbrokes - // lamborghini : 2015-06-04 Automobili Lamborghini S.p.A. lamborghini @@ -8635,10 +8774,7 @@ lancaster // lancia : 2015-07-31 Fiat Chrysler Automobiles N.V. lancia -// lancome : 2015-07-23 L'Oréal -lancome - -// land : 2013-09-10 Pine Moon, LLC +// land : 2013-09-10 Binky Moon, LLC land // landrover : 2014-11-13 Jaguar Land Rover Ltd @@ -8659,16 +8795,16 @@ latino // latrobe : 2014-06-16 La Trobe University latrobe -// law : 2015-01-22 Minds + Machines Group Limited +// law : 2015-01-22 LW TLD Limited law -// lawyer : 2014-03-20 +// lawyer : 2014-03-20 Dog Beach, LLC lawyer -// lds : 2014-03-20 IRI Domain Management, LLC ("Applicant") +// lds : 2014-03-20 IRI Domain Management, LLC lds -// lease : 2014-03-06 Victor Trail, LLC +// lease : 2014-03-06 Binky Moon, LLC lease // leclerc : 2014-08-07 A.C.D. LEC Association des Centres Distributeurs Edouard Leclerc @@ -8677,7 +8813,7 @@ leclerc // lefrak : 2015-07-16 LeFrak Organization, Inc. lefrak -// legal : 2014-10-16 Blue Falls, LLC +// legal : 2014-10-16 Binky Moon, LLC legal // lego : 2015-07-16 LEGO Juris A/S @@ -8689,13 +8825,10 @@ lexus // lgbt : 2014-05-08 Afilias Limited lgbt -// liaison : 2014-10-02 Liaison Technologies, Incorporated -liaison - // lidl : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG lidl -// life : 2014-02-06 Trixy Oaks, LLC +// life : 2014-02-06 Binky Moon, LLC life // lifeinsurance : 2015-01-15 American Council of Life Insurers @@ -8704,19 +8837,19 @@ lifeinsurance // lifestyle : 2014-12-11 Lifestyle Domain Holdings, Inc. lifestyle -// lighting : 2013-08-27 John McCook, LLC +// lighting : 2013-08-27 Binky Moon, LLC lighting -// like : 2014-12-18 Amazon EU S.à r.l. +// like : 2014-12-18 Amazon Registry Services, Inc. like // lilly : 2015-07-31 Eli Lilly and Company lilly -// limited : 2014-03-06 Big Fest, LLC +// limited : 2014-03-06 Binky Moon, LLC limited -// limo : 2013-10-17 Hidden Frostbite, LLC +// limo : 2013-10-17 Binky Moon, LLC limo // lincoln : 2014-11-13 Ford Motor Company @@ -8725,13 +8858,13 @@ lincoln // linde : 2014-12-04 Linde Aktiengesellschaft linde -// link : 2013-11-14 Uniregistry, Corp. +// link : 2013-11-14 UNR Corp. link // lipsy : 2015-06-25 Lipsy Ltd lipsy -// live : 2014-12-04 +// live : 2014-12-04 Dog Beach, LLC live // living : 2015-07-30 Lifestyle Domain Holdings, Inc. @@ -8740,10 +8873,16 @@ living // lixil : 2015-03-19 LIXIL Group Corporation lixil +// llc : 2017-12-14 Afilias Limited +llc + +// llp : 2019-08-26 UNR Corp. +llp + // loan : 2014-11-20 dot Loan Limited loan -// loans : 2014-03-20 June Woods, LLC +// loans : 2014-03-20 Binky Moon, LLC loans // locker : 2015-06-04 Dish DBS Corporation @@ -8755,7 +8894,7 @@ locus // loft : 2015-07-30 Annco, Inc. loft -// lol : 2015-01-30 Uniregistry, Corp. +// lol : 2015-01-30 UNR Corp. lol // london : 2013-11-14 Dot London Domains Limited @@ -8776,10 +8915,10 @@ lpl // lplfinancial : 2015-07-30 LPL Holdings, Inc. lplfinancial -// ltd : 2014-09-25 Over Corner, LLC +// ltd : 2014-09-25 Binky Moon, LLC ltd -// ltda : 2014-04-17 DOMAIN ROBOT SERVICOS DE HOSPEDAGEM NA INTERNET LTDA +// ltda : 2014-04-17 InterNetX, Corp ltda // lundbeck : 2015-08-06 H. Lundbeck A/S @@ -8788,7 +8927,7 @@ lundbeck // lupin : 2014-11-07 LUPIN LIMITED lupin -// luxe : 2014-01-09 Top Level Domain Holdings Limited +// luxe : 2014-01-09 Minds + Machines Group Limited luxe // luxury : 2013-10-17 Luxury Partners, LLC @@ -8803,28 +8942,31 @@ madrid // maif : 2014-10-02 Mutuelle Assurance Instituteur France (MAIF) maif -// maison : 2013-12-05 Victor Frostbite, LLC +// maison : 2013-12-05 Binky Moon, LLC maison -// makeup : 2015-01-15 L'Oréal +// makeup : 2015-01-15 XYZ.COM LLC makeup // man : 2014-12-04 MAN SE man -// management : 2013-11-07 John Goodbye, LLC +// management : 2013-11-07 Binky Moon, LLC management // mango : 2013-10-24 PUNTO FA S.L. mango -// market : 2014-03-06 +// map : 2016-06-09 Charleston Road Registry Inc. +map + +// market : 2014-03-06 Dog Beach, LLC market -// marketing : 2013-11-07 Fern Pass, LLC +// marketing : 2013-11-07 Binky Moon, LLC marketing -// markets : 2014-12-11 IG Group Holdings PLC +// markets : 2014-12-11 Dotmarkets Registry Limited markets // marriott : 2014-10-09 Marriott Worldwide Corporation @@ -8839,25 +8981,19 @@ maserati // mattel : 2015-08-06 Mattel Sites, Inc. mattel -// mba : 2015-04-02 Lone Hollow, LLC +// mba : 2015-04-02 Binky Moon, LLC mba -// mcd : 2015-07-30 McDonald’s Corporation -mcd - -// mcdonalds : 2015-07-30 McDonald’s Corporation -mcdonalds - // mckinsey : 2015-07-31 McKinsey Holdings, Inc. mckinsey // med : 2015-08-06 Medistry LLC med -// media : 2014-03-06 Grand Glen, LLC +// media : 2014-03-06 Binky Moon, LLC media -// meet : 2014-01-16 +// meet : 2014-01-16 Charleston Road Registry Inc. meet // melbourne : 2014-05-29 The Crown in right of the State of Victoria, represented by its Department of State Development, Business and Innovation @@ -8872,16 +9008,13 @@ memorial // men : 2015-02-26 Exclusive Registry Limited men -// menu : 2013-09-11 Wedding TLD2, LLC +// menu : 2013-09-11 Dot Menu Registry, LLC menu -// meo : 2014-11-07 PT Comunicacoes S.A. -meo +// merckmsd : 2016-07-14 MSD Registry Holdings, Inc. +merckmsd -// metlife : 2015-05-07 MetLife Services and Solutions, LLC -metlife - -// miami : 2013-12-19 Top Level Domain Holdings Limited +// miami : 2013-12-19 Minds + Machines Group Limited miami // microsoft : 2014-12-18 Microsoft Corporation @@ -8908,49 +9041,40 @@ mls // mma : 2014-11-07 MMA IARD mma -// mnet : 2015-03-05 Electronic Media Network (Pty) Ltd -mnet - -// mobily : 2014-12-18 GreenTech Consultancy Company W.L.L. -mobily +// mobile : 2016-06-02 Dish DBS Corporation +mobile -// moda : 2013-11-07 United TLD Holdco Ltd. +// moda : 2013-11-07 Dog Beach, LLC moda // moe : 2013-11-13 Interlink Co., Ltd. moe -// moi : 2014-12-18 Amazon EU S.à r.l. +// moi : 2014-12-18 Amazon Registry Services, Inc. moi -// mom : 2015-04-16 Uniregistry, Corp. +// mom : 2015-04-16 UNR Corp. mom // monash : 2013-09-30 Monash University monash -// money : 2014-10-16 Outer McCook, LLC +// money : 2014-10-16 Binky Moon, LLC money -// monster : 2015-09-11 Monster Worldwide, Inc. +// monster : 2015-09-11 XYZ.COM LLC monster -// montblanc : 2014-06-23 Richemont DNS Inc. -montblanc - -// mopar : 2015-07-30 FCA US LLC. -mopar - -// mormon : 2013-12-05 IRI Domain Management, LLC ("Applicant") +// mormon : 2013-12-05 IRI Domain Management, LLC mormon -// mortgage : 2014-03-20 +// mortgage : 2014-03-20 Dog Beach, LLC mortgage // moscow : 2013-12-19 Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID) moscow -// moto : 2015-06-04 Charleston Road Registry Inc. +// moto : 2015-06-04 Motorola Trademark Holdings, LLC moto // motorcycles : 2014-01-09 DERMotorcycles, LLC @@ -8959,55 +9083,34 @@ motorcycles // mov : 2014-01-30 Charleston Road Registry Inc. mov -// movie : 2015-02-05 New Frostbite, LLC +// movie : 2015-02-05 Binky Moon, LLC movie -// movistar : 2014-10-16 Telefónica S.A. -movistar - // msd : 2015-07-23 MSD Registry Holdings, Inc. msd // mtn : 2014-12-04 MTN Dubai Limited mtn -// mtpc : 2014-11-20 Mitsubishi Tanabe Pharma Corporation -mtpc - // mtr : 2015-03-12 MTR Corporation Limited mtr -// multichoice : 2015-03-12 MultiChoice (Proprietary) Limited -multichoice - // mutual : 2015-04-02 Northwestern Mutual MU TLD Registry, LLC mutual -// mutuelle : 2015-06-18 Fédération Nationale de la Mutualité Française -mutuelle - -// mzansimagic : 2015-03-05 Electronic Media Network (Pty) Ltd -mzansimagic - // nab : 2015-08-20 National Australia Bank Limited nab -// nadex : 2014-12-11 IG Group Holdings PLC -nadex - // nagoya : 2013-10-24 GMO Registry, Inc. nagoya -// naspers : 2015-02-12 Intelprop (Proprietary) Limited -naspers - // nationwide : 2015-07-23 Nationwide Mutual Insurance Company nationwide // natura : 2015-03-12 NATURA COSMÉTICOS S.A. natura -// navy : 2014-03-06 United TLD Holdco Ltd. +// navy : 2014-03-06 Dog Beach, LLC navy // nba : 2015-07-31 NBA REGISTRY, LLC @@ -9022,7 +9125,7 @@ netbank // netflix : 2015-06-18 Netflix, Inc. netflix -// network : 2013-11-14 Trixy Manor, LLC +// network : 2013-11-14 Binky Moon, LLC network // neustar : 2013-12-05 NeuStar, Inc. @@ -9034,7 +9137,7 @@ new // newholland : 2015-09-03 CNH Industrial N.V. newholland -// news : 2014-12-18 +// news : 2014-12-18 Dog Beach, LLC news // next : 2015-06-18 Next plc @@ -9064,7 +9167,7 @@ nike // nikon : 2015-05-21 NIKON CORPORATION nikon -// ninja : 2013-11-07 United TLD Holdco Ltd. +// ninja : 2013-11-07 Dog Beach, LLC ninja // nissan : 2014-03-27 NISSAN MOTOR CO., LTD. @@ -9079,10 +9182,10 @@ nokia // northwesternmutual : 2015-06-18 Northwestern Mutual Registry, LLC northwesternmutual -// norton : 2014-12-04 Symantec Corporation +// norton : 2014-12-04 NortonLifeLock Inc. norton -// now : 2015-06-25 Amazon EU S.à r.l. +// now : 2015-06-25 Amazon Registry Services, Inc. now // nowruz : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. @@ -9106,7 +9209,7 @@ nyc // obi : 2014-09-25 OBI Group Holding SE & Co. KGaA obi -// observer : 2015-04-30 Guardian News and Media Limited +// observer : 2015-04-30 Top Level Spectrum, Inc. observer // off : 2015-07-23 Johnson Shareholdings, Inc. @@ -9115,7 +9218,7 @@ off // office : 2015-03-12 Microsoft Corporation office -// okinawa : 2013-12-05 BusinessRalliart Inc. +// okinawa : 2013-12-05 BRregistry, Inc. okinawa // olayan : 2015-05-14 Crescent Holding GmbH @@ -9148,7 +9251,7 @@ online // onyourside : 2015-07-23 Nationwide Mutual Insurance Company onyourside -// ooo : 2014-01-09 INFIBEAM INCORPORATION LIMITED +// ooo : 2014-01-09 INFIBEAM AVENUES LIMITED ooo // open : 2015-07-31 American Express Travel Related Services Company, Inc. @@ -9163,13 +9266,10 @@ orange // organic : 2014-03-27 Afilias Limited organic -// orientexpress : 2015-02-05 Belmond Ltd. -orientexpress - // origins : 2015-10-01 The Estée Lauder Companies Inc. origins -// osaka : 2014-09-04 Interlink Co., Ltd. +// osaka : 2014-09-04 Osaka Registry Co., Ltd. osaka // otsuka : 2013-10-11 Otsuka Holdings Co., Ltd. @@ -9178,31 +9278,25 @@ otsuka // ott : 2015-06-04 Dish DBS Corporation ott -// ovh : 2014-01-16 OVH SAS +// ovh : 2014-01-16 MédiaBC ovh // page : 2014-12-04 Charleston Road Registry Inc. page -// pamperedchef : 2015-02-05 The Pampered Chef, Ltd. -pamperedchef - // panasonic : 2015-07-30 Panasonic Corporation panasonic -// panerai : 2014-11-07 Richemont DNS Inc. -panerai - // paris : 2014-01-30 City of Paris paris // pars : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. pars -// partners : 2013-12-05 Magic Glen, LLC +// partners : 2013-12-05 Binky Moon, LLC partners -// parts : 2013-12-05 Sea Goodbye, LLC +// parts : 2013-12-05 Binky Moon, LLC parts // party : 2014-09-11 Blue Sky Registry Limited @@ -9211,16 +9305,13 @@ party // passagens : 2015-03-05 Travel Reservations SRL passagens -// pay : 2015-08-27 Amazon EU S.à r.l. +// pay : 2015-08-27 Amazon Registry Services, Inc. pay -// payu : 2015-02-12 MIH PayU B.V. -payu - // pccw : 2015-05-14 PCCW Enterprises Limited pccw -// pet : 2015-05-07 Afilias plc +// pet : 2015-05-07 Afilias Limited pet // pfizer : 2015-09-11 Pfizer Inc. @@ -9229,37 +9320,40 @@ pfizer // pharmacy : 2014-06-19 National Association of Boards of Pharmacy pharmacy +// phd : 2016-07-28 Charleston Road Registry Inc. +phd + // philips : 2014-11-07 Koninklijke Philips N.V. philips -// photo : 2013-11-14 Uniregistry, Corp. +// phone : 2016-06-02 Dish DBS Corporation +phone + +// photo : 2013-11-14 UNR Corp. photo -// photography : 2013-09-20 Sugar Glen, LLC +// photography : 2013-09-20 Binky Moon, LLC photography -// photos : 2013-10-17 Sea Corner, LLC +// photos : 2013-10-17 Binky Moon, LLC photos // physio : 2014-05-01 PhysBiz Pty Ltd physio -// piaget : 2014-10-16 Richemont DNS Inc. -piaget - -// pics : 2013-11-14 Uniregistry, Corp. +// pics : 2013-11-14 UNR Corp. pics // pictet : 2014-06-26 Pictet Europe S.A. pictet -// pictures : 2014-03-06 Foggy Sky, LLC +// pictures : 2014-03-06 Binky Moon, LLC pictures // pid : 2015-01-08 Top Level Spectrum, Inc. pid -// pin : 2014-12-18 Amazon EU S.à r.l. +// pin : 2014-12-18 Amazon Registry Services, Inc. pin // ping : 2015-06-11 Ping Registry Provider, Inc. @@ -9271,22 +9365,22 @@ pink // pioneer : 2015-07-16 Pioneer Corporation pioneer -// pizza : 2014-06-26 Foggy Moon, LLC +// pizza : 2014-06-26 Binky Moon, LLC pizza -// place : 2014-04-24 Snow Galley, LLC +// place : 2014-04-24 Binky Moon, LLC place // play : 2015-03-05 Charleston Road Registry Inc. play -// playstation : 2015-07-02 Sony Computer Entertainment Inc. +// playstation : 2015-07-02 Sony Interactive Entertainment Inc. playstation -// plumbing : 2013-09-10 Spring Tigers, LLC +// plumbing : 2013-09-10 Binky Moon, LLC plumbing -// plus : 2015-02-05 Sugar Mill, LLC +// plus : 2015-02-05 Binky Moon, LLC plus // pnc : 2015-07-02 PNC Domain Co., LLC @@ -9295,7 +9389,7 @@ pnc // pohl : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG pohl -// poker : 2014-07-03 Afilias Domains No. 5 Limited +// poker : 2014-07-03 Afilias Limited poker // politie : 2015-08-20 Politie Nederland @@ -9313,13 +9407,13 @@ praxi // press : 2014-04-03 DotPress Inc. press -// prime : 2015-06-25 Amazon EU S.à r.l. +// prime : 2015-06-25 Amazon Registry Services, Inc. prime // prod : 2014-01-23 Charleston Road Registry Inc. prod -// productions : 2013-12-05 Magic Birch, LLC +// productions : 2013-12-05 Binky Moon, LLC productions // prof : 2014-07-24 Charleston Road Registry Inc. @@ -9328,16 +9422,16 @@ prof // progressive : 2015-07-23 Progressive Casualty Insurance Company progressive -// promo : 2014-12-18 +// promo : 2014-12-18 Afilias Limited promo -// properties : 2013-12-05 Big Pass, LLC +// properties : 2013-12-05 Binky Moon, LLC properties -// property : 2014-05-22 Uniregistry, Corp. +// property : 2014-05-22 UNR Corp. property -// protection : 2015-04-23 +// protection : 2015-04-23 XYZ.COM LLC protection // pru : 2015-07-30 Prudential Financial, Inc. @@ -9346,7 +9440,7 @@ pru // prudential : 2015-07-30 Prudential Financial, Inc. prudential -// pub : 2013-12-12 United TLD Holdco Ltd. +// pub : 2013-12-12 Dog Beach, LLC pub // pwc : 2015-10-29 PricewaterhouseCoopers LLP @@ -9358,7 +9452,7 @@ qpon // quebec : 2013-12-19 PointQuébec Inc quebec -// quest : 2015-03-26 Quest ION Limited +// quest : 2015-03-26 XYZ.COM LLC quest // qvc : 2015-07-30 QVC, Inc. @@ -9367,10 +9461,13 @@ qvc // racing : 2014-12-04 Premier Registry Limited racing +// radio : 2016-07-21 European Broadcasting Union (EBU) +radio + // raid : 2015-07-23 Johnson Shareholdings, Inc. raid -// read : 2014-12-18 Amazon EU S.à r.l. +// read : 2014-12-18 Amazon Registry Services, Inc. read // realestate : 2015-09-11 dotRealEstate LLC @@ -9382,7 +9479,7 @@ realtor // realty : 2015-03-19 Fegistry, LLC realty -// recipes : 2013-10-17 Grand Island, LLC +// recipes : 2013-10-17 Binky Moon, LLC recipes // red : 2013-11-07 Afilias Limited @@ -9394,13 +9491,13 @@ redstone // redumbrella : 2015-03-26 Travelers TLD, LLC redumbrella -// rehab : 2014-03-06 United TLD Holdco Ltd. +// rehab : 2014-03-06 Dog Beach, LLC rehab -// reise : 2014-03-13 +// reise : 2014-03-13 Binky Moon, LLC reise -// reisen : 2014-03-06 New Cypress, LLC +// reisen : 2014-03-06 Binky Moon, LLC reisen // reit : 2014-09-04 National Association of Real Estate Investment Trusts, Inc. @@ -9409,34 +9506,34 @@ reit // reliance : 2015-04-02 Reliance Industries Limited reliance -// ren : 2013-12-12 Beijing Qianxiang Wangjing Technology Development Co., Ltd. +// ren : 2013-12-12 ZDNS International Limited ren -// rent : 2014-12-04 DERRent, LLC +// rent : 2014-12-04 XYZ.COM LLC rent -// rentals : 2013-12-05 Big Hollow,LLC +// rentals : 2013-12-05 Binky Moon, LLC rentals -// repair : 2013-11-07 Lone Sunset, LLC +// repair : 2013-11-07 Binky Moon, LLC repair -// report : 2013-12-05 Binky Glen, LLC +// report : 2013-12-05 Binky Moon, LLC report -// republican : 2014-03-20 United TLD Holdco Ltd. +// republican : 2014-03-20 Dog Beach, LLC republican // rest : 2013-12-19 Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable rest -// restaurant : 2014-07-03 Snow Avenue, LLC +// restaurant : 2014-07-03 Binky Moon, LLC restaurant // review : 2014-11-20 dot Review Limited review -// reviews : 2013-09-13 +// reviews : 2013-09-13 Dog Beach, LLC reviews // rexroth : 2015-06-18 Robert Bosch GMBH @@ -9451,16 +9548,13 @@ richardli // ricoh : 2014-11-20 Ricoh Company, Ltd. ricoh -// rightathome : 2015-07-23 Johnson Shareholdings, Inc. -rightathome - // ril : 2015-04-02 Reliance Industries Limited ril // rio : 2014-02-27 Empresa Municipal de Informática SA - IPLANRIO rio -// rip : 2014-07-10 United TLD Holdco Ltd. +// rip : 2014-07-10 Dog Beach, LLC rip // rmit : 2015-11-19 Royal Melbourne Institute of Technology @@ -9469,37 +9563,40 @@ rmit // rocher : 2014-12-18 Ferrero Trading Lux S.A. rocher -// rocks : 2013-11-14 +// rocks : 2013-11-14 Dog Beach, LLC rocks -// rodeo : 2013-12-19 Top Level Domain Holdings Limited +// rodeo : 2013-12-19 Minds + Machines Group Limited rodeo -// rogers : 2015-08-06 Rogers Communications Partnership +// rogers : 2015-08-06 Rogers Communications Canada Inc. rogers -// room : 2014-12-18 Amazon EU S.à r.l. +// room : 2014-12-18 Amazon Registry Services, Inc. room // rsvp : 2014-05-08 Charleston Road Registry Inc. rsvp +// rugby : 2016-12-15 World Rugby Strategic Developments Limited +rugby + // ruhr : 2013-10-02 regiodot GmbH & Co. KG ruhr -// run : 2015-03-19 Snow Park, LLC +// run : 2015-03-19 Binky Moon, LLC run // rwe : 2015-04-02 RWE AG rwe -// ryukyu : 2014-01-09 BusinessRalliart Inc. +// ryukyu : 2014-01-09 BRregistry, Inc. ryukyu // saarland : 2013-12-12 dotSaarland GmbH saarland -// safe : 2014-12-18 Amazon EU S.à r.l. +// safe : 2014-12-18 Amazon Registry Services, Inc. safe // safety : 2015-01-08 Safety Registry Services, LLC. @@ -9508,10 +9605,10 @@ safety // sakura : 2014-12-18 SAKURA Internet Inc. sakura -// sale : 2014-10-16 +// sale : 2014-10-16 Dog Beach, LLC sale -// salon : 2014-12-11 Outer Orchard, LLC +// salon : 2014-12-11 Binky Moon, LLC salon // samsclub : 2015-07-31 Wal-Mart Stores, Inc. @@ -9532,16 +9629,13 @@ sanofi // sap : 2014-03-27 SAP AG sap -// sapo : 2014-11-07 PT Comunicacoes S.A. -sapo - -// sarl : 2014-07-03 Delta Orchard, LLC +// sarl : 2014-07-03 Binky Moon, LLC sarl // sas : 2015-04-02 Research IP LLC sas -// save : 2015-06-25 Amazon EU S.à r.l. +// save : 2015-06-25 Amazon Registry Services, Inc. save // saxo : 2014-10-31 Saxo Bank A/S @@ -9562,16 +9656,16 @@ scb // schaeffler : 2015-08-06 Schaeffler Technologies AG & Co. KG schaeffler -// schmidt : 2014-04-03 SALM S.A.S. +// schmidt : 2014-04-03 SCHMIDT GROUPE S.A.S. schmidt // scholarships : 2014-04-24 Scholarships.com, LLC scholarships -// school : 2014-12-18 Little Galley, LLC +// school : 2014-12-18 Binky Moon, LLC school -// schule : 2014-03-06 Outer Moon, LLC +// schule : 2014-03-06 Binky Moon, LLC schule // schwarz : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG @@ -9583,31 +9677,31 @@ science // scjohnson : 2015-07-23 Johnson Shareholdings, Inc. scjohnson -// scor : 2014-10-31 SCOR SE -scor - // scot : 2014-01-23 Dot Scot Registry Limited scot +// search : 2016-06-09 Charleston Road Registry Inc. +search + // seat : 2014-05-22 SEAT, S.A. (Sociedad Unipersonal) seat -// secure : 2015-08-27 Amazon EU S.à r.l. +// secure : 2015-08-27 Amazon Registry Services, Inc. secure -// security : 2015-05-14 +// security : 2015-05-14 XYZ.COM LLC security // seek : 2014-12-04 Seek Limited seek -// select : 2015-10-08 iSelect Ltd +// select : 2015-10-08 Registry Services, LLC select // sener : 2014-10-24 Sener Ingeniería y Sistemas, S.A. sener -// services : 2014-02-27 Fox Castle, LLC +// services : 2014-02-27 Binky Moon, LLC services // ses : 2015-07-23 SES @@ -9622,7 +9716,7 @@ sew // sex : 2014-11-13 ICM Registry SX LLC sex -// sexy : 2013-09-11 Uniregistry, Corp. +// sexy : 2013-09-11 UNR Corp. sexy // sfr : 2015-08-13 Societe Francaise du Radiotelephone - SFR @@ -9646,13 +9740,19 @@ shia // shiksha : 2013-11-14 Afilias Limited shiksha -// shoes : 2013-10-02 Binky Galley, LLC +// shoes : 2013-10-02 Binky Moon, LLC shoes -// shouji : 2015-01-08 QIHOO 360 TECHNOLOGY CO. LTD. +// shop : 2016-04-08 GMO Registry, Inc. +shop + +// shopping : 2016-03-31 Binky Moon, LLC +shopping + +// shouji : 2015-01-08 Beijing Qihu Keji Co., Ltd. shouji -// show : 2015-03-05 Snow Beach, LLC +// show : 2015-03-05 Binky Moon, LLC show // showtime : 2015-08-06 CBS Domains Inc. @@ -9661,64 +9761,64 @@ showtime // shriram : 2014-01-23 Shriram Capital Ltd. shriram -// silk : 2015-06-25 Amazon EU S.à r.l. +// silk : 2015-06-25 Amazon Registry Services, Inc. silk // sina : 2015-03-12 Sina Corporation sina -// singles : 2013-08-27 Fern Madison, LLC +// singles : 2013-08-27 Binky Moon, LLC singles // site : 2015-01-15 DotSite Inc. site -// ski : 2015-04-09 STARTING DOT LIMITED +// ski : 2015-04-09 Afilias Limited ski -// skin : 2015-01-15 L'Oréal +// skin : 2015-01-15 XYZ.COM LLC skin -// sky : 2014-06-19 Sky IP International Ltd, a company incorporated in England and Wales, operating via its registered Swiss branch +// sky : 2014-06-19 Sky International AG sky // skype : 2014-12-18 Microsoft Corporation skype -// sling : 2015-07-30 Hughes Satellite Systems Corporation +// sling : 2015-07-30 DISH Technologies L.L.C. sling // smart : 2015-07-09 Smart Communications, Inc. (SMART) smart -// smile : 2014-12-18 Amazon EU S.à r.l. +// smile : 2014-12-18 Amazon Registry Services, Inc. smile // sncf : 2015-02-19 Société Nationale des Chemins de fer Francais S N C F sncf -// soccer : 2015-03-26 Foggy Shadow, LLC +// soccer : 2015-03-26 Binky Moon, LLC soccer -// social : 2013-11-07 United TLD Holdco Ltd. +// social : 2013-11-07 Dog Beach, LLC social -// softbank : 2015-07-02 SoftBank Corp. +// softbank : 2015-07-02 SoftBank Group Corp. softbank -// software : 2014-03-20 +// software : 2014-03-20 Dog Beach, LLC software // sohu : 2013-12-19 Sohu.com Limited sohu -// solar : 2013-11-07 Ruby Town, LLC +// solar : 2013-11-07 Binky Moon, LLC solar -// solutions : 2013-11-07 Silver Cover, LLC +// solutions : 2013-11-07 Binky Moon, LLC solutions -// song : 2015-02-26 Amazon EU S.à r.l. +// song : 2015-02-26 Amazon Registry Services, Inc. song // sony : 2015-01-08 Sony Corporation @@ -9727,24 +9827,24 @@ sony // soy : 2014-01-23 Charleston Road Registry Inc. soy +// spa : 2019-09-19 Asia Spa and Wellness Promotion Council Limited +spa + // space : 2014-04-03 DotSpace Inc. space -// spiegel : 2014-02-05 SPIEGEL-Verlag Rudolf Augstein GmbH & Co. KG -spiegel +// sport : 2017-11-16 Global Association of International Sports Federations (GAISF) +sport -// spot : 2015-02-26 Amazon EU S.à r.l. +// spot : 2015-02-26 Amazon Registry Services, Inc. spot -// spreadbetting : 2014-12-11 IG Group Holdings PLC +// spreadbetting : 2014-12-11 Dotspreadbetting Registry Limited spreadbetting -// srl : 2015-05-07 mySRL GmbH +// srl : 2015-05-07 InterNetX, Corp srl -// srt : 2015-07-30 FCA US LLC. -srt - // stada : 2014-11-13 STADA Arzneimittel AG stada @@ -9754,18 +9854,12 @@ staples // star : 2015-01-08 Star India Private Limited star -// starhub : 2015-02-05 StarHub Ltd -starhub - // statebank : 2015-03-12 STATE BANK OF INDIA statebank // statefarm : 2015-07-30 State Farm Mutual Automobile Insurance Company statefarm -// statoil : 2014-12-04 Statoil ASA -statoil - // stc : 2014-10-09 Saudi Telecom Company stc @@ -9775,13 +9869,16 @@ stcgroup // stockholm : 2014-12-18 Stockholms kommun stockholm -// storage : 2014-12-22 Self Storage Company LLC +// storage : 2014-12-22 XYZ.COM LLC storage // store : 2015-04-09 DotStore Inc. store -// studio : 2015-02-11 +// stream : 2016-01-08 dot Stream Limited +stream + +// studio : 2015-02-11 Dog Beach, LLC studio // study : 2014-12-11 OPEN UNIVERSITIES AUSTRALIA PTY LTD @@ -9790,25 +9887,22 @@ study // style : 2014-12-04 Binky Moon, LLC style -// sucks : 2014-12-22 Vox Populi Registry Inc. +// sucks : 2014-12-22 Vox Populi Registry Ltd. sucks -// supersport : 2015-03-05 SuperSport International Holdings Proprietary Limited -supersport - -// supplies : 2013-12-19 Atomic Fields, LLC +// supplies : 2013-12-19 Binky Moon, LLC supplies -// supply : 2013-12-19 Half Falls, LLC +// supply : 2013-12-19 Binky Moon, LLC supply -// support : 2013-10-24 Grand Orchard, LLC +// support : 2013-10-24 Binky Moon, LLC support -// surf : 2014-01-09 Top Level Domain Holdings Limited +// surf : 2014-01-09 Minds + Machines Group Limited surf -// surgery : 2014-03-20 Tin Avenue, LLC +// surgery : 2014-03-20 Binky Moon, LLC surgery // suzuki : 2014-02-20 SUZUKI MOTOR CORPORATION @@ -9826,10 +9920,7 @@ swiss // sydney : 2014-09-18 State of New South Wales, Department of Premier and Cabinet sydney -// symantec : 2014-12-04 Symantec Corporation -symantec - -// systems : 2013-11-07 Dash Cypress, LLC +// systems : 2013-11-07 Binky Moon, LLC systems // tab : 2014-12-04 Tabcorp Holdings Limited @@ -9838,7 +9929,7 @@ tab // taipei : 2014-07-10 Taipei City Government taipei -// talk : 2015-04-09 Amazon EU S.à r.l. +// talk : 2015-04-09 Amazon Registry Services, Inc. talk // taobao : 2015-01-15 Alibaba Group Holding Limited @@ -9853,13 +9944,13 @@ tatamotors // tatar : 2014-04-24 Limited Liability Company "Coordination Center of Regional Domain of Tatarstan Republic" tatar -// tattoo : 2013-08-30 Uniregistry, Corp. +// tattoo : 2013-08-30 UNR Corp. tattoo -// tax : 2014-03-20 Storm Orchard, LLC +// tax : 2014-03-20 Binky Moon, LLC tax -// taxi : 2015-03-19 Pine Falls, LLC +// taxi : 2015-03-19 Binky Moon, LLC taxi // tci : 2014-09-12 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti. @@ -9868,58 +9959,49 @@ tci // tdk : 2015-06-11 TDK Corporation tdk -// team : 2015-03-05 Atomic Lake, LLC +// team : 2015-03-05 Binky Moon, LLC team -// tech : 2015-01-30 Dot Tech LLC +// tech : 2015-01-30 Personals TLD Inc. tech -// technology : 2013-09-13 Auburn Falls +// technology : 2013-09-13 Binky Moon, LLC technology -// telecity : 2015-02-19 TelecityGroup International Limited -telecity - -// telefonica : 2014-10-16 Telefónica S.A. -telefonica - // temasek : 2014-08-07 Temasek Holdings (Private) Limited temasek -// tennis : 2014-12-04 Cotton Bloom, LLC +// tennis : 2014-12-04 Binky Moon, LLC tennis // teva : 2015-07-02 Teva Pharmaceutical Industries Limited teva -// thd : 2015-04-02 Homer TLC, Inc. +// thd : 2015-04-02 Home Depot Product Authority, LLC thd -// theater : 2015-03-19 Blue Tigers, LLC +// theater : 2015-03-19 Binky Moon, LLC theater -// theatre : 2015-05-07 +// theatre : 2015-05-07 XYZ.COM LLC theatre -// theguardian : 2015-04-30 Guardian News and Media Limited -theguardian - // tiaa : 2015-07-23 Teachers Insurance and Annuity Association of America tiaa // tickets : 2015-02-05 Accent Media Limited tickets -// tienda : 2013-11-14 Victor Manor, LLC +// tienda : 2013-11-14 Binky Moon, LLC tienda // tiffany : 2015-01-30 Tiffany and Company tiffany -// tips : 2013-09-20 Corn Willow, LLC +// tips : 2013-09-20 Binky Moon, LLC tips -// tires : 2014-11-07 Dog Edge, LLC +// tires : 2014-11-07 Binky Moon, LLC tires // tirol : 2014-04-24 punkt Tirol GmbH @@ -9937,16 +10019,16 @@ tkmaxx // tmall : 2015-01-15 Alibaba Group Holding Limited tmall -// today : 2013-09-20 Pearl Woods, LLC +// today : 2013-09-20 Binky Moon, LLC today // tokyo : 2013-11-13 GMO Registry, Inc. tokyo -// tools : 2013-11-21 Pioneer North, LLC +// tools : 2013-11-21 Binky Moon, LLC tools -// top : 2014-03-20 Jiangsu Bangning Science & Technology Co.,Ltd. +// top : 2014-03-20 .TOP Registry top // toray : 2014-12-18 Toray Industries, Inc. @@ -9958,27 +10040,30 @@ toshiba // total : 2015-08-06 Total SA total -// tours : 2015-01-22 Sugar Station, LLC +// tours : 2015-01-22 Binky Moon, LLC tours -// town : 2014-03-06 Koko Moon, LLC +// town : 2014-03-06 Binky Moon, LLC town // toyota : 2015-04-23 TOYOTA MOTOR CORPORATION toyota -// toys : 2014-03-06 Pioneer Orchard, LLC +// toys : 2014-03-06 Binky Moon, LLC toys // trade : 2014-01-23 Elite Registry Limited trade -// trading : 2014-12-11 IG Group Holdings PLC +// trading : 2014-12-11 Dottrading Registry Limited trading -// training : 2013-11-07 Wild Willow, LLC +// training : 2013-11-07 Binky Moon, LLC training +// travel : 2015-10-09 Dog Beach, LLC +travel + // travelchannel : 2015-07-02 Lifestyle Domain Holdings, Inc. travelchannel @@ -9988,7 +10073,7 @@ travelers // travelersinsurance : 2015-03-26 Travelers TLD, LLC travelersinsurance -// trust : 2014-10-16 +// trust : 2014-10-16 NCC Group Domain Services, Inc. trust // trv : 2015-03-26 Travelers TLD, LLC @@ -10000,10 +10085,10 @@ tube // tui : 2014-07-03 TUI AG tui -// tunes : 2015-02-26 Amazon EU S.à r.l. +// tunes : 2015-02-26 Amazon Registry Services, Inc. tunes -// tushu : 2014-12-18 Amazon EU S.à r.l. +// tushu : 2014-12-18 Amazon Registry Services, Inc. tushu // tvs : 2015-02-19 T V SUNDRAM IYENGAR & SONS LIMITED @@ -10015,16 +10100,13 @@ ubank // ubs : 2014-12-11 UBS AG ubs -// uconnect : 2015-07-30 FCA US LLC. -uconnect - // unicom : 2015-10-15 China United Network Communications Corporation Limited unicom -// university : 2014-03-06 Little Station, LLC +// university : 2014-03-06 Binky Moon, LLC university -// uno : 2013-09-11 Dot Latin LLC +// uno : 2013-09-11 DotSite Inc. uno // uol : 2014-05-01 UBN INTERNET LTDA. @@ -10033,7 +10115,7 @@ uol // ups : 2015-06-25 UPS Market Driver, Inc. ups -// vacations : 2013-12-05 Atomic Tigers, LLC +// vacations : 2013-12-05 Binky Moon, LLC vacations // vana : 2014-12-11 Lifestyle Domain Holdings, Inc. @@ -10045,22 +10127,22 @@ vanguard // vegas : 2014-01-16 Dot Vegas, Inc. vegas -// ventures : 2013-08-27 Binky Lake, LLC +// ventures : 2013-08-27 Binky Moon, LLC ventures // verisign : 2015-08-13 VeriSign, Inc. verisign -// versicherung : 2014-03-20 dotversicherung-registry GmbH +// versicherung : 2014-03-20 tldbox GmbH versicherung -// vet : 2014-03-06 +// vet : 2014-03-06 Dog Beach, LLC vet -// viajes : 2013-10-17 Black Madison, LLC +// viajes : 2013-10-17 Binky Moon, LLC viajes -// video : 2014-10-16 +// video : 2014-10-16 Dog Beach, LLC video // vig : 2015-05-14 VIENNA INSURANCE GROUP AG Wiener Versicherung Gruppe @@ -10069,10 +10151,10 @@ vig // viking : 2015-04-02 Viking River Cruises (Bermuda) Ltd. viking -// villas : 2013-12-05 New Sky, LLC +// villas : 2013-12-05 Binky Moon, LLC villas -// vin : 2015-06-18 Holly Shadow, LLC +// vin : 2015-06-18 Binky Moon, LLC vin // vip : 2015-01-22 Minds + Machines Group Limited @@ -10084,15 +10166,9 @@ virgin // visa : 2015-07-30 Visa Worldwide Pte. Limited visa -// vision : 2013-12-05 Koko Station, LLC +// vision : 2013-12-05 Binky Moon, LLC vision -// vista : 2014-09-18 Vistaprint Limited -vista - -// vistaprint : 2014-09-18 Vistaprint Limited -vistaprint - // viva : 2014-11-07 Saudi Telecom Company viva @@ -10102,7 +10178,7 @@ vivo // vlaanderen : 2014-02-06 DNS.be vzw vlaanderen -// vodka : 2013-12-19 Top Level Domain Holdings Limited +// vodka : 2013-12-19 Minds + Machines Group Limited vodka // volkswagen : 2015-05-14 Volkswagen Group of America Inc. @@ -10120,7 +10196,7 @@ voting // voto : 2013-11-21 Monolith Registry LLC voto -// voyage : 2013-08-27 Ruby House, LLC +// voyage : 2013-08-27 Binky Moon, LLC voyage // vuelos : 2015-03-05 Travel Reservations SRL @@ -10135,25 +10211,22 @@ walmart // walter : 2014-11-13 Sandvik AB walter -// wang : 2013-10-24 Zodiac Leo Limited +// wang : 2013-10-24 Zodiac Wang Limited wang -// wanggou : 2014-12-18 Amazon EU S.à r.l. +// wanggou : 2014-12-18 Amazon Registry Services, Inc. wanggou -// warman : 2015-06-18 Weir Group IP Limited -warman - -// watch : 2013-11-14 Sand Shadow, LLC +// watch : 2013-11-14 Binky Moon, LLC watch // watches : 2014-12-22 Richemont DNS Inc. watches -// weather : 2015-01-08 The Weather Channel, LLC +// weather : 2015-01-08 International Business Machines Corporation weather -// weatherchannel : 2015-03-12 The Weather Channel, LLC +// weatherchannel : 2015-03-12 International Business Machines Corporation weatherchannel // webcam : 2014-01-23 dot Webcam Limited @@ -10165,10 +10238,7 @@ weber // website : 2014-04-03 DotWebsite Inc. website -// wed : 2013-10-01 Atgron, Inc. -wed - -// wedding : 2014-04-24 Top Level Domain Holdings Limited +// wedding : 2014-04-24 Minds + Machines Group Limited wedding // weibo : 2015-03-05 Sina Corporation @@ -10195,7 +10265,7 @@ win // windows : 2014-12-18 Microsoft Corporation windows -// wine : 2015-06-18 June Station, LLC +// wine : 2015-06-18 Binky Moon, LLC wine // winners : 2015-07-16 The TJX Companies, Inc. @@ -10210,22 +10280,22 @@ wolterskluwer // woodside : 2015-07-09 Woodside Petroleum Limited woodside -// work : 2013-12-19 Top Level Domain Holdings Limited +// work : 2013-12-19 Minds + Machines Group Limited work -// works : 2013-11-14 Little Dynamite, LLC +// works : 2013-11-14 Binky Moon, LLC works -// world : 2014-06-12 Bitter Fields, LLC +// world : 2014-06-12 Binky Moon, LLC world -// wow : 2015-10-08 Amazon EU S.à r.l. +// wow : 2015-10-08 Amazon Registry Services, Inc. wow // wtc : 2013-12-19 World Trade Centers Association, Inc. wtc -// wtf : 2014-03-06 Hidden Way, LLC +// wtf : 2014-03-06 Binky Moon, LLC wtf // xbox : 2014-12-18 Microsoft Corporation @@ -10237,7 +10307,7 @@ xerox // xfinity : 2015-07-09 Comcast IP Holdings I, LLC xfinity -// xihuan : 2015-01-08 QIHOO 360 TECHNOLOGY CO. LTD. +// xihuan : 2015-01-08 Beijing Qihu Keji Co., Ltd. xihuan // xin : 2014-12-11 Elegant Leader Limited @@ -10246,7 +10316,7 @@ xin // xn--11b4c3d : 2015-01-15 VeriSign Sarl कॉम -// xn--1ck2e1b : 2015-02-26 Amazon EU S.à r.l. +// xn--1ck2e1b : 2015-02-26 Amazon Registry Services, Inc. セール // xn--1qqw23a : 2014-01-09 Guangzhou YU Wei Information Technology Co., Ltd. @@ -10258,7 +10328,7 @@ xin // xn--3bst00m : 2013-09-13 Eagle Horizon Limited 集团 -// xn--3ds443g : 2013-09-08 TLD REGISTRY LIMITED +// xn--3ds443g : 2013-09-08 TLD REGISTRY LIMITED OY 在线 // xn--3oq18vl8pn36a : 2015-07-02 Volkswagen (China) Investment Co., Ltd. @@ -10270,19 +10340,16 @@ xin // xn--42c2d9a : 2015-01-15 VeriSign Sarl คอม -// xn--45q11c : 2013-11-21 Zodiac Scorpio Limited +// xn--45q11c : 2013-11-21 Zodiac Gemini Ltd 八卦 -// xn--4gbrim : 2013-10-04 Suhub Electronic Establishment +// xn--4gbrim : 2013-10-04 Fans TLD Limited موقع -// xn--4gq48lf9j : 2015-07-31 Wal-Mart Stores, Inc. -一号店 - // xn--55qw42g : 2013-11-08 China Organizational Name Administration Center 公益 -// xn--55qx5d : 2013-11-14 Computer Network Information Center of Chinese Academy of Sciences （China Internet Network Information Center） +// xn--55qx5d : 2013-11-14 China Internet Network Information Center (CNNIC) 公司 // xn--5su34j936bgsg : 2015-09-03 Shangri‐La International Hotel Management Limited @@ -10324,7 +10391,7 @@ xin // xn--b4w605ferd : 2014-08-07 Temasek Holdings (Private) Limited 淡马锡 -// xn--bck1b9a5dre4c : 2015-02-26 Amazon EU S.à r.l. +// xn--bck1b9a5dre4c : 2015-02-26 Amazon Registry Services, Inc. ファッション // xn--c1avg : 2013-11-14 Public Interest Registry @@ -10333,46 +10400,46 @@ xin // xn--c2br7g : 2015-01-15 VeriSign Sarl नेट -// xn--cck2b3b : 2015-02-26 Amazon EU S.à r.l. +// xn--cck2b3b : 2015-02-26 Amazon Registry Services, Inc. ストア +// xn--cckwcxetd : 2019-12-19 Amazon Registry Services, Inc. +アマゾン + // xn--cg4bki : 2013-09-27 SAMSUNG SDS CO., LTD 삼성 -// xn--czr694b : 2014-01-16 HU YI GLOBAL INFORMATION RESOURCES (HOLDING) COMPANY. HONGKONG LIMITED +// xn--czr694b : 2014-01-16 Internet DotTrademark Organisation Limited 商标 -// xn--czrs0t : 2013-12-19 Wild Island, LLC +// xn--czrs0t : 2013-12-19 Binky Moon, LLC 商店 -// xn--czru2d : 2013-11-21 Zodiac Capricorn Limited +// xn--czru2d : 2013-11-21 Zodiac Aquarius Limited 商城 // xn--d1acj3b : 2013-11-20 The Foundation for Network Initiatives “The Smart Internet” дети -// xn--eckvdtc9d : 2014-12-18 Amazon EU S.à r.l. +// xn--eckvdtc9d : 2014-12-18 Amazon Registry Services, Inc. ポイント -// xn--efvy88h : 2014-08-22 Xinhua News Agency Guangdong Branch 新华通讯社广东分社 +// xn--efvy88h : 2014-08-22 Guangzhou YU Wei Information Technology Co., Ltd. 新闻 -// xn--estv75g : 2015-02-19 Industrial and Commercial Bank of China Limited -工行 - -// xn--fct429k : 2015-04-09 Amazon EU S.à r.l. +// xn--fct429k : 2015-04-09 Amazon Registry Services, Inc. 家電 // xn--fhbei : 2015-01-15 VeriSign Sarl كوم -// xn--fiq228c5hs : 2013-09-08 TLD REGISTRY LIMITED +// xn--fiq228c5hs : 2013-09-08 TLD REGISTRY LIMITED OY 中文网 // xn--fiq64b : 2013-10-14 CITIC Group Corporation 中信 -// xn--fjq720a : 2014-05-22 Will Bloom, LLC +// xn--fjq720a : 2014-05-22 Binky Moon, LLC 娱乐 // xn--flw351e : 2014-07-31 Charleston Road Registry Inc. @@ -10381,42 +10448,42 @@ xin // xn--fzys8d69uvgm : 2015-05-14 PCCW Enterprises Limited 電訊盈科 -// xn--g2xx48c : 2015-01-30 Minds + Machines Group Limited +// xn--g2xx48c : 2015-01-30 Nawang Heli(Xiamen) Network Service Co., LTD. 购物 -// xn--gckr3f0f : 2015-02-26 Amazon EU S.à r.l. +// xn--gckr3f0f : 2015-02-26 Amazon Registry Services, Inc. クラウド -// xn--gk3at1e : 2015-10-08 Amazon EU S.à r.l. +// xn--gk3at1e : 2015-10-08 Amazon Registry Services, Inc. 通販 -// xn--hxt814e : 2014-05-15 Zodiac Libra Limited +// xn--hxt814e : 2014-05-15 Zodiac Taurus Limited 网店 // xn--i1b6b1a6a2e : 2013-11-14 Public Interest Registry संगठन -// xn--imr513n : 2014-12-11 HU YI GLOBAL INFORMATION RESOURCES (HOLDING) COMPANY. HONGKONG LIMITED +// xn--imr513n : 2014-12-11 Internet DotTrademark Organisation Limited 餐厅 -// xn--io0a7i : 2013-11-14 Computer Network Information Center of Chinese Academy of Sciences （China Internet Network Information Center） +// xn--io0a7i : 2013-11-14 China Internet Network Information Center (CNNIC) 网络 // xn--j1aef : 2015-01-15 VeriSign Sarl ком +// xn--jlq480n2rg : 2019-12-19 Amazon Registry Services, Inc. +亚马逊 + // xn--jlq61u9w7b : 2015-01-08 Nokia Corporation 诺基亚 -// xn--jvr189m : 2015-02-26 Amazon EU S.à r.l. +// xn--jvr189m : 2015-02-26 Amazon Registry Services, Inc. 食品 // xn--kcrx77d1x4a : 2014-11-07 Koninklijke Philips N.V. 飞利浦 -// xn--kpu716f : 2014-12-22 Richemont DNS Inc. -手表 - // xn--kput3i : 2014-02-13 Beijing RITT-Net Technology Development Co., Ltd 手机 @@ -10432,9 +10499,6 @@ xin // xn--mgbab2bd : 2013-10-31 CORE Association بازار -// xn--mgbb9fbpob : 2014-12-18 GreenTech Consultancy Company W.L.L. -موبايلي - // xn--mgbca7dzdo : 2015-07-30 Abu Dhabi Systems and Information Centre ابوظبي @@ -10468,12 +10532,12 @@ xin // xn--nyqy26a : 2014-11-07 Stable Tone Limited 健康 +// xn--otu796d : 2017-08-06 Jiang Yu Liang Cai Technology Company Limited +招聘 + // xn--p1acf : 2013-12-12 Rusnames Limited рус -// xn--pbt977c : 2014-12-22 Richemont DNS Inc. -珠宝 - // xn--pssy2u : 2015-01-15 VeriSign Sarl 大拿 @@ -10486,10 +10550,10 @@ xin // xn--rhqv96g : 2013-09-11 Stable Tone Limited 世界 -// xn--rovu88b : 2015-02-26 Amazon EU S.à r.l. +// xn--rovu88b : 2015-02-26 Amazon Registry Services, Inc. 書籍 -// xn--ses554g : 2014-01-16 +// xn--ses554g : 2014-01-16 KNET Co., Ltd. 网址 // xn--t60b56a : 2015-01-15 VeriSign Sarl @@ -10501,7 +10565,7 @@ xin // xn--tiq49xqyj : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication) 天主教 -// xn--unup4y : 2013-07-14 Spring Fields, LLC +// xn--unup4y : 2013-07-14 Binky Moon, LLC 游戏 // xn--vermgensberater-ctb : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG @@ -10510,7 +10574,7 @@ vermögensberater // xn--vermgensberatung-pwb : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG vermögensberatung -// xn--vhquv : 2013-08-27 Dash McCook, LLC +// xn--vhquv : 2013-08-27 Binky Moon, LLC 企业 // xn--vuq861b : 2014-10-16 Beijing Tele-info Network Technology Co., Ltd. @@ -10528,9 +10592,6 @@ vermögensberatung // xn--zfr164b : 2013-11-08 China Organizational Name Administration Center 政务 -// xperia : 2015-05-14 Sony Mobile Communications AB -xperia - // xyz : 2013-12-05 XYZ.COM LLC xyz @@ -10540,46 +10601,43 @@ yachts // yahoo : 2015-04-02 Yahoo! Domain Services Inc. yahoo -// yamaxun : 2014-12-18 Amazon EU S.à r.l. +// yamaxun : 2014-12-18 Amazon Registry Services, Inc. yamaxun -// yandex : 2014-04-10 YANDEX, LLC +// yandex : 2014-04-10 Yandex Europe B.V. yandex // yodobashi : 2014-11-20 YODOBASHI CAMERA CO.,LTD. yodobashi -// yoga : 2014-05-29 Top Level Domain Holdings Limited +// yoga : 2014-05-29 Minds + Machines Group Limited yoga // yokohama : 2013-12-12 GMO Registry, Inc. yokohama -// you : 2015-04-09 Amazon EU S.à r.l. +// you : 2015-04-09 Amazon Registry Services, Inc. you // youtube : 2014-05-01 Charleston Road Registry Inc. youtube -// yun : 2015-01-08 QIHOO 360 TECHNOLOGY CO. LTD. +// yun : 2015-01-08 Beijing Qihu Keji Co., Ltd. yun -// zappos : 2015-06-25 Amazon EU S.à r.l. +// zappos : 2015-06-25 Amazon Registry Services, Inc. zappos // zara : 2014-11-07 Industria de Diseño Textil, S.A. (INDITEX, S.A.) zara -// zero : 2014-12-18 Amazon EU S.à r.l. +// zero : 2014-12-18 Amazon Registry Services, Inc. zero // zip : 2014-05-08 Charleston Road Registry Inc. zip -// zippo : 2015-07-02 Zadco Company -zippo - -// zone : 2013-11-14 Outer Falls, LLC +// zone : 2013-11-14 Binky Moon, LLC zone // zuerich : 2014-11-07 Kanton Zürich (Canton of Zurich) @@ -10590,90 +10648,296 @@ zuerich // ===BEGIN PRIVATE DOMAINS=== // (Note: these are in alphabetical order by company name) +// 1GB LLC : https://www.1gb.ua/ +// Submitted by 1GB LLC <noc@1gb.com.ua> +cc.ua +inf.ua +ltd.ua + +// 611coin : https://611project.org/ +611.to + +// Adobe : https://www.adobe.com/ +// Submitted by Ian Boston <boston@adobe.com> +adobeaemcloud.com +adobeaemcloud.net +*.dev.adobeaemcloud.com + +// Agnat sp. z o.o. : https://domena.pl +// Submitted by Przemyslaw Plewa <it-admin@domena.pl> +beep.pl + +// alboto.ca : http://alboto.ca +// Submitted by Anton Avramov <avramov@alboto.ca> +barsy.ca + +// Alces Software Ltd : http://alces-software.com +// Submitted by Mark J. Titorenko <mark.titorenko@alces-software.com> +*.compute.estate +*.alces.network + +// all-inkl.com : https://all-inkl.com +// Submitted by Werner Kaltofen <wk@all-inkl.com> +kasserver.com + +// Algorithmia, Inc. : algorithmia.com +// Submitted by Eli Perelman <eperelman@algorithmia.io> +*.algorithmia.com +!teams.algorithmia.com +!test.algorithmia.com + +// Altervista: https://www.altervista.org +// Submitted by Carlo Cannas <tech_staff@altervista.it> +altervista.org + +// alwaysdata : https://www.alwaysdata.com +// Submitted by Cyril <admin@alwaysdata.com> +alwaysdata.net + // Amazon CloudFront : https://aws.amazon.com/cloudfront/ // Submitted by Donavan Miller <donavanm@amazon.com> cloudfront.net -// Amazon Elastic Compute Cloud: https://aws.amazon.com/ec2/ -// Submitted by Osman Surkatty <osmans@amazon.com> -ap-northeast-1.compute.amazonaws.com -ap-southeast-1.compute.amazonaws.com -ap-southeast-2.compute.amazonaws.com -cn-north-1.compute.amazonaws.cn -compute.amazonaws.cn -compute.amazonaws.com -compute-1.amazonaws.com -eu-west-1.compute.amazonaws.com -eu-central-1.compute.amazonaws.com -sa-east-1.compute.amazonaws.com +// Amazon Elastic Compute Cloud : https://aws.amazon.com/ec2/ +// Submitted by Luke Wells <psl-maintainers@amazon.com> +*.compute.amazonaws.com +*.compute-1.amazonaws.com +*.compute.amazonaws.com.cn us-east-1.amazonaws.com -us-gov-west-1.compute.amazonaws.com -us-west-1.compute.amazonaws.com -us-west-2.compute.amazonaws.com -z-1.compute-1.amazonaws.com -z-2.compute-1.amazonaws.com // Amazon Elastic Beanstalk : https://aws.amazon.com/elasticbeanstalk/ -// Submitted by Adam Stein <astein@amazon.com> +// Submitted by Luke Wells <psl-maintainers@amazon.com> +cn-north-1.eb.amazonaws.com.cn +cn-northwest-1.eb.amazonaws.com.cn elasticbeanstalk.com +ap-northeast-1.elasticbeanstalk.com +ap-northeast-2.elasticbeanstalk.com +ap-northeast-3.elasticbeanstalk.com +ap-south-1.elasticbeanstalk.com +ap-southeast-1.elasticbeanstalk.com +ap-southeast-2.elasticbeanstalk.com +ca-central-1.elasticbeanstalk.com +eu-central-1.elasticbeanstalk.com +eu-west-1.elasticbeanstalk.com +eu-west-2.elasticbeanstalk.com +eu-west-3.elasticbeanstalk.com +sa-east-1.elasticbeanstalk.com +us-east-1.elasticbeanstalk.com +us-east-2.elasticbeanstalk.com +us-gov-west-1.elasticbeanstalk.com +us-west-1.elasticbeanstalk.com +us-west-2.elasticbeanstalk.com // Amazon Elastic Load Balancing : https://aws.amazon.com/elasticloadbalancing/ -// Submitted by Scott Vidmar <svidmar@amazon.com> -elb.amazonaws.com +// Submitted by Luke Wells <psl-maintainers@amazon.com> +*.elb.amazonaws.com +*.elb.amazonaws.com.cn // Amazon S3 : https://aws.amazon.com/s3/ -// Submitted by Eric Kinolik <kilo@amazon.com> +// Submitted by Luke Wells <psl-maintainers@amazon.com> s3.amazonaws.com s3-ap-northeast-1.amazonaws.com +s3-ap-northeast-2.amazonaws.com +s3-ap-south-1.amazonaws.com s3-ap-southeast-1.amazonaws.com s3-ap-southeast-2.amazonaws.com -s3-external-1.amazonaws.com -s3-external-2.amazonaws.com -s3-fips-us-gov-west-1.amazonaws.com +s3-ca-central-1.amazonaws.com s3-eu-central-1.amazonaws.com s3-eu-west-1.amazonaws.com +s3-eu-west-2.amazonaws.com +s3-eu-west-3.amazonaws.com +s3-external-1.amazonaws.com +s3-fips-us-gov-west-1.amazonaws.com s3-sa-east-1.amazonaws.com s3-us-gov-west-1.amazonaws.com +s3-us-east-2.amazonaws.com s3-us-west-1.amazonaws.com s3-us-west-2.amazonaws.com +s3.ap-northeast-2.amazonaws.com +s3.ap-south-1.amazonaws.com s3.cn-north-1.amazonaws.com.cn +s3.ca-central-1.amazonaws.com s3.eu-central-1.amazonaws.com +s3.eu-west-2.amazonaws.com +s3.eu-west-3.amazonaws.com +s3.us-east-2.amazonaws.com +s3.dualstack.ap-northeast-1.amazonaws.com +s3.dualstack.ap-northeast-2.amazonaws.com +s3.dualstack.ap-south-1.amazonaws.com +s3.dualstack.ap-southeast-1.amazonaws.com +s3.dualstack.ap-southeast-2.amazonaws.com +s3.dualstack.ca-central-1.amazonaws.com +s3.dualstack.eu-central-1.amazonaws.com +s3.dualstack.eu-west-1.amazonaws.com +s3.dualstack.eu-west-2.amazonaws.com +s3.dualstack.eu-west-3.amazonaws.com +s3.dualstack.sa-east-1.amazonaws.com +s3.dualstack.us-east-1.amazonaws.com +s3.dualstack.us-east-2.amazonaws.com +s3-website-us-east-1.amazonaws.com +s3-website-us-west-1.amazonaws.com +s3-website-us-west-2.amazonaws.com +s3-website-ap-northeast-1.amazonaws.com +s3-website-ap-southeast-1.amazonaws.com +s3-website-ap-southeast-2.amazonaws.com +s3-website-eu-west-1.amazonaws.com +s3-website-sa-east-1.amazonaws.com +s3-website.ap-northeast-2.amazonaws.com +s3-website.ap-south-1.amazonaws.com +s3-website.ca-central-1.amazonaws.com +s3-website.eu-central-1.amazonaws.com +s3-website.eu-west-2.amazonaws.com +s3-website.eu-west-3.amazonaws.com +s3-website.us-east-2.amazonaws.com + +// Amsterdam Wireless: https://www.amsterdamwireless.nl/ +// Submitted by Imre Jonk <hostmaster@amsterdamwireless.nl> +amsw.nl + +// Amune : https://amune.org/ +// Submitted by Team Amune <cert@amune.org> +t3l3p0rt.net +tele.amune.org + +// Apigee : https://apigee.com/ +// Submitted by Apigee Security Team <security@apigee.com> +apigee.io + +// Aptible : https://www.aptible.com/ +// Submitted by Thomas Orozco <thomas@aptible.com> +on-aptible.com + +// ASEINet : https://www.aseinet.com/ +// Submitted by Asei SEKIGUCHI <mail@aseinet.com> +user.aseinet.ne.jp +gv.vc +d.gv.vc + +// Asociación Amigos de la Informática "Euskalamiga" : http://encounter.eus/ +// Submitted by Hector Martin <marcan@euskalencounter.org> +user.party.eus + +// Association potager.org : https://potager.org/ +// Submitted by Lunar <jardiniers@potager.org> +pimienta.org +poivron.org +potager.org +sweetpepper.org + +// ASUSTOR Inc. : http://www.asustor.com +// Submitted by Vincent Tseng <vincenttseng@asustor.com> +myasustor.com + +// AVM : https://avm.de +// Submitted by Andreas Weise <a.weise@avm.de> +myfritz.net + +// AW AdvisorWebsites.com Software Inc : https://advisorwebsites.com +// Submitted by James Kennedy <domains@advisorwebsites.com> +*.awdev.ca +*.advisor.ws + +// b-data GmbH : https://www.b-data.io +// Submitted by Olivier Benz <olivier.benz@b-data.ch> +b-data.io + +// backplane : https://www.backplane.io +// Submitted by Anthony Voutas <anthony@backplane.io> +backplaneapp.io + +// Balena : https://www.balena.io +// Submitted by Petros Angelatos <petrosagg@balena.io> +balena-devices.com + +// Banzai Cloud +// Submitted by Janos Matyas <info@banzaicloud.com> +*.banzai.cloud +app.banzaicloud.io +*.backyards.banzaicloud.io + // BetaInABox // Submitted by Adrian <adrian@betainabox.com> betainabox.com +// BinaryLane : http://www.binarylane.com +// Submitted by Nathan O'Sullivan <nathan@mammoth.com.au> +bnr.la + +// Blackbaud, Inc. : https://www.blackbaud.com +// Submitted by Paul Crowder <paul.crowder@blackbaud.com> +blackbaudcdn.net + +// Boomla : https://boomla.com +// Submitted by Tibor Halter <thalter@boomla.com> +boomla.net + +// Boxfuse : https://boxfuse.com +// Submitted by Axel Fontaine <axel@boxfuse.com> +boxfuse.io + +// bplaced : https://www.bplaced.net/ +// Submitted by Miroslav Bozic <security@bplaced.net> +square7.ch +bplaced.com +bplaced.de +square7.de +bplaced.net +square7.net + +// BrowserSafetyMark +// Submitted by Dave Tharp <browsersafetymark.io@quicinc.com> +browsersafetymark.io + +// Bytemark Hosting : https://www.bytemark.co.uk +// Submitted by Paul Cammish <paul.cammish@bytemark.co.uk> +uk0.bigv.io +dh.bytemark.co.uk +vm.bytemark.co.uk + +// callidomus : https://www.callidomus.com/ +// Submitted by Marcus Popp <admin@callidomus.com> +mycd.eu + +// Carrd : https://carrd.co +// Submitted by AJ <aj@carrd.co> +carrd.co +crd.co +uwu.ai + // CentralNic : http://www.centralnic.com/names/domains // Submitted by registry <gavin.brown@centralnic.com> ae.org -ar.com br.com cn.com com.de com.se de.com eu.com -gb.com gb.net -hu.com hu.net jp.net jpn.com -kr.com mex.com -no.com -qc.com ru.com sa.com -se.com se.net uk.com uk.net us.com -uy.com za.bz za.com +// No longer operated by CentralNic, these entries should be adopted and/or removed by current operators +// Submitted by Gavin Brown <gavin.brown@centralnic.com> +ar.com +gb.com +hu.com +kr.com +no.com +qc.com +uy.com + // Africa.com Web Solutions Ltd : https://registry.africa.com // Submitted by Gavin Brown <gavin.brown@centralnic.com> africa.com @@ -10685,6 +10949,7 @@ gr.com // Radix FZC : http://domains.in.net // Submitted by Gavin Brown <gavin.brown@centralnic.com> in.net +web.in // US REGISTRY LLC : http://us.org // Submitted by Gavin Brown <gavin.brown@centralnic.com> @@ -10694,17 +10959,94 @@ us.org // Submitted by Gavin Brown <gavin.brown@centralnic.com> co.com +// Roar Domains LLC : https://roar.basketball/ +// Submitted by Gavin Brown <gavin.brown@centralnic.com> +aus.basketball +nz.basketball + +// BRS Media : https://brsmedia.com/ +// Submitted by Gavin Brown <gavin.brown@centralnic.com> +radio.am +radio.fm + +// Globe Hosting SRL : https://www.globehosting.com/ +// Submitted by Gavin Brown <gavin.brown@centralnic.com> +co.ro +shop.ro + // c.la : http://www.c.la/ c.la +// certmgr.org : https://certmgr.org +// Submitted by B. Blechschmidt <hostmaster@certmgr.org> +certmgr.org + +// Citrix : https://citrix.com +// Submitted by Alex Stoddard <alex.stoddard@citrix.com> +xenapponazure.com + +// Civilized Discourse Construction Kit, Inc. : https://www.discourse.org/ +// Submitted by Rishabh Nambiar & Michael Brown <team@discourse.org> +discourse.group +discourse.team + +// ClearVox : http://www.clearvox.nl/ +// Submitted by Leon Rowland <leon@clearvox.nl> +virtueeldomein.nl + +// Clever Cloud : https://www.clever-cloud.com/ +// Submitted by Quentin Adam <noc@clever-cloud.com> +cleverapps.io + +// Clerk : https://www.clerk.dev +// Submitted by Colin Sidoti <colin@clerk.dev> +*.lcl.dev +*.stg.dev + +// Clic2000 : https://clic2000.fr +// Submitted by Mathilde Blanchemanche <mathilde@clic2000.fr> +clic2000.net + +// Cloud66 : https://www.cloud66.com/ +// Submitted by Khash Sajadi <khash@cloud66.com> +c66.me +cloud66.ws +cloud66.zone + +// CloudAccess.net : https://www.cloudaccess.net/ +// Submitted by Pawel Panek <noc@cloudaccess.net> +jdevcloud.com +wpdevcloud.com +cloudaccess.host +freesite.host +cloudaccess.net + // cloudControl : https://www.cloudcontrol.com/ // Submitted by Tobias Wilken <tw@cloudcontrol.com> cloudcontrolled.com cloudcontrolapp.com +// Cloudera, Inc. : https://www.cloudera.com/ +// Submitted by Philip Langdale <security@cloudera.com> +cloudera.site + +// Cloudflare, Inc. : https://www.cloudflare.com/ +// Submitted by Cloudflare Team <publicsuffixlist@cloudflare.com> +pages.dev +trycloudflare.com +workers.dev + +// Clovyr : https://clovyr.io +// Submitted by Patrick Nielsen <patrick@clovyr.io> +wnext.app + // co.ca : http://registry.co.ca/ co.ca +// Co & Co : https://co-co.nl/ +// Submitted by Govert Versluis <govert@co-co.nl> +*.otap.co + // i-registry s.r.o. : http://www.i-registry.cz/ // Submitted by Martin Semrad <semrad@i-registry.cz> co.cz @@ -10717,18 +11059,157 @@ r.cdn77.net rsc.cdn77.org ssl.origin.cdn77-secure.org +// Cloud DNS Ltd : http://www.cloudns.net +// Submitted by Aleksander Hristov <noc@cloudns.net> +cloudns.asia +cloudns.biz +cloudns.club +cloudns.cc +cloudns.eu +cloudns.in +cloudns.info +cloudns.org +cloudns.pro +cloudns.pw +cloudns.us + +// Cloudeity Inc : https://cloudeity.com +// Submitted by Stefan Dimitrov <contact@cloudeity.com> +cloudeity.net + +// CNPY : https://cnpy.gdn +// Submitted by Angelo Gladding <angelo@lahacker.net> +cnpy.gdn + // CoDNS B.V. co.nl co.no -// Commerce Guys, SAS -// Submitted by Damien Tournoud <damien@commerceguys.com> -*.platform.sh +// Combell.com : https://www.combell.com +// Submitted by Thomas Wouters <thomas.wouters@combellgroup.com> +webhosting.be +hosting-cluster.nl + +// Coordination Center for TLD RU and XN--P1AI : https://cctld.ru/en/domains/domens_ru/reserved/ +// Submitted by George Georgievsky <gug@cctld.ru> +ac.ru +edu.ru +gov.ru +int.ru +mil.ru +test.ru + +// COSIMO GmbH : http://www.cosimo.de +// Submitted by Rene Marticke <rmarticke@cosimo.de> +dyn.cosidns.de +dynamisches-dns.de +dnsupdater.de +internet-dns.de +l-o-g-i-n.de +dynamic-dns.info +feste-ip.net +knx-server.net +static-access.net + +// Craynic, s.r.o. : http://www.craynic.com/ +// Submitted by Ales Krajnik <ales.krajnik@craynic.com> +realm.cz + +// Cryptonomic : https://cryptonomic.net/ +// Submitted by Andrew Cady <public-suffix-list@cryptonomic.net> +*.cryptonomic.net // Cupcake : https://cupcake.io/ // Submitted by Jonathan Rudenberg <jonathan@cupcake.io> cupcake.is +// Curv UG : https://curv-labs.de/ +// Submitted by Marvin Wiesner <Marvin@curv-labs.de> +curv.dev + +// Customer OCI - Oracle Dyn https://cloud.oracle.com/home https://dyn.com/dns/ +// Submitted by Gregory Drake <support@dyn.com> +// Note: This is intended to also include customer-oci.com due to wildcards implicitly including the current label +*.customer-oci.com +*.oci.customer-oci.com +*.ocp.customer-oci.com +*.ocs.customer-oci.com + +// cyon GmbH : https://www.cyon.ch/ +// Submitted by Dominic Luechinger <dol@cyon.ch> +cyon.link +cyon.site + +// Danger Science Group: https://dangerscience.com/ +// Submitted by Skylar MacDonald <skylar@dangerscience.com> +fnwk.site +folionetwork.site +platform0.app + +// Daplie, Inc : https://daplie.com +// Submitted by AJ ONeal <aj@daplie.com> +daplie.me +localhost.daplie.me + +// Datto, Inc. : https://www.datto.com/ +// Submitted by Philipp Heckel <ph@datto.com> +dattolocal.com +dattorelay.com +dattoweb.com +mydatto.com +dattolocal.net +mydatto.net + +// Dansk.net : http://www.dansk.net/ +// Submitted by Anani Voule <digital@digital.co.dk> +biz.dk +co.dk +firm.dk +reg.dk +store.dk + +// dappnode.io : https://dappnode.io/ +// Submitted by Abel Boldu / DAppNode Team <community@dappnode.io> +dyndns.dappnode.io + +// dapps.earth : https://dapps.earth/ +// Submitted by Daniil Burdakov <icqkill@gmail.com> +*.dapps.earth +*.bzz.dapps.earth + +// Dark, Inc. : https://darklang.com +// Submitted by Paul Biggar <ops@darklang.com> +builtwithdark.com + +// Datawire, Inc : https://www.datawire.io +// Submitted by Richard Li <secalert@datawire.io> +edgestack.me + +// Debian : https://www.debian.org/ +// Submitted by Peter Palfrader / Debian Sysadmin Team <dsa-publicsuffixlist@debian.org> +debian.net + +// deSEC : https://desec.io/ +// Submitted by Peter Thomassen <peter@desec.io> +dedyn.io + +// DNS Africa Ltd https://dns.business +// Submitted by Calvin Browne <calvin@dns.business> +jozi.biz + +// DNShome : https://www.dnshome.de/ +// Submitted by Norbert Auler <mail@dnshome.de> +dnshome.de + +// DotArai : https://www.dotarai.com/ +// Submitted by Atsadawat Netcharadsang <atsadawat@dotarai.co.th> +online.th +shop.th + +// DrayTek Corp. : https://www.draytek.com/ +// Submitted by Paul Fang <mis@draytek.com> +drayddns.com + // DreamHost : http://www.dreamhost.com/ // Submitted by Andrew Farmer <andrew.farmer@dreamhost.com> dreamhosters.com @@ -10737,10 +11218,27 @@ dreamhosters.com // Submitted by Ricardo Padilha <rpadilha@drobo.com> mydrobo.com +// Drud Holdings, LLC. : https://www.drud.com/ +// Submitted by Kevin Bridges <kevin@drud.com> +drud.io +drud.us + // DuckDNS : http://www.duckdns.org/ // Submitted by Richard Harper <richard@duckdns.org> duckdns.org +// Bip : https://bip.sh +// Submitted by Joel Kennedy <joel@bip.sh> +bip.sh + +// bitbridge.net : Submitted by Craig Welch, abeliidev@gmail.com +bitbridge.net + +// dy.fi : http://dy.fi/ +// Submitted by Heikki Hannikainen <hessu@hes.iki.fi> +dy.fi +tunk.org + // DynDNS.com : http://www.dyndns.com/services/dns/dyndns/ dyndns-at-home.com dyndns-at-work.com @@ -11022,6 +11520,77 @@ webhop.org worse-than.tv writesthisblog.com +// ddnss.de : https://www.ddnss.de/ +// Submitted by Robert Niedziela <webmaster@ddnss.de> +ddnss.de +dyn.ddnss.de +dyndns.ddnss.de +dyndns1.de +dyn-ip24.de +home-webserver.de +dyn.home-webserver.de +myhome-server.de +ddnss.org + +// Definima : http://www.definima.com/ +// Submitted by Maxence Bitterli <maxence@definima.com> +definima.net +definima.io + +// dnstrace.pro : https://dnstrace.pro/ +// Submitted by Chris Partridge <chris@partridge.tech> +bci.dnstrace.pro + +// Dynu.com : https://www.dynu.com/ +// Submitted by Sue Ye <sue@dynu.com> +ddnsfree.com +ddnsgeek.com +giize.com +gleeze.com +kozow.com +loseyourip.com +ooguy.com +theworkpc.com +casacam.net +dynu.net +accesscam.org +camdvr.org +freeddns.org +mywire.org +webredirect.org +myddns.rocks +blogsite.xyz + +// dynv6 : https://dynv6.com +// Submitted by Dominik Menke <dom@digineo.de> +dynv6.net + +// E4YOU spol. s.r.o. : https://e4you.cz/ +// Submitted by Vladimir Dudr <info@e4you.cz> +e4.cz + +// En root‽ : https://en-root.org +// Submitted by Emmanuel Raviart <emmanuel@raviart.com> +en-root.fr + +// Enalean SAS: https://www.enalean.com +// Submitted by Thomas Cottier <thomas.cottier@enalean.com> +mytuleap.com + +// ECG Robotics, Inc: https://ecgrobotics.org +// Submitted by <frc1533@ecgrobotics.org> +onred.one +staging.onred.one + +// One.com: https://www.one.com/ +// Submitted by Jacob Bunk Nielsen <jbn@one.com> +service.one + +// Enonic : http://enonic.com/ +// Submitted by Erik Kaareng-Sunde <esu@enonic.com> +enonic.io +customer.enonic.io + // EU.org https://eu.org/ // Submitted by Pierre Beyssac <hostmaster@eu.org> eu.org @@ -11081,38 +11650,291 @@ tr.eu.org uk.eu.org us.eu.org -// Fastly Inc. http://www.fastly.com/ -// Submitted by Vladimir Vuksan <vladimir@fastly.com> +// Evennode : http://www.evennode.com/ +// Submitted by Michal Kralik <support@evennode.com> +eu-1.evennode.com +eu-2.evennode.com +eu-3.evennode.com +eu-4.evennode.com +us-1.evennode.com +us-2.evennode.com +us-3.evennode.com +us-4.evennode.com + +// eDirect Corp. : https://hosting.url.com.tw/ +// Submitted by C.S. chang <cschang@corp.url.com.tw> +twmail.cc +twmail.net +twmail.org +mymailer.com.tw +url.tw + +// Fabrica Technologies, Inc. : https://www.fabrica.dev/ +// Submitted by Eric Jiang <eric@fabrica.dev> +onfabrica.com + +// Facebook, Inc. +// Submitted by Peter Ruibal <public-suffix@fb.com> +apps.fbsbx.com + +// FAITID : https://faitid.org/ +// Submitted by Maxim Alzoba <tech.contact@faitid.org> +// https://www.flexireg.net/stat_info +ru.net +adygeya.ru +bashkiria.ru +bir.ru +cbg.ru +com.ru +dagestan.ru +grozny.ru +kalmykia.ru +kustanai.ru +marine.ru +mordovia.ru +msk.ru +mytis.ru +nalchik.ru +nov.ru +pyatigorsk.ru +spb.ru +vladikavkaz.ru +vladimir.ru +abkhazia.su +adygeya.su +aktyubinsk.su +arkhangelsk.su +armenia.su +ashgabad.su +azerbaijan.su +balashov.su +bashkiria.su +bryansk.su +bukhara.su +chimkent.su +dagestan.su +east-kazakhstan.su +exnet.su +georgia.su +grozny.su +ivanovo.su +jambyl.su +kalmykia.su +kaluga.su +karacol.su +karaganda.su +karelia.su +khakassia.su +krasnodar.su +kurgan.su +kustanai.su +lenug.su +mangyshlak.su +mordovia.su +msk.su +murmansk.su +nalchik.su +navoi.su +north-kazakhstan.su +nov.su +obninsk.su +penza.su +pokrovsk.su +sochi.su +spb.su +tashkent.su +termez.su +togliatti.su +troitsk.su +tselinograd.su +tula.su +tuva.su +vladikavkaz.su +vladimir.su +vologda.su + +// Fancy Bits, LLC : http://getchannels.com +// Submitted by Aman Gupta <aman@getchannels.com> +channelsdvr.net +u.channelsdvr.net + +// Fastly Inc. : http://www.fastly.com/ +// Submitted by Fastly Security <security@fastly.com> +fastly-terrarium.com +fastlylb.net +map.fastlylb.net +freetls.fastly.net +map.fastly.net +a.prod.fastly.net +global.prod.fastly.net a.ssl.fastly.net b.ssl.fastly.net global.ssl.fastly.net -a.prod.fastly.net -global.prod.fastly.net + +// FASTVPS EESTI OU : https://fastvps.ru/ +// Submitted by Likhachev Vasiliy <lihachev@fastvps.ru> +fastvps-server.com +fastvps.host +myfast.host +fastvps.site +myfast.space + +// Featherhead : https://featherhead.xyz/ +// Submitted by Simon Menke <simon@featherhead.xyz> +fhapp.xyz + +// Fedora : https://fedoraproject.org/ +// submitted by Patrick Uiterwijk <puiterwijk@fedoraproject.org> +fedorainfracloud.org +fedorapeople.org +cloud.fedoraproject.org +app.os.fedoraproject.org +app.os.stg.fedoraproject.org + +// FearWorks Media Ltd. : https://fearworksmedia.co.uk +// submitted by Keith Fairley <domains@fearworksmedia.co.uk> +conn.uk +copro.uk +couk.me +ukco.me + +// Fermax : https://fermax.com/ +// submitted by Koen Van Isterdael <k.vanisterdael@fermax.be> +mydobiss.com + +// Filegear Inc. : https://www.filegear.com +// Submitted by Jason Zhu <jason@owtware.com> +filegear.me +filegear-au.me +filegear-de.me +filegear-gb.me +filegear-ie.me +filegear-jp.me +filegear-sg.me // Firebase, Inc. // Submitted by Chris Raynor <chris@firebase.com> firebaseapp.com +// fly.io: https://fly.io +// Submitted by Kurt Mackey <kurt@fly.io> +fly.dev +edgeapp.net +shw.io + // Flynn : https://flynn.io // Submitted by Jonathan Rudenberg <jonathan@flynn.io> -flynnhub.com +flynnhosting.net + +// Frederik Braun https://frederik-braun.com +// Submitted by Frederik Braun <fb@frederik-braun.com> +0e.vc + +// Freebox : http://www.freebox.fr +// Submitted by Romain Fliedel <rfliedel@freebox.fr> +freebox-os.com +freeboxos.com +fbx-os.fr +fbxos.fr +freebox-os.fr +freeboxos.fr + +// freedesktop.org : https://www.freedesktop.org +// Submitted by Daniel Stone <daniel@fooishbar.org> +freedesktop.org + +// FunkFeuer - Verein zur Förderung freier Netze : https://www.funkfeuer.at +// Submitted by Daniel A. Maierhofer <vorstand@funkfeuer.at> +wien.funkfeuer.at + +// Futureweb OG : http://www.futureweb.at +// Submitted by Andreas Schnederle-Wagner <schnederle@futureweb.at> +*.futurecms.at +*.ex.futurecms.at +*.in.futurecms.at +futurehosting.at +futuremailing.at +*.ex.ortsinfo.at +*.kunden.ortsinfo.at +*.statics.cloud // GDS : https://www.gov.uk/service-manual/operations/operating-servicegovuk-subdomains // Submitted by David Illsley <david.illsley@digital.cabinet-office.gov.uk> service.gov.uk +// Gehirn Inc. : https://www.gehirn.co.jp/ +// Submitted by Kohei YOSHIDA <tech@gehirn.co.jp> +gehirn.ne.jp +usercontent.jp + +// Gentlent, Inc. : https://www.gentlent.com +// Submitted by Tom Klein <tom@gentlent.com> +gentapps.com +gentlentapis.com +lab.ms + // GitHub, Inc. -// Submitted by Ben Toews <btoews@github.com> +// Submitted by Patrick Toomey <security@github.com> github.io githubusercontent.com +// GitLab, Inc. +// Submitted by Alex Hanselka <alex@gitlab.com> +gitlab.io + +// Gitplac.si - https://gitplac.si +// Submitted by Aljaž Starc <me@aljaxus.eu> +gitapp.si +gitpage.si + +// Glitch, Inc : https://glitch.com +// Submitted by Mads Hartmann <mads@glitch.com> +glitch.me + +// GMO Pepabo, Inc. : https://pepabo.com/ +// Submitted by dojineko <admin@pepabo.com> +lolipop.io + +// GOV.UK Platform as a Service : https://www.cloud.service.gov.uk/ +// Submitted by Tom Whitwell <tom.whitwell@digital.cabinet-office.gov.uk> +cloudapps.digital +london.cloudapps.digital + +// GOV.UK Pay : https://www.payments.service.gov.uk/ +// Submitted by Richard Baker <richard.baker@digital.cabinet-office.gov.uk> +pymnt.uk + +// UKHomeOffice : https://www.gov.uk/government/organisations/home-office +// Submitted by Jon Shanks <jon.shanks@digital.homeoffice.gov.uk> +homeoffice.gov.uk + // GlobeHosting, Inc. // Submitted by Zoltan Egresi <egresi@globehosting.com> -ro.com +ro.im + +// GoIP DNS Services : http://www.goip.de +// Submitted by Christian Poulter <milchstrasse@goip.de> +goip.de // Google, Inc. // Submitted by Eduardo Vela <evn@google.com> +run.app +a.run.app +web.app +*.0emm.com appspot.com +*.r.appspot.com +codespot.com +googleapis.com +googlecode.com +pagespeedmobilizer.com +publishproxy.com +withgoogle.com +withyoutube.com +cloudfunctions.net +cloud.goog +translate.goog + blogspot.ae blogspot.al blogspot.am @@ -11187,43 +12009,512 @@ blogspot.td blogspot.tw blogspot.ug blogspot.vn -cloudfunctions.net -codespot.com -googleapis.com -googlecode.com -pagespeedmobilizer.com -withgoogle.com -withyoutube.com + +// Aaron Marais' Gitlab pages: https://lab.aaronleem.co.za +// Submitted by Aaron Marais <its_me@aaronleem.co.za> +graphox.us + +// Group 53, LLC : https://www.group53.com +// Submitted by Tyler Todd <noc@nova53.net> +awsmppl.com + +// Hakaran group: http://hakaran.cz +// Submited by Arseniy Sokolov <security@hakaran.cz> +fin.ci +free.hr +caa.li +ua.rs +conf.se + +// Handshake : https://handshake.org +// Submitted by Mike Damm <md@md.vc> +hs.zone +hs.run // Hashbang : https://hashbang.sh hashbang.sh +// Hasura : https://hasura.io +// Submitted by Shahidh K Muhammed <shahidh@hasura.io> +hasura.app +hasura-app.io + +// Hepforge : https://www.hepforge.org +// Submitted by David Grellscheid <admin@hepforge.org> +hepforge.org + // Heroku : https://www.heroku.com/ // Submitted by Tom Maher <tmaher@heroku.com> herokuapp.com herokussl.com +// Hibernating Rhinos +// Submitted by Oren Eini <oren@ravendb.net> +myravendb.com +ravendb.community +ravendb.me +development.run +ravendb.run + +// HOSTBIP REGISTRY : https://www.hostbip.com/ +// Submitted by Atanunu Igbunuroghene <publicsuffixlist@hostbip.com> +bpl.biz +orx.biz +ng.city +biz.gl +ng.ink +col.ng +firm.ng +gen.ng +ltd.ng +ngo.ng +ng.school +sch.so + +// HostyHosting (hostyhosting.com) +hostyhosting.io + +// Häkkinen.fi +// Submitted by Eero Häkkinen <Eero+psl@Häkkinen.fi> +häkkinen.fi + +// Ici la Lune : http://www.icilalune.com/ +// Submitted by Simon Morvan <simon@icilalune.com> +*.moonscale.io +moonscale.net + // iki.fi // Submitted by Hannu Aronsson <haa@iki.fi> iki.fi +// Individual Network Berlin e.V. : https://www.in-berlin.de/ +// Submitted by Christian Seitz <chris@in-berlin.de> +dyn-berlin.de +in-berlin.de +in-brb.de +in-butter.de +in-dsl.de +in-dsl.net +in-dsl.org +in-vpn.de +in-vpn.net +in-vpn.org + // info.at : http://www.info.at/ biz.at info.at +// info.cx : http://info.cx +// Submitted by Jacob Slater <whois@igloo.to> +info.cx + +// Interlegis : http://www.interlegis.leg.br +// Submitted by Gabriel Ferreira <registrobr@interlegis.leg.br> +ac.leg.br +al.leg.br +am.leg.br +ap.leg.br +ba.leg.br +ce.leg.br +df.leg.br +es.leg.br +go.leg.br +ma.leg.br +mg.leg.br +ms.leg.br +mt.leg.br +pa.leg.br +pb.leg.br +pe.leg.br +pi.leg.br +pr.leg.br +rj.leg.br +rn.leg.br +ro.leg.br +rr.leg.br +rs.leg.br +sc.leg.br +se.leg.br +sp.leg.br +to.leg.br + +// intermetrics GmbH : https://pixolino.com/ +// Submitted by Wolfgang Schwarz <admin@intermetrics.de> +pixolino.com + +// Internet-Pro, LLP: https://netangels.ru/ +// Submited by Vasiliy Sheredeko <piphon@gmail.com> +na4u.ru + +// iopsys software solutions AB : https://iopsys.eu/ +// Submitted by Roman Azarenko <roman.azarenko@iopsys.eu> +iopsys.se + +// IPiFony Systems, Inc. : https://www.ipifony.com/ +// Submitted by Matthew Hardeman <mhardeman@ipifony.com> +ipifony.net + +// IServ GmbH : https://iserv.eu +// Submitted by Kim-Alexander Brodowski <info@iserv.eu> +mein-iserv.de +schulserver.de +test-iserv.de +iserv.dev + +// I-O DATA DEVICE, INC. : http://www.iodata.com/ +// Submitted by Yuji Minagawa <domains-admin@iodata.jp> +iobb.net + +//Jelastic, Inc. : https://jelastic.com/ +// Submited by Ihor Kolodyuk <ik@jelastic.com> +mel.cloudlets.com.au +cloud.interhostsolutions.be +users.scale.virtualcloud.com.br +mycloud.by +alp1.ae.flow.ch +appengine.flow.ch +es-1.axarnet.cloud +diadem.cloud +vip.jelastic.cloud +jele.cloud +it1.eur.aruba.jenv-aruba.cloud +it1.jenv-aruba.cloud +it1-eur.jenv-arubabiz.cloud +primetel.cloud +uk.primetel.cloud +ca.reclaim.cloud +uk.reclaim.cloud +us.reclaim.cloud +ch.trendhosting.cloud +de.trendhosting.cloud +jele.club +clicketcloud.com +ams.cloudswitches.com +au.cloudswitches.com +sg.cloudswitches.com +dopaas.com +elastyco.com +nv.elastyco.com +hidora.com +paas.hosted-by-previder.com +rag-cloud.hosteur.com +rag-cloud-ch.hosteur.com +jcloud.ik-server.com +jcloud-ver-jpc.ik-server.com +demo.jelastic.com +kilatiron.com +paas.massivegrid.com +jed.wafaicloud.com +lon.wafaicloud.com +ryd.wafaicloud.com +j.scaleforce.com.cy +jelastic.dogado.eu +paas.leviracloud.eu +fi.cloudplatform.fi +demo.datacenter.fi +paas.datacenter.fi +jele.host +mircloud.host +jele.io +ocs.opusinteractive.io +cloud.unispace.io +cloud-de.unispace.io +cloud-fr1.unispace.io +jc.neen.it +cloud.jelastic.open.tim.it +jcloud.kz +upaas.kazteleport.kz +jl.serv.net.mx +cloudjiffy.net +fra1-de.cloudjiffy.net +west1-us.cloudjiffy.net +ams1.jls.docktera.net +jls-sto1.elastx.net +jls-sto2.elastx.net +jls-sto3.elastx.net +fr-1.paas.massivegrid.net +lon-1.paas.massivegrid.net +lon-2.paas.massivegrid.net +ny-1.paas.massivegrid.net +ny-2.paas.massivegrid.net +sg-1.paas.massivegrid.net +jelastic.saveincloud.net +nordeste-idc.saveincloud.net +j.scaleforce.net +jelastic.tsukaeru.net +atl.jelastic.vps-host.net +njs.jelastic.vps-host.net +unicloud.pl +mircloud.ru +jelastic.regruhosting.ru +enscaled.sg +jele.site +jelastic.team +j.layershift.co.uk +phx.enscaled.us +mircloud.us + +// Jino : https://www.jino.ru +// Submitted by Sergey Ulyashin <ulyashin@jino.ru> +myjino.ru +*.hosting.myjino.ru +*.landing.myjino.ru +*.spectrum.myjino.ru +*.vps.myjino.ru + +// Joyent : https://www.joyent.com/ +// Submitted by Brian Bennett <brian.bennett@joyent.com> +*.triton.zone +*.cns.joyent.com + +// JS.ORG : http://dns.js.org +// Submitted by Stefan Keim <admin@js.org> +js.org + +// KaasHosting : http://www.kaashosting.nl/ +// Submitted by Wouter Bakker <hostmaster@kaashosting.nl> +kaas.gg +khplay.nl + +// Keyweb AG : https://www.keyweb.de +// Submitted by Martin Dannehl <postmaster@keymachine.de> +keymachine.de + +// KingHost : https://king.host +// Submitted by Felipe Keller Braz <felipebraz@kinghost.com.br> +kinghost.net +uni5.net + +// KnightPoint Systems, LLC : http://www.knightpoint.com/ +// Submitted by Roy Keene <rkeene@knightpoint.com> +knightpoint.systems + +// KUROKU LTD : https://kuroku.ltd/ +// Submitted by DisposaBoy <security@oya.to> +oya.to + +// .KRD : http://nic.krd/data/krd/Registration%20Policy.pdf +co.krd +edu.krd + +// LCube - Professional hosting e.K. : https://www.lcube-webhosting.de +// Submitted by Lars Laehn <info@lcube.de> +git-repos.de +lcube-server.de +svn-repos.de + +// Leadpages : https://www.leadpages.net +// Submitted by Greg Dallavalle <domains@leadpages.net> +leadpages.co +lpages.co +lpusercontent.com + +// Lelux.fi : https://lelux.fi/ +// Submitted by Lelux Admin <publisuffix@lelux.site> +lelux.site + +// Lifetime Hosting : https://Lifetime.Hosting/ +// Submitted by Mike Fillator <support@lifetime.hosting> +co.business +co.education +co.events +co.financial +co.network +co.place +co.technology + +// Lightmaker Property Manager, Inc. : https://app.lmpm.com/ +// Submitted by Greg Holland <greg.holland@lmpm.com> +app.lmpm.com + +// Linki Tools UG : https://linki.tools +// Submitted by Paulo Matos <pmatos@linki.tools> +linkitools.space + +// linkyard ldt: https://www.linkyard.ch/ +// Submitted by Mario Siegenthaler <mario.siegenthaler@linkyard.ch> +linkyard.cloud +linkyard-cloud.ch + +// Linode : https://linode.com +// Submitted by <security@linode.com> +members.linode.com +*.nodebalancer.linode.com +*.linodeobjects.com + +// LiquidNet Ltd : http://www.liquidnetlimited.com/ +// Submitted by Victor Velchev <admin@liquidnetlimited.com> +we.bs + +// localzone.xyz +// Submitted by Kenny Niehage <hello@yahe.sh> +localzone.xyz + +// Log'in Line : https://www.loginline.com/ +// Submitted by Rémi Mach <remi.mach@loginline.com> +loginline.app +loginline.dev +loginline.io +loginline.services +loginline.site + +// LubMAN UMCS Sp. z o.o : https://lubman.pl/ +// Submitted by Ireneusz Maliszewski <ireneusz.maliszewski@lubman.pl> +krasnik.pl +leczna.pl +lubartow.pl +lublin.pl +poniatowa.pl +swidnik.pl + +// Lug.org.uk : https://lug.org.uk +// Submitted by Jon Spriggs <admin@lug.org.uk> +uklugs.org +glug.org.uk +lug.org.uk +lugs.org.uk + +// Lukanet Ltd : https://lukanet.com +// Submitted by Anton Avramov <register@lukanet.com> +barsy.bg +barsy.co.uk +barsyonline.co.uk +barsycenter.com +barsyonline.com +barsy.club +barsy.de +barsy.eu +barsy.in +barsy.info +barsy.io +barsy.me +barsy.menu +barsy.mobi +barsy.net +barsy.online +barsy.org +barsy.pro +barsy.pub +barsy.shop +barsy.site +barsy.support +barsy.uk + +// Magento Commerce +// Submitted by Damien Tournoud <dtournoud@magento.cloud> +*.magentosite.cloud + +// May First - People Link : https://mayfirst.org/ +// Submitted by Jamie McClelland <info@mayfirst.org> +mayfirst.info +mayfirst.org + +// Mail.Ru Group : https://hb.cldmail.ru +// Submitted by Ilya Zaretskiy <zaretskiy@corp.mail.ru> +hb.cldmail.ru + +// mcpe.me : https://mcpe.me +// Submitted by Noa Heyl <hi@noa.dev> +mcpe.me + +// McHost : https://mchost.ru +// Submitted by Evgeniy Subbotin <e.subbotin@mchost.ru> +mcdir.ru +vps.mcdir.ru + +// Memset hosting : https://www.memset.com +// Submitted by Tom Whitwell <domains@memset.com> +miniserver.com +memset.net + +// MetaCentrum, CESNET z.s.p.o. : https://www.metacentrum.cz/en/ +// Submitted by Zdeněk Šustr <zdenek.sustr@cesnet.cz> +*.cloud.metacentrum.cz +custom.metacentrum.cz + +// MetaCentrum, CESNET z.s.p.o. : https://www.metacentrum.cz/en/ +// Submitted by Radim Janča <janca@cesnet.cz> +flt.cloud.muni.cz +usr.cloud.muni.cz + +// Meteor Development Group : https://www.meteor.com/hosting +// Submitted by Pierre Carrier <pierre@meteor.com> +meteorapp.com +eu.meteorapp.com + // Michau Enterprises Limited : http://www.co.pl/ co.pl -// Microsoft : http://microsoft.com -// Submitted by Barry Dorrans <bdorrans@microsoft.com> +// Microsoft Corporation : http://microsoft.com +// Submitted by Mostafa Elzeiny <moelzein@microsoft.com> +*.azurecontainer.io azurewebsites.net azure-mobile.net cloudapp.net +// minion.systems : http://minion.systems +// Submitted by Robert Böttinger <r@minion.systems> +csx.cc + +// MobileEducation, LLC : https://joinforte.com +// Submitted by Grayson Martin <grayson.martin@mobileeducation.us> +forte.id + +// Mozilla Corporation : https://mozilla.com +// Submitted by Ben Francis <bfrancis@mozilla.com> +mozilla-iot.org + // Mozilla Foundation : https://mozilla.org/ // Submitted by glob <glob@mozilla.com> bmoattachments.org +// MSK-IX : https://www.msk-ix.ru/ +// Submitted by Khannanov Roman <r.khannanov@msk-ix.ru> +net.ru +org.ru +pp.ru + +// Mythic Beasts : https://www.mythic-beasts.com +// Submitted by Paul Cammish <kelduum@mythic-beasts.com> +hostedpi.com +customer.mythic-beasts.com +lynx.mythic-beasts.com +ocelot.mythic-beasts.com +onza.mythic-beasts.com +sphinx.mythic-beasts.com +vs.mythic-beasts.com +x.mythic-beasts.com +yali.mythic-beasts.com +cust.retrosnub.co.uk + +// Nabu Casa : https://www.nabucasa.com +// Submitted by Paulus Schoutsen <infra@nabucasa.com> +ui.nabu.casa + +// Names.of.London : https://names.of.london/ +// Submitted by James Stevens <registry@names.of.london> or <james@jrcs.net> +pony.club +of.fashion +on.fashion +of.football +in.london +of.london +for.men +and.mom +for.mom +for.one +for.sale +of.work +to.work + +// NCTU.ME : https://nctu.me/ +// Submitted by Tocknicsu <admin@nctu.me> +nctu.me + +// Netlify : https://www.netlify.com +// Submitted by Jessica Parsons <jessica@netlify.com> +netlify.app + // Neustar Inc. // Submitted by Trung Tran <Trung.Tran@neustar.biz> 4u.com @@ -11232,30 +12523,286 @@ bmoattachments.org // Submitted by Alan Shreve <alan@ngrok.com> ngrok.io +// Nimbus Hosting Ltd. : https://www.nimbushosting.co.uk/ +// Submitted by Nicholas Ford <nick@nimbushosting.co.uk> +nh-serv.co.uk + // NFSN, Inc. : https://www.NearlyFreeSpeech.NET/ // Submitted by Jeff Wheelhouse <support@nearlyfreespeech.net> nfshost.com +// Now-DNS : https://now-dns.com +// Submitted by Steve Russell <steve@now-dns.com> +dnsking.ch +mypi.co +n4t.co +001www.com +ddnslive.com +myiphost.com +forumz.info +16-b.it +32-b.it +64-b.it +soundcast.me +tcp4.me +dnsup.net +hicam.net +now-dns.net +ownip.net +vpndns.net +dynserv.org +now-dns.org +x443.pw +now-dns.top +ntdll.top +freeddns.us +crafting.xyz +zapto.xyz + +// nsupdate.info : https://www.nsupdate.info/ +// Submitted by Thomas Waldmann <info@nsupdate.info> +nsupdate.info +nerdpol.ovh + +// No-IP.com : https://noip.com/ +// Submitted by Deven Reza <publicsuffixlist@noip.com> +blogsyte.com +brasilia.me +cable-modem.org +ciscofreak.com +collegefan.org +couchpotatofries.org +damnserver.com +ddns.me +ditchyourip.com +dnsfor.me +dnsiskinky.com +dvrcam.info +dynns.com +eating-organic.net +fantasyleague.cc +geekgalaxy.com +golffan.us +health-carereform.com +homesecuritymac.com +homesecuritypc.com +hopto.me +ilovecollege.info +loginto.me +mlbfan.org +mmafan.biz +myactivedirectory.com +mydissent.net +myeffect.net +mymediapc.net +mypsx.net +mysecuritycamera.com +mysecuritycamera.net +mysecuritycamera.org +net-freaks.com +nflfan.org +nhlfan.net +no-ip.ca +no-ip.co.uk +no-ip.net +noip.us +onthewifi.com +pgafan.net +point2this.com +pointto.us +privatizehealthinsurance.net +quicksytes.com +read-books.org +securitytactics.com +serveexchange.com +servehumour.com +servep2p.com +servesarcasm.com +stufftoread.com +ufcfan.org +unusualperson.com +workisboring.com +3utilities.com +bounceme.net +ddns.net +ddnsking.com +gotdns.ch +hopto.org +myftp.biz +myftp.org +myvnc.com +no-ip.biz +no-ip.info +no-ip.org +noip.me +redirectme.net +servebeer.com +serveblog.net +servecounterstrike.com +serveftp.com +servegame.com +servehalflife.com +servehttp.com +serveirc.com +serveminecraft.net +servemp3.com +servepics.com +servequake.com +sytes.net +webhop.me +zapto.org + +// NodeArt : https://nodeart.io +// Submitted by Konstantin Nosov <Nosov@nodeart.io> +stage.nodeart.io + +// Nodum B.V. : https://nodum.io/ +// Submitted by Wietse Wind <hello+publicsuffixlist@nodum.io> +nodum.co +nodum.io + +// Nucleos Inc. : https://nucleos.com +// Submitted by Piotr Zduniak <piotr@nucleos.com> +pcloud.host + // NYC.mn : http://www.information.nyc.mn // Submitted by Matthew Brown <mattbrown@nyc.mn> nyc.mn +// NymNom : https://nymnom.com/ +// Submitted by NymNom <psl@nymnom.com> +nom.ae +nom.af +nom.ai +nom.al +nym.by +nom.bz +nym.bz +nom.cl +nym.ec +nom.gd +nom.ge +nom.gl +nym.gr +nom.gt +nym.gy +nym.hk +nom.hn +nym.ie +nom.im +nom.ke +nym.kz +nym.la +nym.lc +nom.li +nym.li +nym.lt +nym.lu +nom.lv +nym.me +nom.mk +nym.mn +nym.mx +nom.nu +nym.nz +nym.pe +nym.pt +nom.pw +nom.qa +nym.ro +nom.rs +nom.si +nym.sk +nom.st +nym.su +nym.sx +nom.tj +nym.tw +nom.ug +nom.uy +nom.vc +nom.vg + +// Observable, Inc. : https://observablehq.com +// Submitted by Mike Bostock <dns@observablehq.com> +static.observableusercontent.com + +// Octopodal Solutions, LLC. : https://ulterius.io/ +// Submitted by Andrew Sampson <andrew@ulterius.io> +cya.gg + +// OMG.LOL : <https://omg.lol> +// Submitted by Adam Newbold <adam@omg.lol> +omg.lol + +// Omnibond Systems, LLC. : https://www.omnibond.com +// Submitted by Cole Estep <cole@omnibond.com> +cloudycluster.net + +// OmniWe Limited: https://omniwe.com +// Submitted by Vicary Archangel <vicary@omniwe.com> +omniwe.site + // One Fold Media : http://www.onefoldmedia.com/ // Submitted by Eddie Jones <eddie@onefoldmedia.com> nid.io +// Open Social : https://www.getopensocial.com/ +// Submitted by Alexander Varwijk <security@getopensocial.com> +opensocial.site + +// OpenCraft GmbH : http://opencraft.com/ +// Submitted by Sven Marnach <sven@opencraft.com> +opencraft.hosting + // Opera Software, A.S.A. // Submitted by Yngve Pettersen <yngve@opera.com> operaunite.com +// Oursky Limited : https://skygear.io/ +// Submited by Skygear Developer <hello@skygear.io> +skygearapp.com + // OutSystems // Submitted by Duarte Santos <domain-admin@outsystemscloud.com> outsystemscloud.com +// OwnProvider GmbH: http://www.ownprovider.com +// Submitted by Jan Moennich <jan.moennich@ownprovider.com> +ownprovider.com +own.pm + +// OwO : https://whats-th.is/ +// Submitted by Dean Sheather <dean@deansheather.com> +*.owo.codes + +// OX : http://www.ox.rs +// Submitted by Adam Grand <webmaster@mail.ox.rs> +ox.rs + +// oy.lc +// Submitted by Charly Coste <changaco@changaco.oy.lc> +oy.lc + +// Pagefog : https://pagefog.com/ +// Submitted by Derek Myers <derek@pagefog.com> +pgfog.com + // Pagefront : https://www.pagefronthq.com/ // Submitted by Jason Kriss <jason@pagefronthq.com> pagefrontapp.com +// PageXL : https://pagexl.com +// Submitted by Yann Guichard <yann@pagexl.com> +pagexl.com + +// pcarrier.ca Software Inc: https://pcarrier.ca/ +// Submitted by Pierre Carrier <pc@rrier.ca> +bar0.net +bar1.net +bar2.net +rdv.to + // .pl domains (grandfathered) art.pl gliwice.pl @@ -11266,9 +12813,49 @@ zakopane.pl // Pantheon Systems, Inc. : https://pantheon.io/ // Submitted by Gary Dylina <gary@pantheon.io> -pantheon.io +pantheonsite.io gotpantheon.com +// Peplink | Pepwave : http://peplink.com/ +// Submitted by Steve Leung <steveleung@peplink.com> +mypep.link + +// Perspecta : https://perspecta.com/ +// Submitted by Kenneth Van Alstyne <kvanalstyne@perspecta.com> +perspecta.cloud + +// Planet-Work : https://www.planet-work.com/ +// Submitted by Frédéric VANNIÈRE <f.vanniere@planet-work.com> +on-web.fr + +// Platform.sh : https://platform.sh +// Submitted by Nikola Kotur <nikola@platform.sh> +bc.platform.sh +ent.platform.sh +eu.platform.sh +us.platform.sh +*.platformsh.site + +// Platter: https://platter.dev +// Submitted by Patrick Flor <patrick@platter.dev> +platter-app.com +platter-app.dev +platterp.us + +// Plesk : https://www.plesk.com/ +// Submitted by Anton Akhtyamov <program-managers@plesk.com> +pdns.page +plesk.page +pleskns.com + +// Port53 : https://port53.io/ +// Submitted by Maximilian Schieder <maxi@zeug.co> +dyn53.io + +// Positive Codes Technology Company : http://co.bn/faq.html +// Submitted by Zulfais <pc@co.bn> +co.bn + // prgmr.com : https://prgmr.com/ // Submitted by Sarah Newman <owner@prgmr.com> xen.prgmr.com @@ -11277,34 +12864,270 @@ xen.prgmr.com // Submitted by registry <lendl@nic.at> priv.at +// privacytools.io : https://www.privacytools.io/ +// Submitted by Jonah Aragon <jonah@privacytools.io> +prvcy.page + +// Protocol Labs : https://protocol.ai/ +// Submitted by Michael Burns <noc@protocol.ai> +*.dweb.link + +// Protonet GmbH : http://protonet.io +// Submitted by Martin Meier <admin@protonet.io> +protonet.io + +// Publication Presse Communication SARL : https://ppcom.fr +// Submitted by Yaacov Akiba Slama <admin@chirurgiens-dentistes-en-france.fr> +chirurgiens-dentistes-en-france.fr +byen.site + +// pubtls.org: https://www.pubtls.org +// Submitted by Kor Nielsen <kor@pubtls.org> +pubtls.org + +// Qualifio : https://qualifio.com/ +// Submitted by Xavier De Cock <xdecock@gmail.com> +qualifioapp.com + +// QuickBackend: https://www.quickbackend.com +// Submitted by Dani Biro <dani@pymet.com> +qbuser.com + +// Redstar Consultants : https://www.redstarconsultants.com/ +// Submitted by Jons Slemmer <jons@redstarconsultants.com> +instantcloud.cn + +// Russian Academy of Sciences +// Submitted by Tech Support <support@rasnet.ru> +ras.ru + // QA2 // Submitted by Daniel Dent (https://www.danieldent.com/) qa2.com +// QCX +// Submitted by Cassandra Beelen <cassandra@beelen.one> +qcx.io +*.sys.qcx.io + +// QNAP System Inc : https://www.qnap.com +// Submitted by Nick Chang <nickchang@qnap.com> +dev-myqnapcloud.com +alpha-myqnapcloud.com +myqnapcloud.com + +// Quip : https://quip.com +// Submitted by Patrick Linehan <plinehan@quip.com> +*.quipelements.com + +// Qutheory LLC : http://qutheory.io +// Submitted by Jonas Schwartz <jonas@qutheory.io> +vapor.cloud +vaporcloud.io + // Rackmaze LLC : https://www.rackmaze.com // Submitted by Kirill Pertsev <kika@rackmaze.com> rackmaze.com rackmaze.net +// Rakuten Games, Inc : https://dev.viberplay.io +// Submitted by Joshua Zhang <public-suffix@rgames.jp> +g.vbrplsbx.io + +// Rancher Labs, Inc : https://rancher.com +// Submitted by Vincent Fiduccia <domains@rancher.com> +*.on-k3s.io +*.on-rancher.cloud +*.on-rio.io + +// Read The Docs, Inc : https://www.readthedocs.org +// Submitted by David Fischer <team@readthedocs.org> +readthedocs.io + // Red Hat, Inc. OpenShift : https://openshift.redhat.com/ // Submitted by Tim Kramer <tkramer@rhcloud.com> rhcloud.com +// Render : https://render.com +// Submitted by Anurag Goel <dev@render.com> +app.render.com +onrender.com + +// Repl.it : https://repl.it +// Submitted by Mason Clayton <mason@repl.it> +repl.co +repl.run + +// Resin.io : https://resin.io +// Submitted by Tim Perry <tim@resin.io> +resindevice.io +devices.resinstaging.io + +// RethinkDB : https://www.rethinkdb.com/ +// Submitted by Chris Kastorff <info@rethinkdb.com> +hzc.io + +// Revitalised Limited : http://www.revitalised.co.uk +// Submitted by Jack Price <jack@revitalised.co.uk> +wellbeingzone.eu +ptplus.fit +wellbeingzone.co.uk + +// Rochester Institute of Technology : http://www.rit.edu/ +// Submitted by Jennifer Herting <jchits@rit.edu> +git-pages.rit.edu + // Sandstorm Development Group, Inc. : https://sandcats.io/ // Submitted by Asheesh Laroia <asheesh@sandstorm.io> sandcats.io +// SBE network solutions GmbH : https://www.sbe.de/ +// Submitted by Norman Meilick <nm@sbe.de> +logoip.de +logoip.com + +// schokokeks.org GbR : https://schokokeks.org/ +// Submitted by Hanno Böck <hanno@schokokeks.org> +schokokeks.net + +// Scottish Government: https://www.gov.scot +// Submitted by Martin Ellis <martin.ellis@gov.scot> +gov.scot + +// Scry Security : http://www.scrysec.com +// Submitted by Shante Adam <shante@skyhat.io> +scrysec.com + +// Securepoint GmbH : https://www.securepoint.de +// Submitted by Erik Anders <erik.anders@securepoint.de> +firewall-gateway.com +firewall-gateway.de +my-gateway.de +my-router.de +spdns.de +spdns.eu +firewall-gateway.net +my-firewall.org +myfirewall.org +spdns.org + +// Seidat : https://www.seidat.com +// Submitted by Artem Kondratev <accounts@seidat.com> +seidat.net + +// Senseering GmbH : https://www.senseering.de +// Submitted by Felix Mönckemeyer <f.moenckemeyer@senseering.de> +senseering.net + // Service Online LLC : http://drs.ua/ // Submitted by Serhii Bulakh <support@drs.ua> biz.ua co.ua pp.ua +// ShiftEdit : https://shiftedit.net/ +// Submitted by Adam Jimenez <adam@shiftcreate.com> +shiftedit.io + +// Shopblocks : http://www.shopblocks.com/ +// Submitted by Alex Bowers <alex@shopblocks.com> +myshopblocks.com + +// Shopit : https://www.shopitcommerce.com/ +// Submitted by Craig McMahon <craig@shopitcommerce.com> +shopitsite.com + +// shopware AG : https://shopware.com +// Submitted by Jens Küper <cloud@shopware.com> +shopware.store + +// Siemens Mobility GmbH +// Submitted by Oliver Graebner <security@mo-siemens.io> +mo-siemens.io + // SinaAppEngine : http://sae.sina.com.cn/ // Submitted by SinaAppEngine <saesupport@sinacloud.com> +1kapp.com +appchizi.com +applinzi.com sinaapp.com vipsinaapp.com -1kapp.com + +// Siteleaf : https://www.siteleaf.com/ +// Submitted by Skylar Challand <support@siteleaf.com> +siteleaf.net + +// Skyhat : http://www.skyhat.io +// Submitted by Shante Adam <shante@skyhat.io> +bounty-full.com +alpha.bounty-full.com +beta.bounty-full.com + +// Small Technology Foundation : https://small-tech.org +// Submitted by Aral Balkan <aral@small-tech.org> +small-web.org + +// Stackhero : https://www.stackhero.io +// Submitted by Adrien Gillon <adrien+public-suffix-list@stackhero.io> +stackhero-network.com + +// staticland : https://static.land +// Submitted by Seth Vincent <sethvincent@gmail.com> +static.land +dev.static.land +sites.static.land + +// Sony Interactive Entertainment LLC : https://sie.com/ +// Submitted by David Coles <david.coles@sony.com> +playstation-cloud.com + +// SourceLair PC : https://www.sourcelair.com +// Submitted by Antonis Kalipetis <akalipetis@sourcelair.com> +apps.lair.io +*.stolos.io + +// SpaceKit : https://www.spacekit.io/ +// Submitted by Reza Akhavan <spacekit.io@gmail.com> +spacekit.io + +// SpeedPartner GmbH: https://www.speedpartner.de/ +// Submitted by Stefan Neufeind <info@speedpartner.de> +customer.speedpartner.de + +// Standard Library : https://stdlib.com +// Submitted by Jacob Lee <jacob@stdlib.com> +api.stdlib.com + +// Storj Labs Inc. : https://storj.io/ +// Submitted by Philip Hutchins <hostmaster@storj.io> +storj.farm + +// Studenten Net Twente : http://www.snt.utwente.nl/ +// Submitted by Silke Hofstra <syscom@snt.utwente.nl> +utwente.io + +// Student-Run Computing Facility : https://www.srcf.net/ +// Submitted by Edwin Balani <sysadmins@srcf.net> +soc.srcf.net +user.srcf.net + +// Sub 6 Limited: http://www.sub6.com +// Submitted by Dan Miller <dm@sub6.com> +temp-dns.com + +// Swisscom Application Cloud: https://developer.swisscom.com +// Submitted by Matthias.Winzeler <matthias.winzeler@swisscom.com> +applicationcloud.io +scapp.io + +// Symfony, SAS : https://symfony.com/ +// Submitted by Fabien Potencier <fabien@symfony.com> +*.s5y.io +*.sensiosite.cloud + +// Syncloud : https://syncloud.org +// Submitted by Boris Rybalkin <syncloud@syncloud.it> +syncloud.it // Synology, Inc. : https://www.synology.com/ // Submitted by Rony Weng <ronyweng@synology.com> @@ -11321,6 +13144,12 @@ familyds.org i234.me myds.me synology.me +vpnplus.to +direct.quickconnect.to + +// TAIFUN Software AG : http://taifun-software.de +// Submitted by Bjoern Henke <dev-server@taifun-software.de> +taifun-dns.de // TASK geographical domains (www.task.gda.pl/uslugi/dns) gda.pl @@ -11329,6 +13158,94 @@ gdynia.pl med.pl sopot.pl +// Teckids e.V. : https://www.teckids.org +// Submitted by Dominik George <dominik.george@teckids.org> +edugit.org + +// Telebit : https://telebit.cloud +// Submitted by AJ ONeal <aj@telebit.cloud> +telebit.app +telebit.io +*.telebit.xyz + +// The Gwiddle Foundation : https://gwiddlefoundation.org.uk +// Submitted by Joshua Bayfield <joshua.bayfield@gwiddlefoundation.org.uk> +gwiddle.co.uk + +// Thingdust AG : https://thingdust.com/ +// Submitted by Adrian Imboden <adi@thingdust.com> +thingdustdata.com +cust.dev.thingdust.io +cust.disrec.thingdust.io +cust.prod.thingdust.io +cust.testing.thingdust.io +*.firenet.ch +*.svc.firenet.ch + +// Tlon.io : https://tlon.io +// Submitted by Mark Staarink <mark@tlon.io> +arvo.network +azimuth.network +tlon.network + +// TownNews.com : http://www.townnews.com +// Submitted by Dustin Ward <dward@townnews.com> +bloxcms.com +townnews-staging.com + +// TrafficPlex GmbH : https://www.trafficplex.de/ +// Submitted by Phillipp Röll <phillipp.roell@trafficplex.de> +12hp.at +2ix.at +4lima.at +lima-city.at +12hp.ch +2ix.ch +4lima.ch +lima-city.ch +trafficplex.cloud +de.cool +12hp.de +2ix.de +4lima.de +lima-city.de +1337.pictures +clan.rip +lima-city.rocks +webspace.rocks +lima.zone + +// TransIP : https://www.transip.nl +// Submitted by Rory Breuk <rbreuk@transip.nl> +*.transurl.be +*.transurl.eu +*.transurl.nl + +// TuxFamily : http://tuxfamily.org +// Submitted by TuxFamily administrators <adm@staff.tuxfamily.org> +tuxfamily.org + +// TwoDNS : https://www.twodns.de/ +// Submitted by TwoDNS-Support <support@two-dns.de> +dd-dns.de +diskstation.eu +diskstation.org +dray-dns.de +draydns.de +dyn-vpn.de +dynvpn.de +mein-vigor.de +my-vigor.de +my-wan.de +syno-ds.de +synology-diskstation.de +synology-ds.de + +// Uberspace : https://uberspace.de +// Submitted by Moritz Werner <mwerner@jonaspasche.com> +uber.space +*.uberspace.de + // UDR Limited : http://www.udr.hk.com // Submitted by registry <hostmaster@udr.hk.com> hk.com @@ -11336,13 +13253,223 @@ hk.org ltd.hk inc.hk +// United Gameserver GmbH : https://united-gameserver.de +// Submitted by Stefan Schwarz <sysadm@united-gameserver.de> +virtualuser.de +virtual-user.de + +// urown.net : https://urown.net +// Submitted by Hostmaster <hostmaster@urown.net> +urown.cloud +dnsupdate.info + +// .US +// Submitted by Ed Moore <Ed.Moore@lib.de.us> +lib.de.us + +// VeryPositive SIA : http://very.lv +// Submitted by Danko Aleksejevs <danko@very.lv> +2038.io + +// Vercel, Inc : https://vercel.com/ +// Submitted by Connor Davis <security@vercel.com> +vercel.app +vercel.dev +now.sh + +// Viprinet Europe GmbH : http://www.viprinet.com +// Submitted by Simon Kissel <hostmaster@viprinet.com> +router.management + +// Virtual-Info : https://www.virtual-info.info/ +// Submitted by Adnan RIHAN <hostmaster@v-info.info> +v-info.info + +// Voorloper.com: https://voorloper.com +// Submitted by Nathan van Bakel <info@voorloper.com> +voorloper.cloud + +// Voxel.sh DNS : https://voxel.sh/dns/ +// Submitted by Mia Rehlinger <dns@voxel.sh> +neko.am +nyaa.am +be.ax +cat.ax +es.ax +eu.ax +gg.ax +mc.ax +us.ax +xy.ax +nl.ci +xx.gl +app.gp +blog.gt +de.gt +to.gt +be.gy +cc.hn +blog.kg +io.kg +jp.kg +tv.kg +uk.kg +us.kg +de.ls +at.md +de.md +jp.md +to.md +uwu.nu +indie.porn +vxl.sh +ch.tc +me.tc +we.tc +nyan.to +at.vg +blog.vu +dev.vu +me.vu + +// V.UA Domain Administrator : https://domain.v.ua/ +// Submitted by Serhii Rostilo <sergey@rostilo.kiev.ua> +v.ua + +// Waffle Computer Inc., Ltd. : https://docs.waffleinfo.com +// Submitted by Masayuki Note <masa@blade.wafflecell.com> +wafflecell.com + +// WapBlog.ID : https://www.wapblog.id +// Submitted by Fajar Sodik <official@wapblog.id> +idnblogger.com +indowapblog.com +bloghp.id +wblog.id +wbq.me +fastblog.net + +// WebHare bv: https://www.webhare.com/ +// Submitted by Arnold Hendriks <info@webhare.com> +*.webhare.dev + +// WeDeploy by Liferay, Inc. : https://www.wedeploy.com +// Submitted by Henrique Vicente <security@wedeploy.com> +wedeploy.io +wedeploy.me +wedeploy.sh + +// Western Digital Technologies, Inc : https://www.wdc.com +// Submitted by Jung Jin <jungseok.jin@wdc.com> +remotewd.com + +// WIARD Enterprises : https://wiardweb.com +// Submitted by Kidd Hustle <kiddhustle@wiardweb.com> +pages.wiardweb.com + +// Wikimedia Labs : https://wikitech.wikimedia.org +// Submitted by Arturo Borrero Gonzalez <aborrero@wikimedia.org> +wmflabs.org +toolforge.org +wmcloud.org + +// WISP : https://wisp.gg +// Submitted by Stepan Fedotov <stepan@wisp.gg> +panel.gg +daemon.panel.gg + +// WoltLab GmbH : https://www.woltlab.com +// Submitted by Tim Düsterhus <security@woltlab.cloud> +myforum.community +community-pro.de +diskussionsbereich.de +community-pro.net +meinforum.net + +// www.com.vc : http://www.com.vc +// Submitted by Li Hui <lihui@sinopub.com> +cn.vu + +// XenonCloud GbR: https://xenoncloud.net +// Submitted by Julian Uphoff <publicsuffixlist@xenoncloud.net> +half.host + +// XnBay Technology : http://www.xnbay.com/ +// Submitted by XnBay Developer <developer.xncloud@gmail.com> +xnbay.com +u2.xnbay.com +u2-local.xnbay.com + +// XS4ALL Internet bv : https://www.xs4all.nl/ +// Submitted by Daniel Mostertman <unixbeheer+publicsuffix@xs4all.net> +cistron.nl +demon.nl +xs4all.space + +// Yandex.Cloud LLC: https://cloud.yandex.com +// Submitted by Alexander Lodin <security+psl@yandex-team.ru> +yandexcloud.net +storage.yandexcloud.net +website.yandexcloud.net + +// YesCourse Pty Ltd : https://yescourse.com +// Submitted by Atul Bhouraskar <atul@yescourse.com> +official.academy + // Yola : https://www.yola.com/ // Submitted by Stefano Rivera <stefano@yola.com> yolasite.com +// Yombo : https://yombo.net +// Submitted by Mitch Schwenk <mitch@yombo.net> +ybo.faith +yombo.me +homelink.one +ybo.party +ybo.review +ybo.science +ybo.trade + +// Yunohost : https://yunohost.org +// Submitted by Valentin Grimaud <security@yunohost.org> +nohost.me +noho.st + // ZaNiC : http://www.za.net/ // Submitted by registry <hostmaster@nic.za.net> za.net za.org +// Zine EOOD : https://zine.bg/ +// Submitted by Martin Angelov <martin@zine.bg> +bss.design + +// Zitcom A/S : https://www.zitcom.dk +// Submitted by Emil Stahl <esp@zitcom.dk> +basicserver.io +virtualserver.io +enterprisecloud.nu + +// Mintere : https://mintere.com/ +// Submitted by Ben Aubin <security@mintere.com> +mintere.site + +// Cityhost LLC : https://cityhost.ua +// Submitted by Maksym Rivtin <support@cityhost.net.ua> +cx.ua + +// WP Engine : https://wpengine.com/ +// Submitted by Michael Smith <michael.smith@wpengine.com> +// Submitted by Brandon DuRette <brandon.durette@wpengine.com> +wpenginepowered.com +js.wpenginepowered.com + +// Impertrix Solutions : <https://impertrixcdn.com> +// Submitted by Zhixiang Zhao <csuite@impertrix.com> +impertrixcdn.com +impertrix.com + +// GignoSystemJapan: http://gsj.bz +// Submitted by GignoSystemJapan <kakutou-ec@gsj.bz> +gsj.bz // ===END PRIVATE DOMAINS=== diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex index 3b299bdd3ea..5a3adb80b3b 100644 --- a/etc/refcards/cs-refcard.tex +++ b/etc/refcards/cs-refcard.tex @@ -494,7 +494,6 @@ z~minibufferu. Stiskněte \kbd{F10} pro aktivaci menu v~minibufferu. \section{Tagy} \key{najít tag (definici)}{M-.} -\key{najít další výskyt tagu}{C-u M-.} \metax{zadat soubor s novými tagy}{M-x visit-tags-table} \metax{vyhledat reg.\ výraz v~souborech s~tagy}{M-x tags-search} diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex index 21f27479ebf..699dd9054d6 100644 --- a/etc/refcards/cs-survival.tex +++ b/etc/refcards/cs-survival.tex @@ -255,7 +255,6 @@ proměnných, datových typů a dalšího. Pro vytvoření tabulky značek spus příkaz `{\tt etags} {\it vstupní\_soubory}' v příkazovém interpretu. \askip \key{M-.} najdi definici -\key{C-u M-.} najdi další výskyt definice \key{M-*} běž tam, odkud byla volána poslední \kbd{M-.} \mkey{M-x tags-query-replace} spusť query-replace na všech souborech zaznamenaných v tabulce značek. diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex index 6d972ee52b5..29ddf12d49f 100644 --- a/etc/refcards/de-refcard.tex +++ b/etc/refcards/de-refcard.tex @@ -497,7 +497,6 @@ und zu wiederholen, der im Minipuffer aus\-gef\"uhrt wurde. Dr\"u\-cken Sie \section{Tags} \key{Tag finden (Definition)}{M-.} -\key{n\"achstes Vorkommen von Tag finden}{C-u M-.} \metax{neue Tagsdatei angeben}{M-x visit-tags-table} \metax{regul\"aren Ausdruck in Dateien suchen}{M-x tags-search} diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex index 787556d386a..fe303ee8a51 100644 --- a/etc/refcards/fr-refcard.tex +++ b/etc/refcards/fr-refcard.tex @@ -500,7 +500,6 @@ utiliser la barre de menu sur un terminal en utilisant le mini-tampon. \section{Tags} \key{Trouver un tag (une d\'efinition)}{M-.} -\key{Passer \`a l'occurrence suivante du tag}{C-u M-.} \metax{Sp\'ecifier un autre fichier de tags}{M-x visit-tags-table} \metax{Rechercher dans tous les fichiers des tags}{M-x tags-search} diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex index 0aa5df3786c..1cd6852db83 100644 --- a/etc/refcards/fr-survival.tex +++ b/etc/refcards/fr-survival.tex @@ -251,7 +251,6 @@ types de donn\'ees et de tout ce qui peut \^etre pratique. Pour cr\'eer un tel fichier, tapez `{\tt etags} {\it fichier\_entr\'ee}' \`a l'invite du shell. \askip \key{M-.} trouve une d\'efinition -\key{C-u M-.} trouve l'occurrence suivante de la d\'efinition \key{M-*} revient o\`u \kbd{M-.} a \'et\'e appel\'e pour la derni\`ere fois \mkey{M-x tags-query-replace} lance query-replace sur tous les fichiers enregistr\'es dans le tableau des marqueurs diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex index 68acac973b0..2b92fb5545d 100644 --- a/etc/refcards/pl-refcard.tex +++ b/etc/refcards/pl-refcard.tex @@ -690,10 +690,8 @@ Napisz \kbd{F10} aby uaktywni/c menu w minibuforze. \section{Tags} %\key{find a tag (a definition)}{M-.} -%\key{find next occurrence of tag}{C-u M-.} %\metax{specify a new tags file}{M-x visit-tags-table} \key{znajd/x okre/slenie (definicj/e)}{M-.} -\key{znajd/x nast/epne wyst/apienie definicji}{C-u M-.} \metax{podaj nowy plik TAGS}{M-x visit-tags-table} %\metax{regexp search on all files in tags table}{M-x tags-search} diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex index c75fd2f6406..d4e3123458f 100644 --- a/etc/refcards/pt-br-refcard.tex +++ b/etc/refcards/pt-br-refcard.tex @@ -506,7 +506,6 @@ utilizado. Tecle \kbd{F10} para ativar o menu. \section{Tags} \key{busca uma tag (uma defini{\c{c}}{\~a}o)}{M-.} -\key{encontra a pr{\'o}xima ocorr{\^e}ncia da tag}{C-u M-.} \metax{especifica um novo arquivo de tags}{M-x visit-tags-table} \metax{busca por regexp em todos arquivos}{M-x tags-search} diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex index afae238c783..6cac28fabbb 100644 --- a/etc/refcards/refcard.tex +++ b/etc/refcards/refcard.tex @@ -511,7 +511,6 @@ minibuffer. Type \kbd{F10} to activate menu bar items on text terminals. \section{Tags} \key{find a tag (a definition)}{M-.} -\key{find next occurrence of tag}{C-u M-.} \metax{specify a new tags file}{M-x visit-tags-table} \metax{regexp search on all files in tags table}{M-x tags-search} @@ -562,8 +561,8 @@ minibuffer. Type \kbd{F10} to activate menu bar items on text terminals. \key{quote regular expression special character {\it c\/}}{\\{\it c}} \key{alternative (``or'')}{\\|} \key{grouping}{\\( {\rm$\ldots$} \\)} -\key{shy grouping}{\\(:? {\rm$\ldots$} \\)} -\key{explicit numbered grouping}{\\(:NUM {\rm$\ldots$} \\)} +\key{shy grouping}{\\(?: {\rm$\ldots$} \\)} +\key{explicit numbered grouping}{\\(?NUM: {\rm$\ldots$} \\)} \key{same text as {\it n\/}th group}{\\{\it n}} \key{at word break}{\\b} \key{not at word break}{\\B} diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index 0d210b45452..165c00d309c 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -340,7 +340,6 @@ apropos: показать команды, соответствующие стр \begin{tabular}{p{\ColWidth}l} найти определение тега & \kbd{M-.} \\ -найти следующее вхождение тега & \kbd{C-u M-.} \\ использовать новый файл с тегами & \kbd{M-x visit-tags-table} \\ поиск по шаблону по всей таблице тегов & \kbd{M-x tags-search} \\ diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex index 9302e1825e7..b232ea8edf8 100644 --- a/etc/refcards/sk-refcard.tex +++ b/etc/refcards/sk-refcard.tex @@ -494,7 +494,6 @@ z~minibufferu. Stlačte \kbd{F10} pre aktiváciu menu v~minibufferi. \section{Tagy} \key{nájsť tag (definíciu)}{M-.} -\key{nájsť ďalší výskyt tagu}{C-u M-.} \metax{zadať súbor s novými tagmi}{M-x visit-tags-table} \metax{vyhľadať reg.\ výraz v~súboroch s~tagmi}{M-x tags-search} diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex index 5f06c2d11e2..8e5d85f4d39 100644 --- a/etc/refcards/sk-survival.tex +++ b/etc/refcards/sk-survival.tex @@ -258,7 +258,6 @@ premenných, dátových typov a iných. Pre vytvorenie tabuľky značiek spustit príkaz `{\tt etags} {\it vstupné\_súbory}' v príkazovom interprétereri. \askip \key{M-.} nájdi definícu -\key{C-u M-.} nájdi ďalší výskyt definície \key{M-*} choď tam, odkiaľ bola volaná posledná \kbd{M-.} \mkey{M-x tags-query-replace} spusti query-replace na všetkých súboroch zaznamenaných v tabuľke značiek. diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex index 5e73a45b2d7..24204e52006 100644 --- a/etc/refcards/survival.tex +++ b/etc/refcards/survival.tex @@ -243,7 +243,6 @@ else convenient. To create a tags table file, type `{\tt etags} {\it input\_files}' as a shell command. \askip \key{M-.} find a definition -\key{C-u M-.} find next occurrence of definition \key{M-*} pop back to where \kbd{M-.} was last invoked \mkey{M-x tags-query-replace} run query-replace on all files recorded in tags table diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml index f1e0ed7856f..40175b056b1 100644 --- a/etc/schema/schemas.xml +++ b/etc/schema/schemas.xml @@ -1,7 +1,65 @@ <?xml version="1.0"?> +<!-- Copyright (C) 2003-2004, 2007-2020 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/>. --> + <locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0"> + <transformURI fromPattern="*.xml" toPattern="*.rnc"/> + + <uri pattern="*.xsl" typeId="XSLT"/> + <uri pattern="*.html" typeId="XHTML"/> + <uri pattern="*.rng" typeId="RELAX NG"/> + <uri pattern="*.rdf" typeId="RDF"/> + <uri pattern="*.dbk" typeId="DocBook"/> + + <namespace ns="http://www.w3.org/1999/XSL/Transform" typeId="XSLT"/> + <namespace ns="http://www.w3.org/1999/02/22-rdf-syntax-ns#" typeId="RDF"/> + <namespace ns="http://www.w3.org/1999/xhtml" typeId="XHTML"/> + <namespace ns="http://relaxng.org/ns/structure/1.0" typeId="RELAX NG"/> + <namespace ns="http://thaiopensource.com/ns/locating-rules/1.0" + uri="locate.rnc"/> + + <documentElement localName="stylesheet" typeId="XSLT"/> + <documentElement prefix="xsl" localName="transform" typeId="XSLT"/> + + <documentElement localName="html" typeId="XHTML"/> + + <documentElement localName="grammar" typeId="RELAX NG"/> + + <documentElement prefix="" localName="article" typeId="DocBook"/> + <documentElement prefix="" localName="book" typeId="DocBook"/> + <documentElement prefix="" localName="chapter" typeId="DocBook"/> + <documentElement prefix="" localName="part" typeId="DocBook"/> + <documentElement prefix="" localName="refentry" typeId="DocBook"/> + <documentElement prefix="" localName="section" typeId="DocBook"/> + + <documentElement localName="RDF" typeId="RDF"/> + <documentElement prefix="rdf" typeId="RDF"/> + + <documentElement localName="locatingRules" uri="locate.rnc"/> + + <typeId id="XSLT" uri="xslt.rnc"/> + <typeId id="RELAX NG" uri="relaxng.rnc"/> + <typeId id="XHTML" uri="xhtml.rnc"/> + <typeId id="DocBook" uri="docbook.rnc"/> + <typeId id="RDF" uri="rdfxml.rnc"/> + <documentElement prefix="office" typeId="OpenDocument"/> <documentElement prefix="manifest" localName="manifest" typeId="OpenDocument Manifest"/> <typeId id="OpenDocument" uri="od-schema-v1.2-os.rnc"/> <typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-os.rnc"/> + </locatingRules> diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index ac395f993c9..195d40d7af6 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -62,7 +62,7 @@ ;; org-mode, CUA-mode, apt-utils, bbdb, compilation buffers, changelog ;; mode, diff and ediff, eshell, and more. You need emacs-goodies ;; package on Debian to use this. See the wiki page at -;; http://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The +;; https://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The ;; project home page is at https://gna.org/projects/color-theme. ;;; Code: diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index c1090eedefd..db61c97b766 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -1,10 +1,10 @@ ;;; modus-operandi-theme.el --- Accessible light theme (WCAG AAA) -*- lexical-binding:t -*- -;; Copyright (c) 2019-2020 Free Software Foundation, Inc. +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 0.12.0 +;; Version: 0.13.0 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: faces, theme, accessibility @@ -42,17 +42,18 @@ ;; modus-operandi-theme-slanted-constructs (boolean) ;; modus-operandi-theme-bold-constructs (boolean) ;; modus-operandi-theme-variable-pitch-headings (boolean) -;; modus-operandi-theme-rainbow-headings (boolean) -;; modus-operandi-theme-section-headings (boolean) +;; modus-operandi-theme-no-mixed-fonts (boolean) +;; modus-operandi-theme-headings (alist) ;; modus-operandi-theme-scale-headings (boolean) ;; modus-operandi-theme-fringes (choice) ;; modus-operandi-theme-org-blocks (choice) ;; modus-operandi-theme-prompts (choice) -;; modus-operandi-theme-3d-modeline (boolean) -;; modus-operandi-theme-subtle-diffs (boolean) +;; modus-operandi-theme-mode-line (choice) +;; modus-operandi-theme-diffs (choice) ;; modus-operandi-theme-faint-syntax (boolean) ;; modus-operandi-theme-intense-hl-line (boolean) ;; modus-operandi-theme-intense-paren-match (boolean) +;; modus-operandi-theme-no-link-underline (boolean) ;; modus-operandi-theme-completions (choice) ;; modus-operandi-theme-override-colors-alist (alist) ;; @@ -81,6 +82,8 @@ ;; auctex and TeX ;; auto-dim-other-buffers ;; avy +;; awesome-tray +;; binder ;; bm ;; bongo ;; boon @@ -103,6 +106,7 @@ ;; counsel-notmuch ;; counsel-org-capture-string ;; cov +;; cperl-mode ;; csv-mode ;; ctrlf ;; custom (M-x customize) @@ -116,6 +120,7 @@ ;; diff-hl ;; diff-mode ;; dim-autoload +;; dir-treeview ;; dired ;; dired-async ;; dired-git @@ -132,6 +137,7 @@ ;; ediff ;; eglot ;; el-search +;; eldoc ;; eldoc-box ;; elfeed ;; elfeed-score @@ -146,6 +152,7 @@ ;; eshell-fringe-status ;; eshell-git-prompt ;; eshell-prompt-extras (epe) +;; eshell-syntax-highlighting ;; evil (evil-mode) ;; evil-goggles ;; evil-visual-mark-mode @@ -153,6 +160,7 @@ ;; eyebrowse ;; fancy-dabbrev ;; flycheck +;; flycheck-color-mode-line ;; flycheck-indicator ;; flycheck-posframe ;; flymake @@ -229,6 +237,7 @@ ;; minimap ;; modeline ;; mood-line +;; mpdel ;; mu4e ;; mu4e-conversation ;; multiple-cursors @@ -237,6 +246,7 @@ ;; notmuch ;; num3-mode ;; nxml-mode +;; objed ;; orderless ;; org ;; org-journal @@ -266,6 +276,7 @@ ;; powerline-evil ;; proced ;; prodigy +;; racket-mode ;; rainbow-blocks ;; rainbow-identifiers ;; rainbow-delimiters @@ -308,6 +319,7 @@ ;; treemacs ;; tty-menu ;; tuareg +;; typescript ;; undo-tree ;; vc (built-in mode line status for version control) ;; vc-annotate (C-x v g) @@ -411,11 +423,19 @@ between foreground and background is >= 7:1)." (defface modus-theme-diff-focus-changed nil nil) (defface modus-theme-diff-focus-removed nil nil) (defface modus-theme-diff-heading nil nil) -(defface modus-theme-header nil nil) ; Name is tentative +(defface modus-theme-pseudo-header nil nil) (defface modus-theme-mark-alt nil nil) (defface modus-theme-mark-del nil nil) (defface modus-theme-mark-sel nil nil) (defface modus-theme-mark-symbol nil nil) +(defface modus-theme-heading-1 nil nil) +(defface modus-theme-heading-2 nil nil) +(defface modus-theme-heading-3 nil nil) +(defface modus-theme-heading-4 nil nil) +(defface modus-theme-heading-5 nil nil) +(defface modus-theme-heading-6 nil nil) +(defface modus-theme-heading-7 nil nil) +(defface modus-theme-heading-8 nil nil) (defface modus-theme-hl-line nil nil) ;;; Customisation options @@ -441,14 +461,125 @@ between foreground and background is >= 7:1)." "Use proportional fonts (variable-pitch) in headings." :type 'boolean) +(defcustom modus-operandi-theme-no-mixed-fonts nil + "Disable inheritance from `fixed-pitch' in some faces. + +This is done by default to allow spacing-sensitive constructs, +such as Org tables and code blocks, to remain monospaced when +users opt for something like the command `variable-pitch-mode'. +The downside with the default is that users need to explicitly +configure the font family of `fixed-pitch' in order to get a +consistent experience. That may be something they do not want to +do. Hence this option to disable any kind of technique for +mixing fonts." + :type 'boolean) + +(make-obsolete 'modus-operandi-theme-rainbow-headings + 'modus-operandi-theme-headings + "`modus-operandi-theme' 0.13.0") + (defcustom modus-operandi-theme-rainbow-headings nil "Use more saturated colours for headings." :type 'boolean) +(make-obsolete 'modus-operandi-theme-section-headings + 'modus-operandi-theme-headings + "`modus-operandi-theme' 0.13.0") + (defcustom modus-operandi-theme-section-headings nil "Use a background and an overline in headings." :type 'boolean) +(defcustom modus-operandi-theme-headings + '((t . nil)) + "Alist of styles for headings, with optional value per level. + +To control faces per level from 1-8, use something like this: + + (setq modus-operandi-theme-headings + '((1 . highlight) + (2 . line) + (t . rainbow-line-no-bold))) + +To set a uniform value for all heading levels, use this pattern: + + (setq modus-operandi-theme-headings + '((t . rainbow-line-no-bold))) + +The default uses a fairly desaturated foreground value in +combination with a bold typographic weight. To specify this +style for a given level N (assuming you wish to have another +fallback option), just specify the value t like this: + + (setq modus-operandi-theme-headings + '((1 . t) + (2 . line) + (t . rainbow-line-no-bold))) + +A description of all possible values: + ++ `no-bold' retains the default text colour while removing + the typographic weight. + ++ `line' is the same as the default plus an overline over the + heading. + ++ `line-no-bold' is the same as `line' without bold weight. + ++ `rainbow' uses a more colourful foreground in combination + with bold weight. + ++ `rainbow-line' is the same as `rainbow' plus an overline. + ++ `rainbow-line-no-bold' is the same as `rainbow-line' without + the bold weight. + ++ `highlight' retains the default style of a fairly desaturated + foreground combined with a bold weight and add to it a subtle + accented background. + ++ `highlight-no-bold' is the same as `highlight' without a bold + weight. + ++ `rainbow-highlight' is the same as `highlight' but with a more + colourful foreground. + ++ `rainbow-highlight-no-bold' is the same as `rainbow-highlight' + without a bold weight. + ++ `section' retains the default looks and adds to them both an + overline and a slightly accented background. It is, in effect, + a combination of the `line' and `highlight' values. + ++ `section-no-bold' is the same as `section' without a bold + weight. + ++ `rainbow-section' is the same as `section' but with a more + colourful foreground. + ++ `rainbow-section-no-bold' is the same as `rainbow-section' + without a bold weight." + :type + '(alist + :key-type symbol + :value-type + (choice (const :tag "Fairly desaturated foreground with bold weight (default)" t) + (const :tag "Like the default without bold weight" no-bold) + (const :tag "Like the default plus overline" line) + (const :tag "Like `line' without bold weight" line-no-bold) + (const :tag "Like the default but with more colourful foreground" rainbow) + (const :tag "Like `rainbow' plus overline" rainbow-line) + (const :tag "Like `rainbow' without bold weight" rainbow-no-bold) + (const :tag "Like `rainbow-line' without bold weight" rainbow-line-no-bold) + (const :tag "Like the default plus subtle background" highlight) + (const :tag "Like `highlight' without bold weight" highlight-no-bold) + (const :tag "Like `highlight' with more colourful foreground" rainbow-highlight) + (const :tag "Like `rainbow-highlight' without bold weight" rainbow-highlight-no-bold) + (const :tag "Like `highlight' plus overline" section) + (const :tag "Like `section' without bold weight" section-no-bold) + (const :tag "Like `section' with more colourful foreground" rainbow-section) + (const :tag "Like `rainbow-section' without bold weight" rainbow-section-no-bold)))) + (defcustom modus-operandi-theme-scale-headings nil "Use font scaling for headings." :type 'boolean) @@ -508,8 +639,9 @@ For more on the matter, read the documentation of `set-face-attribute', specifically the ':height' section." :type 'number) -(define-obsolete-variable-alias 'modus-operandi-theme-visible-fringes - 'modus-operandi-theme-fringes "`modus-operandi-theme' 0.12.0") +(make-obsolete 'modus-operandi-theme-visible-fringes + 'modus-operandi-theme-fringes + "`modus-operandi-theme' 0.12.0") (defcustom modus-operandi-theme-visible-fringes nil "Use a visible style for fringes." @@ -527,15 +659,17 @@ pronounced greyscale value." (const :tag "Subtle greyscale background" subtle) (const :tag "Intense greyscale background" intense))) -(define-obsolete-variable-alias 'modus-operandi-theme-distinct-org-blocks - 'modus-operandi-theme-org-blocks "`modus-operandi-theme' 0.11.0") +(make-obsolete 'modus-operandi-theme-distinct-org-blocks + 'modus-operandi-theme-org-blocks + "`modus-operandi-theme' 0.11.0") (defcustom modus-operandi-theme-distinct-org-blocks nil "Use a distinct neutral background for `org-mode' blocks." :type 'boolean) -(define-obsolete-variable-alias 'modus-operandi-theme-rainbow-org-src-blocks - 'modus-operandi-theme-org-blocks "`modus-operandi-theme' 0.11.0") +(make-obsolete 'modus-operandi-theme-rainbow-org-src-blocks + 'modus-operandi-theme-org-blocks + "`modus-operandi-theme' 0.11.0") (defcustom modus-operandi-theme-rainbow-org-src-blocks nil "Use colour-coded backgrounds for `org-mode' source blocks. @@ -565,16 +699,69 @@ association list)." (const :tag "Subtle grey block background" greyscale) (const :tag "Colour-coded background per programming language" rainbow))) +(make-obsolete 'modus-operandi-theme-3d-modeline + 'modus-operandi-theme-mode-line + "`modus-operandi-theme' 0.13.0") + (defcustom modus-operandi-theme-3d-modeline nil "Use a three-dimensional style for the active mode line." :type 'boolean) +(defcustom modus-operandi-theme-mode-line nil + "Adjust the overall style of the mode line. + +Nil is a two-dimensional rectangle with a border around it. The +active and the inactive modelines use different shades of +greyscale values for the background and foreground. + +A `3d' value will apply a three-dimensional effect to the active +modeline. The inactive modelines remain two-dimensional and are +toned down a bit, relative to the nil value. + +The `moody' option is meant to optimise the modeline for use with +the library of the same name. This practically means to remove +the box effect and rely on underline and overline properties +instead. It also tones down the inactive modelines. Despite its +intended purpose, this option can also be used without the +`moody' library." + :type '(choice + (const :tag "Two-dimensional box (default)" nil) + (const :tag "Three-dimensional style for the active mode line" 3d) + (const :tag "No box effects, which are optimal for use with the `moody' library" moody))) + +(make-obsolete 'modus-operandi-theme-subtle-diffs + 'modus-operandi-theme-diffs + "`modus-operandi-theme' 0.13.0") + (defcustom modus-operandi-theme-subtle-diffs nil "Use fewer/dim backgrounds in `diff-mode', `ediff',`magit'." :type 'boolean) -(define-obsolete-variable-alias 'modus-operandi-theme-intense-standard-completions - 'modus-operandi-theme-completions "`modus-operandi-theme' 0.12.0") +(defcustom modus-operandi-theme-diffs nil + "Adjust the overall styles of diffs. + +Nil means to use fairly intense colour combinations for diffs. +For example, you get a rich green background with a green +foreground for added lines. Word-wise or 'refined' diffs follow +the same pattern but use different shades of those colours to +remain distinct. + +A `desaturated' value follows the same principles as with the nil +option, while it tones down all relevant colours. + +Option `fg-only' will remove all accented backgrounds, except +from word-wise changes. It instead uses colour-coded foreground +values to differentiate between added/removed/changed lines. If +a background is necessary, such as with `ediff', then a subtle +greyscale value is used." + :type '(choice + (const :tag "Intensely coloured backgrounds (default)" nil) + (const :tag "Slightly accented backgrounds with tinted text" desaturated) + (const :tag "No backgrounds, except for refined diffs" fg-only))) + +(make-obsolete 'modus-operandi-theme-intense-standard-completions + 'modus-operandi-theme-completions + "`modus-operandi-theme' 0.12.0") (defcustom modus-operandi-theme-intense-standard-completions nil "Use prominent backgrounds for Icomplete, Ido, or similar." @@ -582,6 +769,7 @@ association list)." (defcustom modus-operandi-theme-completions nil "Apply special styles to the UI of completion frameworks. + This concerns Icomplete, Ivy, Helm, Selectrum, Ido, as well as any other tool meant to enhance their experience. The effect will vary depending on the completion framework. @@ -621,7 +809,7 @@ effect than the former." (const :tag "Intense background and foreground for the prompt" intense))) (defcustom modus-operandi-theme-intense-hl-line nil - "Use more prominent background for `hl-line-mode'." + "Use more prominent background for command `hl-line-mode'." :type 'boolean) (defcustom modus-operandi-theme-intense-paren-match nil @@ -632,6 +820,10 @@ effect than the former." "Use less saturated colours for code syntax highlighting." :type 'boolean) +(defcustom modus-operandi-theme-no-link-underline nil + "Do not underline links." + :type 'boolean) + ;;; Internal functions ;; Helper functions that are meant to ease the implementation of the @@ -641,6 +833,11 @@ effect than the former." (when modus-operandi-theme-bold-constructs (list :inherit 'bold))) +(defun modus-operandi-theme-mixed-fonts () + "Conditional application of `fixed-pitch' inheritance." + (unless modus-operandi-theme-no-mixed-fonts + (list :inherit 'fixed-pitch))) + (defun modus-operandi-theme-fringe (subtlebg intensebg) "Conditional use of background colours for fringes. SUBTLEBG should be a subtle greyscale value. INTENSEBG must be a @@ -679,29 +876,65 @@ FAINT is the less saturated colour." (list :foreground faint) (list :foreground normal))) -(defun modus-operandi-theme-heading-foreground (subtle rainbow) - "Apply foreground value to headings. -SUBTLE is the default aesthetic. RAINBOW is the saturated one." - (if modus-operandi-theme-rainbow-headings - (list :foreground rainbow) - (list :foreground subtle))) - -(defun modus-operandi-theme-heading-block (bg fg) - "Conditionally extend heading styles. -Apply BG to background and FG to overline." - (if modus-operandi-theme-section-headings - (append - (and (>= emacs-major-version 27) '(:extend t)) - (list :background bg :overline fg)) - (list :background nil :overline nil))) +(defun modus-operandi-theme-heading-p (key) + "Query style of KEY in `modus-operandi-theme-headings'." + (cdr (assoc key modus-operandi-theme-headings))) -(defun modus-operandi-theme-org-todo-block (bgbox fgbox fg) - "Conditionally extend the styles of Org keywords. -BGBOX applies to the background. FGBOX applies to the foreground -and the border. FG is used when no block style is in effect." - (if modus-operandi-theme-section-headings - (list :background bgbox :foreground fgbox :box (list :color fgbox)) - (list :foreground fg))) +(defun modus-operandi-theme-heading (level fg fg-alt bg border) + "Conditional styles for `modus-operandi-theme-headings'. + +LEVEL is the heading's position in their order. FG is the +default text colour. FG-ALT is an accented, more saturated value +than the default. BG is a nuanced, typically accented, +background that can work well with either of the foreground +values. BORDER is a colour value that combines well with the +background and alternative foreground." + (let* ((key (modus-operandi-theme-heading-p `,level)) + (style (or key (modus-operandi-theme-heading-p t))) + (var (if modus-operandi-theme-variable-pitch-headings + 'variable-pitch + 'default))) + (pcase style + ('no-bold + (list :inherit `,var :foreground fg)) + ('line + (list :inherit `(bold ,var) :foreground fg :overline border)) + ('line-no-bold + (list :inherit `,var :foreground fg :overline border)) + ('rainbow + (list :inherit `(bold ,var) :foreground fg-alt)) + ('rainbow-no-bold + (list :inherit `,var :foreground fg-alt)) + ('rainbow-line + (list :inherit `(bold ,var) :foreground fg-alt :overline border)) + ('rainbow-line-no-bold + (list :inherit `,var :foreground fg-alt :overline border)) + ('highlight + (list :inherit `(bold ,var) :background bg :foreground fg)) + ('highlight-no-bold + (list :inherit `,var :background bg :foreground fg)) + ('rainbow-highlight + (list :inherit `(bold ,var) :background bg :foreground fg-alt)) + ('rainbow-highlight-no-bold + (list :inherit `,var :background bg :foreground fg-alt)) + ('section + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `(bold ,var) :background bg :foreground fg :overline border))) + ('section-no-bold + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `,var :background bg :foreground fg :overline border))) + ('rainbow-section + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `(bold ,var) :background bg :foreground fg-alt :overline border))) + ('rainbow-section-no-bold + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `,var :background bg :foreground fg-alt :overline border))) + (_ + (list :inherit `(bold ,var) :foreground fg))))) (defun modus-operandi-theme-org-block (bgblk) "Conditionally set the background of Org blocks. @@ -737,46 +970,64 @@ set to `rainbow'." ('rainbow (list :background bgaccent :foreground fgaccent)) (_ (list :background bg :foreground fg)))) -(defun modus-operandi-theme-modeline-box (col3d col &optional btn int) - "Control the box properties of the mode line. -COL3D is the border that is intended for the three-dimensional -modeline. COL applies to the two-dimensional modeline. Optional -BTN provides the 3d button style. Optional INT defines a border -width." - (let* ((style (if btn 'released-button nil)) - (int (if int int 1))) - (if modus-operandi-theme-3d-modeline - (list :line-width int :color col3d :style style) - (list :line-width 1 :color col :style nil)))) - -(defun modus-operandi-theme-modeline-props (bg3d fg3d &optional bg fg) - "Control the background and foreground of the mode line. -BG is the modeline's background. FG is the modeline's -foreground. BG3D and FG3D apply to the three-dimensional -modeline style." - (if modus-operandi-theme-3d-modeline - (list :background bg3d :foreground fg3d) - (list :background bg :foreground fg))) - -(defun modus-operandi-theme-diffs (subtle-bg subtle-fg intense-bg intense-fg) - "Colour combinations for `modus-operandi-theme-subtle-diffs'. - -SUBTLE-BG should be similar or the same as the main background. -SUBTLE-FG should be an appropriate accent value. INTENSE-BG -should be one of the dedicated backgrounds for diffs. INTENSE-FG -should be one of the dedicated foregrounds for diffs" - (if modus-operandi-theme-subtle-diffs - (list :background subtle-bg :foreground subtle-fg) - (list :background intense-bg :foreground intense-fg))) +(defun modus-operandi-theme-mode-line-attrs + (fg bg fg-alt bg-alt border border-3d &optional alt-style border-width fg-distant) + "Colour combinations for `modus-operandi-theme-mode-line'. + +FG and BG are the default colours. FG-ALT and BG-ALT are meant +to accommodate the options for a 3D modeline or a `moody' +compliant one. BORDER applies to all permutations of the +modeline, except the three-dimensional effect, where BORDER-3D is +used instead. + +Optional ALT-STYLE applies an appropriate style to the mode +line's box property. + +Optional BORDER-WIDTH specifies an integer for the width of the +rectangle that produces the box effect. + +Optional FG-DISTANT should be close to the main background +values. It is intended to be used as a distant-foreground +property." + (pcase modus-operandi-theme-mode-line + ('3d + `(:background ,bg-alt :foreground ,fg-alt + :box (:line-width ,(or border-width 1) + :color ,border-3d + :style ,(and alt-style 'released-button)))) + ('moody + `(:background ,bg-alt :foreground ,fg-alt :underline ,border :overline ,border + :distant-foreground ,fg-distant)) + (_ + `(:foreground ,fg :background ,bg :box ,border)))) + +(defun modus-operandi-theme-diff (fg-only-bg fg-only-fg mainbg mainfg altbg altfg) + "Colour combinations for `modus-operandi-theme-diffs'. + +FG-ONLY-BG should be similar or the same as the main background. +FG-ONLY-FG should be a saturated accent value that can be +combined with the former. + +MAINBG must be one of the dedicated backgrounds for diffs while +MAINFG must be the same for the foreground. + +ALTBG needs to be a slightly accented background that is meant to +be combined with ALTFG. Both must be less intense than MAINBG +and MAINFG respectively." + (pcase modus-operandi-theme-diffs + ('fg-only (list :background fg-only-bg :foreground fg-only-fg)) + ('desaturated (list :background altbg :foreground altfg)) + (_ (list :background mainbg :foreground mainfg)))) (defun modus-operandi-theme-standard-completions (mainfg subtlebg intensebg intensefg) "Combinations for `modus-operandi-theme-completions'. -These are intended for Icomplete, Ido, and related. MAINFG is an accented foreground value. SUBTLEBG is an accented background value that can be combined with MAINFG. INTENSEBG and INTENSEFG are accented colours that are designed to be used in -tandem." +tandem. + +These are intended for Icomplete, Ido, and related." (pcase modus-operandi-theme-completions ('opinionated (list :background intensebg :foreground intensefg)) ('moderate (list :background subtlebg :foreground mainfg)) @@ -784,7 +1035,6 @@ tandem." (defun modus-operandi-theme-extra-completions (subtleface intenseface altface &optional altfg bold) "Combinations for `modus-operandi-theme-completions'. -These are intended for Helm, Ivy, Selectrum, etc. SUBTLEFACE and INTENSEFACE are custom theme faces that combine a background and foreground value. The difference between the two @@ -794,10 +1044,12 @@ ALTFACE is a combination of colours that represents a departure from the UI's default aesthetics. Optional ALTFG is meant to be used in tandem with it. -Optional BOLD will apply a heavier weight to the text." +Optional BOLD will apply a heavier weight to the text. + +These are intended for Helm, Ivy, etc." (pcase modus-operandi-theme-completions ('opinionated (list :inherit (list altface bold) - :foreground (if altfg altfg 'unspecified))) + :foreground (or altfg 'unspecified))) ('moderate (list :inherit (list subtleface bold))) (_ (list :inherit (list intenseface bold))))) @@ -826,8 +1078,8 @@ AMOUNT is a customisation option." ;; specifically for on/off states (e.g. `mode-line') ;; ;; must be combined with themselves - ("bg-active" . "#e0e0e0") ("fg-active" . "#191919") - ("bg-inactive" . "#efedef") ("fg-inactive" . "#424242") + ("bg-active" . "#d7d7d7") ("fg-active" . "#0a0a0a") + ("bg-inactive" . "#efefef") ("fg-inactive" . "#404148") ;; special base values, used only for cases where the above ;; fg-* or bg-* cannot or should not be used (to avoid confusion) ;; must be combined with: {fg,bg}-{main,alt,dim} @@ -839,19 +1091,19 @@ AMOUNT is a customisation option." ;; ;; must be combined with: `bg-main', `bg-alt', `bg-dim' ("red" . "#a60000") ("green" . "#005e00") - ("yellow" . "#813e00") ("blue" . "#0030a6") + ("yellow" . "#813e00") ("blue" . "#0031a9") ("magenta" . "#721045") ("cyan" . "#00538b") ;; styles for common, but still specialised constructs ;; ;; must be combined with: `bg-main', `bg-alt', `bg-dim' ("red-alt" . "#972500") ("green-alt" . "#315b00") - ("yellow-alt" . "#70480f") ("blue-alt" . "#223fbf") + ("yellow-alt" . "#70480f") ("blue-alt" . "#2544bb") ("magenta-alt" . "#8f0075") ("cyan-alt" . "#30517f") ;; same purpose as above, just slight differences ;; ;; must be combined with: `bg-main', `bg-alt', `bg-dim' ("red-alt-other" . "#a0132f") ("green-alt-other" . "#145c33") - ("yellow-alt-other" . "#863927") ("blue-alt-other" . "#0000bb") + ("yellow-alt-other" . "#863927") ("blue-alt-other" . "#0000c0") ("magenta-alt-other" . "#5317ac") ("cyan-alt-other" . "#005a5f") ;; styles for desaturated foreground text, intended for use with ;; the `modus-operandi-theme-faint-syntax' option @@ -915,21 +1167,24 @@ AMOUNT is a customisation option." ;; styles that are meant exclusively for the mode line ;; ;; must be combined with: `bg-active', `bg-inactive' - ("red-active" . "#930000") ("green-active" . "#005300") - ("yellow-active" . "#703700") ("blue-active" . "#0033c0") - ("magenta-active" . "#6320a0") ("cyan-active" . "#004882") + ("red-active" . "#8a0000") ("green-active" . "#004c2e") + ("yellow-active" . "#702d1f") ("blue-active" . "#0030b4") + ("magenta-active" . "#5c2092") ("cyan-active" . "#003f8a") ;; styles that are meant exclusively for the fringes ;; - ;; must have a minimum contrast ratio of 1.5:1 with `bg-inactive' - ;; and be combined with `fg-main' or `fg-dim' - ("red-fringe-bg" . "#ff9a9a") ("green-fringe-bg" . "#86cf86") - ("yellow-fringe-bg" . "#e0c050") ("blue-fringe-bg" . "#82afff") - ("magenta-fringe-bg" . "#f0a3ff") ("cyan-fringe-bg" . "#00d6e0") + ;; must be combined with `fg-main' + ("red-fringe-bg" . "#f08290") ("green-fringe-bg" . "#62c86a") + ("yellow-fringe-bg" . "#dbba3f") ("blue-fringe-bg" . "#82afff") + ("magenta-fringe-bg" . "#e0a3ff") ("cyan-fringe-bg" . "#2fcddf") ;; styles reserved for specific faces ;; ;; `bg-hl-line' is between `bg-dim' and `bg-alt', so it should ;; work with all accents that cover those two, plus `bg-main' ;; + ;; `bg-hl-alt' and `bg-hl-alt-intense' should only be used when no + ;; other greyscale or fairly neutral background is available to + ;; properly draw attention to a given construct + ;; ;; `bg-header' is between `bg-active' and `bg-inactive', so it ;; can be combined with any of the "active" values, plus the ;; "special" and base foreground colours @@ -960,8 +1215,11 @@ AMOUNT is a customisation option." ;; ;; all pairs are combinable with themselves ("bg-hl-line" . "#f2eff3") + ("bg-hl-line-intense" . "#e0e0e0") + ("bg-hl-alt" . "#fbeee0") + ("bg-hl-alt-intense" . "#e8dfd1") ("bg-paren-match" . "#e0af82") - ("bg-paren-match-intense" . "#70af9f") + ("bg-paren-match-intense" . "#c488ff") ("bg-region" . "#bcbcbc") ("bg-tab-bar" . "#d5d5d5") @@ -1094,12 +1352,12 @@ Also bind `class' to ((class color) (min-colors 89))." `(modus-theme-nuanced-cyan ((,class :background ,cyan-nuanced-bg ,@(and (>= emacs-major-version 27) '(:extend t))))) ;;;;; fringe-specific combinations - `(modus-theme-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-dim))) + `(modus-theme-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-main))) ;;;;; special base values ;; these are closer to the grayscale than the accents defined above ;; and should only be used when the next closest alternative would be @@ -1110,26 +1368,96 @@ Also bind `class' to ((class color) (min-colors 89))." `(modus-theme-special-calm ((,class :background ,bg-special-calm :foreground ,fg-special-calm))) ;;;;; diff-specific combinations ;; intended for `diff-mode' or equivalent - `(modus-theme-diff-added ((,class :background ,bg-diff-added :foreground ,fg-diff-added))) - `(modus-theme-diff-changed ((,class :background ,bg-diff-changed :foreground ,fg-diff-changed))) - `(modus-theme-diff-removed ((,class :background ,bg-diff-removed :foreground ,fg-diff-removed))) - `(modus-theme-diff-refine-added ((,class :background ,bg-diff-refine-added :foreground ,fg-diff-refine-added))) - `(modus-theme-diff-refine-changed ((,class :background ,bg-diff-refine-changed :foreground ,fg-diff-refine-changed))) - `(modus-theme-diff-refine-removed ((,class :background ,bg-diff-refine-removed :foreground ,fg-diff-refine-removed))) - `(modus-theme-diff-focus-added ((,class :background ,bg-diff-focus-added :foreground ,fg-diff-focus-added))) - `(modus-theme-diff-focus-changed ((,class :background ,bg-diff-focus-changed :foreground ,fg-diff-focus-changed))) - `(modus-theme-diff-focus-removed ((,class :background ,bg-diff-focus-removed :foreground ,fg-diff-focus-removed))) - `(modus-theme-diff-heading ((,class :background ,bg-diff-heading :foreground ,fg-diff-heading))) + `(modus-theme-diff-added + ((,class ,@(modus-operandi-theme-diff + bg-main green + bg-diff-focus-added fg-diff-focus-added + green-nuanced-bg fg-diff-added)))) + `(modus-theme-diff-changed + ((,class ,@(modus-operandi-theme-diff + bg-main yellow + bg-diff-focus-changed fg-diff-focus-changed + yellow-nuanced-bg fg-diff-changed)))) + `(modus-theme-diff-removed + ((,class ,@(modus-operandi-theme-diff + bg-main red + bg-diff-focus-removed fg-diff-focus-removed + red-nuanced-bg fg-diff-removed)))) + `(modus-theme-diff-refine-added + ((,class ,@(modus-operandi-theme-diff + bg-diff-added fg-diff-added + bg-diff-refine-added fg-diff-refine-added + bg-diff-focus-added fg-diff-focus-added)))) + `(modus-theme-diff-refine-changed + ((,class ,@(modus-operandi-theme-diff + bg-diff-changed fg-diff-changed + bg-diff-refine-changed fg-diff-refine-changed + bg-diff-focus-changed fg-diff-focus-changed)))) + `(modus-theme-diff-refine-removed + ((,class ,@(modus-operandi-theme-diff + bg-diff-removed fg-diff-removed + bg-diff-refine-removed fg-diff-refine-removed + bg-diff-focus-removed fg-diff-focus-removed)))) + `(modus-theme-diff-focus-added + ((,class ,@(modus-operandi-theme-diff + bg-dim green + bg-diff-focus-added fg-diff-focus-added + bg-diff-added fg-diff-added)))) + `(modus-theme-diff-focus-changed + ((,class ,@(modus-operandi-theme-diff + bg-dim yellow + bg-diff-focus-changed fg-diff-focus-changed + bg-diff-changed fg-diff-changed)))) + `(modus-theme-diff-focus-removed + ((,class ,@(modus-operandi-theme-diff + bg-dim red + bg-diff-focus-removed fg-diff-focus-removed + bg-diff-removed fg-diff-removed)))) + `(modus-theme-diff-heading + ((,class ,@(modus-operandi-theme-diff + bg-alt blue-alt + bg-diff-heading fg-diff-heading + blue-nuanced-bg blue)))) ;;;;; mark indicators ;; colour combinations intended for Dired, Ibuffer, or equivalent - `(modus-theme-header ((,class :inherit bold :foreground ,fg-main))) + `(modus-theme-pseudo-header ((,class :inherit bold :foreground ,fg-main))) `(modus-theme-mark-alt ((,class :inherit bold :background ,bg-mark-alt :foreground ,fg-mark-alt))) `(modus-theme-mark-del ((,class :inherit bold :background ,bg-mark-del :foreground ,fg-mark-del))) `(modus-theme-mark-sel ((,class :inherit bold :background ,bg-mark-sel :foreground ,fg-mark-sel))) `(modus-theme-mark-symbol ((,class :inherit bold :foreground ,blue-alt))) +;;;;; heading levels + ;; styles for regular headings used in Org, Markdown, Info, etc. + `(modus-theme-heading-1 + ((,class ,@(modus-operandi-theme-heading + 1 fg-main magenta-alt-other magenta-nuanced-bg bg-region) + ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)))) + `(modus-theme-heading-2 + ((,class ,@(modus-operandi-theme-heading + 2 fg-special-warm magenta-alt red-nuanced-bg bg-region) + ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3)))) + `(modus-theme-heading-3 + ((,class ,@(modus-operandi-theme-heading + 3 fg-special-cold blue blue-nuanced-bg bg-region) + ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2)))) + `(modus-theme-heading-4 + ((,class ,@(modus-operandi-theme-heading + 4 fg-special-mild cyan cyan-nuanced-bg bg-region) + ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1)))) + `(modus-theme-heading-5 + ((,class ,@(modus-operandi-theme-heading + 5 fg-special-calm green-alt-other green-nuanced-bg bg-region)))) + `(modus-theme-heading-6 + ((,class ,@(modus-operandi-theme-heading + 6 yellow-nuanced yellow-alt-other yellow-nuanced-bg bg-region)))) + `(modus-theme-heading-7 + ((,class ,@(modus-operandi-theme-heading + 7 red-nuanced red-alt red-nuanced-bg bg-region)))) + `(modus-theme-heading-8 + ((,class ,@(modus-operandi-theme-heading + 8 fg-dim magenta bg-alt bg-region)))) ;;;;; other custom faces `(modus-theme-hl-line ((,class :background ,(if modus-operandi-theme-intense-hl-line - bg-active bg-hl-line) + bg-hl-line-intense bg-hl-line) (and (>= emacs-major-version 27) '(:extend t))))) ;;;; standard faces ;;;;; absolute essentials @@ -1149,26 +1477,25 @@ Also bind `class' to ((class color) (min-colors 89))." `(bold ((,class :weight bold))) `(comint-highlight-input ((,class :inherit bold))) `(comint-highlight-prompt ((,class ,@(modus-operandi-theme-bold-weight) - ,@(modus-operandi-theme-prompt cyan - blue-nuanced-bg - blue-alt - blue-refine-bg - fg-main)))) + ,@(modus-operandi-theme-prompt + cyan + blue-nuanced-bg blue-alt + blue-refine-bg fg-main)))) `(error ((,class :inherit bold :foreground ,red))) `(escape-glyph ((,class :foreground ,fg-escape-char-construct))) `(file-name-shadow ((,class :foreground ,fg-unfocused))) `(header-line ((,class :background ,bg-header :foreground ,fg-header))) `(header-line-highlight ((,class :inherit modus-theme-active-blue))) + `(help-argument-name ((,class :foreground ,cyan :slant ,modus-theme-slant))) `(homoglyph ((,class :foreground ,fg-escape-char-construct))) `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other))) `(italic ((,class :slant italic))) `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct))) `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t))) - `(minibuffer-prompt ((,class ,@(modus-operandi-theme-prompt cyan-alt-other - cyan-nuanced-bg - cyan - cyan-refine-bg - fg-main)))) + `(minibuffer-prompt ((,class ,@(modus-operandi-theme-prompt + cyan-alt-other + cyan-nuanced-bg cyan + cyan-refine-bg fg-main)))) `(mm-command-output ((,class :foreground ,red-alt-other))) `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild))) `(next-error ((,class :inherit modus-theme-subtle-red))) @@ -1180,9 +1507,11 @@ Also bind `class' to ((class color) (min-colors 89))." `(trailing-whitespace ((,class :background ,red-intense-bg))) `(warning ((,class :inherit bold :foreground ,yellow))) ;;;;; buttons, links, widgets - `(button ((,class :foreground ,blue-alt-other :underline t))) - `(link ((,class :foreground ,blue-alt-other :underline t))) - `(link-visited ((,class :foreground ,magenta-alt-other :underline t))) + `(button ((,class :foreground ,blue-alt-other + ,@(unless modus-operandi-theme-no-link-underline + (list :underline t))))) + `(link ((,class :inherit button))) + `(link-visited ((,class :inherit link :foreground ,magenta-alt-other))) `(tooltip ((,class :background ,bg-special-cold :foreground ,fg-main))) `(widget-button ((,class :inherit button))) `(widget-button-pressed ((,class :inherit button :foreground ,magenta))) @@ -1249,13 +1578,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(anzu-replace-highlight ((,class :inherit modus-theme-refine-yellow :underline t))) `(anzu-replace-to ((,class :inherit (modus-theme-intense-green bold)))) ;;;;; apropos - `(apropos-function-button ((,class :foreground ,magenta-alt-other :underline t))) + `(apropos-function-button ((,class :inherit button :foreground ,magenta-alt-other))) `(apropos-keybinding ((,class :inherit bold :foreground ,cyan))) - `(apropos-misc-button ((,class :foreground ,cyan-alt-other :underline t))) + `(apropos-misc-button ((,class :inherit button :foreground ,cyan-alt-other))) `(apropos-property ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt))) - `(apropos-symbol ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue-nuanced :underline t))) - `(apropos-user-option-button ((,class :foreground ,green-alt-other :underline t))) - `(apropos-variable-button ((,class :foreground ,blue :underline t))) + `(apropos-symbol ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue-alt-other))) + `(apropos-user-option-button ((,class :inherit button :foreground ,green-alt-other))) + `(apropos-variable-button ((,class :inherit button :foreground ,blue))) ;;;;; apt-sources-list `(apt-sources-list-components ((,class :foreground ,cyan))) `(apt-sources-list-options ((,class :foreground ,yellow))) @@ -1310,6 +1639,24 @@ Also bind `class' to ((class color) (min-colors 89))." `(aw-leading-char-face ((,class :inherit bold :height 1.5 :background ,bg-main :foreground ,red-intense))) `(aw-minibuffer-leading-char-face ((,class :foreground ,magenta-active))) `(aw-mode-line-face ((,class :inherit bold))) +;;;;; awesome-tray + `(awesome-tray-module-awesome-tab-face ((,class :inherit bold :foreground ,red-alt-other))) + `(awesome-tray-module-battery-face ((,class :inherit bold :foreground ,cyan-alt-other))) + `(awesome-tray-module-buffer-name-face ((,class :inherit bold :foreground ,yellow-alt-other))) + `(awesome-tray-module-circe-face ((,class :inherit bold :foreground ,blue-alt))) + `(awesome-tray-module-date-face ((,class :inherit bold :foreground ,fg-dim))) + `(awesome-tray-module-evil-face ((,class :inherit bold :foreground ,green-alt))) + `(awesome-tray-module-git-face ((,class :inherit bold :foreground ,magenta))) + `(awesome-tray-module-last-command-face ((,class :inherit bold :foreground ,blue-alt-other))) + `(awesome-tray-module-location-face ((,class :inherit bold :foreground ,yellow))) + `(awesome-tray-module-mode-name-face ((,class :inherit bold :foreground ,green))) + `(awesome-tray-module-parent-dir-face ((,class :inherit bold :foreground ,cyan))) + `(awesome-tray-module-rvm-face ((,class :inherit bold :foreground ,magenta-alt-other))) +;;;;; binder + `(binder-sidebar-highlight ((,class :inherit modus-theme-subtle-cyan))) + `(binder-sidebar-marked ((,class :inherit modus-theme-mark-sel))) + `(binder-sidebar-missing ((,class :inherit modus-theme-subtle-red))) + `(binder-sidebar-tags ((,class :foreground ,cyan))) ;;;;; bm `(bm-face ((,class :inherit modus-theme-subtle-yellow ,@(and (>= emacs-major-version 27) '(:extend t))))) @@ -1351,26 +1698,27 @@ Also bind `class' to ((class color) (min-colors 89))." `(diary-time ((,class :foreground ,blue-alt))) `(holiday ((,class :foreground ,magenta-alt))) ;;;;; calfw - `(cfw:face-annotation ((,class :background ,bg-alt :foreground ,fg-alt))) - `(cfw:face-day-title ((,class :background ,bg-alt :foreground ,fg-main))) + `(cfw:face-annotation ((,class :foreground ,fg-special-warm))) + `(cfw:face-day-title ((,class :foreground ,fg-main))) `(cfw:face-default-content ((,class :foreground ,green-alt))) `(cfw:face-default-day ((,class :inherit (cfw:face-day-title bold)))) - `(cfw:face-disable ((,class :background ,bg-inactive :foreground ,fg-inactive))) - `(cfw:face-grid ((,class :foreground ,fg-inactive))) - `(cfw:face-header ((,class :inherit bold ::foreground ,fg-main))) - `(cfw:face-holiday ((,class :inherit bold :background ,bg-alt :foreground ,magenta))) + `(cfw:face-disable ((,class :foreground ,fg-unfocused))) + `(cfw:face-grid ((,class :foreground ,fg-window-divider-outer))) + `(cfw:face-header ((,class :inherit bold :foreground ,fg-main))) + `(cfw:face-holiday ((,class :foreground ,magenta-alt-other))) `(cfw:face-periods ((,class :foreground ,cyan-alt-other))) - `(cfw:face-saturday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt))) + `(cfw:face-saturday ((,class :inherit bold :foreground ,cyan-alt-other))) `(cfw:face-select ((,class :inherit modus-theme-intense-blue))) - `(cfw:face-sunday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt-other))) + `(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other))) `(cfw:face-title ((,class :inherit ,modus-theme-variable-pitch - :foreground ,fg-special-warm - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)))) - `(cfw:face-today ((,class :inherit bold :foreground ,blue))) - `(cfw:face-today-title ((,class :inherit modus-theme-special-mild :box t))) - `(cfw:face-toolbar ((,class :background ,bg-active :foreground ,bg-active))) - `(cfw:face-toolbar-button-off ((,class :background ,bg-alt :foreground ,cyan))) - `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,bg-main :foreground ,blue-intense))) + :foreground ,fg-special-cold + ,@(modus-operandi-theme-scale modus-operandi-theme-scale-5)))) + `(cfw:face-today ((,class :background ,bg-inactive))) + `(cfw:face-today-title ((,class :background ,bg-active))) + `(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt))) + `(cfw:face-toolbar-button-off ((,class :foreground ,fg-alt))) + `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,blue-nuanced-bg + :foreground ,blue-alt))) ;;;;; centaur-tabs `(centaur-tabs-active-bar-face ((,class :background ,fg-tab-active))) `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground ,red-active :underline t))) @@ -1392,8 +1740,8 @@ Also bind `class' to ((class color) (min-colors 89))." `(change-log-function ((,class :foreground ,green-alt-other))) `(change-log-list ((,class :foreground ,magenta-alt-other))) `(change-log-name ((,class :foreground ,cyan))) - `(log-edit-header ((,class :inherit bold :foreground ,green-alt-other))) - `(log-edit-summary ((,class :foreground ,magenta-alt-other))) + `(log-edit-header ((,class :foreground ,fg-special-warm))) + `(log-edit-summary ((,class :inherit bold :foreground ,cyan))) `(log-edit-unknown-header ((,class :foreground ,fg-alt))) `(log-view-file ((,class :inherit bold :foreground ,fg-special-cold))) `(log-view-message ((,class :foreground ,fg-alt))) @@ -1437,7 +1785,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue))) `(circe-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other))) `(circe-server-face ((,class :foreground ,fg-unfocused))) - `(lui-button-face ((,class :foreground ,blue :underline t))) + `(lui-button-face ((,class :inherit button :foreground ,blue))) `(lui-highlight-face ((,class :foreground ,magenta-alt))) `(lui-time-stamp-face ((,class :foreground ,blue-nuanced))) ;;;;; color-rg @@ -1490,12 +1838,12 @@ Also bind `class' to ((class color) (min-colors 89))." ;;;;; completions `(completions-annotations ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) `(completions-common-part ((,class ,@(modus-operandi-theme-standard-completions - cyan-alt-other cyan-nuanced-bg - yellow-refine-bg yellow-refine-fg)))) + blue-alt blue-nuanced-bg + cyan-refine-bg cyan-refine-fg)))) `(completions-first-difference ((,class :inherit bold ,@(modus-operandi-theme-standard-completions - blue-alt-other blue-nuanced-bg - cyan-subtle-bg fg-dim)))) + magenta-alt blue-nuanced-bg + magenta-intense-bg fg-main)))) ;;;;; counsel `(counsel-active-mode ((,class :foreground ,magenta-alt-other))) `(counsel-application-name ((,class :foreground ,red-alt-other))) @@ -1531,6 +1879,10 @@ Also bind `class' to ((class color) (min-colors 89))." `(cov-light-face ((,class :foreground ,blue-intense))) `(cov-med-face ((,class :foreground ,yellow-intense))) `(cov-none-face ((,class :foreground ,cyan-intense))) +;;;;; cperl-mode + `(cperl-nonoverridable-face ((,class :foreground ,yellow-alt-other))) + `(cperl-array-face ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt))) + `(cperl-hash-face ((,class :inherit bold :background ,bg-alt :foreground ,red-alt :slant ,modus-theme-slant))) ;;;;; csv-mode `(csv-separator-face ((,class :background ,bg-special-cold :foreground ,fg-main))) ;;;;; ctrlf @@ -1609,7 +1961,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(deft-title-face ((,class :inherit bold :foreground ,fg-main))) ;;;;; dictionary `(dictionary-button-face ((,class :inherit bold :foreground ,fg-special-cold))) - `(dictionary-reference-face ((,class :foreground ,blue-alt-other :underline t))) + `(dictionary-reference-face ((,class :inherit :foreground ,blue-alt-other))) `(dictionary-word-definition-face ((,class :foreground ,fg-main))) `(dictionary-word-entry-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) ;;;;; diff-hl @@ -1623,47 +1975,54 @@ Also bind `class' to ((class color) (min-colors 89))." `(diff-hl-insert ((,class :inherit modus-theme-fringe-green))) `(diff-hl-reverted-hunk-highlight ((,class :inherit (modus-theme-active-magenta bold)))) ;;;;; diff-mode - `(diff-added ((,class ,@(modus-operandi-theme-diffs - bg-main green - bg-diff-focus-added fg-diff-focus-added)))) - `(diff-changed ((,class ,@(modus-operandi-theme-diffs - bg-main yellow - bg-diff-focus-changed fg-diff-focus-changed)))) + `(diff-added ((,class :inherit modus-theme-diff-added))) + `(diff-changed ((,class :inherit modus-theme-diff-changed))) `(diff-context ((,class :foreground ,fg-unfocused))) `(diff-file-header ((,class :inherit bold :foreground ,blue))) `(diff-function ((,class :foreground ,fg-special-cold))) `(diff-header ((,class :foreground ,blue-nuanced))) - `(diff-hunk-header ((,class ,@(modus-operandi-theme-diffs - bg-alt blue-alt - bg-diff-heading fg-diff-heading)))) + `(diff-hunk-header ((,class :inherit modus-theme-diff-heading))) `(diff-index ((,class :inherit bold :foreground ,blue-alt))) `(diff-indicator-added ((,class :inherit diff-added))) `(diff-indicator-changed ((,class :inherit diff-changed))) `(diff-indicator-removed ((,class :inherit diff-removed))) `(diff-nonexistent ((,class :inherit (modus-theme-neutral bold)))) - `(diff-refine-added ((,class ,@(modus-operandi-theme-diffs - bg-diff-added fg-diff-added - bg-diff-refine-added fg-diff-refine-added)))) - `(diff-refine-changed ((,class ,@(modus-operandi-theme-diffs - bg-diff-changed fg-diff-changed - bg-diff-refine-changed fg-diff-refine-changed)))) - `(diff-refine-removed ((,class ,@(modus-operandi-theme-diffs - bg-diff-removed fg-diff-removed - bg-diff-refine-removed fg-diff-refine-removed)))) - `(diff-removed ((,class ,@(modus-operandi-theme-diffs - bg-main red - bg-diff-focus-removed fg-diff-focus-removed)))) + `(diff-refine-added ((,class :inherit modus-theme-diff-refine-added))) + `(diff-refine-changed ((,class :inherit modus-theme-diff-refine-changed))) + `(diff-refine-removed ((,class :inherit modus-theme-diff-refine-removed))) + `(diff-removed ((,class :inherit modus-theme-diff-removed))) ;;;;; dim-autoload `(dim-autoload-cookie-line ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) +;;;;; dir-treeview + `(dir-treeview-archive-face ((,class :foreground ,fg-special-warm))) + `(dir-treeview-archive-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,yellow))) + `(dir-treeview-audio-face ((,class :foreground ,magenta))) + `(dir-treeview-audio-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt))) + `(dir-treeview-control-face ((,class :foreground ,fg-alt))) + `(dir-treeview-control-mouse-face ((,class :inherit highlight))) + `(dir-treeview-default-icon-face ((,class :inherit bold :family "Font Awesome" :foreground ,fg-alt))) + `(dir-treeview-default-filename-face ((,class :foreground ,fg-main))) + `(dir-treeview-directory-face ((,class :foreground ,blue))) + `(dir-treeview-directory-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,blue-alt))) + `(dir-treeview-executable-face ((,class :foreground ,red-alt))) + `(dir-treeview-executable-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,red-alt-other))) + `(dir-treeview-image-face ((,class :foreground ,green-alt-other))) + `(dir-treeview-image-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,green-alt))) + `(dir-treeview-indent-face ((,class :foreground ,fg-alt))) + `(dir-treeview-label-mouse-face ((,class :inherit highlight))) + `(dir-treeview-start-dir-face ((,class :inherit modus-theme-pseudo-header))) + `(dir-treeview-symlink-face ((,class :inherit button :foreground ,cyan))) + `(dir-treeview-video-face ((,class :foreground ,magenta-alt-other))) + `(dir-treeview-video-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt-other))) ;;;;; dired `(dired-directory ((,class :foreground ,blue))) `(dired-flagged ((,class :inherit modus-theme-mark-del))) - `(dired-header ((,class :inherit modus-theme-header))) + `(dired-header ((,class :inherit modus-theme-pseudo-header))) `(dired-ignored ((,class :foreground ,fg-alt))) `(dired-mark ((,class :inherit modus-theme-mark-symbol))) `(dired-marked ((,class :inherit modus-theme-mark-sel))) `(dired-perm-write ((,class :foreground ,fg-special-warm))) - `(dired-symlink ((,class :foreground ,cyan-alt :underline t))) + `(dired-symlink ((,class :inherit button :foreground ,cyan-alt))) `(dired-warning ((,class :inherit bold :foreground ,yellow))) ;;;;; dired-async `(dired-async-failures ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-active))) @@ -1688,43 +2047,44 @@ Also bind `class' to ((class color) (min-colors 89))." `(dired-subtree-depth-6-face ((,class :background nil))) ;;;;; diredfl `(diredfl-autofile-name ((,class :inherit modus-theme-special-cold))) - `(diredfl-compressed-file-name ((,class :foreground ,green-alt-other))) - `(diredfl-compressed-file-suffix ((,class :foreground ,green-alt))) - `(diredfl-date-time ((,class :foreground ,fg-special-cold))) + `(diredfl-compressed-file-name ((,class :foreground ,fg-special-warm))) + `(diredfl-compressed-file-suffix ((,class :foreground ,red-alt))) + `(diredfl-date-time ((,class :foreground ,cyan-alt-other))) `(diredfl-deletion ((,class :inherit modus-theme-mark-del))) `(diredfl-deletion-file-name ((,class :inherit modus-theme-mark-del))) - `(diredfl-dir-heading ((,class :inherit modus-theme-header))) + `(diredfl-dir-heading ((,class :inherit modus-theme-pseudo-header))) `(diredfl-dir-name ((,class :inherit dired-directory))) - `(diredfl-dir-priv ((,class :foreground ,blue))) - `(diredfl-exec-priv ((,class :foreground ,red-alt-other))) - `(diredfl-executable-tag ((,class :foreground ,red-alt))) + `(diredfl-dir-priv ((,class :foreground ,blue-alt))) + `(diredfl-exec-priv ((,class :foreground ,magenta))) + `(diredfl-executable-tag ((,class :foreground ,magenta-alt))) `(diredfl-file-name ((,class :foreground ,fg-main))) - `(diredfl-file-suffix ((,class :foreground ,fg-special-warm))) + `(diredfl-file-suffix ((,class :foreground ,cyan))) `(diredfl-flag-mark ((,class :inherit modus-theme-mark-sel))) `(diredfl-flag-mark-line ((,class :inherit modus-theme-mark-sel))) - `(diredfl-ignored-file-name ((,class :foreground ,fg-inactive))) + `(diredfl-ignored-file-name ((,class :foreground ,fg-alt))) `(diredfl-link-priv ((,class :foreground ,blue-alt-other))) - `(diredfl-no-priv ((,class :foreground ,fg-inactive))) - `(diredfl-number ((,class :foreground ,cyan))) + `(diredfl-no-priv ((,class :foreground ,fg-alt))) + `(diredfl-number ((,class :foreground ,cyan-alt))) `(diredfl-other-priv ((,class :foreground ,yellow))) - `(diredfl-rare-priv ((,class :foreground ,magenta-alt-other))) - `(diredfl-read-priv ((,class :foreground ,magenta))) - `(diredfl-symlink ((,class :foreground ,cyan-alt :underline t))) + `(diredfl-rare-priv ((,class :foreground ,red-alt))) + `(diredfl-read-priv ((,class :foreground ,fg-main))) + `(diredfl-symlink ((,class :inherit dired-symlink))) `(diredfl-tagged-autofile-name ((,class :inherit modus-theme-refine-magenta))) - `(diredfl-write-priv ((,class :foreground ,cyan-alt-other))) + `(diredfl-write-priv ((,class :foreground ,cyan))) ;;;;; disk-usage `(disk-usage-children ((,class :foreground ,yellow))) `(disk-usage-inaccessible ((,class :inherit bold :foreground ,red))) `(disk-usage-percent ((,class :foreground ,green))) `(disk-usage-size ((,class :foreground ,cyan))) - `(disk-usage-symlink ((,class :foreground ,blue :underline t))) + `(disk-usage-symlink ((,class :inherit button :foreground ,blue))) `(disk-usage-symlink-directory ((,class :inherit bold :foreground ,blue-alt))) ;;;;; doom-modeline `(doom-modeline-bar ((,class :inherit modus-theme-active-blue))) `(doom-modeline-bar-inactive ((,class :background ,fg-inactive :foreground ,bg-main))) `(doom-modeline-battery-charging ((,class :foreground ,green-active))) `(doom-modeline-battery-critical ((,class :inherit bold :foreground ,red-active))) - `(doom-modeline-battery-error ((,class :inherit modus-theme-active-red))) + `(doom-modeline-battery-error ((,class :inherit bold :box (:line-width -2) + :foreground ,red-active))) `(doom-modeline-battery-full ((,class :foreground ,blue-active))) `(doom-modeline-battery-normal ((,class :foreground ,fg-active))) `(doom-modeline-battery-warning ((,class :inherit bold :foreground ,yellow-active))) @@ -1781,18 +2141,24 @@ Also bind `class' to ((class color) (min-colors 89))." `(ebdb-role-defunct ((,class :foreground ,fg-alt))) `(eieio-custom-slot-tag-face ((,class :foreground ,red-alt))) ;;;;; ediff - `(ediff-current-diff-A ((,class ,@(modus-operandi-theme-diffs - bg-alt red - bg-diff-removed fg-diff-removed)))) - `(ediff-current-diff-Ancestor ((,class ,@(modus-operandi-theme-diffs - bg-alt fg-special-cold - bg-special-cold fg-special-cold)))) - `(ediff-current-diff-B ((,class ,@(modus-operandi-theme-diffs - bg-alt green - bg-diff-added fg-diff-added)))) - `(ediff-current-diff-C ((,class ,@(modus-operandi-theme-diffs - bg-alt yellow - bg-diff-changed fg-diff-changed)))) + ;; NOTE: here we break from the pattern of inheriting from the + ;; modus-theme-diff-* faces. + `(ediff-current-diff-A ((,class ,@(modus-operandi-theme-diff + bg-dim red + bg-diff-removed fg-diff-removed + red-nuanced-bg red-faint)))) + `(ediff-current-diff-Ancestor ((,class ,@(modus-operandi-theme-diff + bg-dim fg-special-cold + bg-special-cold fg-special-cold + blue-nuanced-bg blue)))) + `(ediff-current-diff-B ((,class ,@(modus-operandi-theme-diff + bg-dim green + bg-diff-added fg-diff-added + green-nuanced-bg green-faint)))) + `(ediff-current-diff-C ((,class ,@(modus-operandi-theme-diff + bg-dim yellow + bg-diff-changed fg-diff-changed + yellow-nuanced-bg yellow-faint)))) `(ediff-even-diff-A ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1))) `(ediff-even-diff-Ancestor ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-1))) `(ediff-even-diff-B ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1))) @@ -1812,6 +2178,9 @@ Also bind `class' to ((class color) (min-colors 89))." `(el-search-match ((,class :inherit modus-theme-intense-green))) `(el-search-other-match ((,class :inherit modus-theme-special-mild))) `(el-search-occur-match ((,class :inherit modus-theme-special-calm))) +;;;;; eldoc + ;; NOTE: see https://github.com/purcell/package-lint/issues/187 + (list 'eldoc-highlight-function-argument `((,class :inherit bold :foreground ,blue-alt-other))) ;;;;; eldoc-box `(eldoc-box-body ((,class :background ,bg-alt :foreground ,fg-main))) `(eldoc-box-border ((,class :background ,fg-alt))) @@ -1821,14 +2190,14 @@ Also bind `class' to ((class color) (min-colors 89))." `(elfeed-log-error-level-face ((,class :foreground ,red))) `(elfeed-log-info-level-face ((,class :foreground ,green))) `(elfeed-log-warn-level-face ((,class :foreground ,yellow))) - `(elfeed-search-date-face ((,class :foreground ,cyan))) - `(elfeed-search-feed-face ((,class :foreground ,blue))) - `(elfeed-search-filter-face ((,class :foreground ,magenta-active))) - `(elfeed-search-last-update-face ((,class :foreground ,green-active))) - `(elfeed-search-tag-face ((,class :foreground ,cyan-alt-other))) - `(elfeed-search-title-face ((,class :foreground ,fg-main))) - `(elfeed-search-unread-count-face ((,class :foreground ,blue-active))) - `(elfeed-search-unread-title-face ((,class :inherit bold))) + `(elfeed-search-date-face ((,class :foreground ,blue-nuanced))) + `(elfeed-search-feed-face ((,class :foreground ,cyan))) + `(elfeed-search-filter-face ((,class :inherit bold :foreground ,magenta-active))) + `(elfeed-search-last-update-face ((,class :foreground ,cyan-active))) + `(elfeed-search-tag-face ((,class :foreground ,blue-nuanced))) + `(elfeed-search-title-face ((,class :foreground ,fg-dim))) + `(elfeed-search-unread-count-face ((,class :foreground ,green-active))) + `(elfeed-search-unread-title-face ((,class :inherit bold :foreground ,fg-main))) ;;;;; elfeed-score `(elfeed-score-date-face ((,class :foreground ,blue))) `(elfeed-score-debug-level-face ((,class :foreground ,magenta-alt-other))) @@ -1888,6 +2257,38 @@ Also bind `class' to ((class color) (min-colors 89))." `(erc-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other))) `(erc-timestamp-face ((,class :foreground ,blue-nuanced))) `(erc-underline-face ((,class :underline t))) + `(bg:erc-color-face0 ((,class :background "white"))) + `(bg:erc-color-face1 ((,class :background "black"))) + `(bg:erc-color-face10 ((,class :background ,cyan-subtle-bg))) + `(bg:erc-color-face11 ((,class :background ,cyan-intense-bg))) + `(bg:erc-color-face12 ((,class :background ,blue-subtle-bg))) + `(bg:erc-color-face13 ((,class :background ,magenta-subtle-bg))) + `(bg:erc-color-face14 ((,class :background "gray60"))) + `(bg:erc-color-face15 ((,class :background "gray80"))) + `(bg:erc-color-face2 ((,class :background ,blue-intense-bg))) + `(bg:erc-color-face3 ((,class :background ,green-intense-bg))) + `(bg:erc-color-face4 ((,class :background ,red-subtle-bg))) + `(bg:erc-color-face5 ((,class :background ,red-intense-bg))) + `(bg:erc-color-face6 ((,class :background ,magenta-refine-bg))) + `(bg:erc-color-face7 ((,class :background ,yellow-subtle-bg))) + `(bg:erc-color-face8 ((,class :background ,yellow-refine-bg))) + `(bg:erc-color-face9 ((,class :background ,green-subtle-bg))) + `(fg:erc-color-face0 ((,class :foreground "white"))) + `(fg:erc-color-face1 ((,class :foreground "black"))) + `(fg:erc-color-face10 ((,class :foreground ,cyan))) + `(fg:erc-color-face11 ((,class :foreground ,cyan-alt-other))) + `(fg:erc-color-face12 ((,class :foreground ,blue))) + `(fg:erc-color-face13 ((,class :foreground ,magenta-alt))) + `(fg:erc-color-face14 ((,class :foreground "gray60"))) + `(fg:erc-color-face15 ((,class :foreground "gray80"))) + `(fg:erc-color-face2 ((,class :foreground ,blue-alt-other))) + `(fg:erc-color-face3 ((,class :foreground ,green))) + `(fg:erc-color-face4 ((,class :foreground ,red))) + `(fg:erc-color-face5 ((,class :foreground ,red-alt))) + `(fg:erc-color-face6 ((,class :foreground ,magenta-alt-other))) + `(fg:erc-color-face7 ((,class :foreground ,yellow-alt-other))) + `(fg:erc-color-face8 ((,class :foreground ,yellow-alt))) + `(fg:erc-color-face9 ((,class :foreground ,green-alt-other))) ;;;;; eros `(eros-result-overlay-face ((,class :box (:line-width -1 :color ,blue) :background ,bg-dim :foreground ,fg-dim))) @@ -1904,14 +2305,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(eshell-ls-product ((,class :foreground ,fg-special-warm))) `(eshell-ls-readonly ((,class :foreground ,fg-special-cold))) `(eshell-ls-special ((,class :inherit bold :foreground ,magenta))) - `(eshell-ls-symlink ((,class :foreground ,cyan :underline t))) + `(eshell-ls-symlink ((,class :inherit button :foreground ,cyan))) `(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground ,fg-inactive))) `(eshell-prompt ((,class ,@(modus-operandi-theme-bold-weight) - ,@(modus-operandi-theme-prompt green-alt-other - green-nuanced-bg - green-alt - green-refine-bg - fg-main)))) + ,@(modus-operandi-theme-prompt + green-alt-other + green-nuanced-bg green-alt + green-refine-bg fg-main)))) ;;;;; eshell-fringe-status `(eshell-fringe-status-failure ((,class :foreground ,red))) `(eshell-fringe-status-success ((,class :foreground ,green))) @@ -1939,6 +2339,15 @@ Also bind `class' to ((class color) (min-colors 89))." `(epe-remote-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) `(epe-status-face ((,class :foreground ,magenta-alt-other))) `(epe-venv-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) +;;;;; eshell-syntax-highlighting + `(eshell-syntax-highlighting-alias-face ((,class :foreground ,cyan))) + `(eshell-syntax-highlighting-comment-face ((,class :foreground ,fg-alt))) + `(eshell-syntax-highlighting-directory-face ((,class :foreground ,blue))) + `(eshell-syntax-highlighting-envvar-face ((,class :foreground ,magenta-alt))) + `(eshell-syntax-highlighting-invalid-face ((,class :foreground ,red))) + `(eshell-syntax-highlighting-lisp-function-face ((,class :foreground ,magenta))) + `(eshell-syntax-highlighting-shell-command-face ((,class :foreground ,cyan-alt-other))) + `(eshell-syntax-highlighting-string-face ((,class :foreground ,blue-alt))) ;;;;; evil-mode `(evil-ex-commands ((,class :foreground ,magenta-alt-other))) `(evil-ex-info ((,class :foreground ,cyan-alt-other))) @@ -2006,6 +2415,11 @@ Also bind `class' to ((class color) (min-colors 89))." ((,(append '((supports :underline (:style wave))) class) :underline (:color ,fg-lang-warning :style wave)) (,class :foreground ,fg-lang-warning :underline t))) +;;;;; flycheck-color-mode-line + `(flycheck-color-mode-line-error-face ((,class :inherit flycheck-fringe-error))) + `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-info))) + `(flycheck-color-mode-line-running-face ((,class :foreground ,fg-inactive :slant italic))) + `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-warning))) ;;;;; flycheck-indicator `(flycheck-indicator-disabled ((,class :foreground ,fg-inactive :slant ,modus-theme-slant))) `(flycheck-indicator-error ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-active))) @@ -2049,7 +2463,7 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-subtle-magenta 'modus-theme-intense-magenta 'modus-theme-nuanced-magenta - magenta-alt-other + magenta-alt 'bold)))) ;;;;; freeze-it `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm))) @@ -2157,18 +2571,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(git-commit-comment-branch-remote ((,class :foreground ,magenta-alt :slant ,modus-theme-slant))) `(git-commit-comment-detached ((,class :foreground ,cyan-alt :slant ,modus-theme-slant))) `(git-commit-comment-file ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) - `(git-commit-comment-heading ((,class :inherit bold :foreground ,fg-alt :slant ,modus-theme-slant))) + `(git-commit-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant))) `(git-commit-keyword ((,class :foreground ,magenta))) - `(git-commit-known-pseudo-header ((,class :inherit bold :foreground ,fg-special-warm))) + `(git-commit-known-pseudo-header ((,class :foreground ,cyan-alt-other))) `(git-commit-nonempty-second-line ((,class :inherit modus-theme-refine-yellow))) `(git-commit-overlong-summary ((,class :inherit modus-theme-refine-yellow))) - `(git-commit-pseudo-header ((,class :inherit bold :foreground ,fg-alt))) - `(git-commit-summary ((,class :foreground ,magenta-alt-other))) -;;;;; git-rebase - `(git-rebase-comment-hash ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) - `(git-rebase-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant))) - `(git-rebase-description ((,class :foreground ,fg-main))) - `(git-rebase-hash ((,class :foreground ,cyan-alt-other))) + `(git-commit-pseudo-header ((,class :foreground ,blue))) + `(git-commit-summary ((,class :inherit bold :foreground ,cyan))) ;;;;; git-gutter `(git-gutter:added ((,class :inherit modus-theme-fringe-green))) `(git-gutter:deleted ((,class :inherit modus-theme-fringe-red))) @@ -2194,13 +2603,18 @@ Also bind `class' to ((class color) (min-colors 89))." `(git-lens-header ((,class :inherit bold :height 1.1 :foreground ,cyan))) `(git-lens-modified ((,class :inherit bold :foreground ,yellow))) `(git-lens-renamed ((,class :inherit bold :foreground ,magenta))) +;;;;; git-rebase + `(git-rebase-comment-hash ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) + `(git-rebase-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant))) + `(git-rebase-description ((,class :foreground ,fg-main))) + `(git-rebase-hash ((,class :foreground ,cyan-alt-other))) ;;;;; git-timemachine `(git-timemachine-commit ((,class :inherit bold :foreground ,yellow-active))) `(git-timemachine-minibuffer-author-face ((,class :foreground ,fg-special-warm))) `(git-timemachine-minibuffer-detail-face ((,class :foreground ,red-alt))) ;;;;; git-walktree `(git-walktree-commit-face ((,class :foreground ,yellow))) - `(git-walktree-symlink-face ((,class :foreground ,cyan :underline t))) + `(git-walktree-symlink-face ((,class :inherit button :foreground ,cyan))) `(git-walktree-tree-face ((,class :foreground ,magenta))) ;;;;; gnus `(gnus-button ((,class :inherit button))) @@ -2239,9 +2653,9 @@ Also bind `class' to ((class color) (min-colors 89))." `(gnus-group-news-6-empty ((,class :foreground ,fg-alt))) `(gnus-group-news-low ((,class :inherit bold :foreground ,green-nuanced))) `(gnus-group-news-low-empty ((,class :foreground ,green-nuanced))) - `(gnus-header-content ((,class :foreground ,fg-special-calm))) - `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt :underline nil))) - `(gnus-header-name ((,class :foreground ,cyan-alt-other))) + `(gnus-header-content ((,class :foreground ,cyan))) + `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt-other :underline nil))) + `(gnus-header-name ((,class :foreground ,green))) `(gnus-header-newsgroups ((,class :inherit bold :foreground ,blue-alt))) `(gnus-header-subject ((,class :inherit bold :foreground ,magenta-alt-other))) `(gnus-server-agent ((,class :inherit bold :foreground ,cyan))) @@ -2260,12 +2674,12 @@ Also bind `class' to ((class color) (min-colors 89))." `(gnus-summary-high-undownloaded ((,class :inherit bold :foreground ,yellow))) `(gnus-summary-high-unread ((,class :inherit bold :foreground ,fg-main))) `(gnus-summary-low-ancient ((,class :foreground ,fg-alt :slant italic))) - `(gnus-summary-low-read ((,class :foreground ,fg-special-cold :slant italic))) + `(gnus-summary-low-read ((,class :foreground ,fg-alt :slant italic))) `(gnus-summary-low-ticked ((,class :foreground ,red-refine-fg :slant italic))) `(gnus-summary-low-undownloaded ((,class :foreground ,yellow-refine-fg :slant italic))) `(gnus-summary-low-unread ((,class :inherit bold :foreground ,fg-special-cold))) `(gnus-summary-normal-ancient ((,class :foreground ,fg-special-calm))) - `(gnus-summary-normal-read ((,class :foreground ,fg-special-cold))) + `(gnus-summary-normal-read ((,class :foreground ,fg-alt))) `(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other))) `(gnus-summary-normal-undownloaded ((,class :foreground ,yellow))) `(gnus-summary-normal-unread ((,class :foreground ,fg-main))) @@ -2309,11 +2723,11 @@ Also bind `class' to ((class color) (min-colors 89))." `(helm-ff-directory ((,class :inherit helm-buffer-directory))) `(helm-ff-dirs ((,class :inherit bold :foreground ,blue-alt-other))) `(helm-ff-dotted-directory ((,class :inherit bold :background ,bg-alt :foreground ,fg-alt))) - `(helm-ff-dotted-symlink-directory ((,class :inherit helm-ff-dotted-directory :underline t))) + `(helm-ff-dotted-symlink-directory ((,class :inherit (button helm-ff-dotted-directory)))) `(helm-ff-executable ((,class :foreground ,magenta-alt))) `(helm-ff-file ((,class :foreground ,fg-main))) `(helm-ff-file-extension ((,class :foreground ,fg-special-warm))) - `(helm-ff-invalid-symlink ((,class :foreground ,red :underline t))) + `(helm-ff-invalid-symlink ((,class :inherit button :foreground ,red))) `(helm-ff-pipe ((,class ,@(modus-operandi-theme-extra-completions 'modus-theme-refine-magenta 'modus-theme-subtle-magenta @@ -2330,7 +2744,7 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-refine-red 'modus-theme-nuanced-yellow red-alt)))) - `(helm-ff-symlink ((,class :foreground ,cyan :underline t))) + `(helm-ff-symlink ((,class :inherit button :foreground ,cyan))) `(helm-ff-truename ((,class :foreground ,blue-alt-other))) `(helm-grep-cmd-line ((,class :foreground ,yellow-alt-other))) `(helm-grep-file ((,class :inherit bold :foreground ,fg-special-cold))) @@ -2366,7 +2780,7 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-nuanced-cyan cyan-alt-other)))) `(helm-minibuffer-prompt ((,class :inherit minibuffer-prompt))) - `(helm-moccur-buffer ((,class :foreground ,cyan-alt-other :underline t))) + `(helm-moccur-buffer ((,class :inherit button :foreground ,cyan-alt-other))) `(helm-mode-prefix ((,class ,@(modus-operandi-theme-extra-completions 'modus-theme-subtle-magenta 'modus-theme-intense-magenta @@ -2416,8 +2830,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(helm-xref-file-name ((,class :inherit bold :foreground ,fg-special-cold))) `(helm-xref-file-name ((,class :foreground ,fg-special-warm))) ;;;;; helpful - `(helpful-heading ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)))) + `(helpful-heading ((,class :inherit modus-theme-heading-1))) ;;;;; highlight region or ad-hoc regexp `(hi-black-b ((,class :background ,fg-main :foreground ,bg-main))) `(hi-blue ((,class :background ,bg-alt :foreground ,blue :underline t))) @@ -2487,23 +2900,23 @@ Also bind `class' to ((class color) (min-colors 89))." ;;;;; icomplete `(icomplete-first-match ((,class :inherit bold ,@(modus-operandi-theme-standard-completions - magenta magenta-nuanced-bg - magenta-intense-bg fg-main)))) + magenta bg-alt + bg-active fg-main)))) ;;;;; icomplete-vertical `(icomplete-vertical-separator ((,class :foreground ,fg-alt))) ;;;;; ido-mode `(ido-first-match ((,class :inherit bold ,@(modus-operandi-theme-standard-completions - magenta magenta-nuanced-bg - magenta-subtle-bg fg-main)))) + magenta bg-alt + bg-active fg-main)))) `(ido-incomplete-regexp ((,class :inherit error))) `(ido-indicator ((,class :inherit modus-theme-subtle-yellow))) `(ido-only-match ((,class :inherit bold ,@(modus-operandi-theme-standard-completions - magenta-intense red-nuanced-bg - magenta-intense-bg fg-main)))) - `(ido-subdir ((,class :foreground ,blue-alt-other))) - `(ido-virtual ((,class :foreground ,yellow-alt-other))) + green green-nuanced-bg + green-intense-bg fg-main)))) + `(ido-subdir ((,class :foreground ,blue))) + `(ido-virtual ((,class :foreground ,fg-special-warm))) ;;;;; iedit `(iedit-occurrence ((,class :inherit modus-theme-refine-blue))) `(iedit-read-only-occurrence ((,class :inherit modus-theme-intense-yellow))) @@ -2521,29 +2934,25 @@ Also bind `class' to ((class color) (min-colors 89))." `(imenu-list-entry-subalist-face-3 ((,class :inherit bold :foreground ,red-alt-other :underline t))) ;;;;; indium `(indium-breakpoint-face ((,class :foreground ,red-active))) - `(indium-frame-url-face ((,class :foreground ,fg-alt :underline t))) + `(indium-frame-url-face ((,class :inherit button :foreground ,fg-alt))) `(indium-keyword-face ((,class :foreground ,magenta-alt-other))) `(indium-litable-face ((,class :foreground ,fg-special-warm :slant ,modus-theme-slant))) `(indium-repl-error-face ((,class :inherit bold :foreground ,red))) `(indium-repl-prompt-face ((,class :foreground ,cyan-alt-other))) `(indium-repl-stdout-face ((,class :foreground ,fg-main))) ;;;;; info - `(Info-quoted ((,class :foreground ,magenta))) ; the capitalisation is canonical + `(Info-quoted ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,magenta))) ; the capitalisation is canonical `(info-header-node ((,class :inherit bold :foreground ,fg-alt))) `(info-header-xref ((,class :foreground ,blue-active))) `(info-index-match ((,class :inherit match))) - `(info-menu-header ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2)))) - `(info-menu-star ((,class :foreground ,fg-main))) + `(info-menu-header ((,class :inherit modus-theme-heading-3))) + `(info-menu-star ((,class :foreground ,red))) `(info-node ((,class :inherit bold))) - `(info-title-1 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)))) - `(info-title-2 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-warm - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3)))) - `(info-title-3 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2)))) - `(info-title-4 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-mild - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1)))) + `(info-title-1 ((,class :inherit modus-theme-heading-1))) + `(info-title-2 ((,class :inherit modus-theme-heading-2))) + `(info-title-3 ((,class :inherit modus-theme-heading-3))) + `(info-title-4 ((,class :inherit modus-theme-heading-4))) ;;;;; info-colors `(info-colors-lisp-code-block ((,class :inherit fixed-pitch))) `(info-colors-ref-item-command ((,class :foreground ,magenta))) @@ -2689,13 +3098,14 @@ Also bind `class' to ((class color) (min-colors 89))." `(kaocha-runner-warning-face ((,class :foreground ,yellow))) ;;;;; keycast `(keycast-command ((,class :inherit bold :foreground ,blue-active))) - `(keycast-key ((,class :box ,(modus-operandi-theme-modeline-box blue-alt blue-active t -3) - ,@(modus-operandi-theme-modeline-props - blue-active bg-main - blue-active bg-active)))) + `(keycast-key ((,class ,@(modus-operandi-theme-mode-line-attrs + bg-main blue-active + bg-main blue-active + blue-active blue-intense + 'alt-style -3)))) ;;;;; line numbers (display-line-numbers-mode and global variant) - `(line-number ((,class :background ,bg-dim :foreground ,fg-alt))) - `(line-number-current-line ((,class :inherit bold :background ,bg-active :foreground ,fg-active))) + `(line-number ((,class :inherit default :background ,bg-dim :foreground ,fg-alt))) + `(line-number-current-line ((,class :inherit default :background ,bg-active :foreground ,fg-main))) ;;;;; lsp-mode `(lsp-face-highlight-read ((,class :inherit modus-theme-subtle-blue :underline t))) `(lsp-face-highlight-textual ((,class :inherit modus-theme-subtle-blue))) @@ -2725,7 +3135,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(lsp-lens-mouse-face ((,class :height 0.8 :foreground ,blue-alt-other :underline t))) `(lsp-ui-doc-background ((,class :background ,bg-alt))) `(lsp-ui-doc-header ((,class :background ,bg-header :foreground ,fg-header))) - `(lsp-ui-doc-url ((,class :foreground ,blue-alt-other :underline t))) + `(lsp-ui-doc-url ((,class :inherit button :foreground ,blue-alt-other))) `(lsp-ui-peek-filename ((,class :foreground ,fg-special-warm))) `(lsp-ui-peek-footer ((,class :background ,bg-header :foreground ,fg-header))) `(lsp-ui-peek-header ((,class :background ,bg-header :foreground ,fg-header))) @@ -2757,37 +3167,43 @@ Also bind `class' to ((class color) (min-colors 89))." `(magit-branch-upstream ((,class :slant italic))) `(magit-cherry-equivalent ((,class :background ,bg-main :foreground ,magenta-intense))) `(magit-cherry-unmatched ((,class :background ,bg-main :foreground ,cyan-intense))) - `(magit-diff-added ((,class ,@(modus-operandi-theme-diffs + ;; NOTE: here we break from the pattern of inheriting from the + ;; modus-theme-diff-* faces, though only for the standard actions, + ;; not the highlighted ones. This is because Magit's interaction + ;; model relies on highlighting the current diff hunk. + `(magit-diff-added ((,class ,@(modus-operandi-theme-diff bg-main green - bg-diff-added fg-diff-added)))) - `(magit-diff-added-highlight ((,class ,@(modus-operandi-theme-diffs - bg-dim green - bg-diff-focus-added fg-diff-focus-added)))) - `(magit-diff-base ((,class ,@(modus-operandi-theme-diffs + bg-diff-added fg-diff-added + green-nuanced-bg fg-diff-added)))) + `(magit-diff-added-highlight ((,class :inherit modus-theme-diff-focus-added))) + `(magit-diff-base ((,class ,@(modus-operandi-theme-diff bg-main yellow - bg-diff-changed fg-diff-changed)))) - `(magit-diff-base-highlight ((,class ,@(modus-operandi-theme-diffs - bg-dim yellow - bg-diff-focus-changed fg-diff-focus-changed)))) + bg-diff-changed fg-diff-changed + yellow-nuanced-bg fg-diff-changed)))) + `(magit-diff-base-highlight ((,class :inherit modus-theme-diff-focus-changed))) `(magit-diff-context ((,class :foreground ,fg-unfocused))) - `(magit-diff-context-highlight ((,class ,@(modus-operandi-theme-diffs + `(magit-diff-context-highlight ((,class ,@(modus-operandi-theme-diff bg-dim fg-dim - bg-inactive fg-inactive)))) + bg-inactive fg-inactive + bg-dim fg-alt)))) `(magit-diff-file-heading ((,class :inherit bold :foreground ,fg-special-cold))) `(magit-diff-file-heading-highlight ((,class :inherit (modus-theme-special-cold bold)))) - `(magit-diff-file-heading-selection ((,class :background ,bg-alt :foreground ,cyan))) - `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active :foreground ,fg-inactive))) - `(magit-diff-hunk-heading-highlight ((,class :inherit (modus-theme-diff-heading bold)))) - `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-intense-cyan))) + `(magit-diff-file-heading-selection ((,class :inherit modus-theme-refine-cyan))) + ;; NOTE: here we break from the pattern of inheriting from the + ;; modus-theme-diff-* faces. + `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active + :foreground ,fg-inactive))) + `(magit-diff-hunk-heading-highlight ((,class :inherit bold :background ,bg-diff-heading + :foreground ,fg-diff-heading))) + `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-refine-blue))) `(magit-diff-hunk-region ((,class :inherit bold))) `(magit-diff-lines-boundary ((,class :background ,fg-main))) `(magit-diff-lines-heading ((,class :inherit modus-theme-refine-magenta))) - `(magit-diff-removed ((,class ,@(modus-operandi-theme-diffs + `(magit-diff-removed ((,class ,@(modus-operandi-theme-diff bg-main red - bg-diff-removed fg-diff-removed)))) - `(magit-diff-removed-highlight ((,class ,@(modus-operandi-theme-diffs - bg-dim red - bg-diff-focus-removed fg-diff-focus-removed)))) + bg-diff-removed fg-diff-removed + red-nuanced-bg fg-diff-removed)))) + `(magit-diff-removed-highlight ((,class :inherit modus-theme-diff-focus-removed))) `(magit-diffstat-added ((,class :foreground ,green))) `(magit-diffstat-removed ((,class :foreground ,red))) `(magit-dimmed ((,class :foreground ,fg-unfocused))) @@ -2846,26 +3262,40 @@ Also bind `class' to ((class color) (min-colors 89))." `(Man-reverse ((,class :inherit modus-theme-subtle-magenta))) `(Man-underline ((,class :foreground ,cyan :underline t))) ;;;;; markdown-mode - `(markdown-blockquote-face ((,class :foreground ,fg-special-warm :slant ,modus-theme-slant))) + `(markdown-blockquote-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) `(markdown-bold-face ((,class :inherit bold))) - `(markdown-code-face ((,class :inherit fixed-pitch))) + `(markdown-code-face ((,class ,@(modus-operandi-theme-mixed-fonts)))) `(markdown-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt))) `(markdown-footnote-text-face ((,class :foreground ,fg-main :slant ,modus-theme-slant))) `(markdown-gfm-checkbox-face ((,class :foreground ,cyan-alt-other))) `(markdown-header-delimiter-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,fg-dim))) - `(markdown-header-face ((,class :inherit bold))) + `(markdown-header-face ((t nil))) + `(markdown-header-face-1 ((,class :inherit modus-theme-heading-1))) + `(markdown-header-face-2 ((,class :inherit modus-theme-heading-2))) + `(markdown-header-face-3 ((,class :inherit modus-theme-heading-3))) + `(markdown-header-face-4 ((,class :inherit modus-theme-heading-4))) + `(markdown-header-face-5 ((,class :inherit modus-theme-heading-5))) + `(markdown-header-face-6 ((,class :inherit modus-theme-heading-6))) `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm))) `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm))) - `(markdown-html-attr-name-face ((,class :inherit fixed-pitch :foreground ,cyan))) - `(markdown-html-attr-value-face ((,class :inherit fixed-pitch :foreground ,blue))) - `(markdown-html-entity-face ((,class :inherit fixed-pitch :foreground ,cyan))) - `(markdown-html-tag-delimiter-face ((,class :inherit fixed-pitch :foreground ,fg-special-mild))) - `(markdown-html-tag-name-face ((,class :inherit fixed-pitch :foreground ,magenta-alt))) - `(markdown-inline-code-face ((,class :inherit fixed-pitch :foreground ,magenta))) + `(markdown-html-attr-name-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,cyan))) + `(markdown-html-attr-value-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,blue))) + `(markdown-html-entity-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,cyan))) + `(markdown-html-tag-delimiter-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,fg-special-mild))) + `(markdown-html-tag-name-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,magenta-alt))) + `(markdown-inline-code-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,magenta))) `(markdown-italic-face ((,class :foreground ,fg-special-cold :slant italic))) - `(markdown-language-info-face ((,class :inherit fixed-pitch :foreground ,fg-special-cold))) - `(markdown-language-keyword-face ((,class :inherit fixed-pitch :foreground ,green-alt-other))) + `(markdown-language-info-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,fg-special-cold))) + `(markdown-language-keyword-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,green-alt-other))) `(markdown-line-break-face ((,class :inherit modus-theme-refine-cyan :underline t))) `(markdown-link-face ((,class :inherit link))) `(markdown-link-title-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) @@ -2877,12 +3307,14 @@ Also bind `class' to ((class color) (min-colors 89))." `(markdown-missing-link-face ((,class :inherit bold :foreground ,yellow))) `(markdown-plain-url-face ((,class :inherit markdown-link-face))) `(markdown-pre-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit fixed-pitch :background ,bg-dim + ,@(modus-operandi-theme-mixed-fonts) + :background ,bg-dim :foreground ,fg-special-mild))) `(markdown-reference-face ((,class :inherit markdown-markup-face))) `(markdown-strike-through-face ((,class :strike-through t))) - `(markdown-table-face ((,class :inherit fixed-pitch :foreground ,fg-special-cold))) - `(markdown-url-face ((,class :foreground ,blue))) + `(markdown-table-face ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,fg-special-cold))) + `(markdown-url-face ((,class :foreground ,blue-alt))) ;;;;; markup-faces (`adoc-mode') `(markup-anchor-face ((,class :foreground ,fg-inactive))) `(markup-attribute-face ((,class :foreground ,fg-inactive :slant italic))) @@ -2896,7 +3328,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(markup-emphasis-face ((,class :foreground ,fg-special-cold :slant italic))) `(markup-error-face ((,class :inherit bold :foreground ,red))) `(markup-gen-face ((,class :foreground ,magenta-alt))) - `(markup-internal-reference-face ((,class :foreground ,fg-inactive :underline t))) + `(markup-internal-reference-face ((,class :inherit button :foreground ,fg-inactive))) `(markup-italic-face ((,class :foreground ,fg-special-cold :slant italic))) `(markup-list-face ((,class :inherit modus-theme-special-calm))) `(markup-meta-face ((,class :foreground ,fg-inactive))) @@ -2935,32 +3367,30 @@ Also bind `class' to ((class color) (min-colors 89))." `(message-cited-text-2 ((,class :foreground ,red-alt))) `(message-cited-text-3 ((,class :foreground ,green-alt))) `(message-cited-text-4 ((,class :foreground ,magenta-alt))) - `(message-header-cc ((,class :foreground ,blue-alt))) + `(message-header-cc ((,class :inherit bold :foreground ,cyan-alt))) `(message-header-name ((,class :foreground ,green-alt-other))) - `(message-header-newsgroups ((,class :inherit bold :foreground ,blue))) + `(message-header-newsgroups ((,class :inherit bold :foreground ,green-alt))) `(message-header-other ((,class :inherit bold :foreground ,cyan-alt-other))) `(message-header-subject ((,class :inherit bold :foreground ,magenta-alt-other))) - `(message-header-to ((,class :inherit bold :foreground ,magenta-alt))) - `(message-header-xheader ((,class :foreground ,blue-alt-other))) - `(message-mml ((,class :foreground ,green-alt))) - `(message-separator ((,class :background ,bg-active :foreground ,fg-special-warm))) + `(message-header-to ((,class :inherit bold :foreground ,blue))) + `(message-header-xheader ((,class :foreground ,cyan))) + `(message-mml ((,class :foreground ,fg-special-warm))) + `(message-separator ((,class :inherit modus-theme-intense-neutral))) ;;;;; minibuffer-line `(minibuffer-line ((,class :foreground ,fg-main))) ;;;;; minimap `(minimap-active-region-background ((,class :background ,bg-active))) `(minimap-current-line-face ((,class :background ,cyan-intense-bg :foreground ,fg-main))) ;;;;; modeline - `(mode-line ((,class :box ,(modus-operandi-theme-modeline-box bg-active fg-alt t) - ,@(modus-operandi-theme-modeline-props - bg-active fg-dim - bg-active fg-active)))) + `(mode-line ((,class ,@(modus-operandi-theme-mode-line-attrs + fg-active bg-active fg-dim bg-active + fg-alt bg-active 'alt-style nil bg-main)))) `(mode-line-buffer-id ((,class :inherit bold))) `(mode-line-emphasis ((,class :inherit bold :foreground ,blue-active))) `(mode-line-highlight ((,class :inherit modus-theme-active-blue :box (:line-width -1 :style pressed-button)))) - `(mode-line-inactive ((,class :box ,(modus-operandi-theme-modeline-box bg-active bg-region) - ,@(modus-operandi-theme-modeline-props - bg-dim fg-inactive - bg-inactive fg-inactive)))) + `(mode-line-inactive ((,class ,@(modus-operandi-theme-mode-line-attrs + fg-inactive bg-inactive fg-alt bg-dim + bg-region bg-active)))) ;;;;; mood-line `(mood-line-modified ((,class :foreground ,magenta-active))) `(mood-line-status-error ((,class :inherit bold :foreground ,red-active))) @@ -2969,6 +3399,9 @@ Also bind `class' to ((class color) (min-colors 89))." `(mood-line-status-success ((,class :foreground ,green-active))) `(mood-line-status-warning ((,class :inherit bold :foreground ,yellow-active))) `(mood-line-unimportant ((,class :foreground ,fg-inactive))) +;;;;; mpdel + `(mpdel-browser-directory-face ((,class :foreground ,blue))) + `(mpdel-playlist-current-song-face ((,class :inherit bold :foreground ,blue-alt-other))) ;;;;; mu4e `(mu4e-attach-number-face ((,class :inherit bold :foreground ,cyan-alt))) `(mu4e-cited-1-face ((,class :foreground ,blue-alt))) @@ -2979,7 +3412,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(mu4e-cited-6-face ((,class :foreground ,cyan-alt))) `(mu4e-cited-7-face ((,class :foreground ,magenta))) `(mu4e-compose-header-face ((,class :inherit mu4e-compose-separator-face))) - `(mu4e-compose-separator-face ((,class :background ,bg-active :foreground ,fg-special-warm))) + `(mu4e-compose-separator-face ((,class :inherit modus-theme-intense-neutral))) `(mu4e-contact-face ((,class :inherit bold :foreground ,cyan-alt-other))) `(mu4e-context-face ((,class :foreground ,blue-active))) `(mu4e-draft-face ((,class :foreground ,magenta-alt))) @@ -2998,7 +3431,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(mu4e-moved-face ((,class :foreground ,yellow :slant ,modus-theme-slant))) `(mu4e-ok-face ((,class :inherit bold :foreground ,green))) `(mu4e-region-code ((,class :inherit modus-theme-special-calm))) - `(mu4e-replied-face ((,class :foreground ,cyan-active))) + `(mu4e-replied-face ((,class :foreground ,blue-faint))) `(mu4e-special-header-value-face ((,class :inherit bold :foreground ,blue-alt-other))) `(mu4e-system-face ((,class :foreground ,fg-mark-del :slant ,modus-theme-slant))) `(mu4e-title-face ((,class :foreground ,fg-main))) @@ -3129,10 +3562,15 @@ Also bind `class' to ((class color) (min-colors 89))." `(nxml-ref ((,class ,@(modus-operandi-theme-syntax-foreground green-alt-other green-alt-other-faint) ,@(modus-operandi-theme-bold-weight)))) +;;;;; objed + `(objed-hl ((,class :background ,(if modus-operandi-theme-intense-hl-line + bg-hl-alt-intense bg-hl-alt)))) + `(objed-mark ((,class :background ,bg-active))) + `(objed-mode-line ((,class :foreground ,cyan-active))) ;;;;; orderless `(orderless-match-face-0 ((,class :inherit bold ,@(modus-operandi-theme-standard-completions - blue-alt blue-nuanced-bg + blue-alt-other blue-nuanced-bg blue-refine-bg blue-refine-fg)))) `(orderless-match-face-1 ((,class :inherit bold ,@(modus-operandi-theme-standard-completions @@ -3140,70 +3578,62 @@ Also bind `class' to ((class color) (min-colors 89))." magenta-refine-bg magenta-refine-fg)))) `(orderless-match-face-2 ((,class :inherit bold ,@(modus-operandi-theme-standard-completions - green-alt-other green-nuanced-bg + green green-nuanced-bg green-refine-bg green-refine-fg)))) `(orderless-match-face-3 ((,class :inherit bold ,@(modus-operandi-theme-standard-completions - yellow-alt-other yellow-nuanced-bg + yellow yellow-nuanced-bg yellow-refine-bg yellow-refine-fg)))) ;;;;; org `(org-agenda-calendar-event ((,class :foreground ,fg-main))) `(org-agenda-calendar-sexp ((,class :foreground ,cyan-alt))) - `(org-agenda-clocking ((,class :inherit modus-theme-special-cold))) + `(org-agenda-clocking ((,class :inherit modus-theme-special-cold + ,@(and (>= emacs-major-version 27) '(:extend t))))) `(org-agenda-column-dateline ((,class :background ,bg-alt))) - `(org-agenda-current-time ((,class :inherit modus-theme-subtle-cyan))) - `(org-agenda-date ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan-alt-other - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4) - ,@(modus-operandi-theme-heading-block cyan-nuanced-bg cyan-nuanced)))) - `(org-agenda-date-today ((,class :inherit (bold ,modus-theme-variable-pitch) - :background ,cyan-intense-bg :foreground ,fg-main - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4)))) - `(org-agenda-date-weekend ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4) - ,@(modus-operandi-theme-heading-block blue-nuanced-bg cyan-nuanced)))) + `(org-agenda-current-time ((,class :inherit bold :foreground ,blue-alt-other))) + `(org-agenda-date ((,class :foreground ,cyan))) + `(org-agenda-date-today ((,class :inherit bold :foreground ,fg-main :underline t))) + `(org-agenda-date-weekend ((,class :foreground ,cyan-alt-other))) `(org-agenda-diary ((,class :foreground ,fg-main))) - `(org-agenda-dimmed-todo-face ((,class :inherit modus-theme-subtle-neutral))) - `(org-agenda-done ((,class ,@(modus-operandi-theme-org-todo-block green-nuanced-bg green-nuanced green)))) + `(org-agenda-dimmed-todo-face ((,class :inherit bold :foreground ,fg-alt))) + `(org-agenda-done ((,class :foreground ,green-alt))) `(org-agenda-filter-category ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-filter-effort ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-filter-tags ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim))) - `(org-agenda-structure ((,class :inherit ,modus-theme-variable-pitch - :foreground ,fg-special-mild - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3)))) + `(org-agenda-structure ((,class :foreground ,blue-alt))) `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt))) - `(org-block ((,class ,@(modus-operandi-theme-org-block bg-dim) - :inherit fixed-pitch :foreground ,fg-main))) - `(org-block-begin-line ((,class ,@(modus-operandi-theme-org-block-delim + `(org-block ((,class ,@(modus-operandi-theme-mixed-fonts) + ,@(modus-operandi-theme-org-block bg-dim) + :foreground ,fg-main))) + `(org-block-begin-line ((,class ,@(modus-operandi-theme-mixed-fonts) + ,@(modus-operandi-theme-org-block-delim bg-dim fg-special-cold - bg-alt fg-special-mild) - :inherit fixed-pitch))) + bg-alt fg-special-mild)))) `(org-block-end-line ((,class :inherit org-block-begin-line))) `(org-checkbox ((,class :box (:line-width 1 :color ,bg-active) :background ,bg-inactive :foreground ,fg-active))) - `(org-checkbox-statistics-done ((,class :foreground ,green - ,@(modus-operandi-theme-heading-block - green-nuanced-bg green-nuanced)))) - `(org-checkbox-statistics-todo ((,class ,@(modus-operandi-theme-heading-foreground red-alt red) - ,@(modus-operandi-theme-heading-block - red-nuanced-bg red-nuanced)))) + `(org-checkbox-statistics-done ((,class :inherit org-done))) + `(org-checkbox-statistics-todo ((,class :inherit org-todo))) `(org-clock-overlay ((,class :inherit modus-theme-special-cold))) - `(org-code ((,class :inherit fixed-pitch :foreground ,magenta))) + `(org-code ((,class ,@(modus-operandi-theme-mixed-fonts) :foreground ,magenta))) `(org-column ((,class :background ,bg-alt))) `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt))) - `(org-date ((,class :inherit fixed-pitch :foreground ,cyan-alt-other :underline t))) + `(org-date ((,class :inherit (button fixed-pitch) :foreground ,cyan-alt-other))) `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t))) - `(org-default ((,class :background ,bg-main :foreground ,fg-main))) `(org-document-info ((,class :foreground ,fg-special-cold))) - `(org-document-info-keyword ((,class :inherit fixed-pitch :foreground ,fg-alt))) + `(org-document-info-keyword ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,fg-alt))) `(org-document-title ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold ,@(modus-operandi-theme-scale modus-operandi-theme-scale-5)))) - `(org-done ((,class ,@(modus-operandi-theme-org-todo-block green-nuanced-bg green-nuanced green)))) - `(org-drawer ((,class :foreground ,cyan-alt))) + `(org-done ((,class :box ,bg-region :background ,bg-dim :foreground ,green))) + `(org-drawer ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,cyan))) `(org-ellipsis ((,class :foreground nil))) ; inherits from the heading's colour - `(org-footnote ((,class :foreground ,blue-alt :underline t))) - `(org-formula ((,class :inherit fixed-pitch :foreground ,red-alt))) + `(org-footnote ((,class :inherit button :foreground ,blue-alt))) + `(org-formula ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,red-alt))) `(org-habit-alert-face ((,class :inherit modus-theme-intense-yellow))) `(org-habit-alert-future-face ((,class :inherit modus-theme-refine-yellow))) `(org-habit-clear-face ((,class :inherit modus-theme-intense-magenta))) @@ -3212,69 +3642,48 @@ Also bind `class' to ((class color) (min-colors 89))." `(org-habit-overdue-future-face ((,class :inherit modus-theme-refine-red))) `(org-habit-ready-face ((,class :inherit modus-theme-intense-blue))) `(org-habit-ready-future-face ((,class :inherit modus-theme-refine-blue))) - `(org-headline-done ((,class :foreground ,green-nuanced - ,@(modus-operandi-theme-heading-block - green-nuanced-bg green-nuanced)))) + `(org-headline-done ((,class :inherit ,modus-theme-variable-pitch :foreground ,green-nuanced))) + `(org-headline-todo ((,class :inherit ,modus-theme-variable-pitch :foreground ,red-nuanced))) `(org-hide ((,class :foreground ,bg-main))) `(org-indent ((,class :inherit (fixed-pitch org-hide)))) `(org-latex-and-related ((,class :foreground ,magenta-refine-fg))) - `(org-level-1 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-main magenta-alt-other) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4) - ,@(modus-operandi-theme-heading-block magenta-nuanced-bg magenta-nuanced)))) - `(org-level-2 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-warm magenta-alt) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3) - ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(org-level-3 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-cold blue) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2) - ,@(modus-operandi-theme-heading-block blue-nuanced-bg blue-nuanced)))) - `(org-level-4 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-mild cyan) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1) - ,@(modus-operandi-theme-heading-block cyan-nuanced-bg cyan-nuanced)))) - `(org-level-5 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-calm green-alt-other) - ,@(modus-operandi-theme-heading-block green-nuanced-bg green-nuanced)))) - `(org-level-6 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground yellow-nuanced yellow-alt-other) - ,@(modus-operandi-theme-heading-block yellow-nuanced-bg yellow-nuanced)))) - `(org-level-7 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground red-nuanced red-alt) - ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(org-level-8 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-dim magenta) - ,@(modus-operandi-theme-heading-block bg-alt fg-alt)))) + `(org-level-1 ((,class :inherit modus-theme-heading-1))) + `(org-level-2 ((,class :inherit modus-theme-heading-2))) + `(org-level-3 ((,class :inherit modus-theme-heading-3))) + `(org-level-4 ((,class :inherit modus-theme-heading-4))) + `(org-level-5 ((,class :inherit modus-theme-heading-5))) + `(org-level-6 ((,class :inherit modus-theme-heading-6))) + `(org-level-7 ((,class :inherit modus-theme-heading-7))) + `(org-level-8 ((,class :inherit modus-theme-heading-8))) `(org-link ((,class :inherit link))) `(org-list-dt ((,class :inherit bold))) - `(org-macro ((,class :inherit org-latex-and-related))) - `(org-meta-line ((,class :inherit fixed-pitch :background ,cyan-nuanced-bg :foreground ,cyan-nuanced))) + `(org-macro ((,class :background ,blue-nuanced-bg :foreground ,magenta-alt-other))) + `(org-meta-line ((,class ,@(modus-operandi-theme-mixed-fonts) :foreground ,fg-alt))) `(org-mode-line-clock ((,class :foreground ,fg-main))) `(org-mode-line-clock-overrun ((,class :inherit modus-theme-active-red))) - `(org-priority ((,class ,@(modus-operandi-theme-org-todo-block magenta-nuanced-bg magenta-nuanced magenta) - ,@(modus-operandi-theme-heading-foreground magenta magenta-alt-other)))) - `(org-quote ((,class ,@(if modus-operandi-theme-org-blocks - (append - (and (>= emacs-major-version 27) '(:extend t)) - (list :background bg-dim)) - (list :background nil)) - :foreground ,fg-special-calm :slant ,modus-theme-slant))) + `(org-priority ((,class :box ,bg-region :background ,bg-dim :foreground ,magenta))) + `(org-property-value ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,cyan-alt-other))) + `(org-quote ((,class ,@(modus-operandi-theme-org-block bg-dim) + :foreground ,fg-special-cold :slant ,modus-theme-slant))) `(org-scheduled ((,class :foreground ,fg-special-warm))) `(org-scheduled-previously ((,class :foreground ,yellow-alt-other))) `(org-scheduled-today ((,class :foreground ,magenta-alt-other))) `(org-sexp-date ((,class :inherit org-date))) - `(org-special-keyword ((,class ,@(modus-operandi-theme-org-todo-block cyan-nuanced-bg cyan-nuanced cyan-alt)))) - `(org-table ((,class :inherit fixed-pitch :foreground ,fg-special-cold))) - `(org-tag ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-nuanced))) + `(org-special-keyword ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,blue-nuanced))) + `(org-table ((,class ,@(modus-operandi-theme-mixed-fonts) + :foreground ,fg-special-cold))) + `(org-table-header ((,class :inherit (fixed-pitch modus-theme-intense-neutral)))) + `(org-tag ((,class :foreground ,magenta-nuanced))) `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced))) `(org-target ((,class :underline t))) `(org-time-grid ((,class :foreground ,fg-unfocused))) - `(org-todo ((,class ,@(modus-operandi-theme-org-todo-block red-nuanced-bg red-nuanced red-alt) - ,@(modus-operandi-theme-heading-foreground red-alt red)))) + `(org-todo ((,class :box ,bg-region :background ,bg-dim :foreground ,red-alt))) `(org-upcoming-deadline ((,class :foreground ,red-alt-other))) `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced))) - `(org-verbatim ((,class :inherit fixed-pitch :background ,bg-alt :foreground ,fg-special-calm))) + `(org-verbatim ((,class ,@(modus-operandi-theme-mixed-fonts) + :background ,bg-alt :foreground ,fg-special-calm))) `(org-verse ((,class :inherit org-quote))) `(org-warning ((,class :inherit bold :foreground ,red-alt-other))) ;;;;; org-journal @@ -3291,8 +3700,11 @@ Also bind `class' to ((class color) (min-colors 89))." ;;;;; org-recur `(org-recur ((,class :foreground ,magenta-active))) ;;;;; org-roam - `(org-roam-link ((,class :foreground ,blue-alt-other :underline t))) - `(org-roam-backlink ((,class :foreground ,green-alt-other :underline t))) + `(org-roam-link ((,class :inherit button :foreground ,green))) + `(org-roam-link-current ((,class :inherit button :foreground ,green-alt))) + `(org-roam-link-invalid ((,class :inherit button :foreground ,red))) + `(org-roam-link-shielded ((,class :inherit button :foreground ,yellow))) + `(org-roam-tag ((,class :foreground ,fg-alt :slant italic))) ;;;;; org-superstar `(org-superstar-item ((,class :foreground ,fg-main))) `(org-superstar-leading ((,class :foreground ,fg-whitespace))) @@ -3305,37 +3717,16 @@ Also bind `class' to ((class color) (min-colors 89))." `(origami-fold-header-face ((,class :background ,bg-dim :foreground ,fg-dim :box t))) `(origami-fold-replacement-face ((,class :background ,bg-alt :foreground ,fg-alt))) ;;;;; outline-mode - `(outline-1 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-main magenta-alt-other) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4) - ,@(modus-operandi-theme-heading-block magenta-nuanced-bg magenta-nuanced)))) - `(outline-2 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-warm magenta-alt) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3) - ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(outline-3 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-cold blue) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2) - ,@(modus-operandi-theme-heading-block blue-nuanced-bg blue-nuanced)))) - `(outline-4 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-mild cyan) - ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1) - ,@(modus-operandi-theme-heading-block cyan-nuanced-bg cyan-nuanced)))) - `(outline-5 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-special-calm green-alt-other) - ,@(modus-operandi-theme-heading-block green-nuanced-bg green-nuanced)))) - `(outline-6 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground yellow-nuanced yellow-alt-other) - ,@(modus-operandi-theme-heading-block yellow-nuanced-bg yellow-nuanced)))) - `(outline-7 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground red-nuanced red-alt) - ,@(modus-operandi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(outline-8 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-operandi-theme-heading-foreground fg-dim magenta) - ,@(modus-operandi-theme-heading-block bg-alt fg-alt)))) + `(outline-1 ((,class :inherit modus-theme-heading-1))) + `(outline-2 ((,class :inherit modus-theme-heading-2))) + `(outline-3 ((,class :inherit modus-theme-heading-3))) + `(outline-4 ((,class :inherit modus-theme-heading-4))) + `(outline-5 ((,class :inherit modus-theme-heading-5))) + `(outline-6 ((,class :inherit modus-theme-heading-6))) + `(outline-7 ((,class :inherit modus-theme-heading-7))) + `(outline-8 ((,class :inherit modus-theme-heading-8))) ;;;;; outline-minor-faces - `(outline-minor-0 ((,class ,@(unless modus-operandi-theme-section-headings - (list :background cyan-nuanced-bg))))) + `(outline-minor-0 ((,class nil))) ;;;;; package (M-x list-packages) `(package-description ((,class :foreground ,fg-special-cold))) `(package-help-section-name ((,class :inherit bold :foreground ,magenta-alt-other))) @@ -3423,6 +3814,23 @@ Also bind `class' to ((class color) (min-colors 89))." `(prodigy-green-face ((,class :foreground ,green))) `(prodigy-red-face ((,class :foreground ,red))) `(prodigy-yellow-face ((,class :foreground ,yellow))) +;;;;; racket-mode + `(racket-debug-break-face ((,class :inherit modus-theme-intense-red))) + `(racket-debug-locals-face ((,class :box (:line-width -1 :color nil) + :foreground ,green-alt-other))) + `(racket-debug-result-face ((,class :inherit bold :box (:line-width -1 :color nil) + :foreground ,green))) + `(racket-here-string-face ((,class :foreground ,blue-alt))) + `(racket-keyword-argument-face ((,class :foreground ,red-alt))) + `(racket-logger-config-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) + `(racket-logger-debug-face ((,class :foreground ,blue-alt-other))) + `(racket-logger-info-face ((,class :foreground ,fg-lang-note))) + `(racket-logger-topic-face ((,class :foreground ,magenta :slant ,modus-theme-slant))) + `(racket-selfeval-face ((,class :foreground ,green-alt))) + `(racket-xp-error-face + ((,(append '((supports :underline (:style wave))) class) + :underline (:color ,fg-lang-error :style wave)) + (,class :foreground ,fg-lang-error :underline t))) ;;;;; rainbow-blocks `(rainbow-blocks-depth-1-face ((,class :foreground ,magenta-alt-other))) `(rainbow-blocks-depth-2-face ((,class :foreground ,blue))) @@ -3544,24 +3952,19 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-nuanced-blue blue-alt-other)))) ;;;;; selectrum - `(selectrum-current-candidate ((,class ,@(modus-operandi-theme-extra-completions - 'modus-theme-refine-magenta - 'modus-theme-intense-magenta - 'modus-theme-nuanced-magenta - magenta - 'bold)))) - `(selectrum-primary-highlight ((,class ,@(modus-operandi-theme-extra-completions - 'modus-theme-refine-blue - 'modus-theme-intense-blue - 'modus-theme-nuanced-blue - blue - 'bold)))) - `(selectrum-secondary-highlight ((,class ,@(modus-operandi-theme-extra-completions - 'modus-theme-refine-cyan - 'modus-theme-intense-cyan - 'modus-theme-nuanced-cyan - cyan - 'bold)))) + `(selectrum-current-candidate + ((,class :inherit bold :foreground ,fg-main :underline ,fg-main + :background ,@(pcase modus-operandi-theme-completions + ('opinionated (list bg-active)) + (_ (list bg-inactive)))))) + `(selectrum-primary-highlight ((,class :inherit bold + ,@(modus-operandi-theme-standard-completions + magenta-alt magenta-nuanced-bg + magenta-refine-bg magenta-refine-fg)))) + `(selectrum-secondary-highlight ((,class :inherit bold + ,@(modus-operandi-theme-standard-completions + cyan-alt-other cyan-nuanced-bg + cyan-refine-bg cyan-refine-fg)))) ;;;;; semantic `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t))) `(semantic-decoration-on-private-members-face ((,class :inherit modus-theme-refine-cyan))) @@ -3628,23 +4031,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(sp-wrap-overlay-opening-pair ((,class :inherit sp-pair-overlay-face))) `(sp-wrap-tag-overlay-face ((,class :inherit sp-pair-overlay-face))) ;;;;; smerge - `(smerge-base ((,class ,@(modus-operandi-theme-diffs - bg-main yellow - bg-diff-focus-changed fg-diff-focus-changed)))) - `(smerge-lower ((,class ,@(modus-operandi-theme-diffs - bg-main green - bg-diff-focus-added fg-diff-focus-added)))) + `(smerge-base ((,class :inherit modus-theme-diff-changed))) + `(smerge-lower ((,class :inherit modus-theme-diff-added))) `(smerge-markers ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2))) - `(smerge-refined-added ((,class ,@(modus-operandi-theme-diffs - bg-diff-added fg-diff-added - bg-diff-refine-added fg-diff-refine-added)))) + `(smerge-refined-added ((,class :inherit modus-theme-diff-refine-added))) `(smerge-refined-changed ((,class))) - `(smerge-refined-removed ((,class ,@(modus-operandi-theme-diffs - bg-diff-removed fg-diff-removed - bg-diff-refine-removed fg-diff-refine-removed)))) - `(smerge-upper ((,class ,@(modus-operandi-theme-diffs - bg-main red - bg-diff-focus-removed fg-diff-focus-removed)))) + `(smerge-refined-removed ((,class :inherit modus-theme-diff-refine-removed))) + `(smerge-upper ((,class :inherit modus-theme-diff-removed))) ;;;;; spaceline `(spaceline-evil-emacs ((,class :inherit modus-theme-active-magenta))) `(spaceline-evil-insert ((,class :inherit modus-theme-active-green))) @@ -3804,7 +4197,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(trashed-mark ((,class :inherit modus-theme-mark-symbol))) `(trashed-marked ((,class :inherit modus-theme-mark-alt))) `(trashed-restored ((,class :inherit modus-theme-mark-sel))) - `(trashed-symlink ((,class :foreground ,cyan-alt :underline t))) + `(trashed-symlink ((,class :inherit button :foreground ,cyan-alt))) ;;;;; treemacs `(treemacs-directory-collapsed-face ((,class :foreground ,magenta-alt))) `(treemacs-directory-face ((,class :inherit dired-directory))) @@ -3870,39 +4263,33 @@ Also bind `class' to ((class color) (min-colors 89))." `(tuareg-opam-pkg-variable-name-face ((,class ,@(modus-operandi-theme-syntax-foreground cyan cyan-faint) :slant ,modus-theme-slant))) +;;;;; typescript + `(typescript-jsdoc-tag ((,class :foreground ,fg-special-mild :slant ,modus-theme-slant))) + `(typescript-jsdoc-type ((,class :foreground ,fg-special-calm :slant ,modus-theme-slant))) + `(typescript-jsdoc-value ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) ;;;;; undo-tree `(undo-tree-visualizer-active-branch-face ((,class :inherit bold :foreground ,fg-main))) `(undo-tree-visualizer-current-face ((,class :foreground ,blue-intense))) `(undo-tree-visualizer-default-face ((,class :foreground ,fg-alt))) `(undo-tree-visualizer-register-face ((,class :foreground ,magenta-intense))) `(undo-tree-visualizer-unmodified-face ((,class :foreground ,green-intense))) -;;;;; vc - `(vc-conflict-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-active))) - `(vc-edited-state ((,class :foreground ,fg-special-warm))) +;;;;; vc (vc-hooks.el) + `(vc-conflict-state ((,class :foreground ,red-active :slant ,modus-theme-slant))) + `(vc-edited-state ((,class :foreground ,yellow-active))) `(vc-locally-added-state ((,class :foreground ,cyan-active))) - `(vc-locked-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-active))) - `(vc-missing-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,yellow-active))) - `(vc-needs-update-state ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,fg-special-mild))) + `(vc-locked-state ((,class :foreground ,blue-active))) + `(vc-missing-state ((,class :foreground ,magenta-active :slant ,modus-theme-slant))) + `(vc-needs-update-state ((,class :foreground ,green-active :slant ,modus-theme-slant))) `(vc-removed-state ((,class :foreground ,red-active))) `(vc-state-base ((,class :foreground ,fg-active))) `(vc-up-to-date-state ((,class :foreground ,fg-special-cold))) ;;;;; vdiff - `(vdiff-addition-face ((,class ,@(modus-operandi-theme-diffs - bg-main green - bg-diff-focus-added fg-diff-focus-added)))) - `(vdiff-change-face ((,class ,@(modus-operandi-theme-diffs - bg-main yellow - bg-diff-focus-changed fg-diff-focus-changed)))) + `(vdiff-addition-face ((,class :inherit modus-theme-diff-added))) + `(vdiff-change-face ((,class :inherit modus-theme-diff-changed))) `(vdiff-closed-fold-face ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1))) - `(vdiff-refine-added ((,class ,@(modus-operandi-theme-diffs - bg-diff-added fg-diff-added - bg-diff-refine-added fg-diff-refine-added)))) - `(vdiff-refine-changed ((,class ,@(modus-operandi-theme-diffs - bg-diff-changed fg-diff-changed - bg-diff-refine-changed fg-diff-refine-changed)))) - `(vdiff-subtraction-face ((,class ,@(modus-operandi-theme-diffs - bg-main red - bg-diff-focus-removed fg-diff-focus-removed)))) + `(vdiff-refine-added ((,class :inherit modus-theme-diff-refine-added))) + `(vdiff-refine-changed ((,class :inherit modus-theme-diff-refine-changed))) + `(vdiff-subtraction-face ((,class :inherit modus-theme-diff-removed))) `(vdiff-target-face ((,class :inherit modus-theme-intense-blue))) ;;;;; vimish-fold `(vimish-fold-fringe ((,class :foreground ,cyan-active))) @@ -3925,7 +4312,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(vhl/default-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t)) :background ,bg-alt :foreground ,blue-nuanced))) ;;;;; vterm - `(vterm-color-black ((,class :background "black" :foreground "black"))) + `(vterm-color-black ((,class :background "gray35" :foreground "gray35"))) `(vterm-color-blue ((,class :background ,blue :foreground ,blue))) `(vterm-color-cyan ((,class :background ,cyan :foreground ,cyan))) `(vterm-color-default ((,class :background ,bg-main :foreground ,fg-main))) @@ -3934,7 +4321,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(vterm-color-magenta ((,class :background ,magenta :foreground ,magenta))) `(vterm-color-red ((,class :background ,red :foreground ,red))) `(vterm-color-underline ((,class :foreground ,fg-special-warm :underline t))) - `(vterm-color-white ((,class :background "white" :foreground "white"))) + `(vterm-color-white ((,class :background "gray65" :foreground "gray65"))) `(vterm-color-yellow ((,class :background ,yellow :foreground ,yellow))) ;;;;; wcheck-mode `(wcheck-default-face ((,class :foreground ,red :underline t))) @@ -4135,7 +4522,6 @@ Also bind `class' to ((class color) (min-colors 89))." `(ztreep-node-count-children-face ((,class :foreground ,fg-special-warm))) `(ztreep-node-face ((,class :foreground ,fg-main)))) ;;;; Emacs 27+ - ;; EXPERIMENTAL this form is subject to review (when (>= emacs-major-version 27) (custom-theme-set-faces 'modus-operandi @@ -4143,8 +4529,12 @@ Also bind `class' to ((class color) (min-colors 89))." ;; NOTE that this is specifically for the faces that were ;; introduced in Emacs 27, as the other faces are already ;; supported. - `(line-number-major-tick ((,class (:background ,yellow-nuanced-bg :foreground ,yellow-nuanced)))) - `(line-number-minor-tick ((,class (:background ,cyan-nuanced-bg :foreground ,cyan-nuanced)))) + `(line-number-major-tick ((,class :inherit (bold default) + :background ,yellow-nuanced-bg + :foreground ,yellow-nuanced))) + `(line-number-minor-tick ((,class :inherit (bold default) + :background ,bg-inactive + :foreground ,fg-inactive))) ;;;;; tab-bar-mode `(tab-bar ((,class :background ,bg-tab-bar :foreground ,fg-main))) `(tab-bar-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active) @@ -4160,12 +4550,22 @@ Also bind `class' to ((class color) (min-colors 89))." `(tab-line-tab-current ((,class :inherit tab-line-tab))) `(tab-line-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive) :background ,bg-tab-inactive :foreground ,fg-dim))))) +;;;; Emacs 28+ + (when (>= emacs-major-version 28) + (custom-theme-set-faces + 'modus-operandi +;;;;; isearch regexp groups + `(isearch-group-1 ((,class :inherit modus-theme-intense-blue))) + `(isearch-group-2 ((,class :inherit modus-theme-intense-magenta))))) ;;; variables (custom-theme-set-variables 'modus-operandi ;;;; ansi-colors `(ansi-color-faces-vector [default bold shadow italic underline success warning error]) `(ansi-color-names-vector [,fg-main ,red ,green ,yellow ,blue ,magenta ,cyan ,bg-main]) +;;;; awesome-tray + `(awesome-tray-mode-line-active-color ,blue) + `(awesome-tray-mode-line-inactive-color ,bg-active) ;;;; flymake fringe indicators `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-theme-fringe-red)) `(flymake-warning-bitmap '(exclamation-mark modus-theme-fringe-yellow)) @@ -4174,7 +4574,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(ibuffer-deletion-face 'modus-theme-mark-del) `(ibuffer-filter-group-name-face 'modus-theme-mark-symbol) `(ibuffer-marked-face 'modus-theme-mark-sel) - `(ibuffer-title-face 'modus-theme-header) + `(ibuffer-title-face 'modus-theme-pseudo-header) ;;;; highlight-tail `(highlight-tail-colors '((,green-subtle-bg . 0) diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index fa1b6be8b8e..d45c3ca2eed 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -1,10 +1,10 @@ ;;; modus-vivendi-theme.el --- Accessible dark theme (WCAG AAA) -*- lexical-binding:t -*- -;; Copyright (c) 2019-2020 Free Software Foundation, Inc. +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 0.12.0 +;; Version: 0.13.0 ;; Package-Requires: ((emacs "26.1")) ;; Keywords: faces, theme, accessibility @@ -42,17 +42,18 @@ ;; modus-vivendi-theme-slanted-constructs (boolean) ;; modus-vivendi-theme-bold-constructs (boolean) ;; modus-vivendi-theme-variable-pitch-headings (boolean) -;; modus-vivendi-theme-rainbow-headings (boolean) -;; modus-vivendi-theme-section-headings (boolean) +;; modus-vivendi-theme-no-mixed-fonts (boolean) +;; modus-vivendi-theme-headings (alist) ;; modus-vivendi-theme-scale-headings (boolean) ;; modus-vivendi-theme-fringes (choice) ;; modus-vivendi-theme-org-blocks (choice) ;; modus-vivendi-theme-prompts (choice) -;; modus-vivendi-theme-3d-modeline (boolean) -;; modus-vivendi-theme-subtle-diffs (boolean) +;; modus-vivendi-theme-mode-line (choice) +;; modus-vivendi-theme-diffs (choice) ;; modus-vivendi-theme-faint-syntax (boolean) ;; modus-vivendi-theme-intense-hl-line (boolean) ;; modus-vivendi-theme-intense-paren-match (boolean) +;; modus-vivendi-theme-no-link-underline (boolean) ;; modus-vivendi-theme-completions (choice) ;; modus-vivendi-theme-override-colors-alist (alist) ;; @@ -81,6 +82,8 @@ ;; auctex and TeX ;; auto-dim-other-buffers ;; avy +;; awesome-tray +;; binder ;; bm ;; bongo ;; boon @@ -103,6 +106,7 @@ ;; counsel-notmuch ;; counsel-org-capture-string ;; cov +;; cperl-mode ;; csv-mode ;; ctrlf ;; custom (M-x customize) @@ -116,6 +120,7 @@ ;; diff-hl ;; diff-mode ;; dim-autoload +;; dir-treeview ;; dired ;; dired-async ;; dired-git @@ -132,6 +137,7 @@ ;; ediff ;; eglot ;; el-search +;; eldoc ;; eldoc-box ;; elfeed ;; elfeed-score @@ -146,6 +152,7 @@ ;; eshell-fringe-status ;; eshell-git-prompt ;; eshell-prompt-extras (epe) +;; eshell-syntax-highlighting ;; evil (evil-mode) ;; evil-goggles ;; evil-visual-mark-mode @@ -153,6 +160,7 @@ ;; eyebrowse ;; fancy-dabbrev ;; flycheck +;; flycheck-color-mode-line ;; flycheck-indicator ;; flycheck-posframe ;; flymake @@ -229,6 +237,7 @@ ;; minimap ;; modeline ;; mood-line +;; mpdel ;; mu4e ;; mu4e-conversation ;; multiple-cursors @@ -237,6 +246,7 @@ ;; notmuch ;; num3-mode ;; nxml-mode +;; objed ;; orderless ;; org ;; org-journal @@ -266,6 +276,7 @@ ;; powerline-evil ;; proced ;; prodigy +;; racket-mode ;; rainbow-blocks ;; rainbow-identifiers ;; rainbow-delimiters @@ -308,6 +319,7 @@ ;; treemacs ;; tty-menu ;; tuareg +;; typescript ;; undo-tree ;; vc (built-in mode line status for version control) ;; vc-annotate (C-x v g) @@ -411,11 +423,19 @@ between foreground and background is >= 7:1)." (defface modus-theme-diff-focus-changed nil nil) (defface modus-theme-diff-focus-removed nil nil) (defface modus-theme-diff-heading nil nil) -(defface modus-theme-header nil nil) ; Name is tentative +(defface modus-theme-pseudo-header nil nil) (defface modus-theme-mark-alt nil nil) (defface modus-theme-mark-del nil nil) (defface modus-theme-mark-sel nil nil) (defface modus-theme-mark-symbol nil nil) +(defface modus-theme-heading-1 nil nil) +(defface modus-theme-heading-2 nil nil) +(defface modus-theme-heading-3 nil nil) +(defface modus-theme-heading-4 nil nil) +(defface modus-theme-heading-5 nil nil) +(defface modus-theme-heading-6 nil nil) +(defface modus-theme-heading-7 nil nil) +(defface modus-theme-heading-8 nil nil) (defface modus-theme-hl-line nil nil) ;;; Customisation options @@ -441,14 +461,125 @@ between foreground and background is >= 7:1)." "Use proportional fonts (variable-pitch) in headings." :type 'boolean) +(defcustom modus-vivendi-theme-no-mixed-fonts nil + "Disable inheritance from `fixed-pitch' in some faces. + +This is done by default to allow spacing-sensitive constructs, +such as Org tables and code blocks, to remain monospaced when +users opt for something like the command `variable-pitch-mode'. +The downside with the default is that users need to explicitly +configure the font family of `fixed-pitch' in order to get a +consistent experience. That may be something they do not want to +do. Hence this option to disable any kind of technique for +mixing fonts." + :type 'boolean) + +(make-obsolete 'modus-vivendi-theme-rainbow-headings + 'modus-vivendi-theme-headings + "`modus-vivendi-theme' 0.13.0") + (defcustom modus-vivendi-theme-rainbow-headings nil "Use more saturated colours for headings." :type 'boolean) +(make-obsolete 'modus-vivendi-theme-section-headings + 'modus-vivendi-theme-headings + "`modus-vivendi-theme' 0.13.0") + (defcustom modus-vivendi-theme-section-headings nil "Use a background and an overline in headings." :type 'boolean) +(defcustom modus-vivendi-theme-headings + '((t . nil)) + "Alist of styles for headings, with optional value per level. + +To control faces per level from 1-8, use something like this: + + (setq modus-vivendi-theme-headings + '((1 . highlight) + (2 . line) + (t . rainbow-line-no-bold))) + +To set a uniform value for all heading levels, use this pattern: + + (setq modus-vivendi-theme-headings + '((t . rainbow-line-no-bold))) + +The default uses a fairly desaturated foreground value in +combination with a bold typographic weight. To specify this +style for a given level N (assuming you wish to have another +fallback option), just specify the value t like this: + + (setq modus-vivendi-theme-headings + '((1 . t) + (2 . line) + (t . rainbow-line-no-bold))) + +A description of all possible values: + ++ `no-bold' retains the default text colour while removing + the typographic weight. + ++ `line' is the same as the default plus an overline over the + heading. + ++ `line-no-bold' is the same as `line' without bold weight. + ++ `rainbow' uses a more colourful foreground in combination + with bold weight. + ++ `rainbow-line' is the same as `rainbow' plus an overline. + ++ `rainbow-line-no-bold' is the same as `rainbow-line' without + the bold weight. + ++ `highlight' retains the default style of a fairly desaturated + foreground combined with a bold weight and add to it a subtle + accented background. + ++ `highlight-no-bold' is the same as `highlight' without a bold + weight. + ++ `rainbow-highlight' is the same as `highlight' but with a more + colourful foreground. + ++ `rainbow-highlight-no-bold' is the same as `rainbow-highlight' + without a bold weight. + ++ `section' retains the default looks and adds to them both an + overline and a slightly accented background. It is, in effect, + a combination of the `line' and `highlight' values. + ++ `section-no-bold' is the same as `section' without a bold + weight. + ++ `rainbow-section' is the same as `section' but with a more + colourful foreground. + ++ `rainbow-section-no-bold' is the same as `rainbow-section' + without a bold weight." + :type + '(alist + :key-type symbol + :value-type + (choice (const :tag "Fairly desaturated foreground with bold weight (default)" t) + (const :tag "Like the default without bold weight" no-bold) + (const :tag "Like the default plus overline" line) + (const :tag "Like `line' without bold weight" line-no-bold) + (const :tag "Like the default but with more colourful foreground" rainbow) + (const :tag "Like `rainbow' plus overline" rainbow-line) + (const :tag "Like `rainbow' without bold weight" rainbow-no-bold) + (const :tag "Like `rainbow-line' without bold weight" rainbow-line-no-bold) + (const :tag "Like the default plus subtle background" highlight) + (const :tag "Like `highlight' without bold weight" highlight-no-bold) + (const :tag "Like `highlight' with more colourful foreground" rainbow-highlight) + (const :tag "Like `rainbow-highlight' without bold weight" rainbow-highlight-no-bold) + (const :tag "Like `highlight' plus overline" section) + (const :tag "Like `section' without bold weight" section-no-bold) + (const :tag "Like `section' with more colourful foreground" rainbow-section) + (const :tag "Like `rainbow-section' without bold weight" rainbow-section-no-bold)))) + (defcustom modus-vivendi-theme-scale-headings nil "Use font scaling for headings." :type 'boolean) @@ -508,8 +639,9 @@ For more on the matter, read the documentation of `set-face-attribute', specifically the ':height' section." :type 'number) -(define-obsolete-variable-alias 'modus-vivendi-theme-visible-fringes - 'modus-vivendi-theme-fringes "`modus-vivendi-theme' 0.12.0") +(make-obsolete 'modus-vivendi-theme-visible-fringes + 'modus-vivendi-theme-fringes + "`modus-vivendi-theme' 0.12.0") (defcustom modus-vivendi-theme-visible-fringes nil "Use a visible style for fringes." @@ -527,15 +659,17 @@ pronounced greyscale value." (const :tag "Subtle greyscale background" subtle) (const :tag "Intense greyscale background" intense))) -(define-obsolete-variable-alias 'modus-vivendi-theme-distinct-org-blocks - 'modus-vivendi-theme-org-blocks "`modus-vivendi-theme' 0.11.0") +(make-obsolete 'modus-vivendi-theme-distinct-org-blocks + 'modus-vivendi-theme-org-blocks + "`modus-vivendi-theme' 0.11.0") (defcustom modus-vivendi-theme-distinct-org-blocks nil "Use a distinct neutral background for `org-mode' blocks." :type 'boolean) -(define-obsolete-variable-alias 'modus-vivendi-theme-rainbow-org-src-blocks - 'modus-vivendi-theme-org-blocks "`modus-vivendi-theme' 0.11.0") +(make-obsolete 'modus-vivendi-theme-rainbow-org-src-blocks + 'modus-vivendi-theme-org-blocks + "`modus-vivendi-theme' 0.11.0") (defcustom modus-vivendi-theme-rainbow-org-src-blocks nil "Use colour-coded backgrounds for `org-mode' source blocks. @@ -565,16 +699,69 @@ association list)." (const :tag "Subtle grey block background" greyscale) (const :tag "Colour-coded background per programming language" rainbow))) +(make-obsolete 'modus-vivendi-theme-3d-modeline + 'modus-vivendi-theme-mode-line + "`modus-vivendi-theme' 0.13.0") + (defcustom modus-vivendi-theme-3d-modeline nil "Use a three-dimensional style for the active mode line." :type 'boolean) +(defcustom modus-vivendi-theme-mode-line nil + "Adjust the overall style of the mode line. + +Nil is a two-dimensional rectangle with a border around it. The +active and the inactive modelines use different shades of +greyscale values for the background and foreground. + +A `3d' value will apply a three-dimensional effect to the active +modeline. The inactive modelines remain two-dimensional and are +toned down a bit, relative to the nil value. + +The `moody' option is meant to optimise the modeline for use with +the library of the same name. This practically means to remove +the box effect and rely on underline and overline properties +instead. It also tones down the inactive modelines. Despite its +intended purpose, this option can also be used without the +`moody' library." + :type '(choice + (const :tag "Two-dimensional box (default)" nil) + (const :tag "Three-dimensional style for the active mode line" 3d) + (const :tag "No box effects, which are optimal for use with the `moody' library" moody))) + +(make-obsolete 'modus-vivendi-theme-subtle-diffs + 'modus-vivendi-theme-diffs + "`modus-vivendi-theme' 0.13.0") + (defcustom modus-vivendi-theme-subtle-diffs nil "Use fewer/dim backgrounds in `diff-mode', `ediff',`magit'." :type 'boolean) -(define-obsolete-variable-alias 'modus-vivendi-theme-intense-standard-completions - 'modus-vivendi-theme-completions "`modus-vivendi-theme' 0.12.0") +(defcustom modus-vivendi-theme-diffs nil + "Adjust the overall styles of diffs. + +Nil means to use fairly intense colour combinations for diffs. +For example, you get a rich green background with a green +foreground for added lines. Word-wise or 'refined' diffs follow +the same pattern but use different shades of those colours to +remain distinct. + +A `desaturated' value follows the same principles as with the nil +option, while it tones down all relevant colours. + +Option `fg-only' will remove all accented backgrounds, except +from word-wise changes. It instead uses colour-coded foreground +values to differentiate between added/removed/changed lines. If +a background is necessary, such as with `ediff', then a subtle +greyscale value is used." + :type '(choice + (const :tag "Intensely coloured backgrounds (default)" nil) + (const :tag "Slightly accented backgrounds with tinted text" desaturated) + (const :tag "No backgrounds, except for refined diffs" fg-only))) + +(make-obsolete 'modus-vivendi-theme-intense-standard-completions + 'modus-vivendi-theme-completions + "`modus-vivendi-theme' 0.12.0") (defcustom modus-vivendi-theme-intense-standard-completions nil "Use prominent backgrounds for Icomplete, Ido, or similar." @@ -582,6 +769,7 @@ association list)." (defcustom modus-vivendi-theme-completions nil "Apply special styles to the UI of completion frameworks. + This concerns Icomplete, Ivy, Helm, Selectrum, Ido, as well as any other tool meant to enhance their experience. The effect will vary depending on the completion framework. @@ -621,7 +809,7 @@ effect than the former." (const :tag "Intense background and foreground for the prompt" intense))) (defcustom modus-vivendi-theme-intense-hl-line nil - "Use more prominent background for `hl-line-mode'." + "Use more prominent background for command `hl-line-mode'." :type 'boolean) (defcustom modus-vivendi-theme-intense-paren-match nil @@ -632,6 +820,10 @@ effect than the former." "Use less saturated colours for code syntax highlighting." :type 'boolean) +(defcustom modus-vivendi-theme-no-link-underline nil + "Do not underline links." + :type 'boolean) + ;;; Internal functions ;; Helper functions that are meant to ease the implementation of the @@ -641,6 +833,11 @@ effect than the former." (when modus-vivendi-theme-bold-constructs (list :inherit 'bold))) +(defun modus-vivendi-theme-mixed-fonts () + "Conditional application of `fixed-pitch' inheritance." + (unless modus-vivendi-theme-no-mixed-fonts + (list :inherit 'fixed-pitch))) + (defun modus-vivendi-theme-fringe (subtlebg intensebg) "Conditional use of background colours for fringes. SUBTLEBG should be a subtle greyscale value. INTENSEBG must be a @@ -679,29 +876,65 @@ FAINT is the less saturated colour." (list :foreground faint) (list :foreground normal))) -(defun modus-vivendi-theme-heading-foreground (subtle rainbow) - "Apply foreground value to headings. -SUBTLE is the default aesthetic. RAINBOW is the saturated one." - (if modus-vivendi-theme-rainbow-headings - (list :foreground rainbow) - (list :foreground subtle))) - -(defun modus-vivendi-theme-heading-block (bg fg) - "Conditionally extend heading styles. -Apply BG to background and FG to overline." - (if modus-vivendi-theme-section-headings - (append - (and (>= emacs-major-version 27) '(:extend t)) - (list :background bg :overline fg)) - (list :background nil :overline nil))) +(defun modus-vivendi-theme-heading-p (key) + "Query style of KEY in `modus-vivendi-theme-headings'." + (cdr (assoc key modus-vivendi-theme-headings))) + +(defun modus-vivendi-theme-heading (level fg fg-alt bg border) + "Conditional styles for `modus-vivendi-theme-headings'. -(defun modus-vivendi-theme-org-todo-block (bgbox fgbox fg) - "Conditionally extend the styles of Org keywords. -BGBOX applies to the background. FGBOX applies to the foreground -and the border. FG is used when no block style is in effect." - (if modus-vivendi-theme-section-headings - (list :background bgbox :foreground fgbox :box (list :color fgbox)) - (list :foreground fg))) +LEVEL is the heading's position in their order. FG is the +default text colour. FG-ALT is an accented, more saturated value +than the default. BG is a nuanced, typically accented, +background that can work well with either of the foreground +values. BORDER is a colour value that combines well with the +background and alternative foreground." + (let* ((key (modus-vivendi-theme-heading-p `,level)) + (style (or key (modus-vivendi-theme-heading-p t))) + (var (if modus-vivendi-theme-variable-pitch-headings + 'variable-pitch + 'default))) + (pcase style + ('no-bold + (list :inherit `,var :foreground fg)) + ('line + (list :inherit `(bold ,var) :foreground fg :overline border)) + ('line-no-bold + (list :inherit `,var :foreground fg :overline border)) + ('rainbow + (list :inherit `(bold ,var) :foreground fg-alt)) + ('rainbow-no-bold + (list :inherit `,var :foreground fg-alt)) + ('rainbow-line + (list :inherit `(bold ,var) :foreground fg-alt :overline border)) + ('rainbow-line-no-bold + (list :inherit `,var :foreground fg-alt :overline border)) + ('highlight + (list :inherit `(bold ,var) :background bg :foreground fg)) + ('highlight-no-bold + (list :inherit `,var :background bg :foreground fg)) + ('rainbow-highlight + (list :inherit `(bold ,var) :background bg :foreground fg-alt)) + ('rainbow-highlight-no-bold + (list :inherit `,var :background bg :foreground fg-alt)) + ('section + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `(bold ,var) :background bg :foreground fg :overline border))) + ('section-no-bold + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `,var :background bg :foreground fg :overline border))) + ('rainbow-section + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `(bold ,var) :background bg :foreground fg-alt :overline border))) + ('rainbow-section-no-bold + (append + (and (>= emacs-major-version 27) '(:extend t)) + (list :inherit `,var :background bg :foreground fg-alt :overline border))) + (_ + (list :inherit `(bold ,var) :foreground fg))))) (defun modus-vivendi-theme-org-block (bgblk) "Conditionally set the background of Org blocks. @@ -737,46 +970,64 @@ set to `rainbow'." ('rainbow (list :background bgaccent :foreground fgaccent)) (_ (list :background bg :foreground fg)))) -(defun modus-vivendi-theme-modeline-box (col3d col &optional btn int) - "Control the box properties of the mode line. -COL3D is the border that is intended for the three-dimensional -modeline. COL applies to the two-dimensional modeline. Optional -BTN provides the 3d button style. Optional INT defines a border -width." - (let* ((style (if btn 'released-button nil)) - (int (if int int 1))) - (if modus-vivendi-theme-3d-modeline - (list :line-width int :color col3d :style style) - (list :line-width 1 :color col :style nil)))) - -(defun modus-vivendi-theme-modeline-props (bg3d fg3d &optional bg fg) - "Control the background and foreground of the mode line. -BG is the modeline's background. FG is the modeline's -foreground. BG3D and FG3D apply to the three-dimensional -modeline style." - (if modus-vivendi-theme-3d-modeline - (list :background bg3d :foreground fg3d) - (list :background bg :foreground fg))) - -(defun modus-vivendi-theme-diffs (subtle-bg subtle-fg intense-bg intense-fg) - "Colour combinations for `modus-vivendi-theme-subtle-diffs'. - -SUBTLE-BG should be similar or the same as the main background. -SUBTLE-FG should be an appropriate accent value. INTENSE-BG -should be one of the dedicated backgrounds for diffs. INTENSE-FG -should be one of the dedicated foregrounds for diffs" - (if modus-vivendi-theme-subtle-diffs - (list :background subtle-bg :foreground subtle-fg) - (list :background intense-bg :foreground intense-fg))) +(defun modus-vivendi-theme-mode-line-attrs + (fg bg fg-alt bg-alt border border-3d &optional alt-style border-width fg-distant) + "Colour combinations for `modus-vivendi-theme-mode-line'. + +FG and BG are the default colours. FG-ALT and BG-ALT are meant +to accommodate the options for a 3D modeline or a `moody' +compliant one. BORDER applies to all permutations of the +modeline, except the three-dimensional effect, where BORDER-3D is +used instead. + +Optional ALT-STYLE applies an appropriate style to the mode +line's box property. + +Optional BORDER-WIDTH specifies an integer for the width of the +rectangle that produces the box effect. + +Optional FG-DISTANT should be close to the main background +values. It is intended to be used as a distant-foreground +property." + (pcase modus-vivendi-theme-mode-line + ('3d + `(:background ,bg-alt :foreground ,fg-alt + :box (:line-width ,(or border-width 1) + :color ,border-3d + :style ,(and alt-style 'released-button)))) + ('moody + `(:background ,bg-alt :foreground ,fg-alt :underline ,border :overline ,border + :distant-foreground ,fg-distant)) + (_ + `(:foreground ,fg :background ,bg :box ,border)))) + +(defun modus-vivendi-theme-diff (fg-only-bg fg-only-fg mainbg mainfg altbg altfg) + "Colour combinations for `modus-vivendi-theme-diffs'. + +FG-ONLY-BG should be similar or the same as the main background. +FG-ONLY-FG should be a saturated accent value that can be +combined with the former. + +MAINBG must be one of the dedicated backgrounds for diffs while +MAINFG must be the same for the foreground. + +ALTBG needs to be a slightly accented background that is meant to +be combined with ALTFG. Both must be less intense than MAINBG +and MAINFG respectively." + (pcase modus-vivendi-theme-diffs + ('fg-only (list :background fg-only-bg :foreground fg-only-fg)) + ('desaturated (list :background altbg :foreground altfg)) + (_ (list :background mainbg :foreground mainfg)))) (defun modus-vivendi-theme-standard-completions (mainfg subtlebg intensebg intensefg) "Combinations for `modus-vivendi-theme-completions'. -These are intended for Icomplete, Ido, and related. MAINFG is an accented foreground value. SUBTLEBG is an accented background value that can be combined with MAINFG. INTENSEBG and INTENSEFG are accented colours that are designed to be used in -tandem." +tandem. + +These are intended for Icomplete, Ido, and related." (pcase modus-vivendi-theme-completions ('opinionated (list :background intensebg :foreground intensefg)) ('moderate (list :background subtlebg :foreground mainfg)) @@ -784,7 +1035,6 @@ tandem." (defun modus-vivendi-theme-extra-completions (subtleface intenseface altface &optional altfg bold) "Combinations for `modus-vivendi-theme-completions'. -These are intended for Helm, Ivy, Selectrum, etc. SUBTLEFACE and INTENSEFACE are custom theme faces that combine a background and foreground value. The difference between the two @@ -794,10 +1044,12 @@ ALTFACE is a combination of colours that represents a departure from the UI's default aesthetics. Optional ALTFG is meant to be used in tandem with it. -Optional BOLD will apply a heavier weight to the text." +Optional BOLD will apply a heavier weight to the text. + +These are intended for Helm, Ivy, etc." (pcase modus-vivendi-theme-completions ('opinionated (list :inherit (list altface bold) - :foreground (if altfg altfg 'unspecified))) + :foreground (or altfg 'unspecified))) ('moderate (list :inherit (list subtleface bold))) (_ (list :inherit (list intenseface bold))))) @@ -826,8 +1078,8 @@ AMOUNT is a customisation option." ;; specifically for on/off states (e.g. `mode-line') ;; ;; must be combined with themselves - ("bg-active" . "#2f2f2f") ("fg-active" . "#f5f5f5") - ("bg-inactive" . "#202020") ("fg-inactive" . "#bebebe") + ("bg-active" . "#323232") ("fg-active" . "#f4f4f4") + ("bg-inactive" . "#1e1e1e") ("fg-inactive" . "#bfc0c4") ;; special base values, used only for cases where the above ;; fg-* or bg-* cannot or should not be used (to avoid confusion) ;; must be combined with: {fg,bg}-{main,alt,dim} @@ -839,19 +1091,19 @@ AMOUNT is a customisation option." ;; ;; must be combined with: `bg-main', `bg-alt', `bg-dim' ("red" . "#ff8059") ("green" . "#44bc44") - ("yellow" . "#eecc00") ("blue" . "#29aeff") + ("yellow" . "#eecc00") ("blue" . "#2fafff") ("magenta" . "#feacd0") ("cyan" . "#00d3d0") ;; styles for common, but still specialised constructs ;; ;; must be combined with: `bg-main', `bg-alt', `bg-dim' ("red-alt" . "#f4923b") ("green-alt" . "#80d200") - ("yellow-alt" . "#cfdf30") ("blue-alt" . "#72a4ff") + ("yellow-alt" . "#cfdf30") ("blue-alt" . "#79a8ff") ("magenta-alt" . "#f78fe7") ("cyan-alt" . "#4ae8fc") ;; same purpose as above, just slight differences ;; ;; must be combined with: `bg-main', `bg-alt', `bg-dim' ("red-alt-other" . "#ff9977") ("green-alt-other" . "#00cd68") - ("yellow-alt-other" . "#f0ce43") ("blue-alt-other" . "#00bdfa") + ("yellow-alt-other" . "#f0ce43") ("blue-alt-other" . "#00bcff") ("magenta-alt-other" . "#b6a0ff") ("cyan-alt-other" . "#6ae4b9") ;; styles for desaturated foreground text, intended for use with ;; the `modus-vivendi-theme-faint-syntax' option @@ -915,21 +1167,24 @@ AMOUNT is a customisation option." ;; styles that are meant exclusively for the mode line ;; ;; must be combined with: `bg-active', `bg-inactive' - ("red-active" . "#ffa49e") ("green-active" . "#70e030") - ("yellow-active" . "#efdf00") ("blue-active" . "#00ccff") - ("magenta-active" . "#d0acff") ("cyan-active" . "#00ddc0") + ("red-active" . "#ffa7ba") ("green-active" . "#70d73f") + ("yellow-active" . "#dbbe5f") ("blue-active" . "#34cfff") + ("magenta-active" . "#d5b1ff") ("cyan-active" . "#00d8b4") ;; styles that are meant exclusively for the fringes ;; - ;; must have a minimum contrast ratio of 1.5:1 with `bg-inactive' - ;; and be combined with `fg-main' or `fg-dim' - ("red-fringe-bg" . "#8f0040") ("green-fringe-bg" . "#006000") - ("yellow-fringe-bg" . "#6f4a00") ("blue-fringe-bg" . "#3a30ab") - ("magenta-fringe-bg" . "#692089") ("cyan-fringe-bg" . "#0068a0") + ;; must be combined with `fg-main' + ("red-fringe-bg" . "#8f1f4b") ("green-fringe-bg" . "#006700") + ("yellow-fringe-bg" . "#6f4f00") ("blue-fringe-bg" . "#3f33af") + ("magenta-fringe-bg" . "#6f2f89") ("cyan-fringe-bg" . "#004f8f") ;; styles reserved for specific faces ;; ;; `bg-hl-line' is between `bg-dim' and `bg-alt', so it should ;; work with all accents that cover those two, plus `bg-main' ;; + ;; `bg-hl-alt' and `bg-hl-alt-intense' should only be used when no + ;; other greyscale or fairly neutral background is available to + ;; properly draw attention to a given construct + ;; ;; `bg-header' is between `bg-active' and `bg-inactive', so it ;; can be combined with any of the "active" values, plus the ;; "special" and base foreground colours @@ -960,8 +1215,11 @@ AMOUNT is a customisation option." ;; ;; all pairs are combinable with themselves ("bg-hl-line" . "#151823") + ("bg-hl-line-intense" . "#2f2f2f") + ("bg-hl-alt" . "#181732") + ("bg-hl-alt-intense" . "#282e46") ("bg-paren-match" . "#5f362f") - ("bg-paren-match-intense" . "#255650") + ("bg-paren-match-intense" . "#7416b5") ("bg-region" . "#3c3c3c") ("bg-tab-bar" . "#2c2c2c") @@ -1094,12 +1352,12 @@ Also bind `class' to ((class color) (min-colors 89))." `(modus-theme-nuanced-cyan ((,class :background ,cyan-nuanced-bg ,@(and (>= emacs-major-version 27) '(:extend t))))) ;;;;; fringe-specific combinations - `(modus-theme-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-dim))) - `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-dim))) + `(modus-theme-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-main))) + `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-main))) ;;;;; special base values ;; these are closer to the grayscale than the accents defined above ;; and should only be used when the next closest alternative would be @@ -1110,26 +1368,96 @@ Also bind `class' to ((class color) (min-colors 89))." `(modus-theme-special-calm ((,class :background ,bg-special-calm :foreground ,fg-special-calm))) ;;;;; diff-specific combinations ;; intended for `diff-mode' or equivalent - `(modus-theme-diff-added ((,class :background ,bg-diff-added :foreground ,fg-diff-added))) - `(modus-theme-diff-changed ((,class :background ,bg-diff-changed :foreground ,fg-diff-changed))) - `(modus-theme-diff-removed ((,class :background ,bg-diff-removed :foreground ,fg-diff-removed))) - `(modus-theme-diff-refine-added ((,class :background ,bg-diff-refine-added :foreground ,fg-diff-refine-added))) - `(modus-theme-diff-refine-changed ((,class :background ,bg-diff-refine-changed :foreground ,fg-diff-refine-changed))) - `(modus-theme-diff-refine-removed ((,class :background ,bg-diff-refine-removed :foreground ,fg-diff-refine-removed))) - `(modus-theme-diff-focus-added ((,class :background ,bg-diff-focus-added :foreground ,fg-diff-focus-added))) - `(modus-theme-diff-focus-changed ((,class :background ,bg-diff-focus-changed :foreground ,fg-diff-focus-changed))) - `(modus-theme-diff-focus-removed ((,class :background ,bg-diff-focus-removed :foreground ,fg-diff-focus-removed))) - `(modus-theme-diff-heading ((,class :background ,bg-diff-heading :foreground ,fg-diff-heading))) + `(modus-theme-diff-added + ((,class ,@(modus-vivendi-theme-diff + bg-main green + bg-diff-focus-added fg-diff-focus-added + green-nuanced-bg fg-diff-added)))) + `(modus-theme-diff-changed + ((,class ,@(modus-vivendi-theme-diff + bg-main yellow + bg-diff-focus-changed fg-diff-focus-changed + yellow-nuanced-bg fg-diff-changed)))) + `(modus-theme-diff-removed + ((,class ,@(modus-vivendi-theme-diff + bg-main red + bg-diff-focus-removed fg-diff-focus-removed + red-nuanced-bg fg-diff-removed)))) + `(modus-theme-diff-refine-added + ((,class ,@(modus-vivendi-theme-diff + bg-diff-added fg-diff-added + bg-diff-refine-added fg-diff-refine-added + bg-diff-focus-added fg-diff-focus-added)))) + `(modus-theme-diff-refine-changed + ((,class ,@(modus-vivendi-theme-diff + bg-diff-changed fg-diff-changed + bg-diff-refine-changed fg-diff-refine-changed + bg-diff-focus-changed fg-diff-focus-changed)))) + `(modus-theme-diff-refine-removed + ((,class ,@(modus-vivendi-theme-diff + bg-diff-removed fg-diff-removed + bg-diff-refine-removed fg-diff-refine-removed + bg-diff-focus-removed fg-diff-focus-removed)))) + `(modus-theme-diff-focus-added + ((,class ,@(modus-vivendi-theme-diff + bg-dim green + bg-diff-focus-added fg-diff-focus-added + bg-diff-added fg-diff-added)))) + `(modus-theme-diff-focus-changed + ((,class ,@(modus-vivendi-theme-diff + bg-dim yellow + bg-diff-focus-changed fg-diff-focus-changed + bg-diff-changed fg-diff-changed)))) + `(modus-theme-diff-focus-removed + ((,class ,@(modus-vivendi-theme-diff + bg-dim red + bg-diff-focus-removed fg-diff-focus-removed + bg-diff-removed fg-diff-removed)))) + `(modus-theme-diff-heading + ((,class ,@(modus-vivendi-theme-diff + bg-alt blue-alt + bg-diff-heading fg-diff-heading + blue-nuanced-bg blue)))) ;;;;; mark indicators ;; colour combinations intended for Dired, Ibuffer, or equivalent - `(modus-theme-header ((,class :inherit bold :foreground ,fg-main))) + `(modus-theme-pseudo-header ((,class :inherit bold :foreground ,fg-main))) `(modus-theme-mark-alt ((,class :inherit bold :background ,bg-mark-alt :foreground ,fg-mark-alt))) `(modus-theme-mark-del ((,class :inherit bold :background ,bg-mark-del :foreground ,fg-mark-del))) `(modus-theme-mark-sel ((,class :inherit bold :background ,bg-mark-sel :foreground ,fg-mark-sel))) `(modus-theme-mark-symbol ((,class :inherit bold :foreground ,blue-alt))) +;;;;; heading levels + ;; styles for regular headings used in Org, Markdown, Info, etc. + `(modus-theme-heading-1 + ((,class ,@(modus-vivendi-theme-heading + 1 fg-main magenta-alt-other magenta-nuanced-bg bg-region) + ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)))) + `(modus-theme-heading-2 + ((,class ,@(modus-vivendi-theme-heading + 2 fg-special-warm magenta-alt red-nuanced-bg bg-region) + ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3)))) + `(modus-theme-heading-3 + ((,class ,@(modus-vivendi-theme-heading + 3 fg-special-cold blue blue-nuanced-bg bg-region) + ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2)))) + `(modus-theme-heading-4 + ((,class ,@(modus-vivendi-theme-heading + 4 fg-special-mild cyan cyan-nuanced-bg bg-region) + ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1)))) + `(modus-theme-heading-5 + ((,class ,@(modus-vivendi-theme-heading + 5 fg-special-calm green-alt-other green-nuanced-bg bg-region)))) + `(modus-theme-heading-6 + ((,class ,@(modus-vivendi-theme-heading + 6 yellow-nuanced yellow-alt-other yellow-nuanced-bg bg-region)))) + `(modus-theme-heading-7 + ((,class ,@(modus-vivendi-theme-heading + 7 red-nuanced red-alt red-nuanced-bg bg-region)))) + `(modus-theme-heading-8 + ((,class ,@(modus-vivendi-theme-heading + 8 fg-dim magenta bg-alt bg-region)))) ;;;;; other custom faces `(modus-theme-hl-line ((,class :background ,(if modus-vivendi-theme-intense-hl-line - bg-active bg-hl-line) + bg-hl-line-intense bg-hl-line) (and (>= emacs-major-version 27) '(:extend t))))) ;;;; standard faces ;;;;; absolute essentials @@ -1149,26 +1477,25 @@ Also bind `class' to ((class color) (min-colors 89))." `(bold ((,class :weight bold))) `(comint-highlight-input ((,class :inherit bold))) `(comint-highlight-prompt ((,class ,@(modus-vivendi-theme-bold-weight) - ,@(modus-vivendi-theme-prompt cyan - blue-nuanced-bg - blue-alt - blue-refine-bg - fg-main)))) + ,@(modus-vivendi-theme-prompt + cyan + blue-nuanced-bg blue-alt + blue-refine-bg fg-main)))) `(error ((,class :inherit bold :foreground ,red))) `(escape-glyph ((,class :foreground ,fg-escape-char-construct))) `(file-name-shadow ((,class :foreground ,fg-unfocused))) `(header-line ((,class :background ,bg-header :foreground ,fg-header))) `(header-line-highlight ((,class :inherit modus-theme-active-blue))) + `(help-argument-name ((,class :foreground ,cyan :slant ,modus-theme-slant))) `(homoglyph ((,class :foreground ,fg-escape-char-construct))) `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other))) `(italic ((,class :slant italic))) `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct))) `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t))) - `(minibuffer-prompt ((,class ,@(modus-vivendi-theme-prompt cyan-alt-other - cyan-nuanced-bg - cyan - cyan-refine-bg - fg-main)))) + `(minibuffer-prompt ((,class ,@(modus-vivendi-theme-prompt + cyan-alt-other + cyan-nuanced-bg cyan + cyan-refine-bg fg-main)))) `(mm-command-output ((,class :foreground ,red-alt-other))) `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild))) `(next-error ((,class :inherit modus-theme-subtle-red))) @@ -1180,9 +1507,11 @@ Also bind `class' to ((class color) (min-colors 89))." `(trailing-whitespace ((,class :background ,red-intense-bg))) `(warning ((,class :inherit bold :foreground ,yellow))) ;;;;; buttons, links, widgets - `(button ((,class :foreground ,blue-alt-other :underline t))) - `(link ((,class :foreground ,blue-alt-other :underline t))) - `(link-visited ((,class :foreground ,magenta-alt-other :underline t))) + `(button ((,class :foreground ,blue-alt-other + ,@(unless modus-vivendi-theme-no-link-underline + (list :underline t))))) + `(link ((,class :inherit button))) + `(link-visited ((,class :inherit link :foreground ,magenta-alt-other))) `(tooltip ((,class :background ,bg-special-cold :foreground ,fg-main))) `(widget-button ((,class :inherit button))) `(widget-button-pressed ((,class :inherit button :foreground ,magenta))) @@ -1249,13 +1578,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(anzu-replace-highlight ((,class :inherit modus-theme-refine-yellow :underline t))) `(anzu-replace-to ((,class :inherit (modus-theme-intense-green bold)))) ;;;;; apropos - `(apropos-function-button ((,class :foreground ,magenta-alt-other :underline t))) + `(apropos-function-button ((,class :inherit button :foreground ,magenta-alt-other))) `(apropos-keybinding ((,class :inherit bold :foreground ,cyan))) - `(apropos-misc-button ((,class :foreground ,cyan-alt-other :underline t))) + `(apropos-misc-button ((,class :inherit button :foreground ,cyan-alt-other))) `(apropos-property ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt))) - `(apropos-symbol ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue-nuanced :underline t))) - `(apropos-user-option-button ((,class :foreground ,green-alt-other :underline t))) - `(apropos-variable-button ((,class :foreground ,blue :underline t))) + `(apropos-symbol ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue-alt-other))) + `(apropos-user-option-button ((,class :inherit button :foreground ,green-alt-other))) + `(apropos-variable-button ((,class :inherit button :foreground ,blue))) ;;;;; apt-sources-list `(apt-sources-list-components ((,class :foreground ,cyan))) `(apt-sources-list-options ((,class :foreground ,yellow))) @@ -1310,6 +1639,24 @@ Also bind `class' to ((class color) (min-colors 89))." `(aw-leading-char-face ((,class :inherit bold :height 1.5 :background ,bg-main :foreground ,red-intense))) `(aw-minibuffer-leading-char-face ((,class :foreground ,magenta-active))) `(aw-mode-line-face ((,class :inherit bold))) +;;;;; awesome-tray + `(awesome-tray-module-awesome-tab-face ((,class :inherit bold :foreground ,red-alt-other))) + `(awesome-tray-module-battery-face ((,class :inherit bold :foreground ,cyan-alt-other))) + `(awesome-tray-module-buffer-name-face ((,class :inherit bold :foreground ,yellow-alt-other))) + `(awesome-tray-module-circe-face ((,class :inherit bold :foreground ,blue-alt))) + `(awesome-tray-module-date-face ((,class :inherit bold :foreground ,fg-dim))) + `(awesome-tray-module-evil-face ((,class :inherit bold :foreground ,green-alt))) + `(awesome-tray-module-git-face ((,class :inherit bold :foreground ,magenta))) + `(awesome-tray-module-last-command-face ((,class :inherit bold :foreground ,blue-alt-other))) + `(awesome-tray-module-location-face ((,class :inherit bold :foreground ,yellow))) + `(awesome-tray-module-mode-name-face ((,class :inherit bold :foreground ,green))) + `(awesome-tray-module-parent-dir-face ((,class :inherit bold :foreground ,cyan))) + `(awesome-tray-module-rvm-face ((,class :inherit bold :foreground ,magenta-alt-other))) +;;;;; binder + `(binder-sidebar-highlight ((,class :inherit modus-theme-subtle-cyan))) + `(binder-sidebar-marked ((,class :inherit modus-theme-mark-sel))) + `(binder-sidebar-missing ((,class :inherit modus-theme-subtle-red))) + `(binder-sidebar-tags ((,class :foreground ,cyan))) ;;;;; bm `(bm-face ((,class :inherit modus-theme-subtle-yellow ,@(and (>= emacs-major-version 27) '(:extend t))))) @@ -1351,26 +1698,27 @@ Also bind `class' to ((class color) (min-colors 89))." `(diary-time ((,class :foreground ,blue-alt))) `(holiday ((,class :foreground ,magenta-alt))) ;;;;; calfw - `(cfw:face-annotation ((,class :background ,bg-alt :foreground ,fg-alt))) - `(cfw:face-day-title ((,class :background ,bg-alt :foreground ,fg-main))) + `(cfw:face-annotation ((,class :foreground ,fg-special-warm))) + `(cfw:face-day-title ((,class :foreground ,fg-main))) `(cfw:face-default-content ((,class :foreground ,green-alt))) `(cfw:face-default-day ((,class :inherit (cfw:face-day-title bold)))) - `(cfw:face-disable ((,class :background ,bg-inactive :foreground ,fg-inactive))) - `(cfw:face-grid ((,class :foreground ,fg-inactive))) - `(cfw:face-header ((,class :inherit bold ::foreground ,fg-main))) - `(cfw:face-holiday ((,class :inherit bold :background ,bg-alt :foreground ,magenta))) + `(cfw:face-disable ((,class :foreground ,fg-unfocused))) + `(cfw:face-grid ((,class :foreground ,fg-window-divider-outer))) + `(cfw:face-header ((,class :inherit bold :foreground ,fg-main))) + `(cfw:face-holiday ((,class :foreground ,magenta-alt-other))) `(cfw:face-periods ((,class :foreground ,cyan-alt-other))) - `(cfw:face-saturday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt))) + `(cfw:face-saturday ((,class :inherit bold :foreground ,cyan-alt-other))) `(cfw:face-select ((,class :inherit modus-theme-intense-blue))) - `(cfw:face-sunday ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt-other))) + `(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other))) `(cfw:face-title ((,class :inherit ,modus-theme-variable-pitch - :foreground ,fg-special-warm - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)))) - `(cfw:face-today ((,class :inherit bold :foreground ,blue))) - `(cfw:face-today-title ((,class :inherit modus-theme-special-mild :box t))) - `(cfw:face-toolbar ((,class :background ,bg-active :foreground ,bg-active))) - `(cfw:face-toolbar-button-off ((,class :background ,bg-alt :foreground ,cyan))) - `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,bg-main :foreground ,blue-intense))) + :foreground ,fg-special-cold + ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-5)))) + `(cfw:face-today ((,class :background ,bg-inactive))) + `(cfw:face-today-title ((,class :background ,bg-active))) + `(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt))) + `(cfw:face-toolbar-button-off ((,class :foreground ,fg-alt))) + `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,blue-nuanced-bg + :foreground ,blue-alt))) ;;;;; centaur-tabs `(centaur-tabs-active-bar-face ((,class :background ,fg-tab-active))) `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground ,red-active :underline t))) @@ -1392,8 +1740,8 @@ Also bind `class' to ((class color) (min-colors 89))." `(change-log-function ((,class :foreground ,green-alt-other))) `(change-log-list ((,class :foreground ,magenta-alt-other))) `(change-log-name ((,class :foreground ,cyan))) - `(log-edit-header ((,class :inherit bold :foreground ,green-alt-other))) - `(log-edit-summary ((,class :foreground ,magenta-alt-other))) + `(log-edit-header ((,class :foreground ,fg-special-warm))) + `(log-edit-summary ((,class :inherit bold :foreground ,cyan))) `(log-edit-unknown-header ((,class :foreground ,fg-alt))) `(log-view-file ((,class :inherit bold :foreground ,fg-special-cold))) `(log-view-message ((,class :foreground ,fg-alt))) @@ -1437,7 +1785,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue))) `(circe-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other))) `(circe-server-face ((,class :foreground ,fg-unfocused))) - `(lui-button-face ((,class :foreground ,blue :underline t))) + `(lui-button-face ((,class :inherit button :foreground ,blue))) `(lui-highlight-face ((,class :foreground ,magenta-alt))) `(lui-time-stamp-face ((,class :foreground ,blue-nuanced))) ;;;;; color-rg @@ -1490,12 +1838,12 @@ Also bind `class' to ((class color) (min-colors 89))." ;;;;; completions `(completions-annotations ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) `(completions-common-part ((,class ,@(modus-vivendi-theme-standard-completions - cyan-alt-other cyan-nuanced-bg - yellow-refine-bg yellow-refine-fg)))) + blue-alt blue-nuanced-bg + cyan-refine-bg cyan-refine-fg)))) `(completions-first-difference ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions - blue-alt-other blue-nuanced-bg - cyan-subtle-bg fg-dim)))) + magenta-alt blue-nuanced-bg + magenta-intense-bg fg-main)))) ;;;;; counsel `(counsel-active-mode ((,class :foreground ,magenta-alt-other))) `(counsel-application-name ((,class :foreground ,red-alt-other))) @@ -1531,6 +1879,10 @@ Also bind `class' to ((class color) (min-colors 89))." `(cov-light-face ((,class :foreground ,blue-intense))) `(cov-med-face ((,class :foreground ,yellow-intense))) `(cov-none-face ((,class :foreground ,cyan-intense))) +;;;;; cperl-mode + `(cperl-nonoverridable-face ((,class :foreground ,yellow-alt-other))) + `(cperl-array-face ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt))) + `(cperl-hash-face ((,class :inherit bold :background ,bg-alt :foreground ,red-alt :slant ,modus-theme-slant))) ;;;;; csv-mode `(csv-separator-face ((,class :background ,bg-special-cold :foreground ,fg-main))) ;;;;; ctrlf @@ -1609,7 +1961,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(deft-title-face ((,class :inherit bold :foreground ,fg-main))) ;;;;; dictionary `(dictionary-button-face ((,class :inherit bold :foreground ,fg-special-cold))) - `(dictionary-reference-face ((,class :foreground ,blue-alt-other :underline t))) + `(dictionary-reference-face ((,class :inherit button :foreground ,blue-alt-other))) `(dictionary-word-definition-face ((,class :foreground ,fg-main))) `(dictionary-word-entry-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) ;;;;; diff-hl @@ -1623,47 +1975,54 @@ Also bind `class' to ((class color) (min-colors 89))." `(diff-hl-insert ((,class :inherit modus-theme-fringe-green))) `(diff-hl-reverted-hunk-highlight ((,class :inherit (modus-theme-active-magenta bold)))) ;;;;; diff-mode - `(diff-added ((,class ,@(modus-vivendi-theme-diffs - bg-main green - bg-diff-focus-added fg-diff-focus-added)))) - `(diff-changed ((,class ,@(modus-vivendi-theme-diffs - bg-main yellow - bg-diff-focus-changed fg-diff-focus-changed)))) + `(diff-added ((,class :inherit modus-theme-diff-added))) + `(diff-changed ((,class :inherit modus-theme-diff-changed))) `(diff-context ((,class :foreground ,fg-unfocused))) `(diff-file-header ((,class :inherit bold :foreground ,blue))) `(diff-function ((,class :foreground ,fg-special-cold))) `(diff-header ((,class :foreground ,blue-nuanced))) - `(diff-hunk-header ((,class ,@(modus-vivendi-theme-diffs - bg-alt blue-alt - bg-diff-heading fg-diff-heading)))) + `(diff-hunk-header ((,class :inherit modus-theme-diff-heading))) `(diff-index ((,class :inherit bold :foreground ,blue-alt))) `(diff-indicator-added ((,class :inherit diff-added))) `(diff-indicator-changed ((,class :inherit diff-changed))) `(diff-indicator-removed ((,class :inherit diff-removed))) `(diff-nonexistent ((,class :inherit (modus-theme-neutral bold)))) - `(diff-refine-added ((,class ,@(modus-vivendi-theme-diffs - bg-diff-added fg-diff-added - bg-diff-refine-added fg-diff-refine-added)))) - `(diff-refine-changed ((,class ,@(modus-vivendi-theme-diffs - bg-diff-changed fg-diff-changed - bg-diff-refine-changed fg-diff-refine-changed)))) - `(diff-refine-removed ((,class ,@(modus-vivendi-theme-diffs - bg-diff-removed fg-diff-removed - bg-diff-refine-removed fg-diff-refine-removed)))) - `(diff-removed ((,class ,@(modus-vivendi-theme-diffs - bg-main red - bg-diff-focus-removed fg-diff-focus-removed)))) + `(diff-refine-added ((,class :inherit modus-theme-diff-refine-added))) + `(diff-refine-changed ((,class :inherit modus-theme-diff-refine-changed))) + `(diff-refine-removed ((,class :inherit modus-theme-diff-refine-removed))) + `(diff-removed ((,class :inherit modus-theme-diff-removed))) ;;;;; dim-autoload `(dim-autoload-cookie-line ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) +;;;;; dir-treeview + `(dir-treeview-archive-face ((,class :foreground ,fg-special-warm))) + `(dir-treeview-archive-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,yellow))) + `(dir-treeview-audio-face ((,class :foreground ,magenta))) + `(dir-treeview-audio-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt))) + `(dir-treeview-control-face ((,class :foreground ,fg-alt))) + `(dir-treeview-control-mouse-face ((,class :inherit highlight))) + `(dir-treeview-default-icon-face ((,class :inherit bold :family "Font Awesome" :foreground ,fg-alt))) + `(dir-treeview-default-filename-face ((,class :foreground ,fg-main))) + `(dir-treeview-directory-face ((,class :foreground ,blue))) + `(dir-treeview-directory-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,blue-alt))) + `(dir-treeview-executable-face ((,class :foreground ,red-alt))) + `(dir-treeview-executable-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,red-alt-other))) + `(dir-treeview-image-face ((,class :foreground ,green-alt-other))) + `(dir-treeview-image-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,green-alt))) + `(dir-treeview-indent-face ((,class :foreground ,fg-alt))) + `(dir-treeview-label-mouse-face ((,class :inherit highlight))) + `(dir-treeview-start-dir-face ((,class :inherit modus-theme-pseudo-header))) + `(dir-treeview-symlink-face ((,class :inherit button :foreground ,cyan))) + `(dir-treeview-video-face ((,class :foreground ,magenta-alt-other))) + `(dir-treeview-video-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt-other))) ;;;;; dired `(dired-directory ((,class :foreground ,blue))) `(dired-flagged ((,class :inherit modus-theme-mark-del))) - `(dired-header ((,class :inherit modus-theme-header))) + `(dired-header ((,class :inherit modus-theme-pseudo-header))) `(dired-ignored ((,class :foreground ,fg-alt))) `(dired-mark ((,class :inherit modus-theme-mark-symbol))) `(dired-marked ((,class :inherit modus-theme-mark-sel))) `(dired-perm-write ((,class :foreground ,fg-special-warm))) - `(dired-symlink ((,class :foreground ,cyan-alt :underline t))) + `(dired-symlink ((,class :inherit button :foreground ,cyan-alt))) `(dired-warning ((,class :inherit bold :foreground ,yellow))) ;;;;; dired-async `(dired-async-failures ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-active))) @@ -1688,43 +2047,44 @@ Also bind `class' to ((class color) (min-colors 89))." `(dired-subtree-depth-6-face ((,class :background nil))) ;;;;; diredfl `(diredfl-autofile-name ((,class :inherit modus-theme-special-cold))) - `(diredfl-compressed-file-name ((,class :foreground ,green-alt-other))) - `(diredfl-compressed-file-suffix ((,class :foreground ,green-alt))) - `(diredfl-date-time ((,class :foreground ,fg-special-cold))) + `(diredfl-compressed-file-name ((,class :foreground ,fg-special-warm))) + `(diredfl-compressed-file-suffix ((,class :foreground ,red-alt))) + `(diredfl-date-time ((,class :foreground ,cyan-alt-other))) `(diredfl-deletion ((,class :inherit modus-theme-mark-del))) `(diredfl-deletion-file-name ((,class :inherit modus-theme-mark-del))) - `(diredfl-dir-heading ((,class :inherit modus-theme-header))) + `(diredfl-dir-heading ((,class :inherit modus-theme-pseudo-header))) `(diredfl-dir-name ((,class :inherit dired-directory))) - `(diredfl-dir-priv ((,class :foreground ,blue))) - `(diredfl-exec-priv ((,class :foreground ,red-alt-other))) - `(diredfl-executable-tag ((,class :foreground ,red-alt))) + `(diredfl-dir-priv ((,class :foreground ,blue-alt))) + `(diredfl-exec-priv ((,class :foreground ,magenta))) + `(diredfl-executable-tag ((,class :foreground ,magenta-alt))) `(diredfl-file-name ((,class :foreground ,fg-main))) - `(diredfl-file-suffix ((,class :foreground ,fg-special-warm))) + `(diredfl-file-suffix ((,class :foreground ,cyan))) `(diredfl-flag-mark ((,class :inherit modus-theme-mark-sel))) `(diredfl-flag-mark-line ((,class :inherit modus-theme-mark-sel))) - `(diredfl-ignored-file-name ((,class :foreground ,fg-inactive))) + `(diredfl-ignored-file-name ((,class :foreground ,fg-alt))) `(diredfl-link-priv ((,class :foreground ,blue-alt-other))) - `(diredfl-no-priv ((,class :foreground ,fg-inactive))) - `(diredfl-number ((,class :foreground ,cyan))) + `(diredfl-no-priv ((,class :foreground ,fg-alt))) + `(diredfl-number ((,class :foreground ,cyan-alt))) `(diredfl-other-priv ((,class :foreground ,yellow))) - `(diredfl-rare-priv ((,class :foreground ,magenta-alt-other))) - `(diredfl-read-priv ((,class :foreground ,magenta))) - `(diredfl-symlink ((,class :foreground ,cyan-alt :underline t))) + `(diredfl-rare-priv ((,class :foreground ,red-alt))) + `(diredfl-read-priv ((,class :foreground ,fg-main))) + `(diredfl-symlink ((,class :inherit dired-symlink))) `(diredfl-tagged-autofile-name ((,class :inherit modus-theme-refine-magenta))) - `(diredfl-write-priv ((,class :foreground ,cyan-alt-other))) + `(diredfl-write-priv ((,class :foreground ,cyan))) ;;;;; disk-usage `(disk-usage-children ((,class :foreground ,yellow))) `(disk-usage-inaccessible ((,class :inherit bold :foreground ,red))) `(disk-usage-percent ((,class :foreground ,green))) `(disk-usage-size ((,class :foreground ,cyan))) - `(disk-usage-symlink ((,class :foreground ,blue :underline t))) + `(disk-usage-symlink ((,class :inherit button :foreground ,blue))) `(disk-usage-symlink-directory ((,class :inherit bold :foreground ,blue-alt))) ;;;;; doom-modeline `(doom-modeline-bar ((,class :inherit modus-theme-active-blue))) `(doom-modeline-bar-inactive ((,class :background ,fg-inactive :foreground ,bg-main))) `(doom-modeline-battery-charging ((,class :foreground ,green-active))) `(doom-modeline-battery-critical ((,class :inherit bold :foreground ,red-active))) - `(doom-modeline-battery-error ((,class :inherit modus-theme-active-red))) + `(doom-modeline-battery-error ((,class :inherit bold :box (:line-width -2) + :foreground ,red-active))) `(doom-modeline-battery-full ((,class :foreground ,blue-active))) `(doom-modeline-battery-normal ((,class :foreground ,fg-active))) `(doom-modeline-battery-warning ((,class :inherit bold :foreground ,yellow-active))) @@ -1781,18 +2141,24 @@ Also bind `class' to ((class color) (min-colors 89))." `(ebdb-role-defunct ((,class :foreground ,fg-alt))) `(eieio-custom-slot-tag-face ((,class :foreground ,red-alt))) ;;;;; ediff - `(ediff-current-diff-A ((,class ,@(modus-vivendi-theme-diffs - bg-alt red - bg-diff-removed fg-diff-removed)))) - `(ediff-current-diff-Ancestor ((,class ,@(modus-vivendi-theme-diffs - bg-alt fg-special-cold - bg-special-cold fg-special-cold)))) - `(ediff-current-diff-B ((,class ,@(modus-vivendi-theme-diffs - bg-alt green - bg-diff-added fg-diff-added)))) - `(ediff-current-diff-C ((,class ,@(modus-vivendi-theme-diffs - bg-alt yellow - bg-diff-changed fg-diff-changed)))) + ;; NOTE: here we break from the pattern of inheriting from the + ;; modus-theme-diff-* faces. + `(ediff-current-diff-A ((,class ,@(modus-vivendi-theme-diff + bg-dim red + bg-diff-removed fg-diff-removed + red-nuanced-bg red-faint)))) + `(ediff-current-diff-Ancestor ((,class ,@(modus-vivendi-theme-diff + bg-dim fg-special-cold + bg-special-cold fg-special-cold + blue-nuanced-bg blue)))) + `(ediff-current-diff-B ((,class ,@(modus-vivendi-theme-diff + bg-dim green + bg-diff-added fg-diff-added + green-nuanced-bg green-faint)))) + `(ediff-current-diff-C ((,class ,@(modus-vivendi-theme-diff + bg-dim yellow + bg-diff-changed fg-diff-changed + yellow-nuanced-bg yellow-faint)))) `(ediff-even-diff-A ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1))) `(ediff-even-diff-Ancestor ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-1))) `(ediff-even-diff-B ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1))) @@ -1812,6 +2178,9 @@ Also bind `class' to ((class color) (min-colors 89))." `(el-search-match ((,class :inherit modus-theme-intense-green))) `(el-search-other-match ((,class :inherit modus-theme-special-mild))) `(el-search-occur-match ((,class :inherit modus-theme-special-calm))) +;;;;; eldoc + ;; NOTE: see https://github.com/purcell/package-lint/issues/187 + (list 'eldoc-highlight-function-argument `((,class :inherit bold :foreground ,blue-alt-other))) ;;;;; eldoc-box `(eldoc-box-body ((,class :background ,bg-alt :foreground ,fg-main))) `(eldoc-box-border ((,class :background ,fg-alt))) @@ -1821,14 +2190,14 @@ Also bind `class' to ((class color) (min-colors 89))." `(elfeed-log-error-level-face ((,class :foreground ,red))) `(elfeed-log-info-level-face ((,class :foreground ,green))) `(elfeed-log-warn-level-face ((,class :foreground ,yellow))) - `(elfeed-search-date-face ((,class :foreground ,cyan))) - `(elfeed-search-feed-face ((,class :foreground ,blue))) - `(elfeed-search-filter-face ((,class :foreground ,magenta-active))) - `(elfeed-search-last-update-face ((,class :foreground ,green-active))) - `(elfeed-search-tag-face ((,class :foreground ,cyan-alt-other))) - `(elfeed-search-title-face ((,class :foreground ,fg-main))) - `(elfeed-search-unread-count-face ((,class :foreground ,blue-active))) - `(elfeed-search-unread-title-face ((,class :inherit bold))) + `(elfeed-search-date-face ((,class :foreground ,blue-nuanced))) + `(elfeed-search-feed-face ((,class :foreground ,cyan))) + `(elfeed-search-filter-face ((,class :inherit bold :foreground ,magenta-active))) + `(elfeed-search-last-update-face ((,class :foreground ,cyan-active))) + `(elfeed-search-tag-face ((,class :foreground ,blue-nuanced))) + `(elfeed-search-title-face ((,class :foreground ,fg-dim))) + `(elfeed-search-unread-count-face ((,class :foreground ,green-active))) + `(elfeed-search-unread-title-face ((,class :inherit bold :foreground ,fg-main))) ;;;;; elfeed-score `(elfeed-score-date-face ((,class :foreground ,blue))) `(elfeed-score-debug-level-face ((,class :foreground ,magenta-alt-other))) @@ -1888,6 +2257,38 @@ Also bind `class' to ((class color) (min-colors 89))." `(erc-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other))) `(erc-timestamp-face ((,class :foreground ,blue-nuanced))) `(erc-underline-face ((,class :underline t))) + `(bg:erc-color-face0 ((,class :background "white"))) + `(bg:erc-color-face1 ((,class :background "black"))) + `(bg:erc-color-face10 ((,class :background ,cyan-subtle-bg))) + `(bg:erc-color-face11 ((,class :background ,cyan-intense-bg))) + `(bg:erc-color-face12 ((,class :background ,blue-subtle-bg))) + `(bg:erc-color-face13 ((,class :background ,magenta-subtle-bg))) + `(bg:erc-color-face14 ((,class :background "gray60"))) + `(bg:erc-color-face15 ((,class :background "gray80"))) + `(bg:erc-color-face2 ((,class :background ,blue-intense-bg))) + `(bg:erc-color-face3 ((,class :background ,green-intense-bg))) + `(bg:erc-color-face4 ((,class :background ,red-subtle-bg))) + `(bg:erc-color-face5 ((,class :background ,red-intense-bg))) + `(bg:erc-color-face6 ((,class :background ,magenta-refine-bg))) + `(bg:erc-color-face7 ((,class :background ,yellow-subtle-bg))) + `(bg:erc-color-face8 ((,class :background ,yellow-refine-bg))) + `(bg:erc-color-face9 ((,class :background ,green-subtle-bg))) + `(fg:erc-color-face0 ((,class :foreground "white"))) + `(fg:erc-color-face1 ((,class :foreground "black"))) + `(fg:erc-color-face10 ((,class :foreground ,cyan))) + `(fg:erc-color-face11 ((,class :foreground ,cyan-alt-other))) + `(fg:erc-color-face12 ((,class :foreground ,blue))) + `(fg:erc-color-face13 ((,class :foreground ,magenta-alt))) + `(fg:erc-color-face14 ((,class :foreground "gray60"))) + `(fg:erc-color-face15 ((,class :foreground "gray80"))) + `(fg:erc-color-face2 ((,class :foreground ,blue-alt-other))) + `(fg:erc-color-face3 ((,class :foreground ,green))) + `(fg:erc-color-face4 ((,class :foreground ,red))) + `(fg:erc-color-face5 ((,class :foreground ,red-alt))) + `(fg:erc-color-face6 ((,class :foreground ,magenta-alt-other))) + `(fg:erc-color-face7 ((,class :foreground ,yellow-alt-other))) + `(fg:erc-color-face8 ((,class :foreground ,yellow-alt))) + `(fg:erc-color-face9 ((,class :foreground ,green-alt-other))) ;;;;; eros `(eros-result-overlay-face ((,class :box (:line-width -1 :color ,blue) :background ,bg-dim :foreground ,fg-dim))) @@ -1904,14 +2305,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(eshell-ls-product ((,class :foreground ,fg-special-warm))) `(eshell-ls-readonly ((,class :foreground ,fg-special-cold))) `(eshell-ls-special ((,class :inherit bold :foreground ,magenta))) - `(eshell-ls-symlink ((,class :foreground ,cyan :underline t))) + `(eshell-ls-symlink ((,class :inherit button :foreground ,cyan))) `(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground ,fg-inactive))) `(eshell-prompt ((,class ,@(modus-vivendi-theme-bold-weight) - ,@(modus-vivendi-theme-prompt green-alt-other - green-nuanced-bg - green-alt - green-refine-bg - fg-main)))) + ,@(modus-vivendi-theme-prompt + green-alt-other + green-nuanced-bg green-alt + green-refine-bg fg-main)))) ;;;;; eshell-fringe-status `(eshell-fringe-status-failure ((,class :foreground ,red))) `(eshell-fringe-status-success ((,class :foreground ,green))) @@ -1939,6 +2339,15 @@ Also bind `class' to ((class color) (min-colors 89))." `(epe-remote-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) `(epe-status-face ((,class :foreground ,magenta-alt-other))) `(epe-venv-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) +;;;;; eshell-syntax-highlighting + `(eshell-syntax-highlighting-alias-face ((,class :foreground ,cyan))) + `(eshell-syntax-highlighting-comment-face ((,class :foreground ,fg-alt))) + `(eshell-syntax-highlighting-directory-face ((,class :foreground ,blue))) + `(eshell-syntax-highlighting-envvar-face ((,class :foreground ,magenta-alt))) + `(eshell-syntax-highlighting-invalid-face ((,class :foreground ,red))) + `(eshell-syntax-highlighting-lisp-function-face ((,class :foreground ,magenta))) + `(eshell-syntax-highlighting-shell-command-face ((,class :foreground ,cyan-alt-other))) + `(eshell-syntax-highlighting-string-face ((,class :foreground ,blue-alt))) ;;;;; evil-mode `(evil-ex-commands ((,class :foreground ,magenta-alt-other))) `(evil-ex-info ((,class :foreground ,cyan-alt-other))) @@ -2006,6 +2415,11 @@ Also bind `class' to ((class color) (min-colors 89))." ((,(append '((supports :underline (:style wave))) class) :underline (:color ,fg-lang-warning :style wave)) (,class :foreground ,fg-lang-warning :underline t))) +;;;;; flycheck-color-mode-line + `(flycheck-color-mode-line-error-face ((,class :inherit flycheck-fringe-error))) + `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-info))) + `(flycheck-color-mode-line-running-face ((,class :foreground ,fg-inactive :slant italic))) + `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-warning))) ;;;;; flycheck-indicator `(flycheck-indicator-disabled ((,class :foreground ,fg-inactive :slant ,modus-theme-slant))) `(flycheck-indicator-error ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-active))) @@ -2049,7 +2463,7 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-subtle-magenta 'modus-theme-intense-magenta 'modus-theme-nuanced-magenta - magenta-alt-other + magenta-alt 'bold)))) ;;;;; freeze-it `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm))) @@ -2157,13 +2571,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(git-commit-comment-branch-remote ((,class :foreground ,magenta-alt :slant ,modus-theme-slant))) `(git-commit-comment-detached ((,class :foreground ,cyan-alt :slant ,modus-theme-slant))) `(git-commit-comment-file ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) - `(git-commit-comment-heading ((,class :inherit bold :foreground ,fg-alt :slant ,modus-theme-slant))) + `(git-commit-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant))) `(git-commit-keyword ((,class :foreground ,magenta))) - `(git-commit-known-pseudo-header ((,class :inherit bold :foreground ,fg-special-warm))) + `(git-commit-known-pseudo-header ((,class :foreground ,cyan-alt-other))) `(git-commit-nonempty-second-line ((,class :inherit modus-theme-refine-yellow))) `(git-commit-overlong-summary ((,class :inherit modus-theme-refine-yellow))) - `(git-commit-pseudo-header ((,class :inherit bold :foreground ,fg-alt))) - `(git-commit-summary ((,class :foreground ,magenta-alt-other))) + `(git-commit-pseudo-header ((,class :foreground ,blue))) + `(git-commit-summary ((,class :inherit bold :foreground ,cyan))) ;;;;; git-gutter `(git-gutter:added ((,class :inherit modus-theme-fringe-green))) `(git-gutter:deleted ((,class :inherit modus-theme-fringe-red))) @@ -2200,7 +2614,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(git-timemachine-minibuffer-detail-face ((,class :foreground ,red-alt))) ;;;;; git-walktree `(git-walktree-commit-face ((,class :foreground ,yellow))) - `(git-walktree-symlink-face ((,class :foreground ,cyan :underline t))) + `(git-walktree-symlink-face ((,class :inherit button :foreground ,cyan))) `(git-walktree-tree-face ((,class :foreground ,magenta))) ;;;;; gnus `(gnus-button ((,class :inherit button))) @@ -2239,9 +2653,9 @@ Also bind `class' to ((class color) (min-colors 89))." `(gnus-group-news-6-empty ((,class :foreground ,fg-alt))) `(gnus-group-news-low ((,class :inherit bold :foreground ,green-nuanced))) `(gnus-group-news-low-empty ((,class :foreground ,green-nuanced))) - `(gnus-header-content ((,class :foreground ,fg-special-calm))) - `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt :underline nil))) - `(gnus-header-name ((,class :foreground ,cyan-alt-other))) + `(gnus-header-content ((,class :foreground ,cyan))) + `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt-other :underline nil))) + `(gnus-header-name ((,class :foreground ,green))) `(gnus-header-newsgroups ((,class :inherit bold :foreground ,blue-alt))) `(gnus-header-subject ((,class :inherit bold :foreground ,magenta-alt-other))) `(gnus-server-agent ((,class :inherit bold :foreground ,cyan))) @@ -2260,12 +2674,12 @@ Also bind `class' to ((class color) (min-colors 89))." `(gnus-summary-high-undownloaded ((,class :inherit bold :foreground ,yellow))) `(gnus-summary-high-unread ((,class :inherit bold :foreground ,fg-main))) `(gnus-summary-low-ancient ((,class :foreground ,fg-alt :slant italic))) - `(gnus-summary-low-read ((,class :foreground ,fg-special-cold :slant italic))) + `(gnus-summary-low-read ((,class :foreground ,fg-alt :slant italic))) `(gnus-summary-low-ticked ((,class :foreground ,red-refine-fg :slant italic))) `(gnus-summary-low-undownloaded ((,class :foreground ,yellow-refine-fg :slant italic))) `(gnus-summary-low-unread ((,class :inherit bold :foreground ,fg-special-cold))) `(gnus-summary-normal-ancient ((,class :foreground ,fg-special-calm))) - `(gnus-summary-normal-read ((,class :foreground ,fg-special-cold))) + `(gnus-summary-normal-read ((,class :foreground ,fg-alt))) `(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other))) `(gnus-summary-normal-undownloaded ((,class :foreground ,yellow))) `(gnus-summary-normal-unread ((,class :foreground ,fg-main))) @@ -2309,11 +2723,11 @@ Also bind `class' to ((class color) (min-colors 89))." `(helm-ff-directory ((,class :inherit helm-buffer-directory))) `(helm-ff-dirs ((,class :inherit bold :foreground ,blue-alt-other))) `(helm-ff-dotted-directory ((,class :inherit bold :background ,bg-alt :foreground ,fg-alt))) - `(helm-ff-dotted-symlink-directory ((,class :inherit helm-ff-dotted-directory :underline t))) + `(helm-ff-dotted-symlink-directory ((,class :inherit (button helm-ff-dotted-directory)))) `(helm-ff-executable ((,class :foreground ,magenta-alt))) `(helm-ff-file ((,class :foreground ,fg-main))) `(helm-ff-file-extension ((,class :foreground ,fg-special-warm))) - `(helm-ff-invalid-symlink ((,class :foreground ,red :underline t))) + `(helm-ff-invalid-symlink ((,class :inherit button :foreground ,red))) `(helm-ff-pipe ((,class ,@(modus-vivendi-theme-extra-completions 'modus-theme-refine-magenta 'modus-theme-subtle-magenta @@ -2330,7 +2744,7 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-refine-red 'modus-theme-nuanced-yellow red-alt)))) - `(helm-ff-symlink ((,class :foreground ,cyan :underline t))) + `(helm-ff-symlink ((,class :inherit button :foreground ,cyan))) `(helm-ff-truename ((,class :foreground ,blue-alt-other))) `(helm-grep-cmd-line ((,class :foreground ,yellow-alt-other))) `(helm-grep-file ((,class :inherit bold :foreground ,fg-special-cold))) @@ -2366,7 +2780,7 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-nuanced-cyan cyan-alt-other)))) `(helm-minibuffer-prompt ((,class :inherit minibuffer-prompt))) - `(helm-moccur-buffer ((,class :foreground ,cyan-alt-other :underline t))) + `(helm-moccur-buffer ((,class :inherit button :foreground ,cyan-alt-other))) `(helm-mode-prefix ((,class ,@(modus-vivendi-theme-extra-completions 'modus-theme-subtle-magenta 'modus-theme-intense-magenta @@ -2416,8 +2830,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(helm-xref-file-name ((,class :inherit bold :foreground ,fg-special-cold))) `(helm-xref-file-name ((,class :foreground ,fg-special-warm))) ;;;;; helpful - `(helpful-heading ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)))) + `(helpful-heading ((,class :inherit modus-theme-heading-1))) ;;;;; highlight region or ad-hoc regexp `(hi-black-b ((,class :background ,fg-main :foreground ,bg-main))) `(hi-blue ((,class :background ,bg-alt :foreground ,blue :underline t))) @@ -2487,23 +2900,23 @@ Also bind `class' to ((class color) (min-colors 89))." ;;;;; icomplete `(icomplete-first-match ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions - magenta magenta-nuanced-bg - magenta-intense-bg fg-main)))) + magenta bg-alt + bg-active fg-main)))) ;;;;; icomplete-vertical `(icomplete-vertical-separator ((,class :foreground ,fg-alt))) ;;;;; ido-mode `(ido-first-match ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions - magenta magenta-nuanced-bg - magenta-subtle-bg fg-main)))) + magenta bg-alt + bg-active fg-main)))) `(ido-incomplete-regexp ((,class :inherit error))) `(ido-indicator ((,class :inherit modus-theme-subtle-yellow))) `(ido-only-match ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions - magenta-intense red-nuanced-bg - magenta-intense-bg fg-main)))) - `(ido-subdir ((,class :foreground ,blue-alt-other))) - `(ido-virtual ((,class :foreground ,yellow-alt-other))) + green green-nuanced-bg + green-intense-bg fg-main)))) + `(ido-subdir ((,class :foreground ,blue))) + `(ido-virtual ((,class :foreground ,fg-special-warm))) ;;;;; iedit `(iedit-occurrence ((,class :inherit modus-theme-refine-blue))) `(iedit-read-only-occurrence ((,class :inherit modus-theme-intense-yellow))) @@ -2521,29 +2934,25 @@ Also bind `class' to ((class color) (min-colors 89))." `(imenu-list-entry-subalist-face-3 ((,class :inherit bold :foreground ,red-alt-other :underline t))) ;;;;; indium `(indium-breakpoint-face ((,class :foreground ,red-active))) - `(indium-frame-url-face ((,class :foreground ,fg-alt :underline t))) + `(indium-frame-url-face ((,class :inherit button :foreground ,fg-alt))) `(indium-keyword-face ((,class :foreground ,magenta-alt-other))) `(indium-litable-face ((,class :foreground ,fg-special-warm :slant ,modus-theme-slant))) `(indium-repl-error-face ((,class :inherit bold :foreground ,red))) `(indium-repl-prompt-face ((,class :foreground ,cyan-alt-other))) `(indium-repl-stdout-face ((,class :foreground ,fg-main))) ;;;;; info - `(Info-quoted ((,class :foreground ,magenta))) ; the capitalisation is canonical + `(Info-quoted ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,magenta))) ; the capitalisation is canonical `(info-header-node ((,class :inherit bold :foreground ,fg-alt))) `(info-header-xref ((,class :foreground ,blue-active))) `(info-index-match ((,class :inherit match))) - `(info-menu-header ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2)))) - `(info-menu-star ((,class :foreground ,fg-main))) + `(info-menu-header ((,class :inherit modus-theme-heading-3))) + `(info-menu-star ((,class :foreground ,red))) `(info-node ((,class :inherit bold))) - `(info-title-1 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)))) - `(info-title-2 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-warm - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3)))) - `(info-title-3 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2)))) - `(info-title-4 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-mild - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1)))) + `(info-title-1 ((,class :inherit modus-theme-heading-1))) + `(info-title-2 ((,class :inherit modus-theme-heading-2))) + `(info-title-3 ((,class :inherit modus-theme-heading-3))) + `(info-title-4 ((,class :inherit modus-theme-heading-4))) ;;;;; info-colors `(info-colors-lisp-code-block ((,class :inherit fixed-pitch))) `(info-colors-ref-item-command ((,class :foreground ,magenta))) @@ -2689,13 +3098,14 @@ Also bind `class' to ((class color) (min-colors 89))." `(kaocha-runner-warning-face ((,class :foreground ,yellow))) ;;;;; keycast `(keycast-command ((,class :inherit bold :foreground ,blue-active))) - `(keycast-key ((,class :box ,(modus-vivendi-theme-modeline-box blue-alt blue-active t -3) - ,@(modus-vivendi-theme-modeline-props - blue-active bg-main - blue-active bg-active)))) + `(keycast-key ((,class ,@(modus-vivendi-theme-mode-line-attrs + bg-main blue-active + bg-main blue-active + blue-active blue-intense + 'alt-style -3)))) ;;;;; line numbers (display-line-numbers-mode and global variant) - `(line-number ((,class :background ,bg-dim :foreground ,fg-alt))) - `(line-number-current-line ((,class :inherit bold :background ,bg-active :foreground ,fg-active))) + `(line-number ((,class :inherit default :background ,bg-dim :foreground ,fg-alt))) + `(line-number-current-line ((,class :inherit default :background ,bg-active :foreground ,fg-main))) ;;;;; lsp-mode `(lsp-face-highlight-read ((,class :inherit modus-theme-subtle-blue :underline t))) `(lsp-face-highlight-textual ((,class :inherit modus-theme-subtle-blue))) @@ -2725,7 +3135,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(lsp-lens-mouse-face ((,class :height 0.8 :foreground ,blue-alt-other :underline t))) `(lsp-ui-doc-background ((,class :background ,bg-alt))) `(lsp-ui-doc-header ((,class :background ,bg-header :foreground ,fg-header))) - `(lsp-ui-doc-url ((,class :foreground ,blue-alt-other :underline t))) + `(lsp-ui-doc-url ((,class :inherit button :foreground ,blue-alt-other))) `(lsp-ui-peek-filename ((,class :foreground ,fg-special-warm))) `(lsp-ui-peek-footer ((,class :background ,bg-header :foreground ,fg-header))) `(lsp-ui-peek-header ((,class :background ,bg-header :foreground ,fg-header))) @@ -2757,37 +3167,43 @@ Also bind `class' to ((class color) (min-colors 89))." `(magit-branch-upstream ((,class :slant italic))) `(magit-cherry-equivalent ((,class :background ,bg-main :foreground ,magenta-intense))) `(magit-cherry-unmatched ((,class :background ,bg-main :foreground ,cyan-intense))) - `(magit-diff-added ((,class ,@(modus-vivendi-theme-diffs + ;; NOTE: here we break from the pattern of inheriting from the + ;; modus-theme-diff-* faces, though only for the standard actions, + ;; not the highlighted ones. This is because Magit's interaction + ;; model relies on highlighting the current diff hunk. + `(magit-diff-added ((,class ,@(modus-vivendi-theme-diff bg-main green - bg-diff-added fg-diff-added)))) - `(magit-diff-added-highlight ((,class ,@(modus-vivendi-theme-diffs - bg-dim green - bg-diff-focus-added fg-diff-focus-added)))) - `(magit-diff-base ((,class ,@(modus-vivendi-theme-diffs + bg-diff-added fg-diff-added + green-nuanced-bg fg-diff-added)))) + `(magit-diff-added-highlight ((,class :inherit modus-theme-diff-focus-added))) + `(magit-diff-base ((,class ,@(modus-vivendi-theme-diff bg-main yellow - bg-diff-changed fg-diff-changed)))) - `(magit-diff-base-highlight ((,class ,@(modus-vivendi-theme-diffs - bg-dim yellow - bg-diff-focus-changed fg-diff-focus-changed)))) + bg-diff-changed fg-diff-changed + yellow-nuanced-bg fg-diff-changed)))) + `(magit-diff-base-highlight ((,class :inherit modus-theme-diff-focus-changed))) `(magit-diff-context ((,class :foreground ,fg-unfocused))) - `(magit-diff-context-highlight ((,class ,@(modus-vivendi-theme-diffs + `(magit-diff-context-highlight ((,class ,@(modus-vivendi-theme-diff bg-dim fg-dim - bg-inactive fg-inactive)))) + bg-inactive fg-inactive + bg-dim fg-alt)))) `(magit-diff-file-heading ((,class :inherit bold :foreground ,fg-special-cold))) `(magit-diff-file-heading-highlight ((,class :inherit (modus-theme-special-cold bold)))) - `(magit-diff-file-heading-selection ((,class :background ,bg-alt :foreground ,cyan))) - `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active :foreground ,fg-inactive))) - `(magit-diff-hunk-heading-highlight ((,class :inherit (modus-theme-diff-heading bold)))) - `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-intense-cyan))) + `(magit-diff-file-heading-selection ((,class :inherit modus-theme-refine-cyan))) + ;; NOTE: here we break from the pattern of inheriting from the + ;; modus-theme-diff-* faces. + `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active + :foreground ,fg-inactive))) + `(magit-diff-hunk-heading-highlight ((,class :inherit bold :background ,bg-diff-heading + :foreground ,fg-diff-heading))) + `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-refine-blue))) `(magit-diff-hunk-region ((,class :inherit bold))) `(magit-diff-lines-boundary ((,class :background ,fg-main))) `(magit-diff-lines-heading ((,class :inherit modus-theme-refine-magenta))) - `(magit-diff-removed ((,class ,@(modus-vivendi-theme-diffs + `(magit-diff-removed ((,class ,@(modus-vivendi-theme-diff bg-main red - bg-diff-removed fg-diff-removed)))) - `(magit-diff-removed-highlight ((,class ,@(modus-vivendi-theme-diffs - bg-dim red - bg-diff-focus-removed fg-diff-focus-removed)))) + bg-diff-removed fg-diff-removed + red-nuanced-bg fg-diff-removed)))) + `(magit-diff-removed-highlight ((,class :inherit modus-theme-diff-focus-removed))) `(magit-diffstat-added ((,class :foreground ,green))) `(magit-diffstat-removed ((,class :foreground ,red))) `(magit-dimmed ((,class :foreground ,fg-unfocused))) @@ -2846,26 +3262,40 @@ Also bind `class' to ((class color) (min-colors 89))." `(Man-reverse ((,class :inherit modus-theme-subtle-magenta))) `(Man-underline ((,class :foreground ,cyan :underline t))) ;;;;; markdown-mode - `(markdown-blockquote-face ((,class :foreground ,fg-special-warm :slant ,modus-theme-slant))) + `(markdown-blockquote-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) `(markdown-bold-face ((,class :inherit bold))) - `(markdown-code-face ((,class :inherit fixed-pitch))) + `(markdown-code-face ((,class ,@(modus-vivendi-theme-mixed-fonts)))) `(markdown-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt))) `(markdown-footnote-text-face ((,class :foreground ,fg-main :slant ,modus-theme-slant))) `(markdown-gfm-checkbox-face ((,class :foreground ,cyan-alt-other))) `(markdown-header-delimiter-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,fg-dim))) - `(markdown-header-face ((,class :inherit bold))) + `(markdown-header-face ((t nil))) + `(markdown-header-face-1 ((,class :inherit modus-theme-heading-1))) + `(markdown-header-face-2 ((,class :inherit modus-theme-heading-2))) + `(markdown-header-face-3 ((,class :inherit modus-theme-heading-3))) + `(markdown-header-face-4 ((,class :inherit modus-theme-heading-4))) + `(markdown-header-face-5 ((,class :inherit modus-theme-heading-5))) + `(markdown-header-face-6 ((,class :inherit modus-theme-heading-6))) `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm))) `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm))) - `(markdown-html-attr-name-face ((,class :inherit fixed-pitch :foreground ,cyan))) - `(markdown-html-attr-value-face ((,class :inherit fixed-pitch :foreground ,blue))) - `(markdown-html-entity-face ((,class :inherit fixed-pitch :foreground ,cyan))) - `(markdown-html-tag-delimiter-face ((,class :inherit fixed-pitch :foreground ,fg-special-mild))) - `(markdown-html-tag-name-face ((,class :inherit fixed-pitch :foreground ,magenta-alt))) - `(markdown-inline-code-face ((,class :inherit fixed-pitch :foreground ,magenta))) + `(markdown-html-attr-name-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,cyan))) + `(markdown-html-attr-value-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,blue))) + `(markdown-html-entity-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,cyan))) + `(markdown-html-tag-delimiter-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,fg-special-mild))) + `(markdown-html-tag-name-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,magenta-alt))) + `(markdown-inline-code-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,magenta))) `(markdown-italic-face ((,class :foreground ,fg-special-cold :slant italic))) - `(markdown-language-info-face ((,class :inherit fixed-pitch :foreground ,fg-special-cold))) - `(markdown-language-keyword-face ((,class :inherit fixed-pitch :foreground ,green-alt-other))) + `(markdown-language-info-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,fg-special-cold))) + `(markdown-language-keyword-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,green-alt-other))) `(markdown-line-break-face ((,class :inherit modus-theme-refine-cyan :underline t))) `(markdown-link-face ((,class :inherit link))) `(markdown-link-title-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) @@ -2877,12 +3307,14 @@ Also bind `class' to ((class color) (min-colors 89))." `(markdown-missing-link-face ((,class :inherit bold :foreground ,yellow))) `(markdown-plain-url-face ((,class :inherit markdown-link-face))) `(markdown-pre-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit fixed-pitch :background ,bg-dim + ,@(modus-vivendi-theme-mixed-fonts) + :background ,bg-dim :foreground ,fg-special-mild))) `(markdown-reference-face ((,class :inherit markdown-markup-face))) `(markdown-strike-through-face ((,class :strike-through t))) - `(markdown-table-face ((,class :inherit fixed-pitch :foreground ,fg-special-cold))) - `(markdown-url-face ((,class :foreground ,blue))) + `(markdown-table-face ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,fg-special-cold))) + `(markdown-url-face ((,class :foreground ,blue-alt))) ;;;;; markup-faces (`adoc-mode') `(markup-anchor-face ((,class :foreground ,fg-inactive))) `(markup-attribute-face ((,class :foreground ,fg-inactive :slant italic))) @@ -2896,7 +3328,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(markup-emphasis-face ((,class :foreground ,fg-special-cold :slant italic))) `(markup-error-face ((,class :inherit bold :foreground ,red))) `(markup-gen-face ((,class :foreground ,magenta-alt))) - `(markup-internal-reference-face ((,class :foreground ,fg-inactive :underline t))) + `(markup-internal-reference-face ((,class :inherit button :foreground ,fg-inactive))) `(markup-italic-face ((,class :foreground ,fg-special-cold :slant italic))) `(markup-list-face ((,class :inherit modus-theme-special-calm))) `(markup-meta-face ((,class :foreground ,fg-inactive))) @@ -2935,32 +3367,30 @@ Also bind `class' to ((class color) (min-colors 89))." `(message-cited-text-2 ((,class :foreground ,red-alt))) `(message-cited-text-3 ((,class :foreground ,green-alt))) `(message-cited-text-4 ((,class :foreground ,magenta-alt))) - `(message-header-cc ((,class :foreground ,blue-alt))) + `(message-header-cc ((,class :inherit bold :foreground ,cyan-alt))) `(message-header-name ((,class :foreground ,green-alt-other))) - `(message-header-newsgroups ((,class :inherit bold :foreground ,blue))) + `(message-header-newsgroups ((,class :inherit bold :foreground ,green-alt))) `(message-header-other ((,class :inherit bold :foreground ,cyan-alt-other))) `(message-header-subject ((,class :inherit bold :foreground ,magenta-alt-other))) - `(message-header-to ((,class :inherit bold :foreground ,magenta-alt))) - `(message-header-xheader ((,class :foreground ,blue-alt-other))) - `(message-mml ((,class :foreground ,green-alt))) - `(message-separator ((,class :background ,bg-active :foreground ,fg-special-warm))) + `(message-header-to ((,class :inherit bold :foreground ,blue))) + `(message-header-xheader ((,class :foreground ,cyan))) + `(message-mml ((,class :foreground ,fg-special-warm))) + `(message-separator ((,class :inherit modus-theme-intense-neutral))) ;;;;; minibuffer-line `(minibuffer-line ((,class :foreground ,fg-main))) ;;;;; minimap `(minimap-active-region-background ((,class :background ,bg-active))) `(minimap-current-line-face ((,class :background ,cyan-intense-bg :foreground ,fg-main))) ;;;;; modeline - `(mode-line ((,class :box ,(modus-vivendi-theme-modeline-box bg-active fg-alt t) - ,@(modus-vivendi-theme-modeline-props - bg-active fg-dim - bg-active fg-active)))) + `(mode-line ((,class ,@(modus-vivendi-theme-mode-line-attrs + fg-active bg-active fg-dim bg-active + fg-alt bg-active 'alt-style nil bg-main)))) `(mode-line-buffer-id ((,class :inherit bold))) `(mode-line-emphasis ((,class :inherit bold :foreground ,blue-active))) `(mode-line-highlight ((,class :inherit modus-theme-active-blue :box (:line-width -1 :style pressed-button)))) - `(mode-line-inactive ((,class :box ,(modus-vivendi-theme-modeline-box bg-active bg-region) - ,@(modus-vivendi-theme-modeline-props - bg-dim fg-inactive - bg-inactive fg-inactive)))) + `(mode-line-inactive ((,class ,@(modus-vivendi-theme-mode-line-attrs + fg-inactive bg-inactive fg-alt bg-dim + bg-region bg-active)))) ;;;;; mood-line `(mood-line-modified ((,class :foreground ,magenta-active))) `(mood-line-status-error ((,class :inherit bold :foreground ,red-active))) @@ -2969,6 +3399,9 @@ Also bind `class' to ((class color) (min-colors 89))." `(mood-line-status-success ((,class :foreground ,green-active))) `(mood-line-status-warning ((,class :inherit bold :foreground ,yellow-active))) `(mood-line-unimportant ((,class :foreground ,fg-inactive))) +;;;;; mpdel + `(mpdel-browser-directory-face ((,class :foreground ,blue))) + `(mpdel-playlist-current-song-face ((,class :inherit bold :foreground ,blue-alt-other))) ;;;;; mu4e `(mu4e-attach-number-face ((,class :inherit bold :foreground ,cyan-alt))) `(mu4e-cited-1-face ((,class :foreground ,blue-alt))) @@ -2979,7 +3412,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(mu4e-cited-6-face ((,class :foreground ,cyan-alt))) `(mu4e-cited-7-face ((,class :foreground ,magenta))) `(mu4e-compose-header-face ((,class :inherit mu4e-compose-separator-face))) - `(mu4e-compose-separator-face ((,class :background ,bg-active :foreground ,fg-special-warm))) + `(mu4e-compose-separator-face ((,class :inherit modus-theme-intense-neutral))) `(mu4e-contact-face ((,class :inherit bold :foreground ,cyan-alt-other))) `(mu4e-context-face ((,class :foreground ,blue-active))) `(mu4e-draft-face ((,class :foreground ,magenta-alt))) @@ -2998,7 +3431,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(mu4e-moved-face ((,class :foreground ,yellow :slant ,modus-theme-slant))) `(mu4e-ok-face ((,class :inherit bold :foreground ,green))) `(mu4e-region-code ((,class :inherit modus-theme-special-calm))) - `(mu4e-replied-face ((,class :foreground ,cyan-active))) + `(mu4e-replied-face ((,class :foreground ,blue-faint))) `(mu4e-special-header-value-face ((,class :inherit bold :foreground ,blue-alt-other))) `(mu4e-system-face ((,class :foreground ,fg-mark-del :slant ,modus-theme-slant))) `(mu4e-title-face ((,class :foreground ,fg-main))) @@ -3129,10 +3562,15 @@ Also bind `class' to ((class color) (min-colors 89))." `(nxml-ref ((,class ,@(modus-vivendi-theme-syntax-foreground green-alt-other green-alt-other-faint) ,@(modus-vivendi-theme-bold-weight)))) +;;;;; objed + `(objed-hl ((,class :background ,(if modus-vivendi-theme-intense-hl-line + bg-hl-alt-intense bg-hl-alt)))) + `(objed-mark ((,class :background ,bg-active))) + `(objed-mode-line ((,class :foreground ,cyan-active))) ;;;;; orderless `(orderless-match-face-0 ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions - blue-alt blue-nuanced-bg + blue-alt-other blue-nuanced-bg blue-refine-bg blue-refine-fg)))) `(orderless-match-face-1 ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions @@ -3140,70 +3578,62 @@ Also bind `class' to ((class color) (min-colors 89))." magenta-refine-bg magenta-refine-fg)))) `(orderless-match-face-2 ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions - green-alt-other green-nuanced-bg + green green-nuanced-bg green-refine-bg green-refine-fg)))) `(orderless-match-face-3 ((,class :inherit bold ,@(modus-vivendi-theme-standard-completions - yellow-alt-other yellow-nuanced-bg + yellow yellow-nuanced-bg yellow-refine-bg yellow-refine-fg)))) ;;;;; org `(org-agenda-calendar-event ((,class :foreground ,fg-main))) `(org-agenda-calendar-sexp ((,class :foreground ,cyan-alt))) - `(org-agenda-clocking ((,class :inherit modus-theme-special-cold))) + `(org-agenda-clocking ((,class :inherit modus-theme-special-cold + ,@(and (>= emacs-major-version 27) '(:extend t))))) `(org-agenda-column-dateline ((,class :background ,bg-alt))) - `(org-agenda-current-time ((,class :inherit modus-theme-subtle-cyan))) - `(org-agenda-date ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan-alt-other - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4) - ,@(modus-vivendi-theme-heading-block cyan-nuanced-bg cyan-nuanced)))) - `(org-agenda-date-today ((,class :inherit (bold ,modus-theme-variable-pitch) - :background ,cyan-intense-bg :foreground ,fg-main - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4)))) - `(org-agenda-date-weekend ((,class :inherit ,modus-theme-variable-pitch :foreground ,cyan - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4) - ,@(modus-vivendi-theme-heading-block blue-nuanced-bg cyan-nuanced)))) + `(org-agenda-current-time ((,class :inherit bold :foreground ,blue-alt-other))) + `(org-agenda-date ((,class :foreground ,cyan))) + `(org-agenda-date-today ((,class :inherit bold :foreground ,fg-main :underline t))) + `(org-agenda-date-weekend ((,class :foreground ,cyan-alt-other))) `(org-agenda-diary ((,class :foreground ,fg-main))) - `(org-agenda-dimmed-todo-face ((,class :inherit modus-theme-subtle-neutral))) - `(org-agenda-done ((,class ,@(modus-vivendi-theme-org-todo-block green-nuanced-bg green-nuanced green)))) + `(org-agenda-dimmed-todo-face ((,class :inherit bold :foreground ,fg-alt))) + `(org-agenda-done ((,class :foreground ,green-alt))) `(org-agenda-filter-category ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-filter-effort ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-filter-tags ((,class :inherit bold :foreground ,magenta-active))) `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim))) - `(org-agenda-structure ((,class :inherit ,modus-theme-variable-pitch - :foreground ,fg-special-mild - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3)))) + `(org-agenda-structure ((,class :foreground ,blue-alt))) `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt))) - `(org-block ((,class ,@(modus-vivendi-theme-org-block bg-dim) - :inherit fixed-pitch :foreground ,fg-main))) - `(org-block-begin-line ((,class ,@(modus-vivendi-theme-org-block-delim + `(org-block ((,class ,@(modus-vivendi-theme-mixed-fonts) + ,@(modus-vivendi-theme-org-block bg-dim) + :foreground ,fg-main))) + `(org-block-begin-line ((,class ,@(modus-vivendi-theme-mixed-fonts) + ,@(modus-vivendi-theme-org-block-delim bg-dim fg-special-cold - bg-alt fg-special-mild) - :inherit fixed-pitch))) + bg-alt fg-special-mild)))) `(org-block-end-line ((,class :inherit org-block-begin-line))) `(org-checkbox ((,class :box (:line-width 1 :color ,bg-active) :background ,bg-inactive :foreground ,fg-active))) - `(org-checkbox-statistics-done ((,class :foreground ,green - ,@(modus-vivendi-theme-heading-block - green-nuanced-bg green-nuanced)))) - `(org-checkbox-statistics-todo ((,class ,@(modus-vivendi-theme-heading-foreground red-alt red) - ,@(modus-vivendi-theme-heading-block - red-nuanced-bg red-nuanced)))) + `(org-checkbox-statistics-done ((,class :inherit org-done))) + `(org-checkbox-statistics-todo ((,class :inherit org-todo))) `(org-clock-overlay ((,class :inherit modus-theme-special-cold))) - `(org-code ((,class :inherit fixed-pitch :foreground ,magenta))) + `(org-code ((,class ,@(modus-vivendi-theme-mixed-fonts) :foreground ,magenta))) `(org-column ((,class :background ,bg-alt))) `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt))) - `(org-date ((,class :inherit fixed-pitch :foreground ,cyan-alt-other :underline t))) + `(org-date ((,class :inherit (button fixed-pitch) :foreground ,cyan-alt-other))) `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t))) - `(org-default ((,class :background ,bg-main :foreground ,fg-main))) `(org-document-info ((,class :foreground ,fg-special-cold))) - `(org-document-info-keyword ((,class :inherit fixed-pitch :foreground ,fg-alt))) + `(org-document-info-keyword ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,fg-alt))) `(org-document-title ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-5)))) - `(org-done ((,class ,@(modus-vivendi-theme-org-todo-block green-nuanced-bg green-nuanced green)))) - `(org-drawer ((,class :foreground ,cyan-alt))) + `(org-done ((,class :box ,bg-region :background ,bg-dim :foreground ,green))) + `(org-drawer ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,cyan))) `(org-ellipsis ((,class :foreground nil))) ; inherits from the heading's colour - `(org-footnote ((,class :foreground ,blue-alt :underline t))) - `(org-formula ((,class :inherit fixed-pitch :foreground ,red-alt))) + `(org-footnote ((,class :inherit button :foreground ,blue-alt))) + `(org-formula ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,red-alt))) `(org-habit-alert-face ((,class :inherit modus-theme-intense-yellow))) `(org-habit-alert-future-face ((,class :inherit modus-theme-refine-yellow))) `(org-habit-clear-face ((,class :inherit modus-theme-intense-magenta))) @@ -3212,69 +3642,48 @@ Also bind `class' to ((class color) (min-colors 89))." `(org-habit-overdue-future-face ((,class :inherit modus-theme-refine-red))) `(org-habit-ready-face ((,class :inherit modus-theme-intense-blue))) `(org-habit-ready-future-face ((,class :inherit modus-theme-refine-blue))) - `(org-headline-done ((,class :foreground ,green-nuanced - ,@(modus-vivendi-theme-heading-block - green-nuanced-bg green-nuanced)))) + `(org-headline-done ((,class :inherit ,modus-theme-variable-pitch :foreground ,green-nuanced))) + `(org-headline-todo ((,class :inherit ,modus-theme-variable-pitch :foreground ,red-nuanced))) `(org-hide ((,class :foreground ,bg-main))) `(org-indent ((,class :inherit (fixed-pitch org-hide)))) `(org-latex-and-related ((,class :foreground ,magenta-refine-fg))) - `(org-level-1 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-main magenta-alt-other) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4) - ,@(modus-vivendi-theme-heading-block magenta-nuanced-bg magenta-nuanced)))) - `(org-level-2 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-warm magenta-alt) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3) - ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(org-level-3 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-cold blue) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2) - ,@(modus-vivendi-theme-heading-block blue-nuanced-bg blue-nuanced)))) - `(org-level-4 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-mild cyan) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1) - ,@(modus-vivendi-theme-heading-block cyan-nuanced-bg cyan-nuanced)))) - `(org-level-5 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-calm green-alt-other) - ,@(modus-vivendi-theme-heading-block green-nuanced-bg green-nuanced)))) - `(org-level-6 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground yellow-nuanced yellow-alt-other) - ,@(modus-vivendi-theme-heading-block yellow-nuanced-bg yellow-nuanced)))) - `(org-level-7 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground red-nuanced red-alt) - ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(org-level-8 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-dim magenta) - ,@(modus-vivendi-theme-heading-block bg-alt fg-alt)))) + `(org-level-1 ((,class :inherit modus-theme-heading-1))) + `(org-level-2 ((,class :inherit modus-theme-heading-2))) + `(org-level-3 ((,class :inherit modus-theme-heading-3))) + `(org-level-4 ((,class :inherit modus-theme-heading-4))) + `(org-level-5 ((,class :inherit modus-theme-heading-5))) + `(org-level-6 ((,class :inherit modus-theme-heading-6))) + `(org-level-7 ((,class :inherit modus-theme-heading-7))) + `(org-level-8 ((,class :inherit modus-theme-heading-8))) `(org-link ((,class :inherit link))) `(org-list-dt ((,class :inherit bold))) - `(org-macro ((,class :inherit org-latex-and-related))) - `(org-meta-line ((,class :inherit fixed-pitch :background ,cyan-nuanced-bg :foreground ,cyan-nuanced))) + `(org-macro ((,class :background ,blue-nuanced-bg :foreground ,magenta-alt-other))) + `(org-meta-line ((,class ,@(modus-vivendi-theme-mixed-fonts) :foreground ,fg-alt))) `(org-mode-line-clock ((,class :foreground ,fg-main))) `(org-mode-line-clock-overrun ((,class :inherit modus-theme-active-red))) - `(org-priority ((,class ,@(modus-vivendi-theme-org-todo-block magenta-nuanced-bg magenta-nuanced magenta) - ,@(modus-vivendi-theme-heading-foreground magenta magenta-alt-other)))) - `(org-quote ((,class ,@(if modus-vivendi-theme-org-blocks - (append - (and (>= emacs-major-version 27) '(:extend t)) - (list :background bg-dim)) - (list :background nil)) - :foreground ,fg-special-calm :slant ,modus-theme-slant))) + `(org-priority ((,class :box ,bg-region :background ,bg-dim :foreground ,magenta))) + `(org-property-value ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,cyan-alt-other))) + `(org-quote ((,class ,@(modus-vivendi-theme-org-block bg-dim) + :foreground ,fg-special-cold :slant ,modus-theme-slant))) `(org-scheduled ((,class :foreground ,fg-special-warm))) `(org-scheduled-previously ((,class :foreground ,yellow-alt-other))) `(org-scheduled-today ((,class :foreground ,magenta-alt-other))) `(org-sexp-date ((,class :inherit org-date))) - `(org-special-keyword ((,class ,@(modus-vivendi-theme-org-todo-block cyan-nuanced-bg cyan-nuanced cyan-alt)))) - `(org-table ((,class :inherit fixed-pitch :foreground ,fg-special-cold))) - `(org-tag ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-nuanced))) + `(org-special-keyword ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,blue-nuanced))) + `(org-table ((,class ,@(modus-vivendi-theme-mixed-fonts) + :foreground ,fg-special-cold))) + `(org-table-header ((,class :inherit (fixed-pitch modus-theme-intense-neutral)))) + `(org-tag ((,class :foreground ,magenta-nuanced))) `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced))) `(org-target ((,class :underline t))) `(org-time-grid ((,class :foreground ,fg-unfocused))) - `(org-todo ((,class ,@(modus-vivendi-theme-org-todo-block red-nuanced-bg red-nuanced red-alt) - ,@(modus-vivendi-theme-heading-foreground red-alt red)))) + `(org-todo ((,class :box ,bg-region :background ,bg-dim :foreground ,red-alt))) `(org-upcoming-deadline ((,class :foreground ,red-alt-other))) `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced))) - `(org-verbatim ((,class :inherit fixed-pitch :background ,bg-alt :foreground ,fg-special-calm))) + `(org-verbatim ((,class ,@(modus-vivendi-theme-mixed-fonts) + :background ,bg-alt :foreground ,fg-special-calm))) `(org-verse ((,class :inherit org-quote))) `(org-warning ((,class :inherit bold :foreground ,red-alt-other))) ;;;;; org-journal @@ -3291,8 +3700,11 @@ Also bind `class' to ((class color) (min-colors 89))." ;;;;; org-recur `(org-recur ((,class :foreground ,magenta-active))) ;;;;; org-roam - `(org-roam-link ((,class :foreground ,blue-alt-other :underline t))) - `(org-roam-backlink ((,class :foreground ,green-alt-other :underline t))) + `(org-roam-link ((,class :inherit button :foreground ,green))) + `(org-roam-link-current ((,class :inherit button :foreground ,green-alt))) + `(org-roam-link-invalid ((,class :inherit button :foreground ,red))) + `(org-roam-link-shielded ((,class :inherit button :foreground ,yellow))) + `(org-roam-tag ((,class :foreground ,fg-alt :slant italic))) ;;;;; org-superstar `(org-superstar-item ((,class :foreground ,fg-main))) `(org-superstar-leading ((,class :foreground ,fg-whitespace))) @@ -3305,37 +3717,16 @@ Also bind `class' to ((class color) (min-colors 89))." `(origami-fold-header-face ((,class :background ,bg-dim :foreground ,fg-dim :box t))) `(origami-fold-replacement-face ((,class :background ,bg-alt :foreground ,fg-alt))) ;;;;; outline-mode - `(outline-1 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-main magenta-alt-other) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4) - ,@(modus-vivendi-theme-heading-block magenta-nuanced-bg magenta-nuanced)))) - `(outline-2 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-warm magenta-alt) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3) - ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(outline-3 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-cold blue) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2) - ,@(modus-vivendi-theme-heading-block blue-nuanced-bg blue-nuanced)))) - `(outline-4 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-mild cyan) - ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1) - ,@(modus-vivendi-theme-heading-block cyan-nuanced-bg cyan-nuanced)))) - `(outline-5 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-special-calm green-alt-other) - ,@(modus-vivendi-theme-heading-block green-nuanced-bg green-nuanced)))) - `(outline-6 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground yellow-nuanced yellow-alt-other) - ,@(modus-vivendi-theme-heading-block yellow-nuanced-bg yellow-nuanced)))) - `(outline-7 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground red-nuanced red-alt) - ,@(modus-vivendi-theme-heading-block red-nuanced-bg red-nuanced)))) - `(outline-8 ((,class :inherit (bold ,modus-theme-variable-pitch) - ,@(modus-vivendi-theme-heading-foreground fg-dim magenta) - ,@(modus-vivendi-theme-heading-block bg-alt fg-alt)))) + `(outline-1 ((,class :inherit modus-theme-heading-1))) + `(outline-2 ((,class :inherit modus-theme-heading-2))) + `(outline-3 ((,class :inherit modus-theme-heading-3))) + `(outline-4 ((,class :inherit modus-theme-heading-4))) + `(outline-5 ((,class :inherit modus-theme-heading-5))) + `(outline-6 ((,class :inherit modus-theme-heading-6))) + `(outline-7 ((,class :inherit modus-theme-heading-7))) + `(outline-8 ((,class :inherit modus-theme-heading-8))) ;;;;; outline-minor-faces - `(outline-minor-0 ((,class ,@(unless modus-vivendi-theme-section-headings - (list :background cyan-nuanced-bg))))) + `(outline-minor-0 ((,class nil))) ;;;;; package (M-x list-packages) `(package-description ((,class :foreground ,fg-special-cold))) `(package-help-section-name ((,class :inherit bold :foreground ,magenta-alt-other))) @@ -3423,6 +3814,23 @@ Also bind `class' to ((class color) (min-colors 89))." `(prodigy-green-face ((,class :foreground ,green))) `(prodigy-red-face ((,class :foreground ,red))) `(prodigy-yellow-face ((,class :foreground ,yellow))) +;;;;; racket-mode + `(racket-debug-break-face ((,class :inherit modus-theme-intense-red))) + `(racket-debug-locals-face ((,class :box (:line-width -1 :color nil) + :foreground ,green-alt-other))) + `(racket-debug-result-face ((,class :inherit bold :box (:line-width -1 :color nil) + :foreground ,green))) + `(racket-here-string-face ((,class :foreground ,blue-alt))) + `(racket-keyword-argument-face ((,class :foreground ,red-alt))) + `(racket-logger-config-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant))) + `(racket-logger-debug-face ((,class :foreground ,blue-alt-other))) + `(racket-logger-info-face ((,class :foreground ,fg-lang-note))) + `(racket-logger-topic-face ((,class :foreground ,magenta :slant ,modus-theme-slant))) + `(racket-selfeval-face ((,class :foreground ,green-alt))) + `(racket-xp-error-face + ((,(append '((supports :underline (:style wave))) class) + :underline (:color ,fg-lang-error :style wave)) + (,class :foreground ,fg-lang-error :underline t))) ;;;;; rainbow-blocks `(rainbow-blocks-depth-1-face ((,class :foreground ,magenta-alt-other))) `(rainbow-blocks-depth-2-face ((,class :foreground ,blue))) @@ -3544,24 +3952,19 @@ Also bind `class' to ((class color) (min-colors 89))." 'modus-theme-nuanced-blue blue-alt-other)))) ;;;;; selectrum - `(selectrum-current-candidate ((,class ,@(modus-vivendi-theme-extra-completions - 'modus-theme-refine-magenta - 'modus-theme-intense-magenta - 'modus-theme-nuanced-magenta - magenta - 'bold)))) - `(selectrum-primary-highlight ((,class ,@(modus-vivendi-theme-extra-completions - 'modus-theme-refine-blue - 'modus-theme-intense-blue - 'modus-theme-nuanced-blue - blue - 'bold)))) - `(selectrum-secondary-highlight ((,class ,@(modus-vivendi-theme-extra-completions - 'modus-theme-refine-cyan - 'modus-theme-intense-cyan - 'modus-theme-nuanced-cyan - cyan - 'bold)))) + `(selectrum-current-candidate + ((,class :inherit bold :foreground ,fg-main :underline ,fg-main + :background ,@(pcase modus-vivendi-theme-completions + ('opinionated (list bg-active)) + (_ (list bg-inactive)))))) + `(selectrum-primary-highlight ((,class :inherit bold + ,@(modus-vivendi-theme-standard-completions + magenta-alt magenta-nuanced-bg + magenta-refine-bg magenta-refine-fg)))) + `(selectrum-secondary-highlight ((,class :inherit bold + ,@(modus-vivendi-theme-standard-completions + cyan-alt-other cyan-nuanced-bg + cyan-refine-bg cyan-refine-fg)))) ;;;;; semantic `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t))) `(semantic-decoration-on-private-members-face ((,class :inherit modus-theme-refine-cyan))) @@ -3628,23 +4031,13 @@ Also bind `class' to ((class color) (min-colors 89))." `(sp-wrap-overlay-opening-pair ((,class :inherit sp-pair-overlay-face))) `(sp-wrap-tag-overlay-face ((,class :inherit sp-pair-overlay-face))) ;;;;; smerge - `(smerge-base ((,class ,@(modus-vivendi-theme-diffs - bg-main yellow - bg-diff-focus-changed fg-diff-focus-changed)))) - `(smerge-lower ((,class ,@(modus-vivendi-theme-diffs - bg-main green - bg-diff-focus-added fg-diff-focus-added)))) + `(smerge-base ((,class :inherit modus-theme-diff-changed))) + `(smerge-lower ((,class :inherit modus-theme-diff-added))) `(smerge-markers ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2))) - `(smerge-refined-added ((,class ,@(modus-vivendi-theme-diffs - bg-diff-added fg-diff-added - bg-diff-refine-added fg-diff-refine-added)))) + `(smerge-refined-added ((,class :inherit modus-theme-diff-refine-added))) `(smerge-refined-changed ((,class))) - `(smerge-refined-removed ((,class ,@(modus-vivendi-theme-diffs - bg-diff-removed fg-diff-removed - bg-diff-refine-removed fg-diff-refine-removed)))) - `(smerge-upper ((,class ,@(modus-vivendi-theme-diffs - bg-main red - bg-diff-focus-removed fg-diff-focus-removed)))) + `(smerge-refined-removed ((,class :inherit modus-theme-diff-refine-removed))) + `(smerge-upper ((,class :inherit modus-theme-diff-removed))) ;;;;; spaceline `(spaceline-evil-emacs ((,class :inherit modus-theme-active-magenta))) `(spaceline-evil-insert ((,class :inherit modus-theme-active-green))) @@ -3804,7 +4197,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(trashed-mark ((,class :inherit modus-theme-mark-symbol))) `(trashed-marked ((,class :inherit modus-theme-mark-alt))) `(trashed-restored ((,class :inherit modus-theme-mark-sel))) - `(trashed-symlink ((,class :foreground ,cyan-alt :underline t))) + `(trashed-symlink ((,class :inherit button :foreground ,cyan-alt))) ;;;;; treemacs `(treemacs-directory-collapsed-face ((,class :foreground ,magenta-alt))) `(treemacs-directory-face ((,class :inherit dired-directory))) @@ -3870,39 +4263,33 @@ Also bind `class' to ((class color) (min-colors 89))." `(tuareg-opam-pkg-variable-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground cyan cyan-faint) :slant ,modus-theme-slant))) +;;;;; typescript + `(typescript-jsdoc-tag ((,class :foreground ,fg-special-mild :slant ,modus-theme-slant))) + `(typescript-jsdoc-type ((,class :foreground ,fg-special-calm :slant ,modus-theme-slant))) + `(typescript-jsdoc-value ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant))) ;;;;; undo-tree `(undo-tree-visualizer-active-branch-face ((,class :inherit bold :foreground ,fg-main))) `(undo-tree-visualizer-current-face ((,class :foreground ,blue-intense))) `(undo-tree-visualizer-default-face ((,class :foreground ,fg-alt))) `(undo-tree-visualizer-register-face ((,class :foreground ,magenta-intense))) `(undo-tree-visualizer-unmodified-face ((,class :foreground ,green-intense))) -;;;;; vc - `(vc-conflict-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-active))) - `(vc-edited-state ((,class :foreground ,fg-special-warm))) +;;;;; vc (vc-hooks.el) + `(vc-conflict-state ((,class :foreground ,red-active :slant ,modus-theme-slant))) + `(vc-edited-state ((,class :foreground ,yellow-active))) `(vc-locally-added-state ((,class :foreground ,cyan-active))) - `(vc-locked-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-active))) - `(vc-missing-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,yellow-active))) - `(vc-needs-update-state ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,fg-special-mild))) + `(vc-locked-state ((,class :foreground ,blue-active))) + `(vc-missing-state ((,class :foreground ,magenta-active :slant ,modus-theme-slant))) + `(vc-needs-update-state ((,class :foreground ,green-active :slant ,modus-theme-slant))) `(vc-removed-state ((,class :foreground ,red-active))) `(vc-state-base ((,class :foreground ,fg-active))) `(vc-up-to-date-state ((,class :foreground ,fg-special-cold))) ;;;;; vdiff - `(vdiff-addition-face ((,class ,@(modus-vivendi-theme-diffs - bg-main green - bg-diff-focus-added fg-diff-focus-added)))) - `(vdiff-change-face ((,class ,@(modus-vivendi-theme-diffs - bg-main yellow - bg-diff-focus-changed fg-diff-focus-changed)))) + `(vdiff-addition-face ((,class :inherit modus-theme-diff-added))) + `(vdiff-change-face ((,class :inherit modus-theme-diff-changed))) `(vdiff-closed-fold-face ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1))) - `(vdiff-refine-added ((,class ,@(modus-vivendi-theme-diffs - bg-diff-added fg-diff-added - bg-diff-refine-added fg-diff-refine-added)))) - `(vdiff-refine-changed ((,class ,@(modus-vivendi-theme-diffs - bg-diff-changed fg-diff-changed - bg-diff-refine-changed fg-diff-refine-changed)))) - `(vdiff-subtraction-face ((,class ,@(modus-vivendi-theme-diffs - bg-main red - bg-diff-focus-removed fg-diff-focus-removed)))) + `(vdiff-refine-added ((,class :inherit modus-theme-diff-refine-added))) + `(vdiff-refine-changed ((,class :inherit modus-theme-diff-refine-changed))) + `(vdiff-subtraction-face ((,class :inherit modus-theme-diff-removed))) `(vdiff-target-face ((,class :inherit modus-theme-intense-blue))) ;;;;; vimish-fold `(vimish-fold-fringe ((,class :foreground ,cyan-active))) @@ -3925,7 +4312,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(vhl/default-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t)) :background ,bg-alt :foreground ,blue-nuanced))) ;;;;; vterm - `(vterm-color-black ((,class :background "black" :foreground "black"))) + `(vterm-color-black ((,class :background "gray35" :foreground "gray35"))) `(vterm-color-blue ((,class :background ,blue :foreground ,blue))) `(vterm-color-cyan ((,class :background ,cyan :foreground ,cyan))) `(vterm-color-default ((,class :background ,bg-main :foreground ,fg-main))) @@ -3934,7 +4321,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(vterm-color-magenta ((,class :background ,magenta :foreground ,magenta))) `(vterm-color-red ((,class :background ,red :foreground ,red))) `(vterm-color-underline ((,class :foreground ,fg-special-warm :underline t))) - `(vterm-color-white ((,class :background "white" :foreground "white"))) + `(vterm-color-white ((,class :background "gray65" :foreground "gray65"))) `(vterm-color-yellow ((,class :background ,yellow :foreground ,yellow))) ;;;;; wcheck-mode `(wcheck-default-face ((,class :foreground ,red :underline t))) @@ -4135,7 +4522,6 @@ Also bind `class' to ((class color) (min-colors 89))." `(ztreep-node-count-children-face ((,class :foreground ,fg-special-warm))) `(ztreep-node-face ((,class :foreground ,fg-main)))) ;;;; Emacs 27+ - ;; EXPERIMENTAL this form is subject to review (when (>= emacs-major-version 27) (custom-theme-set-faces 'modus-vivendi @@ -4143,8 +4529,12 @@ Also bind `class' to ((class color) (min-colors 89))." ;; NOTE that this is specifically for the faces that were ;; introduced in Emacs 27, as the other faces are already ;; supported. - `(line-number-major-tick ((,class (:background ,yellow-nuanced-bg :foreground ,yellow-nuanced)))) - `(line-number-minor-tick ((,class (:background ,cyan-nuanced-bg :foreground ,cyan-nuanced)))) + `(line-number-major-tick ((,class :inherit (bold default) + :background ,yellow-nuanced-bg + :foreground ,yellow-nuanced))) + `(line-number-minor-tick ((,class :inherit (bold default) + :background ,bg-inactive + :foreground ,fg-inactive))) ;;;;; tab-bar-mode `(tab-bar ((,class :background ,bg-tab-bar :foreground ,fg-main))) `(tab-bar-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active) @@ -4160,12 +4550,22 @@ Also bind `class' to ((class color) (min-colors 89))." `(tab-line-tab-current ((,class :inherit tab-line-tab))) `(tab-line-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive) :background ,bg-tab-inactive :foreground ,fg-dim))))) +;;;; Emacs 28+ + (when (>= emacs-major-version 28) + (custom-theme-set-faces + 'modus-vivendi +;;;;; isearch regexp groups + `(isearch-group-1 ((,class :inherit modus-theme-intense-blue))) + `(isearch-group-2 ((,class :inherit modus-theme-intense-magenta))))) ;;; variables (custom-theme-set-variables 'modus-vivendi ;;;; ansi-colors `(ansi-color-faces-vector [default bold shadow italic underline success warning error]) `(ansi-color-names-vector [,bg-main ,red ,green ,yellow ,blue ,magenta ,cyan ,fg-main]) +;;;; awesome-tray + `(awesome-tray-mode-line-active-color ,blue) + `(awesome-tray-mode-line-inactive-color ,bg-active) ;;;; flymake fringe indicators `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-theme-fringe-red)) `(flymake-warning-bitmap '(exclamation-mark modus-theme-fringe-yellow)) @@ -4174,7 +4574,7 @@ Also bind `class' to ((class color) (min-colors 89))." `(ibuffer-deletion-face 'modus-theme-mark-del) `(ibuffer-filter-group-name-face 'modus-theme-mark-symbol) `(ibuffer-marked-face 'modus-theme-mark-sel) - `(ibuffer-title-face 'modus-theme-header) + `(ibuffer-title-face 'modus-theme-pseudo-header) ;;;; highlight-tail `(highlight-tail-colors '((,green-subtle-bg . 0) diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index 227c13f3e3a..319ba52b670 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -473,6 +473,7 @@ to undo insertion of text.) >> Kill this line with C-k, then type C-/ and it should reappear. C-_ is an alternative undo command; it works exactly the same as C-/. +On some text terminals, you can omit the shift key when you type C-_. On some text terminals, typing C-/ actually sends C-_ to Emacs. Alternatively, C-x u also works exactly like C-/, but is a little less convenient to type. diff --git a/etc/tutorials/TUTORIAL.de b/etc/tutorials/TUTORIAL.de index 75c03a18e4a..ae58fc9a44b 100644 --- a/etc/tutorials/TUTORIAL.de +++ b/etc/tutorials/TUTORIAL.de @@ -19,15 +19,22 @@ EDIT oder ALT genannt). Folgende Abkürzungen werden verwendet: <<Blank lines inserted here by startup of help-with-tutorial>> [Leerzeilen befinden sich hier aus didaktischen Gründen. Fortsetzung unten.] >> Drücken Sie C-v, um zur nächsten Bildschirmseite vorzublättern. - Ab jetzt sollten Sie das stets tun, wenn Sie eine Seite fertig - gelesen haben. + Ab jetzt sollten Sie das stets tun, wenn Sie das untere + Bildschirmende erreicht haben. Beachten Sie bitte, dass beim Blättern die untersten zwei Zeilen der vorigen Bildschirmseite als die zwei obersten Zeilen der neuen Seite erscheinen, um eine gewisse Kontinuität während des Lesens zu ermöglichen. +Was Sie gerade lesen, ist eine leicht angepasste Kopie der deutschen +Einführung. Später werden Sie aufgefordert, verschiedene Befehle +auszuführen, um den Text der Einführung zu ändern. Es spielt keine +Rolle, wenn Sie den Text schon vorher ändern sollten – man nennt das +»editieren«, und genau dafür ist ein Editor wie Emacs da. + Wichtig: Sie können Emacs mit der Befehlsfolge C-x C-c beenden. +Diese Einführung beenden Sie mit C-x k, gefolgt von der Eingabetaste. Im weiteren wird die ESC-Taste mit <ESC> bezeichnet. @@ -41,7 +48,7 @@ Sie schon (C-v). Mit M-v blättern Sie eine Bildschirmseite zurück (halten Sie die META-Taste gedrückt und geben Sie v ein, oder drücken Sie zuerst <ESC> und anschließend v). ->> Probieren Sie einige Male M-v und C-v aus. +>> Probieren Sie einige Male M-v und C-v aus. [Auf den meisten Tastaturen bewirkt die PgUp-Taste (»page up«, auch mit »Bild« und einem Aufwärtspfeil beschriftet) dasselbe wie M-v bzw. @@ -277,14 +284,14 @@ Wert, signalisiert dem Befehl, etwas anderes zu tun. C-v und M-v sind weitere Ausnahmen. Gibt man diesen Befehlen einen Parameter n, dann verschieben sie den Bildschirminhalt nicht um eine -ganze Bildschirmseite, sondern um n Zeilen. Beispiel: C-u 4 C-v -verschiebt den Bildschirminhalt um vier Zeilen. +ganze Bildschirmseite, sondern um n Zeilen. Beispiel: C-u 8 C-v +verschiebt den dargestellten Text um acht Zeilen. >> Versuchen Sie jetzt C-u 8 C-v auszuführen. -Der Bildschirminhalt sollte jetzt um acht Zeilen nach oben verschoben -sein. Wollen Sie ihn nach unten verschieben, dann geben Sie M-v mit -einem numerischen Argument ein. +Der Text sollte jetzt um acht Zeilen nach oben verschoben sein. +Wollen Sie ihn nach unten verschieben, dann geben Sie M-v mit einem +numerischen Argument ein. Wenn Sie eine graphische Oberfläche wie X oder MS-Windows verwenden, dann befindet sich ein schmaler, langgezogener rechteckiger Bereich @@ -411,12 +418,12 @@ Fortsetzungszeile. >> Geben Sie <Return> ein, um wieder ein Zeilenvorschubzeichen einzufügen. -Die <Return>-Taste ist insofern besonders, als dass sie mehr bewirken -kann, als einfach ein Zeilenvorschubszeichen einzufügen. Abhängig vom -umgebenden Text können zusätzliche Leerzeichen eingefügt werden, damit -der neue Zeilenanfang bündig zur vorherigen Zeile ist. Wir nennen -dieses Verhalten (wenn das Drücken einer Taste mehr bewirkt, als nur -das entsprechende Zeichen einzufügen) »electric«. +Die <Return>-Taste ist besonders, da sie mehr bewirken kann als +einfach ein Zeilenvorschubzeichen einfügen. Abhängig vom umgebenden +Text können zusätzliche Leerzeichen eingefügt werden, damit der neue +Zeilenanfang bündig zur vorherigen Zeile ist. Wir nennen dieses +Verhalten (wenn das Drücken einer Taste mehr bewirkt, als nur das +entsprechende Zeichen einzufügen) »electric«. >> Ein Beispiel für dieses Verhalten von <Return>. Drücken Sie <Return> am Ende dieser Zeile. @@ -468,7 +475,7 @@ gelöschten Text, damit Sie ihn bei Bedarf wieder zurückholen können. Einfügen von bereits gelöschtem Text wird im englischen Dokumentation von Emacs als »yanking« (wörtlich »herausreißen«) bezeichnet. Sie können den gelöschten Text an einer beliebigen Stelle wieder -einzufügen. Solange Sie nichts neues löschen, steht Ihnen dieser +einfügen. Solange Sie nichts neues löschen, steht Ihnen dieser gelöschte Textteil immer wieder zu Verfügung. Der Befehl dazu ist C-y (das Ypsilon steht für »yank«). @@ -584,9 +591,11 @@ Anzahl der notwendigen C-/-Befehle zu reduzieren. >> Löschen Sie diese Zeilen mit C-k und drücken Sie anschließend mehrmals C-/, und die Zeilen erscheinen wieder. -Alternative Tastenkombinationen für C-/ sind C-_ und C-x u. Ein -numerisches Argument für C-/, C-_ oder C-x u wird als -Wiederholungszähler interpretiert. +Alternative Tastenkombinationen für C-/ sind C-_ und C-x u (in manchen +Terminals funktioniert C-_ auch ohne SHIFT-Taste). Wählen Sie das +aus, was am bequemsten für Sie zu tippen ist. Ein numerisches +Argument für C-/, C-_ oder C-x u wird als Wiederholungszähler +interpretiert. Der Unterschied zwischen der Undo-Funktion und dem oben erklärten C-y ist, dass erstere gelöschten Text an exakt der gleichen Position wie @@ -668,10 +677,7 @@ Name besteht aus dem Originalnamen plus einer angehängten Tilde »~« Namenserweiterung durch ».bak« ersetzt]. Emacs schreibt den Namen der gesicherten Datei in die unterste Zeile, -sobald C-x C-s fertig ausgeführt ist. Sie sollten den editierten Text -oft speichern, damit nicht allzuviel bei einem etwaigen Systemabsturz -verloren geht (siehe auch den Abschnitt »AUTOMATISCHES SPEICHERN« -weiter unten). +sobald C-x C-s fertig ausgeführt ist. >> Geben Sie @@ -715,12 +721,11 @@ ein. >> Probieren Sie jetzt C-x C-b. -Beachten Sie, dass jeder Puffer einen Namen hat und manche auch mit -dem Namen einer Datei assoziiert sind, dessen Inhalt sie enthalten. -Manche Puffer aber haben keinen zugehörige Datei, z.B. der mit dem -Namen »*Buffer List*«. Er wurde von dem Befehl C-x C-b erzeugt, um -die Pufferliste darzustellen. JEDER Text, den Sie innerhalb Emacs in -einem Fenster sehen, ist immer ein Ausschnitt eines Puffers. +Beachten Sie, dass manche Puffer keine zugehörige Datei haben, +z.B. der mit dem Namen »*Buffer List*«. Er wurde von dem Befehl C-x +C-b erzeugt, um die Pufferliste darzustellen. JEDER Text, den Sie +innerhalb Emacs in einem Fenster sehen, ist immer ein Ausschnitt eines +Puffers. >> Geben Sie jetzt C-x 1 ein, um die Pufferliste wieder verschwinden zu lassen. @@ -748,13 +753,11 @@ den Verzeichnispräfix), jedoch nicht immer. Die von C-x C-b erzeugte Pufferliste zeigt stets die Namen aller Puffer mit den korrespondierenden Dateinamen. -JEDER Text in Emacs ist Teil eines Puffers, aber nicht jeder Puffer -entspricht einer Datei. So ist z.B. der Puffer »*Buffer List*« mit -keiner Datei assoziiert -- er wurde direkt von dem Befehl C-x C-b -erzeugt. Auch dieser »TUTORIAL.de«-Puffer war anfangs keiner Datei -zugeordnet, jetzt allerdings schon, denn Sie haben im letzten -Abschnitt den Befehl C-x C-s eingegeben und so den Pufferinhalt als -Datei gespeichert. +Wie schon erwähnt, ist JEDER Text in Emacs Teil eines Puffers, aber +nicht jeder Puffer entspricht einer Datei. Auch dieser +»TUTORIAL.de«-Puffer war anfangs keiner Datei zugeordnet, jetzt +allerdings schon, denn Sie haben im letzten Abschnitt den Befehl C-x +C-s eingegeben und so den Pufferinhalt als Datei gespeichert. Der Puffer »*Messages*« hat ebenfalls keine Entsprechung als Datei; er enthält alle Mitteilungen, die in der untersten Zeile während des @@ -774,10 +777,10 @@ Datei permanent abzuspeichern. Es wäre äußerst umständlich, müsste man jedesmal C-x C-f eingeben, um den Puffer dann mit C-x C-s abzuspeichern. Daher gibt es den Befehl - C-x s (sichere mehrere Puffer) + C-x s (sichere mehrere Puffer in Dateien) -Dieser Befehl fragt Sie bei jedem Puffer, der Änderungen enthält, ob -Sie ihn speichern wollen. +Dieser Befehl fragt Sie bei jedem einer Datei zugeordneten Puffer, der +Änderungen enthält, ob Sie ihn in der Datei speichern wollen. >> Fügen Sie eine Textzeile ein und drücken Sie dann C-x s. Emacs fragt Sie jetzt, ob Sie einen Puffer mit dem Namen @@ -824,15 +827,15 @@ zu Emacs zurückzukehren. Der beste Zeitpunkt für C-x C-c ist, wenn Sie sich ausloggen (bzw. Ihren Computer ausschalten); Sie sollten Emacs ebenfalls -beenden, wenn Sie Emacs von einem anderen Programm aus aufgerufen -haben (z.B. einem Programm, das E-mails liest). +beenden, wenn Sie Emacs von einem anderen Programm aus kurzzeitig +aufgerufen haben (z.B. einem Programm, das E-Mails liest). Hier ist eine Liste aller C-x-Befehle, die Sie bereits kennengelernt haben: C-x C-f lade Datei - C-x C-s sichere Datei - C-x s sichere einige Puffer + C-x C-s sichere Puffer in Datei + C-x s sichere einige Puffer in zugehörige Dateien C-x C-b zeige Pufferliste an C-x b wechsle zu Puffer C-x C-c beende Emacs @@ -840,10 +843,10 @@ haben: C-x u widerrufen Ein Beispiel für einen Befehl mit langen Namen ist replace-string, der -global (also in der ganzen Datei bzw. Puffer) eine Zeichenkette durch -eine andere ersetzt. Wenn Sie M-x drücken, dann fragt Sie Emacs in -der untersten Bildschirmzeile nach dem Namen des Befehls (in diesem -Fall »replace-string«). Geben Sie jetzt »repl s<TAB>« ein und Emacs +in der ganzen Datei bzw. Puffer eine Zeichenkette durch eine andere +ersetzt. Wenn Sie M-x drücken, dann fragt Sie Emacs in der untersten +Bildschirmzeile nach dem Namen des Befehls (in diesem Fall +»replace-string«). Geben Sie jetzt »repl s<TAB>« ein und Emacs vervollständigt den Namen. Schließen Sie die Eingabe mit <Return> ab. [<TAB> bezeichnet die Tabulatortaste.] @@ -855,7 +858,7 @@ vervollständigt den Namen. Schließen Sie die Eingabe mit <Return> ab. ein und kehren Sie mit C-u C-SPC an diese Position zurück. Beachten Sie wie diese Bildschirmzeile jetzt aussieht: Sie haben - den Wortteil B-i-l-d-s-c-h-i-r-m durch »Text« ersetzt (und zwar im + den Wortteil »Bildschirm« durch »Text« ersetzt (und zwar im ganzen Dokument beginnend von der Cursorposition). >> Drücken Sie jetzt C-x u, um diese Änderungen auf einmal rückgängig @@ -878,8 +881,8 @@ Stürzt der Rechner einmal wirklich ab, können Sie die Änderungen, die beim letzten Auto-Save gespeichert worden sind, folgendermaßen wiederherstellen: Laden Sie die Datei auf normalem Wege (die Datei, die Sie bearbeitet haben, nicht die Auto-Save-Datei) und geben Sie -dann »M-x recover-file <Return>« ein. Wenn Emacs Sie um Bestätigung -fragt, antworten Sie mit »yes <Return>«, um den Inhalt der +dann »M-x recover-this-file <Return>« ein. Wenn Emacs Sie um +Bestätigung fragt, antworten Sie mit »yes <Return>«, um den Inhalt der Auto-Save-Datei zu übernehmen. @@ -979,6 +982,7 @@ jeweils ein bisschen anders. Dokumentation zum derzeit aktuellen Hauptmodus bekommen Sie mit C-h m. +>> Bewegen Sie den Cursor zur nächsten Zeile. >> Drücken Sie C-l C-l, um diese Zeile an den oberen Bildschirmrand zu bringen. >> Lesen Sie nun mittels C-h m die englische Dokumentation zum @@ -1129,13 +1133,13 @@ Rechteck dargestellt). Alle normalen Editierbefehle betreffen das Fenster, in dem sich der Cursor befindet. Wir nennen dieses Fenster »ausgewählt« (»selected window«). -Der Befehl M-C-v ist sehr nützlich, wenn man Text in einem Fenster +Der Befehl C-M-v ist sehr nützlich, wenn man Text in einem Fenster editiert und das andere Fenster als Referenz verwendet. Ohne das -momentante Arbeitsfenster verlassen zu müssen, kann man mit M-C-v im +momentante Arbeitsfenster verlassen zu müssen, kann man mit C-M-v im anderen Fenster bequem vorwärtsblättern. -M-C-v ist ein Beispiel eines CONTROL-META-Zeichens. Haben Sie eine -META-Taste, dann kann man M-C-v erzeugen, indem man CTRL und META +C-M-v ist ein Beispiel eines CONTROL-META-Zeichens. Haben Sie eine +META-Taste, dann kann man C-M-v erzeugen, indem man CTRL und META gleichzeitig niedergedrückt hält, während man v eintippt. Es ist egal, ob zuerst CTRL oder META niedergedrückt wird, da beide Tasten gleichberechtigt das jeweils einzugebende Zeichen modifizieren. @@ -1146,10 +1150,10 @@ gefolgt von CTRL-v. CTRL-ESC v funktioniert nicht! Der Grund dafür ist, dass ESC ein eigenes Zeichen ist und keine Modifizier-Taste wie META oder CTRL. -Der umgekehrte Befehl zu M-C-v ist M-C-S-v, um im anderen Fenster -rückwärts zu blättern (d.h., Sie müssen die META-Taste sowie die -CONTROL- und SHIFT-Taste zusammen mit »v« betätigen) -- jetzt werden -Sie wahrscheinlich verstehen, warum manche Kritiker das Wort Emacs als +Der umgekehrte Befehl zu C-M-v ist C-M-S-v, um im anderen Fenster +rückwärts zu blättern (d.h., Sie müssen die CONTROL-Taste sowie die +META- und SHIFT-Taste zusammen mit »v« betätigen) -- jetzt werden Sie +wahrscheinlich verstehen, warum manche Kritiker das Wort Emacs als Abkürzung von Escape-Meta-Alt-Control-Shift betrachten. Leider funktioniert diese Befehlsfolge normalerweise nur mit graphischen Oberflächen, da C-v von C-S-v auf den meisten Textterminals nicht @@ -1196,7 +1200,7 @@ Textterminal kann genau ein Rahmen dargestellt werden. >> Geben Sie - M-x make-frame <Return> + C-x 5 2 ein, um einen neuen Rahmen zu erzeugen. @@ -1206,7 +1210,7 @@ gleichwertig. >> Geben Sie - M-x delete-frame <Return> + C-x 5 0 ein, um den ausgewählten Rahmen zu entfernen. @@ -1276,7 +1280,7 @@ Funktion set-language-environment). Mittels C-x <Return> l latin-1 <Return> können Sie z.B. in einer laufenden Emacs-Sitzung auf Latin-1 -umzuschalten. Dadurch wird erreicht, dass Emacs beim Laden einer +umschalten. Dadurch wird erreicht, dass Emacs beim Laden einer Datei (und Speichern derselben) standardmäßig die Latin-1-Zeichenkodierung verwendet. Sie können an der Ziffer 1 unmittelbar vor dem Doppelpunkt links unten in der Statuszeile @@ -1343,7 +1347,7 @@ zwar für die Tastatur- und Bildschirmkodierung.] Wir haben uns bemüht, in dieser Einführung genau soviel Information zu geben, dass Sie beginnen können, mit Emacs zu arbeiten. Emacs ist jedoch so mächtig und umfangreich, dass es den Rahmen einer Einführung -spränge, an dieser Stelle mehr zu erklären. Um Sie im weiteren +sprengte, an dieser Stelle mehr zu erklären. Um Sie im weiteren Lernverlauf zu unterstützen, stellt Emacs eine Reihe von Hilfe-Funktionen zu Verfügung, die alle mit dem Präfix C-h (dem Hilfe-Zeichen, »Help character«) beginnen. @@ -1424,18 +1428,44 @@ zugehörigen langen Namen, find-file. >> Schließen Sie das Hilfefenster mit C-x 1. - C-h i Dieser Befehl öffnet einen speziellen Puffer, um - Handbücher zu lesen (im »Info«-Format), die auf dem + C-h i Dieser Befehl öffnet einen speziellen Puffer »*info*«, + um Handbücher zu lesen (im »Info«-Format), die auf dem verwendeten Computersystem installiert sind. Geben Sie z.B. m emacs <Return> ein, um das Emacs-Handbuch zu lesen. Haben Sie »Info« noch nie benutzt, tippen - Sie ?, und Emacs führt Sie Schritt für Schritt durch + Sie h, und Emacs führt Sie Schritt für Schritt durch die Möglichkeiten des Info-Modus. Wenn Sie diese Einführung fertiggelesen haben, sollten Sie das Info-Handbuch für Emacs als primäre Dokumentation benutzen. +* MEHR FEATURES +--------------- + +Sie können mehr über Emacs lernen, in dem Sie das Handbuch lesen, +entweder in der gedruckten Form oder innerhalb von Emacs (benützen Sie +dazu das Hilfe-Menu oder tippen Sie C-h r). Zwei besonders nützliche +Features sind Vervollständigung, um weniger tippen zu müssen, und +Dired, um das Laden von Dateien zu vereinfachen. + +Das Vervollständigungs-Feature ist eine Methode, um unnötiges Eingeben +von Zeichen zu vermeiden. Wenn Sie beispielsweise zum +»*Messages*«-Puffer umschalten wollen, genügt C-x b *M<TAB>, und Emacs +ergänzt automatisch den Namen des Puffers, soweit das anhand der +bisherigen Eingabe möglich ist. Vervollständigung funktioniert auch +für Befehls- und Dateinamen. Eine genaue Beschreibung finden Sie im +Abschnitt »Completion« des Emacs-Handbuchs. + +Dired ermöglicht es, Dateien eines Verzeichnisses (auf Wunsch +inklusive seiner Unterverzeichnisse) aufzulisten, sich innerhalb der +Liste zu bewegen, Dateien zu besuchen, umzubenennen, zu löschen u.a. +Eine genaue Beschreibung finden Sie im Abschnitt »Dired« des +Emacs-Handbuchs. + +Viele weitere Features sind ebenfalls im Handbuch beschrieben. + + * SCHLUSSBEMERKUNG ------------------ diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr index bc94f9ac626..3148c3f07e7 100644 --- a/etc/tutorials/TUTORIAL.fr +++ b/etc/tutorials/TUTORIAL.fr @@ -917,7 +917,7 @@ que vous recherchez. <Entrée> termine une recherche. Avez-vous vu ce qui se passait ? Emacs, dans une recherche incrémentale, essaie d'aller sur l'occurrence de la chaîne que vous -avec tapée jusqu'à cet instant. Pour aller sur l'occurrence suivante de +avez tapée jusqu'à cet instant. Pour aller sur l'occurrence suivante de « curseur », il suffit de refaire C-s : s'il ne trouve rien, Emacs bippe et vous indique que la recherche a échoué. C-g permet également de mettre fin à la recherche. diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index a6e6f252699..907da242804 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -419,8 +419,9 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא >> גזרו שורה זו עם C-k, אחר־כך הקישו C-/ והיא תופיע שוב. C-_ הינה דרך חלופית להפעיל את פקודת הביטול. היא פועלת בדיוק כמו C-/. -במקלדות אחדות הקשה על C-/ שולחת ל־Emacs את התו C-_. חלופה נוספת היא -C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו. +במקלדות אחדות אפשר לא ללחוץ על shift כשמקישים C-_. +במקלדות אחדות הקשה על C-/ שולחת ל־Emacs את התו C-_. +חלופה נוספת היא C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו. ארגומנט נומרי ל־C-/ או ל־C-_ או ל־C-x u משמש כמספר החזרות על הפקודה. diff --git a/leim/MISC-DIC/CTLau-b5.html b/leim/MISC-DIC/CTLau-b5.html index e718edeb121..117a6ee374e 100644 --- a/leim/MISC-DIC/CTLau-b5.html +++ b/leim/MISC-DIC/CTLau-b5.html @@ -23,7 +23,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/>. +# along with this program. If not, see <https://www.gnu.org/licenses/>. # # # File Format: diff --git a/leim/MISC-DIC/CTLau.html b/leim/MISC-DIC/CTLau.html index 18a48c125d0..e7759117325 100644 --- a/leim/MISC-DIC/CTLau.html +++ b/leim/MISC-DIC/CTLau.html @@ -23,7 +23,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/>. +# along with this program. If not, see <https://www.gnu.org/licenses/>. # # # File Format: diff --git a/leim/MISC-DIC/pinyin.map b/leim/MISC-DIC/pinyin.map index 6c2117713b5..4809769d1ad 100644 --- a/leim/MISC-DIC/pinyin.map +++ b/leim/MISC-DIC/pinyin.map @@ -23,7 +23,7 @@ % details.
%
% You should have received a copy of the GNU General Public License along with
-% CCE. If not, see <http://www.gnu.org/licenses/>.
+% CCE. If not, see <https://www.gnu.org/licenses/>.
%
% End of header added for Emacs
a ߹
diff --git a/leim/MISC-DIC/ziranma.cin b/leim/MISC-DIC/ziranma.cin index 13a63fd7335..b61aea2b6f4 100644 --- a/leim/MISC-DIC/ziranma.cin +++ b/leim/MISC-DIC/ziranma.cin @@ -23,7 +23,7 @@ % details. % % You should have received a copy of the GNU General Public License along with -% CCE. If not, see <http://www.gnu.org/licenses/>. +% CCE. If not, see <https://www.gnu.org/licenses/>. % % End of header added for Emacs %ename ZiranMa diff --git a/lib-src/ChangeLog.1 b/lib-src/ChangeLog.1 index 571eee44f1f..16f5142a01a 100644 --- a/lib-src/ChangeLog.1 +++ b/lib-src/ChangeLog.1 @@ -6944,10 +6944,10 @@ when saving a tag in structtag. Callers changed. (TOKEN): Structure changed. Now used only in C_entries. (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Delete. - (C_entries): nameb and savenameb deleted. Use dinamic allocation. + (C_entries): nameb and savenameb deleted. Use dynamic allocation. (pfcnt): Delete. Users updated. (getit, Asm_labels, Pascal_functions, L_getit, get_scheme) - (TEX_getit, prolog_getit): Use dinamic allocation for storing + (TEX_getit, prolog_getit): Use dynamic allocation for storing the tag instead of a fixed size buffer. 1995-01-10 Richard Stallman <rms@mole.gnu.ai.mit.edu> @@ -7609,7 +7609,7 @@ (longopts, print_help, main, process_file): Put absolute filenames in the tag file if the -A --absolute-pathnames option is used. (print_help): Alphabetically order the options. - (malloc, realloc, strcpy, strncpy, strcmp): Remove extern declar. + (malloc, realloc, strcpy, strncpy, strcmp): Remove extern declare. 1994-02-09 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -8239,7 +8239,7 @@ 1993-03-22 Francesco Potortì (pot@cnuce.cnr.it) * etags.c (YACC): Flag added to c_ext. - (c_ext): No more a synonim for c_ext&C_PLPL because of YACC. + (c_ext): No more a synonym for c_ext&C_PLPL because of YACC. (find_entries): Consistently use streq when reasonable. (find_entries): A .y file is a yacc file. (get_C_stab): c_ext becomes c_ext&C_PLPL. diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 70eb22b9946..7d0650a4059 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -1875,7 +1875,7 @@ yylex (void) /* Actually local to matching_regexp. These variables must be in - global scope for the case that `static' get's defined away. */ + global scope for the case that `static' gets defined away. */ static char *matching_regexp_buffer, *matching_regexp_end_buf; diff --git a/lib-src/movemail.c b/lib-src/movemail.c index 8016a4e3736..4f9abc998a3 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -580,7 +580,7 @@ pfatal_with_name (char *name) static void pfatal_and_delete (char *name) { - char *s = strerror (errno); + const char *s = strerror (errno); unlink (name); fatal ("%s for %s", s, name); } diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 54412223248..177ca08ef3b 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -12772,7 +12772,7 @@ (reftex-words-to-typekey-alist, reftex-key-to-index-macro-alist) (reftex-query-index-macro-prompt, reftex-query-index-macro-help) (reftex-no-follow-message, reftex-no-info-message): Likewise. - (reftex-mode): Define systax table for bibtex parsing. + (reftex-mode): Define syntax table for bibtex parsing. (reftex-syntax-table-for-bib): Syntax table for bibtex parsing. * textmodes/reftex-cite.el (reftex-format-names): %a as name @@ -15993,7 +15993,7 @@ * progmodes/cc-vars.el (c-offsets-alist): A more sane default for `inexpr-statement'. This is not compatible, though. - I think the benefit of a good default style outweights that in + I think the benefit of a good default style outweighs that in this case. Besides, `inexpr-statement' is not very common. 2002-04-22 Martin Stjernholm <mast@lysator.liu.se> diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11 index 52b85950be0..374a5668932 100644 --- a/lisp/ChangeLog.11 +++ b/lisp/ChangeLog.11 @@ -13392,7 +13392,7 @@ * progmodes/compile.el (compilation-error-regexp-alist): Add Java ANt error detection as described in document - http://ant.apache.org/faq.html + https://ant.apache.org/faq.html 2003-08-12 Juri Linkov <juri@jurta.org> (tiny change) diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index a9d0067598e..40aa8c4dc83 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -16274,7 +16274,7 @@ (c-guess-basic-syntax): Adapt case 5B for the new `c-just-after-func-arglist-p'. Merge cases 5B.1 and 5B.3. - Remove cases 5D.1 and 5D.2 since they aren't trigged anymore (case 5B.1 + Remove cases 5D.1 and 5D.2 since they aren't triggered anymore (case 5B.1 covers all cases now). * progmodes/cc-defs.el (c-point): Add `bosws' and `eosws'. @@ -32889,7 +32889,7 @@ 2005-01-14 Nick Roberts <nickrob@snap.net.nz> - * xt-mouse.el (xterm-mouse-event): Compute window co-ordinates + * xt-mouse.el (xterm-mouse-event): Compute window coordinates more carefully. 2005-01-13 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13 index 779a641d16a..1a2863afa97 100644 --- a/lisp/ChangeLog.13 +++ b/lisp/ChangeLog.13 @@ -4765,7 +4765,7 @@ 2007-12-30 Michael Albinus <michael.albinus@gmx.de> * net/dbus.el (dbus-name-owner-changed-handler): Make the function - resistent towards wrong parameters. + resistant towards wrong parameters. (dbus-handle-event): Propagate D-Bus errors only in the debug case. 2007-12-30 Richard Stallman <rms@gnu.org> @@ -5001,7 +5001,7 @@ * vc.el (vc-dired-ignorable-p, vc-dired-hook): Speed optimization; use completion-ignored-extensions to detect files that should be - ignorted in VC-Dired listings, heading off lots of expensive calls + ignored in VC-Dired listings, heading off lots of expensive calls to (vc-state). * vc.el (vc-dired-hook): Show unregistered file status as "?" in diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index 00b6a6ac41b..e9c8a8ff8be 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -10889,7 +10889,7 @@ * menu-bar.el (menu-set-font): New function. Bind "Set Default Font" menu item to it. Apply selected font to all frames, and - make it savable. + make it saveable. (menu-bar-options-save): Save `default' font if changed. 2008-06-10 Stefan Monnier <monnier@iro.umontreal.ca> @@ -13625,7 +13625,7 @@ (completion-emacs22-try-completion): Place cursor after the /, as was done in Emacs-22's minibuffer-complete-word. Fix bug reported by David Hansen <david.hansen@gmx.net>. - (completion-emacs22-try-completion): Merge all mergable text rather + (completion-emacs22-try-completion): Merge all mergeable text rather than just /. (completion-pcm--delim-wild-regex): New var. (completion-pcm-word-delimiters): New custom. diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index e66766eafa5..3a578da4bc7 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -2803,7 +2803,7 @@ 2010-12-29 Karl Fogel <kfogel@red-bean.com> * saveplace.el (save-place-alist-to-file): Save list sorted and - pretty-printed, so that it is mergable by line-based text merging, + pretty-printed, so that it is mergeable by line-based text merging, as suggested by Iain Dalton <iain.dalton {_AT_} gmail.com>. 2010-12-28 Ken Manheimer <ken.manheimer@gmail.com> @@ -5135,10 +5135,10 @@ * progmodes/verilog-mode.el (verilog-directive-re): Make this variable auto-built for efficiency of execution and updating. - (verilog-extended-complete-re): Support 'pure' fucntion & task + (verilog-extended-complete-re): Support 'pure' function & task declarations (these have no bodies). (verilog-beg-of-statement): General cleanup to enable support of - 'pure' fucntion & task declarations (these have no bodies). + 'pure' function & task declarations (these have no bodies). These efforts together fix Verilog bug210 from veripool; which was also noticed by Steve Pearlmutter. (verilog-directive-re, verilog-directive-begin, verilog-indent-re) @@ -10689,7 +10689,7 @@ 2010-05-13 Agustín Martín <agustin.martin@hispalinux.es> * textmodes/ispell.el (ispell-init-process): Do not kill ispell - process everytime when spellchecking from the minibuffer (bug#6143). + process every time when spellchecking from the minibuffer (bug#6143). 2010-05-13 Stefan Monnier <monnier@iro.umontreal.ca> @@ -12100,7 +12100,7 @@ 2010-03-31 Juri Linkov <juri@jurta.org> * image.el (image-animated-p): Use `image-metadata' instead of - `image-extension-data'. Get GIF extenstion data from metadata + `image-extension-data'. Get GIF extension data from metadata property `extension-data'. 2010-03-31 Stefan Monnier <monnier@iro.umontreal.ca> @@ -14907,7 +14907,7 @@ Use complete-with-action rather than pascal-completion-response and let it apply the predicate as well. (pascal-goto-defun): Change buffer before calling pascal-comp-defun - when neded. + when needed. 2009-12-02 Kenichi Handa <handa@m17n.org> @@ -18684,7 +18684,7 @@ 2009-09-24 Vinicius Jose Latorre <viniciusjl@ig.com.br> * whitespace.el: Does not highlight trailing spaces While point is - at end of line. Does not highligt spaces at beginning of buffer + at end of line. Does not highlight spaces at beginning of buffer while point is at beginning of buffer. Does not highlight spaces at end of buffer while point is at end of buffer. (Bug#4177) New version 12.0. diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index b4da88e6346..bb7389c5b71 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -379,7 +379,7 @@ 2013-02-28 Sam Steingold <sds@gnu.org> * vc/diff-mode.el (diff-hunk-file-names): Handle filenames with spaces. - See <http://stackoverflow.com/questions/14720205>. + See <https://stackoverflow.com/questions/14720205>. 2013-02-28 Thierry Volpiatto <thierry.volpiatto@gmail.com> @@ -1326,7 +1326,7 @@ * net/soap-client.el (soap-invoke): Encode the string for `url-request-data' as UTF-8. - Fixes <http://code.google.com/p/emacs-soap-client/issues/detail?id=16>. + Fixes <https://code.google.com/p/emacs-soap-client/issues/detail?id=16>. 2013-02-01 Glenn Morris <rgm@gnu.org> @@ -2462,7 +2462,7 @@ 2012-12-27 Sam Steingold <sds@gnu.org> * progmodes/cperl-mode.el (cperl-calculate-indent): Do not stagger - continuations, see <http://stackoverflow.com/questions/3582436>. + continuations, see <https://stackoverflow.com/questions/3582436>. 2012-12-27 Dmitry Gutov <dgutov@yandex.ru> @@ -3018,7 +3018,7 @@ * progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. (sql-signum): Remove. Use `cl-signum' instead. - (sql-read-passwd): Remove; use read-passwd instread. + (sql-read-passwd): Remove; use read-passwd instead. (sql-get-login-ext): Use read-string. (sql-get-login): Use dolist and pcase. (sql--completion-table): Rename from sql-try-completion. @@ -7833,7 +7833,7 @@ the form for POSITION argument. * term/x-win.el (x-menu-bar-open): - Use the value returend from (posn-at-point) as position + Use the value returned from (posn-at-point) as position passed to `popup-menu'. 2012-08-09 Jay Belanger <jay.p.belanger@gmail.com> @@ -11473,7 +11473,7 @@ (sh-set-shell): Use smie-setup if requested. * term.el (term-set-escape-char): Properly set term-escape-char. - See http://stackoverflow.com/questions/10524656. + See https://stackoverflow.com/questions/10524656. 2012-05-10 Chong Yidong <cyd@gnu.org> @@ -11992,11 +11992,11 @@ * progmodes/verilog-mode.el (verilog-pretty-expr): Don't line up assignment with tests in ifs and for loops. (verilog-extended-complete-re, verilog-complete-reg): Change so - that DPI inport functions don't look like function declarations. + that DPI import functions don't look like function declarations. (verilog-pretty-expr): Don't line up assignment operations to the test and increment in if and for loops (verilog-extended-complete-re, verilog-complete-reg): Change so - that DPI inport functions don't look like function declarations. + that DPI import functions don't look like function declarations. 2012-05-03 Kenichi Handa <handa@m17n.org> @@ -15918,7 +15918,7 @@ Rework verilog-pretty-expr to handle new assignment operators in system verilog, such as += *= and the like. (verilog-assignment-operator-re): Regular expression to find the - assigment operator in a verilog assignment. + assignment operator in a verilog assignment. (verilog-assignment-operation-re): Regular expression to find an assignment statement for pretty-expr. (verilog-in-attribute-p): Query returns true if point is in an @@ -16476,7 +16476,7 @@ (python-pdbtrack-track-stack-file): Adjust to recognize ipdb as well as regular python pdb prompts. Adjustments shamelessly taken exactly as suggested in EmacsWiki page (tiny change): - http://www.emacswiki.org/PythonProgrammingInEmacs#toc14 + https://www.emacswiki.org/PythonProgrammingInEmacs#toc14 2011-11-16 Juanma Barranquero <lekktu@gmail.com> @@ -20442,7 +20442,7 @@ 2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> * net/network-stream.el (open-network-stream): Use the - :end-of-capability command thoughout. + :end-of-capability command throughout. 2011-07-03 Wolfgang Jenkner <wjenkner@inode.at> (tiny change) @@ -21496,7 +21496,7 @@ * net/network-stream.el (open-network-stream): Add the keyword :always-query-capabilities for the case where you want to force a `plain' network connection, but the protocol still requires the - capabilitiy command (i.e., SMTP and EHLO). + capability command (i.e., SMTP and EHLO). * subr.el (process-live-p): Rename from `process-alive-p' for consistency with other `-live-p' functions. @@ -24707,7 +24707,7 @@ * abbrev.el (abbrev-edit-save-to-file, abbrev-edit-save-buffer): New commands. (edit-abbrevs-map): Bind them here. - (write-abbrev-file): New optinal arg VERBOSE. (Bug#5937) + (write-abbrev-file): New optional arg VERBOSE. (Bug#5937) 2011-03-29 Ken Manheimer <ken.manheimer@gmail.com> diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index a1a6363cdca..5789445fcd6 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -6540,8 +6540,8 @@ (newsticker--image-get): New arguments FILENAME and DIRECTORY. Use `url-retrieve' if `newsticker-retrieval-method' is 'intern. (newsticker--image-download-by-wget): New. Use process properties - for storing informations. - (newsticker--image-sentinel): Read informations from process properties. + for storing information. + (newsticker--image-sentinel): Read information from process properties. (newsticker--image-save) (newsticker--image-remove) (newsticker--image-download-by-url) @@ -8465,7 +8465,7 @@ 2014-07-28 Glenn Morris <rgm@gnu.org> * files.el (toggle-read-only): Re-add basic doc-string. - * vc/vc-hooks.el (vc-toggle-read-only): Tweak obsolescence mesage. + * vc/vc-hooks.el (vc-toggle-read-only): Tweak obsolescence message. * progmodes/prolog.el (prolog-mode-keybindings-edit): Replace missing `switch-to-prolog' with `run-prolog'. @@ -14399,7 +14399,7 @@ 2014-01-05 Martin Rudalics <rudalics@gmx.at> - * window.el (balance-windows): Add mising t to fix Bug#16351. + * window.el (balance-windows): Add missing t to fix Bug#16351. 2014-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -15098,7 +15098,7 @@ 2013-12-18 Juri Linkov <juri@jurta.org> * help-mode.el (help-mode-map): Bind "l" to help-go-back, - and "r" to help-go-forward for compatibity with Info. (Bug#16178) + and "r" to help-go-forward for compatibility with Info. (Bug#16178) 2013-12-18 Leo Liu <sdl.web@gmail.com> @@ -15729,7 +15729,7 @@ (flymake-get-temp-dir): Remove. (flymake-popup-menu, flymake-nop, flymake-make-xemacs-menu) (flymake-current-row, flymake-selected-frame) - (flymake-get-point-pixel-pos): Remove xemacs compatibity and + (flymake-get-point-pixel-pos): Remove xemacs compatibility and related functions. (Bug#16077) 2013-12-07 Bozhidar Batsov <bozhidar@batsov.com> @@ -16822,7 +16822,7 @@ * emacs-lisp/byte-run.el (defmacro, defun): Set their `indent' property. * electric.el (electric-indent-post-self-insert-function): - Only delete trailing whitepsace if it is indeed trailing (bug#15767). + Only delete trailing whitespace if it is indeed trailing (bug#15767). 2013-11-04 Helmut Eller <eller.helmut@gmail.com> @@ -17770,7 +17770,7 @@ 2013-10-13 Kenichi Handa <handa@gnu.org> * international/mule-cmds.el (select-safe-coding-system): Remove a - superfluous condition in chekcing whether a coding system is safe + superfluous condition in checking whether a coding system is safe or not. 2013-10-13 Oleh Krehel <ohwoeowho@gmail.com> @@ -23495,7 +23495,7 @@ * progmodes/cc-defs.el (c-set-region-active, c-beginning-of-defun-1) * progmodes/cc-mode.el (c-make-inherited-keymap): Use plain fboundp. * progmodes/cc-defs.el (zmacs-region-stays, zmacs-regions) - (lookup-syntax-properties): Remove unecessary cc-bytecomp-defvar. + (lookup-syntax-properties): Remove unnecessary cc-bytecomp-defvar. * progmodes/cc-vars.el (other): Emacs has this widget since at least 21.1, so don't (re)define it. @@ -23951,7 +23951,7 @@ * simple.el (shell-command-on-region): Pass the `replace' argument down to `call-process-region' to comply with the doc as reported on - <http://stackoverflow.com/questions/16720458/emacs-noninteractive-call-to-shell-command-on-region-always-deletes-region> + <https://stackoverflow.com/questions/16720458/emacs-noninteractive-call-to-shell-command-on-region-always-deletes-region> 2013-05-23 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3 index 79bdbfd6660..ef0e423d145 100644 --- a/lisp/ChangeLog.3 +++ b/lisp/ChangeLog.3 @@ -6958,7 +6958,7 @@ 1991-10-04 Roland McGrath (roland@albert.gnu.ai.mit.edu) * rmail.el: Changed two regexps not to look specifically for 19yy - for years; look for yyyy instead. Planning for the millenium. + for years; look for yyyy instead. Planning for the millennium. 1991-10-03 Roland McGrath (roland@albert.gnu.ai.mit.edu) diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6 index 3fe6aea3b8e..87ae38b27e6 100644 --- a/lisp/ChangeLog.6 +++ b/lisp/ChangeLog.6 @@ -6742,7 +6742,7 @@ quoted tab into a space. (sh-mode): Use new `skeleton-newline-indent-rigidly'. (sh-set-shell): Make maximum font-locking also highlight keywords - after ``' and `!'. (The latter is for ksh '93 but should't hurt other + after ``' and `!'. (The latter is for ksh '93 but shouldn't hurt other shells.) 1995-08-18 Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de> diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index a0d42500e36..58a7fa402ba 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -5774,7 +5774,7 @@ 1998-03-06 Dave Love <d.love@dl.ac.uk> - * browse-url.el: Various doc fixes, mainly to remove innappropriate + * browse-url.el: Various doc fixes, mainly to remove inappropriate leading "*"s. (browse-url-new-window-p, browse-url-netscape-display) (browse-url-save-file, browse-url-generic-program): @@ -10843,7 +10843,7 @@ 1997-09-06 Michael Kifer <kifer@cs.sunysb.edu> * ediff-ptch.el (ediff-patch-buffer-internal): - now behaves uniformely, whether the buffer + now behaves uniformly, whether the buffer visits a file or not. * ediff-util.el (ediff-other-buffer): Smarter selection of suitable other buffer. @@ -11291,7 +11291,7 @@ the various new variables mentioned above. Accept the `a' key to use all selected citations. (reftex-insert-bib-matches): New function. - (reftex-format-citation): Now interpretes % escapes. + (reftex-format-citation): Now interprets % escapes. (reftex-select-item): Emulate a search in the menu buffer. Interpret the 'cnt text property. (reftex-view-crossref): Allow more general label, cite and ref macros. diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8 index 5c55597ddcf..e9b2138e4ba 100644 --- a/lisp/ChangeLog.8 +++ b/lisp/ChangeLog.8 @@ -7002,7 +7002,7 @@ 1999-01-13 Eli Zaretskii <eliz@gnu.org> * international/codepage.el (cp850-decode-table): Replace nil - entries with codes of similary looking glyphs. ( + entries with codes of similarly looking glyphs. ( Suggested by Jason Rumney <jasonr@altavista.net>.) 1999-01-13 Dave Love <fx@gnu.org> @@ -7469,7 +7469,7 @@ (cperl-forward-re): Highlight the trailing / in s/foo// as string. Highlight the starting // in s//foo/ as function-name. Emit a meaningful error instead of a cryptic one for an - uncomplete REx near end-of-buffer. + incomplete REx near end-of-buffer. (cperl-electric-keyword): `qr' recognized. (cperl-electric-else): Likewise. diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index c6bfb1babd9..5372b242f5f 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -237,8 +237,8 @@ After 4.28: (cperl-forward-re): Throw an error at proper moment REx unfinished. After 4.29: - (x-color-defined-p): Make an extra case to peacify the warning. - Toplevel: `defvar' to peacify the warnings. + (x-color-defined-p): Make an extra case to pacify the warning. + Toplevel: `defvar' to pacify the warnings. (cperl-find-pods-heres): Could access `font-lock-comment-face' in -nw. No -nw-compile time warnings now. (cperl-find-tags): TAGS file had too short substring-to-search. @@ -1183,7 +1183,7 @@ 2001-09-07 Gerd Moellmann <gerd@gnu.org> * isearch.el (isearch-intersects-p): New function. - (isearch-close-unnecessary-overlays): Rename from *unecessary*, + (isearch-close-unnecessary-overlays): Rename from *unnecessary*, use isearch-intersects-p, and clean up. 2001-09-07 Eli Zaretskii <eliz@is.elta.co.il> @@ -12432,7 +12432,7 @@ is not reached. It is. (vc-cvs-merge): Set state to 'edited after merge. (vc-cvs-merge-news): Set workfile version to nil if not known. - (vc-cvs-latest-on-branch-p): Recommented. Candidate for removal. + (vc-cvs-latest-on-branch-p): Recommended. Candidate for removal. * vc-cvs.el, vc-rcs.el, vc-sccs.el (vc-*-checkout): Switch off coding systems for checkout via stdout. (Merge from main line.) @@ -13371,7 +13371,7 @@ if defined. (Merged from main line, slightly adapted.) * vc-cvs.el (vc-cvs-annotate-difference): Handle possible - millenium problem (merged from mainline). + millennium problem (merged from mainline). 2000-09-04 Martin Lorentzson <martinl@gnu.org> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 84c5733918a..7c86e89ca99 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -524,4 +524,10 @@ $(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \ $(lisp)/progmodes/cc-align.elc +# https://debbugs.gnu.org/43037 +# js.elc (like all modes using CC Mode's compile time macros) needs to +# be compiled under the same version of CC Mode it will run with. +$(lisp)/progmodes/js.elc: $(lisp)/progmodes/cc-defs.elc \ + $(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-mode.elc + # Makefile ends here. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index be6f9ee3437..f35c637eed5 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -189,17 +189,21 @@ the ones defined from the buffer now." (table (read buf)) abbrevs name hook exp count sys) (forward-line 1) - (while (progn (forward-line 1) - (not (eolp))) - (setq name (read buf) count (read buf)) - (if (equal count '(sys)) - (setq sys t count (read buf)) - (setq sys nil)) - (setq exp (read buf)) - (skip-chars-backward " \t\n\f") - (setq hook (if (not (eolp)) (read buf))) - (skip-chars-backward " \t\n\f") - (setq abbrevs (cons (list name exp hook count sys) abbrevs))) + (while (and (not (eobp)) + ;; Advance as long as we're looking at blank lines + ;; or we have an abbrev. + (looking-at "[ \t\n]\\|\\(\"\\)")) + (when (match-string 1) + (setq name (read buf) count (read buf)) + (if (equal count '(sys)) + (setq sys t count (read buf)) + (setq sys nil)) + (setq exp (read buf)) + (skip-chars-backward " \t\n\f") + (setq hook (if (not (eolp)) (read buf))) + (skip-chars-backward " \t\n\f") + (setq abbrevs (cons (list name exp hook count sys) abbrevs))) + (forward-line 1)) (define-abbrev-table table abbrevs))))) (defun read-abbrev-file (&optional file quietly) @@ -824,6 +828,145 @@ see `define-abbrev' for details." "Function that `expand-abbrev' uses to perform abbrev expansion. Takes no argument and should return the abbrev symbol if expansion took place.") +(defcustom abbrev-suggest nil + "Non-nil means suggest using abbrevs to save typing. +When abbrev mode is active and this option is non-nil, Emacs will +suggest in the echo area to use an existing abbrev if doing so +will save enough typing. See `abbrev-suggest-hint-threshold' for +the definition of \"enough typing\"." + :type 'boolean + :version "28.1") + +(defcustom abbrev-suggest-hint-threshold 3 + "Threshold for when to suggest to use an abbrev to save typing. +The threshold is the amount of typing, in terms of the number of +characters, that would be saved by using the abbrev. The +thinking is that if the expansion is only a few characters +longer than the abbrev, the benefit of informing the user is not +significant. If you always want to be informed about existing +abbrevs for the text you type, set this value to zero or less. +This setting only applies if `abbrev-suggest' is non-nil." + :type 'number + :version "28.1") + +(defun abbrev--suggest-get-active-tables-including-parents () + "Return a list of all active abbrev tables, including parent tables." + (let* ((tables (abbrev--active-tables)) + (all tables)) + (dolist (table tables) + (setq all (append (abbrev-table-get table :parents) all))) + all)) + +(defun abbrev--suggest-get-active-abbrev-expansions () + "Return a list of all the active abbrev expansions. +Includes expansions from parent abbrev tables." + (let (expansions) + (dolist (table (abbrev--suggest-get-active-tables-including-parents)) + (mapatoms (lambda (e) + (let ((value (symbol-value (abbrev--symbol e table)))) + (when value + (push (cons value (symbol-name e)) expansions)))) + table)) + expansions)) + +(defun abbrev--suggest-count-words (expansion) + "Return the number of words in EXPANSION. +Expansion is a string of one or more words." + (length (split-string expansion " " t))) + +(defun abbrev--suggest-get-previous-words (n) + "Return the N words before point, spaces included." + (let ((end (point))) + (save-excursion + (backward-word n) + (replace-regexp-in-string + "\\s " " " + (buffer-substring-no-properties (point) end))))) + +(defun abbrev--suggest-above-threshold (expansion) + "Return non-nil if the abbrev in EXPANSION provides significant savings. +A significant saving, here, is the difference in length between +the abbrev and the abbrev expansion. EXPANSION is a cons cell +where the car is the expansion and the cdr is the abbrev." + (>= (- (length (car expansion)) + (length (cdr expansion))) + abbrev-suggest-hint-threshold)) + +(defvar abbrev--suggest-saved-recommendations nil + "Keeps a list of expansions that have abbrevs defined. +The user can show this list by calling +`abbrev-suggest-show-report'.") + +(defun abbrev--suggest-inform-user (expansion) + "Display a message to the user about the existing abbrev. +EXPANSION is a cons cell where the `car' is the expansion and the +`cdr' is the abbrev." + (run-with-idle-timer + 1 nil + (lambda () + (message "You can write `%s' using the abbrev `%s'." + (car expansion) (cdr expansion)))) + (push expansion abbrev--suggest-saved-recommendations)) + +(defun abbrev--suggest-shortest-abbrev (new current) + "Return the shortest abbrev of NEW and CURRENT. +NEW and CURRENT are cons cells where the `car' is the expansion +and the `cdr' is the abbrev." + (if (not current) + new + (if (< (length (cdr new)) + (length (cdr current))) + new + current))) + +(defun abbrev--suggest-maybe-suggest () + "Suggest an abbrev to the user based on the word(s) before point. +Uses `abbrev-suggest-hint-threshold' to find out if the user should be +informed about the existing abbrev." + (let (words abbrev-found word-count) + (dolist (expansion (abbrev--suggest-get-active-abbrev-expansions)) + (setq word-count (abbrev--suggest-count-words (car expansion)) + words (abbrev--suggest-get-previous-words word-count)) + (let ((case-fold-search t)) + (when (and (> word-count 0) + (string-match (car expansion) words) + (abbrev--suggest-above-threshold expansion)) + (setq abbrev-found (abbrev--suggest-shortest-abbrev + expansion abbrev-found))))) + (when abbrev-found + (abbrev--suggest-inform-user abbrev-found)))) + +(defun abbrev--suggest-get-totals () + "Return a list of all expansions and how many times they were used. +Each expansion is a cons cell where the `car' is the expansion +and the `cdr' is the number of times the expansion has been +typed." + (let (total cell) + (dolist (expansion abbrev--suggest-saved-recommendations) + (if (not (assoc (car expansion) total)) + (push (cons (car expansion) 1) total) + (setq cell (assoc (car expansion) total)) + (setcdr cell (1+ (cdr cell))))) + total)) + +(defun abbrev-suggest-show-report () + "Show a buffer with the list of abbrevs you could have used. +This shows the abbrevs you've \"missed\" because you typed the +full text instead of the abbrevs that expand into that text." + (interactive) + (let ((totals (abbrev--suggest-get-totals)) + (buf (get-buffer-create "*abbrev-suggest*"))) + (set-buffer buf) + (erase-buffer) + (insert "** Abbrev expansion usage ** + +Below is a list of expansions for which abbrevs are defined, and +the number of times the expansion was typed manually. To display +and edit all abbrevs, type `M-x edit-abbrevs RET'\n\n") + (dolist (expansion totals) + (insert (format " %s: %d\n" (car expansion) (cdr expansion)))) + (display-buffer buf))) + (defun expand-abbrev () "Expand the abbrev before point, if there is an abbrev there. Effective when explicitly called even when `abbrev-mode' is nil. @@ -831,7 +974,9 @@ Calls the value of `abbrev-expand-function' with no argument to do the work, and returns whatever it does. (That return value should be the abbrev symbol if expansion occurred, else nil.)" (interactive) - (funcall abbrev-expand-function)) + (or (funcall abbrev-expand-function) + (if abbrev-suggest + (abbrev--suggest-maybe-suggest)))) (defun abbrev--default-expand () "Default function to use for `abbrev-expand-function'. diff --git a/lisp/align.el b/lisp/align.el index 61387b23dc7..e3bdf77002e 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -389,7 +389,7 @@ The possible settings for `align-region-separate' are: (regexp . "\\(^\\s-+[^( \t\n]\\|(\\(\\S-+\\)\\s-+\\)\\S-+\\(\\s-+\\)") (group . 3) (modes . align-lisp-modes) - (run-if . ,(function (lambda () current-prefix-arg)))) + (run-if . ,(lambda () current-prefix-arg))) (lisp-alist-dot (regexp . "\\(\\s-*\\)\\.\\(\\s-*\\)") @@ -463,7 +463,7 @@ The possible settings for `align-region-separate' are: (regexp . ",\\(\\s-*\\)[^/ \t\n]") (repeat . t) (modes . align-c++-modes) - (run-if . ,(function (lambda () current-prefix-arg)))) + (run-if . ,(lambda () current-prefix-arg))) ; (valid ; . ,(function ; (lambda () @@ -480,7 +480,7 @@ The possible settings for `align-region-separate' are: (regexp . ",\\(\\s-*\\)[^# \t\n]") (repeat . t) (modes . (append align-perl-modes '(python-mode))) - (run-if . ,(function (lambda () current-prefix-arg)))) + (run-if . ,(lambda () current-prefix-arg))) (c++-comment (regexp . "\\(\\s-*\\)\\(//.*\\|/\\*.*\\*/\\s-*\\)$") diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 03fc3e2f0e1..ac49d3bf068 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -209,21 +209,6 @@ See `allout-widgets-mode' for allout widgets mode features." :group 'allout-widgets) (make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil "28.1") ;;;_ . Developer -;;;_ = allout-widgets-run-unit-tests-on-load -(defcustom allout-widgets-run-unit-tests-on-load nil - "When non-nil, unit tests will be run at end of loading allout-widgets. - -Generally, allout widgets code developers are the only ones who'll want to -set this. - -\(If set, this makes it an even better practice to exercise changes by -doing byte-compilation with a repeat count, so the file is loaded after -compilation.) - -See `allout-widgets-run-unit-tests' to see what's run." - :version "24.1" - :type 'boolean - :group 'allout-widgets-developer) ;;;_ = allout-widgets-time-decoration-activity (defcustom allout-widgets-time-decoration-activity nil "Retain timing info of the last cooperative redecoration. @@ -1353,64 +1338,6 @@ FROM and TO must be in increasing order, as must be the pairs in RANGES." (setq new-ranges (nreverse new-ranges)) (if ranges (setq new-ranges (append new-ranges ranges))) (list (if included-from t) new-ranges))) -;;;_ > allout-test-range-overlaps () -(defun allout-test-range-overlaps () - "`allout-range-overlaps' unit tests." - (let* (ranges - got - (try (lambda (from to) - (setq got (allout-range-overlaps from to ranges)) - (setq ranges (cadr got)) - got))) -;; ;; biggie: -;; (setq ranges nil) -;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall -;; ;; ~ 13 seconds for doing repeated funcall -;; (message "time-trial: %s, resulting size %s" -;; (time-trial -;; '(let ((size 10000) -;; doing) -;; (dotimes (count size) -;; (setq doing (random size)) -;; (funcall try doing (+ doing (random 5))) -;; ;;(list doing (+ doing (random 5))) -;; ))) -;; (length ranges)) -;; (sit-for 2) - - ;; fresh: - (setq ranges nil) - (cl-assert (equal (funcall try 3 5) '(nil ((3 5))))) - ;; add range at end: - (cl-assert (equal (funcall try 10 12) '(nil ((3 5) (10 12))))) - ;; add range at beginning: - (cl-assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12))))) - ;; insert range somewhere in the middle: - (cl-assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12))))) - ;; consolidate some: - (cl-assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12))))) - ;; add more: - (cl-assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17))))) - ;; add more: - (cl-assert (equal (funcall try 20 22) - '(nil ((1 2) (3 9) (10 12) (15 17) (20 22))))) - ;; encompass more: - (cl-assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22))))) - ;; encompass all: - (cl-assert (equal (funcall try 2 25) '(t ((1 25))))) - - ;; fresh slate: - (setq ranges nil) - (cl-assert (equal (funcall try 20 25) '(nil ((20 25))))) - (cl-assert (equal (funcall try 30 35) '(nil ((20 25) (30 35))))) - (cl-assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35))))) - (cl-assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35))))) - (cl-assert (equal (funcall try 10 30) '(t ((10 35))))) - (cl-assert (equal (funcall try 5 6) '(nil ((5 6) (10 35))))) - (cl-assert (equal (funcall try 2 100) '(t ((2 100))))) - - (setq ranges nil) - )) ;;;_ > allout-widgetize-buffer (&optional doing) (defun allout-widgetize-buffer (&optional doing) "EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree. @@ -2380,18 +2307,6 @@ The elements of LIST are not copied, just the list structure itself." (overlays-in start end))))) (length button-overlays))) -;;;_ : Run unit tests: -(defun allout-widgets-run-unit-tests () - (message "Running allout-widget tests...") - - (allout-test-range-overlaps) - - (message "Running allout-widget tests... Done.") - (sit-for .5)) - -(when allout-widgets-run-unit-tests-on-load - (allout-widgets-run-unit-tests)) - ;;;_ : provide (provide 'allout-widgets) diff --git a/lisp/allout.el b/lisp/allout.el index 955b7000cbf..b56071de59e 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -77,7 +77,6 @@ ;;;_* Dependency loads (require 'overlay) -(eval-when-compile (require 'cl-lib)) ;;;_* USER CUSTOMIZATION VARIABLES: @@ -246,7 +245,7 @@ prevails." "Allout-mode functions bound to keys without any added prefix. This is in contrast to the majority of allout-mode bindings on -`allout-prefixed-bindings', whose bindings are created with a +`allout-prefixed-keybindings', whose bindings are created with a preceding command key. Use vector format for the keys: @@ -840,20 +839,6 @@ for restoring when all encryptions are established.") (defgroup allout-developer nil "Allout settings developers care about, including topic encryption and more." :group 'allout) -;;;_ = allout-run-unit-tests-on-load -(defcustom allout-run-unit-tests-on-load nil - "When non-nil, unit tests will be run at end of loading the allout module. - -Generally, allout code developers are the only ones who'll want to set this. - -\(If set, this makes it an even better practice to exercise changes by -doing byte-compilation with a repeat count, so the file is loaded after -compilation.) - -See `allout-run-unit-tests' to see what's run." - :type 'boolean - :group 'allout-developer) - ;;;_ + Miscellaneous customization ;;;_ = allout-enable-file-variable-adjustment @@ -1525,7 +1510,7 @@ topic prefix. Entries must be symbols that are bound to the desired regexp values. Encryptions that result in matches will be retried, up to -`allout-encryption-ciphertext-rejection-limit' times, after which +`allout-encryption-ciphertext-rejection-ceiling' times, after which an error is raised.") (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps) @@ -4736,7 +4721,7 @@ this function." This is a way to give restricted peek at a concealed locality without the expense of exposing its context, but can leave the outline with aberrant -exposure. `allout-show-offshoot' should be used after the peek to rectify +exposure. `allout-show-to-offshoot' should be used after the peek to rectify the exposure." (interactive) @@ -6518,136 +6503,7 @@ If BEG is bigger than END we return 0." (isearch-repeat 'forward) (isearch-mode t))) -;;;_ #11 Unit tests -- this should be last item before "Provide" -;;;_ > allout-run-unit-tests () -(defun allout-run-unit-tests () - "Run the various allout unit tests." - (message "Running allout tests...") - (allout-test-resumptions) - (message "Running allout tests... Done.") - (sit-for .5)) -;;;_ : test resumptions: -;;;_ > allout-tests-obliterate-variable (name) -(defun allout-tests-obliterate-variable (name) - "Completely unbind variable with NAME." - (if (local-variable-p name (current-buffer)) (kill-local-variable name)) - (while (boundp name) (makunbound name))) -;;;_ > allout-test-resumptions () -(defvar allout-tests-globally-unbound nil - "Fodder for allout resumptions tests -- defvar just for byte compiler.") -(defvar allout-tests-globally-true nil - "Fodder for allout resumptions tests -- defvar just for byte compiler.") -(defvar allout-tests-locally-true nil - "Fodder for allout resumptions tests -- defvar just for byte compiler.") -(defun allout-test-resumptions () - ;; FIXME: Use ERT. - "Exercise allout resumptions." - ;; for each resumption case, we also test that the right local/global - ;; scopes are affected during resumption effects: - - ;; ensure that previously unbound variables return to the unbound state. - (with-temp-buffer - (allout-tests-obliterate-variable 'allout-tests-globally-unbound) - (allout-add-resumptions '(allout-tests-globally-unbound t)) - (cl-assert (not (default-boundp 'allout-tests-globally-unbound))) - (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) - (cl-assert (boundp 'allout-tests-globally-unbound)) - (cl-assert (equal allout-tests-globally-unbound t)) - (allout-do-resumptions) - (cl-assert (not (local-variable-p 'allout-tests-globally-unbound - (current-buffer)))) - (cl-assert (not (boundp 'allout-tests-globally-unbound)))) - - ;; ensure that variable with prior global value is resumed - (with-temp-buffer - (allout-tests-obliterate-variable 'allout-tests-globally-true) - (setq allout-tests-globally-true t) - (allout-add-resumptions '(allout-tests-globally-true nil)) - (cl-assert (equal (default-value 'allout-tests-globally-true) t)) - (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer))) - (cl-assert (equal allout-tests-globally-true nil)) - (allout-do-resumptions) - (cl-assert (not (local-variable-p 'allout-tests-globally-true - (current-buffer)))) - (cl-assert (boundp 'allout-tests-globally-true)) - (cl-assert (equal allout-tests-globally-true t))) - - ;; ensure that prior local value is resumed - (with-temp-buffer - (allout-tests-obliterate-variable 'allout-tests-locally-true) - (set (make-local-variable 'allout-tests-locally-true) t) - (cl-assert (not (default-boundp 'allout-tests-locally-true)) - nil (concat "Test setup mistake -- variable supposed to" - " not have global binding, but it does.")) - (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)) - nil (concat "Test setup mistake -- variable supposed to have" - " local binding, but it lacks one.")) - (allout-add-resumptions '(allout-tests-locally-true nil)) - (cl-assert (not (default-boundp 'allout-tests-locally-true))) - (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (cl-assert (equal allout-tests-locally-true nil)) - (allout-do-resumptions) - (cl-assert (boundp 'allout-tests-locally-true)) - (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (cl-assert (equal allout-tests-locally-true t)) - (cl-assert (not (default-boundp 'allout-tests-locally-true)))) - - ;; ensure that last of multiple resumptions holds, for various scopes. - (with-temp-buffer - (allout-tests-obliterate-variable 'allout-tests-globally-unbound) - (allout-tests-obliterate-variable 'allout-tests-globally-true) - (setq allout-tests-globally-true t) - (allout-tests-obliterate-variable 'allout-tests-locally-true) - (set (make-local-variable 'allout-tests-locally-true) t) - (allout-add-resumptions '(allout-tests-globally-unbound t) - '(allout-tests-globally-true nil) - '(allout-tests-locally-true nil)) - (allout-add-resumptions '(allout-tests-globally-unbound 2) - '(allout-tests-globally-true 3) - '(allout-tests-locally-true 4)) - ;; reestablish many of the basic conditions are maintained after re-add: - (cl-assert (not (default-boundp 'allout-tests-globally-unbound))) - (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) - (cl-assert (equal allout-tests-globally-unbound 2)) - (cl-assert (default-boundp 'allout-tests-globally-true)) - (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer))) - (cl-assert (equal allout-tests-globally-true 3)) - (cl-assert (not (default-boundp 'allout-tests-locally-true))) - (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (cl-assert (equal allout-tests-locally-true 4)) - (allout-do-resumptions) - (cl-assert (not (local-variable-p 'allout-tests-globally-unbound - (current-buffer)))) - (cl-assert (not (boundp 'allout-tests-globally-unbound))) - (cl-assert (not (local-variable-p 'allout-tests-globally-true - (current-buffer)))) - (cl-assert (boundp 'allout-tests-globally-true)) - (cl-assert (equal allout-tests-globally-true t)) - (cl-assert (boundp 'allout-tests-locally-true)) - (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (cl-assert (equal allout-tests-locally-true t)) - (cl-assert (not (default-boundp 'allout-tests-locally-true)))) - - ;; ensure that deliberately unbinding registered variables doesn't foul things - (with-temp-buffer - (allout-tests-obliterate-variable 'allout-tests-globally-unbound) - (allout-tests-obliterate-variable 'allout-tests-globally-true) - (setq allout-tests-globally-true t) - (allout-tests-obliterate-variable 'allout-tests-locally-true) - (set (make-local-variable 'allout-tests-locally-true) t) - (allout-add-resumptions '(allout-tests-globally-unbound t) - '(allout-tests-globally-true nil) - '(allout-tests-locally-true nil)) - (allout-tests-obliterate-variable 'allout-tests-globally-unbound) - (allout-tests-obliterate-variable 'allout-tests-globally-true) - (allout-tests-obliterate-variable 'allout-tests-locally-true) - (allout-do-resumptions)) - ) -;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true: -(when allout-run-unit-tests-on-load - (allout-run-unit-tests)) - -;;;_ #12 Provide +;;;_ #11 Provide (provide 'allout) ;;;_* Local emacs vars. diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 4130f5aad3c..d20260b185c 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -39,7 +39,7 @@ ;; ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 ;; standard (identical to ISO/IEC 6429), which is freely available as a -;; PDF file <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>. +;; PDF file <URL:https://www.ecma-international.org/publications/standards/Ecma-048.htm>. ;; The "Graphic Rendition Combination Mode (GRCM)" implemented is ;; "cumulative mode" as defined in section 7.2.8. Cumulative mode ;; means that whenever possible, SGR control sequences are combined @@ -84,7 +84,7 @@ This translation effectively colorizes strings and regions based upon SGR control sequences embedded in the text. SGR (Select Graphic Rendition) control sequences are defined in section 8.3.117 of the ECMA-48 standard (identical to ISO/IEC 6429), which is freely available -at <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm> +at <URL:https://www.ecma-international.org/publications/standards/Ecma-048.htm> as a PDF file." :version "21.1" :group 'processes) @@ -414,11 +414,17 @@ this." ;; if the rest of the region should have a face, put it there (funcall ansi-color-apply-face-function start-marker end-marker (ansi-color--find-face codes)) - (setq ansi-color-context-region (if codes (list codes))))) + ;; Save a restart position when there are codes active. It's + ;; convenient for man.el's process filter to pass `begin' + ;; positions that overlap regions previously colored; these + ;; `codes' should not be applied to that overlap, so we need + ;; to know where they should really start. + (setq ansi-color-context-region (if codes (list codes end-marker))))) ;; Clean up our temporary markers. (unless (eq start-marker (cadr ansi-color-context-region)) (set-marker start-marker nil)) - (set-marker end-marker nil))) + (unless (eq end-marker (cadr ansi-color-context-region)) + (set-marker end-marker nil)))) (defun ansi-color-apply-overlay-face (beg end face) "Make an overlay from BEG to END, and apply face FACE. @@ -536,7 +542,7 @@ codes. Finally, the so changed list of codes is returned." (cons new (remq new codes)))) (2 (unless (memq new '(20 26 28 29)) ;; The standard says `21 doubly underlined' while - ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims + ;; https://en.wikipedia.org/wiki/ANSI_escape_code claims ;; `21 Bright/Bold: off or Underline: Double'. (remq (- new 20) (pcase new (22 (remq 1 codes)) diff --git a/lisp/apropos.el b/lisp/apropos.el index 6d8c7847b02..e7e8955afe8 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -863,14 +863,12 @@ Optional arg BUFFER (default: current buffer) is the buffer to check." (setq apropos-accumulator (cons (list symb (apropos-score-str var) nil var) apropos-accumulator)))))) (let ((apropos-multi-type nil)) - (if (> emacs-major-version 20) - (apropos-print - nil "\n----------------\n" - (format "Buffer `%s' has the following local variables\nmatching %s`%s':" - (buffer-name buffer) - (if (consp pattern) "keywords " "") - pattern)) - (apropos-print nil "\n----------------\n")))) + (apropos-print + nil "\n----------------\n" + (format "Buffer `%s' has the following local variables\nmatching %s`%s':" + (buffer-name buffer) + (if (consp pattern) "keywords " "") + pattern)))) ;;;###autoload (defun apropos-documentation (pattern &optional do-all) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index ae85fc55add..ce0c061fc09 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -41,8 +41,7 @@ ;; changes will first take effect when the archive buffer ;; is saved. You will be warned about this. ;; -;; * dos-fns.el: (Part of Emacs 19). You get automatic ^M^J <--> ^J -;; conversion. +;; * dos-fns.el: You get automatic ^M^J <--> ^J conversion. ;; ;; arc-mode.el does not work well with crypt++.el; for the archives as ;; such this could be fixed (but wouldn't be useful) by declaring such @@ -52,17 +51,17 @@ ;; ARCHIVE TYPES: Currently only the archives below are handled, but the ;; structure for handling just about anything is in place. ;; -;; Arc Lzh Zip Zoo Rar 7z Ar -;; -------------------------------------------------- -;; View listing Intern Intern Intern Intern Y Y Y -;; Extract member Y Y Y Y Y Y Y -;; Save changed member Y Y Y Y N Y Y -;; Add new member N N N N N N N -;; Delete member Y Y Y Y N Y N -;; Rename member Y Y N N N N N -;; Chmod - Y Y - N N N -;; Chown - Y - - N N N -;; Chgrp - Y - - N N N +;; Arc Lzh Zip Zoo Rar 7z Ar Squashfs +;; --------------------------------------------------------------- +;; View listing Intern Intern Intern Intern Y Y Y Y +;; Extract member Y Y Y Y Y Y Y Y +;; Save changed member Y Y Y Y N Y Y N +;; Add new member N N N N N N N N +;; Delete member Y Y Y Y N Y N N +;; Rename member Y Y N N N N N N +;; Chmod - Y Y - N N N N +;; Chown - Y - - N N N N +;; Chgrp - Y - - N N N N ;; ;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips ;; on the first released version of this package. @@ -371,6 +370,24 @@ file. Archive and member name will be added." :inline t (string :format "%v")))) +;; ------------------------------ +;; Squashfs archive configuration + +(defgroup archive-squashfs nil + "Squashfs-specific options to archive." + :group 'archive) + +(defcustom archive-squashfs-extract '("rdsquashfs" "-c") + "Program and its options to run in order to extract a squashsfs file member. +Extraction should happen to standard output. Archive and member name will +be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :version "28.1" + :group 'archive-squashfs) + ;; ------------------------------------------------------------------------- ;;; Section: Variables @@ -742,6 +759,7 @@ archive. (re-search-forward "Rar!" (+ (point) 100000) t)) 'rar-exe) ((looking-at "7z\274\257\047\034") '7z) + ((looking-at "hsqs") 'squashfs) (t (error "Buffer format not recognized"))))) ;; ------------------------------------------------------------------------- @@ -1920,10 +1938,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (search-backward-regexp "[P]K\005\006") (let ((p (archive-l-e (+ (point) 16) 4)) files) - (when (= p -1) - ;; If the offset of end-of-central-directory is -1, this is a - ;; Zip64 extended ZIP file format, and we need to glean the info - ;; from Zip64 records instead. + (when (or (= p #xffffffff) (= p -1)) + ;; If the offset of end-of-central-directory is 0xFFFFFFFF, this + ;; is a Zip64 extended ZIP file format, and we need to glean the + ;; info from Zip64 records instead. ;; ;; First, find the Zip64 end-of-central-directory locator. (search-backward "PK\006\007") @@ -1949,6 +1967,15 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen)))) (decode-coding-string str archive-file-name-coding-system))) + (ucsize (if (and (or (= ucsize #xffffffff) (= ucsize -1)) + (> exlen 0)) + ;; APPNOTE.TXT, para 4.5.3: the Extra Field + ;; begins with 2 bytes of signature + ;; (\000\001), followed by 2 bytes that give + ;; the size of the extra block, followed by + ;; an 8-byte uncompressed size. + (archive-l-e (+ p 46 fnlen 4) 8) + ucsize)) (isdir (and (= ucsize 0) (string= (file-name-nondirectory efnname) ""))) (mode (cond ((memq creator '(2 3)) ; Unix @@ -2272,6 +2299,85 @@ NAME is expected to be the 16-bytes part of an ar record." descr '("ar" "r"))) +;; ------------------------------------------------------------------------- +;;; Section Squashfs archives. + +(defun archive-squashfs-summarize (&optional file) + (unless file + (setq file buffer-file-name)) + (let ((copy (file-local-copy file)) + (files ())) + (with-temp-buffer + (call-process "unsquashfs" nil t nil "-ll" (or file copy)) + (when copy + (delete-file copy)) + (goto-char (point-min)) + (search-forward-regexp "[drwxl\\-]\\{10\\}") + (beginning-of-line) + (while (looking-at (concat + "^\\(.[rwx\\-]\\{9\\}\\) " ;Mode + "\\(.+\\)/\\(.+\\) " ;user/group + "\\(.+\\) " ;size + "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\) " ;date + "\\([0-9]\\{2\\}:[0-9]\\{2\\}\\) " ;time + "\\(.+\\)\n")) ;Filename + (let* ((name (match-string 7)) + (flags (match-string 1)) + (uid (match-string 2)) + (gid (match-string 3)) + (size (string-to-number (match-string 4))) + (date (match-string 5)) + (time (match-string 6)) + (date-time) + (mode)) + ;; Only list directory and regular files + (when (or (eq (aref flags 0) ?d) + (eq (aref flags 0) ?-)) + (when (equal name "squashfs-root") + (setf name "/")) + ;; Remove 'squashfs-root/' from filenames. + (setq name (string-replace "squashfs-root/" "" name)) + (setq date-time (concat date " " time)) + (setq mode (logior + (cond + ((eq (aref flags 0) ?d) #o40000) + (t 0)) + ;; Convert symbolic to octal representation. + (file-modes-symbolic-to-number + (concat + "u=" (string-replace "-" "" (substring flags 1 4)) + ",g=" (string-replace "-" "" (substring flags 4 7)) + ",o=" (string-replace "-" "" + (substring flags 7 10)))))) + (push (archive--file-desc name name mode size + date-time :uid uid :gid gid) + files))) + (goto-char (match-end 0)))) + (archive--summarize-descs (nreverse files)))) + +(defun archive-squashfs-extract-by-stdout (archive name command + &optional stderr-test) + (let ((stderr-file (make-temp-file "arc-stderr"))) + (unwind-protect + (prog1 + (apply #'call-process + (car command) + nil + (if stderr-file (list t stderr-file) t) + nil + (append (cdr command) (list name archive))) + (with-temp-buffer + (insert-file-contents stderr-file) + (goto-char (point-min)) + (when (if (stringp stderr-test) + (not (re-search-forward stderr-test nil t)) + (> (buffer-size) 0)) + (message "%s" (buffer-string))))) + (if (file-exists-p stderr-file) + (delete-file stderr-file))))) + +(defun archive-squashfs-extract (archive name) + (archive-squashfs-extract-by-stdout archive name archive-squashfs-extract)) ;; ------------------------------------------------------------------------- ;; This line was a mistake; it is kept now for compatibility. diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 4af3d631a2c..97986683256 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -315,8 +315,7 @@ The document was typeset with @printindex cp @bye - -@c " (file-name-nondirectory (buffer-file-name)) " ends here\n")) +")) "A list specifying text to insert by default into a new file. Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION). CONDITION may be a regexp that must match the new file's name, or it may be diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 6e08176f5ff..046ea2b5d6a 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -871,6 +871,62 @@ This is an internal function used by Auto-Revert Mode." (restore-buffer-modified-p modified))) (set-visited-file-modtime)) +(defun auto-revert--buffer-candidates () + "Return a prioritized list of buffers to maybe auto-revert. +The differences between this return value and the reference +variable `auto-revert-buffer-list' include: 1) this has more +entries when in global-auto-revert-mode; 2) this prioritizes +buffers not reverted last time due to user interruption. " + (let ((bufs (delq nil + ;; Buffers with remote contents shall be reverted only + ;; if the connection is established already. + (mapcar + (lambda (buf) + (and (buffer-live-p buf) + (with-current-buffer buf + (and + (or (not (file-remote-p default-directory)) + (file-remote-p default-directory nil t)) + buf)))) + (auto-revert--polled-buffers)))) + remaining new) + ;; Partition `bufs' into two halves depending on whether or not + ;; the buffers are in `auto-revert-remaining-buffers'. The two + ;; halves are then re-joined with the "remaining" buffers at the + ;; head of the list. + (dolist (buf auto-revert-remaining-buffers) + (when (memq buf bufs) + (push buf remaining))) + (dolist (buf bufs) + (unless (memq buf remaining) + (push buf new))) + (nreverse (nconc new remaining)))) + +(defun auto-revert-buffer (buf) + "Revert a single buffer. + +This is performed as specified by Auto-Revert and Global +Auto-Revert Modes." + (if (not (buffer-live-p buf)) + (auto-revert-remove-current-buffer buf) + (with-current-buffer buf + ;; Test if someone has turned off Auto-Revert Mode + ;; in a non-standard way, for example by changing + ;; major mode. + (when (and (not auto-revert-mode) + (not auto-revert-tail-mode)) + (auto-revert-remove-current-buffer)) + (when (auto-revert-active-p) + ;; Enable file notification. + ;; Don't bother creating a notifier for non-file buffers + ;; unless it explicitly indicates that this works. + (when (and auto-revert-use-notify + (not auto-revert-notify-watch-descriptor) + (or buffer-file-name + buffer-auto-revert-by-notification)) + (auto-revert-notify-add-watch)) + (auto-revert-handler))))) + (defun auto-revert-buffers () "Revert buffers as specified by Auto-Revert and Global Auto-Revert Mode. @@ -894,67 +950,19 @@ are checked first the next time this function is called. This function is also responsible for removing buffers no longer in Auto-Revert Mode from `auto-revert-buffer-list', and for canceling the timer when no buffers need to be checked." - (save-match-data - (let ((bufs (auto-revert--polled-buffers)) - remaining new) - ;; Buffers with remote contents shall be reverted only if the - ;; connection is established already. - (setq bufs (delq nil - (mapcar - (lambda (buf) - (and (buffer-live-p buf) - (with-current-buffer buf - (and - (or (not (file-remote-p default-directory)) - (file-remote-p default-directory nil t)) - buf)))) - bufs))) - ;; Partition `bufs' into two halves depending on whether or not - ;; the buffers are in `auto-revert-remaining-buffers'. The two - ;; halves are then re-joined with the "remaining" buffers at the - ;; head of the list. - (dolist (buf auto-revert-remaining-buffers) - (if (memq buf bufs) - (push buf remaining))) - (dolist (buf bufs) - (if (not (memq buf remaining)) - (push buf new))) - (setq bufs (nreverse (nconc new remaining))) + (let ((bufs (auto-revert--buffer-candidates))) (while (and bufs (not (and auto-revert-stop-on-user-input (input-pending-p)))) - (let ((buf (car bufs))) - (if (not (buffer-live-p buf)) - ;; Remove dead buffer from `auto-revert-buffer-list'. - (auto-revert-remove-current-buffer buf) - (with-current-buffer buf - ;; Test if someone has turned off Auto-Revert Mode - ;; in a non-standard way, for example by changing - ;; major mode. - (if (and (not auto-revert-mode) - (not auto-revert-tail-mode) - (memq buf auto-revert-buffer-list)) - (auto-revert-remove-current-buffer)) - (when (auto-revert-active-p) - ;; Enable file notification. - ;; Don't bother creating a notifier for non-file buffers - ;; unless it explicitly indicates that this works. - (when (and auto-revert-use-notify - (not auto-revert-notify-watch-descriptor) - (or buffer-file-name - buffer-auto-revert-by-notification)) - (auto-revert-notify-add-watch)) - (auto-revert-handler))))) - (setq bufs (cdr bufs))) + (auto-revert-buffer (pop bufs))) (setq auto-revert-remaining-buffers bufs) ;; Check if we should cancel the timer. (unless (auto-revert--need-polling-p) - (if (timerp auto-revert-timer) - (cancel-timer auto-revert-timer)) + (when (timerp auto-revert-timer) + (cancel-timer auto-revert-timer)) (setq auto-revert-timer nil))))) - ;; The end: (provide 'autorevert) diff --git a/lisp/bindings.el b/lisp/bindings.el index e3fc5637fab..250234e94c1 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -411,6 +411,8 @@ zero, otherwise they start from one." :type 'boolean :group 'mode-line :version "26.1") +(make-obsolete-variable 'column-number-indicator-zero-based + 'mode-line-position-column-format "28.1") (defcustom mode-line-percent-position '(-3 "%p") "Specification of \"percentage offset\" of window through buffer. @@ -431,6 +433,41 @@ displayed in `mode-line-position', a component of the default :group 'mode-line) (put 'mode-line-percent-position 'risky-local-variable t) +(defcustom mode-line-position-line-format '(" L%l") + "Format used to display line numbers in the mode line. +This is used when `line-number-mode' is switched on. The \"%l\" +format spec will be replaced by the line number." + :type '(list string) + :version "28.1" + :group 'mode-line) + +(defcustom mode-line-position-column-format '(" C%c") + "Format used to display column numbers in the mode line. +This is used when `column-number-mode' is switched on. The +\"%c\" format spec will be replaced by the column number, which +is zero-based if `column-number-indicator-zero-based' is non-nil, +and one-based if `column-number-indicator-zero-based' is nil." + :type '(list string) + :version "28.1" + :group 'mode-line) + +(defcustom mode-line-position-column-line-format '(" (%l,%c)") + "Format used to display combined line/column numbers in the mode line. +This is used when `column-number-mode' and `line-number-mode' are +switched on. The \"%c\" format spec will be replaced by the +column number, which is zero-based if +`column-number-indicator-zero-based' is non-nil, and one-based if +`column-number-indicator-zero-based' is nil." + :type '(list string) + :version "28.1" + :group 'mode-line) + +(defconst mode-line-position--column-line-properties + (list 'local-map mode-line-column-line-number-mode-map + 'mouse-face 'mode-line-highlight + 'help-echo "Line number and Column number\n\ +mouse-1: Display Line and Column Mode Menu")) + (defvar mode-line-position `((:propertize mode-line-percent-position @@ -450,38 +487,30 @@ mouse-1: Display Line and Column Mode Menu"))) (line-number-mode ((column-number-mode (column-number-indicator-zero-based - (10 ,(propertize - " (%l,%c)" - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Line number and Column number\n\ -mouse-1: Display Line and Column Mode Menu")) - (10 ,(propertize - " (%l,%C)" - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Line number and Column number\n\ -mouse-1: Display Line and Column Mode Menu"))) - (6 ,(propertize - " L%l" - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Line Number\n\ -mouse-1: Display Line and Column Mode Menu")))) - ((column-number-mode - (column-number-indicator-zero-based - (5 ,(propertize - " C%c" - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Column number\n\ -mouse-1: Display Line and Column Mode Menu")) - (5 ,(propertize - " C%C" - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Column number\n\ -mouse-1: Display Line and Column Mode Menu"))))))) + (10 + (:propertize + mode-line-position-column-line-format + ,@mode-line-position--column-line-properties)) + (10 + (:propertize + (:eval (string-replace + "%c" "%C" (car mode-line-position-column-line-format))) + ,@mode-line-position--column-line-properties))) + (6 + (:propertize + mode-line-position-line-format + ,@mode-line-position--column-line-properties)))) + (column-number-mode + (column-number-indicator-zero-based + (6 + (:propertize + mode-line-position-column-format + (,@mode-line-position--column-line-properties))) + (6 + (:propertize + (:eval (string-replace + "%c" "%C" (car mode-line-position-column-format))) + ,@mode-line-position--column-line-properties)))))) "Mode line construct for displaying the position in the buffer. Normally displays the buffer percentage and, optionally, the buffer size, the line number and the column number.") @@ -889,6 +918,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key narrow-map "n" 'narrow-to-region) (define-key narrow-map "w" 'widen) +(define-key narrow-map "g" 'goto-line-relative) ;; Quitting (define-key global-map "\e\e\e" 'keyboard-escape-quit) @@ -1383,6 +1413,9 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "'" 'expand-abbrev) (define-key ctl-x-map "\C-b" 'list-buffers) +(define-key ctl-x-map "\C-j" 'dired-jump) +(define-key ctl-x-4-map "\C-j" 'dired-jump-other-window) + (define-key ctl-x-map "z" 'repeat) (define-key esc-map "\C-l" 'reposition-window) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index dcb03adadd8..ab7b04ddfee 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -32,6 +32,7 @@ ;;; Code: (require 'pp) +(require 'tabulated-list) (require 'text-property-search) (eval-when-compile (require 'cl-lib)) @@ -126,16 +127,16 @@ recently set ones come first, oldest ones come last)." (defconst bookmark-bmenu-buffer "*Bookmark List*" "Name of buffer used for Bookmark List.") -(defcustom bookmark-bmenu-use-header-line t +(defvar bookmark-bmenu-use-header-line t "Non-nil means to use an immovable header line. -This is as opposed to inline text at the top of the buffer." - :version "24.4" - :type 'boolean) +This is as opposed to inline text at the top of the buffer.") +(make-obsolete-variable 'bookmark-bmenu-use-header-line "no longer used." "28.1") (defconst bookmark-bmenu-inline-header-height 2 "Number of lines used for the *Bookmark List* header. \(This is only significant when `bookmark-bmenu-use-header-line' is nil.)") +(make-obsolete-variable 'bookmark-bmenu-inline-header-height "no longer used." "28.1") (defconst bookmark-bmenu-marks-width 2 "Number of columns (chars) used for the *Bookmark List* marks column. @@ -165,6 +166,7 @@ A non-nil value may result in truncated bookmark names." "Time before `bookmark-bmenu-search' updates the display." :type 'number) +;; FIXME: No longer used. Should be declared obsolete or removed. (defface bookmark-menu-heading '((t (:inherit font-lock-type-face))) "Face used to highlight the heading in bookmark menu buffers." @@ -976,7 +978,7 @@ Lines beginning with `#' are ignored." (when from-bookmark-list (pop-to-buffer (get-buffer bookmark-bmenu-buffer)) (goto-char (point-min)) - (text-property-search-forward 'bookmark-name-prop bookmark-name)) + (bookmark-bmenu-bookmark)) (kill-buffer old-buffer))) @@ -1587,7 +1589,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (defvar bookmark-bmenu-mode-map (let ((map (make-keymap))) - (set-keymap-parent map special-mode-map) + (set-keymap-parent map tabulated-list-mode-map) (define-key map "v" 'bookmark-bmenu-select) (define-key map "w" 'bookmark-bmenu-locate) (define-key map "5" 'bookmark-bmenu-other-frame) @@ -1607,8 +1609,6 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (define-key map "d" 'bookmark-bmenu-delete) (define-key map "D" 'bookmark-bmenu-delete-all) (define-key map " " 'next-line) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) (define-key map "\177" 'bookmark-bmenu-backup-unmark) (define-key map "u" 'bookmark-bmenu-unmark) (define-key map "U" 'bookmark-bmenu-unmark-all) @@ -1676,6 +1676,30 @@ Don't affect the buffer ring order." (save-window-excursion (bookmark-bmenu-list))))) +(defun bookmark-bmenu--revert () + "Re-populate `tabulated-list-entries'." + (let (entries) + (dolist (full-record (bookmark-maybe-sort-alist)) + (let* ((name (bookmark-name-from-full-record full-record)) + (annotation (bookmark-get-annotation full-record)) + (location (bookmark-location full-record))) + (push (list + full-record + `[,(if (and annotation (not (string-equal annotation ""))) + "*" "") + ,(if (display-mouse-p) + (propertize name + 'font-lock-face 'bookmark-menu-bookmark + 'mouse-face 'highlight + 'follow-link t + 'help-echo "mouse-2: go to this bookmark in other window") + name) + ,@(if bookmark-bmenu-toggle-filenames + (list location))]) + entries))) + (tabulated-list-init-header) + (setq tabulated-list-entries entries)) + (tabulated-list-print t)) ;;;###autoload (defun bookmark-bmenu-get-buffer () @@ -1702,70 +1726,18 @@ deletion, or > if it is flagged for displaying." (if (called-interactively-p 'interactive) (switch-to-buffer buf) (set-buffer buf))) - (let ((inhibit-read-only t)) - (erase-buffer) - (if (not bookmark-bmenu-use-header-line) - (insert "% Bookmark\n- --------\n")) - (add-text-properties (point-min) (point) - '(font-lock-face bookmark-menu-heading)) - (dolist (full-record (bookmark-maybe-sort-alist)) - (let ((name (bookmark-name-from-full-record full-record)) - (annotation (bookmark-get-annotation full-record)) - (start (point)) - end) - ;; if a bookmark has an annotation, prepend a "*" - ;; in the list of bookmarks. - (insert (if (and annotation (not (string-equal annotation ""))) - " *" " ") - name) - (setq end (point)) - (put-text-property - (+ bookmark-bmenu-marks-width start) end 'bookmark-name-prop name) - (when (display-mouse-p) - (add-text-properties - (+ bookmark-bmenu-marks-width start) end - '(font-lock-face bookmark-menu-bookmark - mouse-face highlight - follow-link t - help-echo "mouse-2: go to this bookmark in other window"))) - (insert "\n"))) - (set-buffer-modified-p (not (= bookmark-alist-modification-count 0))) - (goto-char (point-min)) - (bookmark-bmenu-mode) - (if bookmark-bmenu-use-header-line - (bookmark-bmenu-set-header) - (forward-line bookmark-bmenu-inline-header-height)) - (when (and bookmark-alist bookmark-bmenu-toggle-filenames) - (bookmark-bmenu-toggle-filenames t)))) + (bookmark-bmenu-mode) + (bookmark-bmenu--revert)) ;;;###autoload (defalias 'list-bookmarks 'bookmark-bmenu-list) ;;;###autoload (defalias 'edit-bookmarks 'bookmark-bmenu-list) -;; FIXME: This could also display the current default bookmark file -;; according to `bookmark-bookmarks-timestamp'. -(defun bookmark-bmenu-set-header () - "Set the immutable header line." - (let ((header (copy-sequence "%% Bookmark"))) - (when bookmark-bmenu-toggle-filenames - (setq header (concat header - (make-string (- bookmark-bmenu-file-column - (- (length header) 3)) ?\s) - "File"))) - (let ((pos 0)) - (while (string-match "[ \t\n]+" header pos) - (setq pos (match-end 0)) - (put-text-property (match-beginning 0) pos 'display - (list 'space :align-to (- pos 1)) - header))) - (put-text-property 0 2 'face 'fixed-pitch header) - (setq header (concat (propertize " " 'display '(space :align-to 0)) - header)) - ;; Code derived from `buff-menu.el'. - (setq header-line-format header))) - -(define-derived-mode bookmark-bmenu-mode special-mode "Bookmark Menu" +(define-obsolete-function-alias 'bookmark-bmenu-set-header + #'tabulated-list-init-header "28.1") + +(define-derived-mode bookmark-bmenu-mode tabulated-list-mode "Bookmark Menu" "Major mode for editing a list of bookmarks. Each line describes one of the bookmarks in Emacs. Letters do not insert themselves; instead, they are commands. @@ -1804,7 +1776,31 @@ Bookmark names preceded by a \"*\" have annotations. \\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark. \\[bookmark-bmenu-search] -- incrementally search for bookmarks." (setq truncate-lines t) - (setq buffer-read-only t)) + (setq buffer-read-only t) + ;; FIXME: The header could also display the current default bookmark file + ;; according to `bookmark-bookmarks-timestamp'. + (setq tabulated-list-format + `[("" 1) ;; Space to add "*" for bookmark with annotation + ("Bookmark" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate) + ,@(if bookmark-bmenu-toggle-filenames + '(("File" 0 bookmark-bmenu--file-predicate)))]) + (setq tabulated-list-padding bookmark-bmenu-marks-width) + (setq tabulated-list-sort-key '("Bookmark" . nil)) + (add-hook 'tabulated-list-revert-hook #'bookmark-bmenu--revert nil t)' + (setq revert-buffer-function 'bookmark-bmenu--revert) + (tabulated-list-init-header)) + + +(defun bookmark-bmenu--name-predicate (a b) + "Predicate to sort \"*Bookmark List*\" buffer by the name column. +This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." + (string< (caar a) (caar b))) + + +(defun bookmark-bmenu--file-predicate (a b) + "Predicate to sort \"*Bookmark List*\" buffer by the file column. +This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." + (string< (bookmark-location (car a)) (bookmark-location (car b)))) (defun bookmark-bmenu-toggle-filenames (&optional show) @@ -1813,100 +1809,42 @@ Optional argument SHOW means show them unconditionally." (interactive) (cond (show - (setq bookmark-bmenu-toggle-filenames nil) - (bookmark-bmenu-show-filenames) (setq bookmark-bmenu-toggle-filenames t)) (bookmark-bmenu-toggle-filenames - (bookmark-bmenu-hide-filenames) (setq bookmark-bmenu-toggle-filenames nil)) (t - (bookmark-bmenu-show-filenames) (setq bookmark-bmenu-toggle-filenames t))) - (when bookmark-bmenu-use-header-line - (bookmark-bmenu-set-header))) - - -(defun bookmark-bmenu-show-filenames (&optional force) - "In an interactive bookmark list, show filenames along with bookmarks. -Non-nil FORCE forces a redisplay showing the filenames. FORCE is used -mainly for debugging, and should not be necessary in normal use." - (if (and (not force) bookmark-bmenu-toggle-filenames) - nil ;already shown, so do nothing - (with-buffer-modified-unmodified - (save-excursion - (save-window-excursion - (goto-char (point-min)) - (if (not bookmark-bmenu-use-header-line) - (forward-line bookmark-bmenu-inline-header-height)) - (setq bookmark-bmenu-hidden-bookmarks ()) - (let ((inhibit-read-only t)) - (while (< (point) (point-max)) - (let ((bmrk (bookmark-bmenu-bookmark))) - (push bmrk bookmark-bmenu-hidden-bookmarks) - (let ((start (line-end-position))) - (move-to-column bookmark-bmenu-file-column t) - ;; Strip off `mouse-face' from the white spaces region. - (if (display-mouse-p) - (remove-text-properties start (point) - '(mouse-face nil help-echo nil)))) - (delete-region (point) (progn (end-of-line) (point))) - (insert " ") - ;; Pass the NO-HISTORY arg: - (bookmark-insert-location bmrk t) - (forward-line 1))))))))) - - -(defun bookmark-bmenu-hide-filenames (&optional force) - "In an interactive bookmark list, hide the filenames of the bookmarks. -Non-nil FORCE forces a redisplay showing the filenames. FORCE is used -mainly for debugging, and should not be necessary in normal use." - (when (and (not force) bookmark-bmenu-toggle-filenames) - ;; nothing to hide if above is nil - (with-buffer-modified-unmodified - (save-excursion - (goto-char (point-min)) - (if (not bookmark-bmenu-use-header-line) - (forward-line bookmark-bmenu-inline-header-height)) - (setq bookmark-bmenu-hidden-bookmarks - (nreverse bookmark-bmenu-hidden-bookmarks)) - (let ((inhibit-read-only t)) - (while bookmark-bmenu-hidden-bookmarks - (move-to-column bookmark-bmenu-marks-width t) - (bookmark-kill-line) - (let ((name (pop bookmark-bmenu-hidden-bookmarks)) - (start (point))) - (insert name) - (put-text-property start (point) 'bookmark-name-prop name) - (if (display-mouse-p) - (add-text-properties - start (point) - '(font-lock-face bookmark-menu-bookmark - mouse-face highlight - follow-link t help-echo - "mouse-2: go to this bookmark in other window")))) - (forward-line 1))))))) + (bookmark-bmenu-surreptitiously-rebuild-list)) + + +(defun bookmark-bmenu-show-filenames (&optional _) + "In an interactive bookmark list, show filenames along with bookmarks." + (setq bookmark-bmenu-toggle-filenames t) + (bookmark-bmenu-surreptitiously-rebuild-list)) + + +(defun bookmark-bmenu-hide-filenames (&optional _) + "In an interactive bookmark list, hide the filenames of the bookmarks." + (setq bookmark-bmenu-toggle-filenames nil) + (bookmark-bmenu-surreptitiously-rebuild-list)) (defun bookmark-bmenu-ensure-position () "If point is not on a bookmark line, move it to one. -If before the first bookmark line, move to the first; if after the -last full line, move to the last full line. The return value is undefined." - (cond ((and (not bookmark-bmenu-use-header-line) - (< (count-lines (point-min) (point)) - bookmark-bmenu-inline-header-height)) - (goto-char (point-min)) - (forward-line bookmark-bmenu-inline-header-height)) - ((and (bolp) (eobp)) +If after the last full line, move to the last full line. The +return value is undefined." + (cond ((and (bolp) (eobp)) (beginning-of-line 0)))) (defun bookmark-bmenu-bookmark () "Return the bookmark for this line in an interactive bookmark list buffer." (bookmark-bmenu-ensure-position) - (save-excursion - (beginning-of-line) - (forward-char bookmark-bmenu-marks-width) - (get-text-property (point) 'bookmark-name-prop))) + (let* ((id (tabulated-list-get-id)) + (entry (and id (assoc id tabulated-list-entries)))) + (if entry + (caar entry) + ""))) (defun bookmark-show-annotation (bookmark-name-or-record) @@ -1954,14 +1892,8 @@ If the annotation does not exist, do nothing." (defun bookmark-bmenu-mark () "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]." (interactive) - (beginning-of-line) (bookmark-bmenu-ensure-position) - (with-buffer-modified-unmodified - (let ((inhibit-read-only t)) - (delete-char 1) - (insert ?>) - (forward-line 1) - (bookmark-bmenu-ensure-position)))) + (tabulated-list-put-tag ">" t)) (defun bookmark-bmenu-mark-all () @@ -1970,12 +1902,8 @@ If the annotation does not exist, do nothing." (save-excursion (goto-char (point-min)) (bookmark-bmenu-ensure-position) - (with-buffer-modified-unmodified - (let ((inhibit-read-only t)) - (while (not (eobp)) - (delete-char 1) - (insert ?>) - (forward-line 1)))))) + (while (not (eobp)) + (tabulated-list-put-tag ">" t)))) (defun bookmark-bmenu-select () @@ -2126,17 +2054,12 @@ bookmark menu visible." "Cancel all requested operations on bookmark on this line and move down. Optional BACKUP means move up." (interactive "P") - (beginning-of-line) + ;; any flags to reset according to circumstances? How about a + ;; flag indicating whether this bookmark is being visited? + ;; well, we don't have this now, so maybe later. (bookmark-bmenu-ensure-position) - (with-buffer-modified-unmodified - (let ((inhibit-read-only t)) - (delete-char 1) - ;; any flags to reset according to circumstances? How about a - ;; flag indicating whether this bookmark is being visited? - ;; well, we don't have this now, so maybe later. - (insert " ")) - (forward-line (if backup -1 1)) - (bookmark-bmenu-ensure-position))) + (tabulated-list-put-tag " ") + (forward-line (if backup -1 1))) (defun bookmark-bmenu-backup-unmark () @@ -2155,26 +2078,16 @@ Optional BACKUP means move up." (save-excursion (goto-char (point-min)) (bookmark-bmenu-ensure-position) - (with-buffer-modified-unmodified - (let ((inhibit-read-only t)) - (while (not (eobp)) - (delete-char 1) - (insert " ") - (forward-line 1)))))) + (while (not (eobp)) + (tabulated-list-put-tag " " t)))) (defun bookmark-bmenu-delete () "Mark bookmark on this line to be deleted. To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]." (interactive) - (beginning-of-line) (bookmark-bmenu-ensure-position) - (with-buffer-modified-unmodified - (let ((inhibit-read-only t)) - (delete-char 1) - (insert ?D) - (forward-line 1) - (bookmark-bmenu-ensure-position)))) + (tabulated-list-put-tag "D" t)) (defun bookmark-bmenu-delete-backwards () @@ -2182,10 +2095,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]." (interactive) (bookmark-bmenu-delete) - (forward-line -2) - (bookmark-bmenu-ensure-position) - (forward-line 1) - (bookmark-bmenu-ensure-position)) + (forward-line -2)) (defun bookmark-bmenu-delete-all () @@ -2196,12 +2106,8 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ (save-excursion (goto-char (point-min)) (bookmark-bmenu-ensure-position) - (with-buffer-modified-unmodified - (let ((inhibit-read-only t)) - (while (not (eobp)) - (delete-char 1) - (insert ?D) - (forward-line 1)))))) + (while (not (eobp)) + (tabulated-list-put-tag "D" t)))) (defun bookmark-bmenu-execute-deletions () @@ -2217,8 +2123,6 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ (progn (end-of-line) (point)))))) (o-col (current-column))) (goto-char (point-min)) - (unless bookmark-bmenu-use-header-line - (forward-line 1)) (while (re-search-forward "^D" (point-max) t) (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg (bookmark-bmenu-list) diff --git a/lisp/button.el b/lisp/button.el index 03ab59b109c..ba0682348df 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -78,6 +78,10 @@ "Keymap useful for buffers containing buttons. Mode-specific keymaps may want to use this as their parent keymap.") +(define-minor-mode button-mode + "A minor mode for navigating to buttons with the TAB key." + :keymap button-buffer-map) + ;; Default properties for buttons. (put 'default-button 'face 'button) (put 'default-button 'mouse-face 'highlight) @@ -489,12 +493,17 @@ butting, use the `button-describe' command." t)))) (defun button--help-echo (button) - "Evaluate BUTTON's `help-echo' property and return its value." - (let ((help (button-get button 'help-echo))) - (if (functionp help) - (let ((obj (if (overlayp button) button (current-buffer)))) - (funcall help (selected-window) obj (button-start button))) - (eval help lexical-binding)))) + "Evaluate BUTTON's `help-echo' property and return its value. +If the result is non-nil, pass it through `substitute-command-keys' +before returning it, as is done for `show-help-function'." + (let* ((help (button-get button 'help-echo)) + (help (if (functionp help) + (funcall help + (selected-window) + (if (overlayp button) button (current-buffer)) + (button-start button)) + (eval help lexical-binding)))) + (and help (substitute-command-keys help)))) (defun forward-button (n &optional wrap display-message no-error) "Move to the Nth next button, or Nth previous button if N is negative. diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 55ce9711986..6c162b55f7b 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -1,4 +1,4 @@ -;;; calc-aent.el --- algebraic entry functions for Calc +;;; calc-aent.el --- algebraic entry functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -158,7 +158,7 @@ (setq strp (cdr (cdr strp)))) (calc-do-calc-eval (car str) separator args))) ((eq separator 'eval) - (eval str)) + (eval str t)) ((eq separator 'macro) (require 'calc-ext) (let* ((calc-buffer (current-buffer)) @@ -285,6 +285,8 @@ The value t means abort and give an error message.") (defvar calc-alg-entry-history nil "History for algebraic entry.") +(defvar calc-plain-entry nil) + ;;;###autoload (defun calc-alg-entry (&optional initial prompt) (let* ((calc-dollar-values (mapcar #'calc-get-stack-element @@ -401,7 +403,6 @@ The value t means abort and give an error message.") (use-local-map calc-mode-map)) (calcAlg-enter)) -(defvar calc-plain-entry nil) (defun calcAlg-edit () (interactive) (if (or (not calc-plain-entry) @@ -576,8 +577,9 @@ in Calc algebraic input.") (defvar math-expr-data) ;;;###autoload -(defun math-read-exprs (math-exp-str) - (let ((math-exp-pos 0) +(defun math-read-exprs (str) + (let ((math-exp-str str) + (math-exp-pos 0) (math-exp-old-pos 0) (math-exp-keep-spaces nil) math-exp-token math-expr-data) @@ -738,8 +740,8 @@ in Calc algebraic input.") math-exp-pos (match-end 0))) ((and (setq adfn (assq ch (get calc-language 'math-lang-read-symbol))) - (eval (nth 1 adfn))) - (eval (nth 2 adfn))) + (eval (nth 1 adfn) t)) + (eval (nth 2 adfn) t)) ((eq ch ?\$) (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) math-exp-pos) @@ -771,8 +773,8 @@ in Calc algebraic input.") math-expr-data (math-match-substring math-exp-str 1) math-exp-pos (match-end 0))) ((and (setq adfn (get calc-language 'math-lang-read)) - (eval (nth 0 adfn)) - (eval (nth 1 adfn)))) + (eval (nth 0 adfn) t) + (eval (nth 1 adfn) t))) ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos) (setq math-exp-pos (match-end 0)) (math-read-token)) diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index b487aae6883..ae397c4f2c4 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -1,4 +1,4 @@ -;;; calc-arith.el --- arithmetic functions for Calc +;;; calc-arith.el --- arithmetic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -250,44 +250,43 @@ (while (setq p (cdr p)) (and (eq (car-safe (car p)) 'vec) (setq vec (nth 2 (car p))) - (condition-case err - (let ((v (nth 1 (car p)))) - (setq type nil range nil) - (or (eq (car-safe vec) 'vec) - (setq vec (list 'vec vec))) - (while (and (setq vec (cdr vec)) - (not (Math-objectp (car vec)))) - (and (eq (car-safe (car vec)) 'var) - (let ((st (assq (nth 1 (car vec)) - math-super-types))) - (cond (st (setq type (append type st))) - ((eq (nth 1 (car vec)) 'pos) - (setq type (append type - '(real number)) - range - '(intv 1 0 (var inf var-inf)))) - ((eq (nth 1 (car vec)) 'nonneg) - (setq type (append type - '(real number)) - range - '(intv 3 0 - (var inf var-inf)))))))) - (if vec - (setq type (append type '(real number)) - range (math-prepare-set (cons 'vec vec)))) - (setq type (list type range)) - (or (eq (car-safe v) 'vec) - (setq v (list 'vec v))) - (while (setq v (cdr v)) - (if (or (eq (car-safe (car v)) 'var) - (not (Math-primp (car v)))) - (setq math-decls-cache - (cons (cons (if (eq (car (car v)) 'var) - (nth 2 (car v)) - (car (car v))) - type) - math-decls-cache))))) - (error nil))))) + (ignore-errors + (let ((v (nth 1 (car p)))) + (setq type nil range nil) + (or (eq (car-safe vec) 'vec) + (setq vec (list 'vec vec))) + (while (and (setq vec (cdr vec)) + (not (Math-objectp (car vec)))) + (and (eq (car-safe (car vec)) 'var) + (let ((st (assq (nth 1 (car vec)) + math-super-types))) + (cond (st (setq type (append type st))) + ((eq (nth 1 (car vec)) 'pos) + (setq type (append type + '(real number)) + range + '(intv 1 0 (var inf var-inf)))) + ((eq (nth 1 (car vec)) 'nonneg) + (setq type (append type + '(real number)) + range + '(intv 3 0 + (var inf var-inf)))))))) + (if vec + (setq type (append type '(real number)) + range (math-prepare-set (cons 'vec vec)))) + (setq type (list type range)) + (or (eq (car-safe v) 'vec) + (setq v (list 'vec v))) + (while (setq v (cdr v)) + (if (or (eq (car-safe (car v)) 'var) + (not (Math-primp (car v)))) + (setq math-decls-cache + (cons (cons (if (eq (car (car v)) 'var) + (nth 2 (car v)) + (car (car v))) + type) + math-decls-cache))))))))) (setq math-decls-all (assq 'var-All math-decls-cache))))) (defun math-known-scalarp (a &optional assume-scalar) @@ -2892,7 +2891,7 @@ (eq a b)) (list 'calcFunc-exp sumpow)) (t - (condition-case err + (condition-case nil (math-pow a sumpow) (inexact-result (list '^ a sumpow))))))))) (and math-simplifying-units @@ -2927,7 +2926,7 @@ (math-div 1 (list 'calcFunc-sqrt (math-mul a b)))) (t (setq a (math-mul a b)) - (condition-case err + (condition-case nil (math-pow a apow) (inexact-result (list '^ a apow))))))))))) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index 33fd1af6ffb..60dd17e5ed2 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -1,4 +1,4 @@ -;;; calc-bin.el --- binary functions for Calc +;;; calc-bin.el --- binary functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -145,9 +145,10 @@ (setq math-half-2-word-size (math-power-of-2 (1- (math-abs n)))) (calc-do-refresh) (calc-refresh-evaltos) - (if (< n 0) - (message "Binary word size is %d bits (two's complement)" (- n)) - (message "Binary word size is %d bits" n)))) + (cond + ((< n 0) (message "Binary word size is %d bits (two's complement)" (- n))) + ((> n 0) (message "Binary word size is %d bits" n)) + (t (message "No fixed binary word size"))))) @@ -262,9 +263,10 @@ (defun math-binary-arg (a w) (if (not (Math-integerp a)) (setq a (math-trunc a))) - (if (< a 0) - (logand a (1- (ash 1 (if w (math-trunc w) calc-word-size)))) - a)) + (let ((w (if w (math-trunc w) calc-word-size))) + (if (and (< a 0) (not (zerop w))) + (logand a (1- (ash 1 w))) + a))) (defun math-binary-modulo-args (f a b w) (let (mod) @@ -285,7 +287,7 @@ (let ((bits (math-integer-log2 mod))) (if bits (if w - (if (/= w bits) + (if (and (/= w bits) (not (zerop w))) (calc-record-why "*Warning: Modulus inconsistent with word size")) (setq w bits)) @@ -371,11 +373,12 @@ (math-clip (calcFunc-lsh a n (- w)) w) (if (Math-integer-negp a) (setq a (math-clip a w))) - (cond ((or (Math-lessp n (- w)) - (Math-lessp w n)) + (cond ((and (or (Math-lessp n (- w)) + (Math-lessp w n)) + (not (zerop w))) 0) ((< n 0) - (math-quotient (math-clip a w) (math-power-of-2 (- n)))) + (ash (math-clip a w) n)) (t (math-clip (math-mul a (math-power-of-2 n)) w)))))) @@ -403,7 +406,8 @@ (setq a (math-clip a w))) (let ((two-to-sizem1 (math-power-of-2 (1- w))) (sh (calcFunc-lsh a n w))) - (cond ((Math-natnum-lessp a two-to-sizem1) + (cond ((or (zerop w) + (zerop (logand a two-to-sizem1))) sh) ((Math-lessp n (- 1 w)) (math-add (math-mul two-to-sizem1 2) -1)) @@ -421,6 +425,8 @@ (if (eq (car-safe a) 'mod) (math-binary-modulo-args 'calcFunc-rot a n w) (setq w (if w (math-trunc w) calc-word-size)) + (when (zerop w) + (error "Rotation requires a nonzero word size")) (or (integerp w) (math-reject-arg w 'fixnump)) (or (Math-integerp a) @@ -452,6 +458,8 @@ (if (Math-natnum-lessp a (math-power-of-2 (- -1 w))) a (math-sub a (math-power-of-2 (- w))))) + ((math-zerop w) + a) ((Math-negp a) (math-binary-arg a w)) ((integerp a) @@ -682,6 +690,8 @@ (defun math-format-twos-complement (a) "Format an integer in two's complement mode." + (when (zerop calc-word-size) + (error "Nonzero word size required")) (let* (;(calc-leading-zeros t) (num (cond diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index c5d4d0837e7..5aeb8cba0df 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -1,4 +1,4 @@ -;;; calc-comb.el --- combinatoric functions for Calc +;;; calc-comb.el --- combinatoric functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -292,15 +292,9 @@ (defconst math-small-factorial-table (vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 - (math-read-number-simple "479001600") - (math-read-number-simple "6227020800") - (math-read-number-simple "87178291200") - (math-read-number-simple "1307674368000") - (math-read-number-simple "20922789888000") - (math-read-number-simple "355687428096000") - (math-read-number-simple "6402373705728000") - (math-read-number-simple "121645100408832000") - (math-read-number-simple "2432902008176640000"))) + 479001600 6227020800 87178291200 1307674368000 20922789888000 + 355687428096000 6402373705728000 121645100408832000 + 2432902008176640000)) (defun calcFunc-fact (n) ; [I I] [F F] [Public] (let (temp) @@ -445,12 +439,25 @@ (math-div (calcFunc-fact (math-float n)) (math-mul (calcFunc-fact m) (calcFunc-fact (math-sub n m)))))) - ((math-negp m) 0) - ((math-negp n) - (let ((val (calcFunc-choose (math-add (math-add n m) -1) m))) + ;; For the extension to negative integer arguments we follow + ;; M. J. Kronenburg, The Binomial Coefficient for Negative Arguments, + ;; arXiv:1105.3689v2 + ((and (math-negp n) (not (math-negp m))) + ;; n<0≤m: (n choose m) = (-1)^m (-n+m-1 choose m) + (let ((val (calcFunc-choose (math-add (math-sub m n) -1) m))) (if (math-evenp (math-trunc m)) val (math-neg val)))) + ((and (math-negp n) (math-num-integerp n)) + (if (math-lessp n m) + 0 + ;; m≤n<0: (n choose m) = (-1)^(n-m) (-m-1 choose n-m) + (let ((val (calcFunc-choose (math-sub (math-neg m) 1) + (math-sub n m)))) + (if (math-evenp (math-sub n m)) + val + (math-neg val))))) + ((math-negp m) 0) ((and (math-num-integerp n) (Math-lessp n m)) 0) @@ -467,20 +474,23 @@ (math-choose-float-iter tm n 1 1))))))) (defun math-choose-iter (m n i c) - (if (and (= (% i 5) 1) (> i 5)) + (while (<= i m) + (when (and (= (% i 5) 1) (> i 5)) (math-working (format "choose(%d)" (1- i)) c)) - (if (<= i m) - (math-choose-iter m (1- n) (1+ i) - (math-quotient (math-mul c n) i)) - c)) + (setq c (math-quotient (math-mul c n) i)) + (setq n (1- n)) + (setq i (1+ i))) + c) (defun math-choose-float-iter (count n i c) - (if (= (% i 5) 1) + (while (> count 0) + (when (= (% i 5) 1) (math-working (format "choose(%d)" (1- i)) c)) - (if (> count 0) - (math-choose-float-iter (1- count) (math-sub n 1) (1+ i) - (math-div (math-mul c n) i)) - c)) + (setq c (math-div (math-mul c n) i)) + (setq n (math-sub n 1)) + (setq i (1+ i)) + (setq count (1- count))) + c) ;;; Stirling numbers. diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index f4324dcbf1e..7438f63a90d 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -1,4 +1,4 @@ -;;; calc-cplx.el --- Complex number functions for Calc +;;; calc-cplx.el --- Complex number functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index 220213e0fbb..f9c5281c263 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -1,4 +1,4 @@ -;;; calc-embed.el --- embed Calc in a buffer +;;; calc-embed.el --- embed Calc in a buffer -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -219,13 +219,17 @@ (defvar calc-override-minor-modes (cons t calc-override-minor-modes-map)) -(defun calc-do-embedded (calc-embed-arg end obeg oend) +(defvar calc-embedded-no-reselect nil) + +(defun calc-do-embedded (embed-arg end obeg oend) + (let ((calc-embed-arg embed-arg)) (if calc-embedded-info ;; Turn embedded mode off or switch to a new buffer. (cond ((eq (current-buffer) (aref calc-embedded-info 1)) (let ((calcbuf (current-buffer)) - (buf (aref calc-embedded-info 0))) + ;; (buf (aref calc-embedded-info 0)) + ) (calc-embedded-original-buffer t) (calc-embedded nil) (switch-to-buffer calcbuf))) @@ -291,7 +295,7 @@ (calc-embedded-info info) (calc-embedded-no-reselect t)) (calc-wrapper - (let* ((okay nil) + (let* (;; (okay nil) (calc-no-refresh-evaltos t)) (if (aref info 8) (progn @@ -336,7 +340,7 @@ "Type `C-x * x'" "Give this command again") " to return to normal"))))) - (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed. + (scroll-down 0))) ; fix a bug which occurs when truncate-lines is changed. (defun calc-embedded-select (arg) @@ -353,9 +357,10 @@ (calc-select-part 2))) -(defun calc-embedded-update-formula (calc-embed-arg) +(defun calc-embedded-update-formula (embed-arg) (interactive "P") - (if calc-embed-arg + (let ((calc-embed-arg embed-arg)) + (if embed-arg (let ((entry (assq (current-buffer) calc-embedded-active))) (while (setq entry (cdr entry)) (and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto) @@ -376,12 +381,13 @@ (progn (save-excursion (calc-embedded-update info 14 'eval t)) - (goto-char (+ (aref info 4) pt)))))))) + (goto-char (+ (aref info 4) pt))))))))) -(defun calc-embedded-edit (calc-embed-arg) +(defun calc-embedded-edit (embed-arg) (interactive "P") - (let ((info (calc-embedded-make-info (point) nil t calc-embed-arg)) + (let ((calc-embed-arg embed-arg)) + (let ((info (calc-embedded-make-info (point) nil t embed-arg)) str) (if (eq (car-safe (aref info 8)) 'error) (progn @@ -392,15 +398,14 @@ (math-format-nice-expr (aref info 8) (frame-width)))) (calc-edit-mode (list 'calc-embedded-finish-edit info)) (insert str "\n"))) - (calc-show-edit-buffer)) + (calc-show-edit-buffer))) (defvar calc-original-buffer) (defvar calc-edit-top) (defun calc-embedded-finish-edit (info) (let ((buf (current-buffer)) (str (buffer-substring calc-edit-top (point-max))) - (start (point)) - pos) + (start (point))) ;; pos (switch-to-buffer calc-original-buffer) (let ((val (with-current-buffer (aref info 1) (let ((calc-language nil) @@ -416,7 +421,8 @@ (calc-embedded-update info 14 t t)))) ;;;###autoload -(defun calc-do-embedded-activate (calc-embed-arg cbuf) +(defun calc-do-embedded-activate (embed-arg cbuf) + (let ((calc-embed-arg embed-arg)) (calc-plain-buffer-only) (if calc-embed-arg (calc-embedded-forget)) @@ -443,7 +449,7 @@ (or (eq (car-safe (aref info 8)) 'error) (goto-char (aref info 5)))))) (message "Activating %s for Calc Embedded mode...done" (buffer-name))) - (calc-embedded-active-state t)) + (calc-embedded-active-state t))) (defun calc-plain-buffer-only () (if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode)) @@ -735,13 +741,13 @@ The command \\[yank] can retrieve it from there." (defun calc-find-globals () (interactive) - (and (eq major-mode 'calc-mode) + (and (derived-mode-p 'calc-mode) (error "This command should be used in a normal editing buffer")) (make-local-variable 'calc-embedded-globals) (let ((case-fold-search nil) (modes nil) (save-pt (point)) - found value) + found) ;; value (goto-char (point-min)) (while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t) (and (setq found (assoc (buffer-substring (match-beginning 1) @@ -764,7 +770,7 @@ The command \\[yank] can retrieve it from there." (modes nil) (emodes nil) (pmodes nil) - found value) + found) ;; value (while (and no-defaults (search-backward "[calc-" nil t)) (forward-char 6) (or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]") @@ -817,9 +823,13 @@ The command \\[yank] can retrieve it from there." (defvar calc-embed-vars-used) (defun calc-embedded-make-info (point cbuf fresh &optional - calc-embed-top calc-embed-bot - calc-embed-outer-top calc-embed-outer-bot) - (let* ((bufentry (assq (current-buffer) calc-embedded-active)) + embed-top embed-bot + embed-outer-top embed-outer-bot) + (let* ((calc-embed-top embed-top) + (calc-embed-bot embed-bot) + (calc-embed-outer-top embed-outer-top) + (calc-embed-outer-bot embed-outer-bot) + (bufentry (assq (current-buffer) calc-embedded-active)) (found bufentry) (force (and fresh calc-embed-top (null (equal calc-embed-top '(t))))) (fixed calc-embed-top) @@ -1175,7 +1185,6 @@ The command \\[yank] can retrieve it from there." ;;; These are hooks called by the main part of Calc. -(defvar calc-embedded-no-reselect nil) (defun calc-embedded-select-buffer () (if (eq (current-buffer) (aref calc-embedded-info 0)) (let ((info calc-embedded-info) @@ -1240,7 +1249,7 @@ The command \\[yank] can retrieve it from there." (with-current-buffer (aref calc-embedded-info 1) (let* ((info calc-embedded-info) (extra-line (if (eq calc-language 'big) 1 0)) - (the-point (point)) + ;; (the-point (point)) (empty (= (calc-stack-size) 0)) (entry (if empty (list '(var empty var-empty) 1 nil) @@ -1274,6 +1283,7 @@ The command \\[yank] can retrieve it from there." (set-buffer-modified-p (buffer-modified-p))))) (defun calc-embedded-modes-change (vars) + (defvar the-language) (defvar the-display-just) (if (eq (car vars) 'calc-language) (setq vars '(the-language))) (if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just))) (while (and vars diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 5c11554d5d7..23248ce1bd5 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1398,9 +1398,8 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-scroll-up (n) (interactive "P") - (condition-case nil - (scroll-up (or n (/ (window-height) 2))) - (error nil)) + (ignore-errors + (scroll-up (or n (/ (window-height) 2)))) (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) (if (eq major-mode 'calc-mode) (calc-realign) @@ -3095,6 +3094,7 @@ If X is not an error form, return 1." (defvar math-read-big-baseline) (defvar math-read-big-h2) (defvar math-read-big-err-msg) +(defvar math-read-big-lines) (defun math-read-big-expr (str) (and (> (length calc-left-label) 0) @@ -3139,41 +3139,42 @@ If X is not an error form, return 1." (defvar math-rb-h2) -(defun math-read-big-bigp (math-read-big-lines) - (and (cdr math-read-big-lines) - (let ((matrix nil) - (v 0) - (height (if (> (length (car math-read-big-lines)) 0) 1 0))) - (while (and (cdr math-read-big-lines) - (let* ((i 0) - j - (l1 (car math-read-big-lines)) - (l2 (nth 1 math-read-big-lines)) - (len (min (length l1) (length l2)))) - (if (> (length l2) 0) - (setq height (1+ height))) - (while (and (< i len) - (or (memq (aref l1 i) '(?\ ?\- ?\_)) - (memq (aref l2 i) '(?\ ?\-)) - (and (memq (aref l1 i) '(?\| ?\,)) - (= (aref l2 i) (aref l1 i))) - (and (eq (aref l1 i) ?\[) - (eq (aref l2 i) ?\[) - (let ((math-rb-h2 (length l1))) - (setq j (math-read-big-balance - (1+ i) v "["))) - (setq i (1- j))))) - (setq i (1+ i))) - (or (= i len) - (and (eq (aref l1 i) ?\[) - (eq (aref l2 i) ?\[) - (setq matrix t) - nil)))) - (setq math-read-big-lines (cdr math-read-big-lines) - v (1+ v))) - (or (and (> height 1) - (not (cdr math-read-big-lines))) - matrix)))) +(defun math-read-big-bigp (read-big-lines) + (when (cdr read-big-lines) + (let ((math-read-big-lines read-big-lines) + (matrix nil) + (v 0) + (height (if (> (length (car read-big-lines)) 0) 1 0))) + (while (and (cdr math-read-big-lines) + (let* ((i 0) + j + (l1 (car math-read-big-lines)) + (l2 (nth 1 math-read-big-lines)) + (len (min (length l1) (length l2)))) + (if (> (length l2) 0) + (setq height (1+ height))) + (while (and (< i len) + (or (memq (aref l1 i) '(?\ ?\- ?\_)) + (memq (aref l2 i) '(?\ ?\-)) + (and (memq (aref l1 i) '(?\| ?\,)) + (= (aref l2 i) (aref l1 i))) + (and (eq (aref l1 i) ?\[) + (eq (aref l2 i) ?\[) + (let ((math-rb-h2 (length l1))) + (setq j (math-read-big-balance + (1+ i) v "["))) + (setq i (1- j))))) + (setq i (1+ i))) + (or (= i len) + (and (eq (aref l1 i) ?\[) + (eq (aref l2 i) ?\[) + (setq matrix t) + nil)))) + (setq math-read-big-lines (cdr math-read-big-lines) + v (1+ v))) + (or (and (> height 1) + (not (cdr math-read-big-lines))) + matrix)))) ;;; Nontrivial "flat" formatting. @@ -3457,6 +3458,8 @@ A command spec is a command name symbol, a keyboard macro string, a list containing a numeric entry string, or nil. A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") +(make-obsolete-variable 'calc-ext-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'calc-ext-load-hook) (provide 'calc-ext) diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el index d1525939b11..ea1ef24bb19 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -1,4 +1,4 @@ -;;; calc-fin.el --- financial functions for Calc +;;; calc-fin.el --- financial functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 5a8f0a38d24..465d4520b05 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -1,4 +1,4 @@ -;;; calc-forms.el --- data format conversion functions for Calc +;;; calc-forms.el --- data format conversion functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -678,10 +678,11 @@ in the Gregorian calendar." (defvar math-fd-isoweek) (defvar math-fd-isoweekday) -(defun math-format-date (math-fd-date) - (if (eq (car-safe math-fd-date) 'date) - (setq math-fd-date (nth 1 math-fd-date))) - (let ((entry (list math-fd-date calc-internal-prec calc-date-format))) +(defun math-format-date (fd-date) + (let* ((math-fd-date (if (eq (car-safe fd-date) 'date) + (nth 1 fd-date) + fd-date)) + (entry (list math-fd-date calc-internal-prec calc-date-format))) (or (cdr (assoc entry math-format-date-cache)) (let* ((math-fd-dt nil) (math-fd-iso-dt nil) @@ -709,6 +710,10 @@ as measured in the number of days before December 31, 1 BC (Gregorian).") "The beginning of the Julian date calendar, as measured in the integer number of days before December 31, 1 BC (Gregorian).") +(defconst math-unix-epoch 719163 + "The beginning of Unix time: days from December 31, 1 BC (Gregorian) +to Jan 1, 1970 AD.") + (defun math-format-date-part (x) (cond ((stringp x) x) @@ -730,7 +735,8 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (math-floor math-fd-date) math-julian-date-beginning-int))) ((eq x 'U) - (math-format-number (nth 1 (math-date-parts math-fd-date 719164)))) + (math-format-number (nth 1 (math-date-parts math-fd-date + math-unix-epoch)))) ((memq x '(IYYY Iww w)) (progn (or math-fd-iso-dt @@ -909,15 +915,16 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." ;; which is called by math-parse-date and math-parse-standard-date. (defvar math-pd-str) -(defun math-parse-date (math-pd-str) +(defun math-parse-date (pd-str) (catch 'syntax - (or (math-parse-standard-date math-pd-str t) - (math-parse-standard-date math-pd-str nil) - (and (string-match "W[0-9][0-9]" math-pd-str) - (math-parse-iso-date math-pd-str)) - (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str) - (list 'date (math-read-number (math-match-substring math-pd-str 1)))) + (or (math-parse-standard-date pd-str t) + (math-parse-standard-date pd-str nil) + (and (string-match "W[0-9][0-9]" pd-str) + (math-parse-iso-date pd-str)) + (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" pd-str) + (list 'date (math-read-number (math-match-substring pd-str 1)))) (let ((case-fold-search t) + (math-pd-str pd-str) (year nil) (month nil) (day nil) (weekday nil) (hour nil) (minute nil) (second nil) (bc-flag nil) (a nil) (b nil) (c nil) (bigyear nil) temp) @@ -1123,8 +1130,9 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (substring math-pd-str (match-end 0)))) n)))) -(defun math-parse-standard-date (math-pd-str with-time) - (let ((case-fold-search t) +(defun math-parse-standard-date (pd-str with-time) + (let ((math-pd-str pd-str) + (case-fold-search t) (okay t) num (fmt calc-date-format) this next (gnext nil) (isoyear nil) (isoweek nil) (isoweekday nil) @@ -1173,7 +1181,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (setq num (math-match-substring math-pd-str 0) math-pd-str (substring math-pd-str (match-end 0)) num (math-date-to-dt - (math-add 719164 + (math-add math-unix-epoch (math-div (math-read-number num) '(float 864 2)))) hour (nth 3 num) @@ -1301,9 +1309,10 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (setq day (math-add day (1- yearday)))) day)))))) -(defun math-parse-iso-date (math-pd-str) - "Parse MATH-PD-STR as an ISO week date, or return nil." - (let ((case-fold-search t) +(defun math-parse-iso-date (pd-str) + "Parse PD-STR as an ISO week date, or return nil." + (let ((math-pd-str pd-str) + (case-fold-search t) (isoyear nil) (isoweek nil) (isoweekday nil) (hour nil) (minute nil) (second nil)) ;; Extract the time, if any. @@ -1434,11 +1443,11 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (defun calcFunc-unixtime (date &optional zone) (if (math-realp date) (progn - (setq date (math-add 719163 (math-div date '(float 864 2)))) + (setq date (math-add math-unix-epoch (math-div date '(float 864 2)))) (list 'date (math-sub date (math-div (calcFunc-tzone zone date) '(float 864 2))))) (if (eq (car date) 'date) - (math-add (nth 1 (math-date-parts (nth 1 date) 719163)) + (math-add (nth 1 (math-date-parts (nth 1 date) math-unix-epoch)) (calcFunc-tzone zone date)) (math-reject-arg date 'datep)))) @@ -1608,7 +1617,7 @@ and ends on the first Sunday of November at 2 a.m." (math-std-daylight-savings-old date dt zone bump) (math-std-daylight-savings-new date dt zone bump))) -(defun math-std-daylight-savings-new (date dt zone bump) +(defun math-std-daylight-savings-new (date dt _zone bump) "Standard North American daylight saving algorithm as of 2007. This implements the rules for the U.S. and Canada. Daylight saving begins on the second Sunday of March at 2 a.m., @@ -1629,7 +1638,7 @@ and ends on the first Sunday of November at 2 a.m." (t 0)))) (t 0))) -(defun math-std-daylight-savings-old (date dt zone bump) +(defun math-std-daylight-savings-old (date dt _zone bump) "Standard North American daylight saving algorithm before 2007. This implements the rules for the U.S. and Canada. Daylight saving begins on the first Sunday of April at 2 a.m., @@ -1652,7 +1661,7 @@ and ends on the last Sunday of October at 2 a.m." ;;; Compute the day (1-31) of the WDAY (0-6) on or preceding the given ;;; day of the given month. -(defun math-prev-weekday-in-month (date dt day wday) +(defun math-prev-weekday-in-month (date dt day _wday) (or day (setq day (nth 2 dt))) (if (> day (math-days-in-month (car dt) (nth 1 dt))) (setq day (math-days-in-month (car dt) (nth 1 dt)))) @@ -1870,8 +1879,8 @@ and ends on the last Sunday of October at 2 a.m." (and days (= day (car days)) (setq holiday t))) (let* ((weekdays (nth 3 math-holidays-cache)) - (weeks (1- (/ (+ day 6) 7))) - (wkday (- day 1 (* weeks 7)))) + (weeks (/ day 7)) + (wkday (mod day 7))) ; Day of week: 0=Sunday, 6=Saturday (setq delta (+ delta (* weeks (length weekdays)))) (while (and weekdays (< (car weekdays) wkday)) (setq weekdays (cdr weekdays) @@ -1905,14 +1914,15 @@ and ends on the last Sunday of October at 2 a.m." (setq delta (1+ delta))) (setq day (+ day delta))) (let* ((weekdays (nth 3 math-holidays-cache)) - (bweek (- 7 (length weekdays))) - (weeks (1- (/ (+ day (1- bweek)) bweek))) - (wkday (- day 1 (* weeks bweek))) + (bweek (- 7 (length weekdays))) ; Business days in a week, 1..7. + (weeks (/ day bweek)) ; Whole weeks. + (wkday (mod day bweek)) ; Business day in last week, 0..bweek-1 (w 0)) (setq day (+ day (* weeks (length weekdays)))) + ;; Add business days in the last week; `w' is weekday, 0..6. (while (if (memq w weekdays) (setq day (1+ day)) - (> (setq wkday (1- wkday)) 0)) + (>= (setq wkday (1- wkday)) 0)) (setq w (1+ w))) (let ((hours (nth 7 math-holidays-cache))) (if hours @@ -2030,18 +2040,18 @@ and ends on the last Sunday of October at 2 a.m." nil))) (or done (setq math-holidays-cache-tag t)))))) -(defun math-setup-year-holidays (math-sh-year) - (let ((exprs (nth 2 math-holidays-cache))) - (while exprs +(defun math-setup-year-holidays (sh-year) + (let ((math-sh-year sh-year)) + (dolist (expr (nth 2 math-holidays-cache)) + (defvar var-y) (defvar var-m) (let* ((var-y math-sh-year) (var-m nil) - (expr (math-evaluate-expr (car exprs)))) + (expr (math-evaluate-expr expr))) (if (math-expr-contains expr '(var m var-m)) (let ((var-m 0)) (while (<= (setq var-m (1+ var-m)) 12) (math-setup-add-holidays (math-evaluate-expr expr)))) - (math-setup-add-holidays expr))) - (setq exprs (cdr exprs))))) + (math-setup-add-holidays expr)))))) (defun math-setup-add-holidays (days) ; uses "math-sh-year" (cond ((eq (car-safe days) 'vec) diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index 33c1fbaab8d..86a4808c5ad 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -1,4 +1,4 @@ -;;; calc-frac.el --- fraction functions for Calc +;;; calc-frac.el --- fraction functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index add39b6f8b9..5c179ff05d4 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -1,4 +1,4 @@ -;;; calc-funcs.el --- well-known functions for Calc +;;; calc-funcs.el --- well-known functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -816,25 +816,25 @@ (list (list 'frac -174611 - (math-read-number-simple "802857662698291200000")) + 802857662698291200000) (list 'frac 43867 - (math-read-number-simple "5109094217170944000")) + 5109094217170944000) (list 'frac -3617 - (math-read-number-simple "10670622842880000")) + 10670622842880000) (list 'frac 1 - (math-read-number-simple "74724249600")) + 74724249600) (list 'frac -691 - (math-read-number-simple "1307674368000")) + 1307674368000) (list 'frac 1 - (math-read-number-simple "47900160")) + 47900160) (list 'frac -1 - (math-read-number-simple "1209600")) + 1209600) (list 'frac 1 30240) diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 4cdfdbd4b92..829fa44ca4f 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -1,4 +1,4 @@ -;;; calc-graph.el --- graph output functions for Calc +;;; calc-graph.el --- graph output functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -216,7 +216,7 @@ (or (and (Math-num-integerp pstyle) (math-trunc pstyle)) (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec) 0 -1)) - (math-contains-sdev-p (eval (nth 2 ydata)))))) + (math-contains-sdev-p (eval (nth 2 ydata) t))))) (defun calc-graph-lookup (thing) (if (and (eq (car-safe thing) 'var) @@ -313,13 +313,13 @@ (defvar calc-graph-blank) (defvar calc-graph-non-blank) (defvar calc-graph-curve-num) +(defvar math-arglist) (defun calc-graph-plot (flag &optional printing) (interactive "P") (calc-slow-wrapper (let ((calcbuf (current-buffer)) (tempbuf (get-buffer-create "*Gnuplot Temp-2*")) - (tempbuftop 1) (tempoutfile nil) (calc-graph-curve-num 0) (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0))) @@ -403,7 +403,7 @@ (and (equal output "tty") (setq tty-output t))) (setq tempoutfile (calc-temp-file-name -1) output tempoutfile)) - (setq output (eval output))) + (setq output (eval output t))) (or (equal device calc-graph-last-device) (progn (setq calc-graph-last-device device) @@ -480,9 +480,11 @@ (calc-graph-xp calc-graph-xvalue) (calc-graph-yp calc-graph-yvalue) (calc-graph-zp nil) - (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil) + (calc-graph-xlow nil) (calc-graph-xhigh nil) + ;; (y3low nil) (y3high nil) calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY - y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil) + ;; y3val + calc-graph-y3step var-DUMMY2 (calc-graph-zval nil) calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector calc-graph-numsteps calc-graph-numsteps3 (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename))) @@ -562,7 +564,7 @@ calc-gnuplot-print-output))) (if (symbolp command) (funcall command output) - (eval command)))))))))) + (eval command t)))))))))) (defun calc-graph-compute-2d () (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec)) @@ -905,16 +907,15 @@ (while calc-graph-file-cache (and (car calc-graph-file-cache) (file-exists-p (car (car calc-graph-file-cache))) - (condition-case err - (delete-file (car (car calc-graph-file-cache))) - (error nil))) + (ignore-errors + (delete-file (car (car calc-graph-file-cache))))) (setq calc-graph-file-cache (cdr calc-graph-file-cache)))) (defun calc-graph-kill-hook () (calc-graph-delete-temps)) (defun calc-graph-show-tty (output) - "Default calc-gnuplot-plot-command for \"tty\" output mode. + "Default `calc-gnuplot-plot-command' for \"tty\" output mode. This is useful for tek40xx and other graphics-terminal types." (call-process shell-file-name nil calc-gnuplot-buffer nil shell-command-switch @@ -923,7 +924,7 @@ This is useful for tek40xx and other graphics-terminal types." (defvar calc-dumb-map nil "The keymap for the \"dumb\" terminal plot.") -(defun calc-graph-show-dumb (&optional output) +(defun calc-graph-show-dumb (&optional _output) "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type. This \"dumb\" driver will be present in Gnuplot 3.0." (interactive) @@ -1116,14 +1117,14 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (delete-region start end) (goto-char start) (setq errform - (condition-case nil - (math-contains-sdev-p - (eval (intern - (concat "var-" - (save-excursion - (re-search-backward ":\\(.*\\)}") - (match-string 1)))))) - (error nil))) + (ignore-errors + (math-contains-sdev-p + (symbol-value + (intern + (concat "var-" + (save-excursion + (re-search-backward ":\\(.*\\)}") + (match-string 1)))))))) (if yerr (insert " with yerrorbars") (insert " with " @@ -1165,7 +1166,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (or (calc-graph-find-plot nil nil) (error "No data points have been set!")) (let ((base (point)) - start + ;; start end) (re-search-forward "[,\n]\\|[ \t]+with") (setq end (match-beginning 0)) @@ -1462,7 +1463,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (match-beginning 1) (match-end 1)))) (setq calc-gnuplot-version 1)))) - (condition-case err + (condition-case nil (let ((args (append (and calc-gnuplot-display (not (equal calc-gnuplot-display (getenv "DISPLAY"))) diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 72cf90a7587..0b327e8d0f6 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -1,4 +1,4 @@ -;;; calc-help.el --- help display functions for Calc, +;;; calc-help.el --- help display functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -33,8 +33,8 @@ (declare-function Info-last "info" ()) -(defun calc-help-prefix (arg) - "This key is the prefix for Calc help functions. See calc-help-for-help." +(defun calc-help-prefix (&optional _arg) + "This key is the prefix for Calc help functions. See `calc-help-for-help'." (interactive "P") (or calc-dispatch-help (sit-for echo-keystrokes)) (let ((key (calc-read-key-sequence @@ -79,7 +79,7 @@ C-w Describe how there is no warranty for Calc." (message "Calc Help options: Help, Info, ... press SPC, DEL to scroll, C-g to cancel") (memq (setq key (read-event)) '(? ?\C-h ?\C-? ?\C-v ?\M-v))) - (condition-case err + (condition-case nil (if (memq key '(? ?\C-v)) (scroll-up) (scroll-down)) @@ -302,21 +302,19 @@ C-w Describe how there is no warranty for Calc." (let ((entrylist '()) entry) (require 'info nil t) - (while indices - (condition-case nil - (with-temp-buffer - (Info-mode) - (Info-goto-node (concat "(Calc)" (car indices) " Index")) - (goto-char (point-min)) - (while (re-search-forward "\n\\* \\(.*\\): " nil t) - (setq entry (match-string 1)) - (if (and (not (string-match "<[1-9]+>" entry)) - (not (string-match "(.*)" entry)) - (not (string= entry "Menu"))) - (unless (assoc entry entrylist) - (setq entrylist (cons entry entrylist)))))) - (error nil)) - (setq indices (cdr indices))) + (dolist (indice indices) + (ignore-errors + (with-temp-buffer + (Info-mode) + (Info-goto-node (concat "(Calc)" indice " Index")) + (goto-char (point-min)) + (while (re-search-forward "\n\\* \\(.*\\): " nil t) + (setq entry (match-string 1)) + (if (and (not (string-match "<[1-9]+>" entry)) + (not (string-match "(.*)" entry)) + (not (string= entry "Menu"))) + (unless (assoc entry entrylist) + (setq entrylist (cons entry entrylist)))))))) entrylist)) (defun calc-describe-function (&optional func) @@ -409,9 +407,7 @@ C-w Describe how there is no warranty for Calc." (substitute-command-keys x))))) (nreverse (cdr (reverse (cdr (calc-help)))))) (mapc (function (lambda (prefix) - (let ((msgs (condition-case err - (funcall prefix) - (error nil)))) + (let ((msgs (ignore-errors (funcall prefix)))) (if (car msgs) (princ (if (eq (nth 2 msgs) ?v) diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index c6264d1f5f9..2c7a4f0561e 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -1,4 +1,4 @@ -;;; calc-incom.el --- complex data type input functions for Calc +;;; calc-incom.el --- complex data type input functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index ecf43a12b0c..47917dcac7e 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -1,4 +1,4 @@ -;;; calc-keypd.el --- mouse-capable keypad input for Calc +;;; calc-keypd.el --- mouse-capable keypad input for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -35,17 +35,17 @@ (defvar calc-keypad-prev-input nil) (defvar calc-keypad-said-hello nil) -;;; |----+----+----+----+----+----| -;;; | ENTER |+/- |EEX |UNDO| <- | -;;; |-----+---+-+--+--+-+---++----| -;;; | INV | 7 | 8 | 9 | / | -;;; |-----+-----+-----+-----+-----| -;;; | HYP | 4 | 5 | 6 | * | -;;; |-----+-----+-----+-----+-----| -;;; |EXEC | 1 | 2 | 3 | - | -;;; |-----+-----+-----+-----+-----| -;;; | OFF | 0 | . | PI | + | -;;; |-----+-----+-----+-----+-----| +;; |----+----+----+----+----+----| +;; | ENTER |+/- |EEX |UNDO| <- | +;; |-----+---+-+--+--+-+---++----| +;; | INV | 7 | 8 | 9 | / | +;; |-----+-----+-----+-----+-----| +;; | HYP | 4 | 5 | 6 | * | +;; |-----+-----+-----+-----+-----| +;; |EXEC | 1 | 2 | 3 | - | +;; |-----+-----+-----+-----+-----| +;; | OFF | 0 | . | PI | + | +;; |-----+-----+-----+-----+-----| (defvar calc-keypad-layout '( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over ) ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over ) @@ -83,12 +83,12 @@ calc-keypad-modes-menu calc-keypad-user-menu ) ) -;;; |----+----+----+----+----+----| -;;; |FLR |CEIL|RND |TRNC|CLN2|FLT | -;;; |----+----+----+----+----+----| -;;; | LN |EXP | |ABS |IDIV|MOD | -;;; |----+----+----+----+----+----| -;;; |SIN |COS |TAN |SQRT|y^x |1/x | +;; |----+----+----+----+----+----| +;; |FLR |CEIL|RND |TRNC|CLN2|FLT | +;; |----+----+----+----+----+----| +;; | LN |EXP | |ABS |IDIV|MOD | +;; |----+----+----+----+----+----| +;; |SIN |COS |TAN |SQRT|y^x |1/x | (defvar calc-keypad-math-menu '( ( ( "FLR" calc-floor ) @@ -110,12 +110,12 @@ ( "y^x" calc-power ) ( "1/x" calc-inv ) ) )) -;;; |----+----+----+----+----+----| -;;; |IGAM|BETA|IBET|ERF |BESJ|BESY| -;;; |----+----+----+----+----+----| -;;; |IMAG|CONJ| RE |ATN2|RAND|RAGN| -;;; |----+----+----+----+----+----| -;;; |GCD |FACT|DFCT|BNOM|PERM|NXTP| +;; |----+----+----+----+----+----| +;; |IGAM|BETA|IBET|ERF |BESJ|BESY| +;; |----+----+----+----+----+----| +;; |IMAG|CONJ| RE |ATN2|RAND|RAGN| +;; |----+----+----+----+----+----| +;; |GCD |FACT|DFCT|BNOM|PERM|NXTP| (defvar calc-keypad-funcs-menu '( ( ( "IGAM" calc-inc-gamma ) @@ -137,12 +137,12 @@ ( "PERM" calc-perm ) ( "NXTP" calc-next-prime calc-prev-prime ) ) )) -;;; |----+----+----+----+----+----| -;;; |AND | OR |XOR |NOT |LSH |RSH | -;;; |----+----+----+----+----+----| -;;; |DEC |HEX |OCT |BIN |WSIZ|ARSH| -;;; |----+----+----+----+----+----| -;;; | A | B | C | D | E | F | +;; |----+----+----+----+----+----| +;; |AND | OR |XOR |NOT |LSH |RSH | +;; |----+----+----+----+----+----| +;; |DEC |HEX |OCT |BIN |WSIZ|ARSH| +;; |----+----+----+----+----+----| +;; | A | B | C | D | E | F | (defvar calc-keypad-binary-menu '( ( ( "AND" calc-and calc-diff ) @@ -164,12 +164,12 @@ ( "E" ("E") ) ( "F" ("F") ) ) )) -;;; |----+----+----+----+----+----| -;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$| -;;; |----+----+----+----+----+----| -;;; |INV |DET |TRN |IDNT|CRSS|"x" | -;;; |----+----+----+----+----+----| -;;; |PACK|UNPK|INDX|BLD |LEN |... | +;; |----+----+----+----+----+----| +;; |SUM |PROD|MAX |MAP*|MAP^|MAP$| +;; |----+----+----+----+----+----| +;; |INV |DET |TRN |IDNT|CRSS|"x" | +;; |----+----+----+----+----+----| +;; |PACK|UNPK|INDX|BLD |LEN |... | (defvar calc-keypad-vector-menu '( ( ( "SUM" calc-vector-sum calc-vector-alt-sum calc-vector-mean ) @@ -196,12 +196,12 @@ ( "LEN" calc-vlength ) ( "..." calc-full-vectors ) ) )) -;;; |----+----+----+----+----+----| -;;; |FLT |FIX |SCI |ENG |GRP | | -;;; |----+----+----+----+----+----| -;;; |RAD |DEG |FRAC|POLR|SYMB|PREC| -;;; |----+----+----+----+----+----| -;;; |SWAP|RLL3|RLL4|OVER|STO |RCL | +;; |----+----+----+----+----+----| +;; |FLT |FIX |SCI |ENG |GRP | | +;; |----+----+----+----+----+----| +;; |RAD |DEG |FRAC|POLR|SYMB|PREC| +;; |----+----+----+----+----+----| +;; |SWAP|RLL3|RLL4|OVER|STO |RCL | (defvar calc-keypad-modes-menu '( ( ( "FLT" calc-normal-notation diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 4bbe850273d..bde5abe649f 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -1,4 +1,4 @@ -;;; calc-lang.el --- calc language functions +;;; calc-lang.el --- calc language functions -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -45,6 +45,8 @@ (defvar math-comp-comma) (defvar math-comp-vector-prec) +(defvar math-exp-str) ;; Dyn scoped + ;;; Alternate entry/display languages. (defun calc-set-language (lang &optional option no-refresh) @@ -144,7 +146,7 @@ ( y1 . (math-C-parse-bess)) ( tgamma . calcFunc-gamma ))) -(defun math-C-parse-bess (f val) +(defun math-C-parse-bess (_f val) "Parse C's j0, j1, y0, y1 functions." (let ((args (math-read-expr-list))) (math-read-token) @@ -155,7 +157,7 @@ ((eq val 'y1) '(calcFunc-besY 1))) args))) -(defun math-C-parse-fma (f val) +(defun math-C-parse-fma (_f _val) "Parse C's fma function fma(x,y,z) => (x * y + z)." (let ((args (math-read-expr-list))) (math-read-token) @@ -372,14 +374,14 @@ (defvar math-exp-old-pos) (defvar math-parsing-fortran-vector nil) -(defun math-parse-fortran-vector (op) +(defun math-parse-fortran-vector (_op) (let ((math-parsing-fortran-vector '(end . "\000"))) (prog1 (math-read-brackets t "]") (setq math-exp-token (car math-parsing-fortran-vector) math-expr-data (cdr math-parsing-fortran-vector))))) -(defun math-parse-fortran-vector-end (x op) +(defun math-parse-fortran-vector-end (x _op) (if math-parsing-fortran-vector (progn (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data) @@ -466,10 +468,10 @@ ( "\\times" * 191 190 ) ( "*" * 191 190 ) ( "2x" * 191 190 ) + ( "/" / 185 186 ) ( "+" + 180 181 ) ( "-" - 180 181 ) ( "\\over" / 170 171 ) - ( "/" / 170 171 ) ( "\\choose" calcFunc-choose 170 171 ) ( "\\mod" % 170 171 ) ( "<" calcFunc-lt 160 161 ) @@ -692,7 +694,7 @@ "_{" (math-compose-expr (nth 2 a) 0) "}{" (math-compose-expr (nth 1 a) 0) "}")))) -(defun math-parse-tex-sum (f val) +(defun math-parse-tex-sum (f _val) (let (low high save) (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) (math-read-token) @@ -727,14 +729,15 @@ (math-compose-expr (nth 3 a) 0) (if (memq (nth 1 a) '(0 2)) ")" "]"))) -(defun math-compose-tex-var (a prec) +(defun math-compose-tex-var (a _prec) (if (and calc-language-option (not (= calc-language-option 0)) (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'" (symbol-name (nth 1 a)))) - (if (eq calc-language 'latex) - (format "\\text{%s}" (symbol-name (nth 1 a))) - (format "\\hbox{%s}" (symbol-name (nth 1 a)))) + (format (if (eq calc-language 'latex) + "\\text{%s}" + "\\hbox{%s}") + (symbol-name (nth 1 a))) (math-compose-var a))) (defun math-compose-tex-func (func a) @@ -906,7 +909,7 @@ (setq math-exp-str (copy-sequence math-exp-str)) (aset math-exp-str right ?\])))))))))) -(defun math-latex-parse-frac (f val) +(defun math-latex-parse-frac (_f _val) (let (numer denom) (setq numer (car (math-read-expr-list))) (math-read-token) @@ -916,7 +919,7 @@ (list 'frac numer denom) (list '/ numer denom)))) -(defun math-latex-parse-two-args (f val) +(defun math-latex-parse-two-args (f _val) (let (first second) (setq first (car (math-read-expr-list))) (math-read-token) @@ -931,7 +934,7 @@ (put 'latex 'math-input-filter 'math-tex-input-filter) -(defun calc-eqn-language (n) +(defun calc-eqn-language (_n) (interactive "P") (calc-wrapper (calc-set-language 'eqn) @@ -1159,7 +1162,7 @@ (math-compose-eqn-matrix (cdr a))))))) nil)) -(defun math-parse-eqn-matrix (f sym) +(defun math-parse-eqn-matrix (_f _sym) (let ((vec nil)) (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol"))) (math-read-token) @@ -1175,7 +1178,7 @@ (math-read-token) (math-transpose (cons 'vec (nreverse vec))))) -(defun math-parse-eqn-prime (x sym) +(defun math-parse-eqn-prime (x _sym) (if (eq (car-safe x) 'var) (if (equal math-expr-data calc-function-open) (progn @@ -1363,7 +1366,7 @@ (math-compose-vector args ", " 0) "]"))))) -(defun math-yacas-parse-Sum (f val) +(defun math-yacas-parse-Sum (f _val) "Read in the arguments to \"Sum\" in Calc's Yacas mode." (let ((args (math-read-expr-list))) (math-read-token) @@ -1512,7 +1515,7 @@ ( substitute . (math-maxima-parse-subst)) ( taylor . (math-maxima-parse-taylor)))) -(defun math-maxima-parse-subst (f val) +(defun math-maxima-parse-subst (_f _val) "Read in the arguments to \"subst\" in Calc's Maxima mode." (let ((args (math-read-expr-list))) (math-read-token) @@ -1521,7 +1524,7 @@ (nth 2 args) (nth 0 args)))) -(defun math-maxima-parse-taylor (f val) +(defun math-maxima-parse-taylor (_f _val) "Read in the arguments to \"taylor\" in Calc's Maxima mode." (let ((args (math-read-expr-list))) (math-read-token) @@ -1762,7 +1765,7 @@ ( contains . (math-lang-switch-args calcFunc-in)) ( has . (math-lang-switch-args calcFunc-refers)))) -(defun math-lang-switch-args (f val) +(defun math-lang-switch-args (f _val) "Read the arguments to a Calc function in reverse order. This is used for various language modes which have functions in reverse order to Calc's." @@ -1805,15 +1808,15 @@ order to Calc's." (put 'giac 'math-compose-subscr (function (lambda (a) - (let ((args (cdr (cdr a)))) + ;; (let ((args (cdr (cdr a)))) (list 'horiz (math-compose-expr (nth 1 a) 1000) "[" (math-compose-expr (calc-normalize (list '- (nth 2 a) 1)) 0) - "]"))))) + "]")))) ;;) -(defun math-read-giac-subscr (x op) +(defun math-read-giac-subscr (x _op) (let ((idx (math-read-expr-level 0))) (or (equal math-expr-data "]") (throw 'syntax "Expected `]'")) @@ -1947,7 +1950,7 @@ order to Calc's." (math-compose-expr (nth 2 a) 0) "]]")))) -(defun math-read-math-subscr (x op) +(defun math-read-math-subscr (x _op) (let ((idx (math-read-expr-level 0))) (or (and (equal math-expr-data "]") (progn @@ -2094,10 +2097,13 @@ order to Calc's." (defvar math-rb-v1) (defvar math-rb-v2) -(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 +(defun math-read-big-rec (rb-h1 rb-v1 rb-h2 rb-v2 &optional baseline prec short) (or prec (setq prec 0)) - + (let ((math-rb-h1 rb-h1) + (math-rb-v1 rb-v1) + (math-rb-h2 rb-h2) + (math-rb-v2 rb-v2)) ;; Clip whitespace above or below. (while (and (< math-rb-v1 math-rb-v2) (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) @@ -2449,7 +2455,7 @@ order to Calc's." math-read-big-h2 h) (or short (= math-read-big-h2 math-rb-h2) (math-read-big-error h baseline)) - p))) + p)))) (defun math-read-big-char (h v) (or (and (>= h math-rb-h1) diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index 257d369b87a..5aaa5f48d6c 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -61,6 +61,7 @@ (defmacro calc-with-trail-buffer (&rest body) `(let ((save-buf (current-buffer)) (calc-command-flags nil)) + (ignore save-buf) ;FIXME: Use a name less conflict-prone! (with-current-buffer (calc-trail-display t) (progn (goto-char calc-trail-pointer) diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 139ba5b8e38..0ee82826927 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -1,4 +1,4 @@ -;;; calc-map.el --- higher-order functions for Calc +;;; calc-map.el --- higher-order functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -48,6 +48,8 @@ (math-calcFunc-to-var (nth 1 oper)) expr))))) +(defvar calc-mapping-dir nil) + (defun calc-reduce (&optional oper accum) (interactive) (calc-wrapper @@ -136,7 +138,6 @@ (1+ calc-dollar-used)))))))) (defvar calc-verify-arglist t) -(defvar calc-mapping-dir nil) (defun calc-map-stack () "This is meant to be called by calc-keypad mode." (interactive) @@ -492,6 +493,8 @@ (defvar calc-get-operator-history nil "History for calc-get-operator.") +(defvar math-arglist) + (defun calc-get-operator (msg &optional nargs) (setq calc-aborted-prefix nil) (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil) @@ -853,7 +856,7 @@ (i -1) (math-working-step 0) (math-working-step-2 nil) - len cols obj expr) + len obj expr) ;; cols (if (eq mode 'eqn) (setq mode 'elems heads '(calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt @@ -1023,22 +1026,21 @@ (let ((expr (car (setq vec (cdr vec))))) (if expr (progn - (condition-case err - (and (symbolp func) - (let ((lfunc (or (cdr (assq func - '( (calcFunc-add . math-add) - (calcFunc-sub . math-sub) - (calcFunc-mul . math-mul) - (calcFunc-div . math-div) - (calcFunc-pow . math-pow) - (calcFunc-mod . math-mod) - (calcFunc-vconcat . - math-concat) ))) - func))) - (while (cdr vec) - (setq expr (funcall lfunc expr (nth 1 vec)) - vec (cdr vec))))) - (error nil)) + (ignore-errors + (and (symbolp func) + (let ((lfunc (or (cdr (assq func + '( (calcFunc-add . math-add) + (calcFunc-sub . math-sub) + (calcFunc-mul . math-mul) + (calcFunc-div . math-div) + (calcFunc-pow . math-pow) + (calcFunc-mod . math-mod) + (calcFunc-vconcat + . math-concat) ))) + func))) + (while (cdr vec) + (setq expr (funcall lfunc expr (nth 1 vec)) + vec (cdr vec)))))) (while (setq vec (cdr vec)) (setq expr (math-build-call func (list expr (car vec))))) (math-normalize expr)) @@ -1229,9 +1231,11 @@ (defvar math-inner-mul-func) (defvar math-inner-add-func) -(defun calcFunc-inner (math-inner-mul-func math-inner-add-func a b) +(defun calcFunc-inner (inner-mul-func inner-add-func a b) (or (math-vectorp a) (math-reject-arg a 'vectorp)) (or (math-vectorp b) (math-reject-arg b 'vectorp)) + (let ((math-inner-mul-func inner-mul-func) + (math-inner-add-func inner-add-func)) (if (math-matrixp a) (if (math-matrixp b) (if (= (length (nth 1 a)) (length b)) @@ -1247,12 +1251,12 @@ (math-dimension-error)))) (if (math-matrixp b) (nth 1 (math-inner-mats (list 'vec a) b)) - (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b))))) + (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b)))))) (defun math-inner-mats (a b) (let ((mat nil) (cols (length (nth 1 b))) - row col ap bp accum) + row col) ;; ap bp accum (while (setq a (cdr a)) (setq col cols row nil) diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 6bbd2f574e5..46172d1b7f6 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -1,4 +1,4 @@ -;;; calc-math.el --- mathematical functions for Calc +;;; calc-math.el --- mathematical functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -60,33 +60,23 @@ pow (< pow 1.0e+INF)) (setq x (* 2 x)) - (setq pow (condition-case nil - (expt 10.0 (* 2 x)) - (error nil)))) + (setq pow (ignore-errors (expt 10.0 (* 2 x))))) ;; The following loop should stop when 10^(x+1) is too large. - (setq pow (condition-case nil - (expt 10.0 (1+ x)) - (error nil))) + (setq pow (ignore-errors (expt 10.0 (1+ x)))) (while (and pow (< pow 1.0e+INF)) (setq x (1+ x)) - (setq pow (condition-case nil - (expt 10.0 (1+ x)) - (error nil)))) + (setq pow (ignore-errors (expt 10.0 (1+ x))))) (1- x)) "The largest exponent which Calc will convert to an Emacs float.") (defvar math-smallest-emacs-expt (let ((x -1)) - (while (condition-case nil - (> (expt 10.0 x) 0.0) - (error nil)) + (while (ignore-errors (> (expt 10.0 x) 0.0)) (setq x (* 2 x))) (setq x (/ x 2)) - (while (condition-case nil - (> (expt 10.0 x) 0.0) - (error nil)) + (while (ignore-errors (> (expt 10.0 x) 0.0)) (setq x (1- x))) (+ x 2)) "The smallest exponent which Calc will convert to an Emacs float.") @@ -100,19 +90,18 @@ If this can't be done, return NIL." (let* ((xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x)))))) (and (<= math-smallest-emacs-expt xpon) (<= xpon math-largest-emacs-expt) - (condition-case nil - (math-read-number - (number-to-string - (funcall fn - (string-to-number - (let - ((calc-number-radix 10) - (calc-twos-complement-mode nil) - (calc-float-format (list 'float calc-internal-prec)) - (calc-group-digits nil) - (calc-point-char ".")) - (math-format-number (math-float x))))))) - (error nil)))))) + (ignore-errors + (math-read-number + (number-to-string + (funcall fn + (string-to-number + (let + ((calc-number-radix 10) + (calc-twos-complement-mode nil) + (calc-float-format (list 'float calc-internal-prec)) + (calc-group-digits nil) + (calc-point-char ".")) + (math-format-number (math-float x)))))))))))) (defun calc-sqrt (arg) (interactive "P") @@ -638,11 +627,11 @@ If this can't be done, return NIL." (defvar math-nrf-nf) (defvar math-nrf-nfm1) -(defun math-nth-root-float (a math-nrf-n &optional guess) +(defun math-nth-root-float (a nrf-n &optional guess) (math-inexact-result) (math-with-extra-prec 1 - (let ((math-nrf-nf (math-float math-nrf-n)) - (math-nrf-nfm1 (math-float (1- math-nrf-n)))) + (let ((math-nrf-nf (math-float nrf-n)) + (math-nrf-nfm1 (math-float (1- nrf-n)))) (math-nth-root-float-iter a (or guess (math-make-float 1 (/ (+ (math-numdigs (nth 1 a)) @@ -665,11 +654,12 @@ If this can't be done, return NIL." ;; math-nth-root-int. (defvar math-nri-n) -(defun math-nth-root-integer (a math-nri-n &optional guess) ; [I I S] - (math-nth-root-int-iter a (or guess - (math-scale-int 1 (/ (+ (math-numdigs a) - (1- math-nri-n)) - math-nri-n))))) +(defun math-nth-root-integer (a nri-n &optional guess) ; [I I S] + (let ((math-nri-n nri-n)) + (math-nth-root-int-iter a (or guess + (math-scale-int 1 (/ (+ (math-numdigs a) + (1- nri-n)) + nri-n)))))) (defun math-nth-root-int-iter (a guess) (math-working "root" guess) @@ -693,13 +683,13 @@ If this can't be done, return NIL." ;;;; Transcendental functions. -;;; All of these functions are defined on the complex plane. -;;; (Branch cuts, etc. follow Steele's Common Lisp book.) +;; All of these functions are defined on the complex plane. +;; (Branch cuts, etc. follow Steele's Common Lisp book.) -;;; Most functions increase calc-internal-prec by 2 digits, then round -;;; down afterward. "-raw" functions use the current precision, require -;;; their arguments to be in float (or complex float) format, and always -;;; work in radians (where applicable). +;; Most functions increase calc-internal-prec by 2 digits, then round +;; down afterward. "-raw" functions use the current precision, require +;; their arguments to be in float (or complex float) format, and always +;; work in radians (where applicable). (defun math-to-radians (a) ; [N N] (cond ((eq (car-safe a) 'hms) @@ -1126,9 +1116,9 @@ If this can't be done, return NIL." (math-div-float (cdr sc) (car sc))))))) -;;; This could use a smarter method: Reduce x as in math-sin-raw, then -;;; compute either sin(x) or cos(x), whichever is smaller, and compute -;;; the other using the identity sin(x)^2 + cos(x)^2 = 1. +;; This could use a smarter method: Reduce x as in math-sin-raw, then +;; compute either sin(x) or cos(x), whichever is smaller, and compute +;; the other using the identity sin(x)^2 + cos(x)^2 = 1. (defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x)) (cons (math-sin-raw x) (math-cos-raw x))) @@ -2072,7 +2062,7 @@ If this can't be done, return NIL." (put 'calcFunc-arctanh 'math-expandable t) -;;; Convert A from HMS or degrees to radians. +;; Convert A from HMS or degrees to radians. (defun calcFunc-rad (a) ; [R R] [Public] (cond ((or (Math-numberp a) (eq (car a) 'intv)) @@ -2089,7 +2079,7 @@ If this can't be done, return NIL." (t (list 'calcFunc-rad a)))) (put 'calcFunc-rad 'math-expandable t) -;;; Convert A from HMS or radians to degrees. +;; Convert A from HMS or radians to degrees. (defun calcFunc-deg (a) ; [R R] [Public] (cond ((or (Math-numberp a) (eq (car a) 'intv)) diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index 3cc98ef59c3..d593eddb315 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -1,4 +1,4 @@ -;;; calc-menu.el --- a menu for Calc +;;; calc-menu.el --- a menu for Calc -*- lexical-binding:t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index a8f65ffe752..2db09e2b677 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -1,4 +1,4 @@ -;;; calc-misc.el --- miscellaneous functions for Calc +;;; calc-misc.el --- miscellaneous functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -505,7 +505,7 @@ With argument 0, switch line point is in with line mark is in." ;; 3 <-- mid-line = 3 ;; 4 <-- point ;; 5 <-- bot-line = 5 - (dotimes (i mid-line) + (dotimes (_ mid-line) (setq mid-cell old-top-list old-top-list (cdr old-top-list)) (setcdr mid-cell new-top-list) @@ -519,7 +519,7 @@ With argument 0, switch line point is in with line mark is in." ;; 2 ;; 1 (setq prev-mid-cell old-top-list) - (dotimes (i (- bot-line mid-line)) + (dotimes (_ (- bot-line mid-line)) (setq bot-cell old-top-list old-top-list (cdr old-top-list)) (setcdr bot-cell new-top-list) @@ -757,19 +757,21 @@ loaded and the keystroke automatically re-typed." ;; The variable math-trunc-prec is local to math-trunc, but used by ;; math-trunc-fancy in calc-arith.el, which is called by math-trunc. +(defvar math-trunc-prec) ;;;###autoload -(defun math-trunc (a &optional math-trunc-prec) - (cond (math-trunc-prec +(defun math-trunc (a &optional trunc-prec) + (cond (trunc-prec (require 'calc-ext) - (math-trunc-special a math-trunc-prec)) + (math-trunc-special a trunc-prec)) ((Math-integerp a) a) ((Math-looks-negp a) (math-neg (math-trunc (math-neg a)))) ((eq (car a) 'float) (math-scale-int (nth 1 a) (nth 2 a))) (t (require 'calc-ext) - (math-trunc-fancy a)))) + (let ((math-trunc-prec trunc-prec)) + (math-trunc-fancy a))))) ;;;###autoload (defalias 'calcFunc-trunc 'math-trunc) @@ -777,12 +779,13 @@ loaded and the keystroke automatically re-typed." ;; The variable math-floor-prec is local to math-floor, but used by ;; math-floor-fancy in calc-arith.el, which is called by math-floor. +(defvar math-floor-prec) ;;;###autoload -(defun math-floor (a &optional math-floor-prec) ; [Public] - (cond (math-floor-prec +(defun math-floor (a &optional floor-prec) ; [Public] + (cond (floor-prec (require 'calc-ext) - (math-floor-special a math-floor-prec)) + (math-floor-special a floor-prec)) ((Math-integerp a) a) ((Math-messy-integerp a) (math-trunc a)) ((Math-realp a) @@ -790,7 +793,9 @@ loaded and the keystroke automatically re-typed." (math-add (math-trunc a) -1) (math-trunc a))) (t (require 'calc-ext) - (math-floor-fancy a)))) + (let ((math-floor-prec floor-prec)) + (math-floor-fancy a))))) + ;;;###autoload (defalias 'calcFunc-floor 'math-floor) diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index ff99ccc466c..e109233a825 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -1,4 +1,4 @@ -;;; calc-mode.el --- calculator modes for Calc +;;; calc-mode.el --- calculator modes for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -424,8 +424,8 @@ (t "Not recording mode changes permanently"))))) -(defun calc-total-algebraic-mode (flag) - (interactive "P") +(defun calc-total-algebraic-mode (&optional _flag) + (interactive) (calc-wrapper (if (eq calc-algebraic-mode 'total) (calc-algebraic-mode nil) diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index 2850b33721b..8deef7dc4fd 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -1,4 +1,4 @@ -;;; calc-mtx.el --- matrix functions for Calc +;;; calc-mtx.el --- matrix functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 0fe955b28d1..5ed85fe7cae 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el @@ -1,4 +1,4 @@ -;;; calc-nlfit.el --- nonlinear curve fitting for Calc +;;; calc-nlfit.el --- nonlinear curve fitting for Calc -*- lexical-binding:t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. @@ -104,19 +104,19 @@ (list 'vec C12 C22)))) (list A B))))) -;;; The methods described by de Sousa require the cumulative data qdata -;;; and the rates pdata. We will assume that we are given either -;;; qdata and the corresponding times tdata, or pdata and the corresponding -;;; tdata. The following two functions will find pdata or qdata, -;;; given the other.. +;; The methods described by de Sousa require the cumulative data qdata +;; and the rates pdata. We will assume that we are given either +;; qdata and the corresponding times tdata, or pdata and the corresponding +;; tdata. The following two functions will find pdata or qdata, +;; given the other.. -;;; First, given two lists; one of values q0, q1, ..., qn and one of -;;; corresponding times t0, t1, ..., tn; return a list -;;; p0, p1, ..., pn of the rates of change of the qi with respect to t. -;;; p0 is the right hand derivative (q1 - q0)/(t1 - t0). -;;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)). -;;; The other pis are the averages of the two: -;;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)). +;; First, given two lists; one of values q0, q1, ..., qn and one of +;; corresponding times t0, t1, ..., tn; return a list +;; p0, p1, ..., pn of the rates of change of the qi with respect to t. +;; p0 is the right hand derivative (q1 - q0)/(t1 - t0). +;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)). +;; The other pis are the averages of the two: +;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)). (defun math-nlfit-get-rates-from-cumul (tdata qdata) (let ((pdata (list @@ -153,12 +153,12 @@ pdata)) (reverse pdata))) -;;; Next, given two lists -- one of rates p0, p1, ..., pn and one of -;;; corresponding times t0, t1, ..., tn -- and an initial values q0, -;;; return a list q0, q1, ..., qn of the cumulative values. -;;; q0 is the initial value given. -;;; For i>0, qi is computed using the trapezoid rule: -;;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1)) +;; Next, given two lists -- one of rates p0, p1, ..., pn and one of +;; corresponding times t0, t1, ..., tn -- and an initial values q0, +;; return a list q0, q1, ..., qn of the cumulative values. +;; q0 is the initial value given. +;; For i>0, qi is computed using the trapezoid rule: +;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1)) (defun math-nlfit-get-cumul-from-rates (tdata pdata q0) (let* ((qdata (list q0))) @@ -177,16 +177,16 @@ (setq tdata (cdr tdata))) (reverse qdata))) -;;; Given the qdata, pdata and tdata, find the parameters -;;; a, b and c that fit q = a/(1+b*exp(c*t)). -;;; a is found using the method described by de Sousa. -;;; b and c are found using least squares on the linearization -;;; log((a/q)-1) = log(b) + c*t -;;; In some cases (where the logistic curve may well be the wrong -;;; model), the computed a will be less than or equal to the maximum -;;; value of q in qdata; in which case the above linearization won't work. -;;; In this case, a will be replaced by a number slightly above -;;; the maximum value of q. +;; Given the qdata, pdata and tdata, find the parameters +;; a, b and c that fit q = a/(1+b*exp(c*t)). +;; a is found using the method described by de Sousa. +;; b and c are found using least squares on the linearization +;; log((a/q)-1) = log(b) + c*t +;; In some cases (where the logistic curve may well be the wrong +;; model), the computed a will be less than or equal to the maximum +;; value of q in qdata; in which case the above linearization won't work. +;; In this case, a will be replaced by a number slightly above +;; the maximum value of q. (defun math-nlfit-find-qmax (qdata pdata tdata) (let* ((ratios (math-map-binop 'math-div pdata qdata)) @@ -208,12 +208,12 @@ (calcFunc-exp (nth 0 bandc)) (nth 1 bandc)))) -;;; Next, given the pdata and tdata, we can find the qdata if we know q0. -;;; We first try to find q0, using the fact that when p takes on its largest -;;; value, q is half of its maximum value. So we'll find the maximum value -;;; of q given various q0, and use bisection to approximate the correct q0. +;; Next, given the pdata and tdata, we can find the qdata if we know q0. +;; We first try to find q0, using the fact that when p takes on its largest +;; value, q is half of its maximum value. So we'll find the maximum value +;; of q given various q0, and use bisection to approximate the correct q0. -;;; First, given pdata and tdata, find what half of qmax would be if q0=0. +;; First, given pdata and tdata, find what half of qmax would be if q0=0. (defun math-nlfit-find-qmaxhalf (pdata tdata) (let ((pmax (math-max-list (car pdata) (cdr pdata))) @@ -231,7 +231,7 @@ (setq tdata (cdr tdata))) qmh)) -;;; Next, given pdata and tdata, approximate q0. +;; Next, given pdata and tdata, approximate q0. (defun math-nlfit-find-q0 (pdata tdata) (let* ((qhalf (math-nlfit-find-qmaxhalf pdata tdata)) @@ -250,7 +250,7 @@ (setq q0 (math-add q0 qhalf))) (let* ((qmin (math-sub q0 qhalf)) (qmax q0) - (qt (math-nlfit-find-qmax + (_qt (math-nlfit-find-qmax (mapcar (lambda (q) (math-add q0 q)) qdata) @@ -270,20 +270,20 @@ (setq i (1+ i))) (math-mul '(float 5 -1) (math-add qmin qmax))))) -;;; To improve the approximations to the parameters, we can use -;;; Marquardt method as described in Schwarz's book. +;; To improve the approximations to the parameters, we can use +;; Marquardt method as described in Schwarz's book. -;;; Small numbers used in the Givens algorithm +;; Small numbers used in the Givens algorithm (defvar math-nlfit-delta '(float 1 -8)) (defvar math-nlfit-epsilon '(float 1 -5)) -;;; Maximum number of iterations +;; Maximum number of iterations (defvar math-nlfit-max-its 100) -;;; Next, we need some functions for dealing with vectors and -;;; matrices. For convenience, we'll work with Emacs lists -;;; as vectors, rather than Calc's vectors. +;; Next, we need some functions for dealing with vectors and +;; matrices. For convenience, we'll work with Emacs lists +;; as vectors, rather than Calc's vectors. (defun math-nlfit-set-elt (vec i x) (setcar (nthcdr (1- i) vec) x)) @@ -589,7 +589,7 @@ (calcFunc-trn j) j)) (calcFunc-inv j))) -(defun math-nlfit-get-sigmas (grad xlist pparms chisq) +(defun math-nlfit-get-sigmas (grad xlist pparms _chisq) (let* ((sgs nil) (covar (math-nlfit-find-covar grad xlist pparms)) (n (1- (length covar))) @@ -664,6 +664,10 @@ (calc-pop-push-record-list n prefix vals) (calc-handle-whys)) +(defvar calc-curve-nvars) +(defvar calc-curve-varnames) +(defvar calc-curve-coefnames) + (defun math-nlfit-fit-curve (fn grad solnexpr initparms &optional sdv) (calc-slow-wrapper (let* ((sdevv (or (eq sdv 'calcFunc-efit) (eq sdv 'calcFunc-xfit))) @@ -678,7 +682,7 @@ (calc-curve-varnames nil) (calc-curve-coefnames nil) (calc-curve-nvars 1) - (fitvars (calc-get-fit-variables 1 3)) + (_fitvars (calc-get-fit-variables 1 3)) (var (nth 1 calc-curve-varnames)) (parms (cdr calc-curve-coefnames)) (parmguess @@ -763,7 +767,7 @@ (calc-curve-varnames nil) (calc-curve-coefnames nil) (calc-curve-nvars 1) - (fitvars (calc-get-fit-variables 1 2)) + (_fitvars (calc-get-fit-variables 1 2)) (var (nth 1 calc-curve-varnames)) (parms (cdr calc-curve-coefnames)) (soln (list '* (nth 0 finalparms) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 6db5de4c96c..ea9c49748e2 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1,4 +1,4 @@ -;;; calc-prog.el --- user programmability functions for Calc +;;; calc-prog.el --- user programmability functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -111,10 +111,15 @@ "Not reporting timing of commands")))) (defun calc-pass-errors () + ;; FIXME: This is broken at least since Emacs-26. + ;; AFAICT the immediate purpose of this code is to hack the + ;; `condition-case' in `calc-do' so it doesn't catch errors any + ;; more. I'm not sure why/whatfor this was designed, but I suspect + ;; that `condition-case-unless-debug' would cover the same needs. (interactive) ;; The following two cases are for the new, optimizing byte compiler ;; or the standard 18.57 byte compiler, respectively. - (condition-case err + (condition-case nil (let ((place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 15))) (or (memq (car-safe (car-safe place)) '(error xxxerror)) (setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27))) @@ -165,6 +170,7 @@ ;; calc-user-define-composition and calc-finish-formula-edit, ;; but is used by calc-fix-user-formula. (defvar calc-user-formula-alist) +(defvar math-arglist) ; dynamically bound in all callers (defun calc-user-define-formula () (interactive) @@ -328,7 +334,6 @@ (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) (message ""))) -(defvar math-arglist) ; dynamically bound in all callers (defun calc-default-formula-arglist (form) (if (consp form) (if (eq (car form) 'var) @@ -511,8 +516,9 @@ ;; is called (indirectly) by calc-read-parse-table. (defvar calc-lang) -(defun calc-write-parse-table (tab calc-lang) - (let ((p tab)) +(defun calc-write-parse-table (tab lang) + (let ((calc-lang lang) + (p tab)) (while p (calc-write-parse-table-part (car (car p))) (insert ":= " @@ -551,8 +557,9 @@ (insert " ")))) (setq p (cdr p)))) -(defun calc-read-parse-table (calc-buf calc-lang) - (let ((tab nil)) +(defun calc-read-parse-table (calc-buf lang) + (let ((calc-lang lang) + (tab nil)) (while (progn (skip-chars-forward "\n\t ") (not (eobp))) @@ -860,7 +867,7 @@ (defun calc-edit-macro-combine-digits () "Put an entire sequence of digits on a single line." (let ((line (calc-edit-macro-command)) - curline) + ) ;; curline (goto-char (line-beginning-position)) (kill-line 1) (while (string-equal (calc-edit-macro-command-type) "calcDigit-start") @@ -1038,7 +1045,7 @@ Redefine the corresponding command." (let* ((cmd (cdr def)) (fcmd (and cmd (symbolp cmd) (symbol-function cmd))) (func nil) - (pt (point)) + ;; (pt (point)) (fill-column 70) (fill-prefix nil) str q-ok) @@ -1945,8 +1952,9 @@ Redefine the corresponding command." ;; by math-define-body. (defvar math-exp-env) -(defun math-define-body (body math-exp-env) - (math-define-list body)) +(defun math-define-body (body exp-env) + (let ((math-exp-env exp-env)) + (math-define-list body))) (defun math-define-list (body &optional quote) (cond ((null body) diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index bb909e728e1..2cc7b6beef0 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -1,4 +1,4 @@ -;;; calc-rewr.el --- rewriting functions for Calc +;;; calc-rewr.el --- rewriting functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -142,7 +142,7 @@ (calc-pop-push-record-list n "rwrt" (list expr))) (calc-handle-whys))) -(defun calc-match (pat &optional interactive) +(defun calc-match (pat &optional _interactive) (interactive "sPattern: \np") (calc-slow-wrapper (let (n expr) @@ -158,9 +158,9 @@ (setq expr (calc-top-n 1) n 1)) (or (math-vectorp expr) (error "Argument must be a vector")) - (if (calc-is-inverse) - (calc-enter-result n "mtcn" (math-match-patterns pat expr t)) - (calc-enter-result n "mtch" (math-match-patterns pat expr nil)))))) + (calc-enter-result n "mtcn" + (math-match-patterns pat expr + (not (not (calc-is-inverse)))))))) (defvar math-mt-many) @@ -169,8 +169,10 @@ ;; but is used by math-rewrite-phase (defvar math-rewrite-whole-expr) -(defun math-rewrite (math-rewrite-whole-expr rules &optional math-mt-many) - (let* ((crules (math-compile-rewrites rules)) +(defun math-rewrite (rewrite-whole-expr rules &optional mt-many) + (let* ((math-rewrite-whole-expr rewrite-whole-expr) + (math-mt-many mt-many) + (crules (math-compile-rewrites rules)) (heads (math-rewrite-heads math-rewrite-whole-expr)) (trace-buffer (get-buffer "*Trace*")) (calc-display-just 'center) @@ -211,6 +213,8 @@ ":\n" fmt "\n")))) math-rewrite-whole-expr)) +(defvar math-rewrite-phase 1) + (defun math-rewrite-phase (sched) (while (and sched (/= math-mt-many 0)) (if (listp (car sched)) @@ -464,6 +468,8 @@ ;;; whole match the name v. Beware of circular structures! ;;; +(defvar math-rewrite-whole nil) + (defun math-compile-patterns (pats) (if (and (eq (car-safe pats) 'var) (calc-var-value (nth 2 pats))) @@ -485,7 +491,6 @@ (cdr pats) (list pats))))))))) -(defvar math-rewrite-whole nil) (defvar math-make-import-list nil) ;; The variable math-import-list is local to part of math-compile-rewrites, @@ -580,7 +585,7 @@ (let ((rule-set nil) (all-heads nil) (nil-rules nil) - (rule-count 0) + ;; (rule-count 0) (math-schedule nil) (math-iterations nil) (math-phases nil) @@ -831,14 +836,16 @@ (defvar math-rwcomp-subst-new-func) (defvar math-rwcomp-subst-old-func) -(defun math-rwcomp-substitute (expr math-rwcomp-subst-old math-rwcomp-subst-new) - (if (and (eq (car-safe math-rwcomp-subst-old) 'var) - (memq (car-safe math-rwcomp-subst-new) '(var calcFunc-lambda))) - (let ((math-rwcomp-subst-old-func (math-var-to-calcFunc math-rwcomp-subst-old)) - (math-rwcomp-subst-new-func (math-var-to-calcFunc math-rwcomp-subst-new))) +(defun math-rwcomp-substitute (expr rwcomp-subst-old rwcomp-subst-new) + (let ((math-rwcomp-subst-old rwcomp-subst-old) + (math-rwcomp-subst-new rwcomp-subst-new)) + (if (and (eq (car-safe rwcomp-subst-old) 'var) + (memq (car-safe rwcomp-subst-new) '(var calcFunc-lambda))) + (let ((math-rwcomp-subst-old-func (math-var-to-calcFunc rwcomp-subst-old)) + (math-rwcomp-subst-new-func (math-var-to-calcFunc rwcomp-subst-new))) (math-rwcomp-subst-rec expr)) (let ((math-rwcomp-subst-old-func nil)) - (math-rwcomp-subst-rec expr)))) + (math-rwcomp-subst-rec expr))))) (defun math-rwcomp-subst-rec (expr) (cond ((equal expr math-rwcomp-subst-old) math-rwcomp-subst-new) @@ -1452,8 +1459,6 @@ ,form (setcar rules orig)))) -(defvar math-rewrite-phase 1) - ;; The variable math-apply-rw-regs is local to math-apply-rewrites, ;; but is used by math-rwapply-replace-regs and math-rwapply-reg-looks-negp ;; which are called by math-apply-rewrites. @@ -1463,11 +1468,12 @@ ;; but is used by math-rwapply-remember. (defvar math-apply-rw-ruleset) -(defun math-apply-rewrites (expr rules &optional heads math-apply-rw-ruleset) +(defun math-apply-rewrites (expr rules &optional heads apply-rw-ruleset) (and (setq rules (cdr (or (assq (car-safe expr) rules) (assq nil rules)))) - (let ((result nil) + (let ((math-apply-rw-ruleset apply-rw-ruleset) + (result nil) op math-apply-rw-regs inst part pc mark btrack (tracing math-rwcomp-tracing) (phase math-rewrite-phase)) diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index 1b7526c3c9e..fe0e8a1e479 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -1,4 +1,4 @@ -;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc +;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index 0342a0ae48c..23c0e01b527 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -1,4 +1,4 @@ -;;; calc-sel.el --- data selection functions for Calc +;;; calc-sel.el --- data selection functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -146,7 +146,8 @@ (defvar calc-fnp-op) (defvar calc-fnp-num) -(defun calc-find-nth-part (expr calc-fnp-num) +(defun calc-find-nth-part (expr fnp-num) + (let ((calc-fnp-num fnp-num)) (if (and calc-assoc-selections (assq (car-safe expr) calc-assoc-ops)) (let (calc-fnp-op) @@ -154,7 +155,7 @@ (if (eq (car-safe expr) 'intv) (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr)) (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr)) - (nth calc-fnp-num expr))))) + (nth calc-fnp-num expr)))))) (defun calc-find-nth-part-rec (expr) ; uses num, op (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops)) @@ -381,7 +382,7 @@ ;; (if (or (< num 1) (> num (calc-stack-size))) ;; (error "Cursor must be positioned on a stack element")) (let* ((entry (calc-top num 'entry)) - ww w) + ) ;; ww w (or (equal entry calc-selection-cache-entry) (progn (setcar entry (calc-encase-atoms (car entry))) @@ -418,6 +419,7 @@ ;; The variable math-comp-sel-tag is local to calc-find-selected-part, ;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel ;; in calccomp.el, which are called (indirectly) by calc-find-selected-part. +(defvar math-comp-sel-tag) (defun calc-find-selected-part () (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset)) @@ -436,7 +438,8 @@ (current-indentation)) lcount (1+ lcount))) (- lcount (math-comp-ascent - calc-selection-cache-comp) -1)))) + calc-selection-cache-comp) + -1)))) (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset spaces lcount)) (math-comp-sel-tag nil)) @@ -481,8 +484,9 @@ (defvar calc-rsf-old) (defvar calc-rsf-new) -(defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new) - (setq calc-rsf-new (calc-encase-atoms calc-rsf-new)) +(defun calc-replace-sub-formula (expr rsf-old rsf-new) + (let ((calc-rsf-old rsf-old) + (calc-rsf-new (calc-encase-atoms rsf-new)))) (calc-replace-sub-formula-rec expr)) (defun calc-replace-sub-formula-rec (expr) @@ -671,7 +675,7 @@ (entry (calc-top num 'entry)) (expr (car entry)) (sel (or (calc-auto-selection entry) expr)) - alg) + ) ;; alg (let ((str (math-showing-full-precision (math-format-nice-expr sel (frame-width))))) (calc-edit-mode (list 'calc-finish-selection-edit diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index 09d3ce921c4..196f743fc1a 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -1,4 +1,4 @@ -;;; calc-stat.el --- statistical functions for Calc +;;; calc-stat.el --- statistical functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index 79e6cf5c00c..a1e385cb406 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -1,4 +1,4 @@ -;;; calc-store.el --- value storage functions for Calc +;;; calc-store.el --- value storage functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -184,10 +184,11 @@ (defvar calc-read-var-name-history nil "History for reading variable names.") -(defun calc-read-var-name (prompt &optional calc-store-opers) +(defun calc-read-var-name (prompt &optional store-opers) (setq calc-given-value nil calc-aborted-prefix nil) - (let ((var (concat + (let* ((calc-store-opers store-opers) + (var (concat "var-" (let ((minibuffer-completion-table (mapcar (lambda (x) (substring x 4)) @@ -504,7 +505,7 @@ (calc-wrapper (or var (setq var (calc-read-var-name "Declare: " 0))) (or var (setq var 'var-All)) - (let* (dp decl def row rp) + (let* (dp decl row rp) ;; def (or (and (calc-var-value 'var-Decls) (eq (car-safe var-Decls) 'vec)) (setq var-Decls (list 'vec))) diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index bbd61a2c4a8..58b81faee50 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -1,4 +1,4 @@ -;;; calc-stuff.el --- miscellaneous functions for Calc +;;; calc-stuff.el --- miscellaneous functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -273,8 +273,9 @@ With a prefix, push that prefix as a number onto the stack." ;; math-map-over-constants. (defvar math-moc-func) -(defun math-map-over-constants (math-moc-func expr) - (math-map-over-constants-rec expr)) +(defun math-map-over-constants (moc-func expr) + (let ((math-moc-func moc-func)) + (math-map-over-constants-rec expr))) (defun math-map-over-constants-rec (expr) (cond ((or (Math-primp expr) diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index 9f289f21b00..de7205ee3ca 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -1,4 +1,4 @@ -;;; calc-trail.el --- functions for manipulating the Calc "trail" +;;; calc-trail.el --- functions for manipulating the Calc "trail" -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index 92682baa87a..47971e8ab0d 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -1,4 +1,4 @@ -;;; calc-undo.el --- undo functions for Calc +;;; calc-undo.el --- undo functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 7b86eb095b0..709c09ea099 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -37,14 +37,14 @@ ;;; Updated April 2002 by Jochen Küpper ;;; Updated August 2007, using -;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html) -;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) +;;; CODATA (https://physics.nist.gov/cuu/Constants/index.html) +;;; NIST (https://physics.nist.gov/Pubs/SP811/appenB9.html) ;;; ESUWM (Encyclopaedia of Scientific Units, Weights and ;;; Measures, by François Cardarelli) ;;; All conversions are exact unless otherwise noted. ;; CODATA values updated February 2016, using 2014 adjustment -;; http://arxiv.org/pdf/1507.07956.pdf +;; https://arxiv.org/pdf/1507.07956.pdf ;; Updated November 2018 for the redefinition of the SI ;; https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf @@ -59,7 +59,7 @@ ( mi "5280 ft" "Mile" ) ( au "149597870691. m" "Astronomical Unit" nil "149597870691 m (*)") - ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html) + ;; (approx) NASA JPL (https://neo.jpl.nasa.gov/glossary/au.html) ( lyr "c yr" "Light Year" ) ( pc "3.0856775854*10^16 m" "Parsec (**)" nil "3.0856775854 10^16 m (*)") ;; (approx) ESUWM diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 6850ded717b..875414595cf 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -1,4 +1,4 @@ -;;; calc-vec.el --- vector functions for Calc +;;; calc-vec.el --- vector functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -1111,18 +1111,20 @@ ;; by calcFunc-grade and calcFunc-rgrade. (defvar math-grade-vec) -(defun calcFunc-grade (math-grade-vec) - (if (math-vectorp math-grade-vec) - (let* ((len (1- (length math-grade-vec)))) - (cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep))) - (math-reject-arg math-grade-vec 'vectorp))) - -(defun calcFunc-rgrade (math-grade-vec) - (if (math-vectorp math-grade-vec) - (let* ((len (1- (length math-grade-vec)))) +(defun calcFunc-grade (grade-vec) + (if (math-vectorp grade-vec) + (let* ((math-grade-vec grade-vec) + (len (1- (length grade-vec)))) + (cons 'vec (sort (cdr (calcFunc-index len)) #'math-grade-beforep))) + (math-reject-arg grade-vec #'vectorp))) + +(defun calcFunc-rgrade (grade-vec) + (if (math-vectorp grade-vec) + (let* ((math-grade-vec grade-vec) + (len (1- (length grade-vec)))) (cons 'vec (nreverse (sort (cdr (calcFunc-index len)) - 'math-grade-beforep)))) - (math-reject-arg math-grade-vec 'vectorp))) + #'math-grade-beforep)))) + (math-reject-arg grade-vec #'vectorp))) (defun math-grade-beforep (i j) (math-beforep (nth i math-grade-vec) (nth j math-grade-vec))) @@ -1556,7 +1558,8 @@ of two matrices is a matrix." (defvar math-exp-keep-spaces) (defvar math-expr-data) -(defun math-read-brackets (space-sep math-rb-close) +(defun math-read-brackets (space-sep rb-close) + (let ((math-rb-close rb-close)) (and space-sep (setq space-sep (not (math-check-for-commas)))) (math-read-token) (while (eq math-exp-token 'space) @@ -1624,7 +1627,7 @@ of two matrices is a matrix." (throw 'syntax "Expected `]'"))) (or (eq math-exp-token 'end) (math-read-token)) - vals))) + vals)))) (defun math-check-for-commas (&optional balancing) (let ((count 0) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 690aaf2687f..e03c00243c4 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -1,4 +1,4 @@ -;;; calc-yank.el --- kill-ring functionality for Calc +;;; calc-yank.el --- kill-ring functionality for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -401,7 +401,7 @@ Interactively, reads the register using `register-read-with-preview'." (let* ((from-buffer (current-buffer)) (calc-was-started (get-buffer-window "*Calculator*")) (single nil) - data vals pos) + data vals) ;; pos (if arg (if (consp arg) (setq single t) @@ -776,7 +776,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (error "Original calculator buffer has been corrupted"))) (goto-char calc-edit-top) (if (buffer-modified-p) - (eval calc-edit-handler)) + (eval calc-edit-handler t)) (if (and one-window (not (one-window-p t))) (delete-window)) (if (get-buffer-window return) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index fb1287baaa6..bde7bd4e2bd 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1382,6 +1382,29 @@ Notations: 3.14e6 3.14 * 10^6 (set-keymap-parent map calc-mode-map) map)) +(defun calc--header-line (long short width &optional fudge) + "Return a Calc header line appropriate for the buffer width. + +LONG is a desired text for a wide window, SHORT is a desired +abbreviated text, and width is the buffer width, which will be +some fraction of the 'parent' window width (At the time of +writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a +trial-and-error adjustment number for the edge-cases at the +border of the two cases." + ;; TODO: This could be called as part of a 'window-resize' hook. + (setq header-line-format + (let* ((len-long (length long)) + (len-short (length short)) + (fudge (or fudge 0)) + ;; fudge for trail is: -3 (added to len-long) + ;; (width ) for trail + (factor (if (> width (+ len-long fudge)) len-long len-short)) + (size (max (/ (- width factor) 2) 0)) + (fill (make-string size ?-)) + (pre (replace-regexp-in-string ".$" " " fill)) + (post (replace-regexp-in-string "^." " " fill))) + (concat pre (if (= factor len-long) long short) post)))) + (define-derived-mode calc-trail-mode fundamental-mode "Calc Trail" "Calc Trail mode. This mode is used by the *Calc Trail* buffer, which records all results @@ -1396,9 +1419,9 @@ commands given here will actually operate on the *Calculator* stack." (setq buffer-read-only t) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) - (when (= (buffer-size) 0) - (let ((inhibit-read-only t)) - (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))) + (when calc-show-banner + (calc--header-line "Emacs Calculator Trail" "Calc Trail" + (/ (window-width) 3) -3))) (defun calc-create-buffer () "Create and initialize a buffer for the Calculator." @@ -1451,7 +1474,6 @@ commands given here will actually operate on the *Calculator* stack." (pop-to-buffer (current-buffer))))))) (with-current-buffer (calc-trail-buffer) (and calc-display-trail - (= (window-width) (frame-width)) (calc-trail-display 1 t))) (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit") (run-hooks 'calc-start-hook) @@ -1986,13 +2008,11 @@ See calc-keypad for details." (calc-any-evaltos nil)) (setq calc-any-selections nil) (erase-buffer) - (when calc-show-banner - (insert (propertize "--- Emacs Calculator Mode ---\n" - 'face 'italic))) + (when calc-show-banner + (calc--header-line "Emacs Calculator Mode" "Emacs Calc" + (* 2 (/ (window-width) 3)) -3)) (while thing (goto-char (point-min)) - (when calc-show-banner - (forward-line 1)) (insert (math-format-stack-value (car thing)) "\n") (setq thing (cdr thing))) (calc-renumber-stack) @@ -2076,7 +2096,6 @@ the United States." (eq (marker-buffer calc-trail-pointer) calc-trail-buffer)) (with-current-buffer calc-trail-buffer (goto-char (point-min)) - (forward-line 1) (setq calc-trail-pointer (point-marker)))) calc-trail-buffer) @@ -2144,10 +2163,8 @@ the United States." (if (derived-mode-p 'calc-trail-mode) (progn (beginning-of-line) - (if (bobp) - (forward-line 1) - (if (eobp) - (forward-line -1))) + (if (eobp) + (forward-line -1)) (if (or (bobp) (eobp)) (setq overlay-arrow-position nil) ; trail is empty (set-marker calc-trail-pointer (point) (current-buffer)) @@ -2161,7 +2178,7 @@ the United States." (if win (save-excursion (forward-line (/ (window-height win) 2)) - (forward-line (- 1 (window-height win))) + (forward-line (- 2 (window-height win))) (set-window-start win (point)) (set-window-point win (+ calc-trail-pointer 4)) (set-buffer calc-main-buffer) @@ -2296,7 +2313,7 @@ the United States." ((eq last-command-event ?@) "0@ ") (t (char-to-string last-command-event)))) -(defvar calc-buffer) +(defvar calc-buffer nil) (defvar calc-prev-char) (defvar calc-prev-prev-char) (defvar calc-digit-value) @@ -2336,7 +2353,7 @@ the United States." (defun calcDigit-nondigit () (interactive) ;; Exercise for the reader: Figure out why this is a good precaution! - (or (boundp 'calc-buffer) + (or calc-buffer (use-local-map minibuffer-local-map)) (let ((str (minibuffer-contents))) (setq calc-digit-value (with-current-buffer calc-buffer @@ -3435,12 +3452,10 @@ See Info node `(calc)Defining Functions'." (defun calc-clear-unread-commands () (setq unread-command-events nil)) -(defcalcmodevar math-2-word-size - (math-read-number-simple "4294967296") +(defcalcmodevar math-2-word-size 4294967296 "Two to the power of `calc-word-size'.") -(defcalcmodevar math-half-2-word-size - (math-read-number-simple "2147483648") +(defcalcmodevar math-half-2-word-size 2147483648 "One-half of two to the power of `calc-word-size'.") (when calc-always-load-extensions diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index bcfa77dad94..7894bd93015 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -1,4 +1,4 @@ -;;; calcalg2.el --- more algebraic functions for Calc +;;; calcalg2.el --- more algebraic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -333,8 +333,10 @@ (setq n (1+ n))) accum)))))) -(defun calcFunc-deriv (expr math-deriv-var &optional deriv-value math-deriv-symb) - (let* ((math-deriv-total nil) +(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb) + (let* ((math-deriv-var deriv-var) + (math-deriv-symb deriv-symb) + (math-deriv-total nil) (res (catch 'math-deriv (math-derivative expr)))) (or (eq (car-safe res) 'calcFunc-deriv) (null res) @@ -344,9 +346,11 @@ (math-expr-subst res math-deriv-var deriv-value) res)))) -(defun calcFunc-tderiv (expr math-deriv-var &optional deriv-value math-deriv-symb) +(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb) (math-setup-declarations) - (let* ((math-deriv-total t) + (let* ((math-deriv-var deriv-var) + (math-deriv-symb deriv-symb) + (math-deriv-total t) (res (catch 'math-deriv (math-derivative expr)))) (or (eq (car-safe res) 'calcFunc-tderiv) (null res) @@ -363,10 +367,10 @@ (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))) (put 'calcFunc-deg\' 'math-derivative-1 - (function (lambda (u) (math-div-float '(float 18 1) (math-pi))))) + (function (lambda (_) (math-div-float '(float 18 1) (math-pi))))) (put 'calcFunc-rad\' 'math-derivative-1 - (function (lambda (u) (math-pi-over-180)))) + (function (lambda (_) (math-pi-over-180)))) (put 'calcFunc-ln\' 'math-derivative-1 (function (lambda (u) (math-div 1 u)))) @@ -1079,8 +1083,9 @@ ;; math-integ-try-substitutions. (defvar math-integ-expr) -(defun math-do-integral-methods (math-integ-expr) - (let ((math-so-far math-integ-var-list-list) +(defun math-do-integral-methods (integ-expr) + (let ((math-integ-expr integ-expr) + (math-so-far math-integ-var-list-list) rat-in) ;; Integration by substitution, for various likely sub-expressions. @@ -1195,10 +1200,11 @@ (defvar math-good-parts) -(defun math-integ-try-parts (expr &optional math-good-parts) +(defun math-integ-try-parts (expr &optional good-parts) ;; Integration by parts: ;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x) ;; where h(x) = integ(g(x),x). + (let ((math-good-parts good-parts)) (or (let ((exp (calcFunc-expand expr))) (and (not (equal exp expr)) (math-integral exp))) @@ -1219,14 +1225,14 @@ (and (eq (car expr) '^) (math-integrate-by-parts (math-pow (nth 1 expr) (math-sub (nth 2 expr) 1)) - (nth 1 expr))))) + (nth 1 expr)))))) (defun math-integrate-by-parts (u vprime) (let ((math-integ-level (if (or math-good-parts (math-polynomial-p u math-integ-var)) math-integ-level (1- math-integ-level))) - (math-doing-parts t) + ;; (math-doing-parts t) ;Unused v temp) (and (>= math-integ-level 0) (unwind-protect @@ -1532,7 +1538,7 @@ (math-any-substs t) (math-enable-subst nil) (math-prev-parts-v nil) - (math-doing-parts nil) + ;; (math-doing-parts nil) ;Unused (math-good-parts nil) (res (if trace-buffer @@ -1883,7 +1889,10 @@ (defvar calc-high) (defvar math-var) -(defun calcFunc-table (expr math-var &optional calc-low calc-high step) +(defun calcFunc-table (expr var &optional low high step) + (let ((math-var var) + (calc-high high) + (calc-low low)) (or calc-low (setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf))) (or calc-high (setq calc-high calc-low calc-low 1)) @@ -1894,8 +1903,7 @@ (let ((known (+ (if (Math-objectp calc-low) 1 0) (if (Math-objectp calc-high) 1 0) (if (or (null step) (Math-objectp step)) 1 0))) - (count '(var inf var-inf)) - vec) + (count '(var inf var-inf))) ;; vec (or (= known 2) ; handy optimization (equal calc-high '(var inf var-inf)) (progn @@ -1906,6 +1914,7 @@ (setq count (math-trunc count))))) (if (Math-negp count) (setq count -1)) + (defvar var-DUMMY) (if (integerp count) (let ((var-DUMMY nil) (vec math-tabulate-initial) @@ -1939,7 +1948,7 @@ (and (not (and (equal calc-low '(neg (var inf var-inf))) (equal calc-high '(var inf var-inf)))) (list calc-low calc-high)) - (and step (list step)))))) + (and step (list step))))))) (defun math-scan-for-limits (x) (cond ((Math-primp x)) @@ -1951,8 +1960,10 @@ (high-val (math-solve-for (nth 2 x) (1- (length (nth 1 x))) math-var nil)) temp) - (and low-val (math-realp low-val) - high-val (math-realp high-val)) + ;; FIXME: The below is a no-op, but I suspect its result + ;; was meant to be used, tho I don't know what for. + ;; (and low-val (math-realp low-val) + ;; high-val (math-realp high-val)) (and (Math-lessp high-val low-val) (setq temp low-val low-val high-val high-val temp)) (setq calc-low (math-max calc-low (math-ceiling low-val)) @@ -2361,8 +2372,11 @@ (defvar math-try-solve-sign) (defun math-try-solve-for - (math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly) - (let (math-t1 math-t2 math-t3) + (solve-lhs solve-rhs &optional try-solve-sign no-poly) + (let ((math-solve-lhs solve-lhs) + (math-solve-rhs solve-rhs) + (math-try-solve-sign try-solve-sign) + math-t1 math-t2 math-t3) (cond ((equal math-solve-lhs math-solve-var) (setq math-solve-sign math-try-solve-sign) (if (eq math-solve-full 'all) @@ -2721,14 +2735,17 @@ (cons 'vec d) (math-reject-arg expr "Expected a polynomial")))) -(defun math-decompose-poly (math-solve-lhs math-solve-var degree sub-rhs) - (let ((math-solve-rhs (or sub-rhs 1)) +(defun math-decompose-poly (solve-lhs solve-var degree sub-rhs) + (let ((math-solve-lhs solve-lhs) + (math-solve-var solve-var) + (math-solve-rhs (or sub-rhs 1)) math-t1 math-t2 math-t3) (setq math-t2 (math-polynomial-base math-solve-lhs (function - (lambda (math-solve-b) - (let ((math-poly-neg-powers '(1)) + (lambda (solve-b) + (let ((math-solve-b solve-b) + (math-poly-neg-powers '(1)) (math-poly-mult-powers nil) (math-poly-frac-powers 1) (math-poly-exp-base t)) @@ -2964,7 +2981,7 @@ (math-poly-integer-root (car roots)) (setq roots (cdr roots))) (list math-int-factors (nreverse math-int-coefs) math-int-scale)) - (let ((vec nil) res) + (let ((vec nil)) ;; res (while roots (let ((root (car roots)) (math-solve-full (and math-solve-full 'all))) @@ -3109,7 +3126,7 @@ (iters 0) (m (1- (length p))) (try-newt (not polish)) - (tried-newt nil) + ;; (tried-newt nil) b d f x1 dx dxold) (while (and (or (< (setq iters (1+ iters)) 50) @@ -3146,7 +3163,7 @@ (math-lessp (math-abs-approx dx) (calcFunc-scf (math-abs-approx x) -3))) (let ((newt (math-poly-newton-root p x1 7))) - (setq tried-newt t + (setq ;; tried-newt t try-newt nil) (if (math-zerop (cdr newt)) (setq x (car newt) x1 x) @@ -3160,7 +3177,8 @@ (math-nearly-equal x x1)))) (let ((cdx (math-abs-approx dx))) (setq x x1 - tried-newt nil) + ;; tried-newt nil + ) (prog1 (or (<= iters 6) (math-lessp cdx dxold) @@ -3227,7 +3245,9 @@ ;; and math-solve-system-rec, but is used by math-solve-system-subst. (defvar math-solve-simplifying) -(defun math-solve-system (exprs math-solve-vars math-solve-full) +(defun math-solve-system (exprs solve-vars solve-full) + (let ((math-solve-vars solve-vars) + (math-solve-full solve-full)) (setq exprs (mapcar 'list (if (Math-vectorp exprs) (cdr exprs) (list exprs))) @@ -3237,18 +3257,18 @@ (or (let ((math-solve-simplifying nil)) (math-solve-system-rec exprs math-solve-vars nil)) (let ((math-solve-simplifying t)) - (math-solve-system-rec exprs math-solve-vars nil)))) + (math-solve-system-rec exprs math-solve-vars nil))))) -;;; The following backtracking solver works by choosing a variable -;;; and equation, and trying to solve the equation for the variable. -;;; If it succeeds it calls itself recursively with that variable and -;;; equation removed from their respective lists, and with the solution -;;; added to solns as well as being substituted into all existing -;;; equations. The algorithm terminates when any solution path -;;; manages to remove all the variables from var-list. +;; The following backtracking solver works by choosing a variable +;; and equation, and trying to solve the equation for the variable. +;; If it succeeds it calls itself recursively with that variable and +;; equation removed from their respective lists, and with the solution +;; added to solns as well as being substituted into all existing +;; equations. The algorithm terminates when any solution path +;; manages to remove all the variables from `var-list'. -;;; To support calcFunc-roots, entries in eqn-list and solns are -;;; actually lists of equations. +;; To support calcFunc-roots, entries in eqn-list and solns are +;; actually lists of equations. ;; The variables math-solve-system-res and math-solve-system-vv are ;; local to math-solve-system-rec, but are used by math-solve-system-subst. @@ -3437,10 +3457,12 @@ (if (memq (car expr) '(* /)) (math-looks-evenp (nth 1 expr))))) -(defun math-solve-for (lhs rhs math-solve-var math-solve-full &optional sign) - (if (math-expr-contains rhs math-solve-var) - (math-solve-for (math-sub lhs rhs) 0 math-solve-var math-solve-full) - (and (math-expr-contains lhs math-solve-var) +(defun math-solve-for (lhs rhs solve-var solve-full &optional sign) + (let ((math-solve-var solve-var) + (math-solve-full solve-full)) + (if (math-expr-contains rhs solve-var) + (math-solve-for (math-sub lhs rhs) 0 solve-var solve-full) + (and (math-expr-contains lhs solve-var) (math-with-extra-prec 1 (let* ((math-poly-base-variable math-solve-var) (res (math-try-solve-for lhs rhs sign))) @@ -3462,7 +3484,7 @@ (format "*Omitted %d complex solutions" (- old-len new-len))))))) - res))))) + res)))))) (defun math-solve-eqn (expr var full) (if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index 75e691a28ff..f1f67211b84 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -1,4 +1,4 @@ -;;; calcalg3.el --- more algebraic functions for Calc +;;; calcalg3.el --- more algebraic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -120,18 +120,24 @@ (defvar calc-curve-fit-history nil "History for calc-curve-fit.") -(defun calc-curve-fit (arg &optional calc-curve-model - calc-curve-coefnames calc-curve-varnames) +(defvar calc-graph-no-auto-view) +(defvar calc-fit-to-trail nil) + +(defun calc-curve-fit (arg &optional curve-model + curve-coefnames curve-varnames) (interactive "P") (calc-slow-wrapper (setq calc-aborted-prefix nil) - (let ((func (if (calc-is-inverse) 'calcFunc-xfit + (let ((calc-curve-model curve-model) + (calc-curve-coefnames curve-coefnames) + (calc-curve-varnames curve-varnames) + (func (if (calc-is-inverse) 'calcFunc-xfit (if (calc-is-hyperbolic) 'calcFunc-efit 'calcFunc-fit))) key (which 0) (nonlinear nil) (plot nil) - n calc-curve-nvars temp data + n calc-curve-nvars data ;; temp (homog nil) (msgs '( "(Press ? for help)" "1 = linear or multilinear" @@ -321,7 +327,7 @@ (calc-get-fit-variables 1 (1- (length calc-curve-coefnames)) (and homog 1))) ((memq key '(?\$ ?\' ?u ?U)) - (let* ((defvars nil) + (let* (;; (defvars nil) (record-entry nil)) (if (eq key ?\') (let* ((calc-dollar-values calc-arg-values) @@ -472,7 +478,7 @@ (setq defc (calc-invent-parameter-variables nc defv))) (let ((vars (read-string (format-prompt "Fitting variables" - (format "%s; %s)" + (format "%s; %s" (mapconcat 'symbol-name (mapcar (function (lambda (v) (nth 1 v))) @@ -708,7 +714,7 @@ "*Unable to find a sign change in this interval")))) ;;; "rtbis" (but we should be using Brent's method) -(defun math-bisect-root (expr low vlow high vhigh) +(defun math-bisect-root (expr low _vlow high vhigh) (let ((step (math-sub-float high low)) (pos (Math-posp vhigh)) var-DUMMY @@ -726,7 +732,8 @@ (setq high mid vhigh vmid) (setq low mid - vlow vmid))) + ;; vlow vmid + ))) (list 'vec mid vmid))) ;;; "mnewt" @@ -758,7 +765,8 @@ (list 'vec next expr-val)))) -(defun math-find-root (expr var guess math-root-widen) +(defun math-find-root (expr var guess root-widen) + (let ((math-root-widen root-widen)) (if (eq (car-safe expr) 'vec) (let ((n (1- (length expr))) (calc-symbolic-mode nil) @@ -871,7 +879,7 @@ (not (Math-numberp vlow)) (not (Math-numberp vhigh))) (math-search-root expr deriv low vlow high vhigh) - (math-bisect-root expr low vlow high vhigh)))))))))) + (math-bisect-root expr low vlow high vhigh))))))))))) (defun calcFunc-root (expr var guess) (math-find-root expr var guess nil)) @@ -1019,7 +1027,7 @@ math-min-or-max)))))) ;;; "brent" -(defun math-brent-min (expr prec a va x vx b vb) +(defun math-brent-min (expr prec a _va x vx b _vb) (let ((iters (+ 20 (* 5 prec))) (w x) (vw vx) @@ -1181,7 +1189,7 @@ (list 'calcFunc-mrow '(var line-p line-p) (1+ m))))) (math-evaluate-expr expr))) -(defun math-line-min (f1dim line-p line-xi n prec) +(defun math-line-min (f1dim line-p line-xi _n prec) (let* ((var-DUMMY nil) (expr (math-evaluate-expr f1dim)) (params (math-widen-min expr '(float 0 0) '(float 1 0))) @@ -1195,7 +1203,7 @@ (n 0) (var-DUMMY nil) (isvec (math-vectorp var)) - g guesses) + guesses) ;; g (or (math-vectorp var) (setq var (list 'vec var))) (or (math-vectorp guess) @@ -1493,7 +1501,8 @@ (defun math-ninteg-midpoint (expr lo hi mode) ; uses "math-ninteg-temp" (if (eq mode 'inf) - (let ((math-infinite-mode t) temp) + (let (;; (math-infinite-mode t) ;Unused! + temp) (setq temp (math-div 1 lo) lo (math-div 1 hi) hi temp))) @@ -1547,7 +1556,6 @@ (setq math-dummy-counter (1+ math-dummy-counter)))) (defvar math-in-fit 0) -(defvar calc-fit-to-trail nil) (defun calcFunc-fit (expr vars &optional coefs data) (let ((math-in-fit 10)) @@ -1573,6 +1581,7 @@ (defvar math-fit-new-coefs) (defun math-general-fit (expr vars coefs data mode) + (defvar var-YVAL) (defvar var-YVALX) (let ((calc-simplify-mode nil) (math-dummy-counter math-dummy-counter) (math-in-fit 1) @@ -1591,7 +1600,7 @@ (weights nil) (var-YVAL nil) (var-YVALX nil) covar beta - n nn m mm v dummy p) + n m mm v dummy p) ;; nn ;; Validate and parse arguments. (or data @@ -1687,7 +1696,7 @@ (isigsq 1) (xvals (make-vector mm 0)) (i 0) - j k xval yval sigmasqr wt covj covjk covk betaj lud) + j k xval yval sigmasqr wt covj covjk covk betaj) ;; lud (while (<= (setq i (1+ i)) n) ;; Assign various independent variables for this data point. diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 0367c537b5a..1f3ae842638 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1018,7 +1018,8 @@ (make-string (+ w 2) ?\_)) (list 'horiz (if (= h 1) - "V" + (if (char-displayable-p ?√) + "√" "V") (append (list 'vleft (1- a)) (make-list (1- h) " |") '("\\|"))) diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index c8a714900dc..d6842aa7eee 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -1,4 +1,4 @@ -;;; calcsel2.el --- selection functions for Calc +;;; calcsel2.el --- selection functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -34,6 +34,7 @@ ;; The variable calc-sel-reselect is local to the methods below, ;; but is used by some functions in calc-sel.el which are called ;; by the functions below. +(defvar calc-sel-reselect) (defun calc-commute-left (arg) (interactive "p") diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 574261456fc..de9b1f3ff53 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -994,7 +994,7 @@ pre-existing calendar windows." "Set the style of calendar and diary dates to STYLE (a symbol). The valid styles are described in the documentation of `calendar-date-style'." (interactive (list (intern - (completing-read "Date style: " + (completing-read (format-prompt "Date style" "american") '("american" "european" "iso") nil t nil nil "american")))) (or (memq style '(american european iso)) @@ -1096,7 +1096,7 @@ Otherwise, use symbolic time zones like \"CET\"." "Name of buffer used for sunrise/sunset times.") (defconst calendar-hebrew-yahrzeit-buffer "*Yahrzeits*" - "Name of the buffer used by `list-yahrzeit-dates'.") + "Name of the buffer used by `calendar-hebrew-list-yahrzeits'.") (defmacro calendar-increment-month (mon yr n &optional nmonths) "Increment the variables MON and YR by N months. diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index da98e44926e..fbc13f59b2a 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1092,7 +1092,9 @@ This is an option for `diary-display-function'." (if (calendar-date-equal date (car h)) (setq date-holiday-list (append date-holiday-list (cdr h))))) - (insert (if (bobp) "" ?\n) (calendar-date-string date)) + (insert (if (bobp) "" ?\n) + (propertize (calendar-date-string date) + 'font-lock-face 'diary)) (if date-holiday-list (insert ": ")) (setq cc (current-column)) (insert (mapconcat (lambda (x) @@ -1100,7 +1102,10 @@ This is an option for `diary-display-function'." x) date-holiday-list (concat "\n" (make-string cc ?\s)))) - (insert ?\n (make-string (+ cc longest) ?=) ?\n))) + (insert ?\n + (propertize (make-string (+ cc longest) ?=) + 'font-lock-face 'diary) + ?\n))) (let ((this-entry (cadr entry)) this-loc marks temp-face) (unless (zerop (length this-entry)) @@ -2394,6 +2399,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." (defun diary-fancy-date-pattern () "Return a regexp matching the first line of a fancy diary date header. This depends on the calendar date style." + (declare (obsolete nil "28.1")) (concat (calendar-dlet* ((dayname (diary-name-pattern calendar-day-name-array nil t)) @@ -2414,15 +2420,17 @@ This depends on the calendar date style." (defun diary-fancy-date-matcher (limit) "Search for a fancy diary data header, up to LIMIT." + (declare (obsolete nil "28.1")) ;; Any number of " other holiday name" lines, followed by "==" line. - (when (re-search-forward - (format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t) - (put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t) - t)) + (with-suppressed-warnings ((obsolete diary-fancy-date-pattern)) + (when (re-search-forward + (format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t) + (put-text-property (match-beginning 0) (match-end 0) + 'font-lock-multiline t) + t))) (defvar diary-fancy-font-lock-keywords - `((diary-fancy-date-matcher . 'diary) - ("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary) + `(("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary) ("^.*Yahrzeit.*$" . font-lock-constant-face) ("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) ("^Day.*omer.*$" . font-lock-builtin-face) @@ -2443,9 +2451,6 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." (if (looking-at "=+$") (forward-line -1)) (while (and (looking-at " +[^ ]") (zerop (forward-line -1)))) - ;; This check not essential. - (if (looking-at (diary-fancy-date-pattern)) - (setq beg (line-beginning-position))) (goto-char end) (forward-line 0) (while (and (looking-at " +[^ ]") diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 182e99a611f..444a0e53b95 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -310,7 +310,7 @@ to the list. To include the phases of the moon, add (lunar-phases) -to the holiday list, where `lunar-phases' is an Emacs-Lisp function that +to the holiday list, where `lunar-phases' is an Emacs Lisp function that you've written to return a (possibly empty) list of the relevant VISIBLE dates with descriptive strings such as diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 05bb3164e12..07562f62240 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -490,8 +490,8 @@ Uses binary search." (utmin (+ ut (* direction 12.0))) (utmax ut) ; the time searched is between utmin and utmax ;; utmin and utmax are in hours. - (utmoment-old 0.0) ; rise or set approximation - (utmoment 1.0) ; rise or set approximation + (utmoment-old utmin) ; rise or set approximation + (utmoment utmax) ; rise or set approximation (hut 0) ; sun height at utmoment (t0 (car time)) (hmin (cadr (solar-horizontal-coordinates (list t0 utmin) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 638d8c1f884..cf6c20afbd2 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -1,4 +1,4 @@ -;;; time-date.el --- Date and time handling functions +;;; time-date.el --- Date and time handling functions -*- lexical-binding: t -*- ;; Copyright (C) 1998-2020 Free Software Foundation, Inc. @@ -278,6 +278,10 @@ Lower-case specifiers return only the unit. optional leading \".\" for zero-padding. For example, \"%.3Y\" will return something of the form \"001 year\". +The \"%s\" spec takes an additional optional parameter, +introduced by the \",\" character, to say how many decimals to +use. \"%,1s\" means \"use one decimal\". + The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing is output until the first non-zero unit is encountered." @@ -289,10 +293,11 @@ is output until the first non-zero unit is encountered." ("s" "second" 1) ("z"))) (case-fold-search t) - spec match usedunits zeroflag larger prev name unit num zeropos) - (while (string-match "%\\.?[0-9]*\\(.\\)" string start) + spec match usedunits zeroflag larger prev name unit num zeropos + fraction) + (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start) (setq start (match-end 0) - spec (match-string 1 string)) + spec (match-string 2 string)) (unless (string-equal spec "%") (or (setq match (assoc (downcase spec) units)) (error "Bad format specifier: `%s'" spec)) @@ -307,12 +312,17 @@ is output until the first non-zero unit is encountered." (push match usedunits))) (and zeroflag larger (error "Units are not in decreasing order of size")) - (setq seconds (time-convert seconds 'integer)) + (unless (numberp seconds) + (setq seconds (float-time seconds))) + (setq fraction (mod seconds 1) + seconds (round seconds)) (dolist (u units) (setq spec (car u) name (cadr u) unit (nth 2 u)) - (when (string-match (format "%%\\(\\.?[0-9]+\\)?\\(%s\\)" spec) string) + (when (string-match + (format "%%\\(\\.?[0-9]+\\)?\\(,[0-9]+\\)?\\(%s\\)" spec) + string) (if (string-equal spec "z") ; must be last in units (setq string (replace-regexp-in-string @@ -327,9 +337,23 @@ is output until the first non-zero unit is encountered." (setq zeropos (unless (zerop num) (match-beginning 0)))) (setq string (replace-match - (format (concat "%" (match-string 1 string) "d%s") num - (if (string-equal (match-string 2 string) spec) - "" ; lower-case, no unit-name + (format (if (match-string 2 string) + (concat + "%" + (and (match-string 1 string) + (if (= (elt (match-string 1 string) 0) ?.) + (concat "0" (substring + (match-string 1 string) 1)) + (match-string 1 string))) + (concat "." (substring + (match-string 2 string) 1)) + "f%s") + (concat "%" (match-string 1 string) "d%s")) + (if (= unit 1) + (+ num fraction) + num) + (if (string-equal (match-string 3 string) spec) + "" ; lower-case, no unit-name (format " %s%s" name (if (= num 1) "" "s")))) t t string)))))) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 2ee1d34bf15..a26da265fe8 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Created: 25 Mar 1999 -;; Version: 2.6.1 +;; Old-Version: 2.6.1 ;; Keywords: calendar data ;; This file is part of GNU Emacs. @@ -555,7 +555,7 @@ relative only to the time worked today, and not to past time." OLD-DEFAULT hours are set for every day that has no number indicated." (interactive "P") (if old-default (setq old-default (prefix-numeric-value old-default)) - (error "`timelog-make-hours-explicit' requires an explicit argument")) + (error "`timeclock-make-hours-explicit' requires an explicit argument")) (let ((extant-timelog (find-buffer-visiting timeclock-file)) current-date) (with-current-buffer (find-file-noselect timeclock-file t) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 0e4446f77de..3975a9ba6a9 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -4076,7 +4076,9 @@ regexp items." ((equal (file-name-extension f) "todt") "top") ((equal (file-name-extension f) "tody") "diary")))) (push (cons (concat sf-name " (" type ")") f) falist))) - (setq file (completing-read "Choose a filtered items file: " falist nil t nil + (setq file (completing-read (format-prompt "Choose a filtered items file" + (caar falist)) + falist nil t nil 'todo--fifiles-history (caar falist))) (setq file (cdr (assoc-string file falist))) (find-file file) @@ -4724,9 +4726,8 @@ name in `todo-directory'. See also the documentation string of (todo-convert-legacy-date-time))) (forward-line)) (setq file (concat todo-directory - (read-string - (format "Save file as (default \"%s\"): " default) - nil nil default) + (read-string (format-prompt "Save file as" default) + nil nil default) ".todo")) (unless (file-exists-p todo-directory) (make-directory todo-directory)) @@ -6108,11 +6109,12 @@ Valid time strings are those matching `diary-time-regexp'. Typing `<return>' at the prompt returns the current time, if the user option `todo-always-add-time-string' is non-nil, otherwise the empty string (i.e., no time string)." - (let (valid answer) + (let ((default (when todo-always-add-time-string + (format-time-string "%H:%M"))) + valid answer) (while (not valid) - (setq answer (read-string "Enter a clock time: " nil nil - (when todo-always-add-time-string - (format-time-string "%H:%M")))) + (setq answer (read-string (format-prompt "Enter a clock time" default) + nil nil default)) (when (or (string= "" answer) (string-match diary-time-regexp answer)) (setq valid t))) diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1 index 93bd5872f3f..a1c0e41b8da 100644 --- a/lisp/cedet/ChangeLog.1 +++ b/lisp/cedet/ChangeLog.1 @@ -301,7 +301,7 @@ manipulation of `ede-projects' with equivalent and better functions. (ede-proj-load): Replace call to test if dir has project to - explicity ask filesystem if Project.ede is there. + explicitly ask filesystem if Project.ede is there. * ede/config.el: * ede/detect.el: New files. @@ -2101,7 +2101,7 @@ by calling `srecode-cpp-apply-templates'. * srecode/compile.el (srecode-compile-templates): Fix directory - compare of built-in templates. Give built-ins lower piority. + compare of built-in templates. Give built-ins lower priority. Support special variable "project". (srecode-compile-template-table): Set :project slot of new tables. (srecode-compile-one-template-tag): diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index e9dd48c8ab5..409e35ef900 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -215,7 +215,7 @@ the ordering list `autoconf-preferred-macro-order'." (defun autoconf-insert-new-macro (macro &optional param) "Add a call to MACRO in the current autoconf file. Deals with macro order. See `autoconf-preferred-macro-order' and -`autoconf-multi-macros'. +`autoconf-multiple-macros'. Optional argument PARAM is the parameter to pass to the macro as one string." (cond ((member macro autoconf-multiple-macros) ;; This occurs multiple times diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el index b870624f9a1..fe23501807a 100644 --- a/lisp/cedet/ede/detect.el +++ b/lisp/cedet/ede/detect.el @@ -25,7 +25,7 @@ ;; ;; Detection comes in multiple forms: ;; -;; `ede-detect-scan-directory-for-project' - +;; `ede--detect-scan-directory-for-project' - ;; Scan for a project via the file system. ;; `ede-detect-directory-for-project' - ;; Check our file cache for a project. If that fails, use @@ -35,16 +35,6 @@ (require 'ede/auto) ;; Autoload settings. -(when (or (<= emacs-major-version 23) - ;; predicate as name added in Emacs 24.2 - (and (= emacs-major-version 24) - (< emacs-minor-version 2))) - (message "Loading CEDET fallback autoload library.") - (require 'cedet/dominate - (expand-file-name "../../../etc/fallback-libraries/dominate.el" - (file-name-directory load-file-name)))) - - ;;; BASIC PROJECT SCAN ;; (defun ede--detect-stop-scan-p (dir) diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index bfcbd40fcce..a052c5c61e7 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -234,20 +234,19 @@ All files need the macros from lisp.h!" (let* ((D (car dirs)) (ed (expand-file-name D base)) (ef (expand-file-name name ed))) - (if (file-exists-p ef) - (setq ans ef) - ;; Not in this dir? How about subdirs? - (let ((dirfile (directory-files ed t)) - (moredirs nil) - ) - ;; Get all the subdirs. - (dolist (DF dirfile) - (when (and (file-directory-p DF) - (not (string-match "\\.$" DF))) - (push DF moredirs))) - ;; Try again. - (setq ans (ede-emacs-find-in-directories name ed moredirs)) - )) + (when (file-exists-p ed) + (if (file-exists-p ef) + (setq ans ef) + ;; Not in this dir? How about subdirs? + (let ((dirfile (directory-files ed t)) + (moredirs nil)) + ;; Get all the subdirs. + (dolist (DF dirfile) + (when (and (file-directory-p DF) + (not (string-match "\\.$" DF))) + (push DF moredirs))) + ;; Try again. + (setq ans (ede-emacs-find-in-directories name ed moredirs))))) (setq dirs (cdr dirs)))) ans)) diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index db539450e62..1d6a082c5d3 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -96,15 +96,12 @@ of the anchor file for the project." (defun ede--put-inode-dir-hash (dir inode) "Add to the EDE project hash DIR associated with INODE." - (when (fboundp 'puthash) - (puthash dir inode ede-inode-directory-hash) - inode)) + (puthash dir inode ede-inode-directory-hash) + inode) (defun ede--get-inode-dir-hash (dir) "Get the EDE project hash DIR associated with INODE." - (when (fboundp 'gethash) - (gethash dir ede-inode-directory-hash) - )) + (gethash dir ede-inode-directory-hash)) (defun ede--inode-for-dir (dir) "Return the inode for the directory DIR." @@ -272,28 +269,24 @@ Do this only when developing new projects that are incorrectly putting Do this whenever a new project is created, as opposed to loaded." ;; TODO - Use maphash, and delete by regexp, not by dir searching! (setq dir (expand-file-name dir)) - (when (fboundp 'remhash) - (remhash (file-name-as-directory dir) ede-project-directory-hash) - ;; Look for all subdirs of D, and remove them. - (let ((match (concat "^" (regexp-quote dir)))) - (maphash (lambda (K O) - (when (string-match match K) - (remhash K ede-project-directory-hash))) - ede-project-directory-hash)) - )) + (remhash (file-name-as-directory dir) ede-project-directory-hash) + ;; Look for all subdirs of D, and remove them. + (let ((match (concat "^" (regexp-quote dir)))) + (maphash (lambda (K O) + (when (string-match match K) + (remhash K ede-project-directory-hash))) + ede-project-directory-hash))) (defun ede--directory-project-from-hash (dir) "If there is an already loaded project for DIR, return it from the hash." - (when (fboundp 'gethash) - (setq dir (expand-file-name dir)) - (gethash dir ede-project-directory-hash nil))) + (setq dir (expand-file-name dir)) + (gethash dir ede-project-directory-hash nil)) (defun ede--directory-project-add-description-to-hash (dir desc) "Add to the EDE project hash DIR associated with DESC." - (when (fboundp 'puthash) - (setq dir (expand-file-name dir)) - (puthash dir desc ede-project-directory-hash) - desc)) + (setq dir (expand-file-name dir)) + (puthash dir desc ede-project-directory-hash) + desc) ;;; DIRECTORY-PROJECT-P, -CONS ;; diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index a0af4a4ddc5..bcd672133db 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -153,18 +153,9 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)." (let* ((fsrc (expand-file-name src dir)) (elc (concat (file-name-sans-extension fsrc) ".elc"))) (with-no-warnings - (if (< emacs-major-version 24) - ;; Does not have `byte-recompile-file' - (if (or (not (file-exists-p elc)) - (file-newer-than-file-p fsrc elc)) - (progn - (setq comp (1+ comp)) - (byte-compile-file fsrc)) - (setq utd (1+ utd))) - - (if (eq (byte-recompile-file fsrc nil 0) t) - (setq comp (1+ comp)) - (setq utd (1+ utd))))))) + (if (eq (byte-recompile-file fsrc nil 0) t) + (setq comp (1+ comp)) + (setq utd (1+ utd)))))) (oref obj source)) (message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj)) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 58a35d7d8a0..71321e12da3 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -82,8 +82,6 @@ introduced." This variable is for internal use only, and its content depends on the external parser used.") (make-variable-buffer-local 'semantic--parse-table) -(semantic-varalias-obsolete 'semantic-toplevel-bovine-table - 'semantic--parse-table "23.2") (defvar semantic-symbol->name-assoc-list '((type . "Types") @@ -112,17 +110,6 @@ in classes, such as protection labels.") "Value for `case-fold-search' when parsing.") (make-variable-buffer-local 'semantic-case-fold) -(defvar semantic-expand-nonterminal nil - "Function to call for each nonterminal production. -Return a list of non-terminals derived from the first argument, or nil -if it does not need to be expanded. -Languages with compound definitions should use this function to expand -from one compound symbol into several. For example, in C the definition - int a, b; -is easily parsed into one tag. This function should take this -compound tag and turn it into two tags, one for A, and the other for B.") -(make-variable-buffer-local 'semantic-expand-nonterminal) - (defvar semantic--buffer-cache nil "A cache of the fully parsed buffer. If no significant changes have been made (based on the state) then @@ -134,8 +121,6 @@ If you need a tag list, use `semantic-fetch-tags'. If you need the cached values for some reason, chances are you can add a hook to `semantic-after-toplevel-cache-change-hook'.") (make-variable-buffer-local 'semantic--buffer-cache) -(semantic-varalias-obsolete 'semantic-toplevel-bovine-cache - 'semantic--buffer-cache "23.2") (defvar semantic-unmatched-syntax-cache nil "A cached copy of unmatched syntax tokens.") @@ -171,18 +156,6 @@ It is called before any request for tags is made via the function `semantic-fetch-tags' by an application. If any hook returns a nil value, the cached value is returned immediately, even if it is empty.") -(semantic-varalias-obsolete 'semantic-before-toplevel-bovination-hook - 'semantic--before-fetch-tags-hook "23.2") - -(defvar semantic-after-toplevel-bovinate-hook nil - "Hooks run after a toplevel parse. -It is not run if the toplevel parse command is called, and buffer does -not need to be fully reparsed. -For language specific hooks, make sure you define this as a local hook. - -This hook should not be used any more. -Use `semantic-after-toplevel-cache-change-hook' instead.") -(make-obsolete-variable 'semantic-after-toplevel-bovinate-hook nil "23.2") (defvar semantic-after-toplevel-cache-change-hook nil "Hooks run after the buffer tag list has changed. @@ -305,13 +278,6 @@ This hook is for database functions which intend to swap in a tag table. This guarantees that the DB will go before other modes that require a parse of the buffer.") -(semantic-varalias-obsolete 'semantic-init-hooks - 'semantic-init-hook "23.2") -(semantic-varalias-obsolete 'semantic-init-mode-hooks - 'semantic-init-mode-hook "23.2") -(semantic-varalias-obsolete 'semantic-init-db-hooks - 'semantic-init-db-hook "23.2") - (defsubst semantic-error-if-unparsed () "Raise an error if current buffer was not parsed by Semantic." (unless semantic-new-buffer-fcn-was-run @@ -516,8 +482,6 @@ is requested." (semantic-parse-tree-set-needs-rebuild) ;; Remove this hook which tracks if a buffer is up to date or not. (remove-hook 'after-change-functions 'semantic-change-function t) - ;; Old model. Delete someday. - ;;(run-hooks 'semantic-after-toplevel-bovinate-hook) (run-hook-with-args 'semantic-after-toplevel-cache-change-hook semantic--buffer-cache) @@ -540,17 +504,12 @@ is requested." (setq semantic--completion-cache nil) ;; Refresh the display of unmatched syntax tokens if enabled (run-hook-with-args 'semantic-unmatched-syntax-hook - semantic-unmatched-syntax-cache) - ;; Old Semantic 1.3 hook API. Maybe useful forever? - (run-hooks 'semantic-after-toplevel-bovinate-hook) - ) + semantic-unmatched-syntax-cache)) (defvar semantic-working-type 'percent "The type of working message to use when parsing. 'percent means we are doing a linear parse through the buffer. 'dynamic means we are reparsing specific tags.") -(semantic-varalias-obsolete 'semantic-bovination-working-type - 'semantic-working-type "23.2") (defvar semantic-minimum-working-buffer-size (* 1024 5) "The minimum size of a buffer before working messages are displayed. @@ -586,8 +545,6 @@ was marked unparseable, then do nothing, and return the cache." (semantic-active-p) ;; Application hooks say the buffer is safe for parsing (run-hook-with-args-until-failure - 'semantic-before-toplevel-bovination-hook) - (run-hook-with-args-until-failure 'semantic--before-fetch-tags-hook) ;; If the buffer was previously marked unparseable, ;; then don't waste our time. @@ -690,11 +647,6 @@ Does nothing if the current buffer doesn't need reparsing." ;; Return if we are lexically safe lexically-safe)))) -(defun semantic-bovinate-toplevel (&optional ignored) - "Backward compatibility function." - (semantic-fetch-tags)) -(make-obsolete 'semantic-bovinate-toplevel 'semantic-fetch-tags "23.2") - ;; Another approach is to let Emacs call the parser on idle time, when ;; needed, use `semantic-fetch-available-tags' to only retrieve ;; available tags, and setup the `semantic-after-*-hook' hooks to @@ -812,20 +764,6 @@ This function returns semantic tags without overlays." ;; Please move away from these functions, and try using semantic 2.x ;; interfaces instead. ;; -(defsubst semantic-bovinate-region-until-error - (start end nonterm &optional depth) - "NOTE: Use `semantic-parse-region' instead. - -Bovinate between START and END starting with NONTERM. -Optional DEPTH specifies how many levels of parenthesis to enter. -This command will parse until an error is encountered, and return -the list of everything found until that moment. -This is meant for finding variable definitions at the beginning of -code blocks in methods. If `bovine-inner-scope' can also support -commands, use `semantic-bovinate-from-nonterminal-full'." - (semantic-parse-region start end nonterm depth t)) -(make-obsolete 'semantic-bovinate-region-until-error - 'semantic-parse-region "23.2") (defsubst semantic-bovinate-from-nonterminal (start end nonterm &optional depth length) @@ -840,21 +778,6 @@ tokens." (semantic-lex start end (or depth 1) length) nonterm)))) -(defsubst semantic-bovinate-from-nonterminal-full - (start end nonterm &optional depth) - "NOTE: Use `semantic-parse-region' instead. - -Bovinate from within a nonterminal lambda from START to END. -Iterates until all the space between START and END is exhausted. -Argument NONTERM is the nonterminal symbol to start with. -If NONTERM is nil, use `bovine-block-toplevel'. -Optional argument DEPTH is the depth of lists to dive into. -When used in a `lambda' of a MATCH-LIST, there is no need to include -a START and END part." - (semantic-parse-region start end nonterm (or depth 1))) -(make-obsolete 'semantic-bovinate-from-nonterminal-full - 'semantic-parse-region "23.2") - ;;; User interface (defun semantic-force-refresh () diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index 656c63b7eed..bbed1d94f20 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -420,7 +420,6 @@ Return a bovination list to use." :parent (symbol-name (nth 2 form)) :documentation (semantic-elisp-do-doc (nth 4 form)) ))) - define-mode-overload-implementation ;; obsoleted define-mode-local-override ) @@ -650,7 +649,7 @@ define-mode-overload\\)\ )) (when fun ;; Do not return FUN IFF the cursor is on FUN. - ;; Huh? Thats because if cursor is on fun, it is + ;; Huh? That's because if cursor is on fun, it is ;; the current symbol, and not the current function. (if (save-excursion (condition-case nil diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el index 7b835b85097..10afb065320 100644 --- a/lisp/cedet/semantic/bovine/grammar.el +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -143,8 +143,7 @@ expanded from elsewhere." form (cdr form)) ;; Hack for dealing with new reading of unquotes outside of ;; backquote (introduced in 2010-12-06T16:37:26Z!monnier@iro.umontreal.ca). - (when (and (>= emacs-major-version 24) - (listp first) + (when (and (listp first) (or (equal (car first) '\,) (equal (car first) '\,@))) (if (listp (cadr first)) diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el index 93ad27586ed..b2a25bf8eef 100644 --- a/lisp/cedet/semantic/bovine/scm.el +++ b/lisp/cedet/semantic/bovine/scm.el @@ -69,7 +69,7 @@ Attempts a simple prototype for calling or using TAG." ;; Note: Analyzer from Henry S. Thompson (define-lex-regex-analyzer semantic-lex-scheme-symbol "Detect and create symbol and keyword tokens." - "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)*\\)" + "\\(\\sw\\|\\s_\\)+" ;; (message "symbol: %s" (match-string 0)) (semantic-lex-push-token (semantic-lex-token diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 510f931fa9f..86ccf28ad02 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -1245,7 +1245,7 @@ See `semanticdb-find-translate-path' for details on PATH. The argument BRUTISH will be set so that searching includes all tables in the current project. FIND-FILE-MATCH indicates that any time a match is found, the file -associated wit that tag should be loaded into a buffer." +associated with that tag should be loaded into a buffer." (semanticdb-find-tags-collector (lambda (table tags) (semanticdb-deep-find-tags-by-name-method table name tags)) @@ -1257,7 +1257,7 @@ See `semanticdb-find-translate-path' for details on PATH. The argument BRUTISH will be set so that searching includes all tables in the current project. FIND-FILE-MATCH indicates that any time a match is found, the file -associated wit that tag should be loaded into a buffer." +associated with that tag should be loaded into a buffer." (semanticdb-find-tags-collector (lambda (table tags) (semanticdb-deep-find-tags-for-completion-method table prefix tags)) diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el index 0ab03ef49ef..16a30b6cfbc 100644 --- a/lisp/cedet/semantic/db-mode.el +++ b/lisp/cedet/semantic/db-mode.el @@ -69,10 +69,6 @@ database, which can be saved for future Emacs sessions." (dolist (elt semanticdb-hooks) (remove-hook (cadr elt) (car elt))))) -(semantic-varalias-obsolete 'semanticdb-mode-hooks - 'global-semanticdb-minor-mode-hook "23.2") - - (defun semanticdb-toggle-global-mode () "Toggle use of the Semantic Database feature. Update the environment of Semantic enabled buffers accordingly." diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index aaf43a17293..60a65b195bc 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -89,7 +89,7 @@ same major mode as the current buffer.") :documentation "The tags belonging to this table.") (db-refs :initform nil :documentation - "List of `semanticdb-table' objects refering to this one. + "List of `semanticdb-table' objects referring to this one. These aren't saved, but are instead recalculated after load. See the file semanticdb-ref.el for how this slot is used.") (index :type semanticdb-abstract-search-index @@ -764,7 +764,7 @@ If a particular major mode wants to search any mode, put the Do not set the value of this variable permanently.") (defmacro semanticdb-with-match-any-mode (&rest body) - "A Semanticdb search occurring withing BODY will search tags in all modes. + "A Semanticdb search occurring within BODY will search tags in all modes. This temporarily sets `semanticdb-match-any-mode' while executing BODY." (declare (indent 0) (debug t)) `(let ((semanticdb-match-any-mode t)) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 8eb6a3bbd5d..293692000df 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -204,9 +204,6 @@ Also make sure old decorations in the area are completely flushed." (defvar semantic-decorate-pending-decoration-hook nil "Normal hook run to perform pending decoration changes.") -(semantic-varalias-obsolete 'semantic-decorate-pending-decoration-hooks - 'semantic-decorate-pending-decoration-hook "23.2") - (defun semantic-decorate-add-pending-decoration (fcn &optional buffer) "Add a pending decoration change represented by FCN. Applies only to the current BUFFER. diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index 8b39e775789..896bc3bb42e 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -93,8 +93,7 @@ just the lexical token and not the string." Attempt to strip out comment syntactic sugar. Argument NOSNARF means don't modify the found text. If NOSNARF is `lex', then return the lex token." - (let* ((semantic-ignore-comments nil) - (semantic-lex-analyzer #'semantic-comment-lexer)) + (let* ((semantic-lex-analyzer #'semantic-comment-lexer)) (if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility (car (semantic-lex (point) (1+ (point)))) (let ((ct (semantic-lex-token-text diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index 2464833859b..d435ff6b6e9 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -142,19 +142,10 @@ Lays claim to all -by.el, and -wy.el files." (match-string 1 package))) (src (ede-expand-filename obj fname)) (csrc (concat (file-name-sans-extension src) ".elc"))) - (if (< emacs-major-version 24) - ;; Does not have `byte-recompile-file' - (if (or (not (file-exists-p csrc)) - (file-newer-than-file-p src csrc)) - (progn - (setq comp (1+ comp)) - (byte-compile-file src)) - (setq utd (1+ utd))) - ;; Emacs 24 and newer - (with-no-warnings - (if (eq (byte-recompile-file src nil 0) t) - (setq comp (1+ comp)) - (setq utd (1+ utd)))))))) + (with-no-warnings + (if (eq (byte-recompile-file src nil 0) t) + (setq comp (1+ comp)) + (setq utd (1+ utd))))))) (oref obj source)) (message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj)) (cons comp utd))) diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index a1225dfeee9..e4319c7d1b3 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -121,9 +121,6 @@ incremental reparse.") "Hook run after the incremental parser fails. When this happens, the buffer is marked as needing a full reparse.") -(semantic-varalias-obsolete 'semantic-edits-incremental-reparse-failed-hooks - 'semantic-edits-incremental-reparse-failed-hook "23.2") - (defcustom semantic-edits-verbose-flag nil "Non-nil means the incremental parser is verbose. If nil, errors are still displayed, but informative messages are not." diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index e347c99f191..c86cd3abf3d 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -173,6 +173,7 @@ Remove self from `post-command-hook' if it is empty." ;; (defun semantic-overload-symbol-from-function (name) "Return the symbol for overload used by NAME, the defined symbol." + (declare (obsolete define-obsolete-function-alias "28.1")) (let ((sym-name (symbol-name name))) (if (string-match "^semantic-" sym-name) (intern (substring sym-name (match-end 0))) @@ -182,6 +183,7 @@ Remove self from `post-command-hook' if it is empty." "Make OLDFNALIAS an alias for NEWFN. Mark OLDFNALIAS as obsolete, such that the byte compiler will throw a warning when it encounters this symbol." + (declare (obsolete define-obsolete-function-alias "28.1")) (defalias oldfnalias newfn) (make-obsolete oldfnalias newfn when) (when (and (mode-local--function-overload-p newfn) @@ -196,13 +198,14 @@ will throw a warning when it encounters this symbol." "%s: `%s' obsoletes overload `%s'" byte-compile-current-file newfn - (semantic-overload-symbol-from-function oldfnalias)) - )) + (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function)) + (semantic-overload-symbol-from-function oldfnalias))))) (defun semantic-varalias-obsolete (oldvaralias newvar when) "Make OLDVARALIAS an alias for variable NEWVAR. Mark OLDVARALIAS as obsolete, such that the byte compiler will throw a warning when it encounters this symbol." + (declare (obsolete define-obsolete-variable-alias "28.1")) (make-obsolete-variable oldvaralias newvar when) (condition-case nil (defvaralias oldvaralias newvar) @@ -256,9 +259,6 @@ FUNCTION does not have arguments. When FUNCTION is entered (defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers) -(semantic-alias-obsolete 'define-mode-overload-implementation - 'define-mode-local-override "23.2") - (defun semantic-install-function-overrides (overrides &optional transient) "Install the function OVERRIDES in the specified environment. OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD @@ -396,13 +396,10 @@ into `mode-local-init-hook'." file filename) ;; "define-lex-regex-type-analyzer" ;; "define-lex-string-type-analyzer" ;; "define-lex-block-type-analyzer" -;; ;;"define-mode-overload-implementation" ;; ;;"define-semantic-child-mode" ;; "define-semantic-idle-service" ;; "define-semantic-decoration-style" ;; "define-wisent-lexer" -;; "semantic-alias-obsolete" -;; "semantic-varalias-obsolete" ;; "semantic-make-obsolete-overload" ;; "defcustom-mode-local-semantic-dependency-system-include-path" ;; )) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 6cd4832165c..f71ac6c413e 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -142,7 +142,7 @@ It ignores whitespaces, newlines and comments." "Return expansion of built-in ASSOC expression. ARGS are ASSOC's key value list." (let ((key t)) - `(semantic-tag-make-assoc-list + `(semantic-tag-make-plist ,@(mapcar #'(lambda (i) (prog1 (if key diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 76218249c59..8301b195309 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -472,11 +472,6 @@ This hook is not protected from lexical errors.") If any hook function throws an error, this variable is reset to nil. This hook is not protected from lexical errors.") -(semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks - 'semantic-before-idle-scheduler-reparse-hook "23.2") -(semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks - 'semantic-after-idle-scheduler-reparse-hook "23.2") - (defun semantic-idle-scheduler-refresh-tags () "Refreshes the current buffer's tags. This is called by `semantic-idle-scheduler-function' to update the @@ -734,10 +729,6 @@ specific to a major mode. For example, in jde mode: (define-overloadable-function semantic-idle-summary-current-symbol-info () "Return a string message describing the current context.") -(make-obsolete-overload 'semantic-eldoc-current-symbol-info - 'semantic-idle-summary-current-symbol-info - "23.2") - (defcustom semantic-idle-summary-mode-hook nil "Hook run at the end of `semantic-idle-summary'." :group 'semantic diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index cdf0a23fa07..25f7fdb8426 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -88,8 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil." :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-expand-type-members) -(semantic-varalias-obsolete 'semantic-imenu-expand-type-parts - 'semantic-imenu-expand-type-members "23.2") (defcustom semantic-imenu-bucketize-type-members t "Non-nil if members of a type should be grouped into buckets. @@ -98,8 +96,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil." :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-bucketize-type-members) -(semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts - 'semantic-imenu-bucketize-type-members "23.2") (defcustom semantic-imenu-sort-bucket-function nil "Function to use when sorting tags in the buckets of functions. @@ -145,8 +141,6 @@ Tags of those classes will be given submenu with children. By default, a `type' has interesting children. In Texinfo, however, a `section' has interesting children.") (make-variable-buffer-local 'semantic-imenu-expandable-tag-classes) -(semantic-varalias-obsolete 'semantic-imenu-expandable-token - 'semantic-imenu-expandable-tag-classes "23.2") ;;; Code: (defun semantic-imenu-tag-overlay (tag) diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index 80d03dc629b..cc53f69691b 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -253,9 +253,6 @@ Optional argument COLOR indicates that color should be mixed in." 'semantic-format-tag-prototype-default) tag parent color))) -(semantic-alias-obsolete 'semantic-java-prototype-nonterminal - 'semantic-format-tag-prototype-java-mode "23.2") - ;; Include Tag Name ;; @@ -324,7 +321,7 @@ If NOSNARF is `lex', then return the semantic lex token." (defvar semantic-java-doc-line-tags nil "Valid javadoc line tags. Ordered following Sun's Tag Convention at -<http://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>") +<https://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>") (defvar semantic-java-doc-with-name-tags nil "Javadoc tags which have a name.") diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 500a09d492f..809271ddccd 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -1069,7 +1069,7 @@ Only in effect if `debug-on-error' is also non-nil." "For SYNTAX, execute FORMS with protection for unterminated syntax. If FORMS throws an error, treat this as a syntax problem, and execute the unterminated syntax code. FORMS should return a position. -Irregardless of an error, the cursor should be moved to the end of +Regardless of an error, the cursor should be moved to the end of the desired syntax, and a position returned. If `debug-on-error' is set, errors are not caught, so that you can debug them. @@ -1701,9 +1701,6 @@ If there is no error, then the last value of FORMS is returned." `(let* ((semantic-lex-unterminated-syntax-end-function (lambda (,syntax ,start ,end) (throw ',symbol ,syntax))) - ;; Delete the below when semantic-flex is fully retired. - (semantic-flex-unterminated-syntax-end-function - semantic-lex-unterminated-syntax-end-function) (,ret (catch ',symbol (save-excursion ,@forms @@ -1751,32 +1748,12 @@ If there is no error, then the last value of FORMS is returned." )) ;;; Compatibility with Semantic 1.x lexical analysis -;; -;; NOTE: DELETE THIS SOMEDAY SOON - -(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start "23.2") -(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end "23.2") -(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text "23.2") -(semantic-alias-obsolete 'semantic-flex-make-keyword-table 'semantic-lex-make-keyword-table "23.2") -(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p "23.2") -(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put "23.2") -(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get "23.2") -(semantic-alias-obsolete 'semantic-flex-map-keywords 'semantic-lex-map-keywords "23.2") -(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords "23.2") -(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer "23.2") -(semantic-alias-obsolete 'semantic-flex-list 'semantic-lex-list "23.2") - -;; This simple scanner uses the syntax table to generate a stream of -;; simple tokens of the form: -;; -;; (SYMBOL START . END) -;; -;; Where symbol is the type of thing it is. START and END mark that -;; objects boundary. (defvar semantic-flex-tokens semantic-lex-tokens "An alist of semantic token types. See variable `semantic-lex-tokens'.") +(make-obsolete-variable 'semantic-flex-tokens + 'semantic-lex-tokens "28.1") (defvar semantic-flex-unterminated-syntax-end-function (lambda (_syntax _syntax-start flex-end) flex-end) @@ -1788,6 +1765,8 @@ FLEX-END is where the lexical analysis was asked to end. This function can be used for languages that can intelligently fix up broken syntax, or the exit lexical analysis via `throw' or `signal' when finding unterminated syntax.") +(make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function + nil "28.1") (defvar semantic-flex-extensions nil "Buffer local extensions to the lexical analyzer. @@ -1799,6 +1778,7 @@ nil is also a valid return value. TYPE can be any type of symbol, as long as it doesn't occur as a nonterminal in the language definition.") (make-variable-buffer-local 'semantic-flex-extensions) +(make-obsolete-variable 'semantic-flex-extensions nil "28.1") (defvar semantic-flex-syntax-modifications nil "Changes to the syntax table for this buffer. @@ -1809,237 +1789,47 @@ CHAR is the char passed to `modify-syntax-entry', and CLASS is the string also passed to `modify-syntax-entry' to define what syntax class CHAR has.") (make-variable-buffer-local 'semantic-flex-syntax-modifications) +(make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1") (defvar semantic-ignore-comments t "Default comment handling. The value t means to strip comments when flexing; nil means to keep comments as part of the token stream.") (make-variable-buffer-local 'semantic-ignore-comments) +(make-obsolete-variable 'semantic-ignore-comments nil "28.1") (defvar semantic-flex-enable-newlines nil "When flexing, report newlines as syntactic elements. Useful for languages where the newline is a special case terminator. Only set this on a per mode basis, not globally.") (make-variable-buffer-local 'semantic-flex-enable-newlines) +(make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1") (defvar semantic-flex-enable-whitespace nil "When flexing, report whitespace as syntactic elements. Useful for languages where the syntax is whitespace dependent. Only set this on a per mode basis, not globally.") (make-variable-buffer-local 'semantic-flex-enable-whitespace) +(make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1") (defvar semantic-flex-enable-bol nil "When flexing, report beginning of lines as syntactic elements. Useful for languages like python which are indentation sensitive. Only set this on a per mode basis, not globally.") (make-variable-buffer-local 'semantic-flex-enable-bol) +(make-obsolete-variable 'semantic-flex-enable-bol nil "28.1") (defvar semantic-number-expression semantic-lex-number-expression "See variable `semantic-lex-number-expression'.") (make-variable-buffer-local 'semantic-number-expression) +(make-obsolete-variable 'semantic-number-expression + 'semantic-lex-number-expression "28.1") (defvar semantic-flex-depth 0 "Default flexing depth. This specifies how many lists to create tokens in.") (make-variable-buffer-local 'semantic-flex-depth) - -(defun semantic-flex (start end &optional depth length) - "Using the syntax table, do something roughly equivalent to flex. -Semantically check between START and END. Optional argument DEPTH -indicates at what level to scan over entire lists. -The return value is a token stream. Each element is a list, such of -the form (symbol start-expression . end-expression) where SYMBOL -denotes the token type. -See `semantic-flex-tokens' variable for details on token types. -END does not mark the end of the text scanned, only the end of the -beginning of text scanned. Thus, if a string extends past END, the -end of the return token will be larger than END. To truly restrict -scanning, use `narrow-to-region'. -The last argument, LENGTH specifies that `semantic-flex' should only -return LENGTH tokens." - (declare (obsolete define-lex "23.2")) - (if (not semantic-flex-keywords-obarray) - (setq semantic-flex-keywords-obarray [ nil ])) - (let ((ts nil) - (pos (point)) - (ep nil) - (curdepth 0) - (cs (if comment-start-skip - (concat "\\(\\s<\\|" comment-start-skip "\\)") - (concat "\\(\\s<\\)"))) - (newsyntax (copy-syntax-table (syntax-table))) - (mods semantic-flex-syntax-modifications) - ;; Use the default depth if it is not specified. - (depth (or depth semantic-flex-depth))) - ;; Update the syntax table - (while mods - (modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax) - (setq mods (cdr mods))) - (with-syntax-table newsyntax - (goto-char start) - (while (and (< (point) end) (or (not length) (<= (length ts) length))) - (cond - ;; catch beginning of lines when needed. - ;; Must be done before catching any other tokens! - ((and semantic-flex-enable-bol - (bolp) - ;; Just insert a (bol N . N) token in the token stream, - ;; without moving the point. N is the point at the - ;; beginning of line. - (setq ts (cons (cons 'bol (cons (point) (point))) ts)) - nil)) ;; CONTINUE - ;; special extensions, includes whitespace, nl, etc. - ((and semantic-flex-extensions - (let ((fe semantic-flex-extensions) - (r nil)) - (while fe - (if (looking-at (car (car fe))) - (setq ts (cons (funcall (cdr (car fe))) ts) - r t - fe nil - ep (point))) - (setq fe (cdr fe))) - (if (and r (not (car ts))) (setq ts (cdr ts))) - r))) - ;; catch newlines when needed - ((looking-at "\\s-*\\(\n\\|\\s>\\)") - (if semantic-flex-enable-newlines - (setq ep (match-end 1) - ts (cons (cons 'newline - (cons (match-beginning 1) ep)) - ts)))) - ;; catch whitespace when needed - ((looking-at "\\s-+") - (if semantic-flex-enable-whitespace - ;; Language wants whitespaces, link them together. - (if (eq (car (car ts)) 'whitespace) - (setcdr (cdr (car ts)) (match-end 0)) - (setq ts (cons (cons 'whitespace - (cons (match-beginning 0) - (match-end 0))) - ts))))) - ;; numbers - ((and semantic-number-expression - (looking-at semantic-number-expression)) - (setq ts (cons (cons 'number - (cons (match-beginning 0) - (match-end 0))) - ts))) - ;; symbols - ((looking-at "\\(\\sw\\|\\s_\\)+") - (setq ts (cons (cons - ;; Get info on if this is a keyword or not - (or (semantic-lex-keyword-p (match-string 0)) - 'symbol) - (cons (match-beginning 0) (match-end 0))) - ts))) - ;; Character quoting characters (ie, \n as newline) - ((looking-at "\\s\\+") - (setq ts (cons (cons 'charquote - (cons (match-beginning 0) (match-end 0))) - ts))) - ;; Open parens, or semantic-lists. - ((looking-at "\\s(") - (if (or (not depth) (< curdepth depth)) - (progn - (setq curdepth (1+ curdepth)) - (setq ts (cons (cons 'open-paren - (cons (match-beginning 0) (match-end 0))) - ts))) - (setq ts (cons - (cons 'semantic-list - (cons (match-beginning 0) - (save-excursion - (condition-case nil - (forward-list 1) - ;; This case makes flex robust - ;; to broken lists. - (error - (goto-char - (funcall - semantic-flex-unterminated-syntax-end-function - 'semantic-list - start end)))) - (setq ep (point))))) - ts)))) - ;; Close parens - ((looking-at "\\s)") - (setq ts (cons (cons 'close-paren - (cons (match-beginning 0) (match-end 0))) - ts)) - (setq curdepth (1- curdepth))) - ;; String initiators - ((looking-at "\\s\"") - ;; Zing to the end of this string. - (setq ts (cons (cons 'string - (cons (match-beginning 0) - (save-excursion - (condition-case nil - (forward-sexp 1) - ;; This case makes flex - ;; robust to broken strings. - (error - (goto-char - (funcall - semantic-flex-unterminated-syntax-end-function - 'string - start end)))) - (setq ep (point))))) - ts))) - ;; comments - ((looking-at cs) - (if (and semantic-ignore-comments - (not semantic-flex-enable-whitespace)) - ;; If the language doesn't deal with comments nor - ;; whitespaces, ignore them here. - (let ((comment-start-point (point))) - (forward-comment 1) - (if (eq (point) comment-start-point) - ;; In this case our start-skip string failed - ;; to work properly. Lets try and move over - ;; whatever white space we matched to begin - ;; with. - (skip-syntax-forward "-.'" (point-at-eol)) - ;;(forward-comment 1) - ;; Generate newline token if enabled - (if (and semantic-flex-enable-newlines - (bolp)) - (backward-char 1))) - (if (eq (point) comment-start-point) - (error "Strange comment syntax prevents lexical analysis")) - (setq ep (point))) - (let ((tk (if semantic-ignore-comments 'whitespace 'comment))) - (save-excursion - (forward-comment 1) - ;; Generate newline token if enabled - (if (and semantic-flex-enable-newlines - (bolp)) - (backward-char 1)) - (setq ep (point))) - ;; Language wants comments or want them as whitespaces, - ;; link them together. - (if (eq (car (car ts)) tk) - (setcdr (cdr (car ts)) ep) - (setq ts (cons (cons tk (cons (match-beginning 0) ep)) - ts)))))) - ;; punctuation - ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)") - (setq ts (cons (cons 'punctuation - (cons (match-beginning 0) (match-end 0))) - ts))) - ;; unknown token - (t - (error "What is that?"))) - (goto-char (or ep (match-end 0))) - (setq ep nil))) - ;; maybe catch the last beginning of line when needed - (and semantic-flex-enable-bol - (= (point) end) - (bolp) - (setq ts (cons (cons 'bol (cons (point) (point))) ts))) - (goto-char pos) - ;;(message "Flexing muscles...done") - (nreverse ts))) +(make-obsolete-variable 'semantic-flex-depth nil "28.1") (provide 'semantic/lex) diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 23f5f89274f..fc7f9dbcb64 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -85,10 +85,12 @@ current project to find references to the input SYM. The references are the organized by file and the name of the function they are used in. Display the references in `semantic-symref-results-mode'." - (interactive (list (let ((tag (semantic-current-tag))) - (read-string " Symrefs for: " nil nil - (when tag - (regexp-quote (semantic-tag-name tag))))))) + (interactive (list (let* ((tag (semantic-current-tag)) + (default (when tag + (regexp-quote + (semantic-tag-name tag))))) + (read-string (format-prompt " Symrefs for" default) + nil nil default)))) ;; FIXME: Shouldn't the input be in Emacs regexp format, for ;; consistency? Converting it to extended is not hard. (semantic-fetch-tags) diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index 50d43fe9342..23f4b29cbd6 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -101,9 +101,6 @@ PARENT can also be a `semanticdb-table' object." ) ) -(make-obsolete-overload 'semantic-find-nonterminal - 'semantic-go-to-tag "23.2") - ;;; Dependencies ;; ;; A tag which is of type 'include specifies a dependency. @@ -175,9 +172,6 @@ Depends on `semantic-dependency-include-path' for searching. Always searches nil) ))) -(make-obsolete-overload 'semantic-find-dependency - 'semantic-dependency-tag-file "23.2") - ;;; PROTOTYPE FILE ;; ;; In C, a function in the .c file often has a representation in a @@ -199,13 +193,6 @@ file prototypes belong in." (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t) (match-string 1)))))) -(semantic-alias-obsolete 'semantic-find-nonterminal - 'semantic-go-to-tag "23.2") - -(semantic-alias-obsolete 'semantic-find-dependency - 'semantic-dependency-tag-file "23.2") - - (provide 'semantic/tag-file) ;; Local variables: diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 16179a53cd5..3ee11df7d8e 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -190,7 +190,7 @@ See `semantic-tag-similar-p' for details." ;; will contain the info needed to determine the full name. (define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer) "Return the fully qualified package name of TAG in a package hierarchy. -STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', +STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table', but must be a toplevel semantic tag stream that contains TAG. A Package Hierarchy is defined in UML by the way classes and methods are organized on disk. Some languages use this concept such that a @@ -213,7 +213,7 @@ Return the name of the first tag of class `package' in STREAM." (define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer) "Return the fully qualified name of TAG in the package hierarchy. -STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', +STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table', but must be a toplevel semantic tag stream that contains TAG. A Package Hierarchy is defined in UML by the way classes and methods are organized on disk. Some languages use this concept such that a @@ -233,9 +233,6 @@ resolve issues where a method in a class in a package is present." (or stream-or-buffer tag)))) (:override-with-args (tag stream)))) -(make-obsolete-overload 'semantic-nonterminal-full-name - 'semantic-tag-full-name "23.2") - (defun semantic-tag-full-name-default (tag stream) "Default method for `semantic-tag-full-name'. Return the name of TAG found in the toplevel STREAM." @@ -287,9 +284,6 @@ is to return a symbol based on type modifiers." (setq parent (semantic-tag-calculate-parent tag))) (:override)) -(make-obsolete-overload 'semantic-nonterminal-protection - 'semantic-tag-protection "23.2") - (defun semantic-tag-protection-default (tag &optional parent) "Return the protection of TAG as a child of PARENT default action. See `semantic-tag-protection'." @@ -377,9 +371,6 @@ in how methods are overridden. In UML, abstract methods are italicized. The default behavior (if not overridden with `tag-abstract-p' is to return true if `abstract' is in the type modifiers.") -(make-obsolete-overload 'semantic-nonterminal-abstract - 'semantic-tag-abstract-p "23.2") - (defun semantic-tag-abstract-p-default (tag &optional parent) "Return non-nil if TAG is abstract as a child of PARENT default action. See `semantic-tag-abstract-p'." @@ -400,9 +391,6 @@ In UML, leaf methods and classes have special meaning and behavior. The default behavior (if not overridden with `tag-leaf-p' is to return true if `leaf' is in the type modifiers.") -(make-obsolete-overload 'semantic-nonterminal-leaf - 'semantic-tag-leaf-p "23.2") - (defun semantic-tag-leaf-p-default (tag &optional parent) "Return non-nil if TAG is leaf as a child of PARENT default action. See `semantic-tag-leaf-p'." diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index ca5c068d348..e677264c5a9 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1328,26 +1328,6 @@ This function is overridable with the symbol `insert-foreign-tag'." (defconst semantic-token-incompatible-version semantic-tag-incompatible-version) -(defsubst semantic-token-type-parent (tag) - "Return the parent of the type that TAG describes. -The return value is a list. A value of nil means no parents. -The `car' of the list is either the parent class, or a list -of parent classes. The `cdr' of the list is the list of -interfaces, or abstract classes which are parents of TAG." - (cons (semantic-tag-get-attribute tag :superclasses) - (semantic-tag-type-interfaces tag))) - -(make-obsolete 'semantic-token-type-parent - "\ -use `semantic-tag-type-superclass' \ -and `semantic-tag-type-interfaces' instead" "23.2") - -(semantic-alias-obsolete 'semantic-tag-make-assoc-list - 'semantic-tag-make-plist "23.2") - -(semantic-varalias-obsolete 'semantic-expand-nonterminal - 'semantic-tag-expand-function "23.2") - (provide 'semantic/tag) ;; Local variables: diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index c64d56b2e21..7df7dfcb75f 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -79,9 +79,6 @@ If FILE is not loaded, and semanticdb is not available, find the file (with-current-buffer (find-file-noselect file) (semantic-fetch-tags)))))) -(semantic-alias-obsolete 'semantic-file-token-stream - 'semantic-file-tag-table "23.2") - (declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t) (declare-function semanticdb-refresh-table "semantic/db") (declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t) @@ -137,9 +134,6 @@ buffer, or a filename. If SOMETHING is nil return nil." ;; don't know what it is (t nil))) -(semantic-alias-obsolete 'semantic-something-to-stream - 'semantic-something-to-tag-table "23.2") - ;;; Completion APIs ;; ;; These functions provide minibuffer reading/completion for lists of @@ -307,7 +301,6 @@ If TAG is not specified, use the tag at point." semantic-init-db-hook semantic-unmatched-syntax-hook semantic--before-fetch-tags-hook - semantic-after-toplevel-bovinate-hook semantic-after-toplevel-cache-change-hook semantic-before-toplevel-cache-flush-hook semantic-dump-parse diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index 527a35c9ae1..15d1313dfa4 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -43,11 +43,6 @@ "Extra lookahead token. When non-nil it is directly returned by `wisent-lex-function'.") -;; Maintain this alias for compatibility until all WY grammars have -;; been translated again to Elisp code. -(semantic-alias-obsolete 'wisent-lex-make-token-table - 'semantic-lex-make-type-table "23.2") - (defmacro wisent-lex-eoi () "Return an End-Of-Input lexical token. The EOI token is like this: ($EOI \"\" POINT-MAX . POINT-MAX)." diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index 49b0fd1b3b4..0ff9cde80ef 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -427,7 +427,7 @@ Menu items are appended to the common grammar menu.") "\n;; It is derived from the grammar in the ECMAScript Language ;; Specification published at ;; -;; http://www.ecma-international.org/publications/standards/Ecma-262.htm +;; https://www.ecma-international.org/publications/standards/Ecma-262.htm ;; ;; and redistributed under the following license: ;; diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index e46c5820c55..87c7c684dab 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -164,7 +164,7 @@ Has virtual :start and :end initializers.") (cl-defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to) "Return the text under OLAID. -If SET-TO is a string, then replace the text of OLAID wit SET-TO." +If SET-TO is a string, then replace the text of OLAID with SET-TO." (let* ((ol (oref olaid overlay)) (start (overlay-start ol))) (if (not (stringp set-to)) diff --git a/lisp/char-fold.el b/lisp/char-fold.el index 5a3c20c7832..34561a2efe6 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -324,6 +324,13 @@ from which to start." (while (< i end) (pcase (aref string i) (?\s (setq spaces (1+ spaces))) + ((pred (lambda (c) (and char-fold-symmetric + (if isearch-regexp + isearch-regexp-lax-whitespace + isearch-lax-whitespace) + (stringp search-whitespace-regexp) + (string-match-p search-whitespace-regexp (char-to-string c))))) + (setq spaces (1+ spaces))) (c (when (> spaces 0) (push (char-fold--make-space-string spaces) out) (setq spaces 0)) diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index d4bec95ebad..7191b933e41 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -327,9 +327,8 @@ With a prefix argument switch off tracing of procedure PROC." (interactive (list (let ((current (symbol-at-point)) (action (if current-prefix-arg "Untrace" "Trace"))) - (if current - (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current)) - (read-string (format "%s procedure: " action)))) + (read-string (format-prompt "%s procedure" current action) + nil nil (and current (symbol-name current)))) current-prefix-arg)) (when (= (length proc) 0) (error "Invalid procedure name")) diff --git a/lisp/color.el b/lisp/color.el index 560631ae66d..48f150de70c 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -50,7 +50,7 @@ numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive. Optional argument FRAME specifies the frame where the color is to be displayed. If FRAME is omitted or nil, use the selected frame. If FRAME cannot display COLOR, return nil." - ;; `colors-values' maximum value is either 65535 or 65280 depending on the + ;; `color-values' maximum value is either 65535 or 65280 depending on the ;; display system. So we use a white conversion to get the max value. (let ((valmax (float (car (color-values "#ffffffffffff"))))) (mapcar (lambda (x) (/ x valmax)) (color-values color frame)))) diff --git a/lisp/comint.el b/lisp/comint.el index b4ea232767c..2873416c5f4 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -362,6 +362,7 @@ This variable is buffer-local." ;; Some implementations of passwd use "Password (again)" as the 2nd prompt. ;; Something called "perforce" uses "Enter password:". ;; OpenVPN prints a prompt like: "Enter Auth Password:". +;; OpenBSD doas prints "doas (user@host) password:". ;; See ert test `comint-test-password-regexp'. (defcustom comint-password-prompt-regexp (concat @@ -370,7 +371,7 @@ This variable is buffer-local." '("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the" "Enter Auth" "enter auth" "Old" "old" "New" "new" "'s" "login" "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO" - "[sudo]" "Repeat" "Bad" "Retype") + "[sudo]" "doas" "Repeat" "Bad" "Retype") t) ;; Allow for user name to precede password equivalent (Bug#31075). " +.*\\)" @@ -610,6 +611,7 @@ The command \\[comint-accumulate] sets this.") (put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand) (put 'comint-input-ring 'permanent-local t) +(put 'comint-input-ring-file-name 'permanent-local t) (put 'comint-input-ring-index 'permanent-local t) (put 'comint-save-input-ring-index 'permanent-local t) (put 'comint-input-autoexpand 'permanent-local t) @@ -820,18 +822,10 @@ series of processes in the same Comint buffer. The hook (goto-char (point-max)) (set-marker (process-mark proc) (point)) ;; Feed it the startfile. - (cond (startfile - ;;This is guaranteed to wait long enough - ;;but has bad results if the comint does not prompt at all - ;; (while (= size (buffer-size)) - ;; (sleep-for 1)) - ;;I hope 1 second is enough! - (sleep-for 1) - (goto-char (point-max)) - (insert-file-contents startfile) - (setq startfile (buffer-substring (point) (point-max))) - (delete-region (point) (point-max)) - (comint-send-string proc startfile))) + (when startfile + (comint-send-string proc (with-temp-buffer + (insert-file-contents startfile) + (buffer-string)))) (run-hooks 'comint-exec-hook) buffer))) @@ -1781,7 +1775,7 @@ Argument 0 is the command name." ((>= mth 0) (1- (- count mth))) (t (1- (- mth)))))) (mapconcat - (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " ")))) + (lambda (a) a) (nthcdr n (nreverse (nthcdr m args))) " ")))) ;; ;; Input processing stuff diff --git a/lisp/completion.el b/lisp/completion.el index ed13455b711..8a4c1676145 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -399,13 +399,6 @@ Used to decide whether to save completions.") :up) (t :neither)))))) -;; Tests - -;; (cmpl-string-case-type "123ABCDEF456") --> :up -;; (cmpl-string-case-type "123abcdef456") --> :down -;; (cmpl-string-case-type "123aBcDeF456") --> :mixed -;; (cmpl-string-case-type "123456") --> :neither -;; (cmpl-string-case-type "Abcde123") --> :capitalized - (defun cmpl-coerce-string-case (string case-type) (cond ((eq case-type :down) (downcase string)) ((eq case-type :up) (upcase string)) @@ -424,12 +417,6 @@ Used to decide whether to save completions.") ;; as is string-to-coerce)))) -;; Tests - -;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456 -;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456 -;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456 -;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 - (defun cmpl-hours-since-origin () (floor (time-convert nil 'integer) 3600)) @@ -1226,45 +1213,6 @@ String must be longer than `completion-prefix-min-length'." (set cmpl-db-prefix-symbol nil))))) (error "Unknown completion `%s'" completion-string)))) -;; Tests -- -;; - Add and Find - -;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) -;; (find-exact-completion "banana") --> ("banana" 0 nil 0) -;; (find-exact-completion "bana") --> nil -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (add-completion-to-head "banish") --> ("banish" 0 nil 0) -;; (find-exact-completion "banish") --> ("banish" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;; -;; - Deleting - -;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) -;; (delete-completion "banner") -;; (find-exact-completion "banner") --> nil -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) -;; (delete-completion "banana") -;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;; (delete-completion "banner") -;; (delete-completion "banish") -;; (find-cmpl-prefix-entry "ban") --> nil -;; (delete-completion "banner") --> error -;; -;; - Tail - -;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...)) -;; - ;;--------------------------------------------------------------------------- ;; Database Update :: Interface level routines @@ -1361,29 +1309,6 @@ Completions added this way will automatically be saved if (set-completion-num-uses entry 1) (setq cmpl-completions-accepted-p t))))))) -;; Tests -- -;; - Add and Find - -;; (add-completion "banana" 5 10) -;; (find-exact-completion "banana") --> ("banana" 5 10 0) -;; (add-completion "banana" 6) -;; (find-exact-completion "banana") --> ("banana" 6 10 0) -;; (add-completion "banish") -;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) -;; -;; - Accepting - -;; (setq completion-to-accept "banana") -;; (accept-completion) -;; (find-exact-completion "banana") --> ("banana" 7 10) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;; (setq completion-to-accept "banish") -;; (add-completion "banner") -;; (car (find-cmpl-prefix-entry "ban")) -;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) -;; -;; - Deleting - -;; (kill-completion "banish") -;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) - ;;--------------------------------------------------------------------------- ;; Searching the database @@ -1505,46 +1430,6 @@ If there are no more entries, try cdabbrev and then return only a string." ;; Completely unsuccessful, return nil )) -;; Tests -- -;; - Add and Find - -;; (add-completion "banana") -;; (completion-search-reset "ban") -;; (completion-search-next 0) --> "banana" -;; -;; - Discrimination - -;; (add-completion "cumberland") -;; (add-completion "cumberbund") -;; cumbering -;; (completion-search-reset "cumb") -;; (completion-search-peek t) --> "cumberbund" -;; (completion-search-next 0) --> "cumberbund" -;; (completion-search-peek t) --> "cumberland" -;; (completion-search-next 1) --> "cumberland" -;; (completion-search-peek nil) --> nil -;; (completion-search-next 2) --> "cumbering" {cdabbrev} -;; (completion-search-next 3) --> nil or "cumming"{depends on context} -;; (completion-search-next 1) --> "cumberland" -;; (completion-search-peek t) --> "cumbering" {cdabbrev} -;; -;; - Accepting - -;; (completion-search-next 1) --> "cumberland" -;; (setq completion-to-accept "cumberland") -;; (completion-search-reset "foo") -;; (completion-search-reset "cum") -;; (completion-search-next 0) --> "cumberland" -;; -;; - Deleting - -;; (kill-completion "cumberland") -;; cummings -;; (completion-search-reset "cum") -;; (completion-search-next 0) --> "cumberbund" -;; (completion-search-next 1) --> "cummings" -;; -;; - Ignoring Capitalization - -;; (completion-search-reset "CuMb") -;; (completion-search-next 0) --> "cumberbund" - - ;;----------------------------------------------- ;; COMPLETE @@ -1733,12 +1618,6 @@ Prefix args :: "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" "A regexp that searches for Lisp definition form.") -;; Tests - -;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8 -;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9 -;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 -;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 - ;; Parses all the definition names from a Lisp mode buffer and adds them to ;; the completion database. (defun add-completions-from-lisp-buffer () @@ -2162,7 +2041,7 @@ Patched to remove the most recent completion." ;; All common separators (eg. space "(" ")" """) characters go through a ;; function to add new words to the list of words to complete from. -;; If the character before this was an alpha-numeric then this adds the +;; If the character before this was an alphanumeric then this adds the ;; symbol before point to the completion list (using ADD-COMPLETION). (defvar completion-separator-chars diff --git a/lisp/composite.el b/lisp/composite.el index 77c5cd87b88..0a8dcb875c9 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -660,7 +660,7 @@ All non-spacing characters have this function in ;; align it at the center of the glyph of the ;; enclosing mark hoping that the enclosing mark ;; is big enough. We also have to adjust the - ;; x-offset and width of the mark ifself properly + ;; x-offset and width of the mark itself properly ;; depending on how the glyph is designed. ;; (non-spacing or not). For instance, when we @@ -747,7 +747,18 @@ All non-spacing characters have this function in unicode-category-table)) ;; for dotted-circle (aset composition-function-table #x25CC - `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle]))) + `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])) + ;; For prettier display of fractions + (set-char-table-range + composition-function-table + #x2044 + ;; We use font-shape-gstring so that if the font doesn't support + ;; fractional display, the characters are shown separately, not as + ;; a composed cluster. + (list (vector (purecopy "[1-9][0-9][0-9]\u2044[0-9]+") + 3 'font-shape-gstring) + (vector (purecopy "[1-9][0-9]\u2044[0-9]+") 2 'font-shape-gstring) + (vector (purecopy "[1-9]\u2044[0-9]+") 1 'font-shape-gstring)))) (defun compose-gstring-for-terminal (gstring _direction) "Compose glyph-string GSTRING for terminal display. diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index f1061a8621b..9003b7fc1b5 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -51,6 +51,25 @@ ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)" (defalias sym e)))) '(defcustom defface defgroup))) +(defun custom--get-def (expr) + (if (not (memq (car-safe expr) + '( define-minor-mode define-globalized-minor-mode))) + expr + ;; For define-minor-mode, we don't want to evaluate the whole + ;; expression, because it tends to define functions which aren't + ;; usable (because they call other functions that were skipped). + ;; Concretely it gave us an error + ;; "void-function bug-reference--run-auto-setup" + ;; when subsequently loading `cus-load.el'. + (let ((es (list (macroexpand-all expr))) + defs) + (while es + (let ((e (pop es))) + (pcase e + (`(progn . ,exps) (setq es (append exps es))) + (`(custom-declare-variable . ,_) (push e defs))))) + (macroexp-progn (nreverse defs))))) + (defun custom-make-dependencies () "Batch function to extract custom dependencies from .el files. Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" @@ -99,15 +118,19 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (setq name (intern name))) (condition-case nil (while (re-search-forward - "^(def\\(custom\\|face\\|group\\)" nil t) + "^(def\\(custom\\|face\\|group\\|ine\\(?:-globalized\\)?-minor-mode\\)" nil t) (beginning-of-line) (let ((type (match-string 1)) - (expr (read (current-buffer)))) + (expr (custom--get-def (read (current-buffer))))) (condition-case nil - (let ((custom-dont-initialize t)) + (let ((custom-dont-initialize t) + (sym (nth 1 expr))) + (put (if (eq (car-safe sym) 'quote) + (cadr sym) + sym) + 'custom-where name) ;; Eval to get the 'custom-group, -tag, ;; -version, group-documentation etc properties. - (put (nth 1 expr) 'custom-where name) (eval expr)) ;; Eval failed for some reason. Eg maybe the ;; defcustom uses something defined earlier @@ -148,7 +171,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (when found (push (cons (symbol-name symbol) (with-output-to-string - (prin1 (sort found 'string<)))) alist)))))) + (prin1 (sort found #'string<)))) + alist)))))) (dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2))))) (insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n"))) (insert "\ diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index cb1a78d8e20..3eef4468394 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -408,10 +408,6 @@ Use group `text' for this instead. This group is deprecated." "Input from the menus." :group 'environment) -(defgroup dnd nil - "Handling data from drag and drop." - :group 'environment) - (defgroup auto-save nil "Preventing accidental loss of data." :group 'files) @@ -491,6 +487,14 @@ Return a list suitable for use in `interactive'." (if (symbolp v) v nil) (intern val))))) +(defvar custom-actioned-widget nil + "Widget for which to show the menu of available actions. + +When showing a menu for a custom-variable, custom-face or custom-group widget, +the respective custom-*-action functions bind this variable to that widget, and +the respective custom-*-menu menus use the binding in their :enable and +:selected forms.") + (defun custom-menu-filter (menu widget) "Convert MENU to the form used by `widget-choose'. MENU should be in the same format as `custom-variable-menu'. @@ -2785,7 +2789,9 @@ Possible return values are `standard', `saved', `set', `themed', (and (equal value (eval (car tmp))) (equal comment temp)) (error nil)) - 'set + (if (equal value (eval (car (get symbol 'standard-value)))) + 'standard + 'set) 'changed)) ((progn (setq tmp (get symbol 'theme-value)) (setq temp (get symbol 'saved-variable-comment)) @@ -2855,53 +2861,93 @@ otherwise." (defun custom-variable-standard-value (widget) (get (widget-value widget) 'standard-value)) -(defvar custom-variable-menu - `(("Set for Current Session" custom-variable-set - (lambda (widget) - (eq (widget-get widget :custom-state) 'modified))) - ;; Note that in all the backquoted code in this file, we test - ;; init-file-user rather than user-init-file. This is in case - ;; cus-edit is loaded by something in site-start.el, because - ;; user-init-file is not set at that stage. - ;; https://lists.gnu.org/r/emacs-devel/2007-10/msg00310.html - ,@(when (or custom-file init-file-user) - '(("Save for Future Sessions" custom-variable-save - (lambda (widget) - (memq (widget-get widget :custom-state) - '(modified set changed rogue)))))) - ("Undo Edits" custom-redraw - (lambda (widget) - (and (default-boundp (widget-value widget)) - (memq (widget-get widget :custom-state) '(modified changed))))) - ("Revert This Session's Customization" custom-variable-reset-saved - (lambda (widget) - (memq (widget-get widget :custom-state) - '(modified set changed rogue)))) - ,@(when (or custom-file init-file-user) - '(("Erase Customization" custom-variable-reset-standard - (lambda (widget) - (and (get (widget-value widget) 'standard-value) - (memq (widget-get widget :custom-state) - '(modified set changed saved rogue))))))) - ("Set to Backup Value" custom-variable-reset-backup - (lambda (widget) - (get (widget-value widget) 'backup-value))) - ("---" ignore ignore) - ("Add Comment" custom-comment-show custom-comment-invisible-p) - ("---" ignore ignore) - ("Show Current Value" custom-variable-edit - (lambda (widget) - (eq (widget-get widget :custom-form) 'lisp))) - ("Show Saved Lisp Expression" custom-variable-edit-lisp - (lambda (widget) - (eq (widget-get widget :custom-form) 'edit)))) - "Alist of actions for the `custom-variable' widget. +(defun custom-variable-current-value (widget) + "Return the current value of the variable edited by WIDGET. + +WIDGET should be a custom-variable widget." + (let* ((symbol (widget-value widget)) + (get (or (get symbol 'custom-get) 'default-value)) + (type (custom-variable-type symbol)) + (conv (widget-convert type))) + (if (default-boundp symbol) + (funcall get symbol) + (widget-get conv :value)))) + +(defvar custom-variable-menu nil + "If non-nil, an alist of actions for the `custom-variable' widget. + +This variable is kept for backward compatibility reasons, please use +`custom-variable-extended-menu' instead. + Each entry has the form (NAME ACTION FILTER) where NAME is the name of the menu entry, ACTION is the function to call on the widget when the menu is selected, and FILTER is a predicate which takes a `custom-variable' widget as an argument, and returns non-nil if ACTION is valid on that widget. If FILTER is nil, ACTION is always valid.") +(defvar custom-variable-extended-menu + ;; No need to give the keymap a prompt, `widget-choose' takes care of it. + (let ((map (make-sparse-keymap))) + (define-key-after map [custom-variable-set] + '(menu-item "Set for Current Session" custom-variable-set + :enable (eq (widget-get custom-actioned-widget :custom-state) + 'modified))) + ;; Conditionally add items that depend on having loaded the custom-file, + ;; rather than giving it a :visible form, because we used to conditionally + ;; add this item when using simplified menus. + ;; Note that we test init-file-user rather than user-init-file. This is + ;; in case cus-edit is loaded by something in site-start.el, because + ;; user-init-file is not set at that stage. + ;; https://lists.gnu.org/r/emacs-devel/2007-10/msg00310.html + (when (or custom-file init-file-user) + (define-key-after map [custom-variable-save] + '(menu-item "Save for Future Sessions" custom-variable-save + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed rogue))))) + (define-key-after map [custom-redraw] + '(menu-item "Undo Edits" custom-redraw + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified changed)))) + (define-key-after map [custom-variable-reset-saved] + '(menu-item "Revert This Session's Customization" + custom-variable-reset-saved + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed rogue)))) + (when (or custom-file init-file-user) + (define-key-after map [custom-variable-reset-standard] + '(menu-item "Erase Customization" custom-variable-reset-standard + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed saved rogue))))) + (define-key-after map [custom-variable-reset-backup] + '(menu-item "Set to Backup Value" custom-variable-reset-backup + :enable (get + (widget-value custom-actioned-widget) + 'backup-value))) + (define-key-after map [sep0] + '(menu-item "---")) + (define-key-after map [custom-comment-show] + '(menu-item "Add Comment" custom-comment-show + :enable (custom-comment-invisible-p custom-actioned-widget))) + (define-key-after map [sep1] + '(menu-item "---")) + (define-key-after map [custom-variable-edit] + '(menu-item "Show Current Value" custom-variable-edit + :button (:radio . (eq (widget-get custom-actioned-widget + :custom-form) + 'edit)))) + (define-key-after map [custom-variable-edit-lisp] + '(menu-item "Show Saved Lisp Expression" custom-variable-edit-lisp + :button (:radio . (eq (widget-get custom-actioned-widget + :custom-form) + 'lisp)))) + map) + "A menu for `custom-variable' widgets. +Used in `custom-variable-action' to show a menu to the user.") + (defun custom-variable-action (widget &optional event) "Show the menu for `custom-variable' WIDGET. Optional EVENT is the location for the menu." @@ -2911,12 +2957,17 @@ Optional EVENT is the location for the menu." (custom-variable-state-set widget)) (custom-redraw-magic widget) (let* ((completion-ignore-case t) + (custom-actioned-widget widget) (answer (widget-choose (concat "Operation on " - (custom-unlispify-tag-name - (widget-get widget :value))) - (custom-menu-filter custom-variable-menu - widget) - event))) + (custom-unlispify-tag-name + (widget-get widget :value))) + ;; Get rid of checks like this one if we ever + ;; remove the simplified menus. + (if custom-variable-menu + (custom-menu-filter custom-variable-menu + widget) + custom-variable-extended-menu) + event))) (if answer (funcall answer widget))))) @@ -2952,10 +3003,12 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) - (custom-variable-backup-value widget) + (setq val (widget-value child)) + (unless (equal (eval val) (custom-variable-current-value widget)) + (custom-variable-backup-value widget)) (custom-push-theme 'theme-value symbol 'user - 'set (custom-quote (widget-value child))) - (funcall set symbol (eval (setq val (widget-value child)))) + 'set (custom-quote val)) + (funcall set symbol (eval val)) (put symbol 'customized-value (list val)) (put symbol 'variable-comment comment) (put symbol 'customized-variable-comment comment)) @@ -2964,10 +3017,12 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) - (custom-variable-backup-value widget) + (setq val (widget-value child)) + (unless (equal val (custom-variable-current-value widget)) + (custom-variable-backup-value widget)) (custom-push-theme 'theme-value symbol 'user - 'set (custom-quote (widget-value child))) - (funcall set symbol (setq val (widget-value child))) + 'set (custom-quote val)) + (funcall set symbol val) (put symbol 'customized-value (list (custom-quote val))) (put symbol 'variable-comment comment) (put symbol 'customized-variable-comment comment))) @@ -3036,17 +3091,23 @@ before this operation becomes the backup value." (let* ((symbol (widget-value widget)) (saved-value (get symbol 'saved-value)) (comment (get symbol 'saved-variable-comment)) + (old-value (custom-variable-current-value widget)) value) - (custom-variable-backup-value widget) (if (not (or saved-value comment)) - ;; If there is no saved value, remove the setting. - (custom-push-theme 'theme-value symbol 'user 'reset) + (progn + (setq value (car (get symbol 'standard-value))) + ;; If there is no saved value, remove the setting. + (custom-push-theme 'theme-value symbol 'user 'reset) + ;; And reset this property too. + (put symbol 'variable-comment nil)) (setq value (car-safe saved-value)) (custom-push-theme 'theme-value symbol 'user 'set value) (put symbol 'variable-comment comment)) + (unless (equal (eval value) old-value) + (custom-variable-backup-value widget)) (ignore-errors (funcall (or (get symbol 'custom-set) #'set-default) symbol - (eval (or value (car (get symbol 'standard-value)))))) + (eval value))) (put symbol 'customized-value nil) (put symbol 'customized-variable-comment nil) (widget-put widget :custom-state 'unknown) @@ -3059,7 +3120,9 @@ If `custom-reset-standard-variables-list' is nil, save, reset and redraw the widget immediately." (let* ((symbol (widget-value widget))) (if (get symbol 'standard-value) - (custom-variable-backup-value widget) + (unless (equal (custom-variable-current-value widget) + (eval (car (get symbol 'standard-value)))) + (custom-variable-backup-value widget)) (user-error "No standard setting known for %S" symbol)) (put symbol 'variable-comment nil) (put symbol 'customized-value nil) @@ -3096,13 +3159,8 @@ becomes the backup value, so you can get it again." (defun custom-variable-backup-value (widget) "Back up the current value for WIDGET's variable. The backup value is kept in the car of the `backup-value' property." - (let* ((symbol (widget-value widget)) - (get (or (get symbol 'custom-get) 'default-value)) - (type (custom-variable-type symbol)) - (conv (widget-convert type)) - (value (if (default-boundp symbol) - (funcall get symbol) - (widget-get conv :value)))) + (let ((symbol (widget-value widget)) + (value (custom-variable-current-value widget))) (put symbol 'backup-value (list value)))) (defun custom-variable-reset-backup (widget) @@ -3168,6 +3226,7 @@ face attributes (as specified by a `default' defface entry)." :convert-widget 'custom-face-edit-convert-widget :args (mapcar (lambda (att) (list 'group :inline t + :format "%v" :sibling-args (widget-get (nth 1 att) :sibling-args) (list 'const :format "" :value (nth 0 att)) (nth 1 att))) @@ -3564,19 +3623,24 @@ the present value is saved to its :shown-value property instead." (widget-put widget :buttons buttons)) ;; Draw an ordinary `custom-face' widget - (let ((opoint (point))) - ;; Visibility indicator. - (push (widget-create-child-and-convert - widget 'custom-visibility - :help-echo "Hide or show this face." - :on "Hide" :off "Show" - :on-glyph "down" :off-glyph "right" - :action 'custom-toggle-hide-face - (not hiddenp)) - buttons) - ;; Face name (tag). - (insert " " tag) - (widget-specify-sample widget opoint (point))) + ;; Visibility indicator. + (push (widget-create-child-and-convert + widget 'custom-visibility + :help-echo "Hide or show this face." + :on "Hide" :off "Show" + :on-glyph "down" :off-glyph "right" + :action 'custom-toggle-hide-face + (not hiddenp)) + buttons) + ;; Face name (tag). + (insert " ") + (push (widget-create-child-and-convert + widget 'face-link + :button-face 'link + :tag tag + :action (lambda (&rest _x) + (find-face-definition symbol))) + buttons) (insert (cond ((eq custom-buffer-style 'face) " ") ((string-match-p "face\\'" tag) ":") @@ -3675,39 +3739,74 @@ the present value is saved to its :shown-value property instead." (widget-put widget :children children) (custom-face-state-set widget)))))) -(defvar custom-face-menu - `(("Set for Current Session" custom-face-set) - ,@(when (or custom-file init-file-user) - '(("Save for Future Sessions" custom-face-save))) - ("Undo Edits" custom-redraw - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified changed)))) - ("Revert This Session's Customization" custom-face-reset-saved - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set changed)))) - ,@(when (or custom-file init-file-user) - '(("Erase Customization" custom-face-reset-standard - (lambda (widget) - (get (widget-value widget) 'face-defface-spec))))) - ("---" ignore ignore) - ("Add Comment" custom-comment-show custom-comment-invisible-p) - ("---" ignore ignore) - ("For Current Display" custom-face-edit-selected - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'selected)))) - ("For All Kinds of Displays" custom-face-edit-all - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'all)))) - ("Show Lisp Expression" custom-face-edit-lisp - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'lisp))))) - "Alist of actions for the `custom-face' widget. +(defun cus--face-link (widget _format) + (widget-create-child-and-convert + widget 'face-link + :button-face 'link + :tag "link" + :action (lambda (&rest _x) + (customize-face (widget-value widget))))) + +(defvar custom-face-menu nil + "If non-nil, an alist of actions for the `custom-face' widget. + +This variable is kept for backward compatibility reasons, please use +`custom-face-extended-menu' instead. + Each entry has the form (NAME ACTION FILTER) where NAME is the name of the menu entry, ACTION is the function to call on the widget when the menu is selected, and FILTER is a predicate which takes a `custom-face' widget as an argument, and returns non-nil if ACTION is valid on that widget. If FILTER is nil, ACTION is always valid.") +(defvar custom-face-extended-menu + (let ((map (make-sparse-keymap))) + (define-key-after map [custom-face-set] + '(menu-item "Set for Current Session" custom-face-set)) + (when (or custom-file init-file-user) + (define-key-after map [custom-face-save] + '(menu-item "Save for Future Sessions" custom-face-save))) + (define-key-after map [custom-redraw] + '(menu-item "Undo Edits" custom-redraw + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified changed)))) + (define-key-after map [custom-face-reset-saved] + '(menu-item "Revert This Session's Customization" custom-face-reset-saved + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed)))) + (when (or custom-file init-file-user) + (define-key-after map [custom-face-reset-standard] + '(menu-item "Erase Customization" custom-face-reset-standard + :enable (get (widget-value custom-actioned-widget) + 'face-defface-spec)))) + (define-key-after map [sep0] + '(menu-item "---")) + (define-key-after map [custom-comment-show] + '(menu-item "Add Comment" custom-comment-show + :enable (custom-comment-invisible-p custom-actioned-widget))) + (define-key-after map [sep1] + '(menu-item "---")) + (define-key-after map [custom-face-edit-selected] + '(menu-item "For Current Display" custom-face-edit-selected + :button (:radio . (eq (widget-get custom-actioned-widget + :custom-form) + 'selected)))) + (define-key-after map [custom-face-edit-all] + '(menu-item "For All Kinds of Displays" custom-face-edit-all + :button (:radio . (eq (widget-get custom-actioned-widget + :custom-form) + 'all)))) + (define-key-after map [custom-face-edit-lisp] + '(menu-item "Show Lisp Expression" custom-face-edit-lisp + :button (:radio . (eq (widget-get custom-actioned-widget + :custom-form) + 'lisp)))) + map) + "A menu for `custom-face' widgets. +Used in `custom-face-action' to show a menu to the user.") + (defun custom-face-edit-selected (widget) "Edit selected attributes of the value of WIDGET." (widget-put widget :custom-state 'unknown) @@ -3774,12 +3873,15 @@ Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) (custom-toggle-hide widget) (let* ((completion-ignore-case t) + (custom-actioned-widget widget) (symbol (widget-get widget :value)) (answer (widget-choose (concat "Operation on " (custom-unlispify-tag-name symbol)) - (custom-menu-filter custom-face-menu - widget) - event))) + (if custom-face-menu + (custom-menu-filter custom-face-menu + widget) + custom-face-extended-menu) + event))) (if answer (funcall answer widget))))) @@ -3829,7 +3931,12 @@ Optional EVENT is the location for the menu." (custom-face-mark-to-save widget) ;; The user is working on only a selected terminal type; ;; make sure we save the entire spec to `custom-file'. (Bug #40866) + ;; If recreating a widget that may have been edited by the user, remember + ;; to always save the edited value into the :shown-value property, so + ;; we use that value for the recreated widget. (Bug#44331) + (widget-put widget :shown-value (custom-face-widget-to-spec widget)) (custom-face-edit-all widget) + (widget-put widget :shown-value nil) ; Reset it after we used it. (custom-face-mark-to-save widget) (if (eq form 'selected) (custom-face-edit-selected widget) @@ -3914,7 +4021,7 @@ restoring it to the state of a face that has never been customized." (define-widget 'face 'symbol "A Lisp face name (with sample)." - :format "%{%t%}: (%{sample%}) %v" + :format "%f %{%t%}: (%{sample%}) %v" :tag "Face" :value 'default :sample-face-get 'widget-face-sample-face-get @@ -3924,6 +4031,7 @@ restoring it to the state of a face that has never been customized." obarray #'facep 'strict) :prompt-match 'facep :prompt-history 'widget-face-prompt-value-history + :format-handler 'cus--face-link :validate (lambda (widget) (unless (facep (widget-value widget)) (widget-put widget @@ -4309,43 +4417,65 @@ This works for both graphical and text displays." (insert "\n") (custom-group--draw-horizontal-line))))) -(defvar custom-group-menu - `(("Set for Current Session" custom-group-set - (lambda (widget) - (eq (widget-get widget :custom-state) 'modified))) - ,@(when (or custom-file init-file-user) - '(("Save for Future Sessions" custom-group-save - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set)))))) - ("Undo Edits" custom-group-reset-current - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified)))) - ("Revert This Session's Customizations" custom-group-reset-saved - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set)))) - ,@(when (or custom-file init-file-user) - '(("Erase Customization" custom-group-reset-standard - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set saved))))))) - "Alist of actions for the `custom-group' widget. +(defvar custom-group-menu nil + "If non-nil, an alist of actions for the `custom-group' widget. + +This variable is kept for backward compatibility reasons, please use +`custom-group-extended-menu' instead. + Each entry has the form (NAME ACTION FILTER) where NAME is the name of the menu entry, ACTION is the function to call on the widget when the menu is selected, and FILTER is a predicate which takes a `custom-group' widget as an argument, and returns non-nil if ACTION is valid on that widget. If FILTER is nil, ACTION is always valid.") +(defvar custom-group-extended-menu + (let ((map (make-sparse-keymap))) + (define-key-after map [custom-group-set] + '(menu-item "Set for Current Session" custom-group-set + :enable (eq (widget-get custom-actioned-widget :custom-state) + 'modified))) + (when (or custom-file init-file-user) + (define-key-after map [custom-group-save] + '(menu-item "Save for Future Sessions" custom-group-save + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set))))) + (define-key-after map [custom-group-reset-current] + '(menu-item "Undo Edits" custom-group-reset-current + :enable (eq (widget-get custom-actioned-widget :custom-state) + 'modified))) + (define-key-after map [custom-group-reset-saved] + '(menu-item "Revert This Session's Customizations" + custom-group-reset-saved + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set)))) + (when (or custom-file init-file-user) + (define-key-after map [custom-group-reset-standard] + '(menu-item "Erase Customization" custom-group-reset-standard + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set saved))))) + map) + "A menu for `custom-group' widgets. +Used in `custom-group-action' to show a menu to the user.") + (defun custom-group-action (widget &optional event) "Show the menu for `custom-group' WIDGET. Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) (custom-toggle-hide widget) (let* ((completion-ignore-case t) + (custom-actioned-widget widget) (answer (widget-choose (concat "Operation on " (custom-unlispify-tag-name (widget-get widget :value))) - (custom-menu-filter custom-group-menu - widget) - event))) + (if custom-group-menu + (custom-menu-filter custom-group-menu + widget) + custom-group-extended-menu) + event))) (if answer (funcall answer widget))))) @@ -4587,15 +4717,12 @@ This function does not save the buffer." (setq pos (line-beginning-position)))) (goto-char pos))))) -(defvar sort-fold-case) ; defined in sort.el - (defun custom-save-variables () "Save all customized variables in `custom-file'." (save-excursion (custom-save-delete 'custom-set-variables) (let ((standard-output (current-buffer)) - (saved-list (make-list 1 0)) - sort-fold-case) + (saved-list (make-list 1 0))) ;; First create a sorted list of saved variables. (mapatoms (lambda (symbol) @@ -4677,8 +4804,7 @@ This function does not save the buffer." (custom-save-delete 'custom-reset-faces) (custom-save-delete 'custom-set-faces) (let ((standard-output (current-buffer)) - (saved-list (make-list 1 0)) - sort-fold-case) + (saved-list (make-list 1 0))) ;; First create a sorted list of saved faces. (mapatoms (lambda (symbol) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index f5b70e082a5..6927b6df6b8 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -73,9 +73,11 @@ '(choice (const :tag "Frame default" t) (const :tag "Filled box" box) + (cons :tag "Box with specified size" + (const box) integer) (const :tag "Hollow cursor" hollow) (const :tag "Vertical bar" bar) - (cons :tag "Vertical bar with specified width" + (cons :tag "Vertical bar with specified height" (const bar) integer) (const :tag "Horizontal bar" hbar) (cons :tag "Horizontal bar with specified width" @@ -322,9 +324,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (resize-mini-frames frames (choice (const :tag "Never" nil) - (const :tag "Fit frame to buffer" t) + (const :tag "Fit mini frame to buffer" t) (function :tag "User-defined function")) - "27.1") + "27.2") (menu-bar-mode frames boolean nil ;; FIXME? ;; :initialize custom-initialize-default @@ -627,7 +629,9 @@ since it could result in memory overflow and make Emacs crash." (scroll-margin windows integer) (maximum-scroll-margin windows float "26.1") (hscroll-margin windows integer "22.1") - (hscroll-step windows number "22.1") + (hscroll-step windows + (choice (const :tag "Center horizontally" nil) + number) "22.1") (truncate-partial-width-windows display (choice (integer :tag "Truncate if narrower than") @@ -787,7 +791,11 @@ since it could result in memory overflow and make Emacs crash." "27.1" :safe (lambda (value) (or (characterp value) (null value)))) ;; xfaces.c - (scalable-fonts-allowed display boolean "22.1") + (scalable-fonts-allowed + display (choice (const :tag "Don't allow scalable fonts" nil) + (const :tag "Allow any scalable font" t) + (repeat regexp)) + "22.1") ;; xfns.c (x-bitmap-file-path installation (repeat (directory :format "%v"))) diff --git a/lisp/custom.el b/lisp/custom.el index cc445fe765b..cee4589543e 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1010,7 +1010,10 @@ COMMENT is a comment string about SYMBOL." set) (when requests (put symbol 'custom-requests requests) - (mapc #'require requests)) + ;; Load any libraries that the setting has specified as + ;; being required, but don't error out if the package has + ;; been removed. + (mapc (lambda (lib) (require lib nil t)) requests)) (setq set (or (get symbol 'custom-set) #'custom-set-default)) (put symbol 'saved-value (list value)) (put symbol 'saved-variable-comment comment) diff --git a/lisp/delim-col.el b/lisp/delim-col.el index 9d520278a70..1d4358d7385 100644 --- a/lisp/delim-col.el +++ b/lisp/delim-col.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> -;; Version: 2.1 +;; Old-Version: 2.1 ;; Keywords: convenience text ;; X-URL: https://www.emacswiki.org/emacs/ViniciusJoseLatorre diff --git a/lisp/delsel.el b/lisp/delsel.el index 16886dfdb12..df2adc7aeba 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -217,6 +217,10 @@ With ARG, repeat that many times. `C-u' means until end of buffer." (self-insert-command (prefix-numeric-value current-prefix-arg)) (setq this-command 'ignore))))) + ;; If the user has quit here (for instance, if the user is + ;; presented with a "changed on disk; really edit the buffer?" + ;; prompt, but hit `C-g'), just ding. + (quit (ding)) ;; If ask-user-about-supersession-threat signals an error, ;; stop safe_run_hooks from clearing out pre-command-hook. (file-supersession (message "%s" (cadr data)) (ding)) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index d6da4280630..ec9a9680137 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -210,7 +210,7 @@ multilingual development. This is a fairly large file, not typically present on GNU systems. At the time of writing it is at the URL -`http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'." +`https://www.unicode.org/Public/UNIDATA/UnicodeData.txt'." :group 'mule :version "22.1" :type '(choice (const :tag "None" nil) @@ -953,7 +953,7 @@ This function can be used as a value of ;; exclusively, we could call the (now unused) argument ;; _CALLBACK with hints on how to shorten the string if needed, ;; or with multiple usable strings which ElDoc picks according - ;; to its space contraints. + ;; to its space constraints. (describe-char-eldoc--format ch (unless (eq eldoc-echo-area-use-multiline-p t) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 3ee877ee8de..6034d12f323 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,132 @@ Isolated means that STRING is surrounded by spaces or at the beginning/end of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--highlight-no-subst-chars (positions command mark) + (cl-callf substring-no-properties command) + (dolist (pos positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (if mark + (concat command "\n" (dired--mark-positions positions)) + command)) + +(defun dired--no-subst-explain (buf char-positions command mark-positions) + (with-current-buffer buf + (erase-buffer) + (insert + (format-message "\ +If your command contains occurrences of `*' surrounded by +whitespace, `dired-do-shell-command' substitutes them for the +entire file list to process. Otherwise, if your command contains +occurrences of `?' surrounded by whitespace or `%s', Dired will +run the command once for each file, substituting `?' for each +file name. + +Your command contains occurrences of `%s' that will not be +substituted, and will be passed through normally to the shell. + +%s + +(Press ^ to %s markers below these occurrences.) +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions) + (if mark-positions "remove" "add"))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning)) + (choices `(?y ?n ?? ,@(when details '(?^))))) + (read-char-from-minibuffer + (format-message + (ngettext + "%d occurrence of `%s' will not be substituted. Proceed? (%s) " + "%d occurrences of `%s' will not be substituted. Proceed? (%s) " + nb-occur) + nb-occur hilit-char (mapconcat #'string choices ", ")) + choices))) + +(defun dired--no-subst-confirm (char-positions command) + (let ((help-buf (get-buffer-create "*Dired help*")) + (char (aref command (car char-positions))) + (nb-occur (length char-positions)) + (done nil) + (details nil) + (markers nil) + proceed) + (unwind-protect + (save-window-excursion + (while (not done) + (cl-case (dired--no-subst-ask char nb-occur details) + (?y + (setq done t + proceed t)) + (?n + (setq done t + proceed nil)) + (?? + (if details + (progn + (quit-window nil details) + (setq details nil)) + (dired--no-subst-explain + help-buf char-positions command markers) + (setq details (display-buffer help-buf)))) + (?^ + (setq markers (not markers)) + (dired--no-subst-explain + help-buf char-positions command markers))))) + (kill-buffer help-buf)) + proceed)) ;;;###autoload (defun dired-diff (file &optional switches) @@ -772,28 +880,19 @@ prompted for the shell command to use interactively." (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. - (ok (cond ((not (or on-each no-subst)) - (error "You can not combine `*' and `?' substitution marks")) - ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) - ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (dired--no-subst-confirm confirmations command)) + ((setq confirmations (dired--need-confirm-positions command "?")) + (dired--no-subst-confirm confirmations command)) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -804,7 +903,7 @@ prompted for the shell command to use interactively." nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" @@ -1703,7 +1802,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil." (if (and buffer-file-name (dired-in-this-tree-p buffer-file-name expanded-from-dir)) (let ((modflag (buffer-modified-p)) - (to-file (dired-replace-in-string + (to-file (replace-regexp-in-string (concat "^" (regexp-quote from-dir)) to-dir buffer-file-name))) @@ -1767,7 +1866,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil." ;; Update buffer-local dired-subdir-alist and dired-switches-alist (let ((cons (assoc-string (car elt) dired-switches-alist)) (cur-dir (dired-normalize-subdir - (dired-replace-in-string regexp newtext (car elt))))) + (replace-regexp-in-string regexp newtext (car elt))))) (setcar elt cur-dir) (when cons (setcar cons cur-dir)))))) @@ -2513,7 +2612,7 @@ This function takes some pains to conform to `ls -lR' output." (push (cons dirname switches) dired-switches-alist))) (when switches-have-R (dired-build-subdir-alist switches) - (setq switches (dired-replace-in-string "R" "" switches)) + (setq switches (string-replace "R" "" switches)) (dolist (cur-ass dired-subdir-alist) (let ((cur-dir (car cur-ass))) (and (dired-in-this-tree-p cur-dir dirname) @@ -2614,7 +2713,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." (let ((dired-actual-switches (or switches dired-subdir-switches - (dired-replace-in-string "R" "" dired-actual-switches)))) + (string-replace "R" "" dired-actual-switches)))) (if (equal dirname (car (car (last dired-subdir-alist)))) ;; If doing the top level directory of the buffer, ;; redo it as specified in dired-directory. @@ -2718,12 +2817,6 @@ When called interactively and not on a subdir line, go to this subdir's line." (if (dired-get-subdir) 1 0)))) (dired-next-subdir (- arg) no-error-if-not-found no-skip)) -(defun dired-subdir-min () - (save-excursion - (if (not (dired-prev-subdir 0 t t)) - (error "Not in a subdir!") - (point)))) - ;;;###autoload (defun dired-goto-subdir (dir) "Go to end of header line of DIR in this dired buffer. @@ -2816,15 +2909,6 @@ Lower levels are unaffected." ;;; hiding -(defun dired-unhide-subdir () - (with-silent-modifications - (dired--unhide (dired-subdir-min) (dired-subdir-max)))) - -(defun dired-subdir-hidden-p (dir) - (save-excursion - (dired-goto-subdir dir) - (dired--hidden-p))) - ;;;###autoload (defun dired-hide-subdir (arg) "Hide or unhide the current subdirectory and move to next directory. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 80a266f7dcd..55077e71882 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -64,21 +64,8 @@ mbox format, and so cannot be distinguished in this way." :type 'boolean :group 'dired-keys) -(defcustom dired-bind-jump t - "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not. -Setting this variable directly after dired-x is loaded has no effect - -use \\[customize]." - :type 'boolean - :set (lambda (sym val) - (if (set sym val) - (progn - (define-key ctl-x-map "\C-j" 'dired-jump) - (define-key ctl-x-4-map "\C-j" 'dired-jump-other-window)) - (if (eq 'dired-jump (lookup-key ctl-x-map "\C-j")) - (define-key ctl-x-map "\C-j" nil)) - (if (eq 'dired-jump-other-window (lookup-key ctl-x-4-map "\C-j")) - (define-key ctl-x-4-map "\C-j" nil)))) - :group 'dired-keys) +(defvar dired-bind-jump t) +(make-obsolete-variable 'dired-bind-jump "not used." "28.1") (defcustom dired-bind-man t "Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not. @@ -308,7 +295,6 @@ To see the options you can set, use M-x customize-group RET dired-x RET. See also the functions: `dired-flag-extension' `dired-virtual' - `dired-jump' `dired-man' `dired-vm' `dired-rmail' @@ -446,68 +432,7 @@ See variables `dired-texinfo-unclean-extensions', dired-bibtex-unclean-extensions dired-tex-unclean-extensions (list ".dvi")))) - -(defvar archive-superior-buffer) -(defvar tar-superior-buffer) -;;; JUMP. -;;;###autoload -(defun dired-jump (&optional other-window file-name) - "Jump to Dired buffer corresponding to current buffer. -If in a file, Dired the current directory and move to file's line. -If in Dired already, pop up a level and goto old directory's line. -In case the proper Dired file line cannot be found, refresh the dired -buffer and try again. -When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. -When FILE-NAME is non-nil, jump to its line in Dired. -Interactively with prefix argument, read FILE-NAME." - (interactive - (list nil (and current-prefix-arg - (read-file-name "Jump to Dired file: ")))) - (cond - ((and (bound-and-true-p archive-subfile-mode) - (buffer-live-p archive-superior-buffer)) - (switch-to-buffer archive-superior-buffer)) - ((and (bound-and-true-p tar-subfile-mode) - (buffer-live-p tar-superior-buffer)) - (switch-to-buffer tar-superior-buffer)) - (t - ;; Expand file-name before `dired-goto-file' call: - ;; `dired-goto-file' requires its argument to be an absolute - ;; file name; the result of `read-file-name' could be - ;; an abbreviated file name (Bug#24409). - (let* ((file (or (and file-name (expand-file-name file-name)) - buffer-file-name)) - (dir (if file (file-name-directory file) default-directory))) - (if (and (eq major-mode 'dired-mode) (null file-name)) - (progn - (setq dir (dired-current-directory)) - (dired-up-directory other-window) - (unless (dired-goto-file dir) - ;; refresh and try again - (dired-insert-subdir (file-name-directory dir)) - (dired-goto-file dir))) - (if other-window - (dired-other-window dir) - (dired dir)) - (if file - (or (dired-goto-file file) - ;; refresh and try again - (progn - (dired-insert-subdir (file-name-directory file)) - (dired-goto-file file)) - ;; Toggle omitting, if it is on, and try again. - (when dired-omit-mode - (dired-omit-mode) - (dired-goto-file file))))))))) - -;;;###autoload -(defun dired-jump-other-window (&optional file-name) - "Like \\[dired-jump] (`dired-jump') but in other window." - (interactive - (list (and current-prefix-arg - (read-file-name "Jump to Dired file: ")))) - (dired-jump t file-name)) ;;; OMITTING. @@ -1558,7 +1483,9 @@ a prefix argument, when it offers the filename near point as a default." ;;; Internal functions. ;; Fixme: This should probably use `thing-at-point'. -- fx -(defun dired-filename-at-point () +(define-obsolete-function-alias 'dired-filename-at-point + #'dired-x-guess-file-name-at-point "28.1") +(defun dired-x-guess-file-name-at-point () "Return the filename closest to point, expanded. Point should be in or after a filename." (save-excursion @@ -1592,7 +1519,7 @@ Point should be in or after a filename." "Return filename prompting with PROMPT with completion. If `current-prefix-arg' is non-nil, uses name at point as guess." (if current-prefix-arg - (let ((guess (dired-filename-at-point))) + (let ((guess (dired-x-guess-file-name-at-point))) (read-file-name prompt (file-name-directory guess) guess diff --git a/lisp/dired.el b/lisp/dired.el index e4bc4decf84..08b19a02250 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1504,7 +1504,7 @@ see `dired-use-ls-dired' for more details.") ;; "--dired", so we cannot add it to the `process-file' ;; call for wildcards. (when (file-remote-p dir) - (setq switches (dired-replace-in-string "--dired" "" switches))) + (setq switches (string-replace "--dired" "" switches))) (let* ((default-directory (car dir-wildcard)) (script (format "ls %s %s" switches (cdr dir-wildcard))) (remotep (file-remote-p dir)) @@ -2585,6 +2585,21 @@ Otherwise, display it in another buffer." ;;; Functions for extracting and manipulating file names in Dired buffers. +(defun dired-unhide-subdir () + (with-silent-modifications + (dired--unhide (dired-subdir-min) (dired-subdir-max)))) + +(defun dired-subdir-hidden-p (dir) + (save-excursion + (dired-goto-subdir dir) + (dired--hidden-p))) + +(defun dired-subdir-min () + (save-excursion + (if (not (dired-prev-subdir 0 t t)) + (error "Not in a subdir!") + (point)))) + (defun dired-get-filename (&optional localp no-error-if-not-filep) "In Dired, return name of file mentioned on this line. Value returned normally includes the directory name. @@ -2595,10 +2610,17 @@ it occurs in the buffer, and a value of t means construct name relative to Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as regular filenames and return nil if no filename on this line. Otherwise, an error occurs in these cases." - (let (case-fold-search file p1 p2 already-absolute) + (let ((hidden (and dired-subdir-alist + (dired-subdir-hidden-p + (dired-current-directory)))) + case-fold-search file p1 p2 already-absolute) + (when hidden + (dired-unhide-subdir)) (save-excursion (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep))) (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep)))) + (when hidden + (dired-hide-subdir 1)) ;; nil if no file on this line, but no-error-if-not-filep is t: (if (setq file (and p1 p2 (buffer-substring p1 p2))) (progn @@ -4040,10 +4062,10 @@ only in the active region if `dired-mark-region' is non-nil." (if fn (backup-file-name-p fn)))) "backup file"))) -(defun dired-change-marks (old new) +(defun dired-change-marks (&optional old new) "Change all OLD marks to NEW marks. OLD and NEW are both characters used to mark files." - (declare (advertised-calling-convention '(old new) "28.1")) + (declare (advertised-calling-convention (old new) "28.1")) (interactive (let* ((cursor-in-echo-area t) (old (progn (message "Change (old mark): ") (read-char))) @@ -4205,22 +4227,50 @@ format, use `\\[universal-argument] \\[dired]'.") "Non-nil means the Dired sort command is disabled. The idea is to set this buffer-locally in special Dired buffers.") +(defcustom dired-switches-in-mode-line nil + "How to indicate `dired-actual-switches' in mode-line. +Possible values: + * `nil': Indicate name-or-date sort order, if possible. + Else show full switches. + * `as-is': Show full switches. + * Integer: Show only the first N chars of full switches. + * Function: Pass `dired-actual-switches' as arg and show result." + :group 'Dired-Plus + :type '(choice + (const :tag "Indicate by name or date, else full" nil) + (const :tag "Show full switches" as-is) + (integer :tag "Show first N chars of switches" :value 10) + (function :tag "Format with function" :value identity))) + (defun dired-sort-set-mode-line () - ;; Set mode line display according to dired-actual-switches. - ;; Mode line display of "by name" or "by date" guarantees the user a - ;; match with the corresponding regexps. Non-matching switches are - ;; shown literally. + "Set mode-line according to option `dired-switches-in-mode-line'." (when (eq major-mode 'dired-mode) (setq mode-name - (let (case-fold-search) - (cond ((string-match-p - dired-sort-by-name-regexp dired-actual-switches) - "Dired by name") - ((string-match-p - dired-sort-by-date-regexp dired-actual-switches) - "Dired by date") - (t - (concat "Dired " dired-actual-switches))))) + (let ((case-fold-search nil)) + (if dired-switches-in-mode-line + (concat + "Dired" + (cond ((integerp dired-switches-in-mode-line) + (let* ((l1 (length dired-actual-switches)) + (xs (substring + dired-actual-switches + 0 (min l1 dired-switches-in-mode-line))) + (l2 (length xs))) + (if (zerop l2) + xs + (concat " " xs (and (< l2 l1) "…"))))) + ((functionp dired-switches-in-mode-line) + (format " %s" (funcall + dired-switches-in-mode-line + dired-actual-switches))) + (t (concat " " dired-actual-switches)))) + (cond ((string-match-p dired-sort-by-name-regexp + dired-actual-switches) + "Dired by name") + ((string-match-p dired-sort-by-date-regexp + dired-actual-switches) + "Dired by date") + (t (concat "Dired " dired-actual-switches)))))) (force-mode-line-update))) (define-obsolete-function-alias 'dired-sort-set-modeline @@ -4268,11 +4318,10 @@ With a prefix argument, edit the current listing switches instead." (dired-sort-set-mode-line) (revert-buffer)) -;; Some user code loads dired especially for this. -;; Don't do that--use replace-regexp-in-string instead. (defun dired-replace-in-string (regexp newtext string) ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result. ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. + (declare (obsolete replace-regexp-in-string "28.1")) (let ((result "") (start 0) mb me) (while (string-match regexp string start) (setq mb (match-beginning 0) @@ -4475,6 +4524,70 @@ Ask means pop up a menu for the user to select one of copy, move or link." (add-to-list 'desktop-buffer-mode-handlers '(dired-mode . dired-restore-desktop-buffer)) + +;;;; Jump to Dired + +(defvar archive-superior-buffer) +(defvar tar-superior-buffer) + +;;;###autoload +(defun dired-jump (&optional other-window file-name) + "Jump to Dired buffer corresponding to current buffer. +If in a file, Dired the current directory and move to file's line. +If in Dired already, pop up a level and goto old directory's line. +In case the proper Dired file line cannot be found, refresh the dired +buffer and try again. +When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. +When FILE-NAME is non-nil, jump to its line in Dired. +Interactively with prefix argument, read FILE-NAME." + (interactive + (list nil (and current-prefix-arg + (read-file-name "Jump to Dired file: ")))) + (cond + ((and (bound-and-true-p archive-subfile-mode) + (buffer-live-p archive-superior-buffer)) + (switch-to-buffer archive-superior-buffer)) + ((and (bound-and-true-p tar-subfile-mode) + (buffer-live-p tar-superior-buffer)) + (switch-to-buffer tar-superior-buffer)) + (t + ;; Expand file-name before `dired-goto-file' call: + ;; `dired-goto-file' requires its argument to be an absolute + ;; file name; the result of `read-file-name' could be + ;; an abbreviated file name (Bug#24409). + (let* ((file (or (and file-name (expand-file-name file-name)) + buffer-file-name)) + (dir (if file (file-name-directory file) default-directory))) + (if (and (eq major-mode 'dired-mode) (null file-name)) + (progn + (setq dir (dired-current-directory)) + (dired-up-directory other-window) + (unless (dired-goto-file dir) + ;; refresh and try again + (dired-insert-subdir (file-name-directory dir)) + (dired-goto-file dir))) + (if other-window + (dired-other-window dir) + (dired dir)) + (if file + (or (dired-goto-file file) + ;; refresh and try again + (progn + (dired-insert-subdir (file-name-directory file)) + (dired-goto-file file)) + ;; Toggle omitting, if it is on, and try again. + (when (bound-and-true-p dired-omit-mode) + (dired-omit-mode) + (dired-goto-file file))))))))) + +;;;###autoload +(defun dired-jump-other-window (&optional file-name) + "Like \\[dired-jump] (`dired-jump') but in other window." + (interactive + (list (and current-prefix-arg + (read-file-name "Jump to Dired file: ")))) + (dired-jump t file-name)) + (provide 'dired) (run-hooks 'dired-load-hook) ; for your customizations diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el index 3f947bdc1c9..5fd9f07cd46 100644 --- a/lisp/display-fill-column-indicator.el +++ b/lisp/display-fill-column-indicator.el @@ -51,18 +51,21 @@ This uses `display-fill-column-indicator' internally. To change the position of the column displayed by default customize `display-fill-column-indicator-column'. You can change the character for the indicator setting `display-fill-column-indicator-character'. +The globalized version is `global-display-fill-column-indicator-mode', +which see. See Info node `Displaying Boundaries' for details." :lighter nil (if display-fill-column-indicator-mode (progn (setq display-fill-column-indicator t) (unless display-fill-column-indicator-character - (if (and (char-displayable-p ?\u2502) - (or (not (display-graphic-p)) - (eq (aref (query-font (car (internal-char-font nil ?\u2502))) 0) - (face-font 'default)))) - (setq display-fill-column-indicator-character ?\u2502) - (setq display-fill-column-indicator-character ?|)))) + (setq display-fill-column-indicator-character + (if (and (char-displayable-p ?\u2502) + (or (not (display-graphic-p)) + (eq (aref (query-font (car (internal-char-font nil ?\u2502))) 0) + (face-font 'default)))) + ?\u2502 + ?|)))) (setq display-fill-column-indicator nil))) (defun display-fill-column-indicator--turn-on () @@ -73,7 +76,8 @@ See Info node `Displaying Boundaries' for details." ;;;###autoload (define-globalized-minor-mode global-display-fill-column-indicator-mode - display-fill-column-indicator-mode display-fill-column-indicator--turn-on) + display-fill-column-indicator-mode display-fill-column-indicator--turn-on + :predicate '((not special-mode) t)) (provide 'display-fill-column-indicator) diff --git a/lisp/dnd.el b/lisp/dnd.el index 1d0e26cb013..815a4afbecd 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -1,4 +1,4 @@ -;;; dnd.el --- drag and drop support +;;; dnd.el --- drag and drop support -*- lexical-binding: t; -*- ;; Copyright (C) 2005-2020 Free Software Foundation, Inc. @@ -33,6 +33,9 @@ ;;; Customizable variables +(defgroup dnd nil + "Handling data from drag and drop." + :group 'environment) ;;;###autoload (defcustom dnd-protocol-alist @@ -54,14 +57,13 @@ If no match is found, the URL is inserted as text by calling `dnd-insert-text'. The function shall return the action done (move, copy, link or private) if some action was made, or nil if the URL is ignored." :version "22.1" - :type '(repeat (cons (regexp) (function))) - :group 'dnd) + :type '(repeat (cons (regexp) (function)))) (defcustom dnd-open-remote-file-function (if (eq system-type 'windows-nt) - 'dnd-open-local-file - 'dnd-open-remote-url) + #'dnd-open-local-file + #'dnd-open-remote-url) "The function to call when opening a file on a remote machine. The function will be called with two arguments, URI and ACTION. See `dnd-open-file' for details. @@ -71,15 +73,13 @@ Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'. is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode' and is the default except for MS-Windows." :version "22.1" - :type 'function - :group 'dnd) + :type 'function) (defcustom dnd-open-file-other-window nil "If non-nil, always use find-file-other-window to open dropped files." :version "22.1" - :type 'boolean - :group 'dnd) + :type 'boolean) ;; Functions @@ -133,7 +133,8 @@ Return nil if URI is not a local file." (string-equal sysname-no-dot hostname))) (concat "file://" (substring uri (+ 7 (length hostname)))))))) -(defsubst dnd-unescape-uri (uri) +(defun dnd--unescape-uri (uri) + ;; Merge with corresponding code in URL library. (replace-regexp-in-string "%[[:xdigit:]][[:xdigit:]]" (lambda (arg) @@ -157,7 +158,7 @@ Return nil if URI is not a local file." 'utf-8 (or file-name-coding-system default-file-name-coding-system)))) - (and f (setq f (decode-coding-string (dnd-unescape-uri f) coding))) + (and f (setq f (decode-coding-string (dnd--unescape-uri f) coding))) (when (and f must-exist (not (file-readable-p f))) (setq f nil)) f)) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 60f6d6350c9..02d89650b8b 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -24,8 +24,8 @@ ;; doc-view.el requires GNU Emacs 22.1 or newer. You also need Ghostscript, ;; `dvipdf' (comes with Ghostscript) or `dvipdfm' (comes with teTeX or TeXLive) -;; and `pdftotext', which comes with xpdf (http://www.foolabs.com/xpdf/) or -;; poppler (http://poppler.freedesktop.org/). +;; and `pdftotext', which comes with xpdf (https://www.foolabs.com/xpdf/) or +;; poppler (https://poppler.freedesktop.org/). ;;; Commentary: @@ -514,7 +514,7 @@ Typically \"page-%s.png\".") ;; Toggle between text and image display or editing (define-key map (kbd "C-c C-c") 'doc-view-toggle-display) map) - "Keymap used by `doc-minor-view-mode'.") + "Keymap used by `doc-view-minor-mode'.") ;;;; Navigation Commands @@ -910,17 +910,27 @@ Resize the containing frame if needed." (width-diff (- img-width win-width)) (height-diff (- img-height win-height)) (new-frame-params + ;; If we can't resize the window, try and resize the frame. + ;; We used to compare the `window-width/height` and the + ;; `frame-width/height` instead of catching the errors, but + ;; it's too fiddly (e.g. in the presence of the miniwindow, + ;; the height the frame should be equal to the height of the + ;; root window +1). (append - (if (= (window-width) (frame-width)) - `((width . (text-pixels - . ,(+ (frame-text-width) width-diff)))) - (enlarge-window (/ width-diff (frame-char-width)) 'horiz) - nil) - (if (= (window-height) (frame-height)) - `((height . (text-pixels - . ,(+ (frame-text-height) height-diff)))) - (enlarge-window (/ height-diff (frame-char-height)) nil) - nil)))) + (condition-case nil + (progn + (enlarge-window (/ width-diff (frame-char-width)) 'horiz) + nil) + (error + `((width . (text-pixels + . ,(+ (frame-text-width) width-diff)))))) + (condition-case nil + (progn + (enlarge-window (/ height-diff (frame-char-height)) nil) + nil) + (error + `((height . (text-pixels + . ,(+ (frame-text-height) height-diff))))))))) (when new-frame-params (modify-frame-parameters (selected-frame) new-frame-params)))) diff --git a/lisp/double.el b/lisp/double.el index 639d041a1dc..8e5090034cf 100644 --- a/lisp/double.el +++ b/lisp/double.el @@ -99,7 +99,7 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." (load-library "isearch")) (define-key isearch-mode-map [ignore] - (function (lambda () (interactive) (isearch-update)))) + (lambda () (interactive) (isearch-update))) (defun double-translate-key (prompt) ;; Translate input events using double map. diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 7285021676c..079fce88def 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -162,6 +162,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. (message ""))) (when select (set-buffer buffer) + (goto-char select) (let ((opoint (point-marker))) (Buffer-menu-execute) (goto-char (point-min)) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 71474c0289a..1d9b4726b04 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -3,7 +3,6 @@ ;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> -;; Version: 2.01 ;; Keywords: abbrev ;; This file is part of GNU Emacs. diff --git a/lisp/ehelp.el b/lisp/ehelp.el index ad39116c680..81373202c51 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -219,7 +219,7 @@ BUFFER is put back into its original major mode." 'electric-help-retain)))) (Electric-command-loop 'exit - (function (lambda () + (lambda () (sit-for 0) ;necessary if last command was end-of-buffer or ;beginning-of-buffer - otherwise pos-visible-in-window-p ;will yield a wrong result. @@ -241,7 +241,7 @@ BUFFER is put back into its original major mode." (t (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ") (both) - (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "))))))))) + (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))))) t)))) diff --git a/lisp/electric.el b/lisp/electric.el index 7038b91c26d..50ddf525ca4 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -424,7 +424,7 @@ If multiple rules match, only first one is executed.") ;; ;; FIXME: when `newline'ing, we exceptionally ;; prevent a specific behavior of - ;; `eletric-pair-mode', that of opening an extra + ;; `electric-pair-mode', that of opening an extra ;; newline between newly inserted matching paris. ;; In theory that behavior should be provided by ;; `electric-layout-mode' instead, which should be diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 2eef4512009..07bda537b39 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -254,12 +254,12 @@ expression, in which case we want to handle forms differently." ;; the doc-string in FORM. ;; Those properties are now set in lisp-mode.el. -(defun autoload-find-generated-file () +(defun autoload-find-generated-file (file) "Visit the autoload file for the current buffer, and return its buffer." (let ((enable-local-variables :safe) (enable-local-eval nil) - (delay-mode-hooks t) - (file (autoload-generated-file))) + (find-file-hook nil) + (delay-mode-hooks t)) ;; We used to use `raw-text' to read this file, but this causes ;; problems when the file contains non-ASCII characters. (with-current-buffer (find-file-noselect @@ -267,18 +267,20 @@ expression, in which case we want to handle forms differently." (if (zerop (buffer-size)) (insert (autoload-rubric file nil t))) (current-buffer)))) -(defun autoload-generated-file () - "Return `generated-autoload-file' as an absolute name. -If local to the current buffer, expand using the default directory; -otherwise, using `source-directory'/lisp." - (expand-file-name generated-autoload-file +(defun autoload-generated-file (outfile) + "Return OUTFILE as an absolute name. +If `generated-autoload-file' is bound locally in the current +buffer, that is used instead, and it is expanded using the +default directory; otherwise, `source-directory'/lisp is used." + (expand-file-name (if (local-variable-p 'generated-autoload-file) + generated-autoload-file + outfile) ;; File-local settings of generated-autoload-file should ;; be interpreted relative to the file's location, ;; of course. (if (not (local-variable-p 'generated-autoload-file)) (expand-file-name "lisp" source-directory)))) - (defun autoload-read-section-header () "Read a section header form. Since continuation lines have been marked as comments, @@ -453,13 +455,12 @@ which lists the file name and which functions are in it, etc." (defvar no-update-autoloads nil "File local variable to prevent scanning this file for autoload cookies.") -(defun autoload-file-load-name (file) +(defun autoload-file-load-name (file outfile) "Compute the name that will be used to load FILE." ;; OUTFILE should be the name of the global loaddefs.el file, which ;; is expected to be at the root directory of the files we're ;; scanning for autoloads and will be in the `load-path'. - (let* ((outfile (default-value 'generated-autoload-file)) - (name (file-relative-name file (file-name-directory outfile))) + (let* ((name (file-relative-name file (file-name-directory outfile))) (names '()) (dir (file-name-directory outfile))) ;; If `name' has directory components, only keep the @@ -489,8 +490,9 @@ If FILE is being visited in a buffer, the contents of the buffer are used. Return non-nil in the case where no autoloads were added at point." (interactive "fGenerate autoloads for file: ") - (let ((generated-autoload-file buffer-file-name)) - (autoload-generate-file-autoloads file (current-buffer)))) + (let ((autoload-modified-buffers nil)) + (autoload-generate-file-autoloads file (current-buffer) buffer-file-name) + autoload-modified-buffers)) (defvar autoload-compute-prefixes t "If non-nil, autoload will add code to register the prefixes used in a file. @@ -607,7 +609,7 @@ Don't try to split prefixes that are already longer than that.") `(register-definition-prefixes ,file ',(sort (delq nil strings) 'string<)))))) -(defun autoload--setup-output (otherbuf outbuf absfile load-name) +(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file) (let ((outbuf (or (if otherbuf ;; A file-local setting of @@ -615,7 +617,7 @@ Don't try to split prefixes that are already longer than that.") ;; should ignore OUTBUF. nil outbuf) - (autoload-find-destination absfile load-name) + (autoload-find-destination absfile load-name output-file) ;; The file has autoload cookies, but they're ;; already up-to-date. If OUTFILE is nil, the ;; entries are in the expected OUTBUF, @@ -672,23 +674,16 @@ Don't try to split prefixes that are already longer than that.") More specifically those definitions will not be considered for the `register-definition-prefixes' call.") -;; When called from `generate-file-autoloads' we should ignore -;; `generated-autoload-file' altogether. When called from -;; `update-file-autoloads' we don't know `outbuf'. And when called from -;; `update-directory-autoloads' it's in between: we know the default -;; `outbuf' but we should obey any file-local setting of -;; `generated-autoload-file'. (defun autoload-generate-file-autoloads (file &optional outbuf outfile) "Insert an autoload section for FILE in the appropriate buffer. Autoloads are generated for defuns and defmacros in FILE marked by `generate-autoload-cookie' (which see). + If FILE is being visited in a buffer, the contents of the buffer are used. OUTBUF is the buffer in which the autoload statements should be inserted. -If OUTBUF is nil, it will be determined by `autoload-generated-file'. -If provided, OUTFILE is expected to be the file name of OUTBUF. -If OUTFILE is non-nil and FILE specifies a `generated-autoload-file' -different from OUTFILE, then OUTBUF is ignored. +If OUTBUF is nil, the output will go to OUTFILE, unless there's a +buffer-local setting of `generated-autoload-file' in FILE. Return non-nil if and only if FILE adds no autoloads to OUTFILE \(or OUTBUF if OUTFILE is nil). The actual return value is @@ -716,16 +711,19 @@ FILE's modification time." (setq load-name (if (stringp generated-autoload-load-name) generated-autoload-load-name - (autoload-file-load-name absfile))) + (autoload-file-load-name absfile outfile))) ;; FIXME? Comparing file-names for equality with just equal ;; is fragile, eg if one has an automounter prefix and one ;; does not, but both refer to the same physical file. (when (and outfile + (not outbuf) (not (if (memq system-type '(ms-dos windows-nt)) (equal (downcase outfile) - (downcase (autoload-generated-file))) - (equal outfile (autoload-generated-file))))) + (downcase (autoload-generated-file + outfile))) + (equal outfile (autoload-generated-file + outfile))))) (setq otherbuf t)) (save-excursion (save-restriction @@ -739,7 +737,8 @@ FILE's modification time." (file-name-sans-extension (file-name-nondirectory file)))) (setq output-start (autoload--setup-output - otherbuf outbuf absfile load-name)) + otherbuf outbuf absfile + load-name outfile)) (let ((standard-output (marker-buffer output-start)) (print-quoted t)) (princ `(push (purecopy @@ -757,7 +756,8 @@ FILE's modification time." ;; If not done yet, figure out where to insert this text. (unless output-start (setq output-start (autoload--setup-output - otherbuf outbuf absfile load-name))) + otherbuf outbuf absfile + load-name outfile))) (autoload--print-cookie-text output-start load-name file)) ((= (following-char) ?\;) ;; Don't read the comment. @@ -788,7 +788,7 @@ FILE's modification time." ((not otherbuf) (unless output-start (setq output-start (autoload--setup-output - nil outbuf absfile load-name))) + nil outbuf absfile load-name outfile))) (let ((autoload-print-form-outbuf (marker-buffer output-start))) (autoload-print-form form))) @@ -800,9 +800,8 @@ FILE's modification time." ;; then passing otherbuf=nil is enough, but if ;; outbuf is nil, that won't cut it, so we ;; locally bind generated-autoload-file. - (let ((generated-autoload-file - (default-value 'generated-autoload-file))) - (autoload--setup-output nil outbuf absfile load-name))) + (autoload--setup-output nil outbuf absfile load-name + outfile)) (autoload-print-form-outbuf (marker-buffer other-output-start))) (autoload-print-form form) @@ -924,19 +923,23 @@ Return FILE if there was no autoload cookie in it, else nil." (interactive (list (read-file-name "Update autoloads for file: ") current-prefix-arg (read-file-name "Write autoload definitions to file: "))) - (let* ((generated-autoload-file (or outfile generated-autoload-file)) - (autoload-modified-buffers nil) + (setq outfile (or outfile generated-autoload-file)) + (let* ((autoload-modified-buffers nil) ;; We need this only if the output file handles more than one input. ;; See https://debbugs.gnu.org/22213#38 and subsequent. (autoload-timestamps t) - (no-autoloads (autoload-generate-file-autoloads file))) + (no-autoloads (autoload-generate-file-autoloads + file nil + (if (local-variable-p 'generated-autoload-file) + generated-autoload-file + outfile)))) (if autoload-modified-buffers (if save-after (autoload-save-buffers)) (if (called-interactively-p 'interactive) (message "Autoload section for %s is up to date." file))) (if no-autoloads file))) -(defun autoload-find-destination (file load-name) +(defun autoload-find-destination (file load-name output-file) "Find the destination point of the current buffer's autoloads. FILE is the file name of the current buffer. LOAD-NAME is the name as it appears in the output. @@ -946,12 +949,12 @@ removes any prior now out-of-date autoload entries." (catch 'up-to-date (let* ((buf (current-buffer)) (existing-buffer (if buffer-file-name buf)) - (output-file (autoload-generated-file)) + (output-file (autoload-generated-file output-file)) (output-time (if (file-exists-p output-file) (file-attribute-modification-time (file-attributes output-file)))) (found nil)) - (with-current-buffer (autoload-find-generated-file) + (with-current-buffer (autoload-find-generated-file output-file) ;; This is to make generated-autoload-file have Unix EOLs, so ;; that it is portable to all platforms. (or (eq 0 (coding-system-eol-type buffer-file-coding-system)) @@ -1032,12 +1035,31 @@ The function does NOT recursively descend into subdirectories of the directory or directories specified. In an interactive call, prompt for a default output file for the -autoload definitions, and temporarily bind the variable -`generated-autoload-file' to this value. When called from Lisp, -use the existing value of `generated-autoload-file'. If any Lisp -file binds `generated-autoload-file' as a file-local variable, -write its autoloads into the specified file instead." +autoload definitions. When called from Lisp, use the existing +value of `generated-autoload-file'. If any Lisp file binds +`generated-autoload-file' as a file-local variable, write its +autoloads into the specified file instead." + (declare (obsolete make-directory-autoloads "28.1")) (interactive "DUpdate autoloads from directory: ") + (make-directory-autoloads + dirs + (if (called-interactively-p 'interactive) + (read-file-name "Write autoload definitions to file: ") + generated-autoload-file))) + +;;;###autoload +(defun make-directory-autoloads (dir output-file) + "Update autoload definitions for Lisp files in the directories DIRS. +DIR can be either a single directory or a list of +directories. (The latter usage is discouraged.) + +The autoloads will be written to OUTPUT-FILE. If any Lisp file +binds `generated-autoload-file' as a file-local variable, write +its autoloads into the specified file instead. + +The function does NOT recursively descend into subdirectories of the +directory or directories specified." + (interactive "DUpdate autoloads from directory: \nFWrite to file: ") (let* ((files-re (let ((tmp nil)) (dolist (suf (get-load-suffixes)) ;; We don't use module-file-suffix below because @@ -1048,10 +1070,10 @@ write its autoloads into the specified file instead." (push suf tmp))) (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'"))) (files (apply #'nconc - (mapcar (lambda (dir) - (directory-files (expand-file-name dir) - t files-re)) - dirs))) + (mapcar (lambda (d) + (directory-files (expand-file-name d) + t files-re)) + (if (consp dir) dir (list dir))))) (done ()) ;Files processed; to remove duplicates. (changed nil) ;Non-nil if some change occurred. (last-time) @@ -1059,16 +1081,12 @@ write its autoloads into the specified file instead." ;; files because of file-local autoload-generated-file settings. (no-autoloads nil) (autoload-modified-buffers nil) - (generated-autoload-file - (if (called-interactively-p 'interactive) - (read-file-name "Write autoload definitions to file: ") - generated-autoload-file)) (output-time - (if (file-exists-p generated-autoload-file) - (file-attribute-modification-time - (file-attributes generated-autoload-file))))) + (and (file-exists-p output-file) + (file-attribute-modification-time + (file-attributes output-file))))) - (with-current-buffer (autoload-find-generated-file) + (with-current-buffer (autoload-find-generated-file output-file) (save-excursion ;; Canonicalize file names and remove the autoload file itself. (setq files (delete (file-relative-name buffer-file-name) @@ -1125,8 +1143,7 @@ write its autoloads into the specified file instead." (progress (make-progress-reporter (byte-compile-info (concat "Scraping files for " - (file-relative-name - generated-autoload-file))) + (file-relative-name output-file))) 0 (length files) nil 10)) (file-count 0) file-time) @@ -1204,7 +1221,7 @@ should be non-nil)." (let ((args command-line-args-left)) (batch-update-autoloads--summary args) (setq command-line-args-left nil) - (apply #'update-directory-autoloads args))) + (make-directory-autoloads args generated-autoload-file))) (provide 'autoload) diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 8567a3a44f3..5413022e341 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -1,4 +1,4 @@ -;;; backquote.el --- implement the ` Lisp construct +;;; backquote.el --- implement the ` Lisp construct -*- lexical-binding: t -*- ;; Copyright (C) 1990, 1992, 1994, 2001-2020 Free Software Foundation, ;; Inc. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 37dad8db162..5874ba72fcd 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -922,11 +922,15 @@ Output stream used is value of `standard-output'." (princ (backtrace-to-string (backtrace-get-frames 'backtrace))) nil) -(defun backtrace-to-string(&optional frames) +(defun backtrace-to-string (&optional frames) "Format FRAMES, a list of `backtrace-frame' objects, for output. Return the result as a string. If FRAMES is nil, use all function calls currently active." - (unless frames (setq frames (backtrace-get-frames 'backtrace-to-string))) + (substring-no-properties + (backtrace--to-string + (or frames (backtrace-get-frames 'backtrace-to-string))))) + +(defun backtrace--to-string (frames) (let ((backtrace-fontify nil)) (with-temp-buffer (backtrace-mode) @@ -934,8 +938,7 @@ function calls currently active." backtrace-frames frames backtrace-print-function #'cl-prin1) (backtrace-print) - (substring-no-properties (filter-buffer-substring (point-min) - (point-max)))))) + (filter-buffer-substring (point-min) (point-max))))) (provide 'backtrace) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index d168c255121..0fd273aa3e3 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -298,7 +298,7 @@ type field field nil)) (if (and (consp len) (not (eq type 'eval))) - (setq len (apply 'bindat-get-field struct len))) + (setq len (apply #'bindat-get-field struct len))) (if (not len) (setq len 1)) (cond @@ -557,7 +557,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." type field field nil)) (if (and (consp len) (not (eq type 'eval))) - (setq len (apply 'bindat-get-field struct len))) + (setq len (apply #'bindat-get-field struct len))) (if (not len) (setq len 1)) (cond @@ -624,7 +624,7 @@ only that many elements from VECT." (while (> i 0) (setq i (1- i) s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s))) - (apply 'concat s))) + (apply #'concat s))) (defun bindat-vector-to-dec (vect &optional sep) "Format vector VECT in decimal format separated by dots. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4987596bf95..530a086b14b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -830,11 +830,13 @@ (defun byte-optimize-assoc (form) ;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq', ;; if the first arg is a symbol. - (if (and (= (length form) 3) - (byte-optimize--constant-symbol-p (nth 1 form))) - (cons (if (eq (car form) 'assoc) 'assq 'rassq) - (cdr form)) - form)) + (cond + ((/= (length form) 3) + form) + ((byte-optimize--constant-symbol-p (nth 1 form)) + (cons (if (eq (car form) 'assoc) 'assq 'rassq) + (cdr form))) + (t (byte-optimize-constant-args form)))) (defun byte-optimize-memq (form) ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar)) @@ -1044,19 +1046,22 @@ (defun byte-optimize-apply (form) ;; If the last arg is a literal constant, turn this into a funcall. ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). - (let ((fn (nth 1 form)) - (last (nth (1- (length form)) form))) ; I think this really is fastest - (or (if (or (null last) - (eq (car-safe last) 'quote)) - (if (listp (nth 1 last)) - (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) - (nconc (list 'funcall fn) butlast - (mapcar (lambda (x) (list 'quote x)) (nth 1 last)))) - (byte-compile-warn - "last arg to apply can't be a literal atom: `%s'" - (prin1-to-string last)) - nil)) - form))) + (if (= (length form) 2) + ;; single-argument `apply' is not worth optimizing (bug#40968) + form + (let ((fn (nth 1 form)) + (last (nth (1- (length form)) form))) ; I think this really is fastest + (or (if (or (null last) + (eq (car-safe last) 'quote)) + (if (listp (nth 1 last)) + (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) + (nconc (list 'funcall fn) butlast + (mapcar (lambda (x) (list 'quote x)) (nth 1 last)))) + (byte-compile-warn + "last arg to apply can't be a literal atom: `%s'" + (prin1-to-string last)) + nil)) + form)))) (put 'funcall 'byte-optimizer #'byte-optimize-funcall) (put 'apply 'byte-optimizer #'byte-optimize-apply) @@ -1141,13 +1146,15 @@ ;; I wonder if I missed any :-\) (let ((side-effect-free-fns '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan - assoc assq + assq + bool-vector-count-consecutive bool-vector-count-population + bool-vector-subsetp boundp buffer-file-name buffer-local-variables buffer-modified-p buffer-substring byte-code-function-p capitalize car-less-than-car car cdr ceiling char-after char-before char-equal char-to-string char-width compare-strings compare-window-configurations concat coordinates-in-window-p - copy-alist copy-sequence copy-marker cos count-lines + copy-alist copy-sequence copy-marker copysign cos count-lines current-time-string current-time-zone decode-char decode-time default-boundp default-value documentation downcase @@ -1160,21 +1167,22 @@ frame-visible-p fround ftruncate get gethash get-buffer get-buffer-window getenv get-file-buffer hash-table-count - int-to-string intern-soft + int-to-string intern-soft isnan keymap-parent - length line-beginning-position line-end-position + lax-plist-get ldexp length line-beginning-position line-end-position local-variable-if-set-p local-variable-p locale-info log log10 logand logb logcount logior lognot logxor lsh make-byte-code make-list make-string make-symbol marker-buffer max - member memq min minibuffer-selected-window minibuffer-window + member memq memql min minibuffer-selected-window minibuffer-window mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string parse-colon-path plist-get plist-member prefix-numeric-value previous-window prin1-to-string propertize degrees-to-radians - radians-to-degrees rassq rassoc read-from-string regexp-quote - region-beginning region-end reverse round - sin sqrt string string< string= string-equal string-lessp string-to-char - string-to-number substring + radians-to-degrees rassq rassoc read-from-string regexp-opt + regexp-quote region-beginning region-end reverse round + sin sqrt string string< string= string-equal string-lessp + string-search string-to-char + string-to-number string-to-syntax substring sxhash sxhash-equal sxhash-eq sxhash-eql symbol-function symbol-name symbol-plist symbol-value string-make-unibyte string-make-multibyte string-as-multibyte string-as-unibyte @@ -1224,7 +1232,7 @@ standard-case-table standard-syntax-table stringp subrp symbolp syntax-table syntax-table-p this-command-keys this-command-keys-vector this-single-command-keys - this-single-command-raw-keys + this-single-command-raw-keys type-of user-real-login-name user-real-uid user-uid vector vectorp visible-frame-list wholenump window-configuration-p window-live-p @@ -1256,14 +1264,15 @@ '(concat regexp-opt regexp-quote string-to-char string-to-syntax symbol-name eq eql - = /= < <= => > min max + = /= < <= >= > min max + - * / % mod abs ash 1+ 1- sqrt logand logior lognot logxor logcount copysign isnan ldexp float logb floor ceiling round truncate ffloor fceiling fround ftruncate string= string-equal string< string-lessp - consp atom listp nlistp propert-list-p + string-search + consp atom listp nlistp proper-list-p sequencep arrayp vectorp stringp bool-vector-p hash-table-p null not numberp integerp floatp natnump characterp diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 5279a57cd0c..27f54d0ca2a 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -432,7 +432,16 @@ ACCESS-TYPE if non-nil should specify the kind of access that will trigger (defmacro define-obsolete-variable-alias (obsolete-name current-name &optional when docstring) "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. -This uses `defvaralias' and `make-obsolete-variable' (which see). + +WHEN should be a string indicating when the variable was first +made obsolete, for example a date or a release number. + +This macro evaluates all its parameters, and both OBSOLETE-NAME +and CURRENT-NAME should be symbols, so a typical usage would look like: + + (define-obsolete-variable-alias 'foo-thing 'bar-thing \"27.1\") + +This macro uses `defvaralias' and `make-obsolete-variable' (which see). See the Info node `(elisp)Variable Aliases' for more details. If CURRENT-NAME is a defcustom or a defvar (more generally, any variable @@ -446,9 +455,6 @@ dumped with Emacs). This is so that any user customizations are applied before the defcustom tries to initialize the variable (this is due to the way `defvaralias' works). -WHEN should be a string indicating when the variable was first -made obsolete, for example a date or a release number. - For the benefit of Customize, if OBSOLETE-NAME has any of the following properties, they are copied to CURRENT-NAME, if it does not already have them: diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 966990bac96..cbda16d051b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -268,6 +268,13 @@ This option is enabled by default because it reduces Emacs memory usage." (defconst byte-compile-log-buffer "*Compile-Log*" "Name of the byte-compiler's log buffer.") +(defvar byte-compile--known-dynamic-vars nil + "Variables known to be declared as dynamic, for warning purposes. +Each element is (VAR . FILE), indicating that VAR is declared in FILE.") + +(defvar byte-compile--seen-defvars nil + "All dynamic variable declarations seen so far.") + (defcustom byte-optimize-log nil "If non-nil, the byte-compiler will log its optimizations. If this is `source', then only source-level optimizations will be logged. @@ -284,13 +291,13 @@ The information is logged to `byte-compile-log-buffer'." ;; This needs to be autoloaded because it needs to be available to ;; Emacs before the byte compiler is loaded, otherwise Emacs will not ;; know that this variable is marked as safe until it is too late. -;; (See https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html ) +;; (See https://lists.gnu.org/r/emacs-devel/2018-01/msg00261.html ) ;;;###autoload(put 'byte-compile-error-on-warn 'safe-local-variable 'booleanp) (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved obsolete noruntime cl-functions interactive-only - make-local mapcar constants suspicious lexical) + make-local mapcar constants suspicious lexical lexical-dynamic) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "List of warnings that the byte-compiler should issue (t for all). @@ -310,6 +317,8 @@ Elements of the list may be: interactive-only commands that normally shouldn't be called from Lisp code. lexical global/dynamic variables lacking a prefix. + lexical-dynamic + lexically bound variable declared dynamic elsewhere make-local calls to make-variable-buffer-local that may be incorrect. mapcar mapcar called for effect. constants let-binding of, or assignment to, constants/nonvariables. @@ -1836,10 +1845,9 @@ compile FILENAME. If optional argument ARG is 0, it compiles the input file even if the `.elc' file does not exist. Any other non-nil value of ARG means to ask the user. -If optional argument LOAD is non-nil, loads the file after compiling. - If compilation is needed, this functions returns the result of `byte-compile-file'; otherwise it returns `no-byte-compile'." + (declare (advertised-calling-convention (filename &optional force arg) "28.1")) (interactive (let ((file buffer-file-name) (file-name nil) @@ -1868,11 +1876,24 @@ If compilation is needed, this functions returns the result of (progn (if (and noninteractive (not byte-compile-verbose)) (message "Compiling %s..." filename)) - (byte-compile-file filename load)) + (byte-compile-file filename) + (when load + (load (if (file-exists-p dest) dest filename)))) (when load (load (if (file-exists-p dest) dest filename))) 'no-byte-compile))) +(defun byte-compile--load-dynvars (file) + (and file (not (equal file "")) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (let ((vars nil) + var) + (while (ignore-errors (setq var (read (current-buffer)))) + (push var vars)) + vars)))) + (defvar byte-compile-level 0 ; bug#13787 "Depth of a recursive byte compilation.") @@ -1881,8 +1902,10 @@ If compilation is needed, this functions returns the result of "Compile a file of Lisp code named FILENAME into a file of byte code. The output file's name is generated by passing FILENAME to the function `byte-compile-dest-file' (which see). -With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling. -The value is non-nil if there were no errors, nil if errors." +The value is non-nil if there were no errors, nil if errors. + +See also `emacs-lisp-byte-compile-and-load'." + (declare (advertised-calling-convention (filename) "28.1")) ;; (interactive "fByte compile file: \nP") (interactive (let ((file buffer-file-name) @@ -1911,8 +1934,11 @@ The value is non-nil if there were no errors, nil if errors." (let ((byte-compile-current-file filename) (byte-compile-current-group nil) (set-auto-coding-for-load t) + (byte-compile--seen-defvars nil) + (byte-compile--known-dynamic-vars + (byte-compile--load-dynvars (getenv "EMACS_DYNVARS_FILE"))) target-file input-buffer output-buffer - byte-compile-dest-file) + byte-compile-dest-file byte-compiler-error-flag) (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) (with-current-buffer @@ -1974,7 +2000,6 @@ The value is non-nil if there were no errors, nil if errors." 'no-byte-compile) (when byte-compile-verbose (message "Compiling %s..." filename)) - (setq byte-compiler-error-flag nil) ;; It is important that input-buffer not be current at this call, ;; so that the value of point set in input-buffer ;; within byte-compile-from-buffer lingers in that buffer. @@ -2035,8 +2060,17 @@ The value is non-nil if there were no errors, nil if errors." filename)))) (save-excursion (display-call-tree filename))) + (let ((gen-dynvars (getenv "EMACS_GENERATE_DYNVARS"))) + (when (and gen-dynvars (not (equal gen-dynvars "")) + byte-compile--seen-defvars) + (let ((dynvar-file (concat target-file ".dynvars"))) + (message "Generating %s" dynvar-file) + (with-temp-buffer + (dolist (var (delete-dups byte-compile--seen-defvars)) + (insert (format "%S\n" (cons var filename)))) + (write-region (point-min) (point-max) dynvar-file))))) (if load - (load target-file)) + (load target-file)) t)))) ;;; compiling a single function @@ -2425,7 +2459,8 @@ list that represents a doc string reference. (setq byte-compile-lexical-variables (delq sym byte-compile-lexical-variables)) (byte-compile-warn "Variable `%S' declared after its first use" sym)) - (push sym byte-compile-bound-variables)) + (push sym byte-compile-bound-variables) + (push sym byte-compile--seen-defvars)) (defun byte-compile-file-form-defvar (form) (let ((sym (nth 1 form))) @@ -2831,6 +2866,16 @@ If FORM is a lambda or a macro, byte-compile it as a function." (ash nonrest 8) (ash rest 7))))) +(defun byte-compile--warn-lexical-dynamic (var context) + (when (byte-compile-warning-enabled-p 'lexical-dynamic var) + (byte-compile-warn + "`%s' lexically bound in %s here but declared dynamic in: %s" + var context + (mapconcat #'identity + (mapcan (lambda (v) (and (eq var (car v)) + (list (cdr v)))) + byte-compile--known-dynamic-vars) + ", ")))) (defun byte-compile-lambda (fun &optional add-lambda reserved-csts) "Byte-compile a lambda-expression and return a valid function. @@ -2859,6 +2904,10 @@ for symbols generated by the byte compiler itself." (if (cdr body) (setq body (cdr body)))))) (int (assq 'interactive body))) + (when lexical-binding + (dolist (var arglistvars) + (when (assq var byte-compile--known-dynamic-vars) + (byte-compile--warn-lexical-dynamic var 'lambda)))) ;; Process the interactive spec. (when int (byte-compile-set-symbol-position 'interactive) @@ -3174,7 +3223,8 @@ for symbols generated by the byte compiler itself." (t ".")))) (if (eq (car-safe (symbol-function (car form))) 'macro) (byte-compile-report-error - (format "Forgot to expand macro %s in %S" (car form) form))) + (format "`%s' defined after use in %S (missing `require' of a library file?)" + (car form) form))) (if (and handler ;; Make sure that function exists. (and (functionp handler) @@ -4378,6 +4428,8 @@ Return non-nil if the TOS value was popped." ;; VAR is a simple stack-allocated lexical variable. (progn (push (assq var init-lexenv) byte-compile--lexical-environment) + (when (assq var byte-compile--known-dynamic-vars) + (byte-compile--warn-lexical-dynamic var 'let)) nil) ;; VAR should be dynamically bound. (while (assq var byte-compile--lexical-environment) @@ -5206,6 +5258,8 @@ and corresponding effects." byte-compile-variable-ref)))) nil) +(make-obsolete-variable 'bytecomp-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'bytecomp-load-hook) ;;; bytecomp.el ends here diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 964836a32ac..177710038a0 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -4,7 +4,7 @@ ;; Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 +;; Old-Version: 0.2 ;; Keywords: OO, chart, graph ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 1029b52220d..a485378a926 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1573,7 +1573,8 @@ mouse-[0-3]\\)\\)\\>")) ;; a prefix. (let ((disambiguate (completing-read - "Disambiguating Keyword (default variable): " + (format-prompt "Disambiguating Keyword" + "variable") '(("function") ("command") ("variable") ("option") ("symbol")) nil t nil nil "variable"))) @@ -2588,7 +2589,7 @@ This function will not modify `match-data'." ;; going on. (if checkdoc-bouncy-flag (message "%s -> done" question)) (delete-region start end) - (insert replacewith) + (insert-before-markers replacewith) (if checkdoc-bouncy-flag (sit-for 0)) (setq ret t))) (delete-overlay o) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 5bf74792c08..d3159a37683 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -201,8 +201,11 @@ the elements themselves. ;;;###autoload (defun cl-some (cl-pred cl-seq &rest cl-rest) - "Return true if PREDICATE is true of any element of SEQ or SEQs. -If so, return the true (non-nil) value returned by PREDICATE. + "Say whether PREDICATE is true for any element in the SEQ sequences. +More specifically, the return value of this function will be the +same as the first return value of PREDICATE where PREDICATE has a +non-nil value. + \n(fn PREDICATE SEQ...)" (if (or cl-rest (nlistp cl-seq)) (catch 'cl-some @@ -910,6 +913,8 @@ Outputs to the current buffer." (mapc #'cl--describe-class-slot cslots)))) +(make-obsolete-variable 'cl-extra-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'cl-extra-load-hook) ;; Local variables: diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 7a4d3c9c3e3..86ee94e87e0 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -663,6 +663,7 @@ This can be needed when using code byte-compiled using the old macro-expansion of `cl-defstruct' that used vectors objects instead of record objects." :global t + :group 'tools (cond (cl-old-struct-compat-mode (advice-add 'type-of :around #'cl--old-struct-type-of)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c38019d4a73..1501ed43082 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2969,7 +2969,7 @@ Supported keywords for slots are: constrs)) (pcase-dolist (`(,cname ,args ,doc) constrs) (let* ((anames (cl--arglist-args args)) - (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d))) + (make (cl-mapcar (lambda (s d) (if (memq s anames) s d)) slots defaults)) ;; `cl-defsubst' is fundamentally broken: it substitutes ;; its arguments into the body's `sexp' much too naively @@ -3152,6 +3152,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (buffer . bufferp) (character . natnump) (char-table . char-table-p) + (hash-table . hash-table-p) (cons . consp) (fixnum . integerp) (float . floatp) @@ -3429,6 +3430,8 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance." (nth (cl-struct-slot-offset ,struct-type ,slot-name) ,inst) (aref ,inst (cl-struct-slot-offset ,struct-type ,slot-name))))))) +(make-obsolete-variable 'cl-macs-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'cl-macs-load-hook) ;; Local variables: diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index f90cce9b471..d34d50172df 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -1042,6 +1042,8 @@ Atoms are compared by `eql'; cons cells are compared recursively. (and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y))) +(make-obsolete-variable 'cl-seq-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'cl-seq-load-hook) ;; Local variables: diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 6fa51c3f644..9828ca63ebc 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -1,4 +1,4 @@ -;;; copyright.el --- update the copyright notice in current buffer +;;; copyright.el --- update the copyright notice in current buffer -*- lexical-binding: t -*- ;; Copyright (C) 1991-1995, 1998, 2001-2020 Free Software Foundation, ;; Inc. @@ -37,14 +37,12 @@ (defcustom copyright-limit 2000 "Don't try to update copyright beyond this position unless interactive. A value of nil means to search whole buffer." - :group 'copyright :type '(choice (integer :tag "Limit") (const :tag "No limit"))) (defcustom copyright-at-end-flag nil "Non-nil means to search backwards from the end of the buffer for copyright. This is useful for ChangeLogs." - :group 'copyright :type 'boolean :version "23.1") ;;;###autoload(put 'copyright-at-end-flag 'safe-local-variable 'booleanp) @@ -56,7 +54,6 @@ This is useful for ChangeLogs." \\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" "What your copyright notice looks like. The second \\( \\) construct must match the years." - :group 'copyright :type 'regexp) (defcustom copyright-names-regexp "" @@ -64,7 +61,6 @@ The second \\( \\) construct must match the years." Only copyright lines where the name matches this regexp will be updated. This allows you to avoid adding years to a copyright notice belonging to someone else or to a group for which you do not work." - :group 'copyright :type 'regexp) ;; The worst that can happen is a malicious regexp that overflows in @@ -76,7 +72,6 @@ someone else or to a group for which you do not work." "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" "Match additional copyright notice years. The second \\( \\) construct must match the years." - :group 'copyright :type 'regexp) ;; See "Copyright Notices" in maintain.info. @@ -87,7 +82,6 @@ The second \\( \\) construct must match the years." For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008. If you use ranges, you should add an explanatory note in a README file. The function `copyright-fix-years' respects this variable." - :group 'copyright :type 'boolean :version "24.1") @@ -96,7 +90,6 @@ The function `copyright-fix-years' respects this variable." (defcustom copyright-query 'function "If non-nil, ask user before changing copyright. When this is `function', only ask when called non-interactively." - :group 'copyright :type '(choice (const :tag "Do not ask") (const :tag "Ask unless interactive" function) (other :tag "Ask" t))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 1bdb2a3d8ca..0e4135b253e 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -320,6 +320,17 @@ the debugger will not be entered." (message "Error in debug printer: %S" err) (prin1 obj stream)))) +(make-obsolete 'debugger-insert-backtrace + "use a `backtrace-mode' buffer or `backtrace-to-string'." + "Emacs 27.1") + +(defun debugger-insert-backtrace (frames do-xrefs) + "Format and insert the backtrace FRAMES at point. +Make functions into cross-reference buttons if DO-XREFS is non-nil." + (insert (if do-xrefs + (backtrace--to-string frames) + (backtrace-to-string frames)))) + (defun debugger-setup-buffer (args) "Initialize the `*Backtrace*' buffer for entry to the debugger. That buffer should be current already and in debugger-mode." @@ -527,6 +538,9 @@ The environment used is the one when entering the activation frame at point." (let ((str (eval-expression-print-format val))) (if str (princ str t)))))))) +(define-obsolete-function-alias 'debugger-toggle-locals + 'backtrace-toggle-locals "28.1") + (defvar debugger-mode-map (let ((map (make-keymap))) @@ -621,6 +635,9 @@ Complete list of commands: (buffer-substring (line-beginning-position 0) (line-end-position 0))))) +(define-obsolete-function-alias 'debug-help-follow + 'backtrace-help-follow-symbol "28.1") + ;; When you change this, you may also need to change the number of ;; frames that the debugger skips. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 24c9e79f2c1..77f10e61c6c 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -1,4 +1,4 @@ -;;; easy-mmode.el --- easy definition for major and minor modes +;;; easy-mmode.el --- easy definition for major and minor modes -*- lexical-binding: t; -*- ;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc. @@ -84,10 +84,13 @@ replacing its case-insensitive matches with the literal string in LIGHTER." (defconst easy-mmode--arg-docstring " -If called interactively, enable %s if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, -also enable the mode if ARG is omitted or nil, and toggle it -if ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `%s'. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +All other values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled.") @@ -137,6 +140,10 @@ appear in DOC, a paragraph is added to DOC explaining usage of the mode argument. Optional INIT-VALUE is the initial value of the mode's variable. + Note that the minor mode function won't be called by setting + this option, so the value *reflects* the minor mode's natural + initial state, rather than *setting* it. + In the vast majority of cases it should be nil. Optional LIGHTER is displayed in the mode line when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), @@ -157,9 +164,6 @@ BODY contains code to execute each time the mode is enabled or disabled. the minor mode is global): :group GROUP Custom group name to use in all generated `defcustom' forms. - Defaults to MODE without the possible trailing \"-mode\". - Don't use this default group name unless you have written a - `defgroup' to define that group properly. :global GLOBAL If non-nil specifies that the minor mode is not meant to be buffer-local, so don't make the variable MODE buffer-local. By default, the mode is buffer-local. @@ -262,12 +266,6 @@ For example, you could write (unless initialize (setq initialize '(:initialize 'custom-initialize-default))) - (unless group - ;; We might as well provide a best-guess default group. - (setq group - `(:group ',(intern (replace-regexp-in-string - "-mode\\'" "" mode-name))))) - ;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode. (unless type (setq type '(:type 'boolean))) @@ -306,13 +304,20 @@ or call the function `%s'.")))) ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) ;; Use `toggle' rather than (if ,mode 0 1) so that using ;; repeat-command still does the toggling correctly. - (interactive (list (or current-prefix-arg 'toggle))) + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle))) (let ((,last-message (current-message))) (,@setter - (if (eq arg 'toggle) - (not ,getter) - ;; A nil argument also means ON now. - (> (prefix-numeric-value arg) 0))) + (cond ((eq arg 'toggle) + (not ,getter)) + ((and (numberp arg) + (> arg 0)) + t) + ((eq arg nil) + t) + (t + nil))) ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) @@ -344,6 +349,9 @@ or call the function `%s'.")))) No problems result if this variable is not bound. `add-hook' automatically binds it. (This is true for all hook variables.)" modefun))) + ;; Allow using using `M-x customize-variable' on the hook. + (put ',hook 'custom-type 'hook) + (put ',hook 'standard-value (list nil)) ;; Define the minor-mode keymap. ,(unless (symbolp keymap) ;nil is also a symbol. @@ -377,18 +385,21 @@ No problems result if this variable is not bound. (defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body) "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE. TURN-ON is a function that will be called with no args in every buffer - and that should try to turn MODE on if applicable for that buffer. -Each of KEY VALUE is a pair of CL-style keyword arguments. As - the minor mode defined by this function is always global, any - :global keyword is ignored. Other keywords have the same - meaning as in `define-minor-mode', which see. In particular, - :group specifies the custom group. The most useful keywords - are those that are passed on to the `defcustom'. It normally - makes no sense to pass the :lighter or :keymap keywords to - `define-globalized-minor-mode', since these are usually passed - to the buffer-local version of the minor mode. +and that should try to turn MODE on if applicable for that buffer. + +Each of KEY VALUE is a pair of CL-style keyword arguments. :predicate +specifies which major modes the globalized minor mode should be switched on +in. As the minor mode defined by this function is always global, any +:global keyword is ignored. Other keywords have the same meaning as in +`define-minor-mode', which see. In particular, :group specifies the custom +group. The most useful keywords are those that are passed on to the +`defcustom'. It normally makes no sense to pass the :lighter or :keymap +keywords to `define-globalized-minor-mode', since these are usually passed +to the buffer-local version of the minor mode. + BODY contains code to execute each time the mode is enabled or disabled. - It is executed after toggling the mode, and before running GLOBAL-MODE-hook. +It is executed after toggling the mode, and before running +GLOBAL-MODE-hook. If MODE's set-up depends on the major mode in effect when it was enabled, then disabling and reenabling MODE should make MODE work @@ -417,7 +428,11 @@ on if the hook has explicitly disabled it. (minor-MODE-hook (intern (concat mode-name "-hook"))) (MODE-set-explicitly (intern (concat mode-name "-set-explicitly"))) (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode"))) - keyw) + (MODE-predicate (intern (concat (replace-regexp-in-string + "-mode\\'" "" global-mode-name) + "-modes"))) + (turn-on-function `#',turn-on) + keyw predicate) ;; Check keys. (while (keywordp (setq keyw (car body))) @@ -425,6 +440,13 @@ on if the hook has explicitly disabled it. (pcase keyw (:group (setq group (nconc group (list :group (pop body))))) (:global (pop body)) + (:predicate + (setq predicate (list (pop body))) + (setq turn-on-function + `(lambda () + (require 'easy-mmode) + (when (easy-mmode--globalized-predicate-p ,(car predicate)) + (funcall ,turn-on-function))))) (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) `(progn @@ -444,10 +466,17 @@ ARG is omitted or nil. %s is enabled in all buffers where `%s' would do it. -See `%s' for more information on %s." + +See `%s' for more information on +%s.%s" pretty-name pretty-global-name - pretty-name turn-on mode pretty-name) - :global t ,@group ,@(nreverse extra-keywords) + pretty-name turn-on mode pretty-name + (if predicate + (format "\n\n`%s' is used to control which modes +this minor mode is used in." + MODE-predicate) + "")) + :global t ,@group ,@(nreverse extra-keywords) ;; Setup hook to handle future mode changes and new buffers. (if ,global-mode @@ -463,9 +492,28 @@ See `%s' for more information on %s." ;; Go through existing buffers. (dolist (buf (buffer-list)) (with-current-buffer buf - (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1))))) + (if ,global-mode (funcall ,turn-on-function) + (when ,mode (,mode -1))))) ,@body) + ,(when predicate + `(defcustom ,MODE-predicate ,(car predicate) + ,(format "Which major modes `%s' is switched on in. +This variable can be either t (all major modes), nil (no major modes), +or a list of modes and (not modes) to switch use this minor mode or +not. For instance + + (c-mode (not message-mode mail-mode) text-mode) + +means \"use this mode in all modes derived from `c-mode', don't use in +modes derived from `message-mode' or `mail-mode', but do use in other +modes derived from `text-mode'\". An element with value t means \"use\" +and nil means \"don't use\". There's an implicit nil at the end of the +list." + mode) + :type '(repeat sexp) + :group ,group)) + ;; Autoloading define-globalized-minor-mode autoloads everything ;; up-to-here. :autoload-end @@ -499,8 +547,8 @@ See `%s' for more information on %s." (if ,mode (progn (,mode -1) - (funcall #',turn-on)) - (funcall #',turn-on)))) + (funcall ,turn-on-function)) + (funcall ,turn-on-function)))) (setq ,MODE-major-mode major-mode)))))) (put ',MODE-enable-in-buffers 'definition-name ',global-mode) @@ -515,6 +563,33 @@ See `%s' for more information on %s." (add-hook 'post-command-hook ',MODE-check-buffers)) (put ',MODE-cmhh 'definition-name ',global-mode)))) +(defun easy-mmode--globalized-predicate-p (predicate) + (cond + ((eq predicate t) + t) + ((eq predicate nil) + nil) + ((listp predicate) + ;; Legacy support for (not a b c). + (when (eq (car predicate) 'not) + (setq predicate (nconc (mapcar (lambda (e) (list 'not e)) + (cdr predicate)) + (list t)))) + (catch 'found + (dolist (elem predicate) + (cond + ((eq elem t) + (throw 'found t)) + ((eq elem nil) + (throw 'found nil)) + ((and (consp elem) + (eq (car elem) 'not)) + (when (apply #'derived-mode-p (cdr elem)) + (throw 'found nil))) + ((symbolp elem) + (when (derived-mode-p elem) + (throw 'found t))))))))) + ;;; ;;; easy-mmode-defmap ;;; diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 7ff6d68c3ec..fe733630bad 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2665,9 +2665,6 @@ See `edebug-behavior-alist' for implementations.") (defvar edebug-previous-result nil) ;; Last result returned. -;; Emacs 19 adds an arg to mark and mark-marker. -(defalias 'edebug-mark-marker 'mark-marker) - (defun edebug--display (value offset-index arg-mode) ;; edebug--display-1 is too big, we should split it. This function ;; here was just introduced to avoid making edebug--display-1 @@ -2895,8 +2892,8 @@ See `edebug-behavior-alist' for implementations.") ;; But don't restore point if edebug-buffer is current buffer. (if (not (eq edebug-buffer edebug-outside-buffer)) (goto-char edebug-outside-point)) - (if (marker-buffer (edebug-mark-marker)) - (set-marker (edebug-mark-marker) edebug-outside-mark)) + (if (marker-buffer (mark-marker)) + (set-marker (mark-marker) edebug-outside-mark)) )) ; unwind-protect ;; None of the following is done if quit or signal occurs. @@ -3153,8 +3150,8 @@ before returning. The default is one second." (goto-char edebug-outside-point) (message "Current buffer: %s Point: %s Mark: %s" (current-buffer) (point) - (if (marker-buffer (edebug-mark-marker)) - (marker-position (edebug-mark-marker)) "<not set>")) + (if (marker-buffer (mark-marker)) + (marker-position (mark-marker)) "<not set>")) (sit-for arg) (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) @@ -3725,8 +3722,8 @@ Return the result of the last expression." ;; for us. (with-current-buffer edebug-outside-buffer ; of edebug-buffer (goto-char edebug-outside-point) - (if (marker-buffer (edebug-mark-marker)) - (set-marker (edebug-mark-marker) edebug-outside-mark)) + (if (marker-buffer (mark-marker)) + (set-marker (mark-marker) edebug-outside-mark)) ,@body) ;; Back to edebug-buffer. Restore rest of inside context. @@ -4461,7 +4458,6 @@ reinstrument it." (defun edebug-temp-display-freq-count () "Temporarily display the frequency count data for the current definition. It is removed when you hit any char." - ;; This seems not to work with Emacs 18.59. It undoes too far. (interactive) (let ((inhibit-read-only t)) (undo-boundary) @@ -4668,5 +4664,7 @@ instrumentation for, defaulting to all functions." (message "Removed edebug instrumentation from %s" (mapconcat #'symbol-name functions ", "))) +(define-obsolete-function-alias 'edebug-mark-marker #'mark-marker "28.1") + (provide 'edebug) ;;; edebug.el ends here diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 39ad30afc5a..a484c2ff382 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -201,7 +201,7 @@ This is used with the `object-write' method.") "Saving this object should make backup files. Setting to nil will mean no backups are made.")) "This special class enables persistence through save files -Use the `object-save' method to write this object to disk. The save +Use the `object-write' method to write this object to disk. The save format is Emacs Lisp code which calls the constructor for the saved object. For this reason, only slots which do not have an `:initarg' specified will not be saved." diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index b75410ee220..810affa7227 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -875,7 +875,7 @@ this object." ;; Now output readable lisp to recreate this object ;; It should look like this: ;; (<constructor> <name> <slot> <slot> ... ) - ;; Each slot's slot is writen using its :writer. + ;; Each slot's slot is written using its :writer. (when eieio-print-indentation (princ (make-string (* eieio-print-depth 2) ? ))) (princ "(") diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 772c907c284..78cb8f08c34 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -5,7 +5,7 @@ ;; Author: Noah Friedman <friedman@splode.com> ;; Keywords: extensions ;; Created: 1995-10-06 -;; Version: 1.10.0 +;; Version: 1.11.0 ;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -67,6 +67,12 @@ If this variable is set to 0, no idle time is required." Changing the value requires toggling `eldoc-mode'." :type 'boolean) +(defcustom eldoc-echo-area-display-truncation-message t + "If non-nil, provide verbose help when a message has been truncated. +If nil, truncated messages will just have \"...\" appended." + :type 'boolean + :version "28.1") + ;;;###autoload (defcustom eldoc-minor-mode-string (purecopy " ElDoc") "String to display in mode line when ElDoc Mode is enabled; nil for none." @@ -90,19 +96,22 @@ Note that this variable has no effect, unless If value is t, never attempt to truncate messages, even if the echo area must be resized to fit. -If value is a number (integer or floating point), it has the -semantics of `max-mini-window-height', constraining the resizing -for ElDoc purposes only. +If the value is a positive number, it is used to calculate a +number of logical lines of documentation that ElDoc is allowed to +put in the echo area. If a positive integer, the number is used +directly, while a float specifies the number of lines as a +proporting of the echo area frame's height. -Any resizing respects `max-mini-window-height'. - -If value is any non-nil symbol other than t, the part of the doc -string that represents the symbol's name may be truncated if it -will enable the rest of the doc string to fit on a single line, -without resizing the echo area. +If value is the symbol `truncate-sym-name-if-fit' t, the part of +the doc string that represents a symbol's name may be truncated +if it will enable the rest of the doc string to fit on a single +line, without resizing the echo area. If value is nil, a doc string is always truncated to fit in a -single line of display in the echo area." +single line of display in the echo area. + +Any resizing of the echo area additionally respects +`max-mini-window-height'." :type '(radio (const :tag "Always" t) (float :tag "Fraction of frame height" 0.25) (integer :tag "Number of lines" 5) @@ -111,12 +120,13 @@ single line of display in the echo area." symbol names if it will\ enable argument list to fit on one line" truncate-sym-name-if-fit))) -(defcustom eldoc-prefer-doc-buffer nil +(defcustom eldoc-echo-area-prefer-doc-buffer nil "Prefer ElDoc's documentation buffer if it is showing in some frame. -If this variable's value is t and a piece of documentation needs -to be truncated to fit in the echo area, do so if ElDoc's -documentation buffer is not already showing, since the buffer -always holds the full documentation." +If this variable's value is t, ElDoc will skip showing +documentation in the echo area if the dedicated documentation +buffer (given by `eldoc-doc-buffer') is being displayed in some +window. If the value is the symbol `maybe', then the echo area +is only skipped if the documentation doesn't fit there." :type 'boolean) (defface eldoc-highlight-function-argument @@ -231,8 +241,9 @@ expression point is on." :lighter eldoc-minor-mode-string ;; `emacs-lisp-mode' itself? (cond ((<= emacs-major-version 27) (declare-function elisp-eldoc-documentation-function "elisp-mode") - (add-function :before-until (local 'eldoc-documentation-function) - #'elisp-eldoc-documentation-function)) + (with-no-warnings + (add-function :before-until (local 'eldoc-documentation-function) + #'elisp-eldoc-documentation-function))) (t (add-hook 'eldoc-documentation-functions #'elisp-eldoc-var-docstring nil t) (add-hook 'eldoc-documentation-functions @@ -344,40 +355,26 @@ Also store it in `eldoc-last-message' and return that value." ;; for us, but do note that the last-message will be gone. (setq eldoc-last-message nil)))) -(defvar-local eldoc--last-request-state nil +;; The point of `eldoc--request-state' is not to over-request, which +;; can happen if the idle timer is restarted on execution of command +;; which is guaranteed not to change the conditions that warrant a new +;; request for documentation. +(defvar eldoc--last-request-state nil "Tuple containing information about last ElDoc request.") (defun eldoc--request-state () "Compute information to store in `eldoc--last-request-state'." (list (current-buffer) (buffer-modified-tick) (point))) (defun eldoc-display-message-p () - (eldoc--request-docs-p (eldoc--request-state))) + "Tell if ElDoc can use the echo area." + (and (eldoc-display-message-no-interference-p) + (not this-command) + (eldoc--message-command-p last-command))) + (make-obsolete 'eldoc-display-message-p "Use `eldoc-documentation-functions' instead." "eldoc-1.6.0") -(defun eldoc--request-docs-p (request-state) - "Return non-nil when it is appropriate to request docs. -REQUEST-STATE is a candidate for `eldoc--last-request-state'" - (and - ;; FIXME: The original idea behind this function is to protect the - ;; Echo area from ElDoc interference, but since that is only one of - ;; the possible outlets of ElDoc, this must soon be reworked. - (eldoc-display-message-no-interference-p) - (not (and eldoc--doc-buffer - (get-buffer-window eldoc--doc-buffer) - (equal request-state - (with-current-buffer - eldoc--doc-buffer - eldoc--last-request-state)))) - ;; If this-command is non-nil while running via an idle - ;; timer, we're still in the middle of executing a command, - ;; e.g. a query-replace where it would be annoying to - ;; overwrite the echo area. - (not this-command) - (eldoc--message-command-p last-command))) - - ;; Check various conditions about the current environment that might make ;; it undesirable to print eldoc messages right this instant. (defun eldoc-display-message-no-interference-p () @@ -410,43 +407,159 @@ about the context around point. To call the CALLBACK function, the hook function must pass it an obligatory argument DOCSTRING, a string containing the -documentation, followed by an optional list of keyword-value -pairs of the form (:KEY VALUE :KEY2 VALUE2...). KEY can be: - -* `:thing', VALUE is a short string or symbol designating what is - being reported on. The documentation display engine can elect - to remove this information depending on space contraints; - -* `:face', VALUE is a symbol designating a face to use when - displaying `:thing''s value. - -Major modes should modify this hook locally, for example: +documentation, followed by an optional list of arbitrary +keyword-value pairs of the form (:KEY VALUE :KEY2 VALUE2...). +The information contained in these pairs is understood by members +of `eldoc-display-functions', allowing the +documentation-producing backend to cooperate with specific +documentation-displaying frontends. For example, KEY can be: + +* `:thing', VALUE being a short string or symbol designating what + is being reported on. It can, for example be the name of the + function whose signature is being documented, or the name of + the variable whose docstring is being documented. + `eldoc-display-in-echo-area', a member of + `eldoc-display-functions', sometimes omits this information + depending on space constraints; + +* `:face', VALUE being a symbol designating a face which both + `eldoc-display-in-echo-area' and `eldoc-display-in-buffer' will + use when displaying `:thing''s value. + +Finally, major modes should modify this hook locally, for +example: (add-hook \\='eldoc-documentation-functions #\\='foo-mode-eldoc nil t) so that the global value (i.e. the default value of the hook) is taken into account if the major mode specific function does not return any documentation.") +(defvar eldoc-display-functions + '(eldoc-display-in-echo-area eldoc-display-in-buffer) + "Hook of functions tasked with displaying ElDoc results. +Each function is passed two arguments: DOCS and INTERACTIVE. DOCS +is a list (DOC ...) where DOC looks like (STRING :KEY VALUE :KEY2 +VALUE2 ...). STRING is a string containing the documentation's +text and the remainder of DOC is an optional list of +keyword-value pairs denoting additional properties of that +documentation. For commonly recognized properties, see +`eldoc-documentation-functions'. + +INTERACTIVE says if the request to display doc strings came +directly from the user or from ElDoc's automatic mechanisms'.") + (defvar eldoc--doc-buffer nil "Buffer displaying latest ElDoc-produced docs.") -(defun eldoc-doc-buffer (&optional interactive) - "Get latest *eldoc* help buffer. Interactively, display it." +(defvar eldoc--doc-buffer-docs nil "Documentation items in `eldoc--doc-buffer'.") + +(defun eldoc-doc-buffer () + "Display ElDoc documentation buffer. + +This holds the results of the last documentation request." + (interactive) + (unless (buffer-live-p eldoc--doc-buffer) + (user-error (format + "ElDoc buffer doesn't exist, maybe `%s' to produce one." + (substitute-command-keys "\\[eldoc]")))) + (with-current-buffer eldoc--doc-buffer + (rename-buffer (replace-regexp-in-string "^ *" "" + (buffer-name))) + (display-buffer (current-buffer)))) + +(defun eldoc--format-doc-buffer (docs) + "Ensure DOCS are displayed in an *eldoc* buffer." (interactive (list t)) - (prog1 - (if (and eldoc--doc-buffer (buffer-live-p eldoc--doc-buffer)) - eldoc--doc-buffer - (setq eldoc--doc-buffer (get-buffer-create "*eldoc*"))) - (when interactive (display-buffer eldoc--doc-buffer)))) - - -(defun eldoc--handle-docs (docs) - "Display multiple DOCS in echo area. -DOCS is a list of (STRING PLIST...). It is already sorted. -Honor most of `eldoc-echo-area-use-multiline-p'." - ;; If there's nothing to report clear the echo area, but don't erase - ;; the last *eldoc* buffer. - (if (null docs) (eldoc--message nil) + (with-current-buffer (if (buffer-live-p eldoc--doc-buffer) + eldoc--doc-buffer + (setq eldoc--doc-buffer + (get-buffer-create " *eldoc*"))) + (unless (eq docs eldoc--doc-buffer-docs) + (setq-local eldoc--doc-buffer-docs docs) + (let ((inhibit-read-only t) + (things-reported-on)) + (erase-buffer) (setq buffer-read-only t) + (local-set-key "q" 'quit-window) + (cl-loop for (docs . rest) on docs + for (this-doc . plist) = docs + for thing = (plist-get plist :thing) + when thing do + (cl-pushnew thing things-reported-on) + (setq this-doc + (concat + (propertize (format "%s" thing) + 'face (plist-get plist :face)) + ": " + this-doc)) + do (insert this-doc) + when rest do (insert "\n") + finally (goto-char (point-min))) + ;; Rename the buffer, taking into account whether it was + ;; hidden or not + (rename-buffer (format "%s*eldoc%s*" + (if (string-match "^ " (buffer-name)) " " "") + (if things-reported-on + (format " for %s" + (mapconcat + (lambda (s) (format "%s" s)) + things-reported-on + ", ")) + "")))))) + eldoc--doc-buffer) + +(defun eldoc--echo-area-substring (available) + "Given AVAILABLE lines, get buffer substring to display in echo area. +Helper for `eldoc-display-in-echo-area'." + (let ((start (prog1 (progn + (goto-char (point-min)) + (skip-chars-forward " \t\n") + (point)) + (goto-char (line-end-position available)) + (skip-chars-backward " \t\n"))) + (truncated (save-excursion + (skip-chars-forward " \t\n") + (not (eobp))))) + (cond ((eldoc--echo-area-prefer-doc-buffer-p truncated) + nil) + ((and truncated + (> available 1) + eldoc-echo-area-display-truncation-message) + (goto-char (line-end-position 0)) + (concat (buffer-substring start (point)) + (format + "\n(Documentation truncated. Use `%s' to see rest)" + (substitute-command-keys "\\[eldoc-doc-buffer]")))) + (t + (buffer-substring start (point)))))) + +(defun eldoc--echo-area-prefer-doc-buffer-p (truncatedp) + "Tell if display in the echo area should be skipped. +Helper for `eldoc-display-in-echo-area'. If TRUNCATEDP the +documentation to potentially appear in the echo are is truncated." + (and (or (eq eldoc-echo-area-prefer-doc-buffer t) + (and truncatedp + (eq eldoc-echo-area-prefer-doc-buffer + 'maybe))) + (get-buffer-window eldoc--doc-buffer))) + +(defun eldoc-display-in-echo-area (docs _interactive) + "Display DOCS in echo area. +Honor `eldoc-echo-area-use-multiline-p' and +`eldoc-echo-area-prefer-doc-buffer'." + (cond + (;; Check if he wave permission to mess with echo area at all. For + ;; example, if this-command is non-nil while running via an idle + ;; timer, we're still in the middle of executing a command, e.g. a + ;; query-replace where it would be annoying to overwrite the echo + ;; area. + (or + (not (eldoc-display-message-no-interference-p)) + this-command + (not (eldoc--message-command-p last-command)))) + (;; If we do but nothing to report, clear the echo area. + (null docs) + (eldoc--message nil)) + (t + ;; Otherwise, establish some parameters. (let* - ;; Otherwise, establish some parameters. ((width (1- (window-width (minibuffer-window)))) (val (if (and (symbolp eldoc-echo-area-use-multiline-p) eldoc-echo-area-use-multiline-p) @@ -455,44 +568,13 @@ Honor most of `eldoc-echo-area-use-multiline-p'." (available (cl-typecase val (float (truncate (* (frame-height) val))) (integer val) - (t 1))) - (things-reported-on) - (request eldoc--last-request-state) + (t 'just-one-line))) single-doc single-doc-sym) - ;; Then, compose the contents of the `*eldoc*' buffer. - (with-current-buffer (eldoc-doc-buffer) - ;; Set doc-buffer's `eldoc--last-request-state', too - (setq eldoc--last-request-state request) - (let ((inhibit-read-only t)) - (erase-buffer) (setq buffer-read-only t) - (local-set-key "q" 'quit-window) - (cl-loop for (docs . rest) on docs - for (this-doc . plist) = docs - for thing = (plist-get plist :thing) - when thing do - (cl-pushnew thing things-reported-on) - (setq this-doc - (concat - (propertize (format "%s" thing) - 'face (plist-get plist :face)) - ": " - this-doc)) - do (insert this-doc) - when rest do (insert "\n"))) - ;; Rename the buffer. - (when things-reported-on - (rename-buffer (format "*eldoc for %s*" - (mapconcat (lambda (s) (format "%s" s)) - things-reported-on - ", "))))) - ;; Finally, output to the echo area. I'm pretty sure nicer - ;; strategies can be used here, probably by splitting this - ;; function into some `eldoc-display-functions' special hook. (let ((echo-area-message (cond - (;; We handle the `truncate-sym-name-if-fit' special - ;; case first, by checking if for a lot of special - ;; conditions. + (;; To output to the echo area, we handle the + ;; `truncate-sym-name-if-fit' special case first, by + ;; checking for a lot of special conditions. (and (eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p) (null (cdr docs)) @@ -503,38 +585,32 @@ Honor most of `eldoc-echo-area-use-multiline-p'." (not (string-match "\n" single-doc)) (> (+ (length single-doc) (length single-doc-sym) 2) width)) single-doc) - ((> available 1) - (with-current-buffer (eldoc-doc-buffer) - (cl-loop - initially - (goto-char (point-min)) - (goto-char (line-end-position (1+ available))) - for truncated = nil then t - for needed - = (let ((truncate-lines message-truncate-lines)) - (count-screen-lines (point-min) (point) t - (minibuffer-window))) - while (> needed (if truncated (1- available) available)) - do (goto-char (line-end-position (if truncated 0 -1))) - (while (and (not (bobp)) (bolp)) (goto-char (line-end-position 0))) - finally - (unless (and truncated - eldoc-prefer-doc-buffer - (get-buffer-window eldoc--doc-buffer)) - (cl-return - (concat - (buffer-substring (point-min) (point)) - (and truncated - (format - "\n(Documentation truncated. Use `%s' to see rest)" - (substitute-command-keys "\\[eldoc-doc-buffer]"))))))))) - ((= available 1) - ;; Truncate "brutally." ; FIXME: use `eldoc-prefer-doc-buffer' too? - (with-current-buffer (eldoc-doc-buffer) - (truncate-string-to-width - (buffer-substring (goto-char (point-min)) (line-end-position 1)) width)))))) + ((and (numberp available) + (cl-plusp available)) + ;; Else, given a positive number of logical lines, we + ;; format the *eldoc* buffer, using as most of its + ;; contents as we know will fit. + (with-current-buffer (eldoc--format-doc-buffer docs) + (eldoc--echo-area-substring available))) + (t ;; this is the "truncate brutally" situation + (let ((string + (with-current-buffer (eldoc--format-doc-buffer docs) + (buffer-substring (goto-char (point-min)) + (line-end-position 1))))) + (if (> (length string) width) ; truncation to happen + (unless (eldoc--echo-area-prefer-doc-buffer-p t) + (truncate-string-to-width string width)) + (unless (eldoc--echo-area-prefer-doc-buffer-p nil) + string))))))) (when echo-area-message - (eldoc--message echo-area-message)))))) + (eldoc--message echo-area-message))))))) + +(defun eldoc-display-in-buffer (docs interactive) + "Display DOCS in a dedicated buffer. +If INTERACTIVE is t, also display the buffer." + (eldoc--format-doc-buffer docs) + (when interactive + (eldoc-doc-buffer))) (defun eldoc-documentation-default () "Show first doc string for item at point. @@ -696,21 +772,31 @@ have the following values: strings so far, as soon as possible." (funcall eldoc--make-callback method)) -(defun eldoc--invoke-strategy () +(defun eldoc--invoke-strategy (interactive) "Invoke `eldoc-documentation-strategy' function. +If INTERACTIVE is non-nil, the request came directly from a user +command, otherwise it came from ElDoc's idle +timer, `eldoc-timer'. + That function's job is to run the `eldoc-documentation-functions' special hook, using the `run-hook' family of functions. ElDoc's built-in strategy functions play along with the -`eldoc--make-callback' protocol, using it to produce callback to -feed to the functgions of `eldoc-documentation-functions'. - -Other third-party strategy functions do not use -`eldoc--make-callback'. They must find some alternate way to -produce callbacks to feed to `eldoc-documentation-function' and -should endeavour to display the docstrings eventually produced." +`eldoc--make-callback' protocol, using it to produce a callback +argument to feed the functions that the user places in +`eldoc-documentation-functions'. Whenever the strategy +determines it has information to display to the user, this +function passes responsibility to the functions in +`eldoc-display-functions'. + +Other third-party values of `eldoc-documentation-strategy' should +not use `eldoc--make-callback'. They must find some alternate +way to produce callbacks to feed to +`eldoc-documentation-function' and should endeavour to display +the docstrings eventually produced, using +`eldoc-display-functions'." (let* (;; How many callbacks have been created by the strategy - ;; fucntion and passed to elements of + ;; function and passed to elements of ;; `eldoc-documentation-functions'. (howmany 0) ;; How many calls to callbacks we're still waiting on. Used @@ -726,11 +812,12 @@ should endeavour to display the docstrings eventually produced." (push (cons pos (cons string plist)) docs-registered))) (display-doc () - (eldoc--handle-docs - (mapcar #'cdr - (setq docs-registered - (sort docs-registered - (lambda (a b) (< (car a) (car b)))))))) + (run-hook-with-args + 'eldoc-display-functions (mapcar #'cdr + (setq docs-registered + (sort docs-registered + (lambda (a b) (< (car a) (car b)))))) + interactive)) (make-callback (method) (let ((pos (prog1 howmany (cl-incf howmany)))) @@ -773,22 +860,23 @@ should endeavour to display the docstrings eventually produced." (defun eldoc-print-current-symbol-info (&optional interactive) "Document thing at point." (interactive '(t)) - (let ((token (eldoc--request-state))) + (let (token) (cond (interactive - (eldoc--invoke-strategy)) - ((not (eldoc--request-docs-p token)) - ;; Erase the last message if we won't display a new one. - (when eldoc-last-message - (eldoc--message nil))) - (t + (eldoc--invoke-strategy t)) + ((not (equal (setq token (eldoc--request-state)) + eldoc--last-request-state)) (let ((non-essential t)) (setq eldoc--last-request-state token) ;; Only keep looking for the info as long as the user hasn't ;; requested our attention. This also locally disables ;; inhibit-quit. (while-no-input - (eldoc--invoke-strategy))))))) + (eldoc--invoke-strategy nil))))))) + +;; This section only affects ElDoc output to the echo area, as in +;; `eldoc-display-in-echo-area'. +;; ;; When point is in a sexp, the function args are not reprinted in the echo ;; area after every possible interactive command because some of them print ;; their own messages in the echo area; the eldoc functions would instantly @@ -820,7 +908,6 @@ should endeavour to display the docstrings eventually produced." (apply #'eldoc-remove-command (all-completions name eldoc-message-commands)))) - ;; Prime the command list. (eldoc-add-command-completions "back-to-indentation" diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index f68c0faf09d..a94978ac47b 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -342,9 +342,9 @@ Use optional LIST if provided instead." (interactive (list (intern - (completing-read "Master function: " obarray - #'elp--instrumented-p - t nil nil (if elp-master (symbol-name elp-master)))))) + (let ((default (if elp-master (symbol-name elp-master)))) + (completing-read (format-prompt "Master function" default) + obarray #'elp--instrumented-p t nil nil default))))) ;; When there's a master function, recording is turned off by default. (setq elp-master funsym elp-record-p nil) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 622f5654b25..abbff6da625 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -30,6 +30,7 @@ (eval-when-compile (require 'cl-lib)) (require 'ert) +(require 'subr-x) ; string-trim ;;; Test buffers. @@ -177,6 +178,18 @@ test for `called-interactively' in the command will fail." (cl-assert (not unread-command-events) t) return-value)) +(defmacro ert-simulate-keys (keys &rest body) + "Execute BODY with KEYS as pseudo-interactive input." + (declare (debug t) (indent 1)) + `(let ((unread-command-events + ;; Add some C-g to try and make sure we still exit + ;; in case something goes wrong. + (append ,keys '(?\C-g ?\C-g ?\C-g))) + ;; Tell `read-from-minibuffer' not to read from stdin when in + ;; batch mode. + (executing-kbd-macro t)) + ,@body)) + (defun ert-run-idle-timers () "Run all idle timers (from `timer-idle-list')." (dolist (timer (copy-sequence timer-idle-list)) @@ -341,6 +354,45 @@ convert it to a string and pass it to COLLECTOR first." (funcall func object))) (funcall func object printcharfun)))) +(defvar ert-resource-directory-format "%s-resources/" + "Format for `ert-resource-directory'.") +(defvar ert-resource-directory-trim-left-regexp "" + "Regexp for `string-trim' (left) used by `ert-resource-directory'.") +(defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el" + "Regexp for `string-trim' (right) used by `ert-resource-directory'.") + +;; Has to be a macro for `load-file-name'. +(defmacro ert-resource-directory () + "Return absolute file name of the resource directory for this file. + +The path to the resource directory is the \"resources\" directory +in the same directory as the test file. + +If that directory doesn't exist, use the directory named like the +test file but formatted by `ert-resource-directory-format' and trimmed +using `string-trim' with arguments +`ert-resource-directory-trim-left-regexp' and +`ert-resource-directory-trim-right-regexp'. The default values mean +that if called from a test file named \"foo-tests.el\", return +the absolute file name for \"foo-resources\"." + `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file) + (and load-in-progress load-file-name) + buffer-file-name)) + (default-directory (file-name-directory testfile))) + (file-truename + (if (file-accessible-directory-p "resources/") + (expand-file-name "resources/") + (expand-file-name + (format ert-resource-directory-format + (string-trim testfile + ert-resource-directory-trim-left-regexp + ert-resource-directory-trim-right-regexp))))))) + +(defmacro ert-resource-file (file) + "Return file name of resource file named FILE. +A resource file is in the resource directory as per +`ert-resource-directory'." + `(expand-file-name ,file (ert-resource-directory))) (provide 'ert-x) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 3c347c0b199..baa04f2c6af 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -736,7 +736,7 @@ run. ARGS are the arguments to `debugger'." ;; This means we have to limit `print-level' and ;; `print-length' when printing result objects. That ;; might not be worth while when we can also use - ;; `ert-results-rerun-test-debugging-errors-at-point', + ;; `ert-results-rerun-test-at-point-debugging-errors', ;; (i.e., when running interactively) but having the ;; backtrace ready for printing is important for batch ;; use. @@ -958,7 +958,7 @@ Selectors that do not, such as (member ...), just return the set implied by them without checking whether it is really contained in UNIVERSE." ;; This code needs to match the cases in - ;; `ert-insert-human-readable-selector'. + ;; `ert--insert-human-readable-selector'. (pcase-exhaustive selector ('nil nil) ('t (pcase-exhaustive universe @@ -1305,7 +1305,8 @@ EXPECTEDP specifies whether the result was expected." "Pretty-print OBJECT, indenting it to the current column of point. Ensures a final newline is inserted." (let ((begin (point)) - (pp-escape-newlines nil)) + (pp-escape-newlines nil) + (print-escape-control-characters t)) (pp object (current-buffer)) (unless (bolp) (insert "\n")) (save-excursion diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index 78ada3e076d..5112322cfd6 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -205,15 +205,26 @@ NODE and leaving the new node's start there. Return the new node." (defun ewoc--refresh-node (pp node dll) "Redisplay the element represented by NODE using the pretty-printer PP." - (let ((inhibit-read-only t) - (m (ewoc--node-start-marker node)) - (R (ewoc--node-right node))) - ;; First, remove the string from the buffer: - (delete-region m (ewoc--node-start-marker R)) - ;; Calculate and insert the string. - (goto-char m) - (funcall pp (ewoc--node-data node)) - (ewoc--adjust m (point) R dll))) + (let* ((m (ewoc--node-start-marker node)) + (R (ewoc--node-right node)) + (end (ewoc--node-start-marker R)) + (inhibit-read-only t) + (offset (if (= (point) end) + 'end + (when (< m (point) end) + (- (point) m))))) + (save-excursion + ;; First, remove the string from the buffer: + (delete-region m end) + ;; Calculate and insert the string. + (goto-char m) + (funcall pp (ewoc--node-data node)) + (setq end (point)) + (ewoc--adjust m (point) R dll)) + (when offset + (goto-char (if (eq offset 'end) + end + (min (+ m offset) (1- end))))))) (defun ewoc--wrap (func) (lambda (data) @@ -342,11 +353,10 @@ arguments will be passed to MAP-FUNCTION." ((footer (ewoc--footer ewoc)) (pp (ewoc--pretty-printer ewoc)) (node (ewoc--node-nth dll 1))) - (save-excursion - (while (not (eq node footer)) - (if (apply map-function (ewoc--node-data node) args) - (ewoc--refresh-node pp node dll)) - (setq node (ewoc--node-next dll node)))))) + (while (not (eq node footer)) + (if (apply map-function (ewoc--node-data node) args) + (ewoc--refresh-node pp node dll)) + (setq node (ewoc--node-next dll node))))) (defun ewoc-delete (ewoc &rest nodes) "Delete NODES from EWOC." @@ -461,9 +471,8 @@ If the EWOC is empty, nil is returned." Delete current text first, thus effecting a \"refresh\"." (ewoc--set-buffer-bind-dll-let* ewoc ((pp (ewoc--pretty-printer ewoc))) - (save-excursion - (dolist (node nodes) - (ewoc--refresh-node pp node dll))))) + (dolist (node nodes) + (ewoc--refresh-node pp node dll)))) (defun ewoc-goto-prev (ewoc arg) "Move point to the ARGth previous element in EWOC. @@ -566,9 +575,8 @@ Return nil if the buffer has been deleted." (hf-pp (ewoc--hf-pp ewoc))) (setf (ewoc--node-data head) header (ewoc--node-data foot) footer) - (save-excursion - (ewoc--refresh-node hf-pp head dll) - (ewoc--refresh-node hf-pp foot dll)))) + (ewoc--refresh-node hf-pp head dll) + (ewoc--refresh-node hf-pp foot dll))) (provide 'ewoc) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 9e252d8c529..ee94e1fbff7 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -61,7 +61,7 @@ "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ -menu-bar-make-toggle\\)" +menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)" find-function-space-re "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)") "The regexp used by `find-function' to search for a function definition. @@ -286,20 +286,10 @@ Interactively, prompt for LIBRARY using the one at or near point." A library name is the filename of an Emacs Lisp library located in a directory under `load-path' (or `find-function-source-path', if non-nil)." - (let* ((suffix-regexp (mapconcat - (lambda (suffix) - (concat (regexp-quote suffix) "\\'")) - (find-library-suffixes) - "\\|")) - (table (cl-loop for dir in (or find-function-source-path load-path) - for dir-or-default = (or dir default-directory) - when (file-readable-p dir-or-default) - append (mapcar - (lambda (file) - (replace-regexp-in-string suffix-regexp - "" file)) - (directory-files dir-or-default nil - suffix-regexp)))) + (let* ((dirs (or find-function-source-path load-path)) + (suffixes (find-library-suffixes)) + (table (apply-partially 'locate-file-completion-table + dirs suffixes)) (def (if (eq (function-called-at-point) 'require) ;; `function-called-at-point' may return 'require ;; with `point' anywhere on this line. So wrap the diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index 06ef5800568..3bc6d021dc8 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -116,6 +116,10 @@ instead (which see).") function-list &optional docstring) "Create a new generic mode MODE. +A \"generic\" mode is a simple major mode with basic support for +comment syntax and Font Lock mode, but otherwise does not have +any special keystrokes or functionality available. + MODE is the name of the command for the generic mode; don't quote it. The optional DOCSTRING is the documentation for the mode command. If you do not supply it, `define-generic-mode' uses a default diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 78d86b9fc31..5470b8532fc 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -417,6 +417,17 @@ The return value is the last VAL in the list. `(delq ,p ,getter)))))) ,v)))))))))) +(gv-define-expander plist-get + (lambda (do plist prop) + (macroexp-let2 macroexp-copyable-p key prop + (gv-letplace (getter setter) plist + (macroexp-let2 nil p `(cdr (plist-member ,getter ,key)) + (funcall do + `(car ,p) + (lambda (val) + `(if ,p + (setcar ,p ,val) + ,(funcall setter `(cons ,key (cons ,val ,getter))))))))))) ;;; Some occasionally handy extensions. diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 8c18557c79a..35590123ee6 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -55,7 +55,7 @@ This affects `insert-parentheses' and `insert-pair'." "If non-nil, `forward-sexp' delegates to this function. Should take the same arguments and behave similarly to `forward-sexp'.") -(defun forward-sexp (&optional arg) +(defun forward-sexp (&optional arg interactive) "Move forward across one balanced expression (sexp). With ARG, do it that many times. Negative arg -N means move backward across N balanced expressions. This command assumes @@ -64,23 +64,32 @@ point is not in a string or comment. Calls If unable to move over a sexp, signal `scan-error' with three arguments: a message, the start of the obstacle (usually a parenthesis or list marker of some kind), and end of the -obstacle." - (interactive "^p") - (or arg (setq arg 1)) - (if forward-sexp-function - (funcall forward-sexp-function arg) - (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) - (if (< arg 0) (backward-prefix-chars)))) - -(defun backward-sexp (&optional arg) +obstacle. If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") + (if interactive + (condition-case _ + (forward-sexp arg nil) + (scan-error (user-error (if (> arg 0) + "No next sexp" + "No previous sexp")))) + (or arg (setq arg 1)) + (if forward-sexp-function + (funcall forward-sexp-function arg) + (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) + (if (< arg 0) (backward-prefix-chars))))) + +(defun backward-sexp (&optional arg interactive) "Move backward across one balanced expression (sexp). With ARG, do it that many times. Negative arg -N means move forward across N balanced expressions. This command assumes point is not in a string or comment. -Uses `forward-sexp' to do the work." - (interactive "^p") +Uses `forward-sexp' to do the work. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") (or arg (setq arg 1)) - (forward-sexp (- arg))) + (forward-sexp (- arg) interactive)) (defun mark-sexp (&optional arg allow-extend) "Set mark ARG sexps from point. @@ -99,50 +108,78 @@ This command assumes point is not in a string or comment." (set-mark (save-excursion (goto-char (mark)) - (forward-sexp arg) + (condition-case error + (forward-sexp arg) + (scan-error + (user-error (if (equal (cadr error) + "Containing expression ends prematurely") + "No more sexp to select" + (cadr error))))) (point)))) (t (push-mark (save-excursion - (forward-sexp (prefix-numeric-value arg)) + (condition-case error + (forward-sexp (prefix-numeric-value arg)) + (scan-error + (user-error (if (equal (cadr error) + "Containing expression ends prematurely") + "No sexp to select" + (cadr error))))) (point)) nil t)))) -(defun forward-list (&optional arg) +(defun forward-list (&optional arg interactive) "Move forward across one balanced group of parentheses. This command will also work on other parentheses-like expressions defined by the current language mode. With ARG, do it that many times. Negative arg -N means move backward across N groups of parentheses. -This command assumes point is not in a string or comment." - (interactive "^p") - (or arg (setq arg 1)) - (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) - -(defun backward-list (&optional arg) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") + (if interactive + (condition-case _ + (forward-list arg nil) + (scan-error (user-error (if (> arg 0) + "No next group" + "No previous group")))) + (or arg (setq arg 1)) + (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))) + +(defun backward-list (&optional arg interactive) "Move backward across one balanced group of parentheses. This command will also work on other parentheses-like expressions defined by the current language mode. With ARG, do it that many times. Negative arg -N means move forward across N groups of parentheses. -This command assumes point is not in a string or comment." - (interactive "^p") +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") (or arg (setq arg 1)) - (forward-list (- arg))) + (forward-list (- arg) interactive)) -(defun down-list (&optional arg) +(defun down-list (&optional arg interactive) "Move forward down one level of parentheses. This command will also work on other parentheses-like expressions defined by the current language mode. With ARG, do this that many times. A negative argument means move backward but still go down a level. -This command assumes point is not in a string or comment." - (interactive "^p") - (or arg (setq arg 1)) - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) - (setq arg (- arg inc))))) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") + (if interactive + (condition-case _ + (down-list arg nil) + (scan-error (user-error "At bottom level"))) + (or arg (setq arg 1)) + (let ((inc (if (> arg 0) 1 -1))) + (while (/= arg 0) + (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) + (setq arg (- arg inc)))))) (defun backward-up-list (&optional arg escape-strings no-syntax-crossing) "Move backward out of one level of parentheses. @@ -229,26 +266,39 @@ point is unspecified." (or (< inc 0) (forward-comment 1)) (setf arg (+ arg inc))) - (signal (car err) (cdr err)))))) + (if no-syntax-crossing + ;; Assume called interactively; don't signal an error. + (user-error "At top level") + (signal (car err) (cdr err))))))) (setq arg (- arg inc))))) -(defun kill-sexp (&optional arg) +(defun kill-sexp (&optional arg interactive) "Kill the sexp (balanced expression) following point. With ARG, kill that many sexps after point. Negative arg -N means kill N sexps before point. -This command assumes point is not in a string or comment." - (interactive "p") - (let ((opoint (point))) - (forward-sexp (or arg 1)) - (kill-region opoint (point)))) - -(defun backward-kill-sexp (&optional arg) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "p\nd") + (if interactive + (condition-case _ + (kill-sexp arg nil) + (scan-error (user-error (if (> arg 0) + "No next sexp" + "No previous sexp")))) + (let ((opoint (point))) + (forward-sexp (or arg 1)) + (kill-region opoint (point))))) + +(defun backward-kill-sexp (&optional arg interactive) "Kill the sexp (balanced expression) preceding point. With ARG, kill that many sexps before point. Negative arg -N means kill N sexps after point. -This command assumes point is not in a string or comment." - (interactive "p") - (kill-sexp (- (or arg 1)))) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "p\nd") + (kill-sexp (- (or arg 1)) interactive)) ;; After Zmacs: (defun kill-backward-up-list (&optional arg) @@ -735,12 +785,37 @@ This command assumes point is not in a string or comment." (insert-pair arg ?\( ?\))) (defun delete-pair (&optional arg) - "Delete a pair of characters enclosing ARG sexps following point. -A negative ARG deletes a pair of characters around preceding ARG sexps." - (interactive "p") - (unless arg (setq arg 1)) - (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1))) - (delete-char (if (> arg 0) 1 -1))) + "Delete a pair of characters enclosing ARG sexps that follow point. +A negative ARG deletes a pair around the preceding ARG sexps instead." + (interactive "P") + (if arg + (setq arg (prefix-numeric-value arg)) + (setq arg 1)) + (if (< arg 0) + (save-excursion + (skip-chars-backward " \t") + (save-excursion + (let ((close-char (char-before))) + (forward-sexp arg) + (unless (member (list (char-after) close-char) + (mapcar (lambda (p) + (if (= (length p) 3) (cdr p) p)) + insert-pair-alist)) + (error "Not after matching pair")) + (delete-char 1))) + (delete-char -1)) + (save-excursion + (skip-chars-forward " \t") + (save-excursion + (let ((open-char (char-after))) + (forward-sexp arg) + (unless (member (list open-char (char-before)) + (mapcar (lambda (p) + (if (= (length p) 3) (cdr p) p)) + insert-pair-alist)) + (error "Not before matching pair")) + (delete-char -1))) + (delete-char 1)))) (defun raise-sexp (&optional arg) "Raise ARG sexps higher up the tree." diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 031b85710db..a87f2e0f25a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1014,7 +1014,6 @@ untar into a directory named DIR; otherwise, signal an error." (write-region (autoload-rubric file "package" nil) nil file nil 'silent)) file) -(defvar generated-autoload-file) (defvar autoload-timestamps) (defvar version-control) @@ -1022,14 +1021,14 @@ untar into a directory named DIR; otherwise, signal an error." "Generate autoloads in PKG-DIR for package named NAME." (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) - (generated-autoload-file (expand-file-name auto-name pkg-dir)) + (output-file (expand-file-name auto-name pkg-dir)) ;; We don't need 'em, and this makes the output reproducible. (autoload-timestamps nil) (backup-inhibited t) (version-control 'never)) - (package-autoload-ensure-default-file generated-autoload-file) - (update-directory-autoloads pkg-dir) - (let ((buf (find-buffer-visiting generated-autoload-file))) + (package-autoload-ensure-default-file output-file) + (make-directory-autoloads pkg-dir output-file) + (let ((buf (find-buffer-visiting output-file))) (when buf (kill-buffer buf))) auto-name)) @@ -2154,6 +2153,7 @@ Downloads and installs required packages as needed." (unless (package--user-selected-p name) (package--save-selected-packages (cons name package-selected-packages))) + (package--quickstart-maybe-refresh) pkg-desc)) ;;;###autoload @@ -2632,8 +2632,7 @@ Used for the `action' property of buttons in the buffer created by (when (y-or-n-p (format-message "Install package `%s'? " (package-desc-full-name pkg-desc))) (package-install pkg-desc nil) - (revert-buffer nil t) - (goto-char (point-min))))) + (describe-package (package-desc-name pkg-desc))))) (defun package-delete-button-action (button) "Run `package-delete' on the package BUTTON points to. @@ -2643,8 +2642,7 @@ Used for the `action' property of buttons in the buffer created by (when (y-or-n-p (format-message "Delete package `%s'? " (package-desc-full-name pkg-desc))) (package-delete pkg-desc) - (revert-buffer nil t) - (goto-char (point-min))))) + (describe-package (package-desc-name pkg-desc))))) (defun package-keyword-button-action (button) "Show filtered \"*Packages*\" buffer for BUTTON. @@ -2711,6 +2709,7 @@ either a full name or nil, and EMAIL is a valid email address." (define-key map (kbd "/ s") 'package-menu-filter-by-status) (define-key map (kbd "/ v") 'package-menu-filter-by-version) (define-key map (kbd "/ m") 'package-menu-filter-marked) + (define-key map (kbd "/ u") 'package-menu-filter-upgradable) map) "Local keymap for `package-menu-mode' buffers.") @@ -3614,7 +3613,7 @@ This is used for `tabulated-list-format' in `package-menu-mode'." (string< a b)))) (defun package-menu--populate-new-package-list () - "Decide which packages are new in `package-archives-contents'. + "Decide which packages are new in `package-archive-contents'. Store this list in `package-menu--new-package-list'." ;; Find which packages are new. (when package-menu--old-archive-contents @@ -3907,6 +3906,15 @@ Unlike other filters, this leaves the marks intact." (tabulated-list-put-tag (char-to-string mark) t))) (user-error "No packages found"))))) +(defun package-menu-filter-upgradable () + "Filter \"*Packages*\" buffer to show only upgradable packages." + (interactive) + (let ((pkgs (mapcar #'car (package-menu--find-upgrades)))) + (package-menu--filter-by + (lambda (pkg) + (memql (package-desc-name pkg) pkgs)) + "upgradable"))) + (defun package-menu-clear-filter () "Clear any filter currently applied to the \"*Packages*\" buffer." (interactive) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index a8ce23284c4..e603900b095 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2010-2020 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> -;; Keywords: +;; Keywords: extensions ;; This file is part of GNU Emacs. @@ -594,7 +594,7 @@ MATCH is the pattern that needs to be matched, of the form: ((null (cdr else-alts)) (car else-alts)) (t (cons (car match) (nreverse else-alts))))))) ((memq match '(:pcase--succeed :pcase--fail)) (cons match match)) - (t (error "Uknown MATCH %s" match)))) + (t (error "Unknown MATCH %s" match)))) (defun pcase--split-rest (sym splitter rest) (let ((then-rest '()) @@ -725,7 +725,7 @@ MATCH is the pattern that needs to be matched, of the form: (pcase--app-subst-match match sym fun nsym)) (cdr match)))) ((memq match '(:pcase--succeed :pcase--fail)) match) - (t (error "Uknown MATCH %s" match)))) + (t (error "Unknown MATCH %s" match)))) (defun pcase--app-subst-rest (rest sym fun nsym) (mapcar (lambda (branch) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 3df7b0e368e..eb2ee94be3b 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -164,8 +164,11 @@ With argument, pretty-print output into current buffer. Ignores leading comment characters." (interactive "P") (if arg - (insert (pp-to-string (eval (pp-last-sexp) lexical-binding))) - (pp-eval-expression (pp-last-sexp)))) + (insert (pp-to-string (eval (elisp--eval-defun-1 + (macroexpand (pp-last-sexp))) + lexical-binding))) + (pp-eval-expression (elisp--eval-defun-1 + (macroexpand (pp-last-sexp)))))) ;;;###autoload (defun pp-macroexpand-last-sexp (arg) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 0672f607523..78ae3a8c1e5 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -96,7 +96,7 @@ ;; out. ;; Q: But how can I then make out the sub-expressions? -;; A: Thats where the `sub-expression mode' comes in. In it only the +;; A: That's where the `sub-expression mode' comes in. In it only the ;; digit keys are assigned to perform an update that will flash the ;; corresponding subexp only. @@ -301,7 +301,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") "Keymap used by the RE Builder for the subexpression mode.") (defun reb-mode-common () - "Setup functions common to functions `reb-mode' and `reb-mode-lisp'." + "Setup functions common to functions `reb-mode' and `reb-lisp-mode'." (setq reb-mode-string "" reb-valid-string "" @@ -513,7 +513,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (reb-update-overlays subexp)) (defun reb-auto-update (_beg _end _lenold &optional force) - "Called from `after-update-functions' to update the display. + "Called from `after-change-functions' to update the display. BEG, END and LENOLD are passed in from the hook. An actual update is only done if the regexp has changed or if the optional fourth argument FORCE is non-nil." diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el index 61af5e51bda..11b28b72cf3 100644 --- a/lisp/emacs-lisp/regi.el +++ b/lisp/emacs-lisp/regi.el @@ -4,7 +4,7 @@ ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com> ;; Created: 24-Feb-1993 -;; Version: 1.8 +;; Old-Version: 1.8 ;; Last Modified: 1993/06/01 21:33:00 ;; Keywords: extensions, matching diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index d60f974aee1..4656277ea16 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -336,9 +336,11 @@ list." "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE. Return the result of calling FUNCTION with INITIAL-VALUE and the -first element of SEQUENCE, then calling FUNCTION with that result and -the second element of SEQUENCE, then with that result and the third -element of SEQUENCE, etc. +first element of SEQUENCE, then calling FUNCTION with that result +and the second element of SEQUENCE, then with that result and the +third element of SEQUENCE, etc. FUNCTION will be called with +INITIAL-VALUE (and then the accumulated value) as the first +argument, and the elements from SEQUENCE as the second argument. If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." (if (seq-empty-p sequence) @@ -472,6 +474,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-reverse sequence1) '())) +;;;###autoload (cl-defgeneric seq-group-by (function sequence) "Apply FUNCTION to each element of SEQUENCE. Separate the elements of SEQUENCE into an alist using the results as diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el new file mode 100644 index 00000000000..dd9cbd5d55a --- /dev/null +++ b/lisp/emacs-lisp/shortdoc.el @@ -0,0 +1,1254 @@ +;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Keywords: lisp, help +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'seq) +(require 'text-property-search) +(eval-when-compile (require 'cl-lib)) + +(defgroup shortdoc nil + "Short documentation." + :group 'lisp) + +(defface shortdoc-separator + '((((class color) (background dark)) + :height 0.1 :background "#505050" :extend t) + (((class color) (background light)) + :height 0.1 :background "#a0a0a0" :extend t) + (t :height 0.1 :inverse-video t :extend t)) + "Face used to separate sections.") + +(defface shortdoc-section + '((t :inherit variable-pitch)) + "Face used for a section.") + +(defvar shortdoc--groups nil) + +(defmacro define-short-documentation-group (group &rest functions) + "Add GROUP to the list of defined documentation groups. +FUNCTIONS is a list of elements on the form: + + (fun + :no-manual BOOL + :args ARGS + :eval EXAMPLE-FORM + :no-eval EXAMPLE-FORM + :no-value EXAMPLE-FORM + :result RESULT-FORM + :eg-result RESULT-FORM + :eg-result-string RESULT-FORM) + +BOOL should be non-nil if the function isn't documented in the +manual. + +ARGS is optional; the function's signature is displayed if ARGS +is not present. + +If EVAL isn't a string, it will be printed with `prin1', and then +evaluated to give a result, which is also printed. If it's a +string, it'll be inserted as is, then the string will be `read', +and then evaluated. + +There can be any number of :example/:result elements." + `(progn + (setq shortdoc--groups (delq (assq ',group shortdoc--groups) + shortdoc--groups)) + (push (cons ',group ',functions) shortdoc--groups))) + +(define-short-documentation-group alist + "Alist Basics" + (assoc + :eval (assoc 'foo '((foo . bar) (zot . baz)))) + (rassoc + :eval (rassoc 'bar '((foo . bar) (zot . baz)))) + (assq + :eval (assq 'foo '((foo . bar) (zot . baz)))) + (rassq + :eval (rassq 'bar '((foo . bar) (zot . baz)))) + (assoc-string + :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) + "Manipulating Alists" + (assoc-delete-all + :eval (assoc-delete-all "foo" '(("foo" . "bar") ("zot" . "baz")) #'equal)) + (assq-delete-all + :eval (assq-delete-all 'foo '((foo . bar) (zot . baz)))) + (rassq-delete-all + :eval (rassq-delete-all 'bar '((foo . bar) (zot . baz)))) + (alist-get + :eval (let ((foo '((bar . baz)))) + (setf (alist-get 'bar foo) 'zot) + foo)) + "Misc" + (assoc-default + :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) + (copy-alist + :eval (let* ((old '((foo . bar))) + (new (copy-alist old))) + (eq old new))) + ;; FIXME: Outputs "\.rose" for the symbol `.rose'. + ;; (let-alist + ;; :eval (let ((colors '((rose . red) + ;; (lily . white)))) + ;; (let-alist colors + ;; (if (eq .rose 'red) + ;; .lily)))) + ) + +(define-short-documentation-group string + "Making Strings" + (make-string + :args (length init) + :eval "(make-string 5 ?x)") + (string + :eval "(string ?a ?b ?c)") + (concat + :eval (concat "foo" "bar" "zot")) + (string-join + :no-manual t + :eval (string-join '("foo" "bar" "zot") " ")) + (mapconcat + :eval (mapconcat (lambda (a) (concat "[" a "]")) + '("foo" "bar" "zot") " ")) + (mapcar + :eval (mapcar #'identity "123")) + (format + :eval (format "This number is %d" 4)) + "Manipulating Strings" + (substring + :eval (substring "foobar" 0 3) + :eval (substring "foobar" 3)) + (split-string + :eval (split-string "foo bar") + :eval (split-string "|foo|bar|" "|") + :eval (split-string "|foo|bar|" "|" t)) + (string-replace + :eval (string-replace "foo" "bar" "foozot")) + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-trim + :no-manual t + :args (string) + :doc "Trim STRING of leading and trailing white space." + :eval (string-trim " foo ")) + (string-trim-left + :no-manual t + :eval (string-trim-left "oofoo" "o+")) + (string-trim-right + :no-manual t + :eval (string-trim-right "barkss" "s+")) + (string-truncate-left + :no-manual t + :eval (string-truncate-left "longstring" 8)) + (string-remove-suffix + :no-manual t + :eval (string-remove-suffix "bar" "foobar")) + (string-remove-prefix + :no-manual t + :eval (string-remove-prefix "foo" "foobar")) + (reverse + :eval (reverse "foo")) + (substring-no-properties + :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) + "Predicates for Strings" + (string-equal + :eval (string-equal "foo" "foo")) + (eq + :eval (eq "foo" "foo")) + (eql + :eval (eql "foo" "foo")) + (equal + :eval (equal "foo" "foo")) + (cl-equalp + :eval (cl-equalp "Foo" "foo")) + (stringp + :eval "(stringp ?a)") + (string-empty-p + :no-manual t + :eval (string-empty-p "")) + (string-blank-p + :no-manual t + :eval (string-blank-p " \n")) + (string-lessp + :eval (string-lessp "foo" "bar")) + (string-greaterp + :eval (string-greaterp "foo" "bar")) + (string-version-lessp + :eval (string-lessp "foo32.png" "bar4.png")) + (string-prefix-p + :eval (string-prefix-p "foo" "foobar")) + (string-suffix-p + :eval (string-suffix-p "bar" "foobar")) + "Case Manipulation" + (upcase + :eval (upcase "foo")) + (downcase + :eval (downcase "FOObar")) + (capitalize + :eval (capitalize "foo bar zot")) + (upcase-initials + :eval (upcase-initials "The CAT in the hAt")) + "Converting Strings" + (string-to-number + :eval (string-to-number "42") + :eval (string-to-number "deadbeef" 16)) + (number-to-string + :eval (number-to-string 42)) + "Data About Strings" + (length + :eval (length "foo")) + (string-search + :eval (string-search "bar" "foobarzot")) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (seq-position + :eval "(seq-position \"foobarzot\" ?z)")) + +(define-short-documentation-group file-name + "File Name Manipulation" + (file-name-directory + :eval (file-name-directory "/tmp/foo") + :eval (file-name-directory "/tmp/foo/")) + (file-name-nondirectory + :eval (file-name-nondirectory "/tmp/foo") + :eval (file-name-nondirectory "/tmp/foo/")) + (file-name-sans-versions + :args (filename) + :eval (file-name-sans-versions "/tmp/foo~")) + (file-name-extension + :eval (file-name-extension "/tmp/foo.txt")) + (file-name-sans-extension + :eval (file-name-sans-extension "/tmp/foo.txt")) + (file-name-base + :eval (file-name-base "/tmp/foo.txt")) + (file-relative-name + :eval (file-relative-name "/tmp/foo" "/tmp")) + (make-temp-name + :eval (make-temp-name "/tmp/foo-")) + (expand-file-name + :eval (expand-file-name "foo" "/tmp/")) + (substitute-in-file-name + :eval (substitute-in-file-name "$HOME/foo")) + "Directory Functions" + (file-name-as-directory + :eval (file-name-as-directory "/tmp/foo")) + (directory-file-name + :eval (directory-file-name "/tmp/foo/")) + (abbreviate-file-name + :no-eval (abbreviate-file-name "/home/some-user") + :eg-result "~some-user") + "Quoted File Names" + (file-name-quote + :args (name) + :eval (file-name-quote "/tmp/foo")) + (file-name-unquote + :args (name) + :eval (file-name-unquote "/:/tmp/foo")) + "Predicates" + (file-name-absolute-p + :eval (file-name-absolute-p "/tmp/foo") + :eval (file-name-absolute-p "foo")) + (directory-name-p + :eval (directory-name-p "/tmp/foo/")) + (file-name-quoted-p + :eval (file-name-quoted-p "/:/tmp/foo"))) + +(define-short-documentation-group file + "Inserting Contents" + (insert-file-contents + :no-eval (insert-file-contents "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (insert-file-contents-literally + :no-eval (insert-file-contents-literally "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (find-file + :no-eval (find-file "/tmp/foo") + :eg-result-string "#<buffer foo>") + "Predicates" + (file-symlink-p + :no-eval (file-symlink-p "/tmp/foo") + :eg-result t) + (file-directory-p + :no-eval (file-directory-p "/tmp") + :eg-result t) + (file-regular-p + :no-eval (file-regular-p "/tmp/foo") + :eg-result t) + (file-exists-p + :no-eval (file-exists-p "/tmp/foo") + :eg-result t) + (file-readable-p + :no-eval (file-readable-p "/tmp/foo") + :eg-result t) + (file-writeable-p + :no-eval (file-writeable-p "/tmp/foo") + :eg-result t) + (file-accessible-directory-p + :no-eval (file-accessible-directory-p "/tmp") + :eg-result t) + (file-executable-p + :no-eval (file-executable-p "/bin/cat") + :eg-result t) + (file-newer-than-file-p + :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") + :eg-result nil) + (file-equal-p + :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") + :eg-result nil) + (file-in-directory-p + :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") + :eg-result t) + (file-locked-p + :no-eval (file-locked-p "/tmp/foo") + :eg-result nil) + "Information" + (file-attributes + :no-eval* (file-attributes "/tmp")) + (file-truename + :no-eval (file-truename "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (file-chase-links + :no-eval (file-chase-links "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (vc-responsible-backend + :args (file &optional no-error) + :no-eval (vc-responsible-backend "/src/foo/bar.c") + :eg-result Git) + (file-acl + :no-eval (file-acl "/tmp/foo") + :eg-result "user::rw-\ngroup::r--\nother::r--\n") + (file-extended-attributes + :no-eval* (file-extended-attributes "/tmp/foo")) + (file-selinux-context + :no-eval* (file-selinux-context "/tmp/foo")) + (locate-file + :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) + :eg-result "/var/log/syslog") + (executable-find + :no-eval (executable-find "ls") + :eg-result "/usr/bin/ls") + "Creating" + (make-temp-file + :no-eval (make-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-ZcXFMj") + (make-nearby-temp-file + :no-eval (make-nearby-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-xe8iON") + (write-region + :no-value (write-region (point-min) (point-max) "/tmp/foo")) + "Directories" + (make-directory + :no-value (make-directory "/tmp/bar/zot/" t)) + (directory-files + :no-eval (directory-files "/tmp/") + :eg-result ("." ".." ".ICE-unix" ".Test-unix")) + (directory-files-recursively + :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") + :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) + (directory-files-and-attributes + :no-eval* (directory-files-and-attributes "/tmp/foo")) + (file-expand-wildcards + :no-eval (file-expand-wildcards "/tmp/*.png") + :eg-result ("/tmp/foo.png" "/tmp/zot.png")) + (locate-dominating-file + :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot") + :eg-result "/tmp/foo.png") + (copy-directory + :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) + (delete-directory + :no-value (delete-directory "/tmp/bar/")) + "File Operations" + (rename-file + :no-value (rename-file "/tmp/foo" "/tmp/newname")) + (copy-file + :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) + (delete-file + :no-value (delete-file "/tmp/foo")) + (make-empty-file + :no-value (make-empty-file "/tmp/foo")) + (make-symbolic-link + :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) + (add-name-to-file + :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) + (set-file-modes + :no-value "(set-file-modes \"/tmp/foo\" #o644)") + (set-file-times + :no-value (set-file-times "/tmp/foo" (current-time))) + "File Modes" + (set-default-file-modes + :no-value "(set-default-file-modes #o755)") + (default-file-modes + :no-eval (default-file-modes) + :eg-result-string "#o755") + (file-modes-symbolic-to-number + :no-eval (file-modes-symbolic-to-number "a+r") + :eg-result-string "#o444") + (file-modes-number-to-symbolic + :eval "(file-modes-number-to-symbolic #o444)") + (set-file-extended-attributes + :no-eval (set-file-extended-attributes + "/tmp/foo" '((acl . "group::rxx"))) + :eg-result t) + (set-file-selinux-context + :no-eval (set-file-selinux-context + "/tmp/foo" '(unconfined_u object_r user_home_t s0)) + :eg-result t) + (set-file-acl + :no-eval (set-file-acl "/tmp/foo" "group::rxx") + :eg-result t)) + +(define-short-documentation-group hash-table + "Hash Table Basics" + (make-hash-table + :no-eval (make-hash-table) + :result-string "#s(hash-table ...)") + (puthash + :no-eval (puthash 'key "value" table)) + (gethash + :no-eval (gethash 'key table) + :eg-result "value") + (remhash + :no-eval (remhash 'key table) + :result nil) + (clrhash + :no-eval (clrhash table) + :result-string "#s(hash-table ...)") + (maphash + :no-eval (maphash (lambda (key value) (message value)) table) + :result nil) + "Other Hash Table Functions" + (hash-table-p + :eval (hash-table-p 123)) + (copy-hash-table + :no-eval (copy-hash-table table) + :result-string "#s(hash-table ...)") + (hash-table-count + :no-eval (hash-table-count table) + :eg-result 15) + (hash-table-size + :no-eval (hash-table-size table) + :eg-result 65)) + +(define-short-documentation-group list + "Making Lists" + (make-list + :eval (make-list 5 'a)) + (cons + :eval (cons 1 '(2 3 4))) + (list + :eval (list 1 2 3)) + (number-sequence + :eval (number-sequence 5 8)) + "Operations on Lists" + (append + :eval (append '("foo" "bar") '("zot"))) + (copy-tree + :eval (copy-tree '(1 (2 3) 4))) + (flatten-tree + :eval (flatten-tree '(1 (2 3) 4))) + (car + :eval (car '(one two three))) + (cdr + :eval (cdr '(one two three))) + (last + :eval (last '(one two three))) + (butlast + :eval (butlast '(one two three))) + (nbutlast + :eval (nbutlast (list 'one 'two 'three))) + (nth + :eval (nth 1 '(one two three))) + (nthcdr + :eval (nthcdr 1 '(one two three))) + (elt + :eval (elt '(one two three) 1)) + (car-safe + :eval (car-safe '(one two three))) + (cdr-safe + :eval (cdr-safe '(one two three))) + (push + :no-eval* (push 'a list)) + (pop + :no-eval* (pop list)) + (setcar + :no-eval (setcar list 'c) + :result c) + (setcdr + :no-eval (setcdr list (list c)) + :result '(c)) + (nconc + :eval (nconc (list 1) (list 2 3 4))) + (delq + :eval (delq 2 (list 1 2 3 4)) + :eval (delq "a" (list "a" "b" "c" "d"))) + (delete + :eval (delete 2 (list 1 2 3 4)) + :eval (delete "a" (list "a" "b" "c" "d"))) + (remove + :eval (remove 2 '(1 2 3 4)) + :eval (remove "a" '("a" "b" "c" "d"))) + (delete-dups + :eval (delete-dups (list 1 2 4 3 2 4))) + "Mapping Over Lists" + (mapcar + :eval (mapcar #'list '(1 2 3))) + (mapcan + :eval (mapcan #'list '(1 2 3))) + (mapc + :eval (mapc #'insert '("1" "2" "3"))) + (reduce + :eval (reduce #'+ '(1 2 3))) + (mapconcat + :eval (mapconcat #'identity '("foo" "bar") "|")) + "Predicates" + (listp + :eval (listp '(1 2 3)) + :eval (listp nil) + :eval (listp '(1 . 2))) + (consp + :eval (consp '(1 2 3)) + :eval (consp nil)) + (proper-list-p + :eval (proper-list-p '(1 2 3)) + :eval (proper-list-p nil) + :eval (proper-list-p '(1 . 2))) + (null + :eval (null nil)) + (atom + :eval (atom 'a)) + (nlistp + :eval (nlistp '(1 2 3)) + :eval (nlistp t) + :eval (nlistp '(1 . 2))) + "Finding Elements" + (memq + :eval (memq 2 '(1 2 3)) + :eval (memq 2.0 '(1.0 2.0 3.0)) + :eval (memq "b" '("a" "b" "c"))) + (member + :eval (member 2 '(1 2 3)) + :eval (member "b" '("a" "b" "c"))) + (remq + :eval (remq 2 '(1 2 3 2 4 2)) + :eval (remq "b" '("a" "b" "c"))) + (memql + :eval (memql 2.0 '(1.0 2.0 3.0))) + (member-ignore-case + :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) + "Association Lists" + (assoc + :eval (assoc 'b '((a 1) (b 2)))) + (rassoc + :eval (rassoc '2 '((a . 1) (b . 2)))) + (assq + :eval (assq 'b '((a 1) (b 2))) + :eval (assq "a" '(("a" 1) ("b" 2)))) + (rassq + :eval (rassq '2 '((a . 1) (b . 2)))) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (alist-get + :eval (alist-get 2 '((1 . a) (2 . b)))) + (assoc-default + :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) + (copy-alist + :eval (copy-alist '((1 . a) (2 . b)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + "Property Lists" + (plist-get + :eval (plist-get '(a 1 b 2 c 3) 'b)) + (plist-put + :no-eval (setq plist (plist-put plist 'd 4)) + :eq-result (a 1 b 2 c 3 d 4)) + (lax-plist-get + :eval (lax-plist-get '("a" 1 "b" 2 "c" 3) "b")) + (lax-plist-put + :no-eval (setq plist (plist-put plist "d" 4)) + :eq-result '("a" 1 "b" 2 "c" 3 "d" 4)) + (plist-member + :eval (plist-member '(a 1 b 2 c 3) 'b)) + "Data About Lists" + (length + :eval (length '(a b c))) + (safe-length + :eval (safe-length '(a b c)))) + + +(define-short-documentation-group vector + (make-vector + :eval (make-vector 5 "foo")) + (vector + :eval (vector 1 "b" 3)) + (vectorp + :eval (vectorp [1]) + :eval (vectorp "1")) + (vconcat + :eval (vconcat '(1 2) [3 4])) + (append + :eval (append [1 2] nil)) + (length + :eval (length [1 2 3])) + (mapcar + :eval (mapcar #'identity [1 2 3])) + (reduce + :eval (reduce #'+ [1 2 3])) + (seq-subseq + :eval (seq-subseq [1 2 3 4 5] 1 3) + :eval (seq-subseq [1 2 3 4 5] 1))) + +(define-short-documentation-group regexp + "Matching Strings" + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-match-p + :eval (string-match-p "^[fo]+" "foobar")) + "Looking in Buffers" + (re-search-forward + :no-eval (re-search-forward "^foo$" nil t) + :eg-result 43) + (re-search-backward + :no-eval (re-search-backward "^foo$" nil t) + :eg-result 43) + (looking-at-p + :no-eval (looking-at "f[0-9]") + :eg-result t) + "Match Data" + (match-string + :eval (and (string-match "^\\([fo]+\\)b" "foobar") + (match-string 0 "foobar"))) + (match-beginning + :no-eval (match-beginning 1) + :eg-result 0) + (match-end + :no-eval (match-end 1) + :eg-result 3) + (save-match-data + :no-eval (save-match-data ...)) + "Replacing Match" + (replace-match + :no-eval (replace-match "new") + :eg-result nil) + (match-substitute-replacement + :no-eval (match-substitute-replacement "new") + :eg-result "new") + "Utilities" + (regexp-quote + :eval (regexp-quote "foo.*bar")) + (regexp-opt + :eval (regexp-opt '("foo" "bar"))) + (regexp-opt-depth + :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) + (regexp-opt-charset + :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) + "The `rx' Structured Regexp Notation" + (rx + :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) + (rx-to-string + :eval (rx-to-string '(| "foo" "bar"))) + (rx-define + :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) + (rx haskell-comment))" + :result "--.*") + (rx-let + :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) + (number (1+ digit)) + (numbers (comma-separated number))) + (rx \"(\" numbers \")\"))" + :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") + (rx-let-eval + :eval "(rx-let-eval + '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) + (rx-to-string + '(ponder (or \"flowers\" \"cars\" \"socks\"))))" + :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) + +(define-short-documentation-group sequence + "Sequence Predicates" + (seq-contains-p + :eval (seq-contains '(a b c) 'b) + :eval (seq-contains '(a b c) 'd)) + (seq-every-p + :eval (seq-every-p #'numberp '(1 2 3))) + (seq-empty-p + :eval (seq-empty-p [])) + (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))) + "Building Sequences" + (seq-concatenate + :eval (seq-concatenate 'vector '(1 2) '(c d))) + (seq-copy + :eval (seq-copy '(a 2))) + (seq-into + :eval (seq-into '(1 2 3) 'vector)) + "Utility Functions" + (seq-count + :eval (seq-count #'numberp '(1 b c 4))) + (seq-elt + :eval (seq-elt '(a b c) 1)) + (seq-random-elt + :no-eval (seq-random-elt '(a b c)) + :eg-result c) + (seq-find + :eval (seq-find #'numberp '(a b 3 4 f 6))) + (seq-position + :eval (seq-position '(a b c) 'c)) + (seq-length + :eval (seq-length "abcde")) + (seq-max + :eval (seq-max [1 2 3])) + (seq-min + :eval (seq-min [1 2 3])) + (seq-first + :eval (seq-first [a b c])) + (seq-rest + :eval (seq-rest '[1 2 3])) + (seq-reverse + :eval (seq-reverse '(1 2 3))) + (seq-sort + :eval (seq-sort #'> '(1 2 3))) + (seq-sort-by + :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) + "Mapping Over Sequences" + (seq-map + :eval (seq-map #'1+ '(1 2 3))) + (seq-map-indexed + :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) + (seq-mapcat + :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) + (seq-do + :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) + :eg-result ("foo" "bar")) + (seq-do-indexed + :no-eval (seq-do-indexed + (lambda (a index) (message "%s:%s" index a)) + '("foo" "bar")) + :eg-result nil) + (seq-reduce + :eval (seq-reduce #'* [1 2 3] 2)) + "Excerpting Sequences" + (seq-drop + :eval (seq-drop '(a b c) 2)) + (seq-drop-while + :eval (seq-drop-while #'numberp '(1 2 c d 5))) + (seq-filter + :eval (seq-filter #'numberp '(a b 3 4 f 6))) + (seq-remove + :eval (seq-remove #'numberp '(1 2 c d 5))) + (seq-group-by + :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6))) + (seq-difference + :eval (seq-difference '(1 2 3) '(2 3 4))) + (seq-intersection + :eval (seq-intersection '(1 2 3) '(2 3 4))) + (seq-partition + :eval (seq-partition '(a b c d e f g h) 3)) + (seq-subseq + :eval (seq-subseq '(a b c d e) 2 4)) + (seq-take + :eval (seq-take '(a b c d e) 3)) + (seq-take-while + :eval (seq-take-while #'cl-evenp [2 4 9 6 5])) + (seq-uniq + :eval (seq-uniq '(a b d b a c)))) + +(define-short-documentation-group buffer + "Buffer Basics" + (current-buffer + :no-eval (current-buffer) + :eg-result-string "#<buffer shortdoc.el>") + (bufferp + :eval (bufferp 23)) + (buffer-live-p + :no-eval (buffer-live-p some-buffer) + :eg-result t) + (buffer-modified-p + :eval (buffer-modified-p (current-buffer))) + (buffer-name + :eval (buffer-name)) + (window-buffer + :eval (window-buffer)) + "Selecting Buffers" + (get-buffer-create + :no-eval (get-buffer-create "*foo*") + :eg-result-string "#<buffer *foo*>") + (pop-to-buffer + :no-eval (pop-to-buffer "*foo*") + :eg-result-string "#<buffer *foo*>") + (with-current-buffer + :no-eval* (with-current-buffer buffer (buffer-size))) + "Points and Positions" + (point + :eval (point)) + (point-min + :eval (point-max)) + (point-max + :eval (point-max)) + (line-beginning-position + :eval (line-beginning-position)) + (line-end-position + :eval (line-end-position)) + (buffer-size + :eval (buffer-size)) + "Moving Around" + (goto-char + :no-eval (goto-char (point-max)) + :eg-result 342) + (search-forward + :no-eval (search-forward "some-string" nil t) + :eg-result 245) + (re-search-forward + :no-eval (re-search-forward "some-s.*g" nil t) + :eg-result 245) + (forward-line + :no-eval (forward-line 1) + :eg-result 0 + :no-eval (forward-line -2) + :eg-result 0) + "Strings from Buffers" + (buffer-string + :no-eval* (buffer-string)) + (buffer-substring + :eval (buffer-substring (point-min) (+ (point-min) 10))) + (buffer-substring-no-properties + :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) + (following-char + :no-eval (following-char) + :eg-result 67) + (char-after + :eval (char-after 45)) + "Altering Buffers" + (delete-region + :no-value (delete-region (point-min) (point-max))) + (erase-buffer + :no-value (erase-buffer)) + (insert + :no-value (insert "This string will be inserted in the buffer\n")) + "Locking" + (lock-buffer + :no-value (lock-buffer "/tmp/foo")) + (unlock-buffer + :no-value (lock-buffer))) + +(define-short-documentation-group process + (make-process + :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) + :eg-result-string "#<process foo>") + (processp + :eval (processp t)) + (delete-process + :no-value (delete-process process)) + (kill-process + :no-value (kill-process process)) + (set-process-sentinel + :no-value (set-process-sentinel process (lambda (proc string)))) + (process-buffer + :no-eval (process-buffer process) + :eg-result-string "#<buffer *foo*>") + (get-buffer-process + :no-eval (get-buffer-process buffer) + :eg-result-string "#<process foo>") + (process-live-p + :no-eval (process-live-p process) + :eg-result t)) + +(define-short-documentation-group number + "Arithmetic" + (+ + :args (&rest numbers) + :eval (+ 1 2) + :eval (+ 1 2 3 4)) + (- + :args (&rest numbers) + :eval (- 3 2) + :eval (- 6 3 2)) + (* + :args (&rest numbers) + :eval (* 3 4 5)) + (/ + :eval (/ 10 5) + :eval (/ 10 6) + :eval (/ 10.0 6) + :eval (/ 10.0 3 3)) + (% + :eval (% 10 5) + :eval (% 10 6)) + (mod + :eval (mod 10 5) + :eval (mod 10 6) + :eval (mod 10.5 6)) + (1+ + :eval (1+ 2)) + (1- + :eval (1- 4)) + "Predicates" + (= + :args (number &rest numbers) + :eval (= 4 4) + :eval (= 4.0 4.0) + :eval (= 4 5 6 7)) + (eq + :eval (eq 4 4) + :eval (eq 4.0 4.0)) + (eql + :eval (eql 4 4) + :eval (eql 4 "4") + :eval (eql 4.0 4.0)) + (/= + :eval (/= 4 4)) + (< + :args (number &rest numbers) + :eval (< 4 4) + :eval (< 1 2 3)) + (<= + :args (number &rest numbers) + :eval (<= 4 4) + :eval (<= 1 2 3)) + (> + :args (number &rest numbers) + :eval (> 4 4) + :eval (> 1 2 3)) + (>= + :args (number &rest numbers) + :eval (>= 4 4) + :eval (>= 1 2 3)) + (zerop + :eval (zerop 0)) + (cl-plusp + :eval (cl-plusp 0) + :eval (cl-plusp 1)) + (cl-minusp + :eval (cl-minusp 0) + :eval (cl-minusp -1)) + (cl-oddp + :eval (cl-oddp 3)) + (cl-evenp + :eval (cl-evenp 6)) + (natnump + :eval (natnump -1) + :eval (natnump 23)) + (bignump + :eval (bignump 4) + :eval (bignump (expt 2 90))) + (fixnump + :eval (fixnump 4) + :eval (fixnump (expt 2 90))) + (floatp + :eval (floatp 5.4)) + (integerp + :eval (integerp 5.4)) + (numberp + :eval (numberp "5.4")) + (cl-digit-char-p + :eval (cl-digit-char-p ?5 10) + :eval (cl-digit-char-p ?f 16)) + "Operations" + (max + :args (number &rest numbers) + :eval (max 7 9 3)) + (min + :args (number &rest numbers) + :eval (min 7 9 3)) + (abs + :eval (abs -4)) + (float + :eval (float 2)) + (truncate + :eval (truncate 1.2) + :eval (truncate -1.2) + :eval (truncate 5.4 2)) + (floor + :eval (floor 1.2) + :eval (floor -1.2) + :eval (floor 5.4 2)) + (ceiling + :eval (ceiling 1.2) + :eval (ceiling -1.2) + :eval (ceiling 5.4 2)) + (round + :eval (round 1.2) + :eval (round -1.2) + :eval (round 5.4 2)) + (random + :eval (random 6)) + "Bit Operations" + (ash + :eval (ash 1 4) + :eval (ash 16 -1)) + (lsh + :eval (lsh 1 4) + :eval (lsh 16 -1)) + (logand + :no-eval "(logand #b10 #b111)" + :result-string "#b10") + (logior + :eval (logior 4 16)) + (logxor + :eval (logxor 4 16)) + (lognot + :eval (lognot 5)) + (logcount + :eval (logcount 5)) + "Floating Point" + (isnan + :eval (isnan 5.0)) + (frexp + :eval (frexp 5.7)) + (ldexp + :eval (ldexp 0.7125 3)) + (logb + :eval (logb 10.5)) + (ffloor + :eval (floor 1.2)) + (fceiling + :eval (fceiling 1.2)) + (ftruncate + :eval (ftruncate 1.2)) + (fround + :eval (fround 1.2)) + "Standard Math Functions" + (sin + :eval (sin float-pi)) + (cos + :eval (cos float-pi)) + (tan + :eval (tan float-pi)) + (asin + :eval (asin float-pi)) + (acos + :eval (acos float-pi)) + (atan + :eval (atan float-pi)) + (exp + :eval (exp 4)) + (log + :eval (log 54.59)) + (expt + :eval (expt 2 16)) + (sqrt + :eval (sqrt -1))) + +;;;###autoload +(defun shortdoc-display-group (group) + "Pop to a buffer with short documentation summary for functions in GROUP." + (interactive (list (completing-read "Show summary for functions in: " + (mapcar #'car shortdoc--groups)))) + (when (stringp group) + (setq group (intern group))) + (unless (assq group shortdoc--groups) + (error "No such documentation group %s" group)) + (pop-to-buffer (format "*Shortdoc %s*" group)) + (let ((inhibit-read-only t) + (prev nil)) + (erase-buffer) + (shortdoc-mode) + (button-mode) + (mapc + (lambda (data) + (cond + ((stringp data) + (setq prev nil) + (unless (bobp) + (insert "\n")) + (insert (propertize + (concat (substitute-command-keys data) "\n\n") + 'face '(variable-pitch (:height 1.3 :weight bold)) + 'shortdoc-section t))) + ;; There may be functions not yet defined in the data. + ((fboundp (car data)) + (when prev + (insert (propertize "\n" 'face 'shortdoc-separator))) + (setq prev t) + (shortdoc--display-function data)))) + (cdr (assq group shortdoc--groups)))) + (goto-char (point-min))) + +(defun shortdoc--display-function (data) + (let ((function (pop data)) + (start-section (point)) + arglist-start) + ;; Function calling convention. + (insert (propertize "(" + 'shortdoc-function t)) + (if (plist-get data :no-manual) + (insert (symbol-name function)) + (insert-text-button + (symbol-name function) + 'face 'button + 'action (lambda (_) + (info-lookup-symbol function 'emacs-lisp-mode)))) + (setq arglist-start (point)) + (insert ")\n") + ;; Doc string. + (insert " " + (or (plist-get data :doc) + (car (split-string (documentation function) "\n")))) + (insert "\n") + (add-face-text-property start-section (point) 'shortdoc-section t) + (let ((print-escape-newlines t) + (double-arrow (if (char-displayable-p ?⇒) + "⇒" + "=>")) + (single-arrow (if (char-displayable-p ?→) + "→" + "->"))) + (cl-loop for (type value) on data by #'cddr + do + (cl-case type + (:eval + (if (stringp value) + (insert " " value "\n") + (insert " ") + (prin1 value (current-buffer)) + (insert "\n") + (insert " " double-arrow " ") + (prin1 (eval value) (current-buffer)) + (insert "\n"))) + (:no-eval* + (if (stringp value) + (insert " " value "\n") + (insert " ") + (prin1 value (current-buffer))) + (insert "\n " single-arrow " " + (propertize "[it depends]" + 'face 'variable-pitch) + "\n")) + (:no-value + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:no-eval + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:result + (insert " " double-arrow " ") + (prin1 value (current-buffer)) + (insert "\n")) + (:result-string + (insert " " double-arrow " ") + (princ value (current-buffer)) + (insert "\n")) + (:eg-result + (insert " eg. " double-arrow " ") + (prin1 value (current-buffer)) + (insert "\n")) + (:eg-result-string + (insert " eg. " double-arrow " ") + (princ value (current-buffer)) + (insert "\n"))))) + ;; Insert the arglist after doing the evals, in case that's pulled + ;; in the function definition. + (save-excursion + (goto-char arglist-start) + (dolist (param (or (plist-get data :args) + (help-function-arglist function t))) + (insert " " (symbol-name param))) + (add-face-text-property arglist-start (point) 'shortdoc-section t)))) + +(defun shortdoc-function-groups (function) + "Return all shortdoc groups FUNCTION appears in." + (cl-loop for group in shortdoc--groups + when (assq function (cdr group)) + collect (car group))) + +(defun shortdoc-add-function (group section elem) + "Add ELEM to shortdoc GROUP in SECTION. +If GROUP doesn't exist, it will be created. +If SECTION doesn't exist, it will be added. + +Example: + + (shortdoc-add-function + 'file \"Predicates\" + '(file-locked-p :no-eval (file-locked-p \"/tmp\")))" + (let ((glist (assq group shortdoc--groups))) + (unless glist + (setq glist (list group)) + (setq shortdoc--groups (append shortdoc--groups (list glist)))) + (let ((slist (member section glist))) + (unless slist + (setq slist (list section)) + (setq slist (append glist slist))) + (while (and (cdr slist) + (not (stringp (cadr slist)))) + (setq slist (cdr slist))) + (setcdr slist (cons elem (cdr slist)))))) + +(defvar shortdoc-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "n") 'shortdoc-next) + (define-key map (kbd "p") 'shortdoc-previous) + (define-key map (kbd "C-c C-n") 'shortdoc-next-section) + (define-key map (kbd "C-c C-p") 'shortdoc-previous-section) + map) + "Keymap for `shortdoc-mode'") + +(define-derived-mode shortdoc-mode special-mode "shortdoc" + "Mode for shortdoc.") + +(defmacro shortdoc--goto-section (arg sym &optional reverse) + `(progn + (unless (natnump ,arg) + (setq ,arg 1)) + (while (< 0 ,arg) + (,(if reverse + 'text-property-search-backward + 'text-property-search-forward) + ,sym t) + (setq ,arg (1- ,arg))))) + +(defun shortdoc-next (&optional arg) + "Move cursor to next function." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-function)) + +(defun shortdoc-previous (&optional arg) + "Move cursor to previous function." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-function t) + (backward-char 1)) + +(defun shortdoc-next-section (&optional arg) + "Move cursor to next section." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-section)) + +(defun shortdoc-previous-section (&optional arg) + "Move cursor to previous section." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-section t) + (forward-line -2)) + +(provide 'shortdoc) + +;;; shortdoc.el ends here diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 9f96ac50d1c..e6abb39ddc6 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -156,6 +156,7 @@ are non-nil, then the result is non-nil." ,@(or body `(,res)))) `(let* () ,@(or body '(t)))))) +;;;###autoload (defmacro if-let (spec then &rest else) "Bind variables according to SPEC and evaluate THEN or ELSE. Evaluate each binding in turn, as in `let*', stopping if a diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index ce495af95bc..62f1b16d75c 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -65,8 +65,13 @@ cannot be handled just by the buffer's syntax-table. The specified function may call `syntax-ppss' on any position before END, but if it calls `syntax-ppss' on some position and later modifies the buffer on some earlier position, -then it is its responsability to call `syntax-ppss-flush-cache' to flush -the now obsolete ppss info from the cache.") +then it is its responsibility to call `syntax-ppss-flush-cache' to flush +the now obsolete ppss info from the cache. + +Note: When this variable is a function, it must apply _all_ the +`syntax-table' properties needed in the given text interval. +Using both this function and other means to apply these +properties won't work properly.") (defvar syntax-propertize-chunk-size 500) diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 61bd98d3cfe..d7dc7da7c18 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -34,11 +34,11 @@ "Search for the next region of text whose PROPERTY matches VALUE. If not found, return nil and don't move point. -If found, move point to end of the region and return a `prop-match' -object describing the match. To access the details of the match, -use `prop-match-beginning' and `prop-match-end' for the buffer -positions that limit the region, and `prop-match-value' for the -value of PROPERTY in the region. +If found, move point to the start of the region and return a +`prop-match' object describing the match. To access the details +of the match, use `prop-match-beginning' and `prop-match-end' for +the buffer positions that limit the region, and +`prop-match-value' for the value of PROPERTY in the region. PREDICATE is used to decide whether a value of PROPERTY should be considered as matching VALUE. @@ -125,7 +125,7 @@ that matches VALUE." "Search for the previous region of text whose PROPERTY matches VALUE. Like `text-property-search-forward', which see, but searches backward, -and if a matching region is found, moves point to its beginning." +and if a matching region is found, place point at its end." (interactive (list (let ((string (completing-read "Search for property: " obarray))) diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 00d09696d2a..4bda9acebf7 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -49,23 +49,25 @@ (let ((time (list (aref timer 1) (aref timer 2) (aref timer 3)))) - (format "%10.2f" - (float-time - (if (aref timer 7) - time - (time-subtract time nil))))) - 'help-echo "Time in sec till next invocation") + (format "%12s" + (format-seconds "%dd %hh %mm %z%,1ss" + (float-time + (if (aref timer 7) + time + (time-subtract time nil)))))) + 'help-echo "Time until next invocation") ;; Repeat. - ,(propertize - (let ((repeat (aref timer 4))) - (cond - ((numberp repeat) - (format "%8.1f" repeat)) - ((null repeat) - " -") - (t - (format "%8s" repeat)))) - 'help-echo "Symbol: repeat; number: repeat interval in sec") + ,(let ((repeat (aref timer 4))) + (cond + ((numberp repeat) + (propertize + (format "%12s" (format-seconds + "%dd %hh %mm %z%,1ss" repeat)) + 'help-echo "Repeat interval")) + ((null repeat) + (propertize " -" 'help-echo "Runs once")) + (t + (format "%12s" repeat)))) ;; Function. ,(propertize (let ((cl-print-compiled 'static) @@ -93,8 +95,8 @@ (setq-local revert-buffer-function #'list-timers) (setq tabulated-list-format '[("Idle" 6 timer-list--idle-predicate) - (" Next" 12 timer-list--next-predicate) - (" Repeat" 11 timer-list--repeat-predicate) + (" Next" 12 timer-list--next-predicate) + (" Repeat" 12 timer-list--repeat-predicate) ("Function" 10 timer-list--function-predicate)])) (defun timer-list--idle-predicate (A B) diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el index e7077140e54..c4db86a0db3 100644 --- a/lisp/emacs-lisp/unsafep.el +++ b/lisp/emacs-lisp/unsafep.el @@ -91,17 +91,41 @@ in the parse.") (put 'unsafep-vars 'risky-local-variable t) -;;Other safe functions +;; Other safe forms. +;; +;; A function, macro or special form may be put here only if all of +;; the following statements are true: +;; +;; * It is not already marked `pure' or `side-effect-free', or handled +;; explicitly by `unsafep'. +;; +;; * It is not inherently unsafe; eg, would allow the execution of +;; arbitrary code, interact with the file system, network or other +;; processes, or otherwise exfiltrate information from the running +;; Emacs process or manipulate the user's environment. +;; +;; * It does not have side-effects that can make other code behave in +;; unsafe and/or unexpected ways; eg, set variables, mutate data, or +;; change control flow. +;; Any side effect must be innocuous; altering the match data is +;; explicitly permitted. +;; +;; * It does not allow Emacs to behave deceptively to the user; eg, +;; display arbitrary messages. +;; +;; * It does not present a potentially large attack surface; eg, +;; play arbitrary audio files. + (dolist (x '(;;Special forms - and catch if or prog1 prog2 progn while unwind-protect + and if or prog1 prog2 progn while unwind-protect ;;Safe subrs that have some side-effects - ding error random signal sleep-for string-match throw + ding random sleep-for string-match ;;Defsubst functions from subr.el caar cadr cdar cddr ;;Macros from subr.el save-match-data unless when ;;Functions from subr.el that have side effects - split-string replace-regexp-in-string play-sound-file)) + split-string)) (put x 'safe-function t)) ;;;###autoload diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 3a568cb834c..f525ea433ad 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -292,14 +292,17 @@ entirely by setting `warning-suppress-types' or (insert (format (nth 1 level-info) (format warning-type-format typename)) message) - (insert " ") - (insert-button "Disable showing" - 'type 'warning-suppress-warning - 'warning-type type) - (insert " ") - (insert-button "Disable logging" - 'type 'warning-suppress-log-warning - 'warning-type type) + ;; Don't output the buttons when doing batch compilation + ;; and similar. + (unless (or noninteractive (eq type 'bytecomp)) + (insert " ") + (insert-button "Disable showing" + 'type 'warning-suppress-warning + 'warning-type type) + (insert " ") + (insert-button "Disable logging" + 'type 'warning-suppress-log-warning + 'warning-type type)) (funcall newline) (when (and warning-fill-prefix (not (string-match "\n" message))) (let ((fill-prefix warning-fill-prefix) diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 5f393a01e8c..ba75a93035e 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -176,11 +176,12 @@ Return a value appropriate for `kill-buffer-query-functions' (which see)." arg) ((and (eq arg current-prefix-arg) (consp current-prefix-arg)) ;; called with C-u M-x emacs-lock-mode, so ask the user - (intern (completing-read "Locking mode: " - '("all" "exit" "kill") - nil t nil nil - (symbol-name - emacs-lock-default-locking-mode)))) + (intern (completing-read + (format-prompt "Locking mode" + emacs-lock-default-locking-mode) + '("all" "exit" "kill") + nil t nil nil + (symbol-name emacs-lock-default-locking-mode)))) ((eq mode t) ;; turn on, so use previous setting, or customized default (or emacs-lock--old-mode emacs-lock-default-locking-mode)) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index c4dcb76446e..926305e6077 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1379,9 +1379,10 @@ the prefix fallback behavior." (cond (cua-mode - (setq cua--saved-state - (list - (and (boundp 'delete-selection-mode) delete-selection-mode))) + (unless cua--saved-state + (setq cua--saved-state + (list + (and (boundp 'delete-selection-mode) delete-selection-mode)))) (if cua-delete-selection (delete-selection-mode 1) (if (and (boundp 'delete-selection-mode) delete-selection-mode) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 663995a0a11..7ca9dc1af1d 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -37,26 +37,56 @@ (require 'rect) -;; If non-nil, restrict current region to this rectangle. -;; Value is a vector [top bot left right corner ins virt select]. -;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. -;; INS specifies whether to insert on left(nil) or right(t) side. -;; If VIRT is non-nil, virtual straight edges are enabled. -;; If SELECT is a regexp, only lines starting with that regexp are affected.") -(defvar cua--rectangle nil) +(defvar cua--rectangle nil + "If non-nil, restrict current region to this rectangle. +A cua-rectangle definition is a vector used for all actions in +`cua-rectangle-mark-mode', of the form: + + [top bot left right corner ins virt select] + +TOP is the upper-left corner point. + +BOTTOM is the point at the end of line after the the lower-right +corner point. + +LEFT and RIGHT are column numbers. + +CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. + +INS specifies whether to insert on left(nil) or right(t) side. + +If VIRT is non-nil, virtual straight edges are enabled. + +If SELECT is a regexp, only lines starting with that regexp are +affected.") (make-variable-buffer-local 'cua--rectangle) -;; Most recent rectangle geometry. Note: car is buffer. -(defvar cua--last-rectangle nil) +(defvar cua--last-rectangle nil + "Most recent rectangle geometry. +A CONS cell, the car of which is the rectangle's buffer, and the +cdr of which is a cua-rectangle definition. +See `cua--rectangle'.") + -;; Rectangle restored by undo. -(defvar cua--restored-rectangle nil) +(defvar cua--restored-rectangle nil + "Rectangle restored by undo.") ;; Last rectangle copied/killed; nil if last kill was not a rectangle. +;; FIXME: The above seems to be incorrect: +;; + It seems to be the two most recent killed rectangles, and is not +;; reset upon either a `kill-region' or `kill-line' +;; + In the following example, the rectangle full of question marks +;; was killed prior to the rectangle with the string "active". +;; (#("???e\n??? \n???i\n???," 0 19 +;; (yank-handler +;; (rectangle--insert-for-yank +;; ("???e" "??? " "???i" "???,") +;; t))) +;; "active " "sert on" " straig" " lines ") (defvar cua--last-killed-rectangle nil) -;; List of overlays used to display current rectangle. -(defvar cua--rectangle-overlays nil) +(defvar cua--rectangle-overlays nil + "List of overlays used to display current rectangle.") (make-variable-buffer-local 'cua--rectangle-overlays) (put 'cua--rectangle-overlays 'permanent-local t) @@ -522,7 +552,7 @@ If command is repeated at same position, delete the rectangle." ;;; Operations on current rectangle (defun cua--tabify-start (start end) - ;; Return position where auto-tabify should start (or nil if not required). + "Return position where auto-tabify should start (or nil if not required)." (save-excursion (save-restriction (widen) @@ -538,15 +568,15 @@ If command is repeated at same position, delete the rectangle." start))))) (defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct) - ;; Call FCT for each line of region with 4 parameters: - ;; Region start, end, left-col, right-col - ;; Point is at start when FCT is called - ;; Call fct with (s,e) = whole lines if VISIBLE non-nil. - ;; Only call fct for visible lines if VISIBLE==t. - ;; Set undo boundary if UNDO is non-nil. - ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) - ;; Perform auto-tabify after operation if TABIFY is non-nil. - ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. + "Call FCT for each line of region with 4 parameters: +Region start, end, left-col, right-col. +Point is at start when FCT is called. +Call fct with (s,e) = whole lines if VISIBLE non-nil. +Only call fct for visible lines if VISIBLE==t. +Set undo boundary if UNDO is non-nil. +Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) +Perform auto-tabify after operation if TABIFY is non-nil. +Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear." (let* ((inhibit-field-text-motion t) (start (cua--rectangle-top)) (end (cua--rectangle-bot)) @@ -683,9 +713,9 @@ If command is repeated at same position, delete the rectangle." (nreverse rect))) (defun cua--insert-rectangle (rect &optional below paste-column line-count) - ;; Insert rectangle as insert-rectangle, but don't set mark and exit with - ;; point at either next to top right or below bottom left corner - ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. + "Insert rectangle as insert-rectangle, but don't set mark and exit with +point at either next to top right or below bottom left corner +Notice: In overwrite mode, the rectangle is inserted as separate text lines." (if (eq below 'auto) (setq below (and (bolp) (or (eolp) (eobp) (= (1+ (point)) (point-max)))))) @@ -735,7 +765,7 @@ If command is repeated at same position, delete the rectangle." (setq cua--last-killed-rectangle (cons (and kill-ring (car kill-ring)) killed-rectangle)) (if ring (kill-new (mapconcat - (function (lambda (row) (concat row "\n"))) + (lambda (row) (concat row "\n")) killed-rectangle ""))))) (defun cua--activate-rectangle () @@ -1071,7 +1101,7 @@ The text previously in the rectangle is overwritten by the blanks." (cua--copy-rectangle-to-global-mark t)) (let* ((rect (cua--extract-rectangle)) (text (mapconcat - (function (lambda (row) (concat row "\n"))) + (lambda (row) (concat row "\n")) rect ""))) (setq arg (cua--prefix-arg arg)) (if cua--register @@ -1150,9 +1180,9 @@ The numbers are formatted according to the FORMAT string." (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (string-to-number - (read-string "Start value: (0) " nil nil "0"))) + (read-string (format-prompt "Start value" 0) nil nil "0"))) (string-to-number - (read-string "Increment: (1) " nil nil "1")) + (read-string (format-prompt "Increment" 1) nil nil "1")) (read-string (concat "Format: (" cua--rectangle-seq-format ") ")))) (if (= (length format) 0) (setq format cua--rectangle-seq-format) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 1b149b12e41..d76cf71b314 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -184,7 +184,7 @@ In insert mode, this key also functions as Meta." :type 'string :group 'viper) -(defconst viper-ESC-key [escape] +(defconst viper-ESC-key (kbd "ESC") "Key used to ESC.") diff --git a/lisp/epa-file.el b/lisp/epa-file.el index bb027b9abfb..7fd41784746 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -26,6 +26,7 @@ (require 'epa) (require 'epa-hook) +(eval-when-compile (require 'subr-x)) ;;; Options @@ -115,8 +116,17 @@ encryption is used." (let ((error epa-file-error)) (save-window-excursion (kill-buffer)) - (signal 'file-missing - (cons "Opening input file" (cdr error))))) + (if (nth 3 error) + (user-error "Wrong passphrase: %s" (nth 3 error)) + (signal 'file-missing + (cons "Opening input file" (cdr error)))))) + +(defun epa--wrong-password-p (context) + (let ((error-string (epg-context-error-output context))) + (and (string-match + "decryption failed: \\(Bad session key\\|No secret key\\)" + error-string) + (match-string 1 error-string)))) (defvar last-coding-system-used) (defun epa-file-insert-file-contents (file &optional visit beg end replace) @@ -159,7 +169,12 @@ encryption is used." (nth 3 error))) (let ((exists (file-exists-p local-file))) (when exists - (epa-display-error context) + (if-let ((wrong-password (epa--wrong-password-p context))) + ;; Don't display the *error* buffer if we just + ;; have a wrong password; let the later error + ;; handler notify the user. + (setq error (append error (list wrong-password))) + (epa-display-error context)) ;; When the .gpg file isn't an encrypted file (e.g., ;; it's a keyring.gpg file instead), then gpg will ;; say "Unexpected exit" as the error message. In diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 6e6c0a498d2..dd171ab6474 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -49,6 +49,13 @@ (defvar epa-mail-mode-on-hook nil) (defvar epa-mail-mode-off-hook nil) +(defcustom epa-mail-offer-skip t + "If non-nil, when a recipient has no key, ask whether to skip it. +Otherwise, signal an error." + :type 'boolean + :version "28.1" + :group 'epa-mail) + ;;;###autoload (define-minor-mode epa-mail-mode "A minor-mode for composing encrypted/clearsigned mails." @@ -218,10 +225,12 @@ If no one is selected, symmetric encryption will be performed. " recipient)) 'encrypt))) (unless (or recipient-key - (y-or-n-p - (format - "No public key for %s; skip it? " - recipient))) + (and epa-mail-offer-skip + (y-or-n-p + (format + "No public key for %s; skip it? " + recipient))) + ) (error "No public key for %s" recipient)) (if recipient-key (list recipient-key)))) default-recipients))))) @@ -234,6 +243,11 @@ If no one is selected, symmetric encryption will be performed. " (setq epa-last-coding-system-specified (or coding-system-for-write (select-safe-coding-system (point) (point-max))))) + + ;; Insert contents of requested attachments, if any. + (when (and (eq major-mode 'mail-mode) mail-encode-mml) + (mml-to-mime) + (setq mail-encode-mml nil)) ;; Don't let some read-only text stop us from encrypting. (let ((inhibit-read-only t)) diff --git a/lisp/epa.el b/lisp/epa.el index b065887cef1..25e055c201f 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -400,7 +400,7 @@ DOC is documentation text to insert at the start." e expired key. n never trust. m trust marginally. u trust ultimately. f trust fully (keys you have signed, usually). q trust status questionable. - trust status unspecified. - See GPG documentaion for more explanation. + See GPG documentation for more explanation. \n")) ;;;###autoload @@ -435,33 +435,34 @@ q trust status questionable. - trust status unspecified. (unless (and epa-keys-buffer (buffer-live-p epa-keys-buffer)) (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) - (with-current-buffer epa-keys-buffer - (epa-key-list-mode) - ;; C-c C-c is the usual way to finish the selection (bug#11159). - (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit) - (let ((inhibit-read-only t) - buffer-read-only) - (erase-buffer) - (insert prompt "\n" - (substitute-command-keys "\ + (save-window-excursion + (with-current-buffer epa-keys-buffer + (epa-key-list-mode) + ;; C-c C-c is the usual way to finish the selection (bug#11159). + (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit) + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + (insert prompt "\n" + (substitute-command-keys "\ - `\\[epa-mark-key]' to mark a key on the line - `\\[epa-unmark-key]' to unmark a key on the line\n")) - (insert-button "[Cancel]" - 'action (lambda (_button) (abort-recursive-edit))) - (insert " ") - (insert-button "[OK]" - 'action (lambda (_button) (exit-recursive-edit))) - (insert "\n\n") - (epa--insert-keys keys) - (setq epa-exit-buffer-function #'abort-recursive-edit) - (goto-char (point-min)) - (let ((display-buffer-mark-dedicated 'soft)) - (pop-to-buffer (current-buffer)))) - (unwind-protect - (progn - (recursive-edit) - (epa--marked-keys)) - (kill-buffer epa-keys-buffer)))) + (insert-button "[Cancel]" + 'action (lambda (_button) (abort-recursive-edit))) + (insert " ") + (insert-button "[OK]" + 'action (lambda (_button) (exit-recursive-edit))) + (insert "\n\n") + (epa--insert-keys keys) + (setq epa-exit-buffer-function #'abort-recursive-edit) + (goto-char (point-min)) + (let ((display-buffer-mark-dedicated 'soft)) + (pop-to-buffer (current-buffer)))) + (unwind-protect + (progn + (recursive-edit) + (epa--marked-keys)) + (kill-buffer epa-keys-buffer))))) ;;;###autoload (defun epa-select-keys (context prompt &optional names secret) diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1 index ef813bd0325..fdf51954684 100644 --- a/lisp/erc/ChangeLog.1 +++ b/lisp/erc/ChangeLog.1 @@ -7296,7 +7296,7 @@ again. (erc): Require cl for delete-if. (erc-button-remove-old-buttons): Rewrote using delete-if to - prevent excesive consing. Having the marker list is still ugly, + prevent excessive consing. Having the marker list is still ugly, so another solution needs to be found. 2003-01-17 Jorgen Schaefer <forcer@users.sourceforge.net> @@ -9116,7 +9116,7 @@ 2002-11-10 Alex Schroeder <alex@gnu.org> * TODO: - TODO: moved it to http://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO + TODO: moved it to https://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO * erc.el(with-erc-channel-buffer): Rudimentary doc string. @@ -10260,7 +10260,7 @@ Upcased the command defuns (erc-cmd-join is now erc-cmd-JOIN) Fixed erc-complete to not require erc-command-table. Implemented erc-cmd-HELP - (You have to try that, its tooo coool!) + (You have to try that, its too coool!) e.g. /help auto-q fixed autoloads for erc-add-pal and so on to be interactive. @@ -11242,7 +11242,7 @@ 2001-10-29 Mario Lang <mlang@delysid.org> * erc.el: - Imenu fixed somehow, added IRC services interactive function for indentify to NickServ. Read the diff + Imenu fixed somehow, added IRC services interactive function for identify to NickServ. Read the diff 2001-10-26 Gergely Nagy <algernon@debian.org> @@ -11316,7 +11316,7 @@ * erc-speak.el: * Very important fix! Now erc-speak is really complete. Messages don't get cut anymore. Be sure to use auditory icons, - it's reallllly cool now!!! + it's really cool now!!! * erc-speak.el: *** empty log message *** diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 1cf0bb49217..f99088d4c78 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -408,7 +408,7 @@ This string is processed using `format-time-string'." ;;; Flood-related ;; Most of this is courtesy of Jorgen Schaefer and Circe -;; (http://www.nongnu.org/circe) +;; (https://www.nongnu.org/circe) (defcustom erc-server-flood-margin 10 "A margin on how much excess data we send. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 5e6f7c8d107..b799b2427c6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -198,12 +198,12 @@ PAR is a number of a regexp grouping whose text will be passed to :inline t (integer :tag "Regexp section number"))))) -(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?" +(defcustom erc-emacswiki-url "https://www.emacswiki.org/cgi-bin/wiki.pl?" "URL of the EmacsWiki Homepage." :group 'erc-button :type 'string) -(defcustom erc-emacswiki-lisp-url "http://www.emacswiki.org/elisp/" +(defcustom erc-emacswiki-lisp-url "https://www.emacswiki.org/elisp/" "URL of the EmacsWiki ELisp area." :group 'erc-button :type 'string) diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index 1e65f8f4275..3a9a4a4bac6 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -31,6 +31,7 @@ (require 'erc) (require 'xml) (require 'notifications) +(require 'erc-goodies) (require 'erc-match) (require 'dbus) @@ -62,12 +63,12 @@ This will replace the last notification sent with this function." ;; setting the current buffer to the existing query buffer) (dbus-ignore-errors (setq erc-notifications-last-notification - (let ((channel (if privp (erc-get-buffer nick) (current-buffer)))) + (let* ((channel (if privp (erc-get-buffer nick) (current-buffer))) + (title (format "%s in %s" (xml-escape-string nick t) channel)) + (body (xml-escape-string (erc-controls-strip msg) t))) (notifications-notify :bus erc-notifications-bus - :title (format "%s in %s" - (xml-escape-string nick) - channel) - :body (xml-escape-string msg) + :title title + :body body :replaces-id erc-notifications-last-notification :app-icon erc-notifications-icon :actions '("default" "Switch to buffer") diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el index 7aee7705fff..556a25e3e7b 100644 --- a/lisp/erc/erc-ibuffer.el +++ b/lisp/erc/erc-ibuffer.el @@ -92,10 +92,14 @@ " ")) (define-ibuffer-column erc-server-name (:name "Server") - (if (and erc-server-process (processp erc-server-process)) - (with-current-buffer (process-buffer erc-server-process) - (or erc-server-announced-name erc-session-server)) - "")) + (or + (when (and erc-server-process (processp erc-server-process)) + (let ((buffer (process-buffer erc-server-process))) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (or erc-server-announced-name erc-session-server)) + "(closed)"))) + "")) (define-ibuffer-column erc-target (:name "Target") (if (eq major-mode 'erc-mode) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 8551cdd1dee..d957fcee056 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -152,7 +152,7 @@ ("EFnet: EU, PL, Warszawa" EFnet "irc.efnet.pl" 6667) ("EFnet: EU, RU, Moscow" EFnet "irc.rt.ru" ((6661 6669))) ("EFnet: EU, SE, Dalarna" EFnet "irc.du.se" ((6666 6669))) - ("EFnet: EU, SE, Gothenberg" EFnet "irc.hemmet.chalmers.se" ((6666 7000))) + ("EFnet: EU, SE, Gothenburg" EFnet "irc.hemmet.chalmers.se" ((6666 7000))) ("EFnet: EU, SE, Sweden" EFnet "irc.light.se" 6667) ("EFnet: EU, UK, London (carrier)" EFnet "irc.carrier1.net.uk" ((6666 6669))) ("EFnet: EU, UK, London (demon)" EFnet "efnet.demon.co.uk" ((6665 6669))) @@ -190,9 +190,9 @@ ("Fraggers: Random server" Fraggers "irc.fraggers.co.uk" ((6661 6669) (7000 7001) )) ("FreedomChat: Random server" FreedomChat "chat.freedomchat.net" 6667) ("FreedomIRC: Random server" FreedomIRC "irc.freedomirc.net" 6667) - ("Freenode: Random server" freenode "irc.freenode.net" 6667) - ("Freenode: Random EU server" freenode "irc.eu.freenode.net" 6667) - ("Freenode: Random US server" freenode "irc.us.freenode.net" 6667) + ("Freenode: Random server" freenode "chat.freenode.net" 6667) + ("Freenode: Random EU server" freenode "chat.eu.freenode.net" 6667) + ("Freenode: Random US server" freenode "chat.us.freenode.net" 6667) ("FunNet: Random server" FunNet "irc.funnet.org" 6667) ("Galaxynet: Random server" GalaxyNet "irc.galaxynet.org" ((6662 6668) 7000 )) ("Galaxynet: AU, NZ, Auckland" GalaxyNet "auckland.nz.galaxynet.org" ((6661 6669))) diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el new file mode 100644 index 00000000000..08dc8d6015f --- /dev/null +++ b/lisp/erc/erc-status-sidebar.el @@ -0,0 +1,309 @@ +;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC + +;; Copyright (C) 2017, 2020 Free Software Foundation, Inc. + +;; Author: Andrew Barbarello +;; Maintainer: Amin Bandali <bandali@gnu.org> +;; URL: https://github.com/drewbarbs/erc-status-sidebar + +;; 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 package provides a HexChat-like sidebar for joined channels in +;; ERC. It relies on the `erc-track' module, and displays all of the +;; same information that `erc-track' does in the mode line, but in an +;; alternative format in form of a sidebar. + +;; Shout out to sidebar.el <https://github.com/sebastiencs/sidebar.el> +;; and outline-toc.el <https://github.com/abingham/outline-toc.el> for +;; the sidebar window management ideas. + +;; Usage: + +;; Use M-x erc-status-sidebar-open RET to open the ERC status sidebar +;; in the current frame. Make sure that the `erc-track' module is +;; active (this is the default). + +;; Use M-x erc-status-sidebar-close RET to close the sidebar on the +;; current frame. With a prefix argument, it closes the sidebar on +;; all frames. + +;; Use M-x erc-status-sidebar-kill RET to kill the sidebar buffer and +;; close the sidebar on all frames. + +;;; Code: + +(require 'erc) +(require 'erc-track) +(require 'fringe) +(require 'seq) + +(defgroup erc-status-sidebar nil + "A sidebar for ERC channel status." + :group 'convenience) + +(defcustom erc-status-sidebar-buffer-name "*ERC Status*" + "Name of the sidebar buffer." + :type 'string + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-mode-line-format "ERC Status" + "Mode line format for the status sidebar." + :type 'string + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-header-line-format nil + "Header line format for the status sidebar." + :type '(choice (const :tag "No header line" nil) + string) + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-width 15 + "Default width of the sidebar (in columns)." + :type 'number + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-channel-sort + 'erc-status-sidebar-default-chansort + "Sorting function used to determine order of channels in the sidebar." + :type 'function + :group 'erc-status-sidebar) + +(defcustom erc-status-sidebar-channel-format + 'erc-status-sidebar-default-chan-format + "Function used to format channel names for display in the sidebar." + :type 'function + :group 'erc-status-sidebar) + +(defun erc-status-sidebar-display-window () + "Display the status buffer in a side window. Return the new window." + (display-buffer + (erc-status-sidebar-get-buffer) + `(display-buffer-in-side-window . ((side . left) + (window-width . ,erc-status-sidebar-width))))) + +(defun erc-status-sidebar-get-window (&optional no-creation) + "Return the created/existing window displaying the status buffer. + +If NO-CREATION is non-nil, the window is not created." + (let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name))) + (unless (or sidebar-window no-creation) + (with-current-buffer (erc-status-sidebar-get-buffer) + (setq-local vertical-scroll-bar nil)) + (setq sidebar-window (erc-status-sidebar-display-window)) + (set-window-dedicated-p sidebar-window t) + (set-window-parameter sidebar-window 'no-delete-other-windows t) + ;; Don't cycle to this window with `other-window'. + (set-window-parameter sidebar-window 'no-other-window t) + (internal-show-cursor sidebar-window nil) + (set-window-fringes sidebar-window 0 0) + ;; Set a custom display table so the window doesn't show a + ;; truncation symbol when a channel name is too big. + (let ((dt (make-display-table))) + (set-window-display-table sidebar-window dt) + (set-display-table-slot dt 'truncation ?\ ))) + sidebar-window)) + +(defun erc-status-sidebar-buffer-exists-p () + "Check if the sidebar buffer exists." + (get-buffer erc-status-sidebar-buffer-name)) + +(defun erc-status-sidebar-get-buffer () + "Return the sidebar buffer, creating it if it doesn't exist." + (get-buffer-create erc-status-sidebar-buffer-name)) + +(defun erc-status-sidebar-close (&optional all-frames) + "Close the sidebar. + +If called with prefix argument (ALL-FRAMES non-nil), the sidebar +will be closed on all frames. + +The erc-status-sidebar buffer is left alone, but the window +containing it on the current frame is closed. See +`erc-status-sidebar-kill'." + (interactive "P") + (mapcar #'delete-window + (get-buffer-window-list (erc-status-sidebar-get-buffer) + nil (if all-frames t)))) + +(defmacro erc-status-sidebar-writable (&rest body) + "Make the status buffer writable while executing BODY." + `(let ((buffer-read-only nil)) + ,@body)) + +;;;###autoload +(defun erc-status-sidebar-open () + "Open or create a sidebar." + (interactive) + (save-excursion + (let ((sidebar-exists (erc-status-sidebar-buffer-exists-p)) + (sidebar-buffer (erc-status-sidebar-get-buffer)) + (sidebar-window (erc-status-sidebar-get-window))) + (unless sidebar-exists + (with-current-buffer sidebar-buffer + (erc-status-sidebar-mode) + (erc-status-sidebar-refresh)))))) + +;;;###autoload +(defun erc-status-sidebar-toggle () + "Toggle the sidebar open/closed on the current frame." + (interactive) + (if (get-buffer-window erc-status-sidebar-buffer-name nil) + (erc-status-sidebar-close) + (erc-status-sidebar-open))) + +(defun erc-status-sidebar-get-channame (buffer) + "Return name of BUFFER with all leading \"#\" characters removed." + (let ((s (buffer-name buffer))) + (if (string-match "^#\\{1,2\\}" s) + (setq s (replace-match "" t t s))) + (downcase s))) + +(defun erc-status-sidebar-default-chansort (chanlist) + "Sort CHANLIST case-insensitively for display in the sidebar." + (sort chanlist (lambda (x y) + (string< (erc-status-sidebar-get-channame x) + (erc-status-sidebar-get-channame y))))) + +(defun erc-status-sidebar-default-chan-format (channame + &optional num-messages erc-face) + "Format CHANNAME for display in the sidebar. + +If NUM-MESSAGES is non-nil, append it to the channel name. If +ERC-FACE is non-nil, apply it to channel name. If it is equal to +`erc-default-face', also apply bold property to make the channel +name stand out." + (when num-messages + (setq channame (format "%s [%d]" channame num-messages))) + (when erc-face + (put-text-property 0 (length channame) 'face erc-face channame) + (when (eq erc-face 'erc-default-face) + (add-face-text-property 0 (length channame) 'bold t channame))) + channame) + +(defun erc-status-sidebar-refresh () + "Update the content of the sidebar." + (interactive) + (let ((chanlist (apply erc-status-sidebar-channel-sort + (erc-channel-list nil) nil))) + (with-current-buffer (erc-status-sidebar-get-buffer) + (erc-status-sidebar-writable + (delete-region (point-min) (point-max)) + (goto-char (point-min)) + (dolist (chanbuf chanlist) + (let* ((tup (seq-find (lambda (tup) (eq (car tup) chanbuf)) + erc-modified-channels-alist)) + (count (if tup (cadr tup))) + (face (if tup (cddr tup))) + (channame (apply erc-status-sidebar-channel-format + (buffer-name chanbuf) count face nil)) + (cnlen (length channame))) + (put-text-property 0 cnlen 'erc-buf chanbuf channame) + (put-text-property 0 cnlen 'mouse-face 'highlight channame) + (put-text-property + 0 cnlen 'help-echo + "mouse-1: switch to buffer in other window" channame) + (insert channame "\n"))))))) + +(defun erc-status-sidebar-kill () + "Close the ERC status sidebar and its buffer." + (interactive) + (ignore-errors (kill-buffer erc-status-sidebar-buffer-name))) + +(defun erc-status-sidebar-click (event) + "Handle click EVENT in `erc-status-sidebar-mode-map'." + (interactive "e") + (save-excursion + (let ((window (posn-window (event-end event))) + (pos (posn-point (event-end event)))) + (set-buffer (window-buffer window)) + (let ((buf (get-text-property pos 'erc-buf))) + (when buf + (select-window window) + (switch-to-buffer-other-window buf)))))) + +(defvar erc-status-sidebar-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map special-mode-map) + (define-key map [mouse-1] #'erc-status-sidebar-click) + map)) + +(defvar erc-status-sidebar-refresh-triggers + '(erc-track-list-changed-hook + erc-join-hook + erc-part-hook + erc-kill-buffer-hook + erc-kill-channel-hook + erc-kill-server-hook + erc-kick-hook + erc-disconnected-hook + erc-quit-hook)) + +(defun erc-status-sidebar--post-refresh (&rest ignore) + "Schedule sidebar refresh for execution after command stack is cleared. + +Ignore arguments in IGNORE, allowing this function to be added to +hooks that invoke it with arguments." + (run-at-time 0 nil #'erc-status-sidebar-refresh)) + +(defun erc-status-sidebar-mode--unhook () + "Remove hooks installed by `erc-status-sidebar-mode'." + (dolist (hk erc-status-sidebar-refresh-triggers) + (remove-hook hk #'erc-status-sidebar--post-refresh)) + (remove-hook 'window-configuration-change-hook + #'erc-status-sidebar-set-window-preserve-size)) + +(defun erc-status-sidebar-set-window-preserve-size () + "Tell Emacs to preserve the current height/width of the ERC sidebar window. + +Note that preserve status needs to be reset when the window is +manually resized, so `erc-status-sidebar-mode' adds this function +to the `window-configuration-change-hook'." + (when (and (eq (selected-window) (erc-status-sidebar-get-window)) + (fboundp 'window-preserve-size)) + (unless (eq (window-total-width) (window-min-size nil t)) + (apply 'window-preserve-size (selected-window) t t nil)))) + +(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar" + "Major mode for ERC status sidebar" + ;; Don't scroll the buffer horizontally, if a channel name is + ;; obscured then the window can be resized. + (setq-local auto-hscroll-mode nil) + (setq cursor-type nil + buffer-read-only t + mode-line-format erc-status-sidebar-mode-line-format + header-line-format erc-status-sidebar-header-line-format) + (erc-status-sidebar-set-window-preserve-size) + + (add-hook 'window-configuration-change-hook + #'erc-status-sidebar-set-window-preserve-size nil t) + (dolist (hk erc-status-sidebar-refresh-triggers) + (add-hook hk #'erc-status-sidebar--post-refresh)) + + ;; `change-major-mode-hook' is run *before* the + ;; erc-status-sidebar-mode initialization code, so it won't undo the + ;; add-hook's we did in the previous expressions. + (add-hook 'change-major-mode-hook #'erc-status-sidebar-mode--unhook nil t) + (add-hook 'kill-buffer-hook #'erc-status-sidebar-mode--unhook nil t) + :group 'erc-status-sidebar) + +(provide 'erc-status-sidebar) +;;; erc-status-sidebar.el ends here + +;; Local Variables: +;; generated-autoload-file: "erc-loaddefs.el" +;; End: diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 3398c8b9d0c..60f0cfa942f 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -860,7 +860,7 @@ is in `erc-mode'." (defvar erc-track-last-non-erc-buffer nil "Stores the name of the last buffer you were in before activating -`erc-track-switch-buffers'.") +`erc-track-switch-buffer'.") (defun erc-track-sort-by-activest () "Sort erc-modified-channels-alist by activity. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8712113790b..e35ae0cfd87 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1500,7 +1500,7 @@ Defaults to the server buffer." ;; activation -(defconst erc-default-server "irc.freenode.net" +(defconst erc-default-server "chat.freenode.net" "IRC server to use if it cannot be detected otherwise.") (defconst erc-default-port 6667 @@ -2244,7 +2244,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\") + (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\") then the server and full-name will be set to those values, whereas `erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will @@ -4072,7 +4072,8 @@ If `point' is at the beginning of a channel name, use that as default." (table (when (erc-server-buffer-live-p) (set-buffer (process-buffer erc-server-process)) erc-channel-list))) - (completing-read "Join channel: " table nil nil nil nil chnl)) + (completing-read (format-prompt "Join channel" chnl) + table nil nil nil nil chnl)) (when (or current-prefix-arg erc-prompt-for-channel-key) (read-from-minibuffer "Channel key (RET for none): " nil)))) (erc-cmd-JOIN channel (when (>= (length key) 1) key))) @@ -5038,7 +5039,7 @@ information if it is not already present in the user or channel lists. If, and only if, changes are made, or the user is added, -`erc-channel-members-updated-hook' is run, and t is returned. +`erc-channel-members-changed-hook' is run, and t is returned. See also: `erc-update-user' and `erc-update-channel-member'." (let* (changed user-changed @@ -5471,6 +5472,10 @@ submitted line to be intentional." (time-less-p erc-accidental-paste-threshold-seconds (time-subtract now erc-last-input-time))) (save-restriction + ;; If there's an abbrev at the end of the line, expand it. + (when (and abbrev-mode + (eolp)) + (expand-abbrev)) (widen) (if (< (point) (erc-beg-of-input-line)) (erc-error "Point is not in the input area") @@ -6071,7 +6076,7 @@ Sets the buffer local variables: - `erc-session-connector' - `erc-session-server' - `erc-session-port' -- `erc-session-full-name' +- `erc-session-user-full-name' - `erc-server-current-nick'" (setq erc-session-connector erc-server-connect-function erc-session-server (erc-compute-server server) diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index dcf56af6051..8a444c91001 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -116,6 +116,9 @@ is non-nil." (defcustom eshell-command-completions-alist '(("acroread" . "\\.pdf\\'") ("xpdf" . "\\.pdf\\'") + ("gunzip" . "\\.t?gz\\'") + ("bunzip2" . "\\.t?bz2\\'") + ("unxz" . "\\.t?xz\\'") ("ar" . "\\.[ao]\\'") ("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'") ("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'") diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index c26f654e278..59139da10db 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -73,18 +73,18 @@ ordinary strings." (?p . (eshell-pred-file-type ?p)) ; named pipes (?@ . (eshell-pred-file-type ?l)) ; symbolic links (?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.) - (?r . (eshell-pred-file-mode 0400)) ; owner-readable - (?w . (eshell-pred-file-mode 0200)) ; owner-writable - (?x . (eshell-pred-file-mode 0100)) ; owner-executable - (?A . (eshell-pred-file-mode 0040)) ; group-readable - (?I . (eshell-pred-file-mode 0020)) ; group-writable - (?E . (eshell-pred-file-mode 0010)) ; group-executable - (?R . (eshell-pred-file-mode 0004)) ; world-readable - (?W . (eshell-pred-file-mode 0002)) ; world-writable - (?X . (eshell-pred-file-mode 0001)) ; world-executable - (?s . (eshell-pred-file-mode 4000)) ; setuid - (?S . (eshell-pred-file-mode 2000)) ; setgid - (?t . (eshell-pred-file-mode 1000)) ; sticky bit + (?r . (eshell-pred-file-mode #o0400)) ; owner-readable + (?w . (eshell-pred-file-mode #o0200)) ; owner-writable + (?x . (eshell-pred-file-mode #o0100)) ; owner-executable + (?A . (eshell-pred-file-mode #o0040)) ; group-readable + (?I . (eshell-pred-file-mode #o0020)) ; group-writable + (?E . (eshell-pred-file-mode #o0010)) ; group-executable + (?R . (eshell-pred-file-mode #o0004)) ; world-readable + (?W . (eshell-pred-file-mode #o0002)) ; world-writable + (?X . (eshell-pred-file-mode #o0001)) ; world-executable + (?s . (eshell-pred-file-mode #o4000)) ; setuid + (?S . (eshell-pred-file-mode #o2000)) ; setgid + (?t . (eshell-pred-file-mode #o1000)) ; sticky bit (?U . #'(lambda (file) ; owned by effective uid (if (file-exists-p file) (= (file-attribute-user-id (file-attributes file)) @@ -478,7 +478,7 @@ that `ls -l' will show in the first column of its display." `(lambda (file) (let ((modes (file-modes file 'nofollow))) (if modes - (logand ,mode modes))))) + (not (zerop (logand ,mode modes))))))) (defun eshell-pred-file-links () "Return a predicate to test whether a file has a given number of links." diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index fbd3cfbb6fc..68aa6803278 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -439,7 +439,10 @@ Remove the DIRECTORY(ies), if they are empty.") (setq link (file-symlink-p source))) (progn (apply 'eshell-funcalln 'make-symbolic-link - link target args) + link target + ;; `make-symbolic-link' doesn't have + ;; KEEP-TIME; just OK-IF-ALREADY-EXISTS. + (list (car args))) (if (eq func 'rename-file) (if (and (file-directory-p source) (not (file-symlink-p source))) @@ -787,9 +790,9 @@ external command." ;; completions rules for some common UNIX commands -(defsubst eshell-complete-hostname () - "Complete a command that wants a hostname for an argument." - (pcomplete-here (eshell-read-host-names))) +(autoload 'pcmpl-unix-complete-hostname "pcmpl-unix") +(define-obsolete-function-alias 'eshell-complete-hostname + #'pcmpl-unix-complete-hostname "28.1") (defun eshell-complete-host-reference () "If there is a host reference, complete it." @@ -798,26 +801,7 @@ external command." (when (setq index (string-match "@[a-z.]*\\'" arg)) (setq pcomplete-stub (substring arg (1+ index)) pcomplete-last-completion-raw t) - (throw 'pcomplete-completions (eshell-read-host-names))))) - -(defalias 'pcomplete/ftp 'eshell-complete-hostname) -(defalias 'pcomplete/ncftp 'eshell-complete-hostname) -(defalias 'pcomplete/ping 'eshell-complete-hostname) -(defalias 'pcomplete/rlogin 'eshell-complete-hostname) - -(defun pcomplete/telnet () - (require 'pcmpl-unix) - (pcomplete-opt "xl(pcmpl-unix-user-names)") - (eshell-complete-hostname)) - -(defun pcomplete/rsh () - "Complete `rsh', which, after the user and hostname, is like xargs." - (require 'pcmpl-unix) - (pcomplete-opt "l(pcmpl-unix-user-names)") - (eshell-complete-hostname) - (pcomplete-here (funcall pcomplete-command-completion-function)) - (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) - pcomplete-default-completion-function))) + (throw 'pcomplete-completions (pcomplete-read-host-names))))) (defvar block-size) (defvar by-bytes) diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index d55986c49b8..3c038edfd18 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -94,36 +94,6 @@ naturally accessible within Emacs." (defalias 'eshell/ff 'find-name-dired) (defalias 'eshell/gf 'find-grep-dired) -(defun pcomplete/bcc32 () - "Completion function for Borland's C++ compiler." - (let ((cur (pcomplete-arg 0))) - (cond - ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur) - (pcomplete-here - '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc" - "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup" - "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil" - "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci" - "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf" - "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par" - "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret" - "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai" - "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur))) - ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur) - (pcomplete-here (pcomplete-dirs) (match-string 2 cur))) - ((string-match "\\`-[Ee]\\(.*\\)\\'" cur) - (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'") - (match-string 1 cur))) - ((string-match "\\`-o\\(.*\\)\\'" cur) - (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'") - (match-string 1 cur))) - (t - (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz")))) - (while (pcomplete-here - (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'")))) - -(defalias 'pcomplete/bcc 'pcomplete/bcc32) - (provide 'em-xtra) ;; Local Variables: diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index ecdfd285f90..e0e86348bd8 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -1018,6 +1018,7 @@ This function could be in the list `eshell-output-filter-functions'." (location . ,default-directory) (handler . eshell-bookmark-jump))) +;;;###autoload (defun eshell-bookmark-jump (bookmark) "Default bookmark handler for Eshell buffers." (let ((default-directory (bookmark-prop-get bookmark 'location))) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index ab030ede05b..9268921fadc 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -51,9 +51,15 @@ similarly to external commands, as far as successful result output." :group 'eshell-util) (defcustom eshell-hosts-file "/etc/hosts" - "The name of the /etc/hosts file." + "The name of the /etc/hosts file. +Use `pcomplete-hosts-file' instead; this variable is obsolete and +has no effect." :type '(choice (const :tag "No hosts file" nil) file) :group 'eshell-util) +;; Don't make it into an alias, because it doesn't really work with +;; custom and risks creating duplicate entries. Just point users to +;; the other variable, which is less frustrating. +(make-obsolete-variable 'eshell-hosts-file nil "28.1") (defcustom eshell-handle-errors t "If non-nil, Eshell will handle errors itself. @@ -127,11 +133,14 @@ function `string-to-number'." (defvar eshell-user-timestamp nil "A timestamp of when the user file was read.") -(defvar eshell-host-names nil - "A cache the names of frequently accessed hosts.") +;;; Obsolete variables: -(defvar eshell-host-timestamp nil - "A timestamp of when the hosts file was read.") +(define-obsolete-variable-alias 'eshell-host-names + 'pcomplete--host-name-cache "28.1") +(define-obsolete-variable-alias 'eshell-host-timestamp + 'pcomplete--host-name-cache-timestamp "28.1") +(defvar pcomplete--host-name-cache) +(defvar pcomplete--host-name-cache-timestamp) ;;; Functions: @@ -479,37 +488,15 @@ list." (defalias 'eshell-user-name 'user-login-name) -(defun eshell-read-hosts-file (filename) - "Read in the hosts from FILENAME, default `eshell-hosts-file'." - (let (hosts) - (with-temp-buffer - (insert-file-contents (or filename eshell-hosts-file)) - (goto-char (point-min)) - (while (re-search-forward - ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?" - "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t) - (push (cons (match-string 1) - (split-string (match-string 2))) - hosts))) - (nreverse hosts))) - -(defun eshell-read-hosts (file result-var timestamp-var) - "Read the contents of /etc/hosts for host names." - (if (or (not (symbol-value result-var)) - (not (symbol-value timestamp-var)) - (time-less-p - (symbol-value timestamp-var) - (file-attribute-modification-time (file-attributes file)))) - (progn - (set result-var (apply #'nconc (eshell-read-hosts-file file))) - (set timestamp-var (current-time)))) - (symbol-value result-var)) - -(defun eshell-read-host-names () - "Read the contents of /etc/hosts for host names." - (if eshell-hosts-file - (eshell-read-hosts eshell-hosts-file 'eshell-host-names - 'eshell-host-timestamp))) +(autoload 'pcomplete-read-hosts-file "pcomplete") +(autoload 'pcomplete-read-hosts "pcomplete") +(autoload 'pcomplete-read-host-names "pcomplete") +(define-obsolete-function-alias 'eshell-read-hosts-file + #'pcomplete-read-hosts-file "28.1") +(define-obsolete-function-alias 'eshell-read-hosts + #'pcomplete-read-hosts "28.1") +(define-obsolete-function-alias 'eshell-read-host-names + #'pcomplete-read-host-names "28.1") (defsubst eshell-copy-environment () "Return an unrelated copy of `process-environment'." @@ -547,7 +534,7 @@ list." string))) (defun eshell-directory-files-and-attributes (dir &optional full match nosort id-format) - "Make sure to use the handler for `directory-file-and-attributes'." + "Make sure to use the handler for `directory-files-and-attributes'." (let* ((dir (expand-file-name dir))) (if (string-equal (file-remote-p dir 'method) "ftp") (let ((files (directory-files dir full match nosort))) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 96838d41327..7388279f157 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -463,8 +463,8 @@ Possible options are: (eshell-as-subcommand ,(eshell-parse-command cmd)) (ignore (nconc eshell-this-command-hook - (list (function (lambda () - (delete-file ,temp)))))) + (list (lambda () + (delete-file ,temp))))) (quote ,temp))) (goto-char (1+ end))))))) ((eq (char-after) ?\() diff --git a/lisp/faces.el b/lisp/faces.el index 7c23e58fd9d..728f8b0fe67 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1770,7 +1770,7 @@ If FRAME is nil, that stands for the selected frame." (defun defined-colors-with-face-attributes (&optional frame) "Return a list of colors supported for a particular frame. See `defined-colors' for arguments and return value. In contrast -to `define-colors' the elements of the returned list are color +to `defined-colors' the elements of the returned list are color strings with text properties, that make the color names render with the color they represent as background color." (mapcar @@ -2637,9 +2637,9 @@ Use the face `mode-line-highlight' for features that can be selected." :version "21.1" :group 'basic-faces) -(defface header-line-highlight '((t :inherit highlight)) +(defface header-line-highlight '((t :inherit mode-line-highlight)) "Basic header line face for highlighting." - :version "26.1" + :version "28.1" :group 'basic-faces) (defface vertical-border @@ -2716,9 +2716,11 @@ used to display the prompt text." :group 'frames :group 'basic-faces) -(defface scroll-bar '((t nil)) +(defface scroll-bar + '((((background light)) :foreground "black") + (((background dark)) :foreground "white")) "Basic face for the scroll bar colors under X." - :version "21.1" + :version "28.1" :group 'frames :group 'basic-faces) diff --git a/lisp/ffap.el b/lisp/ffap.el index 3e65c687af6..bf035886006 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1,4 +1,4 @@ -;;; ffap.el --- find file (or url) at point +;;; ffap.el --- find file (or url) at point -*- lexical-binding: t -*- ;; Copyright (C) 1995-1997, 2000-2020 Free Software Foundation, Inc. @@ -172,7 +172,7 @@ well-formed, such as \"user@host\" or \"<user@host>\"." :version "25.2") ; nil -> t (defcustom ffap-ftp-default-user "anonymous" - "User name in FTP file names generated by `ffap-host-to-path'. + "User name in FTP file names generated by `ffap-host-to-filename'. Note this name may be omitted if it equals the default \(either `efs-default-user' or `ange-ftp-default-user')." :type 'string @@ -1049,22 +1049,19 @@ out of NAME." "/pub/gnu/emacs/elisp-archive/")) (substring name 2)))) -(defcustom ffap-rfc-path - (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt") +(defcustom ffap-rfc-path "https://www.rfc-editor.org/in-notes/rfc%s.txt" "A `format' string making a filename for RFC documents. -This can be an ange-ftp or Tramp remote filename to download, or -a local filename if you have full set of RFCs locally. See also -`ffap-rfc-directories'." +This can be an URL, an ange-ftp or Tramp remote filename to +download, or a local filename if you have the full set of RFCs +locally. See also `ffap-rfc-directories'." :type 'string - :version "23.1" - :group 'ffap) + :version "28.1") (defcustom ffap-rfc-directories nil "A list of directories to look for RFC files. If a given RFC isn't in these then `ffap-rfc-path' is offered." :type '(repeat directory) - :version "23.1" - :group 'ffap) + :version "23.1") (defun ffap-rfc (name) (let ((num (match-string 1 name))) @@ -1142,7 +1139,7 @@ Move point and return point if an adjustment was done." (unless dir-separator (setq dir-separator "/")) (let ((opoint (point)) - point punct end whitespace-p) + point punct whitespace-p) (when (re-search-backward (regexp-quote dir-separator) (line-beginning-position) t) ;; Move to the beginning of the match.. @@ -1363,12 +1360,14 @@ Set to nil to disable matching gopher bookmarks.") (defun ffap--gopher-var-on-line () "Return (KEY . VALUE) of gopher bookmark on current line." (save-excursion - (let ((eol (progn (end-of-line) (skip-chars-backward " ") (point))) - (bol (progn (beginning-of-line) (point)))) - (when (re-search-forward ffap-gopher-regexp eol t) - (let ((key (match-string 1)) - (val (buffer-substring-no-properties (match-end 0) eol))) - (cons (intern (downcase key)) val)))))) + (end-of-line) + (skip-chars-backward " ") + (let ((eol (point))) + (beginning-of-line) + (when (re-search-forward ffap-gopher-regexp eol t) + (let ((key (match-string 1)) + (val (buffer-substring-no-properties (match-end 0) eol))) + (cons (intern (downcase key)) val)))))) (defun ffap-gopher-at-point () "If point is inside a gopher bookmark block, return its URL. @@ -1383,7 +1382,8 @@ Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any." (point))) (bookmark (cl-loop for keyval = (ffap--gopher-var-on-line) while keyval collect keyval - do (forward-line 1)))) + do (forward-line 1) + until (eobp)))) (when bookmark (setq ffap-string-at-point-region (list beg (point))) (let-alist (nconc bookmark '((type . "1") (port . "70"))) @@ -1926,6 +1926,14 @@ Only intended for interactive use." (ffap--toggle-read-only value) value)) +(defun ffap-read-only-other-tab (filename) + "Like `ffap', but put buffer in another tab and mark as read-only. +Only intended for interactive use." + (interactive (list (ffap-prompter nil " read only other tab"))) + (let ((value (window-buffer (ffap-other-tab filename)))) + (ffap--toggle-read-only value) + value)) + (defun ffap-alternate-file (filename) "Like `ffap' and `find-alternate-file'. Only intended for interactive use." diff --git a/lisp/filecache.el b/lisp/filecache.el index 113d28cf75e..00c53138032 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -46,7 +46,7 @@ ;; * `file-cache-add-file-list': Adds a list of files to the cache ;; ;; The following functions use the regular expressions in -;; `file-cache-delete-regexps' to eliminate unwanted files: +;; `file-cache-filter-regexps' to eliminate unwanted files: ;; ;; * `file-cache-add-directory': Adds the files in a directory to the ;; cache. You can also specify a regular expression to match the files diff --git a/lisp/fileloop.el b/lisp/fileloop.el index 458c25a49b0..b778eca8e9b 100644 --- a/lisp/fileloop.el +++ b/lisp/fileloop.el @@ -57,6 +57,9 @@ (defvar fileloop--iterator iter-empty) (defvar fileloop--scan-function (lambda () (user-error "No operation in progress"))) +;; If the default value below is changed, the :enable form of +;; tags-continue and tags-repl-continue in menu-bar.el will have to be +;; updated accordingly. (defvar fileloop--operate-function #'ignore) (defvar fileloop--freshly-initialized nil) diff --git a/lisp/files.el b/lisp/files.el index e6629d2a21a..59bcc3e8a78 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1392,7 +1392,7 @@ it means chase no more than that many links and then stop." newname)) ;; A handy function to display file sizes in human-readable form. -;; See http://en.wikipedia.org/wiki/Kibibyte for the reference. +;; See https://en.wikipedia.org/wiki/Kibibyte for the reference. (defun file-size-human-readable (file-size &optional flavor space unit) "Produce a string showing FILE-SIZE in human-readable form. @@ -2758,8 +2758,8 @@ since only a single case-insensitive search through the alist is made." ;; The list of archive file extensions should be in sync with ;; `auto-coding-alist' with `no-conversion' coding system. ("\\.\\(\ -arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mode) +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|squashfs\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . archive-mode) ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions. ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. ;; Mailer puts message to be edited in @@ -3067,7 +3067,7 @@ If FUNCTION is nil, then it is not called. (That is a way of saying "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?" "[Hh][Tt][Mm][Ll]")) . mhtml-mode) - ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode) + ("<![Dd][Oo][Cc][Tt][Yy][Pp][Ee][ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode) ;; These two must come after html, because they are more general: ("<\\?xml " . xml-mode) (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") @@ -4301,9 +4301,27 @@ Return the new class name, which is a symbol named DIR." (if (not (and newvars variables)) (or newvars variables) (require 'map) - (map-merge-with 'list (lambda (a b) (map-merge 'list a b)) - variables - newvars)))))) + ;; We want to make the variable setting from + ;; newvars (the second .dir-locals file) take + ;; presedence over the old variables, but we also + ;; want to preserve all `eval' elements as is from + ;; both lists. + (map-merge-with + 'list + (lambda (a b) + (let ((ag + (seq-group-by + (lambda (e) (eq (car e) 'eval)) a)) + (bg + (seq-group-by + (lambda (e) (eq (car e) 'eval)) b))) + (append (map-merge 'list + (assoc-default nil ag) + (assoc-default nil bg)) + (assoc-default t ag) + (assoc-default t bg)))) + variables + newvars)))))) (setq success latest)) (setq variables (dir-locals--sort-variables variables)) (dir-locals-set-class-variables class-name variables) @@ -6254,6 +6272,82 @@ an auto-save file." (insert-file-contents file-name (not auto-save-p) nil nil t)))))) +(defvar revert-buffer-with-fine-grain-max-seconds 2.0 + "Maximum time that `revert-buffer-with-fine-grain' should use. +The command tries to preserve markers, properties and overlays. +If the operation takes more than this time, a single +delete+insert is performed. Actually, this value is passed as +the MAX-SECS argument to the function `replace-buffer-contents', +so it is not ensured that the whole execution won't take longer. +See `replace-buffer-contents' for more details.") + +(defun revert-buffer-insert-file-contents-delicately (file-name _auto-save-p) + "Optional function for `revert-buffer-insert-file-contents-function'. +The function `revert-buffer-with-fine-grain' uses this function by binding +`revert-buffer-insert-file-contents-function' to it. + +As with `revert-buffer-insert-file-contents--default-function', FILE-NAME is +the name of the file and AUTO-SAVE-P is non-nil if this is an auto-save file. +Since calling `replace-buffer-contents' can take a long time, depending of +the number of changes made to the buffer, it uses the value of the variable +`revert-buffer-with-fine-grain-max-seconds' as a maximum time to try delicately +reverting the buffer. If it fails, it does a delete+insert. For more details, +see `replace-buffer-contents'." + (cond + ((not (file-exists-p file-name)) + (error (if buffer-file-number + "File %s no longer exists" + "Cannot revert nonexistent file %s") + file-name)) + ((not (file-readable-p file-name)) + (error (if buffer-file-number + "File %s no longer readable" + "Cannot revert unreadable file %s") + file-name)) + (t + (let* ((buf (current-buffer)) ; current-buffer is the buffer to revert. + (success + (save-excursion + (save-restriction + (widen) + (with-temp-buffer + (insert-file-contents file-name) + (let ((temp-buf (current-buffer))) + (set-buffer buf) + (let ((buffer-file-name nil)) + (replace-buffer-contents + temp-buf + revert-buffer-with-fine-grain-max-seconds)))))))) + ;; See comments in revert-buffer-with-fine-grain for an explanation. + (defun revert-buffer-with-fine-grain-success-p () + success)) + (set-buffer-modified-p nil)))) + +(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm) + "Revert buffer preserving markers, overlays, etc. +This command is an alternative to `revert-buffer' because it tries to be as +non-destructive as possible, preserving markers, properties and overlays. +Binds `revert-buffer-insert-file-contents-function' to the function +`revert-buffer-insert-file-contents-delicately'. + +With a prefix argument, offer to revert from latest auto-save file. For more +details on the arguments, see `revert-buffer'." + ;; See revert-buffer for an explanation of this. + (interactive (list (not current-prefix-arg))) + ;; Simply bind revert-buffer-insert-file-contents-function to the specialized + ;; function, and call revert-buffer. + (let ((revert-buffer-insert-file-contents-function + #'revert-buffer-insert-file-contents-delicately)) + (revert-buffer ignore-auto noconfirm t) + ;; This closure is defined in revert-buffer-insert-file-contents-function. + ;; It is needed because revert-buffer--default always returns t after + ;; reverting, and it might be needed to report the success/failure of + ;; reverting delicately. + (when (fboundp 'revert-buffer-with-fine-grain-success-p) + (prog1 + (revert-buffer-with-fine-grain-success-p) + (fmakunbound 'revert-buffer-with-fine-grain-success-p))))) + (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." (interactive) @@ -6814,9 +6908,7 @@ We assume the output has the format of `df'. The value of this variable must be just a command name or file name; if you want to specify options, use `directory-free-space-args'. -A value of nil disables this feature. - -This variable is obsolete; Emacs no longer uses it." +A value of nil disables this feature." :type '(choice (string :tag "Program") (const :tag "None" nil)) :group 'dired) (make-obsolete-variable 'directory-free-space-program @@ -6862,6 +6954,9 @@ If DIR's free space cannot be obtained, this function returns nil." s "+" "\\(" HH:MM "\\|" yyyy "\\)")) (western-comma (concat month s "+" dd "," s "+" yyyy)) + ;; This represents the date in strftime(3) format "%e-%b-%Y" + ;; (aka "%v"), as it is the default for many ls incarnations. + (DD-MMM-YYYY (concat dd "-" month "-" yyyy s HH:MM)) ;; Japanese MS-Windows ls-lisp has one-digit months, and ;; omits the Kanji characters after month and day-of-month. ;; On Mac OS X 10.3, the date format in East Asian locales is @@ -6889,7 +6984,8 @@ If DIR's free space cannot be obtained, this function returns nil." ;; This is not supported yet. (purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso "\\|.*[0-9][BkKMGTPEZY]? " - "\\(" western "\\|" western-comma "\\|" east-asian "\\)" + "\\(" western "\\|" western-comma + "\\|" DD-MMM-YYYY "\\|" east-asian "\\)" "\\) +"))) "Regular expression to match up to the file name in a directory listing. The default value is designed to recognize dates and times @@ -7702,7 +7798,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (let (delete-by-moving-to-trash) (rename-file fn new-fn)))) ;; Otherwise, use the freedesktop.org method, as specified at - ;; http://freedesktop.org/wiki/Specifications/trash-spec + ;; https://freedesktop.org/wiki/Specifications/trash-spec (t (let* ((xdg-data-dir (directory-file-name diff --git a/lisp/filesets.el b/lisp/filesets.el index 1ec0d24b539..4f23faa2203 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -52,7 +52,7 @@ ;; BTW, if you close a fileset, files, which have been changed, will ;; be silently saved. Change this behavior by setting -;; `filesets-save-buffer-fn'. +;; `filesets-save-buffer-function'. ;;; Supported modes for inclusion groups (`filesets-ingroup-patterns'): ;; - Elisp diff --git a/lisp/find-dired.el b/lisp/find-dired.el index a96c6c9edbb..18330d821ce 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -85,8 +85,8 @@ the options \"-dilsb\". While the option `find -ls' often produces unsorted output, the option `find -exec ls -ld' maintains the sorting order only on short output, -whereas `find -print | sort | xargs' produced sorted output even -on the large number of files." +whereas `find -print | sort | xargs' produces sorted output even +on a large number of files." :version "27.1" ; add choice of predefined set of options :type `(choice (cons :tag "find -ls" @@ -164,7 +164,10 @@ The command run (after changing into DIR) is essentially find . \\( ARGS \\) -ls except that the car of the variable `find-ls-option' specifies what to -use in place of \"-ls\" as the final argument." +use in place of \"-ls\" as the final argument. + +Collect output in the \"*Find*\" buffer. To kill the job before +it finishes, type \\[kill-find]." (interactive (list (read-directory-name "Run find in directory: " nil "" t) (read-string "Run find (with args): " find-args '(find-args-history . 1)))) @@ -215,7 +218,6 @@ use in place of \"-ls\" as the final argument." (car find-ls-option)))) ;; Start the find process. (shell-command (concat args "&") (current-buffer)) - ;; The next statement will bomb in classic dired (no optional arg allowed) (dired-mode dir (cdr find-ls-option)) (let ((map (make-sparse-keymap))) (set-keymap-parent map (current-local-map)) @@ -247,8 +249,8 @@ use in place of \"-ls\" as the final argument." (dired-insert-set-properties point (point))) (setq buffer-read-only t) (let ((proc (get-buffer-process (current-buffer)))) - (set-process-filter proc (function find-dired-filter)) - (set-process-sentinel proc (function find-dired-sentinel)) + (set-process-filter proc #'find-dired-filter) + (set-process-sentinel proc #'find-dired-sentinel) ;; Initialize the process marker; it is used by the filter. (move-marker (process-mark proc) (point) (current-buffer))) (setq mode-line-process '(":%s")))) @@ -258,7 +260,7 @@ use in place of \"-ls\" as the final argument." (interactive) (let ((find (get-buffer-process (current-buffer)))) (and find (eq (process-status find) 'run) - (eq (process-filter find) (function find-dired-filter)) + (eq (process-filter find) #'find-dired-filter) (condition-case nil (delete-process find) (error nil))))) diff --git a/lisp/find-file.el b/lisp/find-file.el index 7e0127da5f2..84d02cb4a26 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -109,8 +109,8 @@ ;; file. ;; CREDITS: -;; Many thanks go to TUSC Computer Systems Pty Ltd for providing an environ- -;; ment that made the development of this package possible. +;; Many thanks go to TUSC Computer Systems Pty Ltd for providing an +;; environment that made the development of this package possible. ;; ;; Many thanks also go to all those who provided valuable feedback throughout ;; the development of this package: diff --git a/lisp/follow.el b/lisp/follow.el index d499da7a8dc..f1d823d9f03 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -113,7 +113,7 @@ ;; whatever you would like to do. These functions are then added to ;; a hook. ;; -;; The keymap `follow-key-map' contains key bindings activated by +;; The keymap `follow-mode-map' contains key bindings activated by ;; `follow-mode'. ;; ;; Example: @@ -356,7 +356,7 @@ property `follow-mode-use-cache' to non-nil.") Used by `follow-window-size-change'.") (defvar follow-windows-start-end-cache nil - "Cache used by `follow-window-start-end'.") + "Cache used by `follow-window-start' and `follow-window-end'.") (defvar follow-fixed-window nil "If non-nil, the current window must not be scrolled. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index c633877e640..e708e69bd59 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -822,7 +822,7 @@ happens, so the major mode can be corrected." ;; `font-lock-keywords-alist'. (when top-cell (dolist (keyword-list-how-pair (cdr top-cell)) - ;; `keywords-list-how-pair' is a cons with a list of + ;; `keyword-list-how-pair' is a cons with a list of ;; keywords in the car top-cell and the original how ;; argument in the cdr top-cell. (setcar keyword-list-how-pair diff --git a/lisp/forms.el b/lisp/forms.el index 83daabdcd6e..8974f99ef57 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -168,10 +168,9 @@ ;; modified (using text-property `read-only'). ;; Also, the read-write fields are shown using a ;; distinct face, if possible. -;; As of emacs 19.29, the `intangible' text property -;; is used to prevent moving into read-only fields. -;; This variable defaults to t if running Emacs 19 or -;; later with text properties. +;; The `intangible' text property is used to +;; prevent moving into read-only fields. +;; This variable defaults to t. ;; The default face to show read-write fields is ;; copied from face `region'. ;; @@ -286,7 +285,7 @@ ;; record. ;; ;; `write-file-functions' is defined to save the actual data file -;; instead of the buffer data, `revert-file-hook' is defined to +;; instead of the buffer data, `revert-buffer-function' is defined to ;; revert a forms to original. ;;; Code: @@ -363,8 +362,7 @@ This variable is for use by the filter routines only. The contents may NOT be modified.") (defcustom forms-use-text-properties t - "Non-nil means: use text properties. -Defaults to t if this Emacs is capable of handling text properties." + "Non-nil means to use text properties. " :group 'forms :type 'boolean) diff --git a/lisp/frame.el b/lisp/frame.el index 70088545a68..772ba3d8c47 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1244,13 +1244,10 @@ face specs for the new background mode." ;; during startup with -rv on the command ;; line for the initial frame, because frames ;; are not recorded in the pdump file. - (assq face (frame-face-alist)) + (assq face (frame-face-alist frame)) (face-spec-match-p face (face-user-default-spec face) - ;; FIXME: why selected-frame and - ;; not the frame that is the - ;; argument to this function? - (selected-frame)))) + frame))) (push face locally-modified-faces))) ;; Now change to the new frame parameters (modify-frame-parameters frame params) @@ -1412,12 +1409,12 @@ as though the font-related attributes of the `default' face had been \"set in this session\", so that the font is applied to future frames." (interactive (let* ((completion-ignore-case t) - (font (completing-read "Font name: " + (default (frame-parameter nil 'font)) + (font (completing-read (format-prompt "Font name" default) ;; x-list-fonts will fail with an error ;; if this frame doesn't support fonts. (x-list-fonts "*" nil (selected-frame)) - nil nil nil nil - (frame-parameter nil 'font)))) + nil nil nil nil default))) (list font current-prefix-arg nil))) (when (or (stringp font) (fontp font)) (let* ((this-frame (selected-frame)) @@ -1581,8 +1578,9 @@ When called interactively, prompt for the name of the frame. On text terminals, the frame name is displayed on the mode line. On graphical displays, it is displayed on the frame's title bar." (interactive - (list (read-string "Frame name: " nil nil - (cdr (assq 'name (frame-parameters)))))) + (let ((default (cdr (assq 'name (frame-parameters))))) + (list (read-string (format-prompt "Frame name" default) nil nil + default)))) (modify-frame-parameters (selected-frame) (list (cons 'name name)))) @@ -1936,7 +1934,7 @@ for FRAME." ;; features change, it will be easy to find all the tests for such ;; capabilities by a simple text search. See more about the history ;; and the intent of these functions in -;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html +;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html ;; or in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35058#17. (declare-function msdos-mouse-p "dosfns.c") diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 2f5dd22930e..533ceb84bf1 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -3378,7 +3378,7 @@ * gnus-async.el (gnus-asynchronous): Move defcustom of gnus-asynchronous away from defgroup of gnus-asynchronous. - This seems to fix an intermittant error in which loading gnus-async + This seems to fix an intermittent error in which loading gnus-async fails to define gnus-asynchronous (the variable). * gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is @@ -7096,7 +7096,7 @@ * nnimap.el (nnimap-callback-callback-function): (nnimap-callback-buffer): Remove, these cannot be global but must be embedded into the callback. - (nnimap-make-callback): New. Embedd article number, callback and + (nnimap-make-callback): New. Embed article number, callback and buffer in function. (nnimap-callback, nnimap-request-article-part): Update. @@ -8031,7 +8031,7 @@ (message-xpost-fup2-header, message-xpost-insert-note) (message-xpost-fup2, message-reduce-to-to-cc): New functions adopted from message-utils.el. Add functions to the keymap, mode - describtion and menu. + description and menu. (message-change-subject, message-xpost-fup2): Signal error if current header is empty. (message-xpost-insert-note): Change insert position. @@ -8612,7 +8612,7 @@ 2002-06-11 Simon Josefsson <jas@extundo.com> * gnus-int.el (gnus-request-move-article): Agent expire article if - successfuly moved. + successfully moved. 2002-06-11 Niklas Morberg <niklas.morberg@axis.com> @@ -9073,7 +9073,7 @@ 2002-04-13 Josh Huber <huber@alum.wpi.edu> - * mml-sec.el (mml-secure-message): Change to support arbritrary + * mml-sec.el (mml-secure-message): Change to support arbitrary modes. * mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)): changed to support "signencrypt" mode. diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index 70eaeb510ac..582c9bd10b7 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -170,7 +170,7 @@ 2015-02-09 Lars Ingebrigtsen <larsi@gnus.org> * mm-decode.el (mm-convert-shr-links): Don't overwrite the faces from - shr, beacause that breaks folding. + shr, because that breaks folding. (mm-shr): Don't shorten the width when using fonts. 2015-02-05 Teodor Zlatanov <tzz@lifelogs.com> @@ -596,7 +596,7 @@ 2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (gnus-article-edit-part): Don't modifiy markers. + * gnus-art.el (gnus-article-edit-part): Don't modify markers. (gnus-article-read-summary-keys): Don't bug out when there is no article in the summary buffer. (gnus-mime-buttonize-attachments-in-header): @@ -1318,7 +1318,7 @@ 2013-08-06 Jan Tatarik <jan.tatarik@gmail.com> * gnus-icalendar.el (gnus-icalendar-event-from-ical): Replace pcase - with cond for backwards compatability. + with cond for backwards compatibility. 2013-08-06 Katsumi Yamaoka <yamaoka@jpl.org> @@ -2221,7 +2221,7 @@ 2013-04-04 Katsumi Yamaoka <yamaoka@jpl.org> - * mml.el (mml-minibuffer-read-description): Use `default' insted of + * mml.el (mml-minibuffer-read-description): Use `default' instead of `initial-input' for the argument name. Suggested by Stefan Monnier <monnier@iro.umontreal.ca>. @@ -5541,7 +5541,7 @@ (registry-prune-hard): Use it. * gnus-registry.el (gnus-registry-fixup-registry): Set prune-factor to - 0.1 expicitly. + 0.1 explicitly. 2011-05-13 Glenn Morris <rgm@gnu.org> @@ -8758,7 +8758,7 @@ * shr.el (shr-generic): The text nodes should be text, not :text. - * nnir.el (nnir-search-engine): Ressurect variable, since it's used + * nnir.el (nnir-search-engine): Resurrect variable, since it's used later in the file. 2010-10-30 Andrew Cohen <cohen@andy.bu.edu> @@ -9481,7 +9481,7 @@ nil. * gnus-start.el (gnus-get-unread-articles): Require gnus-agent before - bidning gnus-agent variables. + binding gnus-agent variables. * shr.el (shr-render-td): Use a cache for the table rendering function to avoid getting an exponential rendering behavior in nested tables. @@ -11849,7 +11849,7 @@ 2010-08-13 Teodor Zlatanov <tzz@lifelogs.com> - Doc fixes and keep unknown groups (ammended for nunion bug fix). + Doc fixes and keep unknown groups (amended for nunion bug fix). * gnus-sync.el: Fix docs. (gnus-sync-save): Keep unknown groups in `gnus-sync-newsrc-loader'. @@ -18925,7 +18925,7 @@ * message.el: Autoload gmm-image-load-path. (message-tool-bar-retro): Prepend "gnus/" subdirectory to some icon file names. Use old Emacs 21 "mail_send.xpm" icon for - consitency. + consistency. * gmm-utils.el (gmm-image-load-path): Also search in "../etc/images". Don't set gmm-image-load-path if we don't find @@ -19523,7 +19523,7 @@ * nnml.el: Don't require gnus-bcklg. Autoload it. (nnml-use-compressed-files, nnml-save-mail): Support other - comression programs such as bzip2. + compression programs such as bzip2. 2005-12-17 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -21227,7 +21227,7 @@ (nntp-with-open-group): Allow debugging. * nnheader.el (mail-header-set-extra): Make into a function - because I just could't understand how to quote the list properly. + because I just couldn't understand how to quote the list properly. * dns.el (query-dns-cached): New function. @@ -24966,7 +24966,7 @@ functions as needing (default), or not needing, gnus-convert-old-newsrc's "backup before upgrading warning". (gnus-convert-converter-needs-prompt): Tests whether the user - should be protected from potentially irreversable changes by the + should be protected from potentially irreversible changes by the function. * legacy-gnus-agent.el: New. Provides converters that are only diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 03e447e072a..6a7e81b3e91 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1304,7 +1304,7 @@ downloaded into the agent." ;; gnus doesn't waste resources trying to fetch them. ;; NOTE: I don't do this for smaller gaps (< 100) as I don't - ;; want to modify the local file everytime someone restarts + ;; want to modify the local file every time someone restarts ;; gnus. The small gap will cause a tiny performance hit ;; when gnus tries, and fails, to retrieve the articles. ;; Still that should be smaller than opening a buffer, diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index e0339cc1f32..1efc1d6f7d9 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -274,6 +274,7 @@ This can also be a list of the above values." If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." :type '(choice string + (const :tag "None" nil) (function-item gnus-display-x-face-in-from) function) :version "27.1" @@ -534,6 +535,13 @@ that the symbol of the saver function, which is specified by :group 'gnus-article-saving :type 'regexp) +(defcustom gnus-global-groups nil + "Groups that should be considered like \"news\" groups. +This means that images will be automatically loaded, for instance." + :type '(repeat string) + :version "28.1" + :group 'gnus-article) + ;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before. (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail "A function to save articles in your favorite format. @@ -2161,7 +2169,9 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (interactive) (save-excursion (when (article-goto-body) - (let ((inhibit-read-only t)) + (require 'ansi-color) + (let ((inhibit-read-only t) + (ansi-color-context-region nil)) (ansi-color-apply-on-region (point) (point-max)))))) (defun gnus-article-treat-unfold-headers () @@ -7086,6 +7096,7 @@ If given a prefix, show the hidden text instead." (gnus-backlog-enter-article group article (current-buffer))) (when (and gnus-agent + gnus-agent-eagerly-store-articles (gnus-agent-group-covered-p group)) (gnus-agent-store-article article group))) (setq result 'article)) @@ -7141,7 +7152,8 @@ If given a prefix, show the hidden text instead." "Allows images in newsgroups to be shown, blocks images in all other groups." (if (or (gnus-news-group-p group) - (gnus-member-of-valid 'global group)) + (gnus-member-of-valid 'global group) + (member group gnus-global-groups)) ;; Block nothing in news groups. nil ;; Block everything anywhere else. diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index e3e81c8bbce..9b08e6a0ef8 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -227,6 +227,7 @@ that was fetched." (narrow-to-region mark (point-max)) ;; Put the articles into the agent, if they aren't already. (when (and gnus-agent + gnus-agent-eagerly-store-articles (gnus-agent-group-covered-p group)) (save-restriction (narrow-to-region mark (point-max)) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 7ca3bf1ce1c..c31d97d41cd 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -93,6 +93,8 @@ it's not cached." (autoload 'nnml-generate-nov-databases-directory "nnml") (autoload 'nnvirtual-find-group-art "nnvirtual") +(autoload 'nnselect-article-group "nnselect") +(autoload 'nnselect-article-number "nnselect") @@ -158,8 +160,12 @@ it's not cached." (file-name-coding-system nnmail-pathname-coding-system)) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) + (let ((result (if (gnus-nnselect-group-p group) + (with-current-buffer gnus-summary-buffer + (cons (nnselect-article-group article) + (nnselect-article-number article))) + (nnvirtual-find-group-art + (gnus-group-real-name group) article)))) (setq group (car result) number (cdr result)))) (when (and number @@ -232,8 +238,14 @@ it's not cached." (let ((arts gnus-cache-removable-articles) ga) (while arts - (when (setq ga (nnvirtual-find-group-art - (gnus-group-real-name gnus-newsgroup-name) (pop arts))) + (when (setq ga + (if (gnus-nnselect-group-p gnus-newsgroup-name) + (with-current-buffer gnus-summary-buffer + (let ((article (pop arts))) + (cons (nnselect-article-group article) + (nnselect-article-number article)))) + (nnvirtual-find-group-art + (gnus-group-real-name gnus-newsgroup-name) (pop arts)))) (let ((gnus-cache-removable-articles (list (cdr ga))) (gnus-newsgroup-name (car ga))) (gnus-cache-possibly-remove-articles-1))))) @@ -467,8 +479,12 @@ Returns the list of articles removed." (file-name-coding-system nnmail-pathname-coding-system)) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) + (let ((result (if (gnus-nnselect-group-p group) + (with-current-buffer gnus-summary-buffer + (cons (nnselect-article-group article) + (nnselect-article-number article))) + (nnvirtual-find-group-art + (gnus-group-real-name group) article)))) (setq group (car result) number (cdr result)))) (setq file (gnus-cache-file-name group number)) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index c95449762e4..3218649761a 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -205,11 +205,12 @@ different input formats." (defun gnus-convert-face-to-png (face) "Convert FACE (which is base64-encoded) to a PNG. The PNG is returned as a string." - (mm-with-unibyte-buffer - (insert face) - (ignore-errors - (base64-decode-region (point-min) (point-max))) - (buffer-string))) + (let ((face (gnus-base64-repad face nil nil t))) + (mm-with-unibyte-buffer + (insert face) + (ignore-errors + (base64-decode-region (point-min) (point-max))) + (buffer-string)))) ;;;###autoload (defun gnus-convert-png-to-face (file) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index a90243b8b6c..1d614f8a8d4 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3166,27 +3166,67 @@ mail messages or news articles in files that have numeric names." (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(autoload 'nnir-make-specs "nnir") +(autoload 'nnir-read-parms "nnir") +(autoload 'nnir-server-to-search-engine "nnir") (autoload 'gnus-group-topic-name "gnus-topic") ;; Temporary to make group creation easier (defun gnus-group-make-search-group (nnir-extra-parms &optional specs) + "Make a group based on a search. +Prompt for a search query and determine the groups to search as +follows: if called from the *Server* buffer search all groups +belonging to the server on the current line; if called from the +*Group* buffer search any marked groups, or the group on the +current line, or all the groups under the current topic. Calling +with a prefix arg prompts for additional search-engine specific +constraints. A non-nil SPECS arg must be an alist with +`nnir-query-spec' and `nnir-group-spec' keys, and skips all +prompting." (interactive "P") (let ((name (gnus-read-group "Group name: "))) (with-current-buffer gnus-group-buffer - (gnus-group-make-group - name - (list 'nnselect "nnselect") - nil - (list - (cons 'nnselect-specs - (list - (cons 'nnselect-function 'nnir-run-query) - (cons 'nnselect-args - (nnir-make-specs nnir-extra-parms specs))))))))) + (let* ((group-spec + (or + (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (seq-group-by + (lambda (elt) (gnus-group-server elt)) + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr + (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) + (query-spec + (or + (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) + (gnus-group-make-group + name + (list 'nnselect "nnselect") + nil + (list + (cons 'nnselect-specs + (list + (cons 'nnselect-function 'nnir-run-query) + (cons 'nnselect-args + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + (cons 'nnselect-artlist nil))))))) + +(define-obsolete-function-alias 'gnus-group-make-nnir-group + 'gnus-group-read-ephemeral-search-group "28.1") (defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs) - "Create an nnselect group based on a search. + "Read an nnselect group based on a search. Prompt for a search query and determine the groups to search as follows: if called from the *Server* buffer search all groups belonging to the server on the current line; if called from the @@ -3197,19 +3237,42 @@ constraints. A non-nil SPECS arg must be an alist with `nnir-query-spec' and `nnir-group-spec' keys, and skips all prompting." (interactive "P") - (gnus-group-read-ephemeral-group - (concat "nnselect-" (message-unique-id)) - (list 'nnselect "nnselect") - nil - (cons (current-buffer) gnus-current-window-configuration) - nil nil - (list - (cons 'nnselect-specs - (list - (cons 'nnselect-function 'nnir-run-query) - (cons 'nnselect-args - (nnir-make-specs nnir-extra-parms specs)))) - (cons 'nnselect-artlist nil)))) + (let* ((group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (seq-group-by + (lambda (elt) (gnus-group-server elt)) + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr + (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) + (query-spec + (or (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) + (gnus-group-read-ephemeral-group + (concat "nnselect-" (message-unique-id)) + (list 'nnselect "nnselect") + nil + (cons (current-buffer) gnus-current-window-configuration) + nil nil + (list + (cons 'nnselect-specs + (list + (cons 'nnselect-function 'nnir-run-query) + (cons 'nnselect-args + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + (cons 'nnselect-artlist nil))))) (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index f624b9d032f..389bce85e8b 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -134,11 +134,11 @@ (cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) "Return recurring interval of EVENT." (let ((rrule (gnus-icalendar-event:recur event)) - (default-interval 1)) + (default-interval "1")) - (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) - (or (match-string 1 rrule) - default-interval))) + (if (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) + (match-string 1 rrule) + default-interval))) (cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event)) "Return, when available, the week day numbers on which the EVENT recurs." @@ -180,8 +180,10 @@ (or (member (attendee-name prop) name-or-email) (let ((att-email (attendee-email prop))) (gnus-icalendar-find-if - (lambda (email) - (string-match email att-email)) + (lambda (str-or-fun) + (if (functionp str-or-fun) + (funcall str-or-fun att-email) + (string-match str-or-fun att-email))) name-or-email)))))) (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) @@ -262,7 +264,14 @@ (map-property ical-property)) args))))) (mapc #'accumulate-args prop-map) - (apply #'make-instance event-class args)))) + (apply + #'make-instance + event-class + (cl-loop for slot in (eieio-class-slots event-class) + for keyword = (intern + (format ":%s" (eieio-slot-descriptor-name slot))) + when (plist-member args keyword) + append (list keyword (plist-get args keyword))))))) (defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) "Parse RFC5545 iCalendar in buffer BUF and return an event object. @@ -763,9 +772,8 @@ These will be used to retrieve the RSVP information from ical events." (lambda (x) (if (listp x) x (list x))) (list user-full-name (regexp-quote user-mail-address) ;; NOTE: these can be lists - gnus-ignored-from-addresses ; already regexp-quoted - (unless (functionp message-alternative-emails) ; String or function. - message-alternative-emails) + gnus-ignored-from-addresses ; String or function. + message-alternative-emails ; String or function. (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) ;; TODO: make the template customizable diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index da385a18023..b8be766c84f 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -365,6 +365,48 @@ If it is down, start it up (again)." (funcall (gnus-get-function gnus-command-method 'request-list) (nth 1 gnus-command-method))) +(defun gnus-server-get-active (server &optional ignored) + "Return the active list for SERVER. +Groups matching the IGNORED regexp are excluded." + (let ((method (gnus-server-to-method server)) + groups) + (gnus-request-list method) + (with-current-buffer nntp-server-buffer + (let ((cur (current-buffer))) + (goto-char (point-min)) + (unless (or (null ignored) + (string= ignored "")) + (delete-matching-lines ignored)) + (if (eq (car method) 'nntp) + (while (not (eobp)) + (ignore-errors + (push (gnus-group-full-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) + method) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (if (eq (char-after) ?\") + (gnus-group-full-name (read cur) method) + (let ((p (point)) (name "")) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + (gnus-group-full-name name method))) + groups)) + (forward-line))))) + groups)) + (defun gnus-finish-retrieve-group-infos (gnus-command-method infos data) "Read and update infos from GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 7bc7fb5be41..465871eafbd 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1352,8 +1352,10 @@ For the \"inline\" alternatives, also see the variable gcc))) (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))))))) -(defun gnus-summary-resend-message (address n) - "Resend the current article to ADDRESS." +(defun gnus-summary-resend-message (address n &optional no-select) + "Resend the current article to ADDRESS. +Uses the process/prefix convention. If NO-SELECT, don't display +the message before resending." (interactive (list (message-read-from-minibuffer "Resend message(s) to: " @@ -1372,6 +1374,7 @@ For the \"inline\" alternatives, also see the variable 'posting-style t)) (user-full-name user-full-name) (user-mail-address user-mail-address) + (group gnus-newsgroup-name) tem) (dolist (style styles) (when (stringp (cadr style)) @@ -1395,11 +1398,18 @@ For the \"inline\" alternatives, also see the variable '(gnus-agent-possibly-do-gcc) '(gnus-inews-do-gcc))))) (dolist (article (gnus-summary-work-articles n)) - (gnus-summary-select-article nil nil nil article) - (with-current-buffer gnus-original-article-buffer - (let ((gnus-gcc-externalize-attachments nil) - (message-inhibit-body-encoding t)) - (message-resend address))) + (if no-select + (with-current-buffer " *nntpd*" + (erase-buffer) + (gnus-request-article article group) + (let ((gnus-gcc-externalize-attachments nil) + (message-inhibit-body-encoding t)) + (message-resend address))) + (gnus-summary-select-article nil nil nil article) + (with-current-buffer gnus-original-article-buffer + (let ((gnus-gcc-externalize-attachments nil) + (message-inhibit-body-encoding t)) + (message-resend address)))) (gnus-summary-mark-article-as-forwarded article)))) ;; From: Matthieu Moy <Matthieu.Moy@imag.fr> diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 46b70eaf275..2e3abe7832d 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -25,8 +25,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-sum) (require 'gnus-art) @@ -35,6 +33,7 @@ (require 'message) (require 'score-mode) (require 'gmm-utils) +(require 'cl-lib) (defcustom gnus-global-score-files nil "List of global score files and directories. @@ -497,6 +496,7 @@ of the last successful match.") ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) + (score-fn -1 nil) ("followup" 2 gnus-score-followup) ("thread" 5 gnus-score-thread))) @@ -862,6 +862,18 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (setq match (string-to-number match))) (set-text-properties 0 (length match) nil match)) + ;; Modify match and type for article age scoring. + (if (string= "date" (nth 0 (assoc header gnus-header-index))) + (let ((age (string-to-number match))) + (if (or (< age 0) + (string= "0" match)) + (user-error "Article age must be a positive number")) + (setq match age + type (cond ((eq type 'after) + '<) + ((eq type 'before) + '>))))) + (unless (eq date 'now) ;; Add the score entry to the score file. (when (= score gnus-score-interactive-default-score) @@ -1163,14 +1175,19 @@ If FORMAT, also format the current score file." (when format (gnus-score-pretty-print)) (when (consp rule) ;; the rule exists - (setq rule (mapconcat #'(lambda (obj) - (regexp-quote (format "%S" obj))) - rule - sep)) + (setq rule (if (symbolp (car rule)) + (format "(%S)" (car rule)) + (mapconcat #'(lambda (obj) + (regexp-quote (format "%S" obj))) + rule + sep))) (goto-char (point-min)) - (re-search-forward rule nil t) - ;; make it easy to use `kill-sexp': - (goto-char (1- (match-beginning 0))))))) + (let ((move (if (string-match "(.*)" rule) + 0 + -1))) + (re-search-forward rule nil t) + ;; make it easy to use `kill-sexp': + (goto-char (+ move (match-beginning 0)))))))) (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. @@ -1220,6 +1237,7 @@ If FORMAT, also format the current score file." (let ((mark (car (gnus-score-get 'mark alist))) (expunge (car (gnus-score-get 'expunge alist))) (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) + (score-fn (car (gnus-score-get 'score-fn alist))) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) (orphan (car (gnus-score-get 'orphan alist))) @@ -1370,9 +1388,12 @@ If FORMAT, also format the current score file." (setq err (cond - ((if (member (downcase type) '("lines" "chars")) - (not (numberp (car s))) - (not (stringp (car s)))) + ((cond ((member (downcase type) '("lines" "chars")) + (not (numberp (car s)))) + ((string= (downcase type) "date") + (not (or (numberp (car s)) + (stringp (car s))))) + (t (not (stringp (car s))))) (format "Invalid match %s in %s" (car s) file)) ((and (cadr s) (not (integerp (cadr s)))) (format "Non-integer score %s in %s" (cadr s) file)) @@ -1552,10 +1573,14 @@ If FORMAT, also format the current score file." (gnus-message 7 "Scoring on headers or body skipped.") nil) + ;; Run score-fn + (if (eq header 'score-fn) + (setq new (gnus-score-func scores trace)) ;; Call the scoring function for this type of "header". (setq new (funcall (nth 2 entry) scores header - now expire trace))) + now expire trace)))) (push new news)))) + (when (gnus-buffer-live-p gnus-summary-buffer) (let ((scored gnus-newsgroup-scored)) (with-current-buffer gnus-summary-buffer @@ -1621,6 +1646,30 @@ score in `gnus-newsgroup-scored' by SCORE." (not (string= id ""))) (gnus-score-lower-thread thread score))))) +(defun gnus-score-func (scores &optional trace) + (dolist (alist scores) + (let ((articles gnus-scores-articles) + (entries (assoc 'score-fn alist))) + (dolist (score-fn (cdr entries)) + (let ((score-fn (car score-fn)) + article-alist score fn-score) + (dolist (art articles) + (setq article-alist + (cl-pairlis + '(number subject from date id + refs chars lines xref extra) + (car art)) + score (cdr art)) + (when (integerp (setq fn-score (funcall score-fn + article-alist score))) + (setcdr art (+ score fn-score))) + (setq score (cdr art)) + (when (and trace + (integerp fn-score)) + (push (cons (car-safe (rassq alist gnus-score-cache)) + (list score-fn fn-score)) + gnus-score-trace)))))))) + (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) entries alist) @@ -1690,9 +1739,21 @@ score in `gnus-newsgroup-scored' by SCORE." ((eq type 'after) (setq match-func 'string< match (gnus-date-iso8601 (nth 0 kill)))) + ((eq type '<) + (setq type 'after + match-func 'string< + match (gnus-time-iso8601 + (time-subtract (current-time) + (* 86400 (nth 0 kill)))))) ((eq type 'before) (setq match-func 'gnus-string> match (gnus-date-iso8601 (nth 0 kill)))) + ((eq type '>) + (setq type 'before + match-func 'gnus-string> + match (gnus-time-iso8601 + (time-subtract (current-time) + (* 86400 (nth 0 kill)))))) ((eq type 'at) (setq match-func 'string= match (gnus-date-iso8601 (nth 0 kill)))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index e4f05de5f8e..615f8dfa877 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -72,7 +72,7 @@ uses considerably less memory." (const :tag "Write directly to file" nil))) (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") - "Your Gnus Emacs-Lisp startup file name. + "Your Gnus Emacs Lisp startup file name. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." :group 'gnus-start :type 'file) @@ -83,7 +83,7 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead." (directory-file-name installation-directory)) "site-lisp/gnus-init") (error nil)) - "The site-wide Gnus Emacs-Lisp startup file name, or nil if none. + "The site-wide Gnus Emacs Lisp startup file name, or nil if none. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." :group 'gnus-start :type '(choice file (const nil))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index dc4f1c6a386..561f199531e 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -87,6 +87,7 @@ (autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t) (autoload 'nnselect-article-rsv "nnselect" nil nil) (autoload 'nnselect-article-group "nnselect" nil nil) +(autoload 'gnus-nnselect-group-p "nnselect" nil nil) (defcustom gnus-kill-summary-on-exit t "If non-nil, kill the summary buffer when you exit from it. @@ -144,11 +145,14 @@ If t, fetch all the available old headers." :type '(choice number (sexp :menu-tag "other" t))) +(define-obsolete-variable-alias 'gnus-refer-thread-use-nnir + 'gnus-refer-thread-use-search "28.1") + (defcustom gnus-refer-thread-use-search nil "Search an entire server when referring threads. A nil value will only search for thread-related articles in the current group." - :version "24.1" + :version "28.1" :group 'gnus-thread :type 'boolean) @@ -1986,6 +1990,7 @@ increase the score of each group you read." "\M-K" gnus-summary-edit-global-kill ;; "V" gnus-version "\C-c\C-d" gnus-summary-describe-group + "\C-c\C-p" gnus-summary-make-group-from-search "q" gnus-summary-exit "Q" gnus-summary-exit-no-update "\C-c\C-i" gnus-info-find-node @@ -6235,8 +6240,8 @@ If WHERE is `summary', the summary mode line format will be used." ;; We might have to chop a bit of the string off... (when (> (length mode-string) max-len) (setq mode-string - (concat (truncate-string-to-width mode-string (- max-len 3)) - "..."))))) + (truncate-string-to-width + mode-string (- max-len 3) nil nil t))))) ;; Update the mode line. (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) @@ -7117,6 +7122,21 @@ The prefix argument ALL means to select all articles." (setq info (copy-sequence (gnus-get-info group)) info (delq (gnus-info-params info) info)))))))))) +(defun gnus-summary-make-group-from-search () + "Make a persistent group from the current ephemeral search group." + (interactive) + (if (not (gnus-nnselect-group-p gnus-newsgroup-name)) + (gnus-message 3 "%s is not a search group" gnus-newsgroup-name) + (let ((name (gnus-read-group "Group name: "))) + (with-current-buffer gnus-group-buffer + (gnus-group-make-group + name + (list 'nnselect "nnselect") + nil + (list (cons 'nnselect-specs + (gnus-group-get-parameter gnus-newsgroup-name + 'nnselect-specs t)))))))) + (defun gnus-summary-save-newsrc (&optional force) "Save the current number of read/marked articles in the dribble buffer. The dribble buffer will then be saved. @@ -10688,6 +10708,7 @@ groups." ;; We only have to update this line. (save-excursion (save-restriction + (nnheader-ms-strip-cr) (message-narrow-to-head) (let ((head (buffer-substring-no-properties (point-min) (point-max))) @@ -11516,7 +11537,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (gnus-save-hidden-threads (let ((beg (point))) ;; We check that there are unread articles. - (when (or all (gnus-summary-find-next)) + (when (or all (gnus-summary-last-article-p) (gnus-summary-find-next)) (gnus-summary-catchup all t beg nil t))))) (gnus-summary-position-point)) @@ -11785,8 +11806,6 @@ will not be hidden." (defun gnus-summary-hide-thread () "Hide thread subtrees. -If PREDICATE is supplied, threads that satisfy this predicate -will not be hidden. Returns nil if no threads were there to be hidden." (interactive) (beginning-of-line) @@ -11807,9 +11826,9 @@ Returns nil if no threads were there to be hidden." (overlay-put ol 'invisible 'gnus-sum) (overlay-put ol 'evaporate t))) (gnus-summary-goto-subject article) + ;; We moved backward past the start point (invisible thread?) (when (> start (point)) - (message "Hiding the thread moved us backwards, aborting!") - (goto-char (point-max)))) + (goto-char starteol))) (goto-char start) nil)))) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index ffd26bb30f4..c913002f70b 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -897,9 +897,7 @@ articles in the topic and its subtopics." (let ((inhibit-read-only t)) (unless gnus-topic-inhibit-change-level (gnus-group-goto-group (or (car (nth 1 previous)) group)) - (when (and gnus-topic-mode - gnus-topic-alist - (not gnus-topic-inhibit-change-level)) + (when (and gnus-topic-mode gnus-topic-alist (gnus-current-topic)) ;; Remove the group from the topics. (if (and (< oldlevel gnus-level-zombie) (>= level gnus-level-zombie)) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 4876715ae6a..ef811c65b86 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1013,6 +1013,12 @@ FILENAME exists and is Babyl format." (rmail-swap-buffers-maybe) (rmail-maybe-set-message-counters)) (widen) + (unless babyl + (goto-char (point-max)) + ;; Ensure we have a blank line before the next message. + (unless (bolp) + (insert "\n")) + (insert "\n")) (narrow-to-region (point-max) (point-max))) (insert-buffer-substring tmpbuf) (when msg @@ -1177,7 +1183,7 @@ ARG is passed to the first function." (maphash (lambda (group active) (when active - (insert (format "%s %d %d y\n" + (insert (format "%S %d %d y\n" (if full-names group (gnus-group-real-name group)) @@ -1343,6 +1349,61 @@ forbidden in URL encoding." (setq tmp (concat tmp str)) tmp)) +(defun gnus-base64-repad (str &optional reject-newlines line-length no-check) + "Take a base 64-encoded string and return it padded correctly. +Existing padding is ignored. + +If any combination of CR and LF characters are present and +REJECT-NEWLINES is nil, remove them; otherwise raise an error. +If LINE-LENGTH is set and the string (or any line in the string +if REJECT-NEWLINES is nil) is longer than that number, raise an +error. Common line length for input characters are 76 plus CRLF +(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including +CRLF (RFC 5321 SMTP). + +If NOCHECK, don't check anything, but just repad." + ;; RFC 4648 specifies that: + ;; - three 8-bit inputs make up a 24-bit group + ;; - the 24-bit group is broken up into four 6-bit values + ;; - each 6-bit value is mapped to one character of the base 64 alphabet + ;; - if the final 24-bit quantum is filled with only 8 bits the output + ;; will be two base 64 characters followed by two "=" padding characters + ;; - if the final 24-bit quantum is filled with only 16 bits the output + ;; will be three base 64 character followed by one "=" padding character + ;; + ;; RFC 4648 section 3 considerations: + ;; - if reject-newlines is nil (default), concatenate multi-line + ;; input (3.1, 3.3) + ;; - if line-length is set, error on input exceeding the limit (3.1) + ;; - reject characters outside base encoding (3.3, also section 12) + ;; + ;; RFC 5322 section 2.2.3 consideration: + ;; Because base 64-encoded strings can appear in long header fields, remove + ;; folding whitespace while still observing the RFC 4648 decisions above. + (when no-check + (setq str (replace-regexp-in-string "[\n\r \t]+" "" str))); + (let ((splitstr (split-string str "[ \t]*[\r\n]+[ \t]?" t))) + (when (and reject-newlines (> (length splitstr) 1)) + (error "Invalid Base64 string")) + (dolist (substr splitstr) + (when (and line-length (> (length substr) line-length)) + (error "Base64 string exceeds line-length")) + (when (string-match "[^A-Za-z0-9+/=]" substr) + (error "Invalid Base64 string"))) + (let* ((str (string-join splitstr)) + (len (length str))) + (when (string-match "=" str) + (setq len (match-beginning 0))) + (concat + (substring str 0 len) + (make-string (/ + (- 24 + (pcase (mod (* len 6) 24) + (`0 24) + (n n))) + 6) + ?=))))) + (defun gnus-make-predicate (spec) "Transform SPEC into a function that can be called. SPEC is a predicate specifier that contains stuff like `or', `and', @@ -1377,7 +1438,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (autoload 'ido-completing-read "ido") (defun gnus-ido-completing-read (prompt collection &optional require-match initial-input history def) - "Call `ido-completing-read-function'." + "Call `ido-completing-read'." (ido-completing-read prompt collection nil require-match initial-input history def)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 8cd35e3d7b7..c1cfddc87b3 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2285,6 +2285,14 @@ a string, be sure to use a valid format, see RFC 2616." (gnus-message 1 "Edit your init file to make this change permanent.") (sit-for 2))) +(defcustom gnus-agent-eagerly-store-articles t + "If non-nil, cache articles eagerly. + +When using the Gnus Agent and reading an agentized newsgroup, +automatically cache the article in the agent cache." + :type 'boolean + :version "28.1") + ;;; Internal variables @@ -3628,11 +3636,12 @@ If you call this function inside a loop, consider using the faster (defun gnus-group-get-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters. -If ALLOW-LIST, also allow list as a result. -Most functions should use `gnus-group-find-parameter', which -also examines the topic parameters." - (let ((params (gnus-info-params (gnus-get-info group)))) +If SYMBOL, return the value of that symbol in the group +parameters. If ALLOW-LIST, also allow list as a result. Most +functions should use `gnus-group-find-parameter', which also +examines the topic parameters. GROUP can also be an info structure." + (let ((params (gnus-info-params (if (listp group) group + (gnus-get-info group))))) (if symbol (gnus-group-parameter-value params symbol allow-list) params))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index e10322417d8..0782778fd43 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -307,7 +307,7 @@ any confusion." "Command to take a screenshot. The command should insert a PNG in the current buffer." :group 'message-various - :type '(list string) + :type '(repeat string) :version "28.1") ;;; Start of variables adopted from `message-utils.el'. @@ -1106,7 +1106,8 @@ point and mark around the citation text as modified." If nil, don't insert a signature. If t, insert `message-signature-file'. If a function or form, insert its result. -See `mail-signature' for the recommended format of a signature." +See `mail-signature' for the recommended format of a signature. +Also see `message-signature-insert-empty-line'." :version "23.2" :type '(choice string (const :tag "None" nil) @@ -2787,9 +2788,7 @@ Consider adding this function to `message-header-setup-hook'" ;; add URL (when (nth 1 message-openpgp-header) (when need-sep (insert "; ")) - (if (string-match-p ";") - (insert "url=\"" (nth 1 message-openpgp-header) "\"") - (insert "url=\"" (nth 1 message-openpgp-header) "\"")) + (insert "url=\"" (nth 1 message-openpgp-header) "\"") (setq need-sep t)) ;; add preference (when (nth 2 message-openpgp-header) @@ -3536,8 +3535,8 @@ Prefix arg means justify as well." (equal quoted (match-string 0))) (goto-char (match-end 0)) (looking-at "[ \t]*") - (if (> (length leading-space) (length (match-string 0))) - (setq leading-space (match-string 0))) + (when (< (length leading-space) (length (match-string 0))) + (setq leading-space (match-string 0))) (forward-line 1)) (setq end (point)) (goto-char beg) @@ -3614,7 +3613,14 @@ Message buffers and is not meant to be called directly." (do-auto-fill)))) (defun message-insert-signature (&optional force) - "Insert a signature. See documentation for variable `message-signature'." + "Insert a signature at the end of the buffer. + +See the documentation for the `message-signature' variable for +more information. + +If FORCE is 0 (or when called interactively), the global values +of the signature variables will be consulted if the local ones +are null." (interactive (list 0)) (let ((message-signature message-signature) (message-signature-file message-signature-file)) @@ -4568,7 +4574,8 @@ This function could be useful in `message-setup-hook'." (custom-add-option 'message-setup-hook 'message-check-recipients) (defun message-add-action (action &rest types) - "Add ACTION to be performed when doing an exit of type TYPES." + "Add ACTION to be performed when doing an exit of type TYPES. +Valid types are `send', `return', `exit', `kill' and `postpone'." (while types (add-to-list (intern (format "message-%s-actions" (pop types))) action))) @@ -4843,10 +4850,10 @@ If you always want Gnus to send messages in one piece, set Each line should be no more than 79 characters long." (goto-char (point-min)) (while (not (eobp)) - (when (and (looking-at "[^:]+:") - (> (- (line-end-position) (point)) 79)) - (mail-header-fold-field)) - (forward-line 1))) + (if (and (looking-at "[^:]+:") + (> (- (line-end-position) (point)) 79)) + (goto-char (mail-header-fold-field)) + (forward-line 1)))) (defvar sendmail-program) (defvar smtpmail-smtp-server) @@ -5658,7 +5665,7 @@ The result is a fixnum." (mail-file-babyl-p filename)) ;; gnus-output-to-mail does the wrong thing with live, mbox ;; Rmail buffers in Emacs 23. - ;; http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255 + ;; https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255 (let ((buff (find-buffer-visiting filename))) (and buff (with-current-buffer buff (eq major-mode 'rmail-mode))))) @@ -8099,7 +8106,7 @@ See `gmm-tool-bar-from-list' for the format of the list." (library image &optional path no-error)) (defun message-make-tool-bar (&optional force) - "Make a message mode tool bar from `message-tool-bar-list'. + "Make a message mode tool bar from `message-tool-bar'. When FORCE, rebuild the tool bar." (when (and (boundp 'tool-bar-mode) tool-bar-mode @@ -8590,7 +8597,7 @@ Meant for use on `completion-at-point-functions'." ;; FIXME: What is the most common term (circular letter, form letter, serial ;; letter, standard letter) for such kind of letter? See also -;; <http://en.wikipedia.org/wiki/Form_letter> +;; <https://en.wikipedia.org/wiki/Form_letter> ;; FIXME: Maybe extent message-mode's font-lock support to recognize ;; `message-form-letter-separator', i.e. highlight each message like a single @@ -8854,6 +8861,8 @@ will then start up Emacs ready to compose mail." (provide 'message) +(make-obsolete-variable 'message-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'message-load-hook) ;; Local Variables: diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index a01fd2729af..1bce6ca020e 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1665,12 +1665,14 @@ If RECURSIVE, search recursively." (let ((type (car ctl)) (subtype (cadr (split-string (car ctl) "/"))) (mm-security-handle ctl) ;; (car CTL) is the type. + (smime-type (cdr (assq 'smime-type (mm-handle-type parts)))) protocol func functest) (cond ((or (equal type "application/x-pkcs7-mime") (equal type "application/pkcs7-mime")) (with-temp-buffer (when (and (cond + ((equal smime-type "signed-data") t) ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) ((eq mm-decrypt-option 'known) t) @@ -1691,7 +1693,21 @@ If RECURSIVE, search recursively." (unless (mail-fetch-field "content-type") (goto-char (point-max)) (insert "Content-type: text/plain\n\n"))) - (setq parts (mm-dissect-buffer t))))) + (setq parts + (if (equal smime-type "signed-data") + (list (propertize + "multipart/signed" + 'protocol "application/pkcs7-signature" + 'gnus-info + (format + "%s:%s" + (get-text-property 0 'gnus-info + (car mm-security-handle)) + (get-text-property 0 'gnus-details + (car mm-security-handle)))) + (mm-dissect-buffer t) + parts) + (mm-dissect-buffer t)))))) ((equal subtype "signed") (unless (and (setq protocol (mm-handle-multipart-ctl-parameter ctl 'protocol)) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 282465722de..958e24c39f5 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -70,7 +70,7 @@ (mm-coding-system-p 'cp932)) '((windows-31j . cp932))) ;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936 - ;; http://www.iana.org/assignments/charset-reg/GBK + ;; https://www.iana.org/assignments/charset-reg/GBK ;; Emacs 22.1 has cp936, but not gbk, so we alias it: ,@(when (and (not (mm-coding-system-p 'gbk)) (mm-coding-system-p 'cp936)) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index bd5960c18b2..ca610010917 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -546,7 +546,7 @@ If MODE is not set, try to find mode automatically." (mm-display-inline-fontify handle 'shell-script-mode)) (defun mm-display-javascript-inline (handle) - "Show JavsScript code from HANDLE inline." + "Show JavaScript code from HANDLE inline." (mm-display-inline-fontify handle 'javascript-mode)) ;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) @@ -597,8 +597,16 @@ If MODE is not set, try to find mode automatically." (with-temp-buffer (insert-buffer-substring (mm-handle-buffer handle)) (goto-char (point-min)) - (let ((part (base64-decode-string (buffer-string)))) - (epg-verify-string (epg-make-context 'CMS) part)))) + (let ((part (base64-decode-string (buffer-string))) + (context (epg-make-context 'CMS))) + (prog1 + (epg-verify-string context part) + (let ((result (car (epg-context-result-for context 'verify)))) + (mm-sec-status + 'gnus-info (epg-signature-status result) + 'gnus-details + (format "%s:%s" (epg-signature-validity result) + (epg-signature-key-id result)))))))) (with-temp-buffer (insert "MIME-Version: 1.0\n") (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m") diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 69852c381d6..74af99da7e3 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -938,9 +938,47 @@ If no one is selected, symmetric encryption will be performed. " (signal (car error) (cdr error)))) cipher)) -;; Should probably be removed and the interface should be different. -(defvar mml-secure-allow-signing-with-unknown-recipient nil - "Variable to bind to allow automatic recipient selection.") +(defun mml-secure-sender-sign-query (protocol sender) + "Query whether to use SENDER to sign when using PROTOCOL. +PROTOCOL will be `OpenPGP' or `CMS' (smime). +This can also save the resulting value of +`mml-secure-smime-sign-with-sender' or +`mml-secure-openpgp-sign-with-sender' via Customize. +Returns non-nil if the user has chosen to use SENDER." + (let ((buffer (get-buffer-create "*MML sender signing options*")) + (options '((?a "always" "Sign using this sender now and sign with message sender in future.") + (?s "session only" "Sign using this sender now, and sign with message sender for this session only.") + (?n "no" "Do not sign this message (and error out)"))) + answer done val) + (save-window-excursion + (pop-to-buffer buffer) + (erase-buffer) + (insert (format "No %s signing key was found for this message.\nThe sender of this message is \"%s\".\nWould you like to attempt looking up a signing key based on it?" + (if (eq protocol 'OpenPGP) + "openpgp" "smime") + sender)) + (while (not done) + (setq answer (read-multiple-choice "Sign this message using the sender?" options)) + (cl-case (car answer) + (?a + (if (eq protocol 'OpenPGP) + (progn + (setq mml-secure-openpgp-sign-with-sender t) + (customize-save-variable + 'mml-secure-openpgp-sign-with-sender t)) + (setq mml-secure-smime-sign-with-sender t) + (customize-save-variable 'mml-secure-smime-sign-with-sender t)) + (setq done t + val t)) + (?s + (if (eq protocol 'OpenPGP) + (setq mml-secure-openpgp-sign-with-sender t) + (setq mml-secure-smime-sign-with-sender t)) + (setq done t + val t)) + (?n + (setq done t))))) + val)) (defun mml-secure-epg-sign (protocol mode) ;; Based on code appearing inside mml2015-epg-sign. @@ -950,15 +988,21 @@ If no one is selected, symmetric encryption will be performed. " (signers (mml-secure-signers context signer-names)) signature micalg) (unless signers - (let ((maybe-msg - (if mml-secure-smime-sign-with-sender - "." - "; try setting `mml-secure-smime-sign-with-sender'."))) - ;; If `mml-secure-smime-sign-with-sender' is already non-nil - ;; then there's no point advising the user to examine it. If - ;; there are any other variables worth examining, please - ;; improve this error message by having it mention them. - (unless mml-secure-allow-signing-with-unknown-recipient + (if (and (not noninteractive) + (mml-secure-sender-sign-query protocol sender)) + (setq signer-names (mml-secure-signer-names protocol sender) + signers (mml-secure-signers context signer-names))) + (unless signers + (let ((maybe-msg + (if (or mml-secure-smime-sign-with-sender + mml-secure-openpgp-sign-with-sender) + "." + "; try setting `mml-secure-smime-sign-with-sender' or 'mml-secure-openpgp-sign-with-sender'."))) + ;; If `mml-secure-smime-sign-with-sender' or + ;; `mml-secure-openpgp-sign-with-sender' are already non-nil + ;; then there's no point advising the user to examine them. + ;; If there are any other variables worth examining, please + ;; improve this error message by having it mention them. (error "Couldn't find any signer names%s" maybe-msg)))) (when (eq 'OpenPGP protocol) (setf (epg-context-armor context) t) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 7894285bdf3..ccd17744993 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -178,7 +178,7 @@ The hook functions will be called with the full group name as argument." (define-obsolete-variable-alias 'nndiary-request-update-info-hooks 'nndiary-request-update-info-functions "24.3") (defcustom nndiary-request-update-info-functions nil - "Hook run after `nndiary-request-update-info-group' is executed. + "Hook run after `nndiary-request-update-info' is executed. The hook functions will be called with the full group name as argument." :group 'nndiary :type 'hook) @@ -1425,7 +1425,7 @@ all. This may very well take some time.") (pop years))) (if years ;; Because we might not be limited in years, we must guard against - ;; infinite loops. Appart from cases like Feb 31, there are probably + ;; infinite loops. Apart from cases like Feb 31, there are probably ;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to ;; decide this, so I assume that if we reach 10 years later, the ;; schedule is undecidable. diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 67dc379ef81..2952e20928b 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1067,6 +1067,8 @@ See `find-file-noselect' for the arguments." (setq nnheader-last-message-time now) (apply 'nnheader-message args)))) +(make-obsolete-variable 'nnheader-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'nnheader-load-hook) (provide 'nnheader) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index d797e893f51..8a88e0e6e64 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1772,11 +1772,6 @@ If LIMIT, first try to limit the search to the N last articles." ;; read it. (subst-char-in-region (point-min) (point-max) ?\\ ?% t) - ;; Remove any MODSEQ entries in the buffer, because they may contain - ;; numbers that are too large for 32-bit Emacsen. - (while (re-search-forward " MODSEQ ([0-9]+)" nil t) - (replace-match "" t t)) - (goto-char (point-min)) (let (start end articles groups uidnext elems permanent-flags uidvalidity vanished highestmodseq) (dolist (elem sequences) @@ -1803,8 +1798,9 @@ If LIMIT, first try to limit the search to the N last articles." (setq uidvalidity (and (re-search-forward "UIDVALIDITY \\([0-9]+\\)" end t) - ;; Store UIDVALIDITY as a string, as it's - ;; too big for 32-bit Emacsen, usually. + ;; Store UIDVALIDITY as a string; before bignums, + ;; it was usually too big for 32-bit Emacsen, + ;; and we don't want to change the format now. (match-string 1))) (goto-char start) (setq vanished diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 6ba0334ceb8..20f82e5cbdf 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -211,6 +211,26 @@ By default this is the name of an email header field.") "Search groups in Gnus with assorted search engines." :group 'gnus) +(make-obsolete-variable 'nnir-summary-line-format "The formatting +specs previously unique to this variable may now be set in +'gnus-summary-line-format." "28.1") + +(defcustom nnir-summary-line-format nil + "The format specification of the lines in an nnir summary buffer. + +All the items from `gnus-summary-line-format' are available, along +with three items unique to nnir summary buffers: + +%Z Search retrieval score value (integer) +%G Article original full group name (string) +%g Article original short group name (string) + +If nil this will use `gnus-summary-line-format'." + :version "24.1" + :type '(choice (const :tag "gnus-summary-line-format" nil) string) + :group 'nnir) + + (defcustom nnir-ignored-newsgroups "" "Newsgroups to skip when searching. Any newsgroup in the active file matching this regexp will be @@ -529,6 +549,7 @@ construct the vector entries." ;;; Search Engine Interfaces: +(autoload 'gnus-server-get-active "gnus-int") (autoload 'nnimap-change-group "nnimap") (declare-function nnimap-buffer "nnimap" ()) (declare-function nnimap-command "nnimap" (&rest args)) @@ -547,7 +568,8 @@ extensions." (cdr (assoc nnir-imap-default-search-key nnir-imap-search-arguments)))) (gnus-inhibit-demon t) - (groups (or groups (nnir-get-active srv)))) + (groups + (or groups (gnus-server-get-active srv nnir-ignored-newsgroups)))) (message "Opening server %s" server) (apply 'vconcat @@ -1185,7 +1207,8 @@ construct path: search terms (see the variable (directory (cadr (assoc sym (cddr method)))) (regexp (cdr (assoc 'query query))) (grep-options (cdr (assoc 'grep-options query))) - (grouplist (or grouplist (nnir-get-active server)))) + (grouplist + (or grouplist (gnus-server-get-active server nnir-ignored-newsgroups)))) (unless directory (error "No directory found in method specification of server %s" server)) @@ -1312,54 +1335,13 @@ environment unless NOT-GLOBAL is non-nil." ((and (not not-global) (boundp key)) (symbol-value key)) (t nil)))) -(autoload 'gnus-request-list "gnus-int") - -(defun nnir-get-active (srv) - "Return the active list for SRV." - (let ((method (gnus-server-to-method srv)) - groups) - (gnus-request-list method) - (with-current-buffer nntp-server-buffer - (let ((cur (current-buffer))) - (goto-char (point-min)) - (unless (or (null nnir-ignored-newsgroups) - (string= nnir-ignored-newsgroups "")) - (delete-matching-lines nnir-ignored-newsgroups)) - (if (eq (car method) 'nntp) - (while (not (eobp)) - (ignore-errors - (push (gnus-group-full-name - (buffer-substring - (point) - (progn - (skip-chars-forward "^ \t") - (point))) - method) - groups)) - (forward-line)) - (while (not (eobp)) - (ignore-errors - (push (if (eq (char-after) ?\") - (gnus-group-full-name (read cur) method) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - (gnus-group-full-name name method))) - groups)) - (forward-line))))) - groups)) - -(autoload 'nnselect-categorize "nnselect" nil nil) (autoload 'gnus-group-topic-name "gnus-topic" nil nil) (defvar gnus-group-marked) (defvar gnus-topic-alist) +(make-obsolete 'nnir-make-specs "This function should no longer +be used." "28.1") + (defun nnir-make-specs (nnir-extra-parms &optional specs) "Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS. Query for the specs, or use SPECS." @@ -1367,12 +1349,12 @@ Query for the specs, or use SPECS." (or (cdr (assq 'nnir-group-spec specs)) (if (gnus-server-server-name) (list (list (gnus-server-server-name))) - (nnselect-categorize + (seq-group-by + (lambda (elt) (gnus-group-server elt)) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) - (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))) - 'nnselect-group-server)))) + (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) (query-spec (or (cdr (assq 'nnir-query-spec specs)) (apply @@ -1387,6 +1369,8 @@ Query for the specs, or use SPECS." (list (cons 'nnir-query-spec query-spec) (cons 'nnir-group-spec group-spec)))) +(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1") + ;; The end. (provide 'nnir) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index b6308140fc9..57801d6f9e6 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -2082,6 +2082,8 @@ Doesn't change point." (format "%S" split) "\n")))) +(make-obsolete-variable 'nnmail-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'nnmail-load-hook) (provide 'nnmail) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 81a148db669..68c31dc4510 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1767,7 +1767,7 @@ This variable is set by `nnmaildir-request-article'.") nnmaildir--cur-server nil) ;; This slightly obscure invocation of `alist-get' removes SERVER from - ;; `nnmaildir-servers'. + ;; `nnmaildir--servers'. (setf (alist-get (nnmaildir--srv-address server) nnmaildir--servers server 'remove #'equal) server)) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 116d7ee9fb2..48c07da1cc8 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -450,7 +450,7 @@ nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s" (defun nnrss-normalize-date (date) "Return a date string of DATE in the style of RFC 822 and its successors. This function handles the ISO 8601 date format described in -URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style +URL `https://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style which RSS 2.0 allows." (let (case-fold-search vector year month day time zone cts given) (cond ((null date)) ; do nothing for this case diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 1965a2614f7..21206b683cf 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -105,9 +105,7 @@ (gnus-uncompress-sequence artseq)) selection))) selection))) -(defun nnselect-group-server (group) - "Return the server for GROUP." - (gnus-group-server group)) +(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1") ;; Data type article list. @@ -205,11 +203,22 @@ as `(keyfunc member)' and the corresponding element is just (nnselect-categorize ,articles 'nnselect-article-group 'nnselect-article-id))) -(define-inline numbers-by-group (articles) +(define-inline numbers-by-group (articles &optional type) (inline-quote - (nnselect-categorize - ,articles 'nnselect-article-group 'nnselect-article-number))) - + (cond + ((eq ,type 'range) + (nnselect-categorize (gnus-uncompress-range ,articles) + 'nnselect-article-group 'nnselect-article-number)) + ((eq ,type 'tuple) + (nnselect-categorize ,articles + #'(lambda (elem) + (nnselect-article-group (car elem))) + #'(lambda (elem) + (cons (nnselect-article-number + (car elem)) (cdr elem))))) + (t + (nnselect-categorize ,articles + 'nnselect-article-group 'nnselect-article-number))))) (defmacro nnselect-add-prefix (group) "Ensures that the GROUP has an nnselect prefix." @@ -238,6 +247,9 @@ as `(keyfunc member)' and the corresponding element is just "Virtual groups in Gnus with arbitrary selection methods." :group 'gnus) +(define-obsolete-variable-alias 'nnir-retrieve-headers-override-function + 'nnselect-retrieve-headers-override-function "28.1") + (defcustom nnselect-retrieve-headers-override-function nil "A function that retrieves article headers for ARTICLES from GROUP. The retrieved headers should populate the `nntp-server-buffer'. @@ -245,8 +257,8 @@ Returns either the retrieved header format 'nov or 'headers. If this variable is nil, or if the provided function returns nil, `gnus-retrieve-headers' will be called instead." - :version "24.1" :type '(function) :group 'nnselect) - + :version "28.1" + :type '(repeat function)) ;; Gnus backend interface functions. @@ -328,11 +340,13 @@ If this variable is nil, or if the provided function returns nil, (nnheader-parse-nov)) (forward-line 1))) ('headers - (goto-char (point-min)) - (while (not (eobp)) - (nnselect-add-novitem - (nnheader-parse-head)) - (forward-line 1))) + (gnus-run-hooks 'gnus-parse-headers-hook) + (let ((nnmail-extra-headers gnus-extra-headers)) + (goto-char (point-min)) + (while (not (eobp)) + (nnselect-add-novitem + (nnheader-parse-head)) + (forward-line 1)))) ((pred listp) (dolist (novitem gnus-headers-retrieved-by) (nnselect-add-novitem novitem))) @@ -416,6 +430,21 @@ If this variable is nil, or if the provided function returns nil, to-newsgroup ; Not respooling (gnus-group-real-name to-newsgroup))))) +(deffoo nnselect-request-replace-article + (article _group buffer &optional no-encode) + (pcase-let ((`[,artgroup ,artnumber ,artrsv] + (with-current-buffer gnus-summary-buffer + (nnselect-artlist-article gnus-newsgroup-selection article)))) + (unless (gnus-check-backend-function + 'request-replace-article artgroup) + (user-error "The group %s does not support article editing" artgroup)) + (let ((newart + (gnus-request-replace-article artnumber artgroup buffer no-encode))) + (with-current-buffer gnus-summary-buffer + (cl-nsubstitute `[,artgroup ,newart ,artrsv] + `[,artgroup ,artnumber ,artrsv] + gnus-newsgroup-selection + :test #'equal :count 1))))) (deffoo nnselect-request-expire-articles (articles _group &optional _server force) @@ -487,15 +516,15 @@ If this variable is nil, or if the provided function returns nil, (list (car artgroup) (gnus-compress-sequence (sort (cdr artgroup) '<)) action marks)) - (numbers-by-group - (gnus-uncompress-range range))))) + (numbers-by-group range 'range)))) actions) 'car 'cdr))) (deffoo nnselect-request-update-info (group info &optional _server) - (let* ((group (nnselect-add-prefix group)) - (gnus-newsgroup-selection (or gnus-newsgroup-selection - (nnselect-get-artlist group)))) + (let* ((group (nnselect-add-prefix group)) + (gnus-newsgroup-selection + (or gnus-newsgroup-selection (nnselect-get-artlist group))) + newmarks) (gnus-info-set-marks info nil) (setf (gnus-info-read info) nil) (pcase-dolist (`(,artgroup . ,nartids) @@ -503,30 +532,56 @@ If this variable is nil, or if the provided function returns nil, (number-sequence 1 (nnselect-artlist-length gnus-newsgroup-selection)))) (let* ((gnus-newsgroup-active nil) - (artids (cl-sort nartids '< :key 'car)) + (artids (cl-sort nartids #'< :key 'car)) (group-info (gnus-get-info artgroup)) (marks (gnus-info-marks group-info)) (unread (gnus-uncompress-sequence (gnus-range-difference (gnus-active artgroup) (gnus-info-read group-info))))) - (gnus-atomic-progn - (setf (gnus-info-read info) - (gnus-add-to-range - (gnus-info-read info) - (delq nil - (mapcar - #'(lambda (art) - (unless (memq (cdr art) unread) (car art))) - artids)))) - (pcase-dolist (`(,type . ,range) marks) - (setq range (gnus-uncompress-sequence range)) - (gnus-add-marked-articles - group type - (delq nil - (mapcar - #'(lambda (art) - (when (memq (cdr art) range) - (car art))) artids))))))) + (setf (gnus-info-read info) + (gnus-add-to-range + (gnus-info-read info) + (delq nil (mapcar + #'(lambda (art) + (unless (memq (cdr art) unread) (car art))) + artids)))) + (pcase-dolist (`(,type . ,mark-list) marks) + (let ((mark-type (gnus-article-mark-to-type type)) new) + (when + (setq new + (delq nil + (cond + ((eq mark-type 'tuple) + (mapcar + #'(lambda (id) + (let (mark) + (when + (setq mark (assq (cdr id) mark-list)) + (cons (car id) (cdr mark))))) + artids)) + (t + (setq mark-list + (gnus-uncompress-range mark-list)) + (mapcar + #'(lambda (id) + (when (memq (cdr id) mark-list) + (car id))) artids))))) + (let ((previous (alist-get type newmarks))) + (if previous + (nconc previous new) + (push (cons type new) newmarks)))))))) + + ;; Clean up the marks: compress lists; + (pcase-dolist (`(,type . ,mark-list) newmarks) + (let ((mark-type (gnus-article-mark-to-type type))) + (unless (eq mark-type 'tuple) + (setf (alist-get type newmarks) + (gnus-compress-sequence mark-list))))) + ;; and ensure an unexist key. + (unless (assq 'unexist newmarks) + (push (cons 'unexist nil) newmarks)) + + (gnus-info-set-marks info newmarks) (gnus-set-active group (cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))) @@ -752,42 +807,61 @@ article came from is also searched." "Copy mark-lists from GROUP to the originating groups." (let ((select-unreads (numbers-by-group gnus-newsgroup-unreads)) (select-reads (numbers-by-group - (gnus-uncompress-range - (gnus-info-read (gnus-get-info group))))) + (gnus-info-read (gnus-get-info group)) 'range)) (select-unseen (numbers-by-group gnus-newsgroup-unseen)) - (gnus-newsgroup-active nil) - mark-list type-list) + (gnus-newsgroup-active nil) mark-list) + ;; collect the set of marked article lists categorized by + ;; originating groups (pcase-dolist (`(,mark . ,type) gnus-article-mark-lists) - (when (setq type-list - (symbol-value (intern (format "gnus-newsgroup-%s" mark)))) - (push (cons type - (numbers-by-group - (gnus-uncompress-range type-list))) mark-list))) + (let (type-list) + (when (setq type-list + (symbol-value (intern (format "gnus-newsgroup-%s" mark)))) + (push (cons + type + (numbers-by-group type-list (gnus-article-mark-to-type type))) + mark-list)))) + ;; now work on each originating group one at a time (pcase-dolist (`(,artgroup . ,artlist) (numbers-by-group gnus-newsgroup-articles)) (let* ((group-info (gnus-get-info artgroup)) (old-unread (gnus-list-of-unread-articles artgroup)) - newmarked) + newmarked delta-marks) (when group-info + ;; iterate over mark lists for this group (pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists) - (let ((select-type - (sort - (cdr (assoc artgroup (alist-get type mark-list))) - '<)) list) - (setq list - (gnus-uncompress-range - (gnus-add-to-range - (gnus-remove-from-range - (alist-get type (gnus-info-marks group-info)) - artlist) - select-type))) - - (when list - ;; Get rid of the entries of the articles that have the - ;; default score. - (when (and (eq type 'score) - gnus-save-score - list) + (let ((list (cdr (assoc artgroup (alist-get type mark-list)))) + (mark-type (gnus-article-mark-to-type type))) + + ;; When the backend can store marks we collect any + ;; changes. Unlike a normal group the mark lists only + ;; include marks for articles we retrieved. + (when (and (gnus-check-backend-function + 'request-set-mark artgroup) + (not (gnus-article-unpropagatable-p type))) + (let* ((old (gnus-list-range-intersection + artlist + (alist-get type (gnus-info-marks group-info)))) + (del (gnus-remove-from-range (copy-tree old) list)) + (add (gnus-remove-from-range (copy-tree list) old))) + (when add (push (list add 'add (list type)) delta-marks)) + (when del + ;; Don't delete marks from outside the active range. + ;; This shouldn't happen, but is a sanity check. + (setq del (gnus-sorted-range-intersection + (gnus-active artgroup) del)) + (push (list del 'del (list type)) delta-marks)))) + + ;; Marked sets are of mark-type 'tuple, 'list, or + ;; 'range. We merge the lists with what is already in + ;; the original info to get full list of new marks. We + ;; do this by removing all the articles we retrieved + ;; from the full list, and then add back in the newly + ;; marked ones. + (cond + ((eq mark-type 'tuple) + ;; Get rid of the entries that have the default + ;; score. + (when (and list (eq type 'score) gnus-save-score) (let* ((arts list) (prev (cons nil list)) (all prev)) @@ -797,30 +871,41 @@ article came from is also searched." (setcdr prev (cdr arts)) (setq prev arts)) (setq arts (cdr arts))) - (setq list (cdr all))))) - - (when (or (eq (gnus-article-mark-to-type type) 'list) - (eq (gnus-article-mark-to-type type) 'range)) + (setq list (cdr all)))) + ;; now merge with the original list and sort just to + ;; make sure (setq list - (gnus-compress-sequence (sort list '<) t))) - - ;; When exiting the group, everything that's previously been - ;; unseen is now seen. - (when (eq type 'seen) - (setq list (gnus-range-add - list (cdr (assoc artgroup select-unseen))))) + (sort (map-merge + 'list list + (alist-get type (gnus-info-marks group-info))) + (lambda (elt1 elt2) + (< (car elt1) (car elt2)))))) + (t + (setq list + (gnus-compress-sequence + (gnus-sorted-union + (gnus-sorted-difference + (gnus-uncompress-sequence + (alist-get type (gnus-info-marks group-info))) + artlist) + (sort list #'<)) t))) + + ;; When exiting the group, everything that's previously been + ;; unseen is now seen. + (when (eq type 'seen) + (setq list (gnus-range-add + list (cdr (assoc artgroup select-unseen)))))) (when (or list (eq type 'unexist)) - (push (cons type list) newmarked)))) + (push (cons type list) newmarked)))) ;; end of mark-type loop - (gnus-atomic-progn - ;; Enter these new marks into the info of the group. - (if (nthcdr 3 group-info) - (setcar (nthcdr 3 group-info) newmarked) - ;; Add the marks lists to the end of the info. - (when newmarked - (setcdr (nthcdr 2 group-info) (list newmarked)))) + (when delta-marks + (unless (gnus-check-group artgroup) + (error "Can't open server for %s" artgroup)) + (gnus-request-set-mark artgroup delta-marks)) + (gnus-atomic-progn + (gnus-info-set-marks group-info newmarked) ;; Cut off the end of the info if there's nothing else there. (let ((i 5)) (while (and (> i 2) diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index 5504a520783..3edae04fcc0 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -44,6 +44,7 @@ ;; cry ;-( ;; dead X-) ;; grin :-D +;; halo O:-) ;;; Code: @@ -64,7 +65,8 @@ "Smiley style." :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14 (const :tag "medium, ~10 colors" medium) ;; 16x16 - (const :tag "dull, grayscale" grayscale)) ;; 14x14 + (const :tag "dull, grayscale" grayscale) ;; 14x14 + (const :tag "emoji, full color" emoji)) :set (lambda (symbol value) (set-default symbol value) (setq smiley-data-directory (smiley-directory)) @@ -96,6 +98,35 @@ is nil, use `smiley-style'." :type 'directory :group 'smiley) +(defcustom smiley-emoji-regexp-alist + '(("\\(;-)\\)\\W" 1 "😉") + ("[^;]\\(;)\\)\\W" 1 "😉") + ("\\(:-]\\)\\W" 1 "😬") + ("\\(8-)\\)\\W" 1 "🥴") + ("\\(:-|\\)\\W" 1 "😐") + ("\\(:-[/\\]\\)\\W" 1 "😕") + ("\\(:-(\\)\\W" 1 "😠") + ("\\(X-)\\)\\W" 1 "😵") ; 💀 + ("\\(:-{\\)\\W" 1 "😦") + ("\\(>:-)\\)\\W" 1 "😈") + ("\\(;-(\\)\\W" 1 "😢") + ("\\(:-D\\)\\W" 1 "😀") + ("\\(O:-)\\)\\W" 1 "😇") + ;; "smile" must be come after "evil" + ("\\(\\^?:-?)\\)\\W" 1 "🙂")) + "A list of regexps to map smilies to emoji. +The elements are (REGEXP MATCH EMOJI), where MATCH is the submatch in +regexp to replace with EMOJI." + :version "28.1" + :type '(repeat (list regexp + (integer :tag "Regexp match number") + (string :tag "Emoji"))) + :set (lambda (symbol value) + (set-default symbol value) + (smiley-update-cache)) + :initialize 'custom-initialize-default + :group 'smiley) + ;; The XEmacs version has a baroque, if not rococo, set of these. (defcustom smiley-regexp-alist '(("\\(;-)\\)\\W" 1 "blink") @@ -142,23 +173,25 @@ regexp to replace with IMAGE. IMAGE is the name of an image file in (defun smiley-update-cache () (setq smiley-cached-regexp-alist nil) - (dolist (elt (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) - (let ((types gnus-smiley-file-types) - file type) - (while (and (not file) - (setq type (pop types))) - (unless (file-exists-p - (setq file (expand-file-name (concat (nth 2 elt) "." type) - smiley-data-directory))) - (setq file nil))) - (when type - (let ((image (gnus-create-image file (intern type) nil - :ascent 'center))) - (when image - (push (list (car elt) (cadr elt) image) - smiley-cached-regexp-alist))))))) + (if (eq smiley-style 'emoji) + (setq smiley-cached-regexp-alist smiley-emoji-regexp-alist) + (dolist (elt (if (symbolp smiley-regexp-alist) + (symbol-value smiley-regexp-alist) + smiley-regexp-alist)) + (let ((types gnus-smiley-file-types) + file type) + (while (and (not file) + (setq type (pop types))) + (unless (file-exists-p + (setq file (expand-file-name (concat (nth 2 elt) "." type) + smiley-data-directory))) + (setq file nil))) + (when type + (let ((image (gnus-create-image file (intern type) nil + :ascent 'center))) + (when image + (push (list (car elt) (cadr elt) image) + smiley-cached-regexp-alist)))))))) ;; Not implemented: ;; (defvar smiley-mouse-map @@ -190,8 +223,15 @@ A list of images is returned." (when image (push image images) (gnus-add-wash-type 'smiley) - (gnus-add-image 'smiley image) - (gnus-put-image image string 'smiley)))) + (if (symbolp image) + (progn + (gnus-add-image 'smiley image) + (gnus-put-image image string 'smiley)) + ;; This is a string, but mark the property for + ;; deletion if the washing method is switched off. + (insert (propertize string + 'display image + 'gnus-image-category 'smiley)))))) images)))) ;;;###autoload diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 5500148e518..eb27fee88ce 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -174,8 +174,9 @@ and the files themselves should be in PEM format." (eq 0 (call-process "openssl" nil nil nil "version")) (error nil)) "openssl") - "Name of OpenSSL binary." - :type 'string + "Name of OpenSSL binary or nil if none." + :type '(choice string + (const :tag "none" nil)) :group 'smime) ;; OpenSSL option to select the encryption cipher diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 3da45a2b623..bf593865d72 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -4,7 +4,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Keywords: network -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat +;; URL: https://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat ;; This file is part of GNU Emacs. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a9943ccd7f4..170f497541a 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -40,8 +40,8 @@ (defvar help-fns-describe-function-functions nil "List of functions to run in help buffer in `describe-function'. Those functions will be run after the header line and argument -list was inserted, and before the documentation will be inserted. -The functions will receive the function name as argument. +list was inserted, and before the documentation is inserted. +The functions will be called with one argument: the function's symbol. They can assume that a newline was output just before they were called, and they should terminate any of their own output with a newline. By convention they should indent their output by 2 spaces.") @@ -622,7 +622,7 @@ FILE is the file where FUNCTION was probably defined." ;; of the *packages* in which the function is defined. (let* ((name (symbol-name symbol)) (re (concat "\\_<" (regexp-quote name) "\\_>")) - (news (directory-files data-directory t "\\`NEWS\\.[1-9]")) + (news (directory-files data-directory t "\\`NEWS\\($\\|\\.\\)")) (place nil) (first nil)) (with-temp-buffer @@ -659,6 +659,39 @@ FILE is the file where FUNCTION was probably defined." (insert (format " Probably introduced at or before Emacs version %s.\n" first)))))) +(declare-function shortdoc-display-group "shortdoc") +(declare-function shortdoc-function-groups "shortdoc") + +(add-hook 'help-fns-describe-function-functions + #'help-fns--mention-shortdoc-groups) +(defun help-fns--mention-shortdoc-groups (object) + (require 'shortdoc) + (when-let ((groups (and (symbolp object) + (shortdoc-function-groups object)))) + (let ((start (point)) + (times 0)) + (with-current-buffer standard-output + (insert " Other relevant functions are documented in the ") + (mapc + (lambda (group) + (when (> times 0) + (insert (if (= times (1- (length groups))) + " and " + ", "))) + (setq times (1+ times)) + (insert-text-button + (symbol-name group) + 'action (lambda (_) + (shortdoc-display-group group)))) + groups) + (insert (if (= (length groups) 1) + " group.\n" + " groups.\n"))) + (save-restriction + (narrow-to-region start (point)) + (fill-region-as-paragraph (point-min) (point-max)) + (goto-char (point-max)))))) + (defun help-fns-short-filename (filename) (let* ((abbrev (abbreviate-file-name filename)) (short abbrev)) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 9c2d1d72275..f0770fb6602 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -308,7 +308,7 @@ The format is (FUNCTION ARGS...).") :supertype 'help-xref 'help-function (lambda (file pos) - (pop-to-buffer (find-file-noselect file)) + (view-buffer-other-window (find-file-noselect file)) (goto-char pos)) 'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement")) @@ -756,16 +756,15 @@ Show all docs for that symbol as either a variable, function or face." (help-do-xref pos #'describe-symbol (list sym)) (user-error "No symbol here")))) -(defun help-mode-revert-buffer (_ignore-auto noconfirm) - (when (or noconfirm (yes-or-no-p "Revert help buffer? ")) - (let ((pos (point)) - (item help-xref-stack-item) - ;; Pretend there is no current item to add to the history. - (help-xref-stack-item nil) - ;; Use the current buffer. - (help-xref-following t)) - (apply (car item) (cdr item)) - (goto-char pos)))) +(defun help-mode-revert-buffer (_ignore-auto _noconfirm) + (let ((pos (point)) + (item help-xref-stack-item) + ;; Pretend there is no current item to add to the history. + (help-xref-stack-item nil) + ;; Use the current buffer. + (help-xref-following t)) + (apply (car item) (cdr item)) + (goto-char pos))) (defun help-insert-string (string) "Insert STRING to the help buffer and install xref info for it. diff --git a/lisp/help.el b/lisp/help.el index 45159d44779..df055d602fe 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -101,6 +101,7 @@ (define-key map "p" 'finder-by-keyword) (define-key map "P" 'describe-package) (define-key map "r" 'info-emacs-manual) + (define-key map "R" 'info-display-manual) (define-key map "s" 'describe-syntax) (define-key map "t" 'help-with-tutorial) (define-key map "w" 'where-is) @@ -178,7 +179,7 @@ Do not call this in the scope of `with-help-window'." (if (same-window-p (buffer-name standard-output)) ;; Say how to scroll this window. (substitute-command-keys - "\\[scroll-up] to scroll the help.") + "\\[scroll-up-command] to scroll the help.") ;; Say how to scroll some other window. (substitute-command-keys "\\[scroll-other-window] to scroll the help.")))))))) @@ -223,6 +224,7 @@ o SYMBOL Display the given function or variable's documentation and value. p TOPIC Find packages matching a given topic keyword. P PACKAGE Describe the given Emacs Lisp package. r Display the Emacs manual in Info mode. +R Prompt for a manual and then display it in Info mode. s Display contents of current syntax table, plus explanations. S SYMBOL Show the section for the given symbol in the Info manual for the programming language used in this buffer. @@ -458,6 +460,7 @@ the variable `message-log-max'." "Display last few input keystrokes and the commands run. For convenience this uses the same format as `edit-last-kbd-macro'. +See `lossage-size' to update the number of recorded keystrokes. To record all your input, use `open-dribble-file'." (interactive) @@ -970,6 +973,475 @@ is currently activated with completion." minor-modes nil) (setq minor-modes (cdr minor-modes))))) result)) + + +(defun substitute-command-keys (string) + "Substitute key descriptions for command names in STRING. +Each substring of the form \\\\=[COMMAND] is replaced by either a +keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND +is not on any keys. + +Each substring of the form \\\\={MAPVAR} is replaced by a summary of +the value of MAPVAR as a keymap. This summary is similar to the one +produced by ‘describe-bindings’. The summary ends in two newlines +(used by the helper function ‘help-make-xrefs’ to find the end of the +summary). + +Each substring of the form \\\\=<MAPVAR> specifies the use of MAPVAR +as the keymap for future \\\\=[COMMAND] substrings. + +Each grave accent \\=` is replaced by left quote, and each apostrophe \\=' +is replaced by right quote. Left and right quote characters are +specified by ‘text-quoting-style’. + +\\\\== quotes the following character and is discarded; thus, \\\\==\\\\== puts \\\\== +into the output, \\\\==\\[ puts \\[ into the output, and \\\\==\\=` puts \\=` into the +output. + +Return the original STRING if no substitutions are made. +Otherwise, return a new string (without any text properties)." + (when (not (null string)) + ;; KEYMAP is either nil (which means search all the active + ;; keymaps) or a specified local map (which means search just that + ;; and the global map). If non-nil, it might come from + ;; overriding-local-map, or from a \\<mapname> construct in STRING + ;; itself. + (let ((keymap overriding-local-map) + (inhibit-modification-hooks t) + (orig-buf (current-buffer))) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (< (point) (point-max)) + (let ((orig-point (point)) + end-point active-maps + close generate-summary) + (cond + ;; 1. Handle all sequences starting with "\" + ((= (following-char) ?\\) + (ignore-errors + (forward-char 1)) + (cond + ;; 1A. Ignore \= at end of string. + ((and (= (+ (point) 1) (point-max)) + (= (following-char) ?=)) + (forward-char 1)) + ;; 1B. \= quotes the next character; thus, to put in \[ + ;; without its special meaning, use \=\[. + ((= (following-char) ?=) + (goto-char orig-point) + (delete-char 2) + (ignore-errors + (forward-char 1))) + ;; 1C. \[foo] is replaced with the keybinding. + ((and (= (following-char) ?\[) + (save-excursion + (prog1 (search-forward "]" nil t) + (setq end-point (- (point) 2))))) + (goto-char orig-point) + (delete-char 2) + (let* ((fun (intern (buffer-substring (point) (1- end-point)))) + (key (with-current-buffer orig-buf + (where-is-internal fun keymap t)))) + ;; If this a command remap, we need to follow it. + (when (and (vectorp key) + (> (length key) 1) + (eq (aref key 0) 'remap) + (symbolp (aref key 1))) + (setq fun (aref key 1)) + (setq key (with-current-buffer orig-buf + (where-is-internal fun keymap t)))) + (if (not key) + ;; Function is not on any key. + (progn (insert "M-x ") + (goto-char (+ end-point 3)) + (delete-char 1)) + ;; Function is on a key. + (delete-char (- end-point (point))) + (insert (key-description key))))) + ;; 1D. \{foo} is replaced with a summary of the keymap + ;; (symbol-value foo). + ;; \<foo> just sets the keymap used for \[cmd]. + ((and (or (and (= (following-char) ?{) + (setq close "}") + (setq generate-summary t)) + (and (= (following-char) ?<) + (setq close ">"))) + (or (save-excursion + (prog1 (search-forward close nil t) + (setq end-point (- (point) 2)))))) + (goto-char orig-point) + (delete-char 2) + (let* ((name (intern (buffer-substring (point) (1- end-point)))) + this-keymap) + (delete-char (- end-point (point))) + ;; Get the value of the keymap in TEM, or nil if + ;; undefined. Do this in the user's current buffer + ;; in case it is a local variable. + (with-current-buffer orig-buf + ;; This is for computing the SHADOWS arg for + ;; describe-map-tree. + (setq active-maps (current-active-maps)) + (when (boundp name) + (setq this-keymap (and (keymapp (symbol-value name)) + (symbol-value name))))) + (cond + ((null this-keymap) + (insert "\nUses keymap " + (substitute-command-keys "`") + (symbol-name name) + (substitute-command-keys "'") + ", which is not currently defined.\n") + (unless generate-summary + (setq keymap nil))) + ((not generate-summary) + (setq keymap this-keymap)) + (t + ;; Get the list of active keymaps that precede this one. + ;; If this one's not active, get nil. + (let ((earlier-maps (cdr (memq this-keymap (reverse active-maps))))) + (describe-map-tree this-keymap t (nreverse earlier-maps) + nil nil t nil nil t)))))))) + ;; 2. Handle quotes. + ((and (eq (get-quoting-style) 'curve) + (or (and (= (following-char) ?\`) + (prog1 t (insert "‘"))) + (and (= (following-char) ?') + (prog1 t (insert "’"))))) + (delete-char 1)) + ((and (eq (get-quoting-style) 'straight) + (= (following-char) ?\`)) + (insert "'") + (delete-char 1)) + ;; 3. Nothing to do -- next character. + (t (forward-char 1))))) + (buffer-string))))) + +(defvar help--keymaps-seen nil) +(defun describe-map-tree (startmap partial shadow prefix title no-menu + transl always-title mention-shadow) + "Insert a description of the key bindings in STARTMAP. +This is followed by the key bindings of all maps reachable +through STARTMAP. + +If PARTIAL is non-nil, omit certain uninteresting commands +\(such as `undefined'). + +If SHADOW is non-nil, it is a list of maps; don't mention keys +which would be shadowed by any of them. + +If PREFIX is non-nil, mention only keys that start with PREFIX. + +If TITLE is non-nil, is a string to insert at the beginning. +TITLE should not end with a colon or a newline; we supply that. + +If NOMENU is non-nil, then omit menu-bar commands. + +If TRANSL is non-nil, the definitions are actually key +translations so print strings and vectors differently. + +If ALWAYS_TITLE is non-nil, print the title even if there are no +maps to look through. + +If MENTION_SHADOW is non-nil, then when something is shadowed by +SHADOW, don't omit it; instead, mention it but say it is +shadowed. + +Any inserted text ends in two newlines (used by +`help-make-xrefs')." + (let* ((amaps (accessible-keymaps startmap prefix)) + (orig-maps (if no-menu + (progn + ;; Delete from MAPS each element that is for + ;; the menu bar. + (let* ((tail amaps) + result) + (while tail + (let ((elem (car tail))) + (when (not (and (>= (length (car elem)) 1) + (eq (elt (car elem) 0) 'menu-bar))) + (setq result (append result (list elem))))) + (setq tail (cdr tail))) + result)) + amaps)) + (maps orig-maps) + (print-title (or maps always-title))) + ;; Print title. + (when print-title + (insert (concat (if title + (concat title + (if prefix + (concat " Starting With " + (key-description prefix))) + ":\n")) + "key binding\n" + "--- -------\n"))) + ;; Describe key bindings. + (setq help--keymaps-seen nil) + (while (consp maps) + (let* ((elt (car maps)) + (elt-prefix (car elt)) + (sub-shadows (lookup-key shadow elt-prefix t))) + (when (if (natnump sub-shadows) + (prog1 t (setq sub-shadows nil)) + ;; Describe this map iff elt_prefix is bound to a + ;; keymap, since otherwise it completely shadows this + ;; map. + (or (keymapp sub-shadows) + (null sub-shadows) + (consp sub-shadows) + (not (keymapp (car sub-shadows))))) + ;; Maps we have already listed in this loop shadow this map. + (let ((tail orig-maps)) + (while (not (equal tail maps)) + (when (equal (car (car tail)) elt-prefix) + (setq sub-shadows (cons (cdr (car tail)) sub-shadows))) + (setq tail (cdr tail)))) + (describe-map (cdr elt) elt-prefix transl partial + sub-shadows no-menu mention-shadow))) + (setq maps (cdr maps))) + (when print-title + (insert "\n")))) + +(defun help--shadow-lookup (keymap key accept-default remap) + "Like `lookup-key', but with command remapping. +Return nil if the key sequence is too long." + ;; Converted from shadow_lookup in keymap.c. + (let ((value (lookup-key keymap key accept-default))) + (cond ((and (fixnump value) (<= 0 value))) + ((and value remap (symbolp value)) + (or (command-remapping value nil keymap) + value)) + (t value)))) + +(defvar help--previous-description-column 0) +(defun help--describe-command (definition) + ;; Converted from describe_command in keymap.c. + ;; If column 16 is no good, go to col 32; + ;; but don't push beyond that--go to next line instead. + (let* ((column (current-column)) + (description-column (cond ((> column 30) + (insert "\n") + 32) + ((or (> column 14) + (and (> column 10) + (= help--previous-description-column 32))) + 32) + (t 16)))) + (indent-to description-column 1) + (setq help--previous-description-column description-column) + (cond ((symbolp definition) + (insert (symbol-name definition) "\n")) + ((or (stringp definition) (vectorp definition)) + (insert "Keyboard Macro\n")) + ((keymapp definition) + (insert "Prefix Command\n")) + (t (insert "??\n"))))) + +(defun help--describe-translation (definition) + ;; Converted from describe_translation in keymap.c. + (indent-to 16 1) + (cond ((symbolp definition) + (insert (symbol-name definition) "\n")) + ((or (stringp definition) (vectorp definition)) + (insert (key-description definition nil) "\n")) + ((keymapp definition) + (insert "Prefix Command\n")) + (t (insert "??\n")))) + +(defun help--describe-map-compare (a b) + (let ((a (car a)) + (b (car b))) + (cond ((and (fixnump a) (fixnump b)) (< a b)) + ;; ((and (not (fixnump a)) (fixnump b)) nil) ; not needed + ((and (fixnump a) (not (fixnump b))) t) + ((and (symbolp a) (symbolp b)) + ;; Sort the keystroke names in the "natural" way, with (for + ;; instance) "<f2>" coming between "<f1>" and "<f11>". + (string-version-lessp (symbol-name a) (symbol-name b))) + (t nil)))) + +(defun describe-map (map prefix transl partial shadow nomenu mention-shadow) + "Describe the contents of keymap MAP. +Assume that this keymap itself is reached by the sequence of +prefix keys PREFIX (a string or vector). + +TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in +`describe-map-tree'." + ;; Converted from describe_map in keymap.c. + (let* ((suppress (and partial 'suppress-keymap)) + (map (keymap-canonicalize map)) + (tail map) + (first t) + (describer (if transl + #'help--describe-translation + #'help--describe-command)) + done vect) + (while (and (consp tail) (not done)) + (cond ((or (vectorp (car tail)) (char-table-p (car tail))) + (help--describe-vector (car tail) prefix describer partial + shadow map mention-shadow)) + ((consp (car tail)) + (let ((event (caar tail)) + definition this-shadowed) + ;; Ignore bindings whose "prefix" are not really + ;; valid events. (We get these in the frames and + ;; buffers menu.) + (and (or (symbolp event) (fixnump event)) + (not (and nomenu (eq event 'menu-bar))) + ;; Don't show undefined commands or suppressed + ;; commands. + (setq definition (keymap--get-keyelt (cdr (car tail)) nil)) + (or (not (symbolp definition)) + (null (get definition suppress))) + ;; Don't show a command that isn't really + ;; visible because a local definition of the + ;; same key shadows it. + (or (not shadow) + (let ((tem (help--shadow-lookup shadow (vector event) t nil))) + (cond ((null tem) t) + ;; If both bindings are keymaps, + ;; this key is a prefix key, so + ;; don't say it is shadowed. + ((and (keymapp definition) (keymapp tem)) t) + ;; Avoid generating duplicate + ;; entries if the shadowed binding + ;; has the same definition. + ((and mention-shadow (not (eq tem definition))) + (setq this-shadowed t)) + (t nil)))) + (push (list event definition this-shadowed) vect)))) + ((eq (car tail) 'keymap) + ;; The same keymap might be in the structure twice, if + ;; we're using an inherited keymap. So skip anything + ;; we've already encountered. + (let ((tem (assq tail help--keymaps-seen))) + (if (and (consp tem) + (equal (car tem) prefix)) + (setq done t) + (push (cons tail prefix) help--keymaps-seen))))) + (setq tail (cdr tail))) + ;; If we found some sparse map events, sort them. + (let ((vect (sort vect 'help--describe-map-compare))) + ;; Now output them in sorted order. + (while vect + (let* ((elem (car vect)) + (start (car elem)) + (definition (cadr elem)) + (shadowed (caddr elem)) + (end start)) + (when first + (setq help--previous-description-column 0) + (insert "\n") + (setq first nil)) + ;; Find consecutive chars that are identically defined. + (when (fixnump start) + (while (and (cdr vect) + (let ((this-event (caar vect)) + (this-definition (cadar vect)) + (this-shadowed (caddar vect)) + (next-event (caar (cdr vect))) + (next-definition (cadar (cdr vect))) + (next-shadowed (caddar (cdr vect)))) + (and (eq next-event (1+ this-event)) + (equal next-definition this-definition) + (eq this-shadowed next-shadowed)))) + (setq vect (cdr vect)) + (setq end (caar vect)))) + ;; Now START .. END is the range to describe next. + ;; Insert the string to describe the event START. + (insert (key-description (vector start) prefix)) + (when (not (eq start end)) + (insert " .. " (key-description (vector end) prefix))) + ;; Print a description of the definition of this character. + ;; Called function will take care of spacing out far enough + ;; for alignment purposes. + (if transl + (help--describe-translation definition) + (help--describe-command definition)) + ;; Print a description of the definition of this character. + ;; elt_describer will take care of spacing out far enough for + ;; alignment purposes. + (when shadowed + (goto-char (max (1- (point)) (point-min))) + (insert "\n (this binding is currently shadowed)") + (goto-char (min (1+ (point)) (point-max))))) + ;; Next item in list. + (setq vect (cdr vect)))))) + +;;;; This Lisp version is 100 times slower than its C equivalent: +;; +;; (defun help--describe-vector +;; (vector prefix transl partial shadow entire-map mention-shadow) +;; "Insert in the current buffer a description of the contents of VECTOR. +;; +;; PREFIX a prefix key which leads to the keymap that this vector is +;; in. +;; +;; If PARTIAL, it means do not mention suppressed commands +;; (that assumes the vector is in a keymap). +;; +;; SHADOW is a list of keymaps that shadow this map. If it is +;; non-nil, look up the key in those maps and don't mention it if it +;; is defined by any of them. +;; +;; ENTIRE-MAP is the vector in which this vector appears. +;; If the definition in effect in the whole map does not match +;; the one in this vector, we ignore this one." +;; ;; Converted from describe_vector in keymap.c. +;; (let* ((first t) +;; (idx 0)) +;; (while (< idx (length vector)) +;; (let* ((val (aref vector idx)) +;; (definition (keymap--get-keyelt val nil)) +;; (start-idx idx) +;; this-shadowed +;; found-range) +;; (when (and definition +;; ;; Don't mention suppressed commands. +;; (not (and partial +;; (symbolp definition) +;; (get definition 'suppress-keymap))) +;; ;; If this binding is shadowed by some other map, +;; ;; ignore it. +;; (not (and shadow +;; (help--shadow-lookup shadow (vector start-idx) t nil) +;; (if mention-shadow +;; (prog1 nil (setq this-shadowed t)) +;; t))) +;; ;; Ignore this definition if it is shadowed by an earlier +;; ;; one in the same keymap. +;; (not (and entire-map +;; (not (eq (lookup-key entire-map (vector start-idx) t) +;; definition))))) +;; (when first +;; (insert "\n") +;; (setq first nil)) +;; (when (and prefix (> (length prefix) 0)) +;; (insert (format "%s" prefix))) +;; (insert (key-description (vector start-idx) prefix)) +;; ;; Find all consecutive characters or rows that have the +;; ;; same definition. +;; (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil) +;; definition) +;; (setq found-range t) +;; (setq idx (1+ idx))) +;; ;; If we have a range of more than one character, +;; ;; print where the range reaches to. +;; (when found-range +;; (insert " .. ") +;; (when (and prefix (> (length prefix) 0)) +;; (insert (format "%s" prefix))) +;; (insert (key-description (vector idx) prefix))) +;; (if transl +;; (help--describe-translation definition) +;; (help--describe-command definition)) +;; (when this-shadowed +;; (goto-char (1- (point))) +;; (insert " (binding currently shadowed)") +;; (goto-char (1+ (point)))))) +;; (setq idx (1+ idx))))) + (declare-function x-display-pixel-height "xfns.c" (&optional terminal)) (declare-function x-display-pixel-width "xfns.c" (&optional terminal)) @@ -1131,7 +1603,7 @@ window." ".") ((eq scroll 'other) ", \\[scroll-other-window] to scroll help.") - (scroll ", \\[scroll-up] to scroll help.")))) + (scroll ", \\[scroll-up-command] to scroll help.")))) (message "%s" (substitute-command-keys (concat quit-part scroll-part))))) diff --git a/lisp/hexl.el b/lisp/hexl.el index 38eca77e260..5d813c410c2 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -93,7 +93,15 @@ as that will override any bit grouping options set here." "Face used in address area of Hexl mode buffer.") (defface hexl-ascii-region - '((t (:inherit header-line))) + ;; Copied from `header-line`. We used to inherit from it, but that + ;; looks awful when the headerline is given a variable-pitch font or + ;; (even worse) a 3D look. + '((((class color grayscale) (background light)) + :background "grey90" :foreground "grey20" + :box nil) + (((class color grayscale) (background dark)) + :background "grey20" :foreground "grey90" + :box nil)) "Face used in ASCII area of Hexl mode buffer.") (defvar-local hexl-max-address 0 @@ -209,10 +217,14 @@ as that will override any bit grouping options set here." (make-variable-buffer-local 'hexl-ascii-overlay) (defvar hexl-font-lock-keywords - '(("^\\([0-9a-f]+:\\).\\{40\\} \\(.+$\\)" - ;; "^\\([0-9a-f]+:\\).+ \\(.+$\\)" + '(("^\\([0-9a-f]+:\\)\\( \\).\\{39\\}\\( \\)\\(.+$\\)" + ;; "^\\([0-9a-f]+:\\).+ \\(.+$\\)"v (1 'hexl-address-region t t) - (2 'hexl-ascii-region t t))) + ;; If `hexl-address-region' is using a variable-pitch font, the + ;; rest of the line isn't naturally aligned, so align them by hand. + (2 '(face nil display (space :align-to 10))) + (3 '(face nil display (space :align-to 51))) + (4 'hexl-ascii-region t t))) "Font lock keywords used in `hexl-mode'.") (defun hexl-rulerize (string bits) @@ -362,6 +374,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (setq-local font-lock-defaults '(hexl-font-lock-keywords t)) + (setq-local font-lock-extra-managed-props '(display)) (setq-local revert-buffer-function #'hexl-revert-buffer-function) (add-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer nil t) @@ -886,7 +899,7 @@ and their encoded form is inserted byte by byte." (when (null encoded) (setq internal (encode-coding-string internal 'utf-8-emacs) internal-hex - (mapconcat (function (lambda (c) (format "%x" c))) + (mapconcat (lambda (c) (format "%x" c)) internal " ")) (if (yes-or-no-p (format-message @@ -899,7 +912,7 @@ and their encoded form is inserted byte by byte." (substitute-command-keys "try \\[hexl-insert-hex-string]")))) (while (> num 0) (mapc - (function (lambda (c) (hexl-insert-char c 1))) encoded) + (lambda (c) (hexl-insert-char c 1)) encoded) (setq num (1- num)))))))) (defun hexl-self-insert-command (arg) diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el index 4cff2a42001..a3398f6e809 100644 --- a/lisp/hfy-cmap.el +++ b/lisp/hfy-cmap.el @@ -1,4 +1,4 @@ -;;; hfy-cmap.el --- Fallback color name -> rgb mapping for `htmlfontify' +;;; hfy-cmap.el --- Fallback color name -> rgb mapping for `htmlfontify' -*- lexical-binding:t -*- ;; Copyright (C) 2002-2003, 2009-2020 Free Software Foundation, Inc. @@ -809,6 +809,22 @@ (defconst hfy-rgb-regex "^\\s-*\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\(.+\\)\\s-*$") +(defun hfy-cmap--parse-buffer (buffer) + (with-current-buffer buffer + (let ((end-of-rgb 0) + result) + (goto-char (point-min)) + (htmlfontify-unload-rgb-file) + (while (/= end-of-rgb 1) + (if (looking-at hfy-rgb-regex) + (push (list (match-string 4) + (string-to-number (match-string 1)) + (string-to-number (match-string 2)) + (string-to-number (match-string 3))) + result)) + (setq end-of-rgb (forward-line))) + result))) + ;;;###autoload (defun htmlfontify-load-rgb-file (&optional file) "Load an X11 style rgb.txt FILE. @@ -818,25 +834,14 @@ Loads the variable `hfy-rgb-txt-color-map', which is used by (interactive (list (read-file-name "rgb.txt (equivalent) file: " "" nil t (hfy-rgb-file)))) - (let ((rgb-buffer nil) - (end-of-rgb 0) - (rgb-txt nil)) - (if (and (setq rgb-txt (or file (hfy-rgb-file))) - (file-readable-p rgb-txt)) - (with-current-buffer - (setq rgb-buffer (find-file-noselect rgb-txt 'nowarn)) - (goto-char (point-min)) - (htmlfontify-unload-rgb-file) - (while (/= end-of-rgb 1) - (if (looking-at hfy-rgb-regex) - (setq hfy-rgb-txt-color-map - (cons (list (match-string 4) - (string-to-number (match-string 1)) - (string-to-number (match-string 2)) - (string-to-number (match-string 3))) - hfy-rgb-txt-color-map)) ) - (setq end-of-rgb (forward-line))) - (kill-buffer rgb-buffer))))) + (let ((rgb-buffer nil) + (rgb-txt (or file (hfy-rgb-file)))) + (when (and rgb-txt + (file-readable-p rgb-txt)) + (setq rgb-buffer (find-file-noselect rgb-txt 'nowarn)) + (when-let ((result (hfy-cmap--parse-buffer rgb-buffer))) + (setq hfy-rgb-txt-color-map result)) + (kill-buffer rgb-buffer)))) (defun htmlfontify-unload-rgb-file () "Unload the current color name -> rgb translation map." diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 0fe651ace34..536a1af8462 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -136,9 +136,9 @@ patterns." (put 'hi-lock-file-patterns-policy 'risky-local-variable t) (defcustom hi-lock-auto-select-face nil - "Non-nil means highlighting commands do not prompt for the face to use. -Instead, each hi-lock command will cycle through the faces in -`hi-lock-face-defaults'." + "When nil, highlighting commands prompt for the face to use. +When non-nil, highlighting command determine the faces to use +by cycling through the faces in `hi-lock-face-defaults'." :type 'boolean :version "24.4") @@ -484,9 +484,17 @@ the major mode specifies support for Font Lock." (interactive (list (hi-lock-regexp-okay - (read-regexp "Regexp to highlight" 'regexp-history-last)) + (read-regexp "Regexp to highlight" + (if (use-region-p) + (prog1 + (buffer-substring (region-beginning) + (region-end)) + (deactivate-mark)) + 'regexp-history-last))) (hi-lock-read-face-name) current-prefix-arg)) + (when (stringp face) + (setq face (intern face))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern @@ -814,6 +822,7 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." (font-lock-add-keywords nil hi-lock-file-patterns t) (font-lock-flush))) +;;;###autoload (defun hi-lock-find-patterns () "Add patterns from the current buffer to the list of hi-lock patterns." (interactive) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 4d653972c95..ed2cd26f0de 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1034,7 +1034,7 @@ then the specification is returned unchanged." ((facep fn) (hfy-face-attr-for-class fn hfy-display-class)) ;; FIXME: is this necessary? Faces can be symbols, but - ;; not symbols refering to other symbols? + ;; not symbols referring to other symbols? ((and (symbolp fn) (facep (symbol-value fn))) (hfy-face-attr-for-class diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index c9a748830c1..8ff3b56c5e6 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1597,7 +1597,7 @@ If point is on a group name, this function operates on that group." (defun ibuffer-compile-make-substring-form (strvar maxvar from-end-p) (if from-end-p ;; FIXME: not sure if this case is correct (Bug#24972) - `(truncate-string-to-width str strlen (- strlen ,maxvar) nil ?\s) + `(truncate-string-to-width str strlen (- strlen ,maxvar) ?\s) `(truncate-string-to-width ,strvar ,maxvar nil ?\s))) (defun ibuffer-compile-make-format-form (strvar widthform alignment) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 47d78a0bc82..4e546807b7f 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -77,7 +77,7 @@ selection process starts again from the user's $HOME.") (defcustom icomplete-show-matches-on-no-input nil "When non-nil, show completions when first prompting for input. This also means that if you traverse the list of completions with -commands like `C-.' and just hit `C-j' (enter) without typing any +commands like `C-.' and just hit RET without typing any characters, the match under point will be chosen instead of the default." :type 'boolean @@ -157,12 +157,22 @@ icompletion is occurring." (defvar icomplete-minibuffer-map (let ((map (make-sparse-keymap))) (define-key map [?\M-\t] 'icomplete-force-complete) + (define-key map [remap minibuffer-complete-and-exit] 'icomplete-ret) (define-key map [?\C-j] 'icomplete-force-complete-and-exit) (define-key map [?\C-.] 'icomplete-forward-completions) (define-key map [?\C-,] 'icomplete-backward-completions) map) "Keymap used by `icomplete-mode' in the minibuffer.") +(defun icomplete-ret () + "Exit minibuffer for icomplete." + (interactive) + (if (and icomplete-show-matches-on-no-input + (car completion-all-sorted-completions) + (eql (icomplete--field-end) (icomplete--field-beg))) + (icomplete-force-complete-and-exit) + (minibuffer-complete-and-exit))) + (defun icomplete-force-complete-and-exit () "Complete the minibuffer with the longest possible match and exit. Use the first of the matches if there are any displayed, and use @@ -469,33 +479,70 @@ Usually run by inclusion in `minibuffer-setup-hook'." with beg = (icomplete--field-beg) with end = (icomplete--field-end) with all = (completion-all-sorted-completions beg end) - ;; First, establish the "bubble up" predicates. + ;; Icomplete mode re-sorts candidates, bubbling the default to + ;; top if it's found somewhere down the list. This loop's + ;; iteration variable, `fn' iterates through these "bubble up + ;; predicates" which may vary depending on specific + ;; `completing-read' invocations, described below: for fn in (cond ((and minibuffer-default (stringp minibuffer-default) ; bug#38992 (= (icomplete--field-end) (icomplete--field-beg))) - ;; When we have a non-nil string default and - ;; no input whatsoever: we want to make sure - ;; that default is bubbled to the top so that - ;; `icomplete-force-complete-and-exit' will - ;; select it (do that even if the match - ;; doesn't match the completion perfectly. - `(,(lambda (comp) + ;; Here, we have a non-nil string default and + ;; no input whatsoever. We want to make sure + ;; that the default is bubbled to the top so + ;; that `icomplete-force-complete-and-exit' + ;; will select it. We want to do that even if + ;; the match doesn't match the completion + ;; perfectly. + ;; + `(;; The first predicate ensures that: + ;; + ;; (completing-read "thing? " '("foo" "bar") + ;; nil nil nil nil "bar") + ;; + ;; Has "bar" at the top, so RET will select + ;; it, as desired. + ,(lambda (comp) (equal minibuffer-default comp)) + ;; Why do we need this second predicate? + ;; Because that'll make things like M-x man + ;; RET RET, when invoked with point on the + ;; "bar" word, behave correctly. There, the + ;; default doesn't quite match any + ;; candidate. So: + ;; + ;; (completing-read "Man entry? " '("foo(1)" "bar(1)") + ;; nil nil nil nil "bar") + ;; + ;; Will place "bar(1)" on top, and RET will + ;; select it -- again, as desired. + ;; + ;; FIXME: it's arguable that this second + ;; behaviour should be a property of the + ;; completion table and not the completion + ;; frontend such as we have done + ;; here. However, it seems generically + ;; useful for a very broad spectrum of + ;; cases. ,(lambda (comp) (string-prefix-p minibuffer-default comp)))) ((and fido-mode (not minibuffer-default) (eq (icomplete--category) 'file)) - ;; `fido-mode' has some extra file-sorting - ;; semantics even if there isn't a default, - ;; which is to bubble "./" to the top if it - ;; exists. This makes M-x dired RET RET go to - ;; the directory of current file, which is - ;; what vanilla Emacs and `ido-mode' both do. + ;; When there isn't a default, `fido-mode' + ;; specifically also has some extra + ;; file-sorting semantics inherited from Ido. + ;; Those make the directory "./" bubble to the + ;; top (if it exists). This makes M-x dired + ;; RET RET go to the directory of current + ;; file, which is non-Icomplete vanilla Emacs + ;; and `ido-mode' both do. `(,(lambda (comp) (string= "./" comp))))) - ;; Now, look for a completion matching one of those predicates - ;; to bubble up (unless that completion is already on top). + ;; After we have setup the predicates, look for a completion + ;; matching one of them and bubble up it, destructively on + ;; `completion-all-sorted-completions' (unless that completion + ;; happens to be already on top). thereis (or (and (funcall fn (car all)) all) (cl-loop @@ -718,10 +765,7 @@ matches exist." (push comp prospects) (setq limit t)))) (setq prospects (nreverse prospects)) - ;; Return the first match if the user hits enter. - (when icomplete-show-matches-on-no-input - (setq-local completion-content-when-empty (car prospects))) - ;; Decorate first of the prospects. + ;; Decorate first of the prospects. (when prospects (let ((first (copy-sequence (pop prospects)))) (put-text-property 0 (length first) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 6f297672caf..a29adde8325 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -60,12 +60,12 @@ ;; ============= ;; ;; * The ImageMagick package. Currently, `convert' and `mogrify' are -;; used. Find it here: http://www.imagemagick.org. +;; used. Find it here: https://www.imagemagick.org. ;; ;; * For non-lossy rotation of JPEG images, the JpegTRAN program is ;; needed. ;; -;; * For `image-dired-get-exif-data' and `image-dired-write-exif-data' to work, +;; * For `image-dired-get-exif-data' and `image-dired-set-exif-data' to work, ;; the command line tool `exiftool' is needed. It can be found here: ;; http://www.sno.phy.queensu.ca/~phil/exiftool/. These two functions ;; are, among other things, used for writing comments to image files @@ -205,7 +205,7 @@ the index.html page that image-dired creates." :group 'image-dired) (defcustom image-dired-gallery-image-root-url -"http://your.own.server/image-diredpics" +"https://your.own.server/image-diredpics" "URL where the full size images are to be found. Note that this path has to be configured in your web server. Image-Dired expects to find pictures in this directory." @@ -213,7 +213,7 @@ expects to find pictures in this directory." :group 'image-dired) (defcustom image-dired-gallery-thumb-image-root-url -"http://your.own.server/image-diredthumbs" +"https://your.own.server/image-diredthumbs" "URL where the thumbnail images are to be found. Note that this path has to be configured in your web server. Image-Dired expects to find pictures in this directory." @@ -309,7 +309,7 @@ temporary file name (typically generated by pnqnq)." :group 'image-dired) (defcustom image-dired-cmd-optipng-options '("-o5" "%t") - "Arguments passed to `image-dired-optipng-program'. + "Arguments passed to `image-dired-cmd-optipng-program'. Available format specifiers are described in `image-dired-cmd-create-thumbnail-options'." :version "26.1" diff --git a/lisp/image-file.el b/lisp/image-file.el index 22366c89e6a..3b4f5722518 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -1,4 +1,4 @@ -;;; image-file.el --- support for visiting image files +;;; image-file.el --- support for visiting image files -*- lexical-binding:t -*- ;; ;; Copyright (C) 2000-2020 Free Software Foundation, Inc. ;; @@ -90,7 +90,7 @@ the variable is set using \\[customize]." t) "\\'")))) (mapconcat - 'identity + #'identity (delq nil (list exts-regexp image-file-name-regexps (car (rassq 'imagemagick image-type-file-name-regexps)))) diff --git a/lisp/image.el b/lisp/image.el index 4b2faa992fc..9ebb603086e 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -841,7 +841,7 @@ multiplication factor for the current value." N=0 refers to the initial animation frame. COUNT is the total number of frames in the animation. TIME-ELAPSED is the total time that has elapsed since -`image-animate-start' was called. +`image-animate' was called. LIMIT determines when to stop. If t, loop forever. If nil, stop after displaying the last animation frame. Otherwise, stop after LIMIT seconds have elapsed. diff --git a/lisp/indent.el b/lisp/indent.el index 9f32cedfa4a..e67109ab431 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -52,23 +52,37 @@ or in the line's indentation, otherwise it inserts a \"real\" TAB character. If `complete', TAB first tries to indent the current line, and if the line was already indented, then try to complete the thing at point. -Some programming language modes have their own variable to control this, -e.g., `c-tab-always-indent', and do not respect this variable. - -If you want the TAB key to always insert a literal TAB character, -this can't be controlled by setting this variable. Instead you -could say something like: +Also see `tab-first-completion'. -\(setq overriding-terminal-local-map - (let ((map (make-sparse-keymap))) - (define-key map [?\t] 'self-insert-command) - map))" +Some programming language modes have their own variable to control this, +e.g., `c-tab-always-indent', and do not respect this variable." :group 'indent :type '(choice (const :tag "Always indent" t) (const :tag "Indent if inside indentation, else TAB" nil) (const :tag "Indent, or if already indented complete" complete))) +(defcustom tab-first-completion nil + "Governs the behavior of TAB completion on the first press of the key. +When nil, complete. When `eol', only complete if point is at the +end of a line. When `word', complete unless the next character +has word syntax (according to `syntax-after'). When +`word-or-paren', complete unless the next character is part of a +word or a parenthesis. When `word-or-paren-or-punct', complete +unless the next character is part of a word, parenthesis, or +punctuation. Typing TAB a second time always results in +completion. + +This variable has no effect unless `tab-always-indent' is `complete'." + :group 'indent + :type '(choice + (const :tag "Always complete" nil) + (const :tag "Unless at the end of a line" 'eol) + (const :tag "Unless looking at a word" 'word) + (const :tag "Unless at a word or parenthesis" 'word-or-paren) + (const :tag "Unless at a word, parenthesis, or punctuation." 'word-or-paren-or-punct)) + :version "27.1") + (defun indent-according-to-mode () "Indent line in proper way for current major mode. @@ -122,7 +136,7 @@ or performs symbol completion, depending on `tab-always-indent'. The function called to actually indent the line or insert a tab is given by the variable `indent-line-function'. -If a prefix argument is given, after this function indents the +If a prefix argument is given (ARG), after this function indents the current line or inserts a tab, it also rigidly indents the entire balanced expression which starts at the beginning of the current line, to reflect the current line's indentation. @@ -150,7 +164,8 @@ prefix argument is ignored." (t (let ((old-tick (buffer-chars-modified-tick)) (old-point (point)) - (old-indent (current-indentation))) + (old-indent (current-indentation)) + (syn `(,(syntax-after (point))))) ;; Indent the line. (or (not (eq (indent--funcall-widened indent-line-function) 'noindent)) @@ -163,7 +178,20 @@ prefix argument is ignored." ;; If the text was already indented right, try completion. ((and (eq tab-always-indent 'complete) (eq old-point (point)) - (eq old-tick (buffer-chars-modified-tick))) + (eq old-tick (buffer-chars-modified-tick)) + (or (null tab-first-completion) + (eq last-command this-command) + (and (equal tab-first-completion 'eol) + (eolp)) + (and (member tab-first-completion + '(word word-or-paren word-or-paren-or-punct)) + (not (member 2 syn))) + (and (member tab-first-completion + '(word-or-paren word-or-paren-or-punct)) + (not (or (member 4 syn) + (member 5 syn)))) + (and (equal tab-first-completion 'word-or-paren-or-punct) + (not (member 1 syn))))) (completion-at-point)) ;; If a prefix argument was given, rigidly indent the following @@ -221,7 +249,8 @@ It is activated by calling `indent-rigidly' interactively.") If called interactively with no prefix argument, activate a transient mode in which the indentation can be adjusted interactively by typing \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]. -Typing any other key deactivates the transient mode. +Typing any other key exits this mode. If `transient-mark-mode' is enabled, +exiting also deactivates the mark. If called from a program, or interactively with prefix ARG, indent all lines starting in the region forward by ARG columns. diff --git a/lisp/info.el b/lisp/info.el index dc1102aab30..c3684deb96b 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -67,7 +67,6 @@ Intermediate Info nodes are nodes visited by Info internally in the process of searching the node to display. Intermediate nodes are not presented to the user." :type 'boolean - :group 'info :version "24.1") (defvar Info-enable-active-nodes nil @@ -79,8 +78,7 @@ The Lisp code is executed when the node is selected.") '((((class color) (background light)) :foreground "brown" :weight bold :slant italic) (((class color) (background dark)) :foreground "white" :weight bold :slant italic) (t :weight bold :slant italic)) - "Face for Info node names." - :group 'info) + "Face for Info node names.") (defface info-title-1 '((((type tty pc) (class color) (background light)) @@ -88,26 +86,22 @@ The Lisp code is executed when the node is selected.") (((type tty pc) (class color) (background dark)) :foreground "yellow" :weight bold) (t :height 1.2 :inherit info-title-2)) - "Face for info titles at level 1." - :group 'info) + "Face for info titles at level 1.") (defface info-title-2 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) (t :height 1.2 :inherit info-title-3)) - "Face for info titles at level 2." - :group 'info) + "Face for info titles at level 2.") (defface info-title-3 '((((type tty pc) (class color)) :weight bold) (t :height 1.2 :inherit info-title-4)) - "Face for info titles at level 3." - :group 'info) + "Face for info titles at level 3.") (defface info-title-4 '((((type tty pc) (class color)) :weight bold) (t :weight bold :inherit variable-pitch)) - "Face for info titles at level 4." - :group 'info) + "Face for info titles at level 4.") (defface info-menu-header '((((type tty pc)) @@ -116,31 +110,26 @@ The Lisp code is executed when the node is selected.") (t :inherit variable-pitch :weight bold)) - "Face for headers in Info menus." - :group 'info) + "Face for headers in Info menus.") (defface info-menu-star '((((class color)) :foreground "red1") (t :underline t)) - "Face for every third `*' in an Info menu." - :group 'info) + "Face for every third `*' in an Info menu.") (defface info-xref '((t :inherit link)) - "Face for unvisited Info cross-references." - :group 'info) + "Face for unvisited Info cross-references.") (defface info-xref-visited '((t :inherit (link-visited info-xref))) "Face for visited Info cross-references." - :version "22.1" - :group 'info) + :version "22.1") (defcustom Info-fontify-visited-nodes t "Non-nil to fontify references to visited nodes in `info-xref-visited' face." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) ;; It's unfortunate that nil means no fontification, as opposed to no limit, ;; since that differs from font-lock-maximum-size. @@ -150,29 +139,24 @@ Set to nil to disable node fontification; set to t for no limit." :type '(choice (const :tag "No fontification" nil) (const :tag "No size limit" t) (integer :tag "Up to this many characters")) - :version "25.1" ; 100k -> 400k - :group 'info) + :version "25.1") ; 100k -> 400k (defcustom Info-use-header-line t "Non-nil means to put the beginning-of-node links in an Emacs header-line. A header-line does not scroll with the rest of the buffer." - :type 'boolean - :group 'info) + :type 'boolean) (defface info-header-xref '((t :inherit info-xref)) - "Face for Info cross-references in a node header." - :group 'info) + "Face for Info cross-references in a node header.") (defface info-header-node '((t :inherit info-node)) - "Face for Info nodes in a node header." - :group 'info) + "Face for Info nodes in a node header.") (defface info-index-match '((t :inherit match)) "Face used to highlight matches in an index entry." - :group 'info :version "24.4") ;; This is a defcustom largely so that we can get the benefit @@ -249,8 +233,7 @@ Although this is a customizable variable, that is mainly for technical reasons. Normally, you should either set INFOPATH or customize `Info-additional-directory-list', rather than changing this variable." :initialize 'custom-initialize-delay - :type '(repeat directory) - :group 'info)) + :type '(repeat directory))) (defvar Info-directory-list nil "List of directories to search for Info documentation files. @@ -285,8 +268,7 @@ a version of Emacs without installing it.") (defcustom Info-additional-directory-list nil "List of additional directories to search for Info documentation files. These directories are searched after those in `Info-directory-list'." - :type '(repeat directory) - :group 'info) + :type '(repeat directory)) (defcustom Info-scroll-prefer-subnodes nil "If non-nil, \\<Info-mode-map>\\[Info-scroll-up] in a menu visits subnodes. @@ -300,15 +282,15 @@ Setting this option to nil results in behavior similar to the stand-alone Info reader program, which visits the first subnode from the menu only when you hit the end of the current node." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) (defcustom Info-hide-note-references t "If non-nil, hide the tag and section reference in *note and * menu items. -If value is non-nil but not `hide', also replaces the \"*note\" with \"see\". -If value is non-nil but not t or `hide', the reference section is still shown. -nil completely disables this feature. If this is non-nil, you might -want to set `Info-refill-paragraphs'." +If the value is t, the default, replace \"*note\" with \"see\". +If the value is `hide', remove \"*note\" without replacing it with anything. +If value is non-nil, but not t or `hide', the reference section is still shown. +nil completely disables this feature, leaving the original \"*note\" visible. +If this is non-nil, you may wish setting `Info-refill-paragraphs' non-nil." :version "22.1" :type '(choice (const :tag "No hiding" nil) (const :tag "Replace tag and hide reference" t) @@ -319,8 +301,7 @@ want to set `Info-refill-paragraphs'." (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (derived-mode-p 'Info-mode) - (revert-buffer t t))))) - :group 'info) + (revert-buffer t t)))))) (defcustom Info-refill-paragraphs nil "If non-nil, attempt to refill paragraphs with hidden references. @@ -328,15 +309,13 @@ This refilling may accidentally remove explicit line breaks in the Info file, so be prepared for a few surprises if you enable this feature. This only has an effect if `Info-hide-note-references' is non-nil." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) (defcustom Info-breadcrumbs-depth 4 "Depth of breadcrumbs to display. 0 means do not display breadcrumbs." :version "23.1" - :type 'integer - :group 'info) + :type 'integer) (defcustom Info-search-whitespace-regexp "\\s-+" "If non-nil, regular expression to match a sequence of whitespace chars. @@ -346,8 +325,7 @@ In the Customization buffer, that is `[' followed by a space, a tab, a carriage return (control-M), a newline, and `]+'. Don't add any capturing groups into this value; that can change the numbering of existing capture groups in unexpected ways." - :type 'regexp - :group 'info) + :type 'regexp) (defcustom Info-isearch-search t "If non-nil, isearch in Info searches through multiple nodes. @@ -362,8 +340,7 @@ node depending on search direction. Setting this option to nil restores the default isearch behavior with wrapping around the current Info node." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) (defvar Info-isearch-initial-node nil) (defvar Info-isearch-initial-history nil) @@ -374,13 +351,11 @@ with wrapping around the current Info node." (unless (and (boundp 'Info-fontify) (null Info-fontify)) '(turn-on-font-lock)) "Hook run when activating Info Mode." - :type 'hook - :group 'info) + :type 'hook) (defcustom Info-selection-hook nil "Hook run when an Info node is selected as the current node." - :type 'hook - :group 'info) + :type 'hook) (defvar-local Info-current-file nil "Info file that Info is now looking at, or nil. @@ -638,14 +613,14 @@ Do the right thing if the file has been compressed or zipped." (insert-file-contents-literally fullname visit) (let ((inhibit-read-only t) (coding-system-for-write 'no-conversion) - (inhibit-nul-byte-detection t) ; Index nodes include null bytes + (inhibit-null-byte-detection t) ; Index nodes include null bytes (default-directory (or (file-name-directory fullname) default-directory))) (or (consp decoder) (setq decoder (list decoder))) (apply #'call-process-region (point-min) (point-max) (car decoder) t t nil (cdr decoder)))) - (let ((inhibit-nul-byte-detection t)) ; Index nodes include null bytes + (let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes (insert-file-contents fullname visit))) ;; Clear the caches of modified Info files. @@ -956,6 +931,7 @@ This function first looks for a case-sensitive match for NODENAME; if none is found it then tries a case-insensitive match (unless STRICT-CASE is non-nil)." (info-initialize) + (setq nodename (info--node-canonicalize-whitespace nodename)) (setq filename (Info-find-file filename)) ;; Go into Info buffer. (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) @@ -1374,7 +1350,7 @@ is non-nil)." ;; Index nodes include null bytes. DIR ;; files should not have indices, but who ;; knows... - (let ((inhibit-nul-byte-detection t)) + (let ((inhibit-null-byte-detection t)) (insert-file-contents file) (setq Info-dir-file-name file) (push (current-buffer) buffers) @@ -1472,9 +1448,10 @@ is non-nil)." (defvar Info-streamline-headings '(("Emacs" . "Emacs") - ("Programming" . "Programming") + ("Software development\\|Programming" . "Software development") ("Libraries" . "Libraries") - ("World Wide Web\\|Net Utilities" . "Net Utilities")) + ("Network applications\\|World Wide Web\\|Net Utilities" + . "Network applications")) "List of elements (RE . NAME) to merge headings matching RE to NAME.") (defun Info-dir-remove-duplicates () @@ -2684,14 +2661,16 @@ Because of ambiguities, this should be concatenated with something like ;;; (setq Info-point-loc ;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1)))) ) - (replace-regexp-in-string - "[ \n]+" " " + (info--node-canonicalize-whitespace (or (and (not (equal (match-string-no-properties 2) "")) (match-string-no-properties 2)) ;; If the node name is the menu entry name (using `entry::'). (buffer-substring-no-properties (match-beginning 0) (1- (match-beginning 1))))))) +(defun info--node-canonicalize-whitespace (string) + (replace-regexp-in-string "[ \t\n]+" " " string)) + ;; No one calls this. ;;(defun Info-menu-item-sequence (list) ;; (while list @@ -4050,6 +4029,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (define-key map "^" 'Info-up) (define-key map "," 'Info-index-next) (define-key map "\177" 'Info-scroll-down) + (define-key map [remap goto-line] 'goto-line-relative) (define-key map [mouse-2] 'Info-mouse-follow-nearest-node) (define-key map [follow-link] 'mouse-face) (define-key map [XF86Back] 'Info-history-back) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index b7656d9c1a7..0b6920cf180 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -60,7 +60,7 @@ Vietnamese") ;; For each group (row) of 2-byte character sets. (define-category ?A "2-byte alnum -Alpha-numeric characters of 2-byte character sets") +Alphanumeric characters of 2-byte character sets") (define-category ?C "2-byte han Chinese (Han) characters of 2-byte character sets") (define-category ?G "2-byte Greek diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 23abb0d0a9e..a52b6283c3e 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -191,6 +191,7 @@ (kanbun #x319D) (han #x5B57) (yi #xA288) + (javanese #xA980) (cham #xAA00) (tai-viet #xAA80) (hangul #xAC00) @@ -723,6 +724,7 @@ symbol braille yi + javanese tai-viet aegean-number ancient-greek-number diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el index e86efe5827b..0df07d65148 100644 --- a/lisp/international/iso-ascii.el +++ b/lisp/international/iso-ascii.el @@ -1,4 +1,4 @@ -;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals +;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals -*- lexical-binding: t -*- ;; Copyright (C) 1987, 1995, 1998, 2001-2020 Free Software Foundation, ;; Inc. @@ -41,8 +41,7 @@ (defcustom iso-ascii-convenient nil "Non-nil means `iso-ascii' should aim for convenience, not precision." - :type 'boolean - :group 'iso-ascii) + :type 'boolean) (defvar iso-ascii-display-table (make-display-table) "Display table used for ISO-ASCII mode.") diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index f5e70ce7021..5f645b6e8e4 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -329,12 +329,12 @@ Optional argument DIRNAME if specified is the directory name under which the generated Emacs Lisp is saved. The name of generated file is specified by the variable `ja-dic-filename'." (interactive "FSKK dictionary file: ") - (let* ((coding-system-for-read 'euc-japan) - (skkbuf (get-buffer-create " *skkdic-unannotated*")) + (let* ((skkbuf (get-buffer-create " *skkdic-unannotated*")) (buf (get-buffer-create "*skkdic-work*"))) ;; Set skkbuf to an unannotated copy of the dictionary. (with-current-buffer skkbuf - (insert-file-contents (expand-file-name filename)) + (let ((coding-system-for-read 'euc-japan)) + (insert-file-contents (expand-file-name filename))) (re-search-forward "^[^;]") (while (re-search-forward ";[^\n/]*/" nil t) (replace-match "/"))) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index ccc8ac9f9e6..e3155dfc52c 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1799,13 +1799,11 @@ The default status is as follows: 'raw-text) (set-default-coding-systems nil) - (setq default-sendmail-coding-system 'iso-latin-1) - ;; On Darwin systems, this should be utf-8-unix, but when this file is loaded - ;; that is not yet defined, so we set it in set-locale-environment instead. - ;; [Actually, it seems to work fine to use utf-8-unix here, and not just - ;; on Darwin. The previous comment seems to be outdated? - ;; See patch at https://debbugs.gnu.org/15803 ] - (setq default-file-name-coding-system 'iso-latin-1-unix) + (setq default-sendmail-coding-system 'utf-8) + (setq default-file-name-coding-system (if (memq system-type + '(window-nt ms-dos)) + 'iso-latin-1-unix + 'utf-8-unix)) ;; Preserve eol-type from existing default-process-coding-systems. ;; On non-unix-like systems in particular, these may have been set ;; carefully by the user, or by the startup code, to deal with the @@ -1821,8 +1819,10 @@ The default status is as follows: (input-coding (condition-case nil (coding-system-change-text-conversion - (cdr default-process-coding-system) 'iso-latin-1) - (coding-system-error 'iso-latin-1)))) + (cdr default-process-coding-system) + (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8)) + (coding-system-error + (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8))))) (setq default-process-coding-system (cons output-coding input-coding))) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index edda79ba4ee..42dd19842c8 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -39,7 +39,7 @@ ;; Society of Japan/Information Technology Standards Commission of ;; Japan (IPSJ/ITSCJ) at https://www.itscj.ipsj.or.jp/itscj_english/. ;; Standards docs equivalent to iso-2022 and iso-8859 are at -;; http://www.ecma.ch/. +;; https://www.ecma.ch/. ;; FWIW, http://www.microsoft.com/globaldev/ lists the following for ;; MS Windows, which are presumably the only charsets we really need @@ -1508,6 +1508,7 @@ for decoding and encoding files, process I/O, etc." :mime-charset 'us-ascii) (define-coding-system-alias 'iso-safe 'us-ascii) +(define-coding-system-alias 'ascii 'us-ascii) (define-coding-system 'utf-7 "UTF-7 encoding of Unicode (RFC 2152)." diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 660ac58e022..8f316332249 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -44,9 +44,22 @@ (setq i (1+ i))))) string) -(defvar truncate-string-ellipsis "..." ;"…" +(defvar truncate-string-ellipsis nil "String to use to indicate truncation. -Serves as default value of ELLIPSIS argument to `truncate-string-to-width'.") +Serves as default value of ELLIPSIS argument to `truncate-string-to-width' +returned by the function `truncate-string-ellipsis'.") + +(defun truncate-string-ellipsis () + "Return the string used to indicate truncation. +Use the value of the variable `truncate-string-ellipsis' when it's non-nil. +Otherwise, return the Unicode character U+2026 \"HORIZONTAL ELLIPSIS\" +when it's displayable on the selected frame, or `...'. This function +needs to be called on every use of `truncate-string-to-width' to +decide whether the selected frame can display that Unicode character." + (cond + (truncate-string-ellipsis) + ((char-displayable-p ?…) "…") + ("..."))) ;;;###autoload (defun truncate-string-to-width (str end-column @@ -73,7 +86,7 @@ If ELLIPSIS is non-nil, it should be a string which will replace the end of STR (including any padding) if it extends beyond END-COLUMN, unless the display width of STR is equal to or less than the display width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS -defaults to `truncate-string-ellipsis'. +defaults to `truncate-string-ellipsis', or to three dots when it's nil. If ELLIPSIS-TEXT-PROPERTY is non-nil, a too-long string will not be truncated, but instead the elided parts will be covered by a @@ -81,7 +94,7 @@ be truncated, but instead the elided parts will be covered by a (or start-column (setq start-column 0)) (when (and ellipsis (not (stringp ellipsis))) - (setq ellipsis truncate-string-ellipsis)) + (setq ellipsis (truncate-string-ellipsis))) (let ((str-len (length str)) (str-width (string-width str)) (ellipsis-width (if ellipsis (string-width ellipsis) 0)) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index c4febb26d4f..ad9c3a23066 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -855,10 +855,10 @@ VALUE is a CCL program name defined by `define-ccl-program'. The CCL program reads a character sequence and writes a byte sequence as an encoding result. -`:inhibit-nul-byte-detection' +`:inhibit-null-byte-detection' VALUE non-nil means Emacs ignore null bytes on code detection. -See the variable `inhibit-nul-byte-detection'. This attribute +See the variable `inhibit-null-byte-detection'. This attribute is meaningful only when `:coding-type' is `undecided'. `:inhibit-iso-escape-detection' @@ -903,7 +903,7 @@ non-ASCII files. This attribute is meaningful only when :ccl-encoder :valids)) ((eq coding-type 'undecided) - '(:inhibit-nul-byte-detection + '(:inhibit-null-byte-detection :inhibit-iso-escape-detection :prefer-utf-8)))))) @@ -1710,8 +1710,8 @@ in-place." ;; self-extracting exe archives. (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) '(("\\.\\(\ -arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|squashfs\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\|SQUASHFS\\)\\'" . no-conversion-multibyte) ("\\.\\(exe\\|EXE\\)\\'" . no-conversion) ("\\.\\(sx[dmicw]\\|odt\\|tar\\|t[bg]z\\)\\'" . no-conversion) diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index a6dcd02dc68..2da8635f80b 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -795,7 +795,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (forward-line 1))) (maphash #'(lambda (key val) (setq dic (cons (cons key val) dic))) table))) - (setq dic (sort dic (function (lambda (x y) (string< (car x ) (car y)))))) + (setq dic (sort dic (lambda (x y) (string< (car x ) (car y))))) (dolist (elt dic) (insert (format "(%S\t%S)\n" (car elt) (cdr elt)))) (let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B") @@ -956,7 +956,7 @@ method `chinese-tonepy' with which you must specify tones by digits (setq trans (mapconcat 'identity trans ""))))) (setq dic (cons (cons key trans) dic))) table))) - (setq dic (sort dic (function (lambda (x y) (string< (car x) (car y)))))) + (setq dic (sort dic (lambda (x y) (string< (car x) (car y))))) (goto-char (point-max)) (insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index b703d3dd2f2..33d0f0dda29 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -25,8 +25,8 @@ ;; This program has passed the NormalizationTest-5.2.0.txt. ;; ;; References: -;; http://www.unicode.org/reports/tr15/ -;; http://www.unicode.org/review/pr-29.html +;; https://www.unicode.org/reports/tr15/ +;; https://www.unicode.org/review/pr-29.html ;; ;; HFS-Normalization: ;; Reference: @@ -98,7 +98,7 @@ ;; ;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars') ;; -;; The block will be split to multiple samller blocks by starter +;; The block will be split to multiple smaller blocks by starter ;; characters. Each block is sorted, and composed if necessary. ;; ;; E. Composition of Entire Block (`ucs-normalize-compose-chars') @@ -131,7 +131,7 @@ #x1D1BF #x1D1C0) "Composition Exclusion List. This list is taken from - http://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt") + https://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt") ;; Unicode ranges that decompositions & combining characters are defined. (defvar check-range nil) diff --git a/lisp/isearch.el b/lisp/isearch.el index 7fb1d8a3ca6..245bf452b1f 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -54,7 +54,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(declare-function tmm-menubar-keymap "tmm.el") ;; Some additional options and constants. @@ -269,6 +268,17 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' "Non-nil means incremental search highlights the current match." :type 'boolean) +(defcustom search-highlight-submatches t + "Whether to highlight regexp subexpressions of the current regexp match. +The faces used to do the highlights are named `isearch-group-1', +`isearch-group-2', etc. (By default, only these 2 are defined.) +When there are more matches than faces, then faces are reused from the +beginning, in a cyclical manner, so the `isearch-group-1' face is +isreused for the third match. If you want to use more distinctive colors, +you can define more of these faces using the same numbering scheme." + :type 'boolean + :version "28.1") + (defface isearch '((((class color) (min-colors 88) (background light)) ;; The background must not be too dark, for that means @@ -494,7 +504,7 @@ This is like `describe-bindings', but displays only Isearch keys." (require 'tmm) (run-hooks 'menu-bar-update-hook) (let ((command nil)) - (let ((menu-bar (tmm-menubar-keymap))) + (let ((menu-bar (menu-bar-keymap))) (with-isearch-suspended (setq command (let ((isearch-mode t)) ; Show bindings from ; `isearch-mode-map' in @@ -880,7 +890,7 @@ variable by the command `isearch-toggle-lax-whitespace'.") "Stack of search status elements. Each element is an `isearch--state' struct where the slots are [STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD/REGEXP-FUNCTION - ERROR WRAPPED BARRIER CASE-FOLD-SEARCH POP-FUN]") + ERROR WRAPPED BARRIER CASE-FOLD-SEARCH POP-FUN MATCH-DATA]") (defvar isearch-string "") ; The current search string. (defvar isearch-message "") ; text-char-description version of isearch-string @@ -896,6 +906,7 @@ Each element is an `isearch--state' struct where the slots are "Recorded minimum/maximal point for the current search.") (defvar isearch-just-started nil) (defvar isearch-start-hscroll 0) ; hscroll when starting the search. +(defvar isearch-match-data nil) ; match-data of regexp-based search ;; case-fold-search while searching. ;; either nil, t, or 'yes. 'yes means the same as t except that mixed @@ -1214,6 +1225,7 @@ used to set the value of `isearch-regexp-function'." isearch-small-window nil isearch-just-started t isearch-start-hscroll (window-hscroll) + isearch-match-data nil isearch-opoint (point) search-ring-yank-pointer nil @@ -1342,8 +1354,8 @@ The last thing is to trigger a new round of lazy highlighting." (set-window-hscroll (selected-window) current-scroll)))) (if isearch-other-end (if (< isearch-other-end (point)) ; isearch-forward? - (isearch-highlight isearch-other-end (point)) - (isearch-highlight (point) isearch-other-end)) + (isearch-highlight isearch-other-end (point) isearch-match-data) + (isearch-highlight (point) isearch-other-end isearch-match-data)) (isearch-dehighlight)))) (setq ;; quit-flag nil not for isearch-mode isearch-adjusted nil @@ -1501,7 +1513,8 @@ REGEXP if non-nil says use the regexp search ring." (barrier isearch-barrier) (case-fold-search isearch-case-fold-search) (pop-fun (if isearch-push-state-function - (funcall isearch-push-state-function)))))) + (funcall isearch-push-state-function))) + (match-data isearch-match-data)))) (string nil :read-only t) (message nil :read-only t) (point nil :read-only t) @@ -1513,7 +1526,8 @@ REGEXP if non-nil says use the regexp search ring." (wrapped nil :read-only t) (barrier nil :read-only t) (case-fold-search nil :read-only t) - (pop-fun nil :read-only t)) + (pop-fun nil :read-only t) + (match-data nil :read-only t)) (defun isearch--set-state (cmd) (setq isearch-string (isearch--state-string cmd) @@ -1525,7 +1539,8 @@ REGEXP if non-nil says use the regexp search ring." isearch-error (isearch--state-error cmd) isearch-wrapped (isearch--state-wrapped cmd) isearch-barrier (isearch--state-barrier cmd) - isearch-case-fold-search (isearch--state-case-fold-search cmd)) + isearch-case-fold-search (isearch--state-case-fold-search cmd) + isearch-match-data (isearch--state-match-data cmd)) (if (functionp (isearch--state-pop-fun cmd)) (funcall (isearch--state-pop-fun cmd) cmd)) (goto-char (isearch--state-point cmd))) @@ -1617,6 +1632,7 @@ You can update the global isearch variables by setting new values to (isearch-adjusted isearch-adjusted) (isearch-yank-flag isearch-yank-flag) (isearch-error isearch-error) + (isearch-match-data isearch-match-data) (multi-isearch-file-list-new multi-isearch-file-list) (multi-isearch-buffer-list-new multi-isearch-buffer-list) @@ -2518,6 +2534,8 @@ is bound to outside of Isearch." (let ((pasted-text (nth 1 event))) (isearch-yank-string pasted-text)))) +(defvar isearch--yank-prev-point nil) + (defun isearch-yank-internal (jumpform) "Pull the text from point to the point reached by JUMPFORM. JUMPFORM is a lambda expression that takes no arguments and returns @@ -2528,7 +2546,14 @@ or it might return the position of the end of the line." (save-excursion (and (not isearch-forward) isearch-other-end (goto-char isearch-other-end)) - (buffer-substring-no-properties (point) (funcall jumpform))))) + (and (not isearch-success) isearch--yank-prev-point + (goto-char isearch--yank-prev-point)) + (buffer-substring-no-properties + (point) + (prog1 + (setq isearch--yank-prev-point (funcall jumpform)) + (when isearch-success + (setq isearch--yank-prev-point nil))))))) (defun isearch-yank-char-in-minibuffer (&optional arg) "Pull next character from buffer into end of search string in minibuffer." @@ -3237,6 +3262,8 @@ the word mode." (< (point) isearch-opoint))) "over") (if isearch-wrapped "wrapped ") + (if (and (not isearch-success) (buffer-narrowed-p) widen-automatically) + "narrowed-buffer " "") (if (and (not isearch-success) (not isearch-case-fold-search)) "case-sensitive ") (let ((prefix "")) @@ -3425,9 +3452,10 @@ Optional third argument, if t, means if fail just return nil (no error). (match-beginning 0) (match-end 0))) (setq retry nil))) (setq isearch-just-started nil) - (if isearch-success - (setq isearch-other-end - (if isearch-forward (match-beginning 0) (match-end 0))))) + (when isearch-success + (setq isearch-other-end + (if isearch-forward (match-beginning 0) (match-end 0))) + (setq isearch-match-data (match-data t)))) (quit (isearch-unread ?\C-g) (setq isearch-success nil)) @@ -3654,8 +3682,29 @@ since they have special meaning in a regexp." ;; Highlighting (defvar isearch-overlay nil) +(defvar isearch-submatches-overlays nil) + +(defface isearch-group-1 + '((((class color) (min-colors 88) (background light)) + (:background "#f000f0" :foreground "lightskyblue1")) + (((class color) (min-colors 88) (background dark)) + (:background "palevioletred1" :foreground "brown4")) + (t (:inherit isearch))) + "Face for highlighting Isearch the odd group matches." + :group 'isearch + :version "28.1") + +(defface isearch-group-2 + '((((class color) (min-colors 88) (background light)) + (:background "#a000a0" :foreground "lightskyblue1")) + (((class color) (min-colors 88) (background dark)) + (:background "palevioletred3" :foreground "brown4")) + (t (:inherit isearch))) + "Face for highlighting Isearch the even group matches." + :group 'isearch + :version "28.1") -(defun isearch-highlight (beg end) +(defun isearch-highlight (beg end &optional match-data) (if search-highlight (if isearch-overlay ;; Overlay already exists, just move it. @@ -3664,11 +3713,33 @@ since they have special meaning in a regexp." (setq isearch-overlay (make-overlay beg end)) ;; 1001 is higher than lazy's 1000 and ediff's 100+ (overlay-put isearch-overlay 'priority 1001) - (overlay-put isearch-overlay 'face isearch-face)))) + (overlay-put isearch-overlay 'face isearch-face))) + + (when (and search-highlight-submatches + isearch-regexp) + (mapc 'delete-overlay isearch-submatches-overlays) + (setq isearch-submatches-overlays nil) + (let ((submatch-data (cddr (butlast match-data))) + (group 0) + ov face) + (while submatch-data + (setq group (1+ group)) + (setq ov (make-overlay (pop submatch-data) (pop submatch-data)) + face (intern-soft (format "isearch-group-%d" group))) + ;; Recycle faces from beginning. + (unless (facep face) + (setq group 1 face 'isearch-group-1)) + (overlay-put ov 'face face) + (overlay-put ov 'priority 1002) + (push ov isearch-submatches-overlays))))) (defun isearch-dehighlight () (when isearch-overlay - (delete-overlay isearch-overlay))) + (delete-overlay isearch-overlay)) + (when search-highlight-submatches + (mapc 'delete-overlay isearch-submatches-overlays) + (setq isearch-submatches-overlays nil))) + ;; isearch-lazy-highlight feature ;; by Bob Glickstein <http://www.zanshin.com/~bobg/> diff --git a/lisp/json.el b/lisp/json.el index 9002e868537..c2fc1574faa 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -432,14 +432,14 @@ Initialized lazily by `json-encode-string'.") ;; string length as our heuristic. See also bug#20154. (if (and (< (length string) json--long-string-threshold) (not (string-match-p (rx json--escape) string))) - (concat "\"" string "\"") + (concat "\"" (substring-no-properties string) "\"") (with-current-buffer (or json--string-buffer (with-current-buffer (generate-new-buffer " *json-string*") ;; This seems to afford decent performance gains. (setq-local inhibit-modification-hooks t) (setq json--string-buffer (current-buffer)))) - (insert ?\" string) + (insert ?\" (substring-no-properties string)) ; see bug#43549 (goto-char (1+ (point-min))) (while (re-search-forward (rx json--escape) nil 'move) (let ((char (preceding-char))) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 2d50df70fd4..7de6baeb00a 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; This library implements the JSONRPC 2.0 specification as described -;; in http://www.jsonrpc.org/. As the name suggests, JSONRPC is a +;; in https://www.jsonrpc.org/. As the name suggests, JSONRPC is a ;; generic Remote Procedure Call protocol designed around JSON ;; objects. To learn how to write JSONRPC programs with this library, ;; see Info node `(elisp)JSONRPC'." @@ -239,8 +239,8 @@ JSON object. The caller can expect SUCCESS-FN or ERROR-FN to be called with a JSONRPC `:result' or `:error' object, respectively. If this doesn't happen after TIMEOUT seconds (defaults to -`jsonrpc-request-timeout'), the caller can expect TIMEOUT-FN to be -called with no arguments. The default values of SUCCESS-FN, +`jrpc-default-request-timeout'), the caller can expect TIMEOUT-FN +to be called with no arguments. The default values of SUCCESS-FN, ERROR-FN and TIMEOUT-FN simply log the events into `jsonrpc-events-buffer'. @@ -274,7 +274,7 @@ error of type `jsonrpc-error'. DEFERRED is passed to `jsonrpc-async-request', which see. If CANCEL-ON-INPUT is non-nil and the user inputs something while -the functino is waiting, then it exits immediately, returning +the function is waiting, then it exits immediately, returning CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are ignored." (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer @@ -336,7 +336,7 @@ ignored." "Time in seconds before timing out a JSONRPC request.") -;;; Specfic to `jsonrpc-process-connection' +;;; Specific to `jsonrpc-process-connection' ;;; (defclass jsonrpc-process-connection (jsonrpc-connection) @@ -649,7 +649,7 @@ TIMEOUT is nil)." (if (jsonrpc-connection-ready-p connection deferred) ;; Server is ready, we jump below and send it immediately. (remhash (list deferred buf) (jsonrpc--deferred-actions connection)) - ;; Otherwise, save in `eglot--deferred-actions' and exit non-locally + ;; Otherwise, save in `jsonrpc--deferred-actions' and exit non-locally (unless old-id (jsonrpc--debug connection `(:deferring ,method :id ,id :params ,params))) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 3a59708d837..3437dba5e6a 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -924,7 +924,7 @@ The ARG parameter is unused." nil (if kmacro-view-last-item (concat (cond ((= kmacro-view-item-no 2) "2nd") - ((= kmacro-view-item-no 3) "3nd") + ((= kmacro-view-item-no 3) "3rd") (t (format "%dth" kmacro-view-item-no))) " previous macro") "Last macro"))) diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el index 1888c8f86a2..d689e87d785 100644 --- a/lisp/language/burmese.el +++ b/lisp/language/burmese.el @@ -1,4 +1,4 @@ -;;; burmese.el --- support for Burmese -*- coding: utf-8 -*- +;;; burmese.el --- support for Burmese -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/cham.el b/lisp/language/cham.el index 4749f2e8db4..eef6d6f8f9f 100644 --- a/lisp/language/cham.el +++ b/lisp/language/cham.el @@ -1,4 +1,4 @@ -;;; cham.el --- support for Cham -*- coding: utf-8 -*- +;;; cham.el --- support for Cham -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011, 2012 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/czech.el b/lisp/language/czech.el index b3cc152d25e..e6923426b52 100644 --- a/lisp/language/czech.el +++ b/lisp/language/czech.el @@ -1,4 +1,4 @@ -;;; czech.el --- support for Czech -*- coding: utf-8 -*- +;;; czech.el --- support for Czech -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el index 3e3c1df31a0..53c994bd76f 100644 --- a/lisp/language/georgian.el +++ b/lisp/language/georgian.el @@ -1,4 +1,4 @@ -;;; georgian.el --- language support for Georgian +;;; georgian.el --- language support for Georgian -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/greek.el b/lisp/language/greek.el index 2fec52637be..15ae5f42f94 100644 --- a/lisp/language/greek.el +++ b/lisp/language/greek.el @@ -1,4 +1,4 @@ -;;; greek.el --- support for Greek +;;; greek.el --- support for Greek -*- lexical-binding: t -*- ;; Copyright (C) 2002, 2013-2020 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el index 4a070321961..37173c9fb95 100644 --- a/lisp/language/khmer.el +++ b/lisp/language/khmer.el @@ -1,4 +1,4 @@ -;;; khmer.el --- support for Khmer -*- coding: utf-8 -*- +;;; khmer.el --- support for Khmer -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index 296dbd78970..3821785da73 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el @@ -46,7 +46,7 @@ (concat "korean-hangul" default-korean-keyboard)))) (defun quail-hangul-switch-symbol-ksc (&rest ignore) - "Swith to/from Korean symbol package." + "Switch to/from Korean symbol package." (interactive "i") (and current-input-method (if (string-equal current-input-method "korean-symbol") @@ -55,7 +55,7 @@ (activate-input-method "korean-symbol")))) (defun quail-hangul-switch-hanja (&rest ignore) - "Swith to/from Korean hanja package." + "Switch to/from Korean hanja package." (interactive "i") (and current-input-method (if (string-match "korean-hanja" current-input-method) diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index e3a24c41536..089b79c5208 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -141,6 +141,59 @@ thin (i.e. 1-dot width) space." (vector "[\u0600-\u074F\u200C\u200D]+" 0 'arabic-shape-gstring))) +;; The Egyptian Hieroglyph Format Controls were introduced in Unicode +;; Standard v12.0. Apparently, they are not yet well supported in +;; existing fonts, as of late 2020. But there's no reason for us not +;; to be ready for when they will be! +;; The below is needed to support the arrangement of the Egyptian +;; Hieroglyphs in "quadrats", as directed by the format controls, +;; which specify how the hieroglyphs should be joined horizontally and +;; vertically. +(defun egyptian-shape-grouping (gstring direction) + (if (= (lgstring-char gstring 0) #x13437) + (let ((nchars (lgstring-char-len gstring)) + (i 1) + (nesting 1) + ch) + ;; Find where this group ends. + (while (and (< i nchars) (> nesting 0)) + (setq ch (lgstring-char gstring i)) + (cond + ((= ch #x13437) + (setq nesting (1+ nesting))) + ((= ch #x13438) + (setq nesting (1- nesting)))) + (setq i (1+ i))) + (when (zerop nesting) + ;; Make a new gstring from the characters that constitute a + ;; complete nested group. + (let ((new-header (make-vector (1+ i) nil)) + (new-gstring (make-vector (+ i 2) nil))) + (aset new-header 0 (lgstring-font gstring)) + (dotimes (j i) + (aset new-header (1+ j) (lgstring-char gstring j)) + (lgstring-set-glyph new-gstring j (lgstring-glyph gstring j))) + (lgstring-set-header new-gstring new-header) + (font-shape-gstring new-gstring direction)))))) + +(let ((hieroglyph "[\U00013000-\U0001342F]")) + ;; HORIZONTAL/VERTICAL JOINER and INSERT AT.../OVERLAY controls + (set-char-table-range + composition-function-table + '(#x13430 . #x13436) + (list (vector (concat hieroglyph "[\U00013430-\U00013436]" hieroglyph) + ;; We use font-shape-gstring so that, if the font + ;; doesn't support these controls, the glyphs are + ;; displayed individually, and not as a single + ;; grapheme cluster. + 1 'font-shape-gstring))) + ;; Grouping controls + (set-char-table-range + composition-function-table + #x13437 + (list (vector "\U00013437[\U00013000-\U0001343F]+" + 0 'egyptian-shape-grouping)))) + (provide 'misc-lang) ;;; misc-lang.el ends here diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el index 0cd1d61de0f..9f1c67765e1 100644 --- a/lisp/language/romanian.el +++ b/lisp/language/romanian.el @@ -1,4 +1,4 @@ -;;; romanian.el --- support for Romanian -*- coding: utf-8 -*- +;;; romanian.el --- support for Romanian -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el index efd8aacc5ac..90fc41c1c41 100644 --- a/lisp/language/sinhala.el +++ b/lisp/language/sinhala.el @@ -1,4 +1,4 @@ -;;; sinhala.el --- support for Sinhala -*- coding: utf-8 -*- +;;; sinhala.el --- support for Sinhala -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el index bc70a05ad08..c42a872574d 100644 --- a/lisp/language/slovak.el +++ b/lisp/language/slovak.el @@ -1,4 +1,4 @@ -;;; slovak.el --- support for Slovak -*- coding: utf-8 -*- +;;; slovak.el --- support for Slovak -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el index 22295f39e52..039e478b162 100644 --- a/lisp/language/tai-viet.el +++ b/lisp/language/tai-viet.el @@ -1,4 +1,4 @@ -;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8 -*- +;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. ;; Copyright (C) 2007, 2008, 2009, 2010, 2011 diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el index 8684cdb1338..04369f6af87 100644 --- a/lisp/language/tibet-util.el +++ b/lisp/language/tibet-util.el @@ -275,7 +275,7 @@ The returned string has no composition information." (compose-region from to components))))))) (defvar tibetan-decompose-precomposition-alist - (mapcar (function (lambda (x) (cons (string-to-char (cdr x)) (car x)))) + (mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x))) tibetan-precomposition-rule-alist)) ;;;###autoload diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el index 78fbae3c89d..9e59f61ee10 100644 --- a/lisp/language/utf-8-lang.el +++ b/lisp/language/utf-8-lang.el @@ -1,4 +1,4 @@ -;;; utf-8-lang.el --- generic UTF-8 language environment +;;; utf-8-lang.el --- generic UTF-8 language environment -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el index cb282db0762..c1cef962865 100644 --- a/lisp/language/vietnamese.el +++ b/lisp/language/vietnamese.el @@ -1,4 +1,4 @@ -;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; -*- +;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 40a4150628a..f5ae3adf2eb 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -511,10 +511,13 @@ Return t if `allout-mode' is active in current buffer." nil t) (autoload 'allout-mode "allout" "\ Toggle Allout outline mode. -If called interactively, enable Allout mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Allout mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -829,10 +832,13 @@ See `allout-widgets-mode' for allout widgets mode features.") (autoload 'allout-widgets-mode "allout-widgets" "\ Toggle Allout Widgets mode. -If called interactively, enable Allout-Widgets mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Allout-Widgets mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1246,15 +1252,17 @@ Entering array mode calls the function `array-mode-hook'. ;;;### (autoloads nil "artist" "textmodes/artist.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/artist.el -(push (purecopy '(artist 1 2 6)) package--builtin-versions) (autoload 'artist-mode "artist" "\ Toggle Artist mode. -If called interactively, enable Artist mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Artist mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1586,10 +1594,13 @@ or call the function `autoarg-kp-mode'.") (autoload 'autoarg-kp-mode "autoarg" "\ Toggle Autoarg-KP mode, a global minor mode. -If called interactively, enable Autoarg-Kp mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Autoarg-Kp mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1645,10 +1656,13 @@ or call the function `auto-insert-mode'.") (autoload 'auto-insert-mode "autoinsert" "\ Toggle Auto-insert mode, a global minor mode. -If called interactively, enable Auto-Insert mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Auto-Insert mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1696,14 +1710,29 @@ The function does NOT recursively descend into subdirectories of the directory or directories specified. In an interactive call, prompt for a default output file for the -autoload definitions, and temporarily bind the variable -`generated-autoload-file' to this value. When called from Lisp, -use the existing value of `generated-autoload-file'. If any Lisp -file binds `generated-autoload-file' as a file-local variable, -write its autoloads into the specified file instead. +autoload definitions. When called from Lisp, use the existing +value of `generated-autoload-file'. If any Lisp file binds +`generated-autoload-file' as a file-local variable, write its +autoloads into the specified file instead. \(fn &rest DIRS)" t nil) +(make-obsolete 'update-directory-autoloads 'make-directory-autoloads '"28.1") + +(autoload 'make-directory-autoloads "autoload" "\ +Update autoload definitions for Lisp files in the directories DIRS. +DIR can be either a single directory or a list of +directories. (The latter usage is discouraged.) + +The autoloads will be written to OUTPUT-FILE. If any Lisp file +binds `generated-autoload-file' as a file-local variable, write +its autoloads into the specified file instead. + +The function does NOT recursively descend into subdirectories of the +directory or directories specified. + +\(fn DIR OUTPUT-FILE)" t nil) + (autoload 'batch-update-autoloads "autoload" "\ Update loaddefs.el autoloads in batch mode. Calls `update-directory-autoloads' on the command line arguments. @@ -1720,10 +1749,13 @@ should be non-nil)." nil nil) (autoload 'auto-revert-mode "autorevert" "\ Toggle reverting buffer when the file changes (Auto-Revert Mode). -If called interactively, enable Auto-Revert mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Auto-Revert mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1750,10 +1782,13 @@ This function is designed to be added to hooks, for example: (autoload 'auto-revert-tail-mode "autorevert" "\ Toggle reverting tail of buffer when the file grows. -If called interactively, enable Auto-Revert-Tail mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Auto-Revert-Tail mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1794,10 +1829,13 @@ or call the function `global-auto-revert-mode'.") (autoload 'global-auto-revert-mode "autorevert" "\ Toggle Global Auto-Revert Mode. -If called interactively, enable Global Auto-Revert mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Global Auto-Revert mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -1928,10 +1966,13 @@ or call the function `display-battery-mode'.") (autoload 'display-battery-mode "battery" "\ Toggle battery status display in mode line (Display Battery mode). -If called interactively, enable Display-Battery mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Display-Battery mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -2907,10 +2948,13 @@ columns on its right towards the left. (autoload 'bug-reference-mode "bug-reference" "\ Toggle hyperlinking bug references in the buffer (Bug Reference mode). -If called interactively, enable Bug-Reference mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Bug-Reference mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -2920,10 +2964,13 @@ disabled. (autoload 'bug-reference-prog-mode "bug-reference" "\ Like `bug-reference-mode', but only buttonize in comments and strings. -If called interactively, enable Bug-Reference-Prog mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Bug-Reference-Prog mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -2998,11 +3045,14 @@ that already has a `.elc' file. Compile a file of Lisp code named FILENAME into a file of byte code. The output file's name is generated by passing FILENAME to the function `byte-compile-dest-file' (which see). -With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling. The value is non-nil if there were no errors, nil if errors. +See also `emacs-lisp-byte-compile-and-load'. + \(fn FILENAME &optional LOAD)" t nil) +(set-advertised-calling-convention 'byte-compile-file '(filename) '"28.1") + (autoload 'compile-defun "bytecomp" "\ Compile and evaluate the current top-level form. Print the result in the echo area. @@ -3295,14 +3345,6 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "calc-aent" "calc/calc-aent.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from calc/calc-aent.el - -(register-definition-prefixes "calc-aent" '("calc" "math-")) - -;;;*** - ;;;### (autoloads nil "calc-alg" "calc/calc-alg.el" (0 0 0 0)) ;;; Generated autoloads from calc/calc-alg.el @@ -3338,14 +3380,6 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "calc-embed" "calc/calc-embed.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from calc/calc-embed.el - -(register-definition-prefixes "calc-embed" '("calc-")) - -;;;*** - ;;;### (autoloads nil "calc-ext" "calc/calc-ext.el" (0 0 0 0)) ;;; Generated autoloads from calc/calc-ext.el @@ -3444,14 +3478,6 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "calc-misc" "calc/calc-misc.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from calc/calc-misc.el - -(register-definition-prefixes "calc-misc" '("math-iipow")) - -;;;*** - ;;;### (autoloads nil "calc-mode" "calc/calc-mode.el" (0 0 0 0)) ;;; Generated autoloads from calc/calc-mode.el @@ -3562,14 +3588,6 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "calc-yank" "calc/calc-yank.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from calc/calc-yank.el - -(register-definition-prefixes "calc-yank" '("calc-" "math-number-regexp")) - -;;;*** - ;;;### (autoloads nil "calcalg2" "calc/calcalg2.el" (0 0 0 0)) ;;; Generated autoloads from calc/calcalg2.el @@ -4499,7 +4517,6 @@ from which to start. ;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/chart.el -(push (purecopy '(chart 0 2)) package--builtin-versions) (register-definition-prefixes "chart" '("chart")) @@ -4692,10 +4709,13 @@ Prefix argument is the same as for `checkdoc-defun'." t nil) (autoload 'checkdoc-minor-mode "checkdoc" "\ Toggle automatic docstring checking (Checkdoc minor mode). -If called interactively, enable Checkdoc minor mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Checkdoc minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -4788,14 +4808,6 @@ and runs the normal hook `command-history-hook'." t nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "cl-extra" "emacs-lisp/cl-extra.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/cl-extra.el - -(register-definition-prefixes "cl-extra" '("cl-")) - -;;;*** - ;;;### (autoloads nil "cl-font-lock" "progmodes/cl-font-lock.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/cl-font-lock.el @@ -4813,10 +4825,13 @@ or call the function `cl-font-lock-built-in-mode'.") (autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\ Highlight built-in functions, variables, and types in `lisp-mode'. -If called interactively, enable Cl-Font-Lock-Built-In mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Cl-Font-Lock-Built-In mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5028,10 +5043,13 @@ This can be needed when using code byte-compiled using the old macro-expansion of `cl-defstruct' that used vectors objects instead of record objects. -If called interactively, enable Cl-Old-Struct-Compat mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Cl-Old-Struct-Compat mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5042,14 +5060,6 @@ disabled. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "cl-macs" "emacs-lisp/cl-macs.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/cl-macs.el - -(register-definition-prefixes "cl-macs" '("cl-")) - -;;;*** - ;;;### (autoloads nil "cl-print" "emacs-lisp/cl-print.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/cl-print.el @@ -5106,14 +5116,6 @@ limit. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "cl-seq" "emacs-lisp/cl-seq.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/cl-seq.el - -(register-definition-prefixes "cl-seq" '("cl--")) - -;;;*** - ;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cmacexp.el @@ -5480,10 +5482,13 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see). (autoload 'compilation-shell-minor-mode "compile" "\ Toggle Compilation Shell minor mode. -If called interactively, enable Compilation-Shell minor mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Compilation-Shell minor mode'. If +the prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5498,10 +5503,13 @@ See `compilation-mode'. (autoload 'compilation-minor-mode "compile" "\ Toggle Compilation minor mode. -If called interactively, enable Compilation minor mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Compilation minor mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5538,10 +5546,13 @@ or call the function `dynamic-completion-mode'.") (autoload 'dynamic-completion-mode "completion" "\ Toggle dynamic word-completion on or off. -If called interactively, enable Dynamic-Completion mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Dynamic-Completion mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -5950,12 +5961,12 @@ Variables controlling indentation style: `cperl-min-label-indent' Minimal indentation for line that is a label. -Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith - `cperl-indent-level' 5 4 2 4 - `cperl-brace-offset' 0 0 0 0 - `cperl-continued-brace-offset' -5 -4 0 0 - `cperl-label-offset' -5 -4 -2 -4 - `cperl-continued-statement-offset' 5 4 2 4 +Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith + `cperl-indent-level' 5 4 2 4 4 + `cperl-brace-offset' 0 0 0 0 0 + `cperl-continued-brace-offset' -5 -4 0 0 0 + `cperl-label-offset' -5 -4 -2 -2 -4 + `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the corresponding variables. Use \\[cperl-set-style] to do this. Use @@ -6102,10 +6113,13 @@ or call the function `cua-mode'.") (autoload 'cua-mode "cua-base" "\ Toggle Common User Access style editing (CUA mode). -If called interactively, enable Cua mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Cua mode'. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6153,10 +6167,13 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated. -If called interactively, enable Cua-Rectangle-Mark mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Cua-Rectangle-Mark mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6179,10 +6196,13 @@ By convention, this is a list of symbols where each symbol stands for the (autoload 'cursor-intangible-mode "cursor-sensor" "\ Keep cursor outside of any `cursor-intangible' text property. -If called interactively, enable Cursor-Intangible mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Cursor-Intangible mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6197,10 +6217,13 @@ where WINDOW is the affected window, OLDPOS is the last known position of the cursor and DIR can be `entered' or `left' depending on whether the cursor is entering the area covered by the text-property property or leaving it. -If called interactively, enable Cursor-Sensor mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Cursor-Sensor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6523,7 +6546,7 @@ The format is suitable for use with `easy-menu-define'. \(fn SYMBOL &optional NAME)" nil nil) -(register-definition-prefixes "cus-edit" '("Custom-" "custom" "widget-")) +(register-definition-prefixes "cus-edit" '("Custom-" "cus" "widget-")) ;;;*** @@ -6580,10 +6603,13 @@ Mode used for cvs status output. (autoload 'cwarn-mode "cwarn" "\ Minor mode that highlights suspicious C and C++ constructions. -If called interactively, enable Cwarn mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Cwarn mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -6618,7 +6644,9 @@ ARG is omitted or nil. Cwarn mode is enabled in all buffers where `turn-on-cwarn-mode-if-enabled' would do it. -See `cwarn-mode' for more information on Cwarn mode. + +See `cwarn-mode' for more information on +Cwarn mode. \(fn &optional ARG)" t nil) @@ -6726,7 +6754,7 @@ Create a new data-debug buffer with NAME. (autoload 'dbus-handle-event "dbus" "\ Handle events from the D-Bus. EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being -part of the event, is called with arguments ARGS. +part of the event, is called with arguments ARGS (without type information). If the HANDLER returns a `dbus-error', it is propagated as return message. \(fn EVENT)" t nil) @@ -6824,8 +6852,7 @@ Variables controlling indentation style and extra features: dcl-imenu-label-call Change the text that is used as sub-listing labels in imenu. -Loading this package calls the value of the variable -`dcl-mode-load-hook' with no args, if that value is non-nil. +To run code after DCL mode has loaded, use `with-eval-after-load'. Turning on DCL mode calls the value of the variable `dcl-mode-hook' with no args, if that value is non-nil. @@ -6971,7 +6998,6 @@ The most useful commands are: ;;;### (autoloads nil "delim-col" "delim-col.el" (0 0 0 0)) ;;; Generated autoloads from delim-col.el -(push (purecopy '(delim-col 2 1)) package--builtin-versions) (autoload 'delimit-columns-customize "delim-col" "\ Customize the `columns' group." t nil) @@ -7032,10 +7058,13 @@ or call the function `delete-selection-mode'.") (autoload 'delete-selection-mode "delsel" "\ Toggle Delete Selection mode. -If called interactively, enable Delete-Selection mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Delete-Selection mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7204,10 +7233,13 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -If called interactively, enable Desktop-Save mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Desktop-Save mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7600,10 +7632,13 @@ a diff with \\[diff-reverse-direction]. (autoload 'diff-minor-mode "diff-mode" "\ Toggle Diff minor mode. -If called interactively, enable Diff minor mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Diff minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7762,23 +7797,24 @@ Keybindings: \(fn &optional DIRNAME SWITCHES)" nil nil) (put 'dired-find-alternate-file 'disabled t) -(register-definition-prefixes "dired" '("dired-")) +(autoload 'dired-jump "dired" "\ +Jump to Dired buffer corresponding to current buffer. +If in a file, Dired the current directory and move to file's line. +If in Dired already, pop up a level and goto old directory's line. +In case the proper Dired file line cannot be found, refresh the dired +buffer and try again. +When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. +When FILE-NAME is non-nil, jump to its line in Dired. +Interactively with prefix argument, read FILE-NAME. -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "dired-aux" "dired-aux.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from dired-aux.el +\(fn &optional OTHER-WINDOW FILE-NAME)" t nil) -(register-definition-prefixes "dired-aux" '("dired-" "minibuffer-default-add-dired-shell-commands")) +(autoload 'dired-jump-other-window "dired" "\ +Like \\[dired-jump] (`dired-jump') but in other window. -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "dired-x" "dired-x.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from dired-x.el +\(fn &optional FILE-NAME)" t nil) -(register-definition-prefixes "dired-x" '("dired-" "virtual-dired")) +(register-definition-prefixes "dired" '("dired-")) ;;;*** @@ -7788,10 +7824,13 @@ Keybindings: (autoload 'dirtrack-mode "dirtrack" "\ Toggle directory tracking in shell buffers (Dirtrack mode). -If called interactively, enable Dirtrack mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Dirtrack mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7962,10 +8001,13 @@ in `.emacs'. Toggle display of fill-column indicator. This uses `display-fill-column-indicator' internally. -If called interactively, enable Display-Fill-Column-Indicator mode if -ARG is positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and toggle -it if ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Display-Fill-Column-Indicator mode'. +If the prefix argument is positive, enable the mode, and if it is zero +or negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -7973,6 +8015,8 @@ disabled. To change the position of the column displayed by default customize `display-fill-column-indicator-column'. You can change the character for the indicator setting `display-fill-column-indicator-character'. +The globalized version is `global-display-fill-column-indicator-mode', +which see. See Info node `Displaying Boundaries' for details. \(fn &optional ARG)" t nil) @@ -7997,10 +8041,31 @@ ARG is omitted or nil. Display-Fill-Column-Indicator mode is enabled in all buffers where `display-fill-column-indicator--turn-on' would do it. -See `display-fill-column-indicator-mode' for more information on Display-Fill-Column-Indicator mode. + +See `display-fill-column-indicator-mode' for more information on +Display-Fill-Column-Indicator mode. + +`global-display-fill-column-indicator-modes' is used to control which modes +this minor mode is used in. \(fn &optional ARG)" t nil) +(defvar global-display-fill-column-indicator-modes '((not special-mode) t) "\ +Which major modes `display-fill-column-indicator-mode' is switched on in. +This variable can be either t (all major modes), nil (no major modes), +or a list of modes and (not modes) to switch use this minor mode or +not. For instance + + (c-mode (not message-mode mail-mode) text-mode) + +means \"use this mode in all modes derived from `c-mode', don't use in +modes derived from `message-mode' or `mail-mode', but do use in other +modes derived from `text-mode'\". An element with value t means \"use\" +and nil means \"don't use\". There's an implicit nil at the end of the +list.") + +(custom-autoload 'global-display-fill-column-indicator-modes "display-fill-column-indicator" t) + (register-definition-prefixes "display-fill-column-indicator" '("display-fill-column-indicator--turn-on")) ;;;*** @@ -8013,10 +8078,13 @@ See `display-fill-column-indicator-mode' for more information on Display-Fill-Co Toggle display of line numbers in the buffer. This uses `display-line-numbers' internally. -If called interactively, enable Display-Line-Numbers mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Display-Line-Numbers mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -8047,7 +8115,9 @@ ARG is omitted or nil. Display-Line-Numbers mode is enabled in all buffers where `display-line-numbers--turn-on' would do it. -See `display-line-numbers-mode' for more information on Display-Line-Numbers mode. + +See `display-line-numbers-mode' for more information on +Display-Line-Numbers mode. \(fn &optional ARG)" t nil) @@ -8151,10 +8221,13 @@ to the next best mode." nil nil) (autoload 'doc-view-minor-mode "doc-view" "\ Toggle displaying buffer via Doc View (Doc View minor mode). -If called interactively, enable Doc-View minor mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Doc-View minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -8216,10 +8289,13 @@ Switch to *doctor* buffer and start giving psychotherapy." t nil) (autoload 'double-mode "double" "\ Toggle special insertion on double keypresses (Double mode). -If called interactively, enable Double mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Double mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -8235,7 +8311,6 @@ strings when pressed twice. See `double-map' for details. ;;;### (autoloads nil "dunnet" "play/dunnet.el" (0 0 0 0)) ;;; Generated autoloads from play/dunnet.el -(push (purecopy '(dunnet 2 2)) package--builtin-versions) (autoload 'dunnet "dunnet" "\ Switch to *dungeon* buffer and start game." t nil) @@ -8280,6 +8355,10 @@ appear in DOC, a paragraph is added to DOC explaining usage of the mode argument. Optional INIT-VALUE is the initial value of the mode's variable. + Note that the minor mode function won't be called by setting + this option, so the value *reflects* the minor mode's natural + initial state, rather than *setting* it. + In the vast majority of cases it should be nil. Optional LIGHTER is displayed in the mode line when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), @@ -8300,9 +8379,6 @@ BODY contains code to execute each time the mode is enabled or disabled. the minor mode is global): :group GROUP Custom group name to use in all generated `defcustom' forms. - Defaults to MODE without the possible trailing \"-mode\". - Don't use this default group name unless you have written a - `defgroup' to define that group properly. :global GLOBAL If non-nil specifies that the minor mode is not meant to be buffer-local, so don't make the variable MODE buffer-local. By default, the mode is buffer-local. @@ -8340,18 +8416,21 @@ For example, you could write (autoload 'define-globalized-minor-mode "easy-mmode" "\ Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE. TURN-ON is a function that will be called with no args in every buffer - and that should try to turn MODE on if applicable for that buffer. -Each of KEY VALUE is a pair of CL-style keyword arguments. As - the minor mode defined by this function is always global, any - :global keyword is ignored. Other keywords have the same - meaning as in `define-minor-mode', which see. In particular, - :group specifies the custom group. The most useful keywords - are those that are passed on to the `defcustom'. It normally - makes no sense to pass the :lighter or :keymap keywords to - `define-globalized-minor-mode', since these are usually passed - to the buffer-local version of the minor mode. +and that should try to turn MODE on if applicable for that buffer. + +Each of KEY VALUE is a pair of CL-style keyword arguments. :predicate +specifies which major modes the globalized minor mode should be switched on +in. As the minor mode defined by this function is always global, any +:global keyword is ignored. Other keywords have the same meaning as in +`define-minor-mode', which see. In particular, :group specifies the custom +group. The most useful keywords are those that are passed on to the +`defcustom'. It normally makes no sense to pass the :lighter or :keymap +keywords to `define-globalized-minor-mode', since these are usually passed +to the buffer-local version of the minor mode. + BODY contains code to execute each time the mode is enabled or disabled. - It is executed after toggling the mode, and before running GLOBAL-MODE-hook. +It is executed after toggling the mode, and before running +GLOBAL-MODE-hook. If MODE's set-up depends on the major mode in effect when it was enabled, then disabling and reenabling MODE should make MODE work @@ -9060,10 +9139,13 @@ or call the function `global-ede-mode'.") (autoload 'global-ede-mode "ede" "\ Toggle global EDE (Emacs Development Environment) mode. -If called interactively, enable Global Ede mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Global Ede mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -9092,38 +9174,6 @@ an EDE controlled project. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ede/base" "cedet/ede/base.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/base.el - -(register-definition-prefixes "ede/base" '("ede-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/config" "cedet/ede/config.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/config.el - -(register-definition-prefixes "ede/config" '("ede-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/cpp-root" -;;;;;; "cedet/ede/cpp-root.el" (0 0 0 0)) -;;; Generated autoloads from cedet/ede/cpp-root.el - -(register-definition-prefixes "ede/cpp-root" '("ede-cpp-root-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/custom" "cedet/ede/custom.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/custom.el - -(register-definition-prefixes "ede/custom" '("ede-" "eieio-ede-old-variables")) - -;;;*** - ;;;### (autoloads nil "ede/detect" "cedet/ede/detect.el" (0 0 0 0)) ;;; Generated autoloads from cedet/ede/detect.el @@ -9131,62 +9181,6 @@ an EDE controlled project. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ede/dired" "cedet/ede/dired.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/dired.el - -(register-definition-prefixes "ede/dired" '("ede-dired-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/emacs" "cedet/ede/emacs.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/emacs.el - -(register-definition-prefixes "ede/emacs" '("ede-emacs-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/files" "cedet/ede/files.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/files.el - -(register-definition-prefixes "ede/files" '("ede-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/generic" -;;;;;; "cedet/ede/generic.el" (0 0 0 0)) -;;; Generated autoloads from cedet/ede/generic.el - -(register-definition-prefixes "ede/generic" '("ede-generic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/linux" "cedet/ede/linux.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/linux.el - -(register-definition-prefixes "ede/linux" '("ede-linux-" "project-linux-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/locate" "cedet/ede/locate.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/locate.el - -(register-definition-prefixes "ede/locate" '("ede-locate-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ede/make" "cedet/ede/make.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/make.el - -(register-definition-prefixes "ede/make" '("ede-")) - -;;;*** - ;;;### (autoloads nil "ede/makefile-edit" "cedet/ede/makefile-edit.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/ede/makefile-edit.el @@ -9304,14 +9298,6 @@ an EDE controlled project. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ede/shell" "cedet/ede/shell.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/shell.el - -(register-definition-prefixes "ede/shell" '("ede-shell-run-command")) - -;;;*** - ;;;### (autoloads nil "ede/simple" "cedet/ede/simple.el" (0 0 0 0)) ;;; Generated autoloads from cedet/ede/simple.el @@ -9326,14 +9312,6 @@ an EDE controlled project. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ede/speedbar" -;;;;;; "cedet/ede/speedbar.el" (0 0 0 0)) -;;; Generated autoloads from cedet/ede/speedbar.el - -(register-definition-prefixes "ede/speedbar" '("ede-")) - -;;;*** - ;;;### (autoloads nil "ede/srecode" "cedet/ede/srecode.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from cedet/ede/srecode.el @@ -9342,14 +9320,6 @@ an EDE controlled project. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ede/util" "cedet/ede/util.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/ede/util.el - -(register-definition-prefixes "ede/util" '("ede-make-buffer-writable")) - -;;;*** - ;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/edebug.el @@ -9815,7 +9785,6 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." t nil ;;;### (autoloads nil "edmacro" "edmacro.el" (0 0 0 0)) ;;; Generated autoloads from edmacro.el -(push (purecopy '(edmacro 2 1)) package--builtin-versions) (autoload 'edit-kbd-macro "edmacro" "\ Edit a keyboard macro. @@ -9967,14 +9936,6 @@ BUFFER is put back into its original major mode. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "eieio-compat" -;;;;;; "emacs-lisp/eieio-compat.el" (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/eieio-compat.el - -(register-definition-prefixes "eieio-compat" '("eieio--generic-static-symbol-specializers" "generic-p" "next-method-p" "no-")) - -;;;*** - ;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (0 ;;;;;; 0 0 0)) ;;; Generated autoloads from emacs-lisp/eieio-core.el @@ -9994,14 +9955,6 @@ It creates an autoload function for CNAME's constructor. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "eieio-custom" -;;;;;; "emacs-lisp/eieio-custom.el" (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/eieio-custom.el - -(register-definition-prefixes "eieio-custom" '("eieio-")) - -;;;*** - ;;;### (autoloads nil "eieio-datadebug" "emacs-lisp/eieio-datadebug.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/eieio-datadebug.el @@ -10010,14 +9963,6 @@ It creates an autoload function for CNAME's constructor. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "eieio-opt" "emacs-lisp/eieio-opt.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from emacs-lisp/eieio-opt.el - -(register-definition-prefixes "eieio-opt" '("eieio-")) - -;;;*** - ;;;### (autoloads nil "eieio-speedbar" "emacs-lisp/eieio-speedbar.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/eieio-speedbar.el @@ -10028,7 +9973,7 @@ It creates an autoload function for CNAME's constructor. ;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/eldoc.el -(push (purecopy '(eldoc 1 9 0)) package--builtin-versions) +(push (purecopy '(eldoc 1 11 0)) package--builtin-versions) ;;;*** @@ -10048,10 +9993,13 @@ or call the function `electric-pair-mode'.") (autoload 'electric-pair-mode "elec-pair" "\ Toggle automatic parens pairing (Electric Pair mode). -If called interactively, enable Electric-Pair mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Electric-Pair mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10069,10 +10017,13 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'. (autoload 'electric-pair-local-mode "elec-pair" "\ Toggle `electric-pair-mode' only in this buffer. -If called interactively, enable Electric-Pair-Local mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Electric-Pair-Local mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10168,142 +10119,6 @@ displayed." t nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "em-alias" "eshell/em-alias.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-alias.el - -(register-definition-prefixes "em-alias" '("eshell" "pcomplete/eshell-mode/alias")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-banner" "eshell/em-banner.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-banner.el - -(register-definition-prefixes "em-banner" '("eshell-banner-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-basic" "eshell/em-basic.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-basic.el - -(register-definition-prefixes "em-basic" '("eshell")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-cmpl" "eshell/em-cmpl.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-cmpl.el - -(register-definition-prefixes "em-cmpl" '("eshell-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-dirs" "eshell/em-dirs.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-dirs.el - -(register-definition-prefixes "em-dirs" '("eshell")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-glob" "eshell/em-glob.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-glob.el - -(register-definition-prefixes "em-glob" '("eshell-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-hist" "eshell/em-hist.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-hist.el - -(register-definition-prefixes "em-hist" '("eshell")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-ls" "eshell/em-ls.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-ls.el - -(register-definition-prefixes "em-ls" '("eshell")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-pred" "eshell/em-pred.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-pred.el - -(register-definition-prefixes "em-pred" '("eshell-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-prompt" "eshell/em-prompt.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-prompt.el - -(register-definition-prefixes "em-prompt" '("eshell-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-rebind" "eshell/em-rebind.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-rebind.el - -(register-definition-prefixes "em-rebind" '("eshell-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-script" "eshell/em-script.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-script.el - -(register-definition-prefixes "em-script" '("eshell")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-smart" "eshell/em-smart.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-smart.el - -(register-definition-prefixes "em-smart" '("eshell-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-term" "eshell/em-term.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-term.el - -(register-definition-prefixes "em-term" '("eshell-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-tramp" "eshell/em-tramp.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-tramp.el - -(register-definition-prefixes "em-tramp" '("eshell")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-unix" "eshell/em-unix.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-unix.el - -(register-definition-prefixes "em-unix" '("eshell" "nil-blank-string" "pcomplete/")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "em-xtra" "eshell/em-xtra.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from eshell/em-xtra.el - -(register-definition-prefixes "em-xtra" '("eshell/" "pcomplete/bcc")) - -;;;*** - ;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lock.el @@ -10349,7 +10164,15 @@ Already submitted bugs can be found in the Emacs bug tracker: (set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5") -(register-definition-prefixes "emacsbug" '("report-emacs-bug-")) +(autoload 'submit-emacs-patch "emacsbug" "\ +Send an Emacs patch to the Emacs maintainers. +Interactively, you will be prompted for SUBJECT and a patch FILE +name (which will be attached to the mail). You will end up in a +Message buffer where you can explain more about the patch. + +\(fn SUBJECT FILE)" t nil) + +(register-definition-prefixes "emacsbug" '("emacs-bug--system-description" "report-emacs-bug-")) ;;;*** @@ -10417,10 +10240,13 @@ Minor mode for editing text/enriched files. These are files with embedded formatting information in the MIME standard text/enriched format. -If called interactively, enable Enriched mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Enriched mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10679,10 +10505,13 @@ Encrypt marked files." t nil) (autoload 'epa-mail-mode "epa-mail" "\ A minor-mode for composing encrypted/clearsigned mails. -If called interactively, enable epa-mail mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `epa-mail mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10746,10 +10575,13 @@ or call the function `epa-global-mail-mode'.") (autoload 'epa-global-mail-mode "epa-mail" "\ Minor mode to hook EasyPG into Mail mode. -If called interactively, enable Epa-Global-Mail mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Epa-Global-Mail mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -10835,7 +10667,7 @@ Non-interactively, it takes the keyword arguments That is, if called with - (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\") + (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\") then the server and full-name will be set to those values, whereas `erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will @@ -10862,14 +10694,6 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "erc-autoaway" -;;;;;; "erc/erc-autoaway.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-autoaway.el - -(register-definition-prefixes "erc-autoaway" '("erc-auto")) - -;;;*** - ;;;### (autoloads nil "erc-backend" "erc/erc-backend.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-backend.el @@ -10877,54 +10701,6 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "erc-button" "erc/erc-button.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-button.el - -(register-definition-prefixes "erc-button" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-capab" "erc/erc-capab.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-capab.el - -(register-definition-prefixes "erc-capab" '("erc-capab-identify-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-dcc" "erc/erc-dcc.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-dcc.el - -(register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-desktop-notifications" -;;;;;; "erc/erc-desktop-notifications.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-desktop-notifications.el - -(register-definition-prefixes "erc-desktop-notifications" '("erc-notifications-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-ezbounce" -;;;;;; "erc/erc-ezbounce.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-ezbounce.el - -(register-definition-prefixes "erc-ezbounce" '("erc-ezb-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-fill" "erc/erc-fill.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-fill.el - -(register-definition-prefixes "erc-fill" '("erc-")) - -;;;*** - ;;;### (autoloads nil "erc-goodies" "erc/erc-goodies.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-goodies.el @@ -10939,30 +10715,6 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "erc-identd" "erc/erc-identd.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-identd.el - -(register-definition-prefixes "erc-identd" '("erc-identd-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-imenu" "erc/erc-imenu.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-imenu.el - -(register-definition-prefixes "erc-imenu" '("erc-unfill-notice")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-join" "erc/erc-join.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-join.el - -(register-definition-prefixes "erc-join" '("erc-")) - -;;;*** - ;;;### (autoloads nil "erc-lang" "erc/erc-lang.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-lang.el @@ -10970,46 +10722,6 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "erc-list" "erc/erc-list.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-list.el - -(register-definition-prefixes "erc-list" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-log" "erc/erc-log.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-log.el - -(register-definition-prefixes "erc-log" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-match" "erc/erc-match.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-match.el - -(register-definition-prefixes "erc-match" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-menu" "erc/erc-menu.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-menu.el - -(register-definition-prefixes "erc-menu" '("erc-menu-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-netsplit" -;;;;;; "erc/erc-netsplit.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-netsplit.el - -(register-definition-prefixes "erc-netsplit" '("erc-")) - -;;;*** - ;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-networks.el @@ -11026,110 +10738,6 @@ Interactively select a server to connect to using `erc-server-alist'." t nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "erc-notify" "erc/erc-notify.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-notify.el - -(register-definition-prefixes "erc-notify" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-page" "erc/erc-page.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-page.el - -(register-definition-prefixes "erc-page" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-pcomplete" -;;;;;; "erc/erc-pcomplete.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-pcomplete.el - -(register-definition-prefixes "erc-pcomplete" '("erc-pcomplet" "pcomplete")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-replace" -;;;;;; "erc/erc-replace.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-replace.el - -(register-definition-prefixes "erc-replace" '("erc-replace-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-ring" "erc/erc-ring.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-ring.el - -(register-definition-prefixes "erc-ring" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-services" -;;;;;; "erc/erc-services.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-services.el - -(register-definition-prefixes "erc-services" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-sound" "erc/erc-sound.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-sound.el - -(register-definition-prefixes "erc-sound" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-speedbar" -;;;;;; "erc/erc-speedbar.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-speedbar.el - -(register-definition-prefixes "erc-speedbar" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-spelling" -;;;;;; "erc/erc-spelling.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-spelling.el - -(register-definition-prefixes "erc-spelling" '("erc-spelling-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-stamp" "erc/erc-stamp.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-stamp.el - -(register-definition-prefixes "erc-stamp" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-track" "erc/erc-track.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-track.el - -(register-definition-prefixes "erc-track" '("erc-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-truncate" -;;;;;; "erc/erc-truncate.el" (0 0 0 0)) -;;; Generated autoloads from erc/erc-truncate.el - -(register-definition-prefixes "erc-truncate" '("erc-max-buffer-size")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "erc-xdcc" "erc/erc-xdcc.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from erc/erc-xdcc.el - -(register-definition-prefixes "erc-xdcc" '("erc-")) - -;;;*** - ;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ert.el @@ -11253,6 +10861,11 @@ Emacs shell interactive mode. \(fn)" t nil) +(autoload 'eshell-bookmark-jump "esh-mode" "\ +Default bookmark handler for Eshell buffers. + +\(fn BOOKMARK)" nil nil) + (register-definition-prefixes "esh-mode" '("eshell")) ;;;*** @@ -11599,7 +11212,7 @@ Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. -For non-interactive use, superceded by `fileloop-initialize-replace'. +For non-interactive use, superseded by `fileloop-initialize-replace'. \(fn FROM TO &optional DELIMITED FILES)" t nil) @@ -12032,11 +11645,11 @@ Render FILE using EWW. \(fn FILE)" t nil) (autoload 'eww-search-words "eww" "\ -Search the web for the text between BEG and END. +Search the web for the text in the region. If region is active (and not whitespace), search the web for -the text between BEG and END. Else, prompt the user for a search -string. See the `eww-search-prefix' variable for the search -engine used." t nil) +the text between region beginning and end. Else, prompt the +user for a search string. See the variable `eww-search-prefix' +for the search engine used." t nil) (autoload 'eww-mode "eww" "\ Mode for browsing the web. @@ -12345,10 +11958,13 @@ a top-level keymap, `text-scale-increase' or (autoload 'buffer-face-mode "face-remap" "\ Minor mode for a buffer-specific default face. -If called interactively, enable Buffer-Face mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Buffer-Face mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -12818,6 +12434,9 @@ The command run (after changing into DIR) is essentially except that the car of the variable `find-ls-option' specifies what to use in place of \"-ls\" as the final argument. +Collect output in the \"*Find*\" buffer. To kill the job before +it finishes, type \\[kill-find]. + \(fn DIR ARGS)" t nil) (autoload 'find-name-dired "find-dired" "\ @@ -13261,10 +12880,13 @@ region is invalid. (autoload 'flymake-mode "flymake" "\ Toggle Flymake mode on or off. -If called interactively, enable Flymake mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Flymake mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13346,10 +12968,13 @@ Turn on `flyspell-mode' for comments and strings." t nil) (autoload 'flyspell-mode "flyspell" "\ Toggle on-the-fly spell checking (Flyspell mode). -If called interactively, enable Flyspell mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Flyspell mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13374,7 +12999,7 @@ invoking `ispell-change-dictionary'. Consider using the `ispell-parser' to check your text. For instance consider adding: -\(add-hook \\='tex-mode-hook (function (lambda () (setq ispell-parser \\='tex)))) +\(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex))) in your init file. \\[flyspell-region] checks all words inside a region. @@ -13426,10 +13051,13 @@ Turn off Follow mode. Please see the function `follow-mode'." nil nil) (autoload 'follow-mode "follow" "\ Toggle Follow mode. -If called interactively, enable Follow mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Follow mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13549,15 +13177,17 @@ selected if the original window is the first one in the frame. ;;;### (autoloads nil "footnote" "mail/footnote.el" (0 0 0 0)) ;;; Generated autoloads from mail/footnote.el -(push (purecopy '(footnote 0 19)) package--builtin-versions) (autoload 'footnote-mode "footnote" "\ Toggle Footnote mode. -If called interactively, enable Footnote mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Footnote mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -13988,7 +13618,6 @@ Interactively, reads the register using `register-read-with-preview'. ;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (0 0 0 0)) ;;; Generated autoloads from play/gamegrid.el -(push (purecopy '(gamegrid 1 2)) package--builtin-versions) (register-definition-prefixes "gamegrid" '("gamegrid-")) @@ -14019,10 +13648,13 @@ being transferred. This list may grow up to a size of `gdb-debug-log-max' after which the oldest element (at the end of the list) is deleted every time a new one is added (at the front). -If called interactively, enable Gdb-Enable-Debug mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Gdb-Enable-Debug mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -14112,6 +13744,10 @@ instead (which see).") (autoload 'define-generic-mode "generic" "\ Create a new generic mode MODE. +A \"generic\" mode is a simple major mode with basic support for +comment syntax and Font Lock mode, but otherwise does not have +any special keystrokes or functionality available. + MODE is the name of the command for the generic mode; don't quote it. The optional DOCSTRING is the documentation for the mode command. If you do not supply it, `define-generic-mode' uses a default @@ -14196,10 +13832,13 @@ regular expression that can be used as an element of (autoload 'glasses-mode "glasses" "\ Minor mode for making identifiers likeThis readable. -If called interactively, enable Glasses mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Glasses mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -14808,10 +14447,13 @@ If FORCE is non-nil, replace the old ones. (autoload 'gnus-mailing-list-mode "gnus-ml" "\ Minor mode for providing mailing-list commands. -If called interactively, enable Gnus-Mailing-List mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Gnus-Mailing-List mode'. If the +prefix argument is positive, enable the mode, and if it is zero +or negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +All other values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -15262,10 +14904,13 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (autoload 'goto-address-mode "goto-addr" "\ Minor mode to buttonize URLs and e-mail addresses in the current buffer. -If called interactively, enable Goto-Address mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Goto-Address mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -15292,17 +14937,22 @@ ARG is omitted or nil. Goto-Address mode is enabled in all buffers where `goto-addr-mode--turn-on' would do it. -See `goto-address-mode' for more information on Goto-Address mode. + +See `goto-address-mode' for more information on +Goto-Address mode. \(fn &optional ARG)" t nil) (autoload 'goto-address-prog-mode "goto-addr" "\ Like `goto-address-mode', but only for comments and strings. -If called interactively, enable Goto-Address-Prog mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Goto-Address-Prog mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -15636,10 +15286,13 @@ or call the function `gud-tooltip-mode'.") (autoload 'gud-tooltip-mode "gud" "\ Toggle the display of GUD tooltips. -If called interactively, enable Gud-Tooltip mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Gud-Tooltip mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16348,24 +16001,19 @@ This discards the buffer's undo information." t nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "hfy-cmap" "hfy-cmap.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from hfy-cmap.el - -(register-definition-prefixes "hfy-cmap" '("hfy-" "htmlfontify-unload-rgb-file")) - -;;;*** - ;;;### (autoloads nil "hi-lock" "hi-lock.el" (0 0 0 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ Toggle selective highlighting of patterns (Hi Lock mode). -If called interactively, enable Hi-Lock mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Hi-Lock mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16452,7 +16100,9 @@ ARG is omitted or nil. Hi-Lock mode is enabled in all buffers where `turn-on-hi-lock-if-enabled' would do it. -See `hi-lock-mode' for more information on Hi-Lock mode. + +See `hi-lock-mode' for more information on +Hi-Lock mode. \(fn &optional ARG)" t nil) @@ -16556,6 +16206,9 @@ Interactively added patterns are those normally specified using `highlight-regexp' and `highlight-lines-matching-regexp'; they can be found in variable `hi-lock-interactive-patterns'." t nil) +(autoload 'hi-lock-find-patterns "hi-lock" "\ +Add patterns from the current buffer to the list of hi-lock patterns." t nil) + (register-definition-prefixes "hi-lock" '("hi-lock-" "turn-on-hi-lock-if-enabled")) ;;;*** @@ -16566,10 +16219,13 @@ be found in variable `hi-lock-interactive-patterns'." t nil) (autoload 'hide-ifdef-mode "hideif" "\ Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). -If called interactively, enable Hide-Ifdef mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Hide-Ifdef mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16617,7 +16273,7 @@ Several variables affect how the hiding is done: ;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/hideshow.el -(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\ +(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\ Alist for initializing the hideshow variables for different modes. Each element has the form (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). @@ -16648,10 +16304,13 @@ whitespace. Case does not matter.") (autoload 'hs-minor-mode "hideshow" "\ Minor mode to selectively hide/show code and comment blocks. -If called interactively, enable Hs minor mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Hs minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16695,10 +16354,13 @@ Unconditionally turn off `hs-minor-mode'." nil nil) (autoload 'highlight-changes-mode "hilit-chg" "\ Toggle highlighting changes in this buffer (Highlight Changes mode). -If called interactively, enable Highlight-Changes mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Highlight-Changes mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16723,10 +16385,13 @@ buffer with the contents of a file (autoload 'highlight-changes-visible-mode "hilit-chg" "\ Toggle visibility of highlighting due to Highlight Changes mode. -If called interactively, enable Highlight-Changes-Visible mode if ARG -is positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and toggle -it if ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Highlight-Changes-Visible mode'. If +the prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16821,7 +16486,9 @@ ARG is omitted or nil. Highlight-Changes mode is enabled in all buffers where `highlight-changes-mode-turn-on' would do it. -See `highlight-changes-mode' for more information on Highlight-Changes mode. + +See `highlight-changes-mode' for more information on +Highlight-Changes mode. \(fn &optional ARG)" t nil) @@ -16868,10 +16535,13 @@ argument VERBOSE non-nil makes the function verbose. (autoload 'hl-line-mode "hl-line" "\ Toggle highlighting of the current line (Hl-Line mode). -If called interactively, enable Hl-Line mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Hl-Line mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -16903,10 +16573,13 @@ or call the function `global-hl-line-mode'.") (autoload 'global-hl-line-mode "hl-line" "\ Toggle line highlighting in all buffers (Global Hl-Line mode). -If called interactively, enable Global Hl-Line mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Global Hl-Line mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -17086,14 +16759,6 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ibuf-ext" "ibuf-ext.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from ibuf-ext.el - -(register-definition-prefixes "ibuf-ext" '("alphabetic" "basename" "content" "derived-mode" "directory" "eval" "file" "ibuffer-" "major-mode" "mod" "name" "predicate" "print" "process" "query-replace" "rename-uniquely" "replace-regexp" "revert" "shell-command-" "size" "starred-name" "used-mode" "view-and-eval" "visiting-file")) - -;;;*** - ;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (0 0 0 0)) ;;; Generated autoloads from ibuf-macs.el @@ -17326,10 +16991,13 @@ or call the function `fido-mode'.") (autoload 'fido-mode "icomplete" "\ An enhanced `icomplete-mode' that emulates `ido-mode'. -If called interactively, enable Fido mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Fido mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -17352,10 +17020,13 @@ or call the function `icomplete-mode'.") (autoload 'icomplete-mode "icomplete" "\ Toggle incremental minibuffer completion (Icomplete mode). -If called interactively, enable Icomplete mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Icomplete mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -17590,7 +17261,7 @@ The main features of this mode are \\[idlwave-info] to display (complain to your sysadmin if that does not work). For Postscript, PDF, and HTML versions of the documentation, check IDLWAVE's homepage at URL - `http://github.com/jdtsmith/idlwave'. + `https://github.com/jdtsmith/idlwave'. IDLWAVE has customize support - see the group `idlwave'. 10.Keybindings @@ -17897,10 +17568,13 @@ See `inferior-emacs-lisp-mode' for details. (autoload 'iimage-mode "iimage" "\ Toggle Iimage mode on or off. -If called interactively, enable Iimage mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Iimage mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -18208,10 +17882,13 @@ Setup easy-to-use keybindings for the commands to be used in dired mode. Note that n, p and <down> and <up> will be hijacked and bound to `image-dired-dired-x-line'. -If called interactively, enable Image-Dired minor mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Image-Dired minor mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -18307,10 +17984,13 @@ or call the function `auto-image-file-mode'.") (autoload 'auto-image-file-mode "image-file" "\ Toggle visiting of image files as images (Auto Image File mode). -If called interactively, enable Auto-Image-File mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Auto-Image-File mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -18339,10 +18019,13 @@ Key bindings: (autoload 'image-minor-mode "image-mode" "\ Toggle Image minor mode in this buffer. -If called interactively, enable Image minor mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Image minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -18584,7 +18267,7 @@ the environment variable INFOPATH is set. Although this is a customizable variable, that is mainly for technical reasons. Normally, you should either set INFOPATH or customize -`Info-additional-directory-list', rather than changing this variable." :initialize 'custom-initialize-delay :type '(repeat directory) :group 'info) +`Info-additional-directory-list', rather than changing this variable." :initialize 'custom-initialize-delay :type '(repeat directory)) (autoload 'info-other-window "info" "\ Like `info' but show the Info buffer in another window. @@ -19297,10 +18980,13 @@ available on the net." t nil) (autoload 'ispell-minor-mode "ispell" "\ Toggle last-word spell checking (Ispell minor mode). -If called interactively, enable ISpell minor mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `ISpell minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -19336,7 +19022,7 @@ in your init file: You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: - (function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))" t nil) + (lambda () (local-set-key \"\\C-ci\" \\='ispell-message))" t nil) (register-definition-prefixes "ispell" '("check-ispell-version" "ispell-")) @@ -19989,10 +19675,13 @@ sleep in seconds. (autoload 'linum-mode "linum" "\ Toggle display of line numbers in the left margin (Linum mode). -If called interactively, enable Linum mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Linum mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -20021,7 +19710,9 @@ ARG is omitted or nil. Linum mode is enabled in all buffers where `linum-on' would do it. -See `linum-mode' for more information on Linum mode. + +See `linum-mode' for more information on +Linum mode. \(fn &optional ARG)" t nil) @@ -20046,11 +19737,10 @@ If the feature is required by any other loaded code, and prefix arg FORCE is nil, raise an error. Standard unloading activities include restoring old autoloads for -functions defined by the library, undoing any additions that the -library has made to hook variables or to `auto-mode-alist', undoing -ELP profiling of functions in that library, unproviding any features -provided by the library, and canceling timers held in variables -defined by the library. +functions defined by the library, removing such functions from +hooks and `auto-mode-alist', undoing their ELP profiling, +unproviding any features provided by the library, and canceling +timers held in variables defined by the library. If a function `FEATURE-unload-function' is defined, this function calls it with no arguments, before doing anything else. That function @@ -20565,10 +20255,13 @@ or call the function `mail-abbrevs-mode'.") (autoload 'mail-abbrevs-mode "mailabbrev" "\ Toggle abbrev expansion of mail aliases (Mail Abbrevs mode). -If called interactively, enable Mail-Abbrevs mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Mail-Abbrevs mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -20904,10 +20597,13 @@ Default bookmark handler for Man buffers. (autoload 'master-mode "master" "\ Toggle Master mode. -If called interactively, enable Master mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Master mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -20943,10 +20639,13 @@ or call the function `minibuffer-depth-indicate-mode'.") (autoload 'minibuffer-depth-indicate-mode "mb-depth" "\ Toggle Minibuffer Depth Indication mode. -If called interactively, enable Minibuffer-Depth-Indicate mode if ARG -is positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and toggle -it if ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Minibuffer-Depth-Indicate mode'. If +the prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -20964,7 +20663,6 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;### (autoloads nil "md4" "md4.el" (0 0 0 0)) ;;; Generated autoloads from md4.el -(push (purecopy '(md4 1 0)) package--builtin-versions) (register-definition-prefixes "md4" '("md4")) @@ -21488,10 +21186,13 @@ or call the function `midnight-mode'.") (autoload 'midnight-mode "midnight" "\ Non-nil means run `midnight-hook' at midnight. -If called interactively, enable Midnight mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Midnight mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -21537,10 +21238,13 @@ or call the function `minibuffer-electric-default-mode'.") (autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\ Toggle Minibuffer Electric Default mode. -If called interactively, enable Minibuffer-Electric-Default mode if -ARG is positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and toggle -it if ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Minibuffer-Electric-Default mode'. +If the prefix argument is positive, enable the mode, and if it is zero +or negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -21608,7 +21312,7 @@ upper atmosphere. These cause momentary pockets of higher-pressure air to form, which act as lenses that deflect incoming cosmic rays, focusing them to strike the drive platter and flip the desired bit. You can type `M-x butterfly C-M-c' to run it. This is a permuted -variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." t nil) +variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'." t nil) (autoload 'list-dynamic-libraries "misc" "\ Display a list of all dynamic libraries known to Emacs. @@ -21716,7 +21420,7 @@ whose file names match the specified wildcard. ;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (0 0 ;;;;;; 0 0)) ;;; Generated autoloads from progmodes/mixal-mode.el -(push (purecopy '(mixal-mode 0 1)) package--builtin-versions) +(push (purecopy '(mixal-mode 0 4)) package--builtin-versions) (autoload 'mixal-mode "mixal-mode" "\ Major mode for the mixal asm language. @@ -22110,10 +21814,13 @@ or call the function `msb-mode'.") (autoload 'msb-mode "msb" "\ Toggle Msb mode. -If called interactively, enable Msb mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Msb mode'. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -22130,6 +21837,12 @@ different buffer menu using the function `msb'. ;;;### (autoloads nil "mspools" "mail/mspools.el" (0 0 0 0)) ;;; Generated autoloads from mail/mspools.el +(autoload 'mspools-show "mspools" "\ +Show the list of non-empty spool files in the *spools* buffer. +Buffer is not displayed if SHOW is non-nil. + +\(fn &optional NOSHOW)" t nil) + (register-definition-prefixes "mspools" '("mspools-")) ;;;*** @@ -22289,7 +22002,7 @@ If ELLIPSIS is non-nil, it should be a string which will replace the end of STR (including any padding) if it extends beyond END-COLUMN, unless the display width of STR is equal to or less than the display width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS -defaults to `truncate-string-ellipsis'. +defaults to `truncate-string-ellipsis', or to three dots when it's nil. If ELLIPSIS-TEXT-PROPERTY is non-nil, a too-long string will not be truncated, but instead the elided parts will be covered by a @@ -22848,7 +22561,7 @@ This command does not work if you use short group names." t nil) ;;;### (autoloads nil "nnir" "gnus/nnir.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nnir.el -(register-definition-prefixes "nnir" '("gnus-" "nnir-")) +(register-definition-prefixes "nnir" '("nnir-")) ;;;*** @@ -22927,6 +22640,13 @@ Generate NOV databases in all nnml directories. ;;;*** +;;;### (autoloads nil "nnselect" "gnus/nnselect.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnselect.el + +(register-definition-prefixes "nnselect" '("gnus-" "ids-by-group" "nnselect-" "numbers-by-group")) + +;;;*** + ;;;### (autoloads nil "nnspool" "gnus/nnspool.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nnspool.el @@ -23208,14 +22928,6 @@ Many aspects this mode can be customized using ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ob-core" "org/ob-core.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ob-core.el - -(register-definition-prefixes "ob-core" '("org-")) - -;;;*** - ;;;### (autoloads nil "ob-css" "org/ob-css.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-css.el @@ -23365,14 +23077,6 @@ Many aspects this mode can be customized using ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ob-lob" "org/ob-lob.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ob-lob.el - -(register-definition-prefixes "ob-lob" '("org-babel-")) - -;;;*** - ;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-lua.el @@ -23543,14 +23247,6 @@ Many aspects this mode can be customized using ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ob-tangle" "org/ob-tangle.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ob-tangle.el - -(register-definition-prefixes "ob-tangle" '("org-babel-")) - -;;;*** - ;;;### (autoloads nil "ob-vala" "org/ob-vala.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-vala.el @@ -23712,14 +23408,6 @@ Also refresh fontification if needed." t nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ol-bbdb" "org/ol-bbdb.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ol-bbdb.el - -(register-definition-prefixes "ol-bbdb" '("org-bbdb-")) - -;;;*** - ;;;### (autoloads nil "ol-bibtex" "org/ol-bibtex.el" (0 0 0 0)) ;;; Generated autoloads from org/ol-bibtex.el @@ -23762,14 +23450,6 @@ Also refresh fontification if needed." t nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ol-irc" "org/ol-irc.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ol-irc.el - -(register-definition-prefixes "ol-irc" '("org-irc-")) - -;;;*** - ;;;### (autoloads nil "ol-mhe" "org/ol-mhe.el" (0 0 0 0)) ;;; Generated autoloads from org/ol-mhe.el @@ -24299,22 +23979,6 @@ to override `appt-message-warning-time'. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-archive" -;;;;;; "org/org-archive.el" (0 0 0 0)) -;;; Generated autoloads from org/org-archive.el - -(register-definition-prefixes "org-archive" '("org-a")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "org-attach" "org/org-attach.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-attach.el - -(register-definition-prefixes "org-attach" '("org-attach-")) - -;;;*** - ;;;### (autoloads nil "org-attach-git" "org/org-attach-git.el" (0 ;;;;;; 0 0 0)) ;;; Generated autoloads from org/org-attach-git.el @@ -24369,14 +24033,6 @@ Set `org-capture-templates' to be similar to `org-remember-templates'." t nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-clock" "org/org-clock.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-clock.el - -(register-definition-prefixes "org-clock" '("org-")) - -;;;*** - ;;;### (autoloads nil "org-colview" "org/org-colview.el" (0 0 0 0)) ;;; Generated autoloads from org/org-colview.el @@ -24492,14 +24148,6 @@ Try very hard to provide sensible version strings." nil t) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-datetree" -;;;;;; "org/org-datetree.el" (0 0 0 0)) -;;; Generated autoloads from org/org-datetree.el - -(register-definition-prefixes "org-datetree" '("org-datetree-")) - -;;;*** - ;;;### (autoloads nil "org-duration" "org/org-duration.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from org/org-duration.el @@ -24555,14 +24203,6 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-element" -;;;;;; "org/org-element.el" (0 0 0 0)) -;;; Generated autoloads from org/org-element.el - -(register-definition-prefixes "org-element" '("org-element-")) - -;;;*** - ;;;### (autoloads nil "org-entities" "org/org-entities.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from org/org-entities.el @@ -24578,22 +24218,6 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-feed" "org/org-feed.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-feed.el - -(register-definition-prefixes "org-feed" '("org-feed-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "org-footnote" -;;;;;; "org/org-footnote.el" (0 0 0 0)) -;;; Generated autoloads from org/org-footnote.el - -(register-definition-prefixes "org-footnote" '("org-footnote-")) - -;;;*** - ;;;### (autoloads nil "org-goto" "org/org-goto.el" (0 0 0 0)) ;;; Generated autoloads from org/org-goto.el @@ -24637,22 +24261,6 @@ With a prefix argument, use the alternative interface: e.g., if ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-id" "org/org-id.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-id.el - -(register-definition-prefixes "org-id" '("org-id-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "org-indent" "org/org-indent.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-indent.el - -(register-definition-prefixes "org-indent" '("org-")) - -;;;*** - ;;;### (autoloads nil "org-inlinetask" "org/org-inlinetask.el" (0 ;;;;;; 0 0 0)) ;;; Generated autoloads from org/org-inlinetask.el @@ -24715,14 +24323,6 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-mobile" "org/org-mobile.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-mobile.el - -(register-definition-prefixes "org-mobile" '("org-mobile-")) - -;;;*** - ;;;### (autoloads nil "org-mouse" "org/org-mouse.el" (0 0 0 0)) ;;; Generated autoloads from org/org-mouse.el @@ -24742,10 +24342,13 @@ NUMBERING is a list of numbers. (autoload 'org-num-mode "org-num" "\ Dynamic numbering of headlines in an Org buffer. -If called interactively, enable Org-Num mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Org-Num mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -24764,14 +24367,6 @@ disabled. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-plot" "org/org-plot.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-plot.el - -(register-definition-prefixes "org-plot" '("org-plot")) - -;;;*** - ;;;### (autoloads nil "org-protocol" "org/org-protocol.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from org/org-protocol.el @@ -24787,14 +24382,6 @@ disabled. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-table" "org/org-table.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-table.el - -(register-definition-prefixes "org-table" '("org")) - -;;;*** - ;;;### (autoloads nil "org-tempo" "org/org-tempo.el" (0 0 0 0)) ;;; Generated autoloads from org/org-tempo.el @@ -24802,14 +24389,6 @@ disabled. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "org-timer" "org/org-timer.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/org-timer.el - -(register-definition-prefixes "org-timer" '("org-timer-")) - -;;;*** - ;;;### (autoloads nil "org-version" "org/org-version.el" (0 0 0 0)) ;;; Generated autoloads from org/org-version.el @@ -24827,6 +24406,7 @@ Inserted by installing Org or when a release is made." nil nil) ;;; Generated autoloads from outline.el (put 'outline-regexp 'safe-local-variable 'stringp) (put 'outline-heading-end-regexp 'safe-local-variable 'stringp) +(put 'outline-level 'risky-local-variable t) (autoload 'outline-mode "outline" "\ Set major mode for editing outlines with selective display. @@ -24856,10 +24436,13 @@ Turning on outline mode calls the value of `text-mode-hook' and then of (autoload 'outline-minor-mode "outline" "\ Toggle Outline minor mode. -If called interactively, enable Outline minor mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Outline minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -24867,108 +24450,11 @@ disabled. See the command `outline-mode' for more information on this mode. \(fn &optional ARG)" t nil) -(put 'outline-level 'risky-local-variable t) (register-definition-prefixes "outline" '("outline-")) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ox" "org/ox.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox.el - -(register-definition-prefixes "ox" '("org-export-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-ascii" "org/ox-ascii.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-ascii.el - -(register-definition-prefixes "ox-ascii" '("org-ascii-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-beamer" "org/ox-beamer.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-beamer.el - -(register-definition-prefixes "ox-beamer" '("org-beamer-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-html" "org/ox-html.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-html.el - -(register-definition-prefixes "ox-html" '("org-html-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-icalendar" -;;;;;; "org/ox-icalendar.el" (0 0 0 0)) -;;; Generated autoloads from org/ox-icalendar.el - -(register-definition-prefixes "ox-icalendar" '("org-icalendar-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-latex" "org/ox-latex.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-latex.el - -(register-definition-prefixes "ox-latex" '("org-latex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-man" "org/ox-man.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-man.el - -(register-definition-prefixes "ox-man" '("org-man-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-md" "org/ox-md.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-md.el - -(register-definition-prefixes "ox-md" '("org-md-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-odt" "org/ox-odt.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-odt.el - -(register-definition-prefixes "ox-odt" '("org-odt-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-org" "org/ox-org.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-org.el - -(register-definition-prefixes "ox-org" '("org-org-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-publish" "org/ox-publish.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-publish.el - -(register-definition-prefixes "ox-publish" '("org-publish-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "ox-texinfo" "org/ox-texinfo.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from org/ox-texinfo.el - -(register-definition-prefixes "ox-texinfo" '("org-texinfo-")) - -;;;*** - ;;;### (autoloads nil "package" "emacs-lisp/package.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/package.el (push (purecopy '(package 1 1 0)) package--builtin-versions) @@ -25158,10 +24644,13 @@ or call the function `show-paren-mode'.") (autoload 'show-paren-mode "paren" "\ Toggle visualization of matching parens (Show Paren mode). -If called interactively, enable Show-Paren mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Show-Paren mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -25502,7 +24991,12 @@ Completion rules for the `ssh' command." nil nil) Completion rules for the `scp' command. Includes files as well as host names followed by a colon." nil nil) -(register-definition-prefixes "pcmpl-unix" '("pcmpl-")) +(autoload 'pcomplete/telnet "pcmpl-unix" nil nil nil) + +(autoload 'pcomplete/rsh "pcmpl-unix" "\ +Complete `rsh', which, after the user and hostname, is like xargs." nil nil) + +(register-definition-prefixes "pcmpl-unix" '("pcmpl-" "pcomplete/")) ;;;*** @@ -25522,6 +25016,11 @@ long options." nil nil) (autoload 'pcomplete/ag "pcmpl-x" "\ Completion for the `ag' command." nil nil) +(autoload 'pcomplete/bcc32 "pcmpl-x" "\ +Completion function for Borland's C++ compiler." nil nil) + +(defalias 'pcomplete/bcc 'pcomplete/bcc32) + (register-definition-prefixes "pcmpl-x" '("pcmpl-x-")) ;;;*** @@ -25858,10 +25357,13 @@ or call the function `pixel-scroll-mode'.") (autoload 'pixel-scroll-mode "pixel-scroll" "\ A minor mode to scroll text pixel-by-pixel. -If called interactively, enable Pixel-Scroll mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Pixel-Scroll mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -26573,7 +26075,7 @@ Open profile FILENAME. ;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 5 1)) package--builtin-versions) +(push (purecopy '(project 0 5 2)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -26622,7 +26124,8 @@ Run project command, displaying resultant buffer in a new tab. The following commands are available: \\{project-prefix-map}" t nil) - (define-key tab-prefix-map "p" #'project-other-tab-command) + +(when (bound-and-true-p tab-prefix-map) (define-key tab-prefix-map "p" #'project-other-tab-command)) (autoload 'project-find-regexp "project" "\ Find all matches for REGEXP in the current project's roots. @@ -26742,7 +26245,7 @@ identical. Only the buffers that match a condition in `project-kill-buffer-conditions' will be killed. If NO-CONFIRM is non-nil, the command will not ask the user for confirmation. NO-CONFIRM is always nil when the command is invoked -interactivly. +interactively. \(fn &optional NO-CONFIRM)" t nil) @@ -26876,14 +26379,6 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ps-mule" "ps-mule.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from ps-mule.el - -(register-definition-prefixes "ps-mule" '("ps-mule-")) - -;;;*** - ;;;### (autoloads nil "ps-print" "ps-print.el" (0 0 0 0)) ;;; Generated autoloads from ps-print.el (push (purecopy '(ps-print 7 3 5)) package--builtin-versions) @@ -27109,7 +26604,7 @@ Optional argument FACE specifies the face to do the highlighting. ;;;### (autoloads nil "python" "progmodes/python.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/python.el -(push (purecopy '(python 0 26 1)) package--builtin-versions) +(push (purecopy '(python 0 27)) package--builtin-versions) (add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode)) @@ -27613,10 +27108,13 @@ or call the function `rcirc-track-minor-mode'.") (autoload 'rcirc-track-minor-mode "rcirc" "\ Global minor mode for tracking activity in rcirc buffers. -If called interactively, enable Rcirc-Track minor mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Rcirc-Track minor mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27662,10 +27160,13 @@ or call the function `recentf-mode'.") (autoload 'recentf-mode "recentf" "\ Toggle \"Open Recent\" menu (Recentf mode). -If called interactively, enable Recentf mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Recentf mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27817,10 +27318,13 @@ with a prefix argument, prompt for START-AT and FORMAT. (autoload 'rectangle-mark-mode "rect" "\ Toggle the region as rectangular. -If called interactively, enable Rectangle-Mark mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Rectangle-Mark mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27853,10 +27357,13 @@ Activates the region if needed. Only lasts until the region is deactivated. (autoload 'refill-mode "refill" "\ Toggle automatic refilling (Refill mode). -If called interactively, enable Refill mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Refill mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27887,10 +27394,13 @@ Turn on RefTeX mode." nil nil) (autoload 'reftex-mode "reftex" "\ Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX. -If called interactively, enable Reftex mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Reftex mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -27933,78 +27443,6 @@ This enforces rescanning the buffer on next use." nil nil) ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "reftex-auc" "textmodes/reftex-auc.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-auc.el - -(register-definition-prefixes "reftex-auc" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-cite" -;;;;;; "textmodes/reftex-cite.el" (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-cite.el - -(register-definition-prefixes "reftex-cite" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-dcr" "textmodes/reftex-dcr.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-dcr.el - -(register-definition-prefixes "reftex-dcr" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-global" -;;;;;; "textmodes/reftex-global.el" (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-global.el - -(register-definition-prefixes "reftex-global" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-index" -;;;;;; "textmodes/reftex-index.el" (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-index.el - -(register-definition-prefixes "reftex-index" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-parse" -;;;;;; "textmodes/reftex-parse.el" (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-parse.el - -(register-definition-prefixes "reftex-parse" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-ref" "textmodes/reftex-ref.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-ref.el - -(register-definition-prefixes "reftex-ref" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-sel" "textmodes/reftex-sel.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-sel.el - -(register-definition-prefixes "reftex-sel" '("reftex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "reftex-toc" "textmodes/reftex-toc.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from textmodes/reftex-toc.el - -(register-definition-prefixes "reftex-toc" '("reftex-")) - -;;;*** - ;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (0 ;;;;;; 0 0 0)) ;;; Generated autoloads from textmodes/reftex-vars.el @@ -28083,7 +27521,6 @@ This means the number of non-shy regexp grouping constructs ;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/regi.el -(push (purecopy '(regi 1 8)) package--builtin-versions) (register-definition-prefixes "regi" '("regi-")) @@ -28238,10 +27675,13 @@ first comment line visible (if point is in a comment). (autoload 'reveal-mode "reveal" "\ Toggle uncloaking of invisible text near point (Reveal mode). -If called interactively, enable Reveal mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Reveal mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28249,6 +27689,8 @@ disabled. Reveal mode is a buffer-local minor mode. When enabled, it reveals invisible text around point. +Also see the `reveal-auto-hide' variable. + \(fn &optional ARG)" t nil) (defvar global-reveal-mode nil "\ @@ -28265,10 +27707,13 @@ or call the function `global-reveal-mode'.") Toggle Reveal mode in all buffers (Global Reveal mode). Reveal mode renders invisible text around point visible again. -If called interactively, enable Global Reveal mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Global Reveal mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28597,30 +28042,6 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "rmailedit" "mail/rmailedit.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from mail/rmailedit.el - -(register-definition-prefixes "rmailedit" '("rmail-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "rmailkwd" "mail/rmailkwd.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from mail/rmailkwd.el - -(register-definition-prefixes "rmailkwd" '("rmail-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "rmailmm" "mail/rmailmm.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from mail/rmailmm.el - -(register-definition-prefixes "rmailmm" '("rmail-")) - -;;;*** - ;;;### (autoloads nil "rmailout" "mail/rmailout.el" (0 0 0 0)) ;;; Generated autoloads from mail/rmailout.el (put 'rmail-output-file-alist 'risky-local-variable t) @@ -28693,22 +28114,6 @@ than appending to it. Deletes the message after writing if ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "rmailsort" "mail/rmailsort.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from mail/rmailsort.el - -(register-definition-prefixes "rmailsort" '("rmail-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "rmailsum" "mail/rmailsum.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from mail/rmailsum.el - -(register-definition-prefixes "rmailsum" '("rmail-")) - -;;;*** - ;;;### (autoloads nil "rmc" "emacs-lisp/rmc.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/rmc.el @@ -28836,10 +28241,13 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil) (autoload 'rng-validate-mode "rng-valid" "\ Minor mode performing continual validation against a RELAX NG schema. -If called interactively, enable Rng-Validate mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Rng-Validate mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -28990,10 +28398,13 @@ highlighting. (autoload 'rst-minor-mode "rst" "\ Toggle ReST minor mode. -If called interactively, enable Rst minor mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Rst minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29043,10 +28454,13 @@ Use the command `ruler-mode' to change this variable.") (autoload 'ruler-mode "ruler-mode" "\ Toggle display of ruler in header line (Ruler mode). -If called interactively, enable Ruler mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Ruler mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29274,7 +28688,6 @@ For more details, see Info node `(elisp) Extending Rx'. ;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (0 0 0 0)) ;;; Generated autoloads from net/sasl-ntlm.el -(push (purecopy '(sasl 1 0)) package--builtin-versions) (register-definition-prefixes "sasl-ntlm" '("sasl-ntlm-")) @@ -29298,7 +28711,6 @@ For more details, see Info node `(elisp) Extending Rx'. ;;;### (autoloads nil "savehist" "savehist.el" (0 0 0 0)) ;;; Generated autoloads from savehist.el -(push (purecopy '(savehist 24)) package--builtin-versions) (defvar savehist-mode nil "\ Non-nil if Savehist mode is enabled. @@ -29313,10 +28725,13 @@ or call the function `savehist-mode'.") (autoload 'savehist-mode "savehist" "\ Toggle saving of minibuffer history (Savehist mode). -If called interactively, enable Savehist mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Savehist mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29371,10 +28786,13 @@ Non-nil means automatically save place in each file. This means when you visit a file, point goes to the last place where it was when you previously visited the same file. -If called interactively, enable Save-Place mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Save-Place mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29387,10 +28805,13 @@ If this mode is enabled, point is recorded when you kill the buffer or exit Emacs. Visiting this file again will go to that position, even in a later Emacs session. -If called interactively, enable Save-Place-Local mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Save-Place-Local mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29478,10 +28899,13 @@ or call the function `scroll-all-mode'.") (autoload 'scroll-all-mode "scroll-all" "\ Toggle shared scrolling in same-frame windows (Scroll-All mode). -If called interactively, enable Scroll-All mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Scroll-All mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29508,10 +28932,13 @@ one window apply to all visible windows in the same frame. (autoload 'scroll-lock-mode "scroll-lock" "\ Buffer-local minor mode for pager-like scrolling. -If called interactively, enable Scroll-Lock mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Scroll-Lock mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29582,10 +29009,13 @@ or call the function `semantic-mode'.") (autoload 'semantic-mode "semantic" "\ Toggle parser features (Semantic mode). -If called interactively, enable Semantic mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Semantic mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -29604,22 +29034,6 @@ Semantic mode. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze" -;;;;;; "cedet/semantic/analyze.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/analyze.el - -(register-definition-prefixes "semantic/analyze" '("semantic-a")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze/complete" -;;;;;; "cedet/semantic/analyze/complete.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/analyze/complete.el - -(register-definition-prefixes "semantic/analyze/complete" '("semantic-analyze-")) - -;;;*** - ;;;### (autoloads nil "semantic/analyze/debug" "cedet/semantic/analyze/debug.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/analyze/debug.el @@ -29636,30 +29050,6 @@ Semantic mode. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze/refs" -;;;;;; "cedet/semantic/analyze/refs.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/analyze/refs.el - -(register-definition-prefixes "semantic/analyze/refs" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine" -;;;;;; "cedet/semantic/bovine.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/bovine.el - -(register-definition-prefixes "semantic/bovine" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/c" -;;;;;; "cedet/semantic/bovine/c.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/bovine/c.el - -(register-definition-prefixes "semantic/bovine/c" '("c-mode" "semantic")) - -;;;*** - ;;;### (autoloads nil "semantic/bovine/debug" "cedet/semantic/bovine/debug.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/bovine/debug.el @@ -29668,22 +29058,6 @@ Semantic mode. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/el" -;;;;;; "cedet/semantic/bovine/el.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/bovine/el.el - -(register-definition-prefixes "semantic/bovine/el" '("emacs-lisp-mode" "semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/gcc" -;;;;;; "cedet/semantic/bovine/gcc.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/bovine/gcc.el - -(register-definition-prefixes "semantic/bovine/gcc" '("semantic-")) - -;;;*** - ;;;### (autoloads nil "semantic/bovine/grammar" "cedet/semantic/bovine/grammar.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el @@ -29697,22 +29071,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/make" -;;;;;; "cedet/semantic/bovine/make.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/bovine/make.el - -(register-definition-prefixes "semantic/bovine/make" '("makefile-mode" "semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/scm" -;;;;;; "cedet/semantic/bovine/scm.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/bovine/scm.el - -(register-definition-prefixes "semantic/bovine/scm" '("semantic-")) - -;;;*** - ;;;### (autoloads nil "semantic/chart" "cedet/semantic/chart.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/chart.el @@ -29721,30 +29079,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/complete" -;;;;;; "cedet/semantic/complete.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/complete.el - -(register-definition-prefixes "semantic/complete" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/ctxt" -;;;;;; "cedet/semantic/ctxt.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/ctxt.el - -(register-definition-prefixes "semantic/ctxt" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/db" -;;;;;; "cedet/semantic/db.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/db.el - -(register-definition-prefixes "semantic/db" '("semanticdb-")) - -;;;*** - ;;;### (autoloads nil "semantic/db-debug" "cedet/semantic/db-debug.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/db-debug.el @@ -29769,30 +29103,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-file" -;;;;;; "cedet/semantic/db-file.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/db-file.el - -(register-definition-prefixes "semantic/db-file" '("semanticdb-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-find" -;;;;;; "cedet/semantic/db-find.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/db-find.el - -(register-definition-prefixes "semantic/db-find" '("semanticdb-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-global" -;;;;;; "cedet/semantic/db-global.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/db-global.el - -(register-definition-prefixes "semantic/db-global" '("semanticdb-")) - -;;;*** - ;;;### (autoloads nil "semantic/db-javascript" "cedet/semantic/db-javascript.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/db-javascript.el @@ -29801,14 +29111,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-mode" -;;;;;; "cedet/semantic/db-mode.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/db-mode.el - -(register-definition-prefixes "semantic/db-mode" '("semanticdb-")) - -;;;*** - ;;;### (autoloads nil "semantic/db-ref" "cedet/semantic/db-ref.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/db-ref.el @@ -29817,22 +29119,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-typecache" -;;;;;; "cedet/semantic/db-typecache.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/db-typecache.el - -(register-definition-prefixes "semantic/db-typecache" '("semanticdb-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/debug" -;;;;;; "cedet/semantic/debug.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/debug.el - -(register-definition-prefixes "semantic/debug" '("semantic-debug-")) - -;;;*** - ;;;### (autoloads nil "semantic/decorate" "cedet/semantic/decorate.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/decorate.el @@ -29841,38 +29127,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/decorate/include" -;;;;;; "cedet/semantic/decorate/include.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/decorate/include.el - -(register-definition-prefixes "semantic/decorate/include" '("semantic-decoration-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/decorate/mode" -;;;;;; "cedet/semantic/decorate/mode.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/decorate/mode.el - -(register-definition-prefixes "semantic/decorate/mode" '("define-semantic-decoration-style" "semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/dep" -;;;;;; "cedet/semantic/dep.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/dep.el - -(register-definition-prefixes "semantic/dep" '("defcustom-mode-local-semantic-dependency-system-include-path" "semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/doc" -;;;;;; "cedet/semantic/doc.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/doc.el - -(register-definition-prefixes "semantic/doc" '("semantic-doc")) - -;;;*** - ;;;### (autoloads nil "semantic/ede-grammar" "cedet/semantic/ede-grammar.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/ede-grammar.el @@ -29881,30 +29135,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/edit" -;;;;;; "cedet/semantic/edit.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/edit.el - -(register-definition-prefixes "semantic/edit" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/find" -;;;;;; "cedet/semantic/find.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/find.el - -(register-definition-prefixes "semantic/find" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/format" -;;;;;; "cedet/semantic/format.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/format.el - -(register-definition-prefixes "semantic/format" '("semantic-")) - -;;;*** - ;;;### (autoloads nil "semantic/fw" "cedet/semantic/fw.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from cedet/semantic/fw.el @@ -29929,46 +29159,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/html" -;;;;;; "cedet/semantic/html.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/html.el - -(register-definition-prefixes "semantic/html" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/ia" -;;;;;; "cedet/semantic/ia.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/ia.el - -(register-definition-prefixes "semantic/ia" '("semantic-ia-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/ia-sb" -;;;;;; "cedet/semantic/ia-sb.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/ia-sb.el - -(register-definition-prefixes "semantic/ia-sb" '("semantic-ia-s")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/idle" -;;;;;; "cedet/semantic/idle.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/idle.el - -(register-definition-prefixes "semantic/idle" '("define-semantic-idle-service" "global-semantic-idle-summary-mode" "semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/imenu" -;;;;;; "cedet/semantic/imenu.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/imenu.el - -(register-definition-prefixes "semantic/imenu" '("semantic-")) - -;;;*** - ;;;### (autoloads nil "semantic/java" "cedet/semantic/java.el" (0 ;;;;;; 0 0 0)) ;;; Generated autoloads from cedet/semantic/java.el @@ -29977,30 +29167,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/lex" -;;;;;; "cedet/semantic/lex.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/lex.el - -(register-definition-prefixes "semantic/lex" '("define-lex" "semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/lex-spp" -;;;;;; "cedet/semantic/lex-spp.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/lex-spp.el - -(register-definition-prefixes "semantic/lex-spp" '("define-lex-spp-" "semantic-lex-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/mru-bookmark" -;;;;;; "cedet/semantic/mru-bookmark.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/mru-bookmark.el - -(register-definition-prefixes "semantic/mru-bookmark" '("global-semantic-mru-bookmark-mode" "semantic-")) - -;;;*** - ;;;### (autoloads nil "semantic/sb" "cedet/semantic/sb.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from cedet/semantic/sb.el @@ -30009,46 +29175,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/scope" -;;;;;; "cedet/semantic/scope.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/scope.el - -(register-definition-prefixes "semantic/scope" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/senator" -;;;;;; "cedet/semantic/senator.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/senator.el - -(register-definition-prefixes "semantic/senator" '("semantic-up-reference" "senator-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/sort" -;;;;;; "cedet/semantic/sort.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/sort.el - -(register-definition-prefixes "semantic/sort" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref" -;;;;;; "cedet/semantic/symref.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/symref.el - -(register-definition-prefixes "semantic/symref" '("semantic-symref-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/cscope" -;;;;;; "cedet/semantic/symref/cscope.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/symref/cscope.el - -(register-definition-prefixes "semantic/symref/cscope" '("semantic-symref-cscope--line-re")) - -;;;*** - ;;;### (autoloads nil "semantic/symref/filter" "cedet/semantic/symref/filter.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/symref/filter.el @@ -30057,78 +29183,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/global" -;;;;;; "cedet/semantic/symref/global.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/symref/global.el - -(register-definition-prefixes "semantic/symref/global" '("semantic-symref-global--line-re")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/grep" -;;;;;; "cedet/semantic/symref/grep.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/symref/grep.el - -(register-definition-prefixes "semantic/symref/grep" '("semantic-symref-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/idutils" -;;;;;; "cedet/semantic/symref/idutils.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/symref/idutils.el - -(register-definition-prefixes "semantic/symref/idutils" '("semantic-symref-idutils--line-re")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/list" -;;;;;; "cedet/semantic/symref/list.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/symref/list.el - -(register-definition-prefixes "semantic/symref/list" '("semantic-symref-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag" -;;;;;; "cedet/semantic/tag.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/tag.el - -(register-definition-prefixes "semantic/tag" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-file" -;;;;;; "cedet/semantic/tag-file.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/tag-file.el - -(register-definition-prefixes "semantic/tag-file" '("semantic-prototype-file")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-ls" -;;;;;; "cedet/semantic/tag-ls.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/tag-ls.el - -(register-definition-prefixes "semantic/tag-ls" '("semantic-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-write" -;;;;;; "cedet/semantic/tag-write.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/tag-write.el - -(register-definition-prefixes "semantic/tag-write" '("semantic-tag-write-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/texi" -;;;;;; "cedet/semantic/texi.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/texi.el - -(register-definition-prefixes "semantic/texi" '("semantic-")) - -;;;*** - ;;;### (autoloads nil "semantic/util" "cedet/semantic/util.el" (0 ;;;;;; 0 0 0)) ;;; Generated autoloads from cedet/semantic/util.el @@ -30137,14 +29191,6 @@ Major mode for editing Bovine grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/util-modes" -;;;;;; "cedet/semantic/util-modes.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/util-modes.el - -(register-definition-prefixes "semantic/util-modes" '("semantic-")) - -;;;*** - ;;;### (autoloads nil "semantic/wisent" "cedet/semantic/wisent.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/wisent.el @@ -30174,30 +29220,6 @@ Major mode for editing Wisent grammars. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/java-tags" -;;;;;; "cedet/semantic/wisent/java-tags.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/wisent/java-tags.el - -(register-definition-prefixes "semantic/wisent/java-tags" '("semantic-" "wisent-java-parse-error")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/javascript" -;;;;;; "cedet/semantic/wisent/javascript.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/wisent/javascript.el - -(register-definition-prefixes "semantic/wisent/javascript" '("semantic-" "wisent-javascript-jv-expand-tag")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/python" -;;;;;; "cedet/semantic/wisent/python.el" (0 0 0 0)) -;;; Generated autoloads from cedet/semantic/wisent/python.el - -(register-definition-prefixes "semantic/wisent/python" '("semantic-" "wisent-python-")) - -;;;*** - ;;;### (autoloads nil "semantic/wisent/wisent" "cedet/semantic/wisent/wisent.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/wisent/wisent.el @@ -30414,7 +29436,7 @@ and `default-sendmail-coding-system', but lower priority than the local value of `buffer-file-coding-system'. See also the function `select-message-coding-system'.") -(defvar default-sendmail-coding-system 'iso-latin-1 "\ +(defvar default-sendmail-coding-system 'utf-8 "\ Default coding system for encoding the outgoing mail. This variable is used only when `sendmail-coding-system' is nil. @@ -30522,9 +29544,11 @@ Return a list of all the elements for which (PRED element) is nil in SEQUENCE. Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE. Return the result of calling FUNCTION with INITIAL-VALUE and the -first element of SEQUENCE, then calling FUNCTION with that result and -the second element of SEQUENCE, then with that result and the third -element of SEQUENCE, etc. +first element of SEQUENCE, then calling FUNCTION with that result +and the second element of SEQUENCE, then with that result and the +third element of SEQUENCE, etc. FUNCTION will be called with +INITIAL-VALUE (and then the accumulated value) as the first +argument, and the elements from SEQUENCE as the second argument. If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called. @@ -30557,6 +29581,13 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil. \(fn SEQUENCE ELT &optional TESTFN)" nil nil) +(autoload 'seq-group-by "seq" "\ +Apply FUNCTION to each element of SEQUENCE. +Separate the elements of SEQUENCE into an alist using the results as +keys. Keys are compared using `equal'. + +\(fn FUNCTION SEQUENCE)" nil nil) + (autoload 'seq-max "seq" "\ Return the largest element of SEQUENCE. SEQUENCE must be a sequence of numbers or markers. @@ -30618,10 +29649,13 @@ or call the function `server-mode'.") (autoload 'server-mode "server" "\ Toggle Server mode. -If called interactively, enable Server mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Server mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -30760,7 +29794,6 @@ To work around that, do: ;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from progmodes/sh-script.el -(push (purecopy '(sh-script 2 0 6)) package--builtin-versions) (put 'sh-shell 'safe-local-variable 'symbolp) (autoload 'sh-mode "sh-script" "\ @@ -30960,6 +29993,19 @@ Make the shell buffer the current buffer, and return it. ;;;*** +;;;### (autoloads nil "shortdoc" "emacs-lisp/shortdoc.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from emacs-lisp/shortdoc.el + +(autoload 'shortdoc-display-group "shortdoc" "\ +Pop to a buffer with short documentation summary for functions in GROUP. + +\(fn GROUP)" t nil) + +(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "process" "regexp" "sequence" "shortdoc-" "string" "vector")) + +;;;*** + ;;;### (autoloads nil "shr" "net/shr.el" (0 0 0 0)) ;;; Generated autoloads from net/shr.el @@ -31240,10 +30286,13 @@ buffer names. (autoload 'smerge-mode "smerge-mode" "\ Minor mode to simplify editing output from the diff3 program. -If called interactively, enable Smerge mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Smerge mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31370,10 +30419,13 @@ Open the so-long `customize' group." t nil) (autoload 'so-long-minor-mode "so-long" "\ This is the minor mode equivalent of `so-long-mode'. -If called interactively, enable So-Long minor mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `So-Long minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31449,10 +30501,13 @@ or call the function `global-so-long-mode'.") (autoload 'global-so-long-mode "so-long" "\ Toggle automated performance mitigations for files with long lines. -If called interactively, enable Global So-Long mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Global So-Long mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -31479,7 +30534,7 @@ Use \\[so-long-customize] to configure the behaviour. ;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) ;;; Generated autoloads from net/soap-client.el -(push (purecopy '(soap-client 3 1 5)) package--builtin-versions) +(push (purecopy '(soap-client 3 2 0)) package--builtin-versions) (register-definition-prefixes "soap-client" '("soap-")) @@ -32407,22 +31462,6 @@ Run vsql as an inferior process. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "srecode/compile" -;;;;;; "cedet/srecode/compile.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/compile.el - -(register-definition-prefixes "srecode/compile" '("srecode-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "srecode/cpp" -;;;;;; "cedet/srecode/cpp.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/cpp.el - -(register-definition-prefixes "srecode/cpp" '("srecode-")) - -;;;*** - ;;;### (autoloads nil "srecode/ctxt" "cedet/srecode/ctxt.el" (0 0 ;;;;;; 0 0)) ;;; Generated autoloads from cedet/srecode/ctxt.el @@ -32439,30 +31478,6 @@ Run vsql as an inferior process. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "srecode/document" -;;;;;; "cedet/srecode/document.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/document.el - -(register-definition-prefixes "srecode/document" '("srecode-document-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "srecode/el" "cedet/srecode/el.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/el.el - -(register-definition-prefixes "srecode/el" '("srecode-semantic-apply-tag-to-dict")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "srecode/expandproto" -;;;;;; "cedet/srecode/expandproto.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/expandproto.el - -(register-definition-prefixes "srecode/expandproto" '("srecode-")) - -;;;*** - ;;;### (autoloads nil "srecode/extract" "cedet/srecode/extract.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/srecode/extract.el @@ -32495,38 +31510,6 @@ Run vsql as an inferior process. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "srecode/getset" -;;;;;; "cedet/srecode/getset.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/getset.el - -(register-definition-prefixes "srecode/getset" '("srecode-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "srecode/insert" -;;;;;; "cedet/srecode/insert.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/insert.el - -(register-definition-prefixes "srecode/insert" '("srecode-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "srecode/map" -;;;;;; "cedet/srecode/map.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/map.el - -(register-definition-prefixes "srecode/map" '("srecode-")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "srecode/mode" -;;;;;; "cedet/srecode/mode.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/mode.el - -(register-definition-prefixes "srecode/mode" '("srecode-")) - -;;;*** - ;;;### (autoloads nil "srecode/semantic" "cedet/srecode/semantic.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/srecode/semantic.el @@ -32535,14 +31518,6 @@ Run vsql as an inferior process. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "srecode/srt" -;;;;;; "cedet/srecode/srt.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/srt.el - -(register-definition-prefixes "srecode/srt" '("srecode-read-")) - -;;;*** - ;;;### (autoloads nil "srecode/srt-mode" "cedet/srecode/srt-mode.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el @@ -32566,22 +31541,6 @@ Major-mode for writing SRecode macros. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "srecode/template" -;;;;;; "cedet/srecode/template.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/template.el - -(register-definition-prefixes "srecode/template" '("semantic-tag-components")) - -;;;*** - -;;;### (autoloads "actual autoloads are elsewhere" "srecode/texi" -;;;;;; "cedet/srecode/texi.el" (0 0 0 0)) -;;; Generated autoloads from cedet/srecode/texi.el - -(register-definition-prefixes "srecode/texi" '("semantic-insert-foreign-tag" "srecode-texi-")) - -;;;*** - ;;;### (autoloads nil "strokes" "strokes.el" (0 0 0 0)) ;;; Generated autoloads from strokes.el @@ -32660,10 +31619,13 @@ or call the function `strokes-mode'.") (autoload 'strokes-mode "strokes" "\ Toggle Strokes mode, a global minor mode. -If called interactively, enable Strokes mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Strokes mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -32718,6 +31680,27 @@ Studlify-case the current buffer." t nil) ;;;### (autoloads nil "subr-x" "emacs-lisp/subr-x.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/subr-x.el +(autoload 'if-let "subr-x" "\ +Bind variables according to SPEC and evaluate THEN or ELSE. +Evaluate each binding in turn, as in `let*', stopping if a +binding value is nil. If all are non-nil return the value of +THEN, otherwise the last form in ELSE. + +Each element of SPEC is a list (SYMBOL VALUEFORM) that binds +SYMBOL to the value of VALUEFORM. An element can additionally be +of the form (VALUEFORM), which is evaluated and checked for nil; +i.e. SYMBOL can be omitted if only the test result is of +interest. It can also be of the form SYMBOL, then the binding of +SYMBOL is checked for nil. + +As a special case, interprets a SPEC of the form (SYMBOL SOMETHING) +like ((SYMBOL SOMETHING)). This exists for backward compatibility +with an old syntax that accepted only one binding. + +\(fn SPEC THEN &rest ELSE)" nil t) + +(function-put 'if-let 'lisp-indent-function '2) + (autoload 'when-let "subr-x" "\ Bind variables according to SPEC and conditionally evaluate BODY. Evaluate each binding in turn, stopping if a binding value is nil. @@ -32734,7 +31717,7 @@ Truncate STRING to LENGTH, replacing initial surplus with \"...\". \(fn STRING LENGTH)" nil nil) -(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let" "internal--" "replace-region-contents" "string-" "thread-" "when-let*")) +(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "replace-region-contents" "string-" "thread-" "when-let*")) ;;;*** @@ -32746,10 +31729,13 @@ Truncate STRING to LENGTH, replacing initial surplus with \"...\". (autoload 'subword-mode "subword" "\ Toggle subword movement and editing (Subword mode). -If called interactively, enable Subword mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Subword mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -32794,17 +31780,22 @@ ARG is omitted or nil. Subword mode is enabled in all buffers where `(lambda nil (subword-mode 1))' would do it. -See `subword-mode' for more information on Subword mode. + +See `subword-mode' for more information on +Subword mode. \(fn &optional ARG)" t nil) (autoload 'superword-mode "subword" "\ Toggle superword movement and editing (Superword mode). -If called interactively, enable Superword mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Superword mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -32838,7 +31829,9 @@ ARG is omitted or nil. Superword mode is enabled in all buffers where `(lambda nil (superword-mode 1))' would do it. -See `superword-mode' for more information on Superword mode. + +See `superword-mode' for more information on +Superword mode. \(fn &optional ARG)" t nil) @@ -32880,7 +31873,7 @@ and `sc-post-hook' is run after the guts of this function." nil nil) ;;;### (autoloads nil "svg" "svg.el" (0 0 0 0)) ;;; Generated autoloads from svg.el -(push (purecopy '(svg 1 0)) package--builtin-versions) +(push (purecopy '(svg 1 1)) package--builtin-versions) (register-definition-prefixes "svg" '("svg-")) @@ -32902,10 +31895,13 @@ or call the function `gpm-mouse-mode'.") (autoload 'gpm-mouse-mode "t-mouse" "\ Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). -If called interactively, enable Gpm-Mouse mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Gpm-Mouse mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -32930,10 +31926,13 @@ GPM. This is due to limitations in GPM and the Linux kernel. (autoload 'tab-line-mode "tab-line" "\ Toggle display of window tab line in the buffer. -If called interactively, enable Tab-Line mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Tab-Line mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -32964,7 +31963,9 @@ ARG is omitted or nil. Tab-Line mode is enabled in all buffers where `tab-line-mode--turn-on' would do it. -See `tab-line-mode' for more information on Tab-Line mode. + +See `tab-line-mode' for more information on +Tab-Line mode. \(fn &optional ARG)" t nil) @@ -33341,10 +32342,13 @@ location is indicated by `table-word-continuation-char'. This variable's value can be toggled by \\[table-fixed-width-mode] at run-time. -If called interactively, enable Table-Fixed-Width mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Table-Fixed-Width mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -33383,7 +32387,7 @@ buffer, and leaves the previous contents of the buffer untouched. References used for this implementation: HTML: - URL `http://www.w3.org' + URL `https://www.w3.org' LaTeX: URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html' @@ -33663,7 +32667,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. \(fn COMMAND &optional ARG)" t nil) -(register-definition-prefixes "tcl" '("add-log-tcl-defun" "calculate-tcl-indent" "indent-tcl-exp" "inferior-tcl-" "run-tcl" "switch-to-tcl" "tcl-")) +(register-definition-prefixes "tcl" '("inferior-tcl-" "run-tcl" "switch-to-tcl" "tcl-")) ;;;*** @@ -34529,10 +33533,13 @@ This function is meant to be used as a `post-self-insert-hook'." t nil) (autoload 'tildify-mode "tildify" "\ Adds electric behavior to space character. -If called interactively, enable Tildify mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Tildify mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -34581,10 +33588,13 @@ or call the function `display-time-mode'.") (autoload 'display-time-mode "time" "\ Toggle display of time, load level, and mail flag in mode lines. -If called interactively, enable Display-Time mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Display-Time mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -34597,7 +33607,7 @@ runs the normal hook `display-time-hook' after each update. \(fn &optional ARG)" t nil) -(defalias 'display-time-world #'world-clock) +(define-obsolete-function-alias 'display-time-world #'world-clock "28.1") (autoload 'world-clock "time" "\ Display a world clock buffer with times in various time zones. @@ -34608,8 +33618,10 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. Return a string giving the uptime of this instance of Emacs. FORMAT is a string to format the result, using `format-seconds'. For example, the Unix uptime command format is \"%D, %z%2h:%.2m\". +If the optional argument HERE is non-nil, insert string at +point. -\(fn &optional FORMAT)" t nil) +\(fn &optional FORMAT HERE)" t nil) (autoload 'emacs-init-time "time" "\ Return a string giving the duration of the Emacs initialization." t nil) @@ -34700,6 +33712,10 @@ Lower-case specifiers return only the unit. optional leading \".\" for zero-padding. For example, \"%.3Y\" will return something of the form \"001 year\". +The \"%s\" spec takes an additional optional parameter, +introduced by the \",\" character, to say how many decimals to +use. \"%,1s\" means \"use one decimal\". + The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing is output until the first non-zero unit is encountered. @@ -34766,7 +33782,6 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (0 0 0 ;;;;;; 0)) ;;; Generated autoloads from calendar/timeclock.el -(push (purecopy '(timeclock 2 6 1)) package--builtin-versions) (defvar timeclock-mode-line-display nil "\ Non-nil if Timeclock-Mode-Line-Display mode is enabled. @@ -34921,7 +33936,6 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;### (autoloads nil "tmm" "tmm.el" (0 0 0 0)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) - (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) (autoload 'tmm-menubar "tmm" "\ Text-mode emulation of looking and choosing from a menubar. @@ -35466,10 +34480,13 @@ or call the function `type-break-mode'.") Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. -If called interactively, enable Type-Break mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Type-Break mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -35689,14 +34706,6 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "undigest" "mail/undigest.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from mail/undigest.el - -(register-definition-prefixes "undigest" '("rmail-")) - -;;;*** - ;;;### (autoloads nil "unrmail" "mail/unrmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/unrmail.el @@ -36002,10 +35011,13 @@ or call the function `url-handler-mode'.") (autoload 'url-handler-mode "url-handlers" "\ Toggle using `url' library for URL filenames (URL Handler mode). -If called interactively, enable Url-Handler mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Url-Handler mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38160,10 +37172,13 @@ own View-like bindings. (autoload 'view-mode "view" "\ Toggle View mode, a minor mode for viewing text but not editing it. -If called interactively, enable View mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `View mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38441,6 +37456,11 @@ See also `warning-series', `warning-prefix-function', `warning-fill-prefix', and `warning-fill-column' for additional programming features. +This will also display buttons allowing the user to permanently +disable automatic display of the warning or disable the warning +entirely by setting `warning-suppress-types' or +`warning-suppress-log-types' on their behalf. + \(fn TYPE MESSAGE &optional LEVEL BUFFER-NAME)" nil nil) (autoload 'lwarn "warnings" "\ @@ -38531,10 +37551,13 @@ or call the function `which-function-mode'.") (autoload 'which-function-mode "which-func" "\ Toggle mode line display of current function (Which Function mode). -If called interactively, enable Which-Function mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Which-Function mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38556,10 +37579,13 @@ in certain major modes. (autoload 'whitespace-mode "whitespace" "\ Toggle whitespace visualization (Whitespace mode). -If called interactively, enable Whitespace mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Whitespace mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38572,10 +37598,13 @@ See also `whitespace-style', `whitespace-newline' and (autoload 'whitespace-newline-mode "whitespace" "\ Toggle newline visualization (Whitespace Newline mode). -If called interactively, enable Whitespace-Newline mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Whitespace-Newline mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38602,10 +37631,13 @@ or call the function `global-whitespace-mode'.") (autoload 'global-whitespace-mode "whitespace" "\ Toggle whitespace visualization globally (Global Whitespace mode). -If called interactively, enable Global Whitespace mode if ARG is -positive, and disable it if ARG is zero or negative. If called from -Lisp, also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Global Whitespace mode'. If the +prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38628,10 +37660,13 @@ or call the function `global-whitespace-newline-mode'.") (autoload 'global-whitespace-newline-mode "whitespace" "\ Toggle global newline visualization (Global Whitespace Newline mode). -If called interactively, enable Global Whitespace-Newline mode if ARG -is positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and toggle -it if ARG is `toggle'; disable the mode otherwise. +If called interactively, toggle `Global Whitespace-Newline mode'. If +the prefix argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -38955,10 +37990,13 @@ Show widget browser for WIDGET in other window. (autoload 'widget-minor-mode "wid-browse" "\ Minor mode for traversing widgets. -If called interactively, enable Widget minor mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Widget minor mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -39192,10 +38230,13 @@ or call the function `winner-mode'.") (autoload 'winner-mode "winner" "\ Toggle Winner mode on or off. -If called interactively, enable Winner mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Winner mode'. If the prefix argument +is positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -39481,10 +38522,13 @@ or call the function `xterm-mouse-mode'.") (autoload 'xterm-mouse-mode "xt-mouse" "\ Toggle XTerm mouse mode. -If called interactively, enable Xterm-Mouse mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. +If called interactively, toggle `Xterm-Mouse mode'. If the prefix +argument is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. All other +values will disable the mode. The mode's hook is called both when the mode is enabled and when it is disabled. @@ -39601,16 +38645,16 @@ Zone out, completely." t nil) ;;;;;; "erc/erc-notify.el" "erc/erc-page.el" "erc/erc-pcomplete.el" ;;;;;; "erc/erc-replace.el" "erc/erc-ring.el" "erc/erc-services.el" ;;;;;; "erc/erc-sound.el" "erc/erc-speedbar.el" "erc/erc-spelling.el" -;;;;;; "erc/erc-stamp.el" "erc/erc-track.el" "erc/erc-truncate.el" -;;;;;; "erc/erc-xdcc.el" "eshell/em-alias.el" "eshell/em-banner.el" -;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el" -;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el" -;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" -;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" -;;;;;; "eshell/em-tramp.el" "eshell/em-unix.el" "eshell/em-xtra.el" -;;;;;; "facemenu.el" "faces.el" "files.el" "font-core.el" "font-lock.el" -;;;;;; "format.el" "frame.el" "help.el" "hfy-cmap.el" "ibuf-ext.el" -;;;;;; "indent.el" "international/characters.el" "international/charprop.el" +;;;;;; "erc/erc-stamp.el" "erc/erc-status-sidebar.el" "erc/erc-track.el" +;;;;;; "erc/erc-truncate.el" "erc/erc-xdcc.el" "eshell/em-alias.el" +;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el" +;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el" +;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el" +;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el" +;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el" +;;;;;; "eshell/em-xtra.el" "facemenu.el" "faces.el" "files.el" "font-core.el" +;;;;;; "font-lock.el" "format.el" "frame.el" "help.el" "hfy-cmap.el" +;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charprop.el" ;;;;;; "international/charscript.el" "international/cp51932.el" ;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el" ;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el" diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el index d4170564c58..cbc555d1faa 100644 --- a/lisp/leim/quail/ipa.el +++ b/lisp/leim/quail/ipa.el @@ -340,7 +340,7 @@ See http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition of the mapping.") (quail-define-rules - ;; Table taken from http://en.wikipedia.org/wiki/X-SAMPA, checked with + ;; Table taken from https://en.wikipedia.org/wiki/X-SAMPA, checked with ;; http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf ("d`" "ɖ") ;; Voiced retroflex plosive U+0256 diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index a033739efba..1d6aeddc060 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -937,7 +937,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\=' (quail-define-package "danish-postfix" "Latin-1" "DA<" t - "Danish input method (rule: AE -> Æ, OE -> Ø, AA -> Å, E\\=' -> É) + "Danish input method (rule: AE -> Æ, OE -> Ø, AA -> Å, E\\=' -> É, E= -> €) Doubling the postfix separates the letter and postfix: e.g. aee -> ae " @@ -951,6 +951,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae ("AA" ?Å) ("aa" ?å) ("E'" ?É) + ("E=" ?€) ("e'" ?é) ("AEE" ["AE"]) @@ -960,6 +961,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae ("AAA" ["AA"]) ("aaa" ["aa"]) ("E''" ["E'"]) + ("E==" ["E="]) ("e''" ["e'"]) ) @@ -1034,6 +1036,7 @@ AE -> Ä AEE -> AE OE -> Ö OEE -> OE +E= -> € " nil t nil nil nil nil nil nil nil nil t) @@ -1042,11 +1045,13 @@ OEE -> OE ("ae" ?ä) ("OE" ?Ö) ("oe" ?ö) + ("E=" ?€) ("AEE" ["AE"]) ("aee" ["ae"]) ("OEE" ["OE"]) ("oee" ["oe"]) + ("E==" ["E="]) ) (quail-define-package @@ -1061,6 +1066,8 @@ Par exemple: a\\=` -> à e\\=' -> é. En doublant la frappe des diacritiques, ils s'isoleront de la lettre. Par exemple: e\\='\\=' -> e\\=' +€ est produit par E=. + Œ est produit par O/." nil t nil nil nil nil nil nil nil nil t) @@ -1073,6 +1080,7 @@ Par exemple: e\\='\\=' -> e\\=' ("E'" ?É) ("E^" ?Ê) ("E\"" ?Ë) + ("E=" ?€) ("e`" ?è) ("e'" ?é) ("e^" ?ê) @@ -1104,6 +1112,7 @@ Par exemple: e\\='\\=' -> e\\=' ("E''" ["E'"]) ("E^^" ["E^"]) ("E\"\"" ["E\""]) + ("E==" ["E="]) ("e``" ["e`"]) ("e''" ["e'"]) ("e^^" ["e^"]) @@ -1140,6 +1149,7 @@ ue -> ü (not after a/e/q) uee -> ue sz -> ß szz -> sz +E= -> € " nil t nil nil nil nil nil nil nil nil t) @@ -1152,6 +1162,7 @@ szz -> sz ("ue" ?ü) ("sz" ?ß) ("SZ" ?ẞ) + ("E=" ?€) ("AEE" ["AE"]) ("aee" ["ae"]) @@ -1168,6 +1179,7 @@ szz -> sz ("Aue" ["Aue"]) ("que" ["que"]) ("Que" ["Que"]) + ("E==" ["E="]) ) (quail-define-package @@ -1184,6 +1196,7 @@ AE -> Æ OE -> Ö D/ -> Ð (eth) T/ -> Þ (thorn) +E= -> € Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\=' " nil t nil nil nil nil nil nil nil nil t) @@ -1238,7 +1251,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\=' a\\=` -> à A\\=` -> À e\\=' -> é << -> « e\\=` -> è E\\=` -> È E\\=' -> É >> -> » -i\\=` -> ì I\\=` -> Ì o_ -> º +i\\=` -> ì I\\=` -> Ì E= -> € o_ -> º o\\=` -> ò O\\=` -> Ò a_ -> ª u\\=` -> ù U\\=` -> Ù @@ -1252,6 +1265,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=` ("a`" ?à) ("E`" ?È) ("E'" ?É) + ("E=" ?€) ("e`" ?è) ("e'" ?é) ("I`" ?Ì) @@ -1269,6 +1283,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=` ("a``" ["a`"]) ("E``" ["E`"]) ("E''" ["E'"]) + ("E==" ["E="]) ("e``" ["e`"]) ("e''" ["e'"]) ("I``" ["I`"]) @@ -1285,7 +1300,8 @@ Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=` (quail-define-package "norwegian-postfix" "Latin-1" "NO<" t - "Norwegian (Norsk) input method (rule: AE->Æ OE->Ø AA->Å E\\='->É) + "Norwegian (Norsk) input method (rule: AE->Æ OE->Ø AA->Å E\\='->É + E= -> €) Doubling the postfix separates the letter and postfix: e.g. aee -> ae " @@ -1299,6 +1315,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae ("AA" ?Å) ("aa" ?å) ("E'" ?É) + ("E=" ?€) ("e'" ?é) ("AEE" ["AE"]) @@ -1308,6 +1325,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae ("AAA" ["AA"]) ("aaa" ["aa"]) ("E''" ["E'"]) + ("E==" ["E="]) ("e''" ["e'"]) ) @@ -1322,6 +1340,7 @@ aa -> å a\" -> ä o\" -> ö e\\=' -> é +E= -> € Doubling the postfix separates the letter and postfix: aee -> ae o\"\" -> o\" etc. @@ -1339,6 +1358,7 @@ aee -> ae o\"\" -> o\" etc. ("O\"" ?Ö) ("o\"" ?ö) ("E'" ?É) + ("E=" ?€) ("e'" ?é) ("AEE" ["AE"]) @@ -1352,6 +1372,7 @@ aee -> ae o\"\" -> o\" etc. ("O\"\"" ["O\""]) ("o\"\"" ["o\""]) ("E''" ["E'"]) + ("E==" ["E="]) ("e''" ["e'"]) ) @@ -1361,6 +1382,7 @@ aee -> ae o\"\" -> o\" etc. A\\=' -> Á E\\=' -> É +E= -> € I\\=' -> Í O\\=' -> Ó U\\=' -> Ú @@ -1376,6 +1398,7 @@ a\\='\\=' -> a\\=' n~~ -> n~, etc. ("A'" ?Á) ("a'" ?á) ("E'" ?É) + ("E=" ?€) ("e'" ?é) ("I'" ?Í) ("i'" ?í) @@ -1393,6 +1416,7 @@ a\\='\\=' -> a\\=' n~~ -> n~, etc. ("A''" ["A'"]) ("a''" ["a'"]) ("E''" ["E'"]) + ("E==" ["E="]) ("e''" ["e'"]) ("I''" ["I'"]) ("i''" ["i'"]) @@ -1410,7 +1434,8 @@ a\\='\\=' -> a\\=' n~~ -> n~, etc. (quail-define-package "swedish-postfix" "Latin-1" "SV<" t - "Swedish (Svenska) input method (rule: AA -> Å AE -> Ä OE -> Ö E\\=' -> É) + "Swedish (Svenska) input method +(rule: AA -> Å AE -> Ä OE -> Ö E\\=' -> É E= -> €) Doubling the postfix separates the letter and postfix: e.g. aee -> ae " nil t nil nil nil nil nil nil nil nil t) @@ -1423,6 +1448,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae ("OE" ?Ö) ("oe" ?ö) ("E'" ?É) + ("E=" ?€) ("e'" ?é) ("AAA" ["AA"]) @@ -1432,6 +1458,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae ("OEE" ["OE"]) ("oee" ["oe"]) ("E''" ["E'"]) + ("E==" ["E="]) ("e''" ["e'"]) ) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index a1ff2f6270d..8ac575e8e39 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -234,11 +234,10 @@ If the feature is required by any other loaded code, and prefix arg FORCE is nil, raise an error. Standard unloading activities include restoring old autoloads for -functions defined by the library, undoing any additions that the -library has made to hook variables or to `auto-mode-alist', undoing -ELP profiling of functions in that library, unproviding any features -provided by the library, and canceling timers held in variables -defined by the library. +functions defined by the library, removing such functions from +hooks and `auto-mode-alist', undoing their ELP profiling, +unproviding any features provided by the library, and canceling +timers held in variables defined by the library. If a function `FEATURE-unload-function' is defined, this function calls it with no arguments, before doing anything else. That function @@ -287,22 +286,32 @@ something strange, such as redefining an Emacs function." ;; functions which the package might just have installed, and ;; there might be other important state, but this tactic ;; normally works. - (mapatoms - (lambda (x) - (when (and (boundp x) - (or (and (consp (symbol-value x)) ; Random hooks. - (string-match "-hooks?\\'" (symbol-name x))) - (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc. - (dolist (y unload-function-defs-list) - (when (and (eq (car-safe y) 'defun) - (not (get (cdr y) 'autoload))) - (remove-hook x (cdr y))))))) - ;; Remove any feature-symbols from auto-mode-alist as well. - (dolist (y unload-function-defs-list) - (when (and (eq (car-safe y) 'defun) - (not (get (cdr y) 'autoload))) - (setq auto-mode-alist - (rassq-delete-all (cdr y) auto-mode-alist))))) + (let ((removables (cl-loop for def in unload-function-defs-list + when (and (eq (car-safe def) 'defun) + (not (get (cdr def) 'autoload))) + collect (cdr def)))) + (mapatoms + (lambda (x) + (when (and (boundp x) + (or (and (consp (symbol-value x)) ; Random hooks. + (string-match "-hooks?\\'" (symbol-name x))) + ;; Known abnormal hooks etc. + (memq x unload-feature-special-hooks))) + (dolist (func removables) + (remove-hook x func))))) + (save-current-buffer + (dolist (buffer (buffer-list)) + (pcase-dolist (`(,sym . ,val) (buffer-local-variables buffer)) + (when (or (and (consp val) + (string-match "-hooks?\\'" (symbol-name sym))) + (memq sym unload-feature-special-hooks)) + (set-buffer buffer) + (dolist (func removables) + (remove-hook sym func t)))))) + ;; Remove any feature-symbols from auto-mode-alist as well. + (dolist (func removables) + (setq auto-mode-alist + (rassq-delete-all func auto-mode-alist))))) ;; Change major mode in all buffers using one defined in the feature being unloaded. (unload--set-major-mode) diff --git a/lisp/loadup.el b/lisp/loadup.el index 97525b27086..568b9fe40df 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -170,7 +170,6 @@ (load "cus-face") (load "faces") ; after here, `defface' may be used. -(load "button") ;; We don't want to store loaddefs.el in the repository because it is ;; a generated file; but it is required in order to compile the lisp files. @@ -193,6 +192,7 @@ definition-prefixes) (setq definition-prefixes new)) +(load "button") ;After loaddefs, because of define-minor-mode! (load "emacs-lisp/nadvice") (load "emacs-lisp/cl-preloaded") (load "obarray") ;abbrev.el is implemented in terms of obarrays. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 8851522bbdb..e2646209313 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -836,6 +836,9 @@ Return nil if no time switch found." ((memq ?t switches) 5) ; last modtime ((memq ?u switches) 4))) ; last access +(defvar ls-lisp--time-locale nil + "Locale to be used for formatting file times.") + (defun ls-lisp-format-time (file-attr time-index) "Format time for file with attributes FILE-ATTR according to TIME-INDEX. Use the same method as ls to decide whether to show time-of-day or year, @@ -851,11 +854,13 @@ All ls time options, namely c, t and u, are handled." (condition-case nil ;; Use traditional time format in the C or POSIX locale, ;; ISO-style time format otherwise, so columns line up. - (let ((locale system-time-locale)) + (let ((locale (or system-time-locale ls-lisp--time-locale))) (if (not locale) (let ((vars '("LC_ALL" "LC_TIME" "LANG"))) (while (and vars (not (setq locale (getenv (car vars))))) - (setq vars (cdr vars))))) + (setq vars (cdr vars))) + ;; Cache the locale for next calls. + (setq ls-lisp--time-locale (or locale "C")))) (if (member locale '("C" "POSIX")) (setq locale nil)) (format-time-string diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 2c77f88f97b..035bb32fa12 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -29,12 +29,6 @@ ;;; Code: -(eval-and-compile - (defalias 'binhex-char-int - (if (fboundp 'char-int) - 'char-int - 'identity))) - (defgroup binhex nil "Decoding of BinHex (binary-to-hexadecimal) data." :group 'mail @@ -150,14 +144,14 @@ input and write the converted data to its standard output." (defun binhex-string-big-endian (string) (let ((ret 0) (i 0) (len (length string))) (while (< i len) - (setq ret (+ (ash ret 8) (binhex-char-int (aref string i))) + (setq ret (+ (ash ret 8) (aref string i)) i (1+ i))) ret)) (defun binhex-string-little-endian (string) (let ((ret 0) (i 0) (shift 0) (len (length string))) (while (< i len) - (setq ret (+ ret (ash (binhex-char-int (aref string i)) shift)) + (setq ret (+ ret (ash (aref string i) shift)) i (1+ i) shift (+ shift 8))) ret)) @@ -167,11 +161,11 @@ input and write the converted data to its standard output." (let ((pos (point-min)) len) (vector (prog1 - (setq len (binhex-char-int (char-after pos))) + (setq len (char-after pos)) (setq pos (1+ pos))) (buffer-substring pos (setq pos (+ pos len))) (prog1 - (setq len (binhex-char-int (char-after pos))) + (setq len (char-after pos)) (setq pos (1+ pos))) (buffer-substring pos (setq pos (+ pos 4))) (buffer-substring pos (setq pos (+ pos 4))) @@ -323,6 +317,8 @@ If HEADER-ONLY is non-nil only decode header and return filename." (binhex-decode-region-external start end) (binhex-decode-region-internal start end))) +(define-obsolete-function-alias 'binhex-char-int #'identity "28.1") + (provide 'binhex) ;;; binhex.el ends here diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 6b9e1db5fc6..d524b26f1b9 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -305,30 +305,7 @@ usually do not have translators for other languages.\n\n"))) (let ((txt (delete-and-extract-region (1+ user-point) (point)))) (insert (propertize "\n" 'display txt))) - (insert "\nIn " (emacs-version)) - (if emacs-build-system - (insert " built on " emacs-build-system)) - (insert "\n") - - (if (stringp emacs-repository-version) - (insert "Repository revision: " emacs-repository-version "\n")) - (if (stringp emacs-repository-branch) - (insert "Repository branch: " emacs-repository-branch "\n")) - (if (fboundp 'x-server-vendor) - (condition-case nil - ;; This is used not only for X11 but also W32 and others. - (insert "Windowing system distributor '" (x-server-vendor) - "', version " - (mapconcat 'number-to-string (x-server-version) ".") "\n") - (error t))) - (let ((os (ignore-errors (report-emacs-bug--os-description)))) - (if (stringp os) - (insert "System Description: " os "\n\n"))) - (when (and system-configuration-options - (not (equal system-configuration-options ""))) - (insert "Configured using:\n 'configure " - system-configuration-options "'\n\n") - (fill-region (line-beginning-position -1) (point))) + (emacs-bug--system-description) (insert "Configured features:\n" system-configuration-features "\n\n") (fill-region (line-beginning-position -1) (point)) (insert "Important settings:\n") @@ -409,72 +386,148 @@ usually do not have translators for other languages.\n\n"))) (buffer-substring-no-properties (point-min) (point))) (goto-char user-point))) +(defun emacs-bug--system-description () + (insert "\nIn " (emacs-version)) + (if emacs-build-system + (insert " built on " emacs-build-system)) + (insert "\n") + + (if (stringp emacs-repository-version) + (insert "Repository revision: " emacs-repository-version "\n")) + (if (stringp emacs-repository-branch) + (insert "Repository branch: " emacs-repository-branch "\n")) + (if (fboundp 'x-server-vendor) + (condition-case nil + ;; This is used not only for X11 but also W32 and others. + (insert "Windowing system distributor '" (x-server-vendor) + "', version " + (mapconcat 'number-to-string (x-server-version) ".") "\n") + (error t))) + (let ((os (ignore-errors (report-emacs-bug--os-description)))) + (if (stringp os) + (insert "System Description: " os "\n\n"))) + (when (and system-configuration-options + (not (equal system-configuration-options ""))) + (insert "Configured using:\n 'configure " + system-configuration-options "'\n\n") + (fill-region (line-beginning-position -1) (point)))) + (define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3") (defun report-emacs-bug-hook () "Do some checking before sending a bug report." - (save-excursion - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (and (= (- (point) (point-min)) - (length report-emacs-bug-orig-text)) - (string-equal (buffer-substring-no-properties (point-min) (point)) - report-emacs-bug-orig-text) - (error "No text entered in bug report")) - ;; Warning for novice users. - (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to")) - (not report-emacs-bug-no-confirmation) - (not (yes-or-no-p - "Send this bug report to the Emacs maintainers? "))) - (with-output-to-temp-buffer "*Bug Help*" - (princ (substitute-command-keys - (format "\ + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (and (= (- (point) (point-min)) + (length report-emacs-bug-orig-text)) + (string-equal (buffer-substring-no-properties (point-min) (point)) + report-emacs-bug-orig-text) + (error "No text entered in bug report")) + ;; Warning for novice users. + (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to")) + (not report-emacs-bug-no-confirmation) + (not (yes-or-no-p + "Send this bug report to the Emacs maintainers? "))) + (with-output-to-temp-buffer "*Bug Help*" + (princ (substitute-command-keys + (format "\ You invoked the command M-x report-emacs-bug, but you decided not to mail the bug report to the Emacs maintainers. If you want to mail it to someone else instead, please insert the proper e-mail address after \"To: \", and send the mail again%s." - (if report-emacs-bug-send-command - (format " using \\[%s]" - report-emacs-bug-send-command) - ""))))) - (error "M-x report-emacs-bug was canceled, please read *Bug Help* buffer")) - ;; Query the user for the SMTP method, so that we can skip - ;; questions about From header validity if the user is going to - ;; use mailclient, anyway. - (when (or (and (derived-mode-p 'message-mode) - (eq message-send-mail-function 'sendmail-query-once)) - (and (not (derived-mode-p 'message-mode)) - (eq send-mail-function 'sendmail-query-once))) - (sendmail-query-user-about-smtp) - (when (derived-mode-p 'message-mode) - (setq message-send-mail-function (message-default-send-mail-function)))) - (or report-emacs-bug-no-confirmation - ;; mailclient.el does not need a valid From - (if (derived-mode-p 'message-mode) - (eq message-send-mail-function 'message-send-mail-with-mailclient) - (eq send-mail-function 'mailclient-send-it)) - ;; Not narrowing to the headers, but that's OK. - (let ((from (mail-fetch-field "From"))) - (and (or (not from) - (message-bogus-recipient-p from) - ;; This is the default user-mail-address. On today's - ;; systems, it seems more likely to be wrong than right, - ;; since most people don't run their own mail server. - (string-match (format "\\<%s@%s\\>" - (regexp-quote (user-login-name)) - (regexp-quote (system-name))) - from)) - (not (yes-or-no-p - (format-message "Is `%s' really your email address? " - from))) - (error "Please edit the From address and try again")))) - ;; Bury the help buffer (if it's shown). - (when-let ((help (get-buffer "*Bug Help*"))) - (when (get-buffer-window help) - (quit-window nil (get-buffer-window help)))))) + (if report-emacs-bug-send-command + (format " using \\[%s]" + report-emacs-bug-send-command) + ""))))) + (error "M-x report-emacs-bug was canceled, please read *Bug Help* buffer")) + ;; Query the user for the SMTP method, so that we can skip + ;; questions about From header validity if the user is going to + ;; use mailclient, anyway. + (when (or (and (derived-mode-p 'message-mode) + (eq (message-default-send-mail-function) 'sendmail-query-once)) + (and (not (derived-mode-p 'message-mode)) + (eq send-mail-function 'sendmail-query-once))) + (setq send-mail-function (sendmail-query-user-about-smtp)) + (when (derived-mode-p 'message-mode) + (setq message-send-mail-function (message-default-send-mail-function)) + (add-hook 'message-sent-hook + (lambda () + (when (y-or-n-p "Save this mail sending choice?") + (customize-save-variable 'send-mail-function + send-mail-function))) + nil t))) + (or report-emacs-bug-no-confirmation + ;; mailclient.el does not need a valid From + (eq send-mail-function 'mailclient-send-it) + ;; Not narrowing to the headers, but that's OK. + (let ((from (mail-fetch-field "From"))) + (when (and (or (not from) + (message-bogus-recipient-p from) + ;; This is the default user-mail-address. On + ;; today's systems, it seems more likely to + ;; be wrong than right, since most people + ;; don't run their own mail server. + (string-match (format "\\<%s@%s\\>" + (regexp-quote (user-login-name)) + (regexp-quote (system-name))) + from)) + (not (yes-or-no-p + (format-message "Is `%s' really your email address? " + from)))) + (goto-char (point-min)) + (re-search-forward "^From: " nil t) + (error "Please edit the From address and try again")))) + ;; Bury the help buffer (if it's shown). + (when-let ((help (get-buffer "*Bug Help*"))) + (when (get-buffer-window help) + (quit-window nil (get-buffer-window help))))) +;;;###autoload +(defun submit-emacs-patch (subject file) + "Send an Emacs patch to the Emacs maintainers. +Interactively, you will be prompted for SUBJECT and a patch FILE +name (which will be attached to the mail). You will end up in a +Message buffer where you can explain more about the patch." + (interactive "sThis patch is about: \nfPatch file name: ") + (switch-to-buffer "*Patch Help*") + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "Thank you for considering submitting a patch to the Emacs project.\n\n" + "Please describe what the patch fixes (or, if it's a new feature, what it\n" + "implements) in the mail buffer below. When done, use the `C-c C-c' command\n" + "to send the patch as an email to the Emacs issue tracker.\n\n" + "If this is the first time you've submitted an Emacs patch, please\n" + "read the ") + (insert-text-button + "CONTRIBUTE" + 'action (lambda (_) + (view-buffer + (find-file-noselect + (expand-file-name "CONTRIBUTE" installation-directory))))) + (insert " file first.\n") + (goto-char (point-min)) + (view-mode 1) + (button-mode 1)) + (message-mail-other-window report-emacs-bug-address subject) + (insert "\n\n\n") + (emacs-bug--system-description) + (mml-attach-file file "text/patch" nil "attachment") + (message-goto-body) + (message "Write a description of the patch and use `C-c C-c' to send it") + (add-hook 'message-send-hook + (lambda () + (message-goto-body) + (insert "Tags: patch\n\n")) + nil t) + (message-add-action + (lambda () + ;; Bury the help buffer (if it's shown). + (when-let ((help (get-buffer "*Patch Help*"))) + (when (get-buffer-window help) + (quit-window nil (get-buffer-window help))))) + 'send)) (provide 'emacsbug) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 0d7193c1be0..6effe139864 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -1630,7 +1630,7 @@ local gurus." (let ((result (smtpmail-via-smtp addr-listoid prepped))) (when result (set-buffer errors-to) - (insert "Send via smtpmail failed: %s" result) + (insert "Send via smtpmail failed: " result) (let ((case-fold-search t) ;; don't be overconfident about the name of the trace buffer (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server)))) @@ -1911,7 +1911,7 @@ see the variable feedmail-prompt-before-queue-user-alist. (and (stringp feedmail-prompt-before-queue-help-supplement) (princ feedmail-prompt-before-queue-help-supplement)) (with-current-buffer standard-output - (if (fboundp 'help-mode) (help-mode))))) + (help-mode)))) (defun feedmail-message-action-scroll-up () @@ -1972,13 +1972,9 @@ backup file names and the like)." (list-of-possible-fqms)) (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global) (setq do-the-run - (if (fboundp 'y-or-n-p-with-timeout) - (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? " - d-cnt d-oth q-cnt q-oth) - 5 nil) - (y-or-n-p (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? " - d-cnt d-oth q-cnt q-oth)) - ))) + (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? " + d-cnt d-oth q-cnt q-oth) + 5 nil))) (if (not do-the-run) (setq messages-skipped q-cnt) (save-window-excursion @@ -1997,15 +1993,10 @@ backup file names and the like)." (if (and already-buffer (buffer-modified-p already-buffer)) (save-window-excursion (display-buffer (set-buffer already-buffer)) - (if (fboundp 'y-or-n-p-with-timeout) - ;; make a guess that the user just forgot to save - (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t) - (save-buffer)) - (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby)) - (save-buffer)) - ))) - - (set-buffer blobby-buffer) + ;; make a guess that the user just forgot to save + (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t) + (save-buffer)))) + (set-buffer blobby-buffer) (setq buffer-offer-save nil) (buffer-disable-undo blobby-buffer) (insert-file-contents-literally maybe-file) @@ -2158,17 +2149,8 @@ you can set `feedmail-queue-reminder-alist' to nil." (setq answer (cons '^ helper)) (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y)) (setq user-sez d-char)) - ;; these char-to-int things are because of some - ;; incomprehensible difference between the two in - ;; byte-compiled stuff between Emacs and XEmacs - ;; (well, I'm sure someone could comprehend it, - ;; but I say 'uncle') - (setq answer (or (assoc user-sez user-alist) - (and (fboundp 'char-to-int) - (assoc (char-to-int user-sez) user-alist)) - (assoc user-sez standard-alist) - (and (fboundp 'char-to-int) - (assoc (char-to-int user-sez) standard-alist)))) + (setq answer (or (assoc user-sez user-alist) + (assoc user-sez standard-alist))) (if (or (null answer) (null (cdr answer))) (progn (beep) @@ -2414,7 +2396,7 @@ mapped to mostly alphanumerics for safety." ;; mail-aliases nil = mail-abbrevs.el (feedmail-say-debug "expanding mail aliases") (if (or feedmail-force-expand-mail-aliases - (and (fboundp 'expand-mail-aliases) mail-aliases)) + mail-aliases) (expand-mail-aliases (point-min) eoh-marker)) ;; Make it pretty. @@ -3130,8 +3112,7 @@ been weeded out." ;; won't delete the newly created frame upon exit! (save-window-excursion (switch-to-buffer buffer) - (if (and (fboundp 'y-or-n-p-with-timeout) - (numberp feedmail-confirm-outgoing-timeout)) + (if (numberp feedmail-confirm-outgoing-timeout) (y-or-n-p-with-timeout "FQM: Send this email? " (abs feedmail-confirm-outgoing-timeout) diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el index f4b55031194..b357b3e2563 100644 --- a/lisp/mail/flow-fill.el +++ b/lisp/mail/flow-fill.el @@ -157,7 +157,8 @@ lines." ;; Hack: Don't do the flowing on the signature line. (when (and (not (looking-at "-- $")) (eq (char-before (line-end-position)) ?\s)) - (while (eq (char-before (line-end-position)) ?\s) + (while (and (not (eobp)) + (eq (char-before (line-end-position)) ?\s)) (end-of-line) (when delete-space (delete-char -1)) diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 61f7cbf9695..67bfbf703bb 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -5,7 +5,7 @@ ;; Author: Steven L Baur <steve@xemacs.org> (1997-2011) ;; Boruch Baum <boruch_baum@gmx.com> (2017-) ;; Keywords: mail, news -;; Version: 0.19 +;; Old-Version: 0.19 ;; This file is part of GNU Emacs. diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index 12cffd9bc4b..a2705d659a4 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el @@ -116,15 +116,6 @@ For example, you may want to set this to (\"-Z2\") to reduce header length." (require 'mail-utils) -(eval-and-compile - (if (fboundp 'point-at-bol) - (defalias 'hashcash-point-at-bol 'point-at-bol) - (defalias 'hashcash-point-at-bol 'line-beginning-position)) - - (if (fboundp 'point-at-eol) - (defalias 'hashcash-point-at-eol 'point-at-eol) - (defalias 'hashcash-point-at-eol 'line-end-position))) - (defun hashcash-strip-quoted-names (addr) (setq addr (mail-strip-quoted-names addr)) (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr)) @@ -141,8 +132,8 @@ For example, you may want to set this to (\"-Z2\") to reduce header length." (let ((token "")) (cl-loop (setq token - (concat token (buffer-substring (point) (hashcash-point-at-eol)))) - (goto-char (hashcash-point-at-eol)) + (concat token (buffer-substring (point) (line-end-position)))) + (goto-char (line-end-position)) (forward-char 1) (unless (looking-at "[ \t]") (cl-return token)) (while (looking-at "[ \t]") (forward-char 1)))))) @@ -374,6 +365,9 @@ Prefix arg sets default accept amount temporarily." (message "Payment valid")) ok)))) +(define-obsolete-function-alias 'hashcash-point-at-bol #'line-beginning-position "28.1") +(define-obsolete-function-alias 'hashcash-point-at-eol #'line-end-position "28.1") + (provide 'hashcash) ;;; hashcash.el ends here diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index f1a455dce2d..49dfd2ee874 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1851,11 +1851,16 @@ place. It affects how `mail-extract-address-components' works." ;; Updated by the RIPE Network Coordination Centre. ;; ;; Source: ISO 3166 Maintenance Agency -;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt -;; http://www.iana.org/domain-names.htm -;; http://www.iana.org/cctld/cctld-whois.htm +;; https://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt +;; https://www.iana.org/domain-names.htm +;; https://www.iana.org/cctld/cctld-whois.htm ;; Latest change: 2007/11/15 +;; FIXME: There are over 1500 top level domains, the vast majority of +;; which are not in the below list. Should they be? +;; https://data.iana.org/TLD/tlds-alpha-by-domain.txt +;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains + (defconst mail-extr-all-top-level-domains (let ((ob (make-vector 739 0))) (mapc @@ -2145,6 +2150,80 @@ place. It affects how `mail-extract-address-components' works." ("uucp" t "Unix to Unix CoPy") ;; Infrastructure Domains: ("arpa" t "Advanced Research Projects Agency (U.S. DoD)") + ;; Geographic Domains: + ("abudhabi" "Abu Dhabi") + ("africa" "Africa") + ("alsace" "Alsace, France") + ("amsterdam" "Amsterdam, The Netherlands") + ("arab" "League of Arab States") + ("asia" "Asia-Pacific region") + ("bar" "Bar, Montenegro") + ("barcelona" "Barcelona, Spain") + ("bayern" "Bavaria, Germany") + ("bcn" "Barcelona, Spain") + ("berlin" "Berlin, Germany") + ("boston" "Boston, Massachusetts") + ("brussels" "Brussels, Belgium") + ("budapest" "Budapest, Hungary") + ("bzh" "Brittany, France") + ("capetown" "Cape Town, South Africa") + ("cat" "Catalonia, Spain") + ("cologne" "Cologne, Germany") + ("corsica" "Corsica, France") + ("cymru" "Wales, United Kingdom") + ("doha" "Doha") + ("dubai" "Dubai") + ("durban" "Durban, South Africa") + ("eus" "Basque, Spain and France") + ("frl" "Friesland, Netherlands") + ("gal" "Galicia, Spain") + ("gent" "Ghent, Belgium") + ("hamburg" "Hamburg, Germany") + ("helsinki" "Helsinki, Finland") + ("irish" "Ireland") + ("ist" "İstanbul, Turkey") + ("istanbul" "İstanbul, Turkey") + ("joburg" "Johannesburg, South Africa") + ("kiwi" "New Zealanders") + ("koeln" "Cologne, Germany") + ("krd" "Kurdistan") + ("kyoto" "Kyoto, Japan") + ("lat" "Latin America") + ("london" "London, United Kingdom") + ("madrid" "Madrid, Spain") + ("melbourne" "Melbourne, Australia") + ("miami" "Miami, Florida") + ("nagoya" "Nagoya, Japan") + ("nrw" "North Rhine-Westphalia, Germany") + ("nyc" "New York City, New York") + ("okinawa" "Okinawa, Japan") + ("osaka" "Osaka, Japan") + ("paris" "Paris, France") + ("quebec" "Québec, Canada") + ("rio" "Rio de Janeiro, Brazil") + ("ruhr" "Ruhr, Germany") + ("ryukyu" "Ryukyu Islands, Japan") + ("saarland" "Saarland, Germany") + ("scot" "Scotland, United Kingdom") + ("stockholm" "Stockholm, Sweden") + ("swiss" "Switzerland") + ("sydney" "Sydney, Australia") + ("taipei" "Taipei, Taiwan") + ("tatar" "Tatars") + ("tirol" "Tyrol, Austria") + ("tokyo" "Tokyo, Japan") + ("vegas" "Las Vegas, Nevada") + ("wales" "Wales, United Kingdom") + ("wien" "Vienna, Austria") + ("yokohama" "Yokohama, Japan") + ("zuerich" "Zurich, Switzerland") + ;; Internationalized Geographic Domains: + ("xn--1qqw23a" "Foshan, China") + ("xn--xhq521b" "Guangdong, China") + ("xn--80adxhks" "Moscow, Russia") + ("xn--p1acf" "Russia") + ("xn--mgbca7dzdo" "Abu Dhabi") + ("xn--ngbrx" "Arab") )) ob)) diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el index 894313633da..e0274c8a11b 100644 --- a/lisp/mail/mail-parse.el +++ b/lisp/mail/mail-parse.el @@ -1,4 +1,4 @@ -;;; mail-parse.el --- Interface functions for parsing mail +;;; mail-parse.el --- Interface functions for parsing mail -*- lexical-binding: t -*- ;; Copyright (C) 1998-2020 Free Software Foundation, Inc. diff --git a/lisp/mail/mail-prsvr.el b/lisp/mail/mail-prsvr.el index 9023c00a66e..7c67c49b0b4 100644 --- a/lisp/mail/mail-prsvr.el +++ b/lisp/mail/mail-prsvr.el @@ -1,4 +1,4 @@ -;;; mail-prsvr.el --- Interface variables for parsing mail +;;; mail-prsvr.el --- Interface variables for parsing mail -*- lexical-binding: t -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 1f688734d47..2b76539e152 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -517,7 +517,7 @@ PREFIX is the string we want to complete." (setq mail-names (sort (append (if (consp mail-aliases) (mapcar - (function (lambda (a) (list (car a)))) + (lambda (a) (list (car a))) mail-aliases)) (if (consp mail-local-names) mail-local-names) diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el index 08325484677..405ae17a12c 100644 --- a/lisp/mail/mailclient.el +++ b/lisp/mail/mailclient.el @@ -134,7 +134,7 @@ The mail client is taken to be the handler of mailto URLs." character-coding ;; Use the external browser function to send the ;; message. - (browse-url-mailto-function nil)) + (browse-url-default-handlers nil)) ;; initialize limiter (setq mailclient-delim-static "?") ;; construct and call up mailto URL diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index 234f319669f..4aa0c2809b2 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -716,11 +716,13 @@ Point moves to the end of the region." (goto-char e))))) (defun rfc2047-fold-field () - "Fold the current header field." + "Fold the current header field. +Return the new end point." (save-excursion (save-restriction (rfc2047-narrow-to-field) - (rfc2047-fold-region (point-min) (point-max))))) + (rfc2047-fold-region (point-min) (point-max)) + (point-max)))) (defun rfc2047-fold-region (b e) "Fold long lines in region B to E." diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el index add099745b6..17da60e0bee 100644 --- a/lisp/mail/rfc2231.el +++ b/lisp/mail/rfc2231.el @@ -215,23 +215,25 @@ These look like: \"\\='en-us\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", \"\\='\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", or \"This is ***fun***\"." - (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string) - (let ((coding-system (mm-charset-to-coding-system - (match-string 1 string) nil t)) - ;;(language (match-string 2 string)) - (value (match-string 3 string))) - (mm-with-unibyte-buffer - (insert value) - (goto-char (point-min)) - (while (re-search-forward "%\\([[:xdigit:]][[:xdigit:]]\\)" nil t) - (insert - (prog1 - (string-to-number (match-string 1) 16) - (delete-region (match-beginning 0) (match-end 0))))) - ;; Decode using the charset, if any. - (if (memq coding-system '(nil ascii)) - (buffer-string) - (decode-coding-string (buffer-string) coding-system))))) + (if (not (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)\\'" + string)) + (error "Unrecognized RFC2231 format: %S" string) + (let ((value (match-string 3 string)) + ;;(language (match-string 2 string)) + (coding-system (mm-charset-to-coding-system + (match-string 1 string) nil t))) + (mm-with-unibyte-buffer + (insert value) + (goto-char (point-min)) + (while (re-search-forward "%\\([[:xdigit:]][[:xdigit:]]\\)" nil t) + (insert + (prog1 + (string-to-number (match-string 1) 16) + (delete-region (match-beginning 0) (match-end 0))))) + ;; Decode using the charset, if any. + (if (memq coding-system '(nil ascii)) + (buffer-string) + (decode-coding-string (buffer-string) coding-system)))))) (defun rfc2231-encode-string (param value) "Return a PARAM=VALUE string encoded according to RFC2231. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index f14025a93a8..86084b03f47 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -39,6 +39,7 @@ (require 'mail-utils) (require 'rfc2047) +(require 'auth-source) (require 'rmail-loaddefs) @@ -1884,7 +1885,8 @@ interactively." (when rmail-remote-password-required (setq got-password (not (rmail-have-password))) (setq supplied-password (rmail-get-remote-password - (string-match "^imaps?" proto)))) + (string-match "^imaps?" proto) + user host))) ;; FIXME ;; The password is embedded. Strip it out since movemail ;; does not really like it, in spite of the movemail spec. @@ -1904,14 +1906,12 @@ interactively." ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file) (let (got-password supplied-password - ;; (proto "pop") - ;; (user (match-string 1 file)) - ;; (host (match-string 3 file)) - ) + (user (match-string 1 file)) + (host (match-string 3 file))) (when rmail-remote-password-required (setq got-password (not (rmail-have-password))) - (setq supplied-password (rmail-get-remote-password nil))) + (setq supplied-password (rmail-get-remote-password nil user host))) (list file "pop" supplied-password got-password))) @@ -2786,7 +2786,7 @@ The current mail message becomes the message displayed." (with-current-buffer rmail-view-buffer ;; We give the view buffer a buffer-local value of ;; rmail-header-style based on the binding in effect when - ;; this function is called; `rmail-toggle-headers' can + ;; this function is called; `rmail-toggle-header' can ;; inspect this value to determine how to toggle. (set (make-local-variable 'rmail-header-style) header-style) ;; In case viewing the previous message sets the paragraph @@ -2877,9 +2877,9 @@ The current mail message becomes the message displayed." (rmail-display-labels) (rmail-swap-buffers) (setq rmail-buffer-swapped t) - (run-hooks 'rmail-show-message-hook) (when showing-message - (setq blurb (format "Showing message %d...done" msg))))) + (setq blurb (format "Showing message %d...done" msg))) + (run-hooks 'rmail-show-message-hook))) blurb)) (defun rmail-copy-headers (beg _end &optional ignored-headers) @@ -4147,22 +4147,12 @@ The variable `rmail-retry-ignored-headers' is a regular expression specifying headers which should not be copied into the new message." (interactive) (require 'mail-utils) - ;; FIXME This does not handle rmail-mime-feature != 'rmailmm. - ;; There is no API defined for rmail-mime-feature to provide - ;; rmail-mime-message-p, rmail-mime-toggle-raw equivalents. - ;; But does anyone actually use rmail-mime-feature != 'rmailmm? - (if (and rmail-enable-mime - (eq rmail-mime-feature 'rmailmm) - (featurep rmail-mime-feature)) - (with-current-buffer rmail-buffer - (if (rmail-mime-message-p) - (let ((rmail-mime-mbox-buffer rmail-view-buffer) - (rmail-mime-view-buffer rmail-buffer)) - (rmail-mime-toggle-raw 'raw))))) - - (let ((rmail-this-buffer (current-buffer)) + (let (bounce-buffer ;; Buffer we found it in + bounce-start ;; Position of start of failed message in that buffer + bounce-end ;; Position of end of failed message in that buffer + bounce-indent ;; Number of columns we need to de-indent it. (msgnum rmail-current-message) - bounce-start bounce-end bounce-indent resending + resending (content-type (rmail-get-header "Content-Type"))) (save-excursion (goto-char (point-min)) @@ -4171,19 +4161,27 @@ specifying headers which should not be copied into the new message." (string-match ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" content-type)) - ;; Handle a MIME multipart bounce message. + ;; Handle a MIME multipart bounce message + ;; by scanning the raw buffer. (let ((codestring (concat "\n--" (substring content-type (match-beginning 1) - (match-end 1))))) - (unless (re-search-forward mail-mime-unsent-header nil t) - (error "Cannot find beginning of header in failed message")) - (unless (search-forward "\n\n" nil t) - (error "Cannot find start of Mime data in failed message")) - (setq bounce-start (point)) - (if (search-forward codestring nil t) - (setq bounce-end (match-beginning 0)) - (setq bounce-end (point-max)))) + (match-end 1)))) + (beg (rmail-msgbeg msgnum)) + (end (rmail-msgend msgnum))) + (with-current-buffer rmail-view-buffer + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (unless (re-search-forward mail-mime-unsent-header nil t) + (error "Cannot find beginning of header in failed message")) + (unless (search-forward "\n\n" nil t) + (error "Cannot find start of Mime data in failed message")) + (setq bounce-start (point)) + (setq bounce-buffer (current-buffer)) + (if (search-forward codestring nil t) + (setq bounce-end (match-beginning 0)) + (setq bounce-end (point-max)))))) ;; Non-MIME bounce. (or (re-search-forward mail-unsent-separator nil t) (error "Cannot parse this as a failure message")) @@ -4198,6 +4196,7 @@ specifying headers which should not be copied into the new message." (setq bounce-indent (- (current-column))) (goto-char (point-max)) (re-search-backward "^End of returned message$" nil t) + (setq bounce-buffer (current-buffer)) (setq bounce-end (point))) ;; One message contained a few random lines before ;; the old message header. The first line of the @@ -4214,8 +4213,10 @@ specifying headers which should not be copied into the new message." (setq bounce-start (point)) (goto-char (point-max)) (search-backward (concat "\n\n" boundary) bounce-start t) + (setq bounce-buffer (current-buffer)) (setq bounce-end (point))) (setq bounce-start (point) + bounce-buffer (current-buffer) bounce-end (point-max))) (unless (search-forward "\n\n" nil t) (error "Cannot find end of header in failed message")))))) @@ -4224,9 +4225,9 @@ specifying headers which should not be copied into the new message." ;; Turn off the usual actions for initializing the message body ;; because we want to get only the text from the failure message. (let (mail-signature mail-setup-hook) - (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer + (if (rmail-start-mail nil nil nil nil nil rmail-buffer (list (list 'rmail-mark-message - rmail-this-buffer + rmail-buffer (aref rmail-msgref-vector msgnum) rmail-retried-attr-index))) ;; Insert original text as initial text of new draft message. @@ -4235,7 +4236,7 @@ specifying headers which should not be copied into the new message." (let ((inhibit-read-only t) eoh) (erase-buffer) - (insert-buffer-substring rmail-this-buffer + (insert-buffer-substring bounce-buffer bounce-start bounce-end) (goto-char (point-min)) (if bounce-indent @@ -4461,15 +4462,30 @@ TEXT and INDENT are not used." (setq rmail-remote-password nil) (setq rmail-encoded-remote-password nil))) -(defun rmail-get-remote-password (imap) - "Get the password for retrieving mail from a POP or IMAP server. If none -has been set, then prompt the user for one." +(defun rmail-get-remote-password (imap user host) + "Get the password for retrieving mail from a POP or IMAP server. +If none has been set, the password is found via auth-source. If +you use ~/.authinfo as your auth-source backend, then put +something like the following in that file: + +machine mymachine login myloginname password mypassword + +If auth-source search yields no result, prompt the user for the +password." (when (not rmail-encoded-remote-password) (if (not rmail-remote-password) - (setq rmail-remote-password - (read-passwd (if imap - "IMAP password: " - "POP password: ")))) + (setq rmail-remote-password + (let ((found (nth 0 (auth-source-search + :max 1 :user user :host host + :require '(:secret))))) + (if found + (let ((secret (plist-get found :secret))) + (if (functionp secret) + (funcall secret) + secret)) + (read-passwd (if imap + "IMAP password: " + "POP password: ")))))) (rmail-set-remote-password rmail-remote-password) (setq rmail-remote-password nil)) (rmail-encode-string rmail-encoded-remote-password (emacs-pid))) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index cc55451902a..521659b7eb6 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -931,8 +931,8 @@ a negative argument means to delete and move backward." (not (and backward (bobp)))) (rmail-summary-goto-msg) (with-current-buffer rmail-buffer - (rmail-delete-message) - (setq del-msg rmail-current-message)) + (setq del-msg rmail-current-message) + (rmail-delete-message)) (rmail-summary-mark-deleted del-msg) (while (and (not (if backward (bobp) (eobp))) (save-excursion (beginning-of-line) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index dd6eecbfd09..7610939e575 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -975,7 +975,7 @@ but lower priority than the local value of `buffer-file-coding-system'. See also the function `select-message-coding-system'.") ;;;###autoload -(defvar default-sendmail-coding-system 'iso-latin-1 +(defvar default-sendmail-coding-system 'utf-8 "Default coding system for encoding the outgoing mail. This variable is used only when `sendmail-coding-system' is nil. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 1786608dd67..63c8f14085a 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -50,7 +50,7 @@ ;; Modified by Simon Josefsson <jas@pdc.kth.se>, 22/2/99, to support SMTP ;; Authentication by the AUTH mechanism. -;; See http://www.ietf.org/rfc/rfc2554.txt +;; See https://www.ietf.org/rfc/rfc2554.txt ;;; Code: ;;; Dependencies diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index 945bff35f79..bcbd571b539 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -24,11 +24,6 @@ ;;; Code: -(defalias 'uudecode-char-int - (if (fboundp 'char-int) - 'char-int - 'identity)) - (defgroup uudecode nil "Decoding of uuencoded data." :group 'mail @@ -140,7 +135,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." ((> (skip-chars-forward uudecode-alphabet end) 0) (setq lim (point)) (setq remain - (logand (- (uudecode-char-int (char-after inputpos)) 32) + (logand (- (char-after inputpos) 32) 63)) (setq inputpos (1+ inputpos)) (if (= remain 0) (setq done t)) @@ -148,7 +143,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (setq bits (+ bits (logand (- - (uudecode-char-int (char-after inputpos)) 32) + (char-after inputpos) 32) 63))) (if (/= counter 0) (setq remain (1- remain))) (setq counter (1+ counter) @@ -201,6 +196,8 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (uudecode-decode-region-external start end file-name) (uudecode-decode-region-internal start end file-name))) +(define-obsolete-function-alias 'uudecode-char-int #'identity "28.1") + (provide 'uudecode) ;;; uudecode.el ends here diff --git a/lisp/man.el b/lisp/man.el index 64272415411..bd55d7eff06 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -927,15 +927,18 @@ foo(sec)[, bar(sec) [, ...]] [other stuff] - description" ;; run differently in Man-getpage-in-background, an error ;; here may not necessarily mean that we'll also get an ;; error later. - (ignore-errors - (call-process manual-program nil '(t nil) nil - "-k" (concat (when (or Man-man-k-use-anchor - (string-equal prefix "")) - "^") - prefix)))) - (setq table (Man-parse-man-k))) + (when (eq 0 + (ignore-errors + (call-process + manual-program nil '(t nil) nil + "-k" (concat (when (or Man-man-k-use-anchor + (string-equal prefix "")) + "^") + prefix)))) + (setq table (Man-parse-man-k))))) ;; Cache the table for later reuse. - (setq Man-completion-cache (cons prefix table))) + (when table + (setq Man-completion-cache (cons prefix table)))) ;; The table may contain false positives since the match is made ;; by "man -k" not just on the manpage's name. (if section @@ -1508,8 +1511,11 @@ manpage command." (when delete-buff (if (window-live-p (get-buffer-window Man-buffer t)) - (quit-restore-window - (get-buffer-window Man-buffer t) 'kill) + (progn + (quit-restore-window + (get-buffer-window Man-buffer t) 'kill) + ;; Ensure that we end up in the correct window. + (select-window (old-selected-window))) (kill-buffer Man-buffer))) (when message @@ -1541,8 +1547,8 @@ The following man commands are available in the buffer. Try \\[man] Prompt to retrieve a new manpage. \\[Man-follow-manual-reference] Retrieve reference in SEE ALSO section. -\\[Man-next-manpage] Jump to next manpage in circular list. -\\[Man-previous-manpage] Jump to previous manpage in circular list. +\\[Man-next-manpage] Jump to next manpage in circular list. +\\[Man-previous-manpage] Jump to previous manpage in circular list. \\[Man-next-section] Jump to next manpage section. \\[Man-previous-section] Jump to previous manpage section. \\[Man-goto-section] Go to a manpage section. diff --git a/lisp/master.el b/lisp/master.el index 387116a8fbd..32556a535f3 100644 --- a/lisp/master.el +++ b/lisp/master.el @@ -36,12 +36,12 @@ ;; SQL buffer. ;; ;; (add-hook 'sql-mode-hook -;; (function (lambda () -;; (master-mode t) -;; (master-set-slave sql-buffer)))) +;; (lambda () +;; (master-mode t) +;; (master-set-slave sql-buffer))) ;; (add-hook 'sql-set-sqli-hook -;; (function (lambda () -;; (master-set-slave sql-buffer)))) +;; (lambda () +;; (master-set-slave sql-buffer))) ;;; Thanks to all the people who helped me out: ;; diff --git a/lisp/md4.el b/lisp/md4.el index 925686aa756..11c91307afc 100644 --- a/lisp/md4.el +++ b/lisp/md4.el @@ -4,7 +4,7 @@ ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; Keywords: MD4 -;; Version: 1.00 +;; Old-Version: 1.00 ;; Created: February 2001 ;; This file is part of GNU Emacs. @@ -22,6 +22,16 @@ ;; 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: + +;; The MD4 Message-Digest Algorithm. +;; +;; The security of the MD4 hashing algorithm is very poor to +;; non-existent. It was declared obsolete by RFC 6150 in 2011: +;; https://tools.ietf.org/html/rfc6150 +;; +;; You probably want to use `secure-hash' instead. + ;;; Code: ;;; @@ -33,7 +43,12 @@ (defun md4 (in n) "Return the MD4 hash for a string IN of length N bytes. The returned hash is 16 bytes long. N is required to handle -strings containing the character 0." +strings containing the character 0. + +The security of the MD4 hashing algorithm is very poor to +non-existent. It was declared obsolete by RFC 6150 in 2011. + +You probably want to use `secure-hash' instead." (let (m (b (cons 0 (* n 8))) (i 0) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index bc094c9050d..c6ced689a67 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -333,6 +333,8 @@ (bindings--define-key menu [tags-continue] '(menu-item "Continue Tags Search" fileloop-continue + :enable (and (featurep 'fileloop) + (not (eq fileloop--operate-function 'ignore))) :help "Continue last tags search operation")) (bindings--define-key menu [tags-srch] '(menu-item "Search Tagged Files..." tags-search @@ -382,6 +384,8 @@ (let ((menu (make-sparse-keymap "Replace"))) (bindings--define-key menu [tags-repl-continue] '(menu-item "Continue Replace" fileloop-continue + :enable (and (featurep 'fileloop) + (not (eq fileloop--operate-function 'ignore))) :help "Continue last tags replace operation")) (bindings--define-key menu [tags-repl] '(menu-item "Replace in Tagged Files..." tags-query-replace @@ -536,6 +540,12 @@ (if (featurep 'ns) (bindings--define-key menu [separator-undo] menu-bar-separator)) + (bindings--define-key menu [undo-redo] + '(menu-item "Redo" undo-redo + :enable (and (not buffer-read-only) + (undo--last-change-was-undo-p buffer-undo-list)) + :help "Redo last undone edits")) + (bindings--define-key menu [undo] '(menu-item "Undo" undo :enable (and (not buffer-read-only) @@ -543,7 +553,7 @@ (if (eq last-command 'undo) (listp pending-undo-list) (consp buffer-undo-list))) - :help "Undo last operation")) + :help "Undo last edits")) menu)) @@ -657,31 +667,63 @@ PROPS are additional properties." :button (:toggle . (and (default-boundp ',fname) (default-value ',fname))))) -(defmacro menu-bar-make-toggle (name variable doc message help &rest body) +(defmacro menu-bar-make-toggle (command variable item-name message help + &rest body) + "Define a menu-bar toggle command. +See `menu-bar-make-toggle-command', for which this is a +compatibility wrapper. BODY is passed in as SETTING-SEXP in that macro." + (declare (obsolete menu-bar-make-toggle-command "28.1")) + `(menu-bar-make-toggle-command ,command ,variable ,item-name ,message ,help + ,(and body + `(progn + ,@body)))) + +(defmacro menu-bar-make-toggle-command (command variable item-name message + help + &optional setting-sexp + &rest keywords) + "Define a menu-bar toggle command. +COMMAND (a symbol) is the toggle command to define. + +VARIABLE (a symbol) is the variable to set. + +ITEM-NAME (a string) is the menu-item name. + +MESSAGE is a format string for the toggle message, with %s for the new +status. + +HELP (a string) is the `:help' tooltip text and the doc string first +line (minus final period) for the command. + +SETTING-SEXP is a Lisp sexp that sets VARIABLE, or it is nil meaning +set it according to its `defcustom' or using `set-default'. + +KEYWORDS is a plist for `menu-item' for keywords other than `:help'." `(progn - (defun ,name (&optional interactively) + (defun ,command (&optional interactively) ,(concat "Toggle whether to " (downcase (substring help 0 1)) - (substring help 1) ". + (substring help 1) ". In an interactive call, record this option as a candidate for saving by \"Save Options\" in Custom buffers.") (interactive "p") - (if ,(if body `(progn . ,body) - `(progn + (if ,(if setting-sexp + `,setting-sexp + `(progn (custom-load-symbol ',variable) (let ((set (or (get ',variable 'custom-set) 'set-default)) (get (or (get ',variable 'custom-get) 'default-value))) (funcall set ',variable (not (funcall get ',variable)))))) - (message ,message "enabled globally") - (message ,message "disabled globally")) - ;; The function `customize-mark-as-set' must only be called when - ;; a variable is set interactively, as the purpose is to mark it as - ;; a candidate for "Save Options", and we do not want to save options - ;; the user have already set explicitly in his init file. - (if interactively (customize-mark-as-set ',variable))) - '(menu-item ,doc ,name - :help ,help - :button (:toggle . (and (default-boundp ',variable) - (default-value ',variable)))))) + (message ,message "enabled globally") + (message ,message "disabled globally")) + ;; `customize-mark-as-set' must only be called when a variable is set + ;; interactively, because the purpose is to mark the variable as a + ;; candidate for `Save Options', and we do not want to save options that + ;; the user has already set explicitly in the init file. + (when interactively (customize-mark-as-set ',variable))) + '(menu-item ,item-name ,command :help ,help + :button (:toggle . (and (default-boundp ',variable) + (default-value ',variable))) + ,@keywords))) ;; Function for setting/saving default font. @@ -953,10 +995,11 @@ The selected font will be the default on both the existing and future frames." :help "Indicate buffer boundaries in fringe")) (bindings--define-key menu [indicate-empty-lines] - (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines - "Empty Line Indicators" - "Indicating of empty lines %s" - "Indicate trailing empty lines in fringe, globally")) + (menu-bar-make-toggle-command + toggle-indicate-empty-lines indicate-empty-lines + "Empty Line Indicators" + "Indicating of empty lines %s" + "Indicate trailing empty lines in fringe, globally")) (bindings--define-key menu [customize] '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize @@ -1401,7 +1444,7 @@ mail status in mode line")) (bindings--define-key menu [custom-separator] menu-bar-separator) (bindings--define-key menu [case-fold-search] - (menu-bar-make-toggle + (menu-bar-make-toggle-command toggle-case-fold-search case-fold-search "Ignore Case" "Case-Insensitive Search %s" @@ -1432,7 +1475,7 @@ mail status in mode line")) (if (featurep 'system-font-setting) (bindings--define-key menu [menu-system-font] - (menu-bar-make-toggle + (menu-bar-make-toggle-command toggle-use-system-font font-use-system-font "Use System Font" "Use system font: %s" @@ -1458,13 +1501,15 @@ mail status in mode line")) menu-bar-separator) (bindings--define-key menu [debug-on-quit] - (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit - "Enter Debugger on Quit/C-g" "Debug on Quit %s" - "Enter Lisp debugger when C-g is pressed")) + (menu-bar-make-toggle-command + toggle-debug-on-quit debug-on-quit + "Enter Debugger on Quit/C-g" "Debug on Quit %s" + "Enter Lisp debugger when C-g is pressed")) (bindings--define-key menu [debug-on-error] - (menu-bar-make-toggle toggle-debug-on-error debug-on-error - "Enter Debugger on Error" "Debug on Error %s" - "Enter Lisp debugger when an error is signaled")) + (menu-bar-make-toggle-command + toggle-debug-on-error debug-on-error + "Enter Debugger on Error" "Debug on Error %s" + "Enter Lisp debugger when an error is signaled")) (bindings--define-key menu [debugger-separator] menu-bar-separator) @@ -1477,31 +1522,33 @@ mail status in mode line")) menu-bar-separator) (bindings--define-key menu [save-desktop] - (menu-bar-make-toggle + (menu-bar-make-toggle-command toggle-save-desktop-globally desktop-save-mode "Save State between Sessions" "Saving desktop state %s" "Visit desktop of previous session when restarting Emacs" - (require 'desktop) - ;; Do it by name, to avoid a free-variable - ;; warning during byte compilation. - (set-default - 'desktop-save-mode (not (symbol-value 'desktop-save-mode))))) + (progn + (require 'desktop) + ;; Do it by name, to avoid a free-variable + ;; warning during byte compilation. + (set-default + 'desktop-save-mode (not (symbol-value 'desktop-save-mode)))))) (bindings--define-key menu [save-place] - (menu-bar-make-toggle + (menu-bar-make-toggle-command toggle-save-place-globally save-place-mode "Save Place in Files between Sessions" "Saving place in files %s" "Visit files of previous session when restarting Emacs" - (require 'saveplace) - ;; Do it by name, to avoid a free-variable - ;; warning during byte compilation. - (set-default - 'save-place-mode (not (symbol-value 'save-place-mode))))) + (progn + (require 'saveplace) + ;; Do it by name, to avoid a free-variable + ;; warning during byte compilation. + (set-default + 'save-place-mode (not (symbol-value 'save-place-mode)))))) (bindings--define-key menu [uniquify] - (menu-bar-make-toggle + (menu-bar-make-toggle-command toggle-uniquify-buffer-names uniquify-buffer-name-style "Use Directory Names in Buffer Names" "Directory name in buffer names (uniquify) %s" @@ -1515,7 +1562,7 @@ mail status in mode line")) (bindings--define-key menu [cua-mode] (menu-bar-make-mm-toggle cua-mode - "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)" + "Cut/Paste with C-x/C-c/C-v (CUA Mode)" "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste" (:visible (or (not (boundp 'cua-enable-cua-keys)) cua-enable-cua-keys)))) @@ -1523,8 +1570,8 @@ mail status in mode line")) (bindings--define-key menu [cua-emulation-mode] (menu-bar-make-mm-toggle cua-mode - "Shift movement mark region (CUA)" - "Use shifted movement keys to set and extend the region" + "CUA Mode (without C-x/C-c/C-v)" + "Enable CUA Mode without rebinding C-x/C-c/C-v keys" (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) @@ -1834,6 +1881,9 @@ they ran")) (bindings--define-key menu [describe-function] '(menu-item "Describe Function..." describe-function :help "Display documentation of function/command")) + (bindings--define-key menu [shortdoc-display-group] + '(menu-item "Function Group Overview..." shortdoc-display-group + :help "Display a function overview for a specific topic")) (bindings--define-key menu [describe-key-1] '(menu-item "Describe Key or Mouse Operation..." describe-key ;; Users typically don't identify keys and menu items... @@ -2038,6 +2088,8 @@ key, a click, or a menu-item")) (bindings--define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu)) +(define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse) + (defun menu-bar-menu-frame-live-and-visible-p () "Return non-nil if the menu frame is alive and visible. The menu frame is the frame for which we are updating the menu." @@ -2442,7 +2494,7 @@ created in the future." (put 'menu-bar-mode 'standard-value '(t)) (defun toggle-menu-bar-mode-from-frame (&optional arg) - "Toggle menu bar on or off, based on the status of the current frame. + "Toggle display of the menu bar of the current frame. See `menu-bar-mode' for more information." (interactive (list (or current-prefix-arg 'toggle))) (if (eq arg 'toggle) @@ -2613,6 +2665,92 @@ If FRAME is nil or not given, use the selected frame." (global-set-key [f10] 'menu-bar-open) +(defun menu-bar-open-mouse (event) + "Open the menu bar for the menu item clicked on by the mouse. +EVENT should be a mouse down or click event. + +Also see `menu-bar-open', which this calls. +This command is to be used when you click the mouse in the menubar." + (interactive "e") + ;; This only should be bound to clicks on the menu-bar, outside of + ;; any window. + (let ((window (posn-window (event-start event)))) + (when window + (error "Event is inside window %s" window))) + + (let* ((x-position (car (posn-x-y (event-start event)))) + (menu-bar-item-cons (menu-bar-item-at-x x-position))) + (menu-bar-open nil + (if menu-bar-item-cons + (cdr menu-bar-item-cons) + 0)))) + +(defun menu-bar-keymap () + "Return the current menu-bar keymap. + +The ordering of the return value respects `menu-bar-final-items'." + (let ((menu-bar '()) + (menu-end '())) + (map-keymap + (lambda (key binding) + (let ((pos (seq-position menu-bar-final-items key)) + (menu-item (cons key binding))) + (if pos + ;; If KEY is the name of an item that we want to put + ;; last, store it separately with explicit ordering for + ;; sorting. + (push (cons pos menu-item) menu-end) + (push menu-item menu-bar)))) + (lookup-key (menu-bar-current-active-maps) [menu-bar])) + `(keymap ,@(nreverse menu-bar) + ,@(mapcar #'cdr (sort menu-end + (lambda (a b) + (< (car a) (car b)))))))) + +(defun menu-bar-current-active-maps () + "Return the current active maps in the order the menu bar displays them. +This value does not take into account `menu-bar-final-items' as that applies +per-item." + ;; current-active-maps returns maps in the order local then + ;; global. The menu bar displays items in the opposite order. + (cons 'keymap (nreverse (current-active-maps)))) + +(defun menu-bar-item-at-x (x-position) + "Return a cons of the form (KEY . X) for a menu item. +The returned X is the left X coordinate for that menu item. + +X-POSITION is the X coordinate being queried. If nothing is clicked on, +returns nil." + (let ((column 0) + (menu-bar (menu-bar-keymap)) + prev-key + prev-column + found) + (catch 'done + (map-keymap + (lambda (key binding) + (when (> column x-position) + (setq found t) + (throw 'done nil)) + (setq prev-key key) + (pcase binding + ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item. + `(menu-item ,name ,_cmd ;Extended menu item. + . ,(and props + (guard (let ((visible + (plist-get props :visible))) + (or (null visible) + (eval visible))))))) + (setq prev-column column + column (+ column (length name) 1))))) + menu-bar) + ;; Check the last menu item. + (when (> column x-position) + (setq found t))) + (if found + (cons prev-key prev-column) + nil))) + (defun buffer-menu-open () "Start key navigation of the buffer menu. This is the keyboard interface to \\[mouse-buffer-menu]." @@ -2632,6 +2770,16 @@ This is the keyboard interface to \\[mouse-buffer-menu]." (menu-bar-buffer-vector item))))) km)) +(defun menu-bar-define-mouse-key (map key def) + "Like `define-key', but adds all possible prefixes for the mouse." + (define-key map (vector key) def) + (mapc (lambda (prefix) (define-key map (vector prefix key) def)) + ;; This list only needs to contain special window areas that + ;; are rendered in TTYs. No need for *-scroll-bar, *-fringe, + ;; or *-divider. + '(tab-line header-line menu-bar tab-bar mode-line vertical-line + left-margin right-margin))) + (defvar tty-menu-navigation-map (let ((map (make-sparse-keymap))) ;; The next line is disabled because it breaks interpretation of @@ -2666,39 +2814,33 @@ This is the keyboard interface to \\[mouse-buffer-menu]." (define-key map [?\C-j] 'tty-menu-select) (define-key map [return] 'tty-menu-select) (define-key map [linefeed] 'tty-menu-select) - (define-key map [mouse-1] 'tty-menu-select) - (define-key map [drag-mouse-1] 'tty-menu-select) - (define-key map [mouse-2] 'tty-menu-select) - (define-key map [drag-mouse-2] 'tty-menu-select) - (define-key map [mouse-3] 'tty-menu-select) - (define-key map [drag-mouse-3] 'tty-menu-select) - (define-key map [wheel-down] 'tty-menu-next-item) - (define-key map [wheel-up] 'tty-menu-prev-item) - (define-key map [wheel-left] 'tty-menu-prev-menu) - (define-key map [wheel-right] 'tty-menu-next-menu) - ;; The following 4 bindings are for those whose text-mode mouse + (menu-bar-define-mouse-key map 'mouse-1 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-1 'tty-menu-select) + (menu-bar-define-mouse-key map 'mouse-2 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-2 'tty-menu-select) + (menu-bar-define-mouse-key map 'mouse-3 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-3 'tty-menu-select) + (menu-bar-define-mouse-key map 'wheel-down 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'wheel-up 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'wheel-left 'tty-menu-prev-menu) + (menu-bar-define-mouse-key map 'wheel-right 'tty-menu-next-menu) + ;; The following 6 bindings are for those whose text-mode mouse ;; lack the wheel. - (define-key map [S-mouse-1] 'tty-menu-next-item) - (define-key map [S-drag-mouse-1] 'tty-menu-next-item) - (define-key map [S-mouse-2] 'tty-menu-prev-item) - (define-key map [S-drag-mouse-2] 'tty-menu-prev-item) - (define-key map [S-mouse-3] 'tty-menu-prev-item) - (define-key map [S-drag-mouse-3] 'tty-menu-prev-item) - (define-key map [header-line mouse-1] 'tty-menu-select) - (define-key map [header-line drag-mouse-1] 'tty-menu-select) + (menu-bar-define-mouse-key map 'S-mouse-1 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-1 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'S-mouse-2 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-2 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-mouse-3 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-3 'tty-menu-prev-item) ;; The down-mouse events must be bound to tty-menu-ignore, so that ;; only releasing the mouse button pops up the menu. - (define-key map [mode-line down-mouse-1] 'tty-menu-ignore) - (define-key map [mode-line down-mouse-2] 'tty-menu-ignore) - (define-key map [mode-line down-mouse-3] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-1] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-2] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-3] 'tty-menu-ignore) - (define-key map [down-mouse-1] 'tty-menu-ignore) - (define-key map [C-down-mouse-1] 'tty-menu-ignore) - (define-key map [C-down-mouse-2] 'tty-menu-ignore) - (define-key map [C-down-mouse-3] 'tty-menu-ignore) - (define-key map [mouse-movement] 'tty-menu-mouse-movement) + (menu-bar-define-mouse-key map 'down-mouse-1 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'down-mouse-2 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'down-mouse-3 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-1 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-2 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-3 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'mouse-movement 'tty-menu-mouse-movement) map) "Keymap used while processing TTY menus.") diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index dad3d1ec560..d30441f91a8 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -324,7 +324,7 @@ * mh-customize.el (mh-show-pgg-good-face) (mh-show-pgg-unknown-face, mh-show-pgg-bad-face): Faces added to - highlight buttons introduced for encrpted or signed MIME parts. + highlight buttons introduced for encrypted or signed MIME parts. 2005-03-19 Bill Wohler <wohler@newt.com> @@ -428,7 +428,7 @@ 2004-11-28 Jeffrey C Honig <jch@honig.net> * mh-comp.el (mh-complete-word): Kill the *Completions* buffer in - any cases where we belive we are done with it. Not perfect, but + any cases where we believe we are done with it. Not perfect, but better than just leaving it around. 2004-11-08 Satyaki Das <satyaki@theforce.stanford.edu> @@ -818,7 +818,7 @@ * Makefile: (mh-e-autoloads.el): Add target to make `mh-e-autoloads.el', a - file containg usual entry commands into MH-E to be used for users + file containing usual entry commands into MH-E to be used for users installing MH-E separately from Emacs. (XEMACS_LOADDEFS_FILE): New. Used to generate mh-loaddefs.el in XEmacs. @@ -1201,7 +1201,7 @@ 2003-11-01 Peter S Galbraith <psg@debian.org> - * Makefile: Add target to make `mh-startup.el', a file containg + * Makefile: Add target to make `mh-startup.el', a file containing usual entry commands into MH-E to be used for users installing MH-E separately from Emacs. @@ -1914,7 +1914,7 @@ 2003-08-18 Peter S Galbraith <psg@debian.org> * mh-comp.el (mh-letter-mode): Call `mh-find-path unconditionally, - like elsewehere in MH-E. + like elsewhere in MH-E. * mh-utils.el (mh-find-path): Run setup code only if `mh-find-path-run' is nil such that this is only done once. @@ -2588,7 +2588,7 @@ 2003-07-24 Satyaki Das <satyakid@stanford.edu> * mh-e.el (mh-folder-message-menu, mh-folder-folder-menu): Use the - predicate mh-outstanding-commands-p instead of its exapansion. + predicate mh-outstanding-commands-p instead of its expansion. Also use the same label in both menus. (mh-outstanding-commands-p): Generalized so that it will work in mh-show-mode buffers as well. @@ -3915,7 +3915,7 @@ 2003-04-22 Satyaki Das <satyaki@theforce.stanford.edu> * mh-utils.el (mh-normalize-folder-name): Make the completion - code work properly with XEmacs. This change is neeeded since + code work properly with XEmacs. This change is needed since split-string behaves differently in XEmacs than it does in GNU Emacs. (mh-exec-cmd-error): Add a comment, so that we change it later on. @@ -7391,7 +7391,7 @@ numbers. (mh-cmd-note): Mention mh-set-cmd-note in docstring. Also suggest that it is updated dynamically only if mh-scan-format-file is t. - (mh-set-cmd-note): Grammer fix in docstring. + (mh-set-cmd-note): Grammar fix in docstring. (mh-cmd-note): Noted that the first column is column number 0. * mh-e.el (mh-scan-format-file): Added information about @@ -7696,7 +7696,7 @@ * mh-identity.el: New file. Multiple Identify support for MH-E. Used to easily set different fields such as From and Organization, - as well as diffrent signature files. This file won't be included + as well as different signature files. This file won't be included with V7.0. 2002-11-02 Bill Wohler <wohler@newt.com> @@ -9458,10 +9458,10 @@ 2002-07-15 Mark D. Baushke <mdb@gnu.org> - * mh-utils.el (mm-decode): Use load for the Non-fatal depencency + * mh-utils.el (mm-decode): Use load for the Non-fatal dependency on the mm-decode library. * mh-mime.el (mm-decode, mm-uu, mm-view): Use load for the - Non-fatal depencencies on the mm-decode, mm-uu and mm-view + Non-fatal dependencies on the mm-decode, mm-uu and mm-view libraries. 2002-07-15 Satyaki Das <satyaki@theforce.stanford.edu> @@ -11356,7 +11356,7 @@ 4 was silly for my case. * mh-e.el (mh-update-sequences): Check for nil value of mh-current-folder, which happens if mh-summary-height < 4 - although I haven't tracked doen why that happens. + although I haven't tracked down why that happens. 2001-10-22 Peter S Galbraith <psg@debian.org> diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index f7e30bfbb3d..8a69adbb756 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -305,6 +305,7 @@ message and scan line." (let ((draft-buffer (current-buffer)) (file-name buffer-file-name) (config mh-previous-window-config) + ;; FIXME this is subtly different to select-message-coding-system. (coding-system-for-write (if (fboundp 'select-message-coding-system) (select-message-coding-system) ; Emacs has this since at least 21.1 @@ -318,7 +319,7 @@ message and scan line." (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) (and (default-boundp 'buffer-file-coding-system) (default-value 'buffer-file-coding-system)) - 'iso-latin-1))))) + 'utf-8))))) ;; Older versions of spost do not support -msgid and -mime. (unless mh-send-uses-spost-flag ;; Adding a Message-ID field looks good, makes it easier to search for diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 92b7d801c7b..c02b095b2ea 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -134,7 +134,7 @@ introduced in Emacs 22." (defmacro mh-face-background (face &optional frame inherit) "Return the background color name of face, or nil if unspecified. -See documentation for `back-foreground' for a description of the +See documentation for `face-background' for a description of the arguments FACE, FRAME, and INHERIT. This macro is used by Emacs versions that lack an INHERIT argument, introduced in Emacs 22." diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index dd05d691c91..3ac5c8f7aed 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -1550,7 +1550,7 @@ as the result is undefined." ,(append '(radio) (mapcar - (function (lambda (arg) `(const ,arg))) + (lambda (arg) `(const ,arg)) (mapcar 'car mh-identity-list)))) (cons :tag "Fcc Field" (const "fcc") @@ -1577,7 +1577,7 @@ See `mh-identity-list'." :type (append '(radio) (cons '(const :tag "None" nil) - (mapcar (function (lambda (arg) `(const ,arg))) + (mapcar (lambda (arg) `(const ,arg)) (mapcar 'car mh-identity-list)))) :group 'mh-identity :package-version '(MH-E . "7.1")) @@ -1914,7 +1914,7 @@ of images into \"X-Face:\" header fields (see URL Use the \"make-face\" script to convert a JPEG image to the higher resolution, color, \"Face:\" header field (see URL -`http://quimby.gnus.org/circus/face/make-face'). +`https://quimby.gnus.org/circus/face/make-face'). The URL of any image can be used for the \"X-Image-URL:\" field and no processing of the image is required. @@ -2420,11 +2420,11 @@ of citations entirely, choose \"None\"." ;; These entries have been intentionally excluded by the developers. ;; "Comments:" ; RFC 822 (or later) - show this one -;; "Fax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ -;; "Mail-System-Version:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ -;; "Mailer:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ +;; "Fax:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ +;; "Mail-System-Version:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ +;; "Mailer:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ ;; "Organization:" ; -;; "Phone:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ +;; "Phone:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ ;; "Reply-By:" ; RFC 2156 ;; "Reply-To:" ; RFC 822 (or later) ;; "Sender:" ; @@ -2437,13 +2437,13 @@ of citations entirely, choose \"None\"." ;; Mention source, if known. (defvar mh-invisible-header-fields-internal '( - "Abuse-Reports-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Abuse-Reports-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Accept-Language:" "AcceptLanguage:" "Accreditor:" ; Habeas "Also-Control:" ; H. Spencer: News Article Format and Transmission, June 1994 "Alternate-recipient:" ; RFC 2156 - "Approved-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Approved-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Approved:" ; RFC 1036 "Article-Names:" ; H. Spencer: News Article Format and Transmission, June 1994 "Article-Updates:" ; H. Spencer: News Article Format and Transmission, June 1994 @@ -2454,7 +2454,7 @@ of citations entirely, choose \"None\"." "Bounces-To:" "Bounces_to:" "Bytes:" - "Cancel-Key:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Cancel-Key:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Cancel-Lock:" ; NNTP posts "Comment:" ; Shows up with DomainKeys "Content-" ; RFC 2045, 1123, 1766, 1864, 2045, 2110, 2156, 2183, 2912 @@ -2475,14 +2475,14 @@ of citations entirely, choose \"None\"." "DomainKey-Signature:" "Encoding:" ; RFC 1505 "Envelope-to:" - "Errors-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Errors-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Expires:" ; RFC 1036 "Expiry-Date:" ; RFC 2156 "Face:" ; Gnus Face header "Followup-To:" ; RFC 1036 - "For-Approval:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "For-Comment:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "For-Handling:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "For-Approval:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "For-Comment:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "For-Handling:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Forwarded:" ; MH "From " ; sendmail "Generate-Delivery-Report:" ; RFC 2156 @@ -2493,12 +2493,12 @@ of citations entirely, choose \"None\"." "Language:" ; RFC 2156 "Lines:" ; RFC 1036 "List-" ; RFC 2369, 2919 - "Mail-Copies-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "Mail-Followup-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Mail-Copies-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Mail-Followup-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Mail-from:" ; MH - "Mail-Reply-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Mail-Reply-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Mailing-List:" ; Egroups/yahoogroups mailing list manager - "Message-Content:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Message-Content:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Message-ID:" ; RFC 822 (or later) "Message-Type:" ; RFC 2156 "Mime-Version" ; RFC 2045 @@ -2516,42 +2516,42 @@ of citations entirely, choose \"None\"." "Original-Recipient:" ; RFC 2298 "Original-To:" ; mail to news "Original-X-" ; mail to news - "Origination-Client:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "Originator:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Origination-Client:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Originator:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "P1-Content-Type:" ; X400 "P1-Message-Id:" ; X400 "P1-Recipient:" ; X400 "Path:" ; RFC 1036 "Pics-Label:" ; W3C - "Posted-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "Precedence:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Posted-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Precedence:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Prev-Resent" ; MH "Prevent-NonDelivery-Report:" ; RFC 2156 "Priority:" ; RFC 2156 - "Read-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Read-Receipt-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Received-SPF:" ; Gmail "Received:" ; RFC 822 (or later) "References:" ; RFC 822 (or later) - "Registered-Mail-Reply-Requested-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Registered-Mail-Reply-Requested-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Remailed-" ; MH - "Replaces:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Replaces:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Replied:" ; MH "Resent-" ; RFC 822 (or later) "Return-Path:" ; RFC 822 (or later) - "Return-Receipt-Requested:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "Return-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Return-Receipt-Requested:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Return-Receipt-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Seal-Send-Time:" "See-Also:" ; H. Spencer: News Article Format and Transmission, June 1994 "Sensitivity:" ; RFC 2156, 2421 - "Speech-Act:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Speech-Act:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Status:" ; sendmail "Supersedes:" ; H. Spencer: News Article Format and Transmission, June 1994 - "Telefax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Telefax:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Thread-" "Thread-Index:" "Thread-Topic:" - "Translated-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "Translation-Of:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Translated-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Translation-Of:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Ua-Content-Id:" ; X400 "Via:" ; MH "X-Abuse-and-DMCA-" @@ -2559,7 +2559,7 @@ of citations entirely, choose \"None\"." "X-Accept-Language:" ; Netscape/Mozilla "X-Ack:" "X-ACL-Warn:" ; http://www.exim.org - "X-Admin:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Admin:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Administrivia-To:" "X-AMAZON" ; Amazon.com "X-AnalysisOut:" ; Exchange @@ -2594,9 +2594,9 @@ of citations entirely, choose \"None\"." "X-CanIt-Geo:" ; IEEE spam filter "X-Cloudmark-SP-" ; Cloudmark (www.cloudmark.com) "X-Comment:" ; AT&T Mailennium - "X-Complaints-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Complaints-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Completed:" - "X-Confirm-Reading-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Confirm-Reading-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Content-Filtered-By:" "X-ContentStamp:" ; NetZero "X-Country-Chain:" ; http://www.declude.com/x-note.htm @@ -2622,13 +2622,13 @@ of citations entirely, choose \"None\"." "X-Email-Type-Id:" ; Paypal http://www.paypal.com "X-Enigmail-Version:" "X-Envelope-Date:" ; GNU mailutils - "X-Envelope-From:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Envelope-From:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Envelope-Sender:" - "X-Envelope-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Envelope-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-EviteMessageId:" ; evite.com "X-Evolution:" ; Evolution mail client "X-ExtLoop" - "X-Face:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Face:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Facebook" ; Facebook "X-FB-SS:" "X-fmx-" @@ -2652,7 +2652,7 @@ of citations entirely, choose \"None\"." "X-Identity:" ; http://www.declude.com/x-note.htm "X-IEEE-UCE-" ; IEEE spam filter "X-Image-URL:" - "X-IMAP:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-IMAP:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Info:" ; NTMail "X-IronPort-" ; IronPort AV "X-ISI-4-30-3-MailScanner:" @@ -2662,12 +2662,12 @@ of citations entirely, choose \"None\"." "X-Juno-" ; Juno "X-Key:" "X-Launchpad-" ; plaunchpad.net - "X-List-Host:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-List-Host:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-List-Subscribe:" ; Unknown mailing list managers "X-List-Unsubscribe:" ; Unknown mailing list managers "X-Listprocessor-" ; ListProc(tm) by CREN - "X-Listserver:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "X-Loop:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Listserver:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Loop:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Lrde-Mailscanner:" "X-Lumos-SenderID:" ; Roving ConstantContact "X-mail_abuse_inquiries:" ; http://www.salesforce.com @@ -2693,18 +2693,18 @@ of citations entirely, choose \"None\"." "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX "X-MHE-Checksum:" ; Checksum added during index search "X-MIME-Autoconverted:" ; sendmail - "X-MIMEOLE:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail + "X-MIMEOLE:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail "X-MIMETrack:" "X-Mms-" ; T-Mobile pictures "X-Mozilla-Status:" ; Netscape/Mozilla "X-MS-" ; MS Outlook "X-Msmail-" ; MS Outlook - "X-MSMail-Priority" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-MSMail-Priority" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-MXL-Hash:" "X-NAI-Spam-" ; Network Associates Inc. SpamKiller "X-News:" ; News - "X-Newsreader:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "X-No-Archive:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Newsreader:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-No-Archive:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Notes-Item:" ; Lotus Notes Domino structured header "X-Notification-" ; Google+ "X-Notifications:" ; Google+ @@ -2713,7 +2713,7 @@ of citations entirely, choose \"None\"." "X-ORBL:" "X-Orcl-Content-Type:" "X-Organization:" - "X-Original-Arrival-Type:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Original-Arrival-Type:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Original-Complaints-To:" "X-Original-Date:" ; SourceForge mailing list manager "X-Original-To:" @@ -2733,10 +2733,10 @@ of citations entirely, choose \"None\"." "X-Provags-ID:" "X-PSTN-" "X-Qotd-" ; User added - "X-RCPT-TO:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-RCPT-TO:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Received-Date:" "X-Received:" - "X-Report-Abuse-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Report-Abuse-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Request-" "X-Resolved-to:" ; fastmail.fm "X-Return-Path-Hint:" ; Roving ConstantContact @@ -2753,7 +2753,7 @@ of citations entirely, choose \"None\"." "X-SBRule:" ; Spam "X-Scanned-By:" "X-Sender-ID:" ; Google+ - "X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Sendergroup:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com) "X-Server-Date:" "X-Server-Uuid:" @@ -2776,11 +2776,11 @@ of citations entirely, choose \"None\"." "X-TM-IMSS-Message-ID:" ; http://www.trendmicro.com "X-Trace:" "X-UID" - "X-UIDL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-UIDL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Unity" "X-UNTD-" ; NetZero - "X-URI:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "X-URL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-URI:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-URL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-USANET-" ; usa.net "X-Usenet-Provider" "X-UserInfo1:" @@ -2792,7 +2792,7 @@ of citations entirely, choose \"None\"." "X-VSMLoop:" ; NTMail "X-WebTV-Signature:" "X-Wss-Id:" ; Worldtalk gateways - "X-X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-XPT-XSL-Name:" ; Paypal http://www.paypal.com "X-xsi-" "X-XWALL-" ; http://www.dataenter.co.at/doc/xwall_undocumented_config.htm @@ -3036,7 +3036,7 @@ supports it. The first header field used, if present, is the Gnus-specific \"Face:\" field. The \"Face:\" field appeared in GNU Emacs 21 and XEmacs. For more information, see URL -`http://quimby.gnus.org/circus/face/'. Next is the traditional +`https://quimby.gnus.org/circus/face/'. Next is the traditional \"X-Face:\" header field. The display of this field requires the \"uncompface\" program (see URL `ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent @@ -3049,7 +3049,7 @@ header field if neither the \"Face:\" nor the \"X-Face:\" fields are present. The display of the images requires \"wget\" (see URL `https://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\" to fetch the image and the \"convert\" program from the ImageMagick -suite (see URL `http://www.imagemagick.org/'). Of the three header +suite (see URL `https://www.imagemagick.org/'). Of the three header fields this is the most efficient in terms of network usage since the image doesn't need to be transmitted with every single mail. diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index eea04c63783..ebc5038a194 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -58,7 +58,7 @@ program, see: (defun mh-blacklist-a-msg (message) "Blacklist MESSAGE. If MESSAGE is nil then the message at point is blacklisted. -The hook `mh-blacklisted-msg-hook' is called after you mark a message +The hook `mh-blacklist-msg-hook' is called after you mark a message for blacklisting." (save-excursion (if (numberp message) diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el index a3fbb89bb88..d4577807c92 100644 --- a/lisp/mh-e/mh-limit.el +++ b/lisp/mh-e/mh-limit.el @@ -148,7 +148,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." "Put all following messages with same subject in sequence 'subject. If arg ALL is t, move to beginning of folder buffer to collect all messages. -If arg ALL is nil, collect only messages fron current one on forward. +If arg ALL is nil, collect only messages from current one on forward. Return number of messages put in the sequence: @@ -198,7 +198,7 @@ It would be desirable to avoid hard-coding this.") This function only works with an unthreaded folder. If arg ALL is t, move to beginning of folder buffer to collect all messages. If -arg ALL is nil, collect only messages fron current one on +arg ALL is nil, collect only messages from current one on forward. Return number of messages put in the sequence: diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 3c07d426b7d..7536f949e76 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -219,8 +219,7 @@ Sets the current buffer to the show buffer." (erase-buffer) ;; Changing contents, so this hook needs to be reinitialized. ;; pgp.el uses this. - (if (boundp 'write-contents-hooks) ;Emacs 19 - (kill-local-variable 'write-contents-hooks)) + (kill-local-variable 'write-contents-functions) (font-lock-mode -1) (mh-show-mode) (if formfile diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 7e0981bed3a..0732a16dc7d 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -307,7 +307,7 @@ The function will expand out parent folders of FOLDER if needed." (mh-speed-toggle)) (goto-char (gethash prefix mh-speed-folder-map)))) (while suffix-list - ;; We always need atleast one toggle. We need two if the directory list + ;; We always need at least one toggle. We need two if the directory list ;; is stale since a folder was added. (when (equal prefix (get-text-property (mh-line-beginning-position) 'mh-folder)) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index fc30187245d..e6ee87b8411 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -26,10 +26,10 @@ ;; The threading portion of this files tries to implement the ;; algorithm described at: -;; http://www.jwz.org/doc/threading.html +;; https://www.jwz.org/doc/threading.html ;; It also begins to implement the threading section of the IMAP - ;; SORT and THREAD Extensions RFC at: -;; http://tools.ietf.org/html/rfc5256 +;; https://tools.ietf.org/html/rfc5256 ;; The implementation lacks the reference and subject canonicalization ;; of the RFC. diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index a32d21abb30..363899d2656 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -44,12 +44,12 @@ (concat (regexp-quote (substring minibuffer-default-prompt-format 0 (match-beginning 0))) - ".*" + "\\(.*?\\)" (regexp-quote (substring minibuffer-default-prompt-format (match-end 0)))) (regexp-quote minibuffer-default-prompt-format)) - ": *\\)") - 1) + "\\): ") + 1 (and minibuffer-eldef-shorten-default " [\\2]")) `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'" 1 ,(if minibuffer-eldef-shorten-default " [\\2]")) ("([^(]+?\\(, default\\(?: is\\)? \\(.*\\)\\)):? \\'" 1) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 864726e3cc0..5a41e2f30bd 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -776,44 +776,50 @@ The text is displayed for `minibuffer-message-clear-timeout' seconds whichever comes first. Unlike `minibuffer-message', this function is called automatically via `set-message-function'." - (when (and (not noninteractive) - (window-live-p (active-minibuffer-window))) - (with-current-buffer (window-buffer (active-minibuffer-window)) - (setq message (if (string-match-p "\\` *\\[.+\\]\\'" message) - ;; Make sure we can put-text-property. - (copy-sequence message) - (concat " [" message "]"))) - (unless (or (null minibuffer-message-properties) - ;; Don't overwrite the face properties the caller has set - (text-properties-at 0 message)) - (setq message (apply #'propertize message minibuffer-message-properties))) - - (clear-minibuffer-message) - - (let ((ovpos (minibuffer--message-overlay-pos))) - (setq minibuffer-message-overlay - (make-overlay ovpos ovpos nil t t))) - (unless (zerop (length message)) - ;; The current C cursor code doesn't know to use the overlay's - ;; marker's stickiness to figure out whether to place the cursor - ;; before or after the string, so let's spoon-feed it the pos. - (put-text-property 0 1 'cursor 1 message)) - (overlay-put minibuffer-message-overlay 'after-string message) - ;; Make sure the overlay with the message is displayed before - ;; any other overlays in that position, in case they have - ;; resize-mini-windows set to nil and the other overlay strings - ;; are too long for the mini-window width. This makes sure the - ;; temporary message will always be visible. - (overlay-put minibuffer-message-overlay 'priority 1100) - - (when (numberp minibuffer-message-clear-timeout) - (setq minibuffer-message-timer - (run-with-timer minibuffer-message-clear-timeout nil - #'clear-minibuffer-message))) - - ;; Return `t' telling the caller that the message - ;; was handled specially by this function. - t))) + (let* ((minibuf-window (active-minibuffer-window)) + (minibuf-frame (and (window-live-p minibuf-window) + (window-frame minibuf-window)))) + (when (and (not noninteractive) + (window-live-p minibuf-window) + (or (eq (window-frame) minibuf-frame) + (eq (frame-parameter minibuf-frame 'minibuffer) 'only))) + (with-current-buffer (window-buffer minibuf-window) + (setq message (if (string-match-p "\\` *\\[.+\\]\\'" message) + ;; Make sure we can put-text-property. + (copy-sequence message) + (concat " [" message "]"))) + (unless (or (null minibuffer-message-properties) + ;; Don't overwrite the face properties the caller has set + (text-properties-at 0 message)) + (setq message + (apply #'propertize message minibuffer-message-properties))) + + (clear-minibuffer-message) + + (let ((ovpos (minibuffer--message-overlay-pos))) + (setq minibuffer-message-overlay + (make-overlay ovpos ovpos nil t t))) + (unless (zerop (length message)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (put-text-property 0 1 'cursor 1 message)) + (overlay-put minibuffer-message-overlay 'after-string message) + ;; Make sure the overlay with the message is displayed before + ;; any other overlays in that position, in case they have + ;; resize-mini-windows set to nil and the other overlay strings + ;; are too long for the mini-window width. This makes sure the + ;; temporary message will always be visible. + (overlay-put minibuffer-message-overlay 'priority 1100) + + (when (numberp minibuffer-message-clear-timeout) + (setq minibuffer-message-timer + (run-with-timer minibuffer-message-clear-timeout nil + #'clear-minibuffer-message))) + + ;; Return `t' telling the caller that the message + ;; was handled specially by this function. + t)))) (setq set-message-function 'set-minibuffer-message) @@ -1065,10 +1071,16 @@ in the last `cdr'." (defun completion--replace (beg end newtext) "Replace the buffer text between BEG and END with NEWTEXT. Moves point to the end of the new text." - ;; The properties on `newtext' include things like - ;; completions-first-difference, which we don't want to include - ;; upon insertion. - (set-text-properties 0 (length newtext) nil newtext) + ;; The properties on `newtext' include things like the + ;; `completions-first-difference' face, which we don't want to + ;; include upon insertion. + (if minibuffer-allow-text-properties + ;; If we're preserving properties, then just remove the faces + ;; and other properties added by the completion machinery. + (remove-text-properties 0 (length newtext) '(face completion-score) + newtext) + ;; Remove all text properties. + (set-text-properties 0 (length newtext) nil newtext)) ;; Maybe this should be in subr.el. ;; You'd think this is trivial to do, but details matter if you want ;; to keep markers "at the right place" and be robust in the face of @@ -1119,7 +1131,6 @@ completion candidates than this number." (defvar-local completion-all-sorted-completions nil) (defvar-local completion--all-sorted-completions-location nil) (defvar completion-cycling nil) ;Function that takes down the cycling map. -(defvar completion-content-when-empty nil) (defvar completion-fail-discreetly nil "If non-nil, stay quiet when there is no match.") @@ -1504,13 +1515,8 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', COMPLETION-FUNCTION is called if the current buffer's content does not appear to be a match." (cond - ;; Allow user to specify null string. In the case that - ;; `completion-content-when-empty' is set, use that instead. - ((= beg end) - (when completion-content-when-empty - (completion--replace beg end completion-content-when-empty)) - (funcall exit-function)) - + ;; Allow user to specify null string + ((= beg end) (funcall exit-function)) ((test-completion (buffer-substring beg end) minibuffer-completion-table minibuffer-completion-predicate) @@ -3110,12 +3116,12 @@ or a symbol, see `completion-pcm--merge-completions'." (while p (pcase p (`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest))) - ;; This is not just a performance improvement: it also turns - ;; a terminating `point' into an implicit `any', which - ;; affects the final position of point (because `point' gets - ;; turned into a non-greedy ".*?" regexp whereas we need - ;; it the be greedy when it's at the end, see bug#38458). - (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'. + ;; This is not just a performance improvement: it turns a + ;; terminating `point' into an implicit `any', which affects + ;; the final position of point (because `point' gets turned + ;; into a non-greedy ".*?" regexp whereas we need it to be + ;; greedy when it's at the end, see bug#38458). + (`(point) (setq p nil)) ;Implicit terminating `any'. (_ (push (pop p) n)))) (nreverse n))) @@ -3865,6 +3871,9 @@ FORMAT-ARGS is non-nil, PROMPT is used as a format control string, and FORMAT-ARGS are the arguments to be substituted into it. See `format' for details. +If DEFAULT is a list, the first element is used as the default. +If not, the element is used as is. + If DEFAULT is nil, no \"default value\" string is included in the return value." (concat @@ -3872,7 +3881,10 @@ return value." prompt (apply #'format prompt format-args)) (and default - (format minibuffer-default-prompt-format default)) + (format minibuffer-default-prompt-format + (if (consp default) + (car default) + default))) ": ")) (provide 'minibuffer) diff --git a/lisp/misc.el b/lisp/misc.el index 8c39492784b..03395781a51 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -69,7 +69,9 @@ The characters copied are inserted in the buffer before point." Case is ignored if `case-fold-search' is non-nil in the current buffer. Goes backward if ARG is negative; error if CHAR not found. Ignores CHAR at point." - (interactive "p\ncZap up to char: ") + (interactive (list (prefix-numeric-value current-prefix-arg) + (read-char-from-minibuffer "Zap up to char: " + nil 'read-char-history))) (let ((direction (if (>= arg 0) 1 -1))) (kill-region (point) (progn @@ -125,7 +127,7 @@ upper atmosphere. These cause momentary pockets of higher-pressure air to form, which act as lenses that deflect incoming cosmic rays, focusing them to strike the drive platter and flip the desired bit. You can type `M-x butterfly C-M-c' to run it. This is a permuted -variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." +variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'." (interactive) (if (yes-or-no-p "Do you really want to unleash the powers of the butterfly? ") (progn @@ -137,7 +139,7 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." (sit-for (* 5 (/ (abs (random)) (float most-positive-fixnum)))) (message "Successfully flipped one bit!")) (message "Well, then go to xkcd.com!") - (browse-url "http://xkcd.com/378/"))) + (browse-url "https://xkcd.com/378/"))) ;; A command to list dynamically loaded libraries. This useful in ;; environments where dynamic-library-alist is used, i.e., Windows diff --git a/lisp/misearch.el b/lisp/misearch.el index 958c10a1bf6..6ec10fe2c2e 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -236,11 +236,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'." (buf nil) (ido-ignore-item-temp-list bufs)) (while (not (string-equal - (setq buf (read-buffer - (if (eq read-buffer-function #'ido-read-buffer) - "Next buffer to search (C-j to end): " - "Next buffer to search (RET to end): ") - nil t)) + (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) (add-to-list 'bufs buf) (setq ido-ignore-item-temp-list bufs)) diff --git a/lisp/mouse.el b/lisp/mouse.el index 06fdca12b9c..9d4492f1bde 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2206,8 +2206,8 @@ and selects that window." ;; Sort the list to put the most popular major modes first. (setq split-by-major-mode (sort split-by-major-mode - (function (lambda (elt1 elt2) - (> (length elt1) (length elt2)))))) + (lambda (elt1 elt2) + (> (length elt1) (length elt2))))) ;; Make a separate submenu for each major mode ;; that has more than one buffer, ;; unless all the remaining buffers are less than 1/10 of them. @@ -2248,8 +2248,8 @@ and selects that window." head) (setq buffers (sort buffers - (function (lambda (elt1 elt2) - (string< (buffer-name elt1) (buffer-name elt2)))))) + (lambda (elt1 elt2) + (string< (buffer-name elt1) (buffer-name elt2))))) (setq tail buffers) (while tail (or (eq ?\s (aref (buffer-name (car tail)) 0)) @@ -2622,7 +2622,7 @@ is copied instead of being cut." ;; this for all windows on all visible frames. In addition we save ;; also the cursor type for the window's buffer so we can restore it ;; in case we modified it. - ;; https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00090.html + ;; https://lists.gnu.org/r/emacs-devel/2017-12/msg00090.html (walk-window-tree (lambda (window) (setq states diff --git a/lisp/mpc.el b/lisp/mpc.el index 47fe4dea7fa..fade23e3cc2 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -819,8 +819,8 @@ The songs are returned as alists." (defun mpc-cmd-status () (mpc-proc-cmd-to-alist "status")) -(defun mpc-cmd-play () - (mpc-proc-cmd "play") +(defun mpc-cmd-play (&optional sn) + (mpc-proc-cmd (if sn (list "play" sn) "play")) (mpc-status-refresh)) (defun mpc-cmd-seekcur (time) @@ -849,7 +849,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." ;; Sort them from last to first, so the renumbering ;; caused by the earlier deletions don't affect ;; later ones. - (sort song-poss '>)))) + (sort (copy-sequence song-poss) '>)))) (if (stringp playlist) (puthash (cons 'Playlist playlist) nil mpc--find-memoize))) @@ -873,7 +873,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." ;; Sort them from last to first, so the renumbering ;; caused by the earlier deletions affect ;; later ones a bit less. - (sort song-poss '>)))) + (sort (copy-sequence song-poss) '>)))) (if (stringp playlist) (puthash (cons 'Playlist playlist) nil mpc--find-memoize)))) @@ -2089,7 +2089,7 @@ This is used so that they can be compared with `eq', which is needed for ((null (with-current-buffer plbuf (re-search-forward re nil t))) ;; song-file only appears once in the playlist: no ambiguity, ;; we're good to go! - (mpc-proc-cmd (list "play" sn))) + (mpc-cmd-play sn)) (t ;; The song appears multiple times in the playlist. If the current ;; buffer holds not only the destination song but also the current @@ -2391,6 +2391,7 @@ This is used so that they can be compared with `eq', which is needed for (interactive) (mpc-cmd-stop) (mpc-cmd-clear) + (mpc-songs-refresh) (mpc-status-refresh)) (defun mpc-pause () @@ -2750,7 +2751,9 @@ If stopped, start playback." (if current-prefix-arg ;; FIXME: We should provide some completion here, especially for the ;; case where the user specifies a local socket/file name. - (setq mpc-host (read-string "MPD host and port: " nil nil mpc-host))) + (setq mpc-host (read-string + (format-prompt "MPD host and port" mpc-host) + nil nil mpc-host))) nil)) (let* ((song-buf (mpc-songs-buf)) (song-win (get-buffer-window song-buf 0))) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 3b93bd1d5e4..c6a7391df1a 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -85,7 +85,7 @@ set to the event sent when clicking on the mouse wheel button." :type 'number) (defcustom mouse-wheel-scroll-amount - '(5 ((shift) . 1) ((meta) . nil) ((control) . text-scale)) + '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale)) "Amount to scroll windows by when spinning the mouse wheel. This is an alist mapping the modifier key to the amount to scroll when the wheel is moved with the modifier key depressed. @@ -97,6 +97,9 @@ screen. It can also be a floating point number, specifying the fraction of a full screen to scroll. A near full screen is `next-screen-context-lines' less than a full screen. +If AMOUNT is the symbol 'hscroll', this means that with MODIFIER, +the mouse wheel will scroll horizontally instead of vertically. + If AMOUNT is the symbol text-scale, this means that with MODIFIER, the mouse wheel will change the face height instead of scrolling." @@ -123,9 +126,10 @@ scrolling." (const :tag "Scroll full screen" :value nil) (integer :tag "Scroll specific # of lines") (float :tag "Scroll fraction of window") + (const :tag "Scroll horizontally" :value hscroll) (const :tag "Change face size" :value text-scale))))) :set 'mouse-wheel-change-button - :version "27.1") + :version "28.1") (defcustom mouse-wheel-progressive-speed t "If non-nil, the faster the user moves the wheel, the faster the scrolling. @@ -203,13 +207,13 @@ Also see `mouse-wheel-tilt-scroll'." (defvar mouse-wheel-left-event (if (or (featurep 'w32-win) (featurep 'ns-win)) 'wheel-left - (intern "mouse-6")) + 'mouse-6) "Event used for scrolling left.") (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win)) 'wheel-right - (intern "mouse-7")) + 'mouse-7) "Event used for scrolling right.") (defun mouse-wheel--get-scroll-window (event) @@ -270,7 +274,11 @@ non-Windows systems." (condition-case nil (unwind-protect (let ((button (mwheel-event-button event))) - (cond ((eq button mouse-wheel-down-event) + (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event)) + (funcall (if mouse-wheel-flip-direction + mwheel-scroll-left-function + mwheel-scroll-right-function) 1)) + ((eq button mouse-wheel-down-event) (condition-case nil (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. @@ -285,7 +293,11 @@ non-Windows systems." ;; for a reason that escapes me. This problem seems ;; to only affect scroll-down. --Stef (set-window-start (selected-window) (point-min)))))) - ((eq button mouse-wheel-up-event) + ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event)) + (funcall (if mouse-wheel-flip-direction + mwheel-scroll-right-function + mwheel-scroll-left-function) 1)) + ((eq button mouse-wheel-up-event) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index e7dad48cf4a..8b245b01066 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -134,6 +134,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: +(require 'url) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Variables @@ -1374,10 +1376,16 @@ Optional argument SAME-WINDOW non-nil means show the URL in the currently selected window instead." (interactive (browse-url-interactive-arg "URL: ")) (require 'url-handlers) - (let ((file-name-handler-alist - (cons (cons url-handler-regexp 'url-file-handler) - file-name-handler-alist))) - (if same-window (find-file url) (find-file-other-window url)))) + (let ((parsed (url-generic-parse-url url)) + (func (if same-window 'find-file 'find-file-other-window))) + (if (and (equal (url-type parsed) "file") + (file-directory-p (url-filename parsed))) + ;; It's a directory; just open it. + (funcall func (url-filename parsed)) + (let ((file-name-handler-alist + (cons (cons url-handler-regexp 'url-file-handler) + file-name-handler-alist))) + (funcall func url))))) (function-put 'browse-url-emacs 'browse-url-browser-kind 'internal) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index ad5ff8d450e..8b40808005b 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -51,10 +51,16 @@ (unless (boundp 'dbus-debug) (defvar dbus-debug nil)) +(require 'cl-lib) +(require 'seq) +(require 'subr-x) (require 'xml) ;;; D-Bus constants. +(defconst dbus-compound-types '(:array :variant :struct :dict-entry) + "D-Bus compound types, represented as list.") + (defconst dbus-service-dbus "org.freedesktop.DBus" "The bus name used to talk to the bus itself.") @@ -139,6 +145,17 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter ;; </signal> ;; </interface> +(defconst dbus-interface-monitoring (concat dbus-interface-dbus ".Monitoring") + "The monitoring interface. +See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor'.") + +;; <interface name="org.freedesktop.DBus.Monitoring"> +;; <method name="BecomeMonitor"> +;; <arg name="rule" type="as" direction="in"/> +;; <arg name="flags" type="u" direction="in"/> ;; Not used, must be 0. +;; </method> +;; </interface> + (defconst dbus-interface-local (concat dbus-interface-dbus ".Local") "An interface whose methods can only be invoked by the local implementation.") @@ -148,28 +165,60 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter ;; </signal> ;; </interface> +(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated") + "An annotation indicating a deprecated interface, method, signal, or property.") + ;;; Default D-Bus errors. +(defgroup dbus nil + "Elisp bindings for D-Bus." + :group 'comm + :link '(custom-manual "(dbus)Top") + :version "28.1") + (defconst dbus-error-dbus "org.freedesktop.DBus.Error" "The namespace for default error names. See /usr/include/dbus-1.0/dbus/dbus-protocol.h.") -(defconst dbus-error-failed (concat dbus-error-dbus ".Failed") - "A generic error; \"something went wrong\" - see the error message for more.") - (defconst dbus-error-access-denied (concat dbus-error-dbus ".AccessDenied") "Security restrictions don't allow doing what you're trying to do.") +(defconst dbus-error-disconnected (concat dbus-error-dbus ".Disconnected") + "The connection is disconnected and you're trying to use it.") + +(defconst dbus-error-failed (concat dbus-error-dbus ".Failed") + "A generic error; \"something went wrong\" - see the error message for more.") + (defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs") "Invalid arguments passed to a method call.") +(defconst dbus-error-no-reply (concat dbus-error-dbus ".NoReply") + "No reply to a message expecting one, usually means a timeout occurred.") + (defconst dbus-error-property-read-only (concat dbus-error-dbus ".PropertyReadOnly") "Property you tried to set is read-only.") +(defconst dbus-error-service-unknown (concat dbus-error-dbus ".ServiceUnknown") + "The bus doesn't know how to launch a service to supply the bus name you wanted.") + +(defconst dbus-error-unknown-interface + (concat dbus-error-dbus ".UnknownInterface") + "Interface you invoked a method on isn't known by the object.") + +(defconst dbus-error-unknown-method (concat dbus-error-dbus ".UnknownMethod") + "Method name you invoked isn't known by the object you invoked it on.") + +(defconst dbus-error-unknown-object (concat dbus-error-dbus ".UnknownObject") + "Object you invoked a method on isn't known.") + +(defconst dbus-error-unknown-property (concat dbus-error-dbus ".UnknownProperty") + "Property you tried to access isn't known by the object.") + ;;; Emacs defaults. + (defconst dbus-service-emacs "org.gnu.Emacs" "The well known service name of Emacs.") @@ -200,7 +249,7 @@ caught in `condition-case' by `dbus-error'.") (defvar dbus-return-values-table (make-hash-table :test #'equal) "Hash table for temporarily storing arguments of reply messages. A key in this hash table is a list (:serial BUS SERIAL), like in -`dbus-registered-objects-table'. BUS is either a Lisp symbol, +`dbus-registered-objects-table'. BUS is either a Lisp keyword, `:system' or `:session', or a string denoting the bus address. SERIAL is the serial number of the reply message. @@ -234,8 +283,8 @@ The result will be made available in `dbus-return-values-table'." (defun dbus-call-method (bus service path interface method &rest args) "Call METHOD on the D-Bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE is the D-Bus service name to be used. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -256,8 +305,8 @@ converted into D-Bus types via the following rules: string => DBUS_TYPE_STRING list => DBUS_TYPE_ARRAY -All arguments can be preceded by a type symbol. For details about -type symbols, see Info node `(dbus)Type Conversion'. +All arguments can be preceded by a type keyword. For details +about type keywords, see Info node `(dbus)Type Conversion'. `dbus-call-method' returns the resulting values of METHOD as a list of Lisp objects. The type conversion happens the other direction as for @@ -302,7 +351,8 @@ object is returned instead of a list containing this single Lisp object. (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) - (or (memq bus '(:system :session)) (stringp bus) + (or (memq bus '(:system :session :system-private :session-private)) + (stringp bus) (signal 'wrong-type-argument (list 'keywordp bus))) (or (stringp service) (signal 'wrong-type-argument (list 'stringp service))) @@ -335,31 +385,32 @@ object is returned instead of a list containing this single Lisp object. (puthash key result dbus-return-values-table) (unwind-protect - (progn - (with-timeout ((if timeout (/ timeout 1000.0) 25) - (signal 'dbus-error (list "call timed out"))) - (while (eq (car result) :pending) - (let ((event (let ((inhibit-redisplay t) unread-command-events) - (read-event nil nil check-interval)))) - (when event - (if (ignore-errors (dbus-check-event event)) - (setf result (gethash key dbus-return-values-table)) - (setf unread-command-events - (nconc unread-command-events - (cons event nil))))) - (when (< check-interval 1) - (setf check-interval (* check-interval 1.05)))))) - (when (eq (car result) :error) - (signal (cadr result) (cddr result))) - (cdr result)) + (progn + (with-timeout + ((if timeout (/ timeout 1000.0) 25) + (signal 'dbus-error `(,dbus-error-no-reply "Call timed out"))) + (while (eq (car result) :pending) + (let ((event (let ((inhibit-redisplay t) unread-command-events) + (read-event nil nil check-interval)))) + (when event + (if (ignore-errors (dbus-check-event event)) + (setf result (gethash key dbus-return-values-table)) + (setf unread-command-events + (nconc unread-command-events + (cons event nil))))) + (when (< check-interval 1) + (setf check-interval (* check-interval 1.05)))))) + (when (eq (car result) :error) + (signal (cadr result) (cddr result))) + (cdr result)) (remhash key dbus-return-values-table)))) (defun dbus-call-method-asynchronously (bus service path interface method handler &rest args) "Call METHOD on the D-Bus BUS asynchronously. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE is the D-Bus service name to be used. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -384,8 +435,8 @@ converted into D-Bus types via the following rules: string => DBUS_TYPE_STRING list => DBUS_TYPE_ARRAY -All arguments can be preceded by a type symbol. For details about -type symbols, see Info node `(dbus)Type Conversion'. +All arguments can be preceded by a type keyword. For details +about type keywords, see Info node `(dbus)Type Conversion'. If HANDLER is a Lisp function, the function returns a key into the hash table `dbus-registered-objects-table'. The corresponding entry @@ -396,7 +447,7 @@ Example: \(dbus-call-method-asynchronously :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\" - \"org.freedesktop.Hal.Device\" \"GetPropertyString\" \\='message + \"org.freedesktop.Hal.Device\" \"GetPropertyString\" #\\='message \"system.kernel.machine\") -| i686 @@ -405,7 +456,8 @@ Example: (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) - (or (memq bus '(:system :session)) (stringp bus) + (or (memq bus '(:system :session :system-private :session-private)) + (stringp bus) (signal 'wrong-type-argument (list 'keywordp bus))) (or (stringp service) (signal 'wrong-type-argument (list 'stringp service))) @@ -424,9 +476,9 @@ Example: (defun dbus-send-signal (bus service path interface signal &rest args) "Send signal SIGNAL on the D-Bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. The signal is sent from the D-Bus object -Emacs is registered at BUS. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. The signal is sent from the +D-Bus object Emacs is registered at BUS. SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known name or a unique name. If SERVICE is nil, the signal is sent as @@ -444,8 +496,8 @@ converted into D-Bus types via the following rules: string => DBUS_TYPE_STRING list => DBUS_TYPE_ARRAY -All arguments can be preceded by a type symbol. For details about -type symbols, see Info node `(dbus)Type Conversion'. +All arguments can be preceded by a type keyword. For details +about type keywords, see Info node `(dbus)Type Conversion'. Example: @@ -455,7 +507,8 @@ Example: (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) - (or (memq bus '(:system :session)) (stringp bus) + (or (memq bus '(:system :session :system-private :session-private)) + (stringp bus) (signal 'wrong-type-argument (list 'keywordp bus))) (or (null service) (stringp service) (signal 'wrong-type-argument (list 'stringp service))) @@ -475,7 +528,8 @@ This is an internal function, it shall not be used outside dbus.el." (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) - (or (memq bus '(:system :session)) (stringp bus) + (or (memq bus '(:system :session :system-private :session-private)) + (stringp bus) (signal 'wrong-type-argument (list 'keywordp bus))) (or (stringp service) (signal 'wrong-type-argument (list 'stringp service))) @@ -492,7 +546,8 @@ This is an internal function, it shall not be used outside dbus.el." (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) - (or (memq bus '(:system :session)) (stringp bus) + (or (memq bus '(:system :session :system-private :session-private)) + (stringp bus) (signal 'wrong-type-argument (list 'keywordp bus))) (or (stringp service) (signal 'wrong-type-argument (list 'stringp service))) @@ -502,6 +557,22 @@ This is an internal function, it shall not be used outside dbus.el." (apply #'dbus-message-internal dbus-message-type-error bus service serial error-name args)) +(defun dbus-check-arguments (bus service &rest args) + "Check arguments ARGS by side effect. +BUS, SERVICE and ARGS have the same format as in `dbus-call-method'. +Any wrong argument triggers a D-Bus error. Otherwise, return t. +This is an internal function, it shall not be used outside dbus.el." + + (or (featurep 'dbusbind) + (signal 'dbus-error (list "Emacs not compiled with dbus support"))) + (or (memq bus '(:system :session :system-private :session-private)) + (stringp bus) + (signal 'wrong-type-argument (list 'keywordp bus))) + (or (stringp service) + (signal 'wrong-type-argument (list 'stringp service))) + + (apply #'dbus-message-internal dbus-message-type-invalid bus service args)) + ;;; Hash table of registered functions. @@ -519,8 +590,9 @@ hash table." (defun dbus-setenv (bus variable value) "Set the value of the BUS environment variable named VARIABLE to VALUE. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. Both VARIABLE and VALUE should be strings. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. Both VARIABLE and VALUE should +be strings. Normally, services inherit the environment of the BUS daemon. This function adds to or modifies that environment when activating services. @@ -534,8 +606,8 @@ Some bus instances, such as `:system', may disable setting the environment." (defun dbus-register-service (bus service &rest flags) "Register known name SERVICE on the D-Bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE is the D-Bus service name that should be registered. It must be a known name. @@ -565,8 +637,9 @@ placed in the queue. `:already-owner': Service is already the primary owner." ;; Add Peer handler. - (dbus-register-method bus service nil dbus-interface-peer "Ping" - #'dbus-peer-handler 'dont-register) + (dbus-register-method + bus service nil dbus-interface-peer "Ping" + #'dbus-peer-handler 'dont-register) ;; Add ObjectManager handler. (dbus-register-method @@ -595,8 +668,9 @@ placed in the queue. (defun dbus-unregister-service (bus service) "Unregister all objects related to SERVICE from D-Bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. SERVICE must be a known service name. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE must be a known service +name. The function returns a keyword, indicating the result of the operation. One of the following keywords is returned: @@ -631,8 +705,8 @@ queue of this service." (bus service path interface signal handler &rest args) "Register for a signal on the D-Bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE is the D-Bus service name used by the sending D-Bus object. It can be either a known name or the unique name of the D-Bus object @@ -675,7 +749,7 @@ Example: \(dbus-register-signal :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" - \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" \\='my-signal-handler) + \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" #\\='my-signal-handler) => ((:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\") (\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler)) @@ -786,8 +860,8 @@ Example: (bus service path interface method handler &optional dont-register-service) "Register METHOD on the D-Bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE is the D-Bus service name of the D-Bus object METHOD is registered for. It must be a known name (see discussion of @@ -801,7 +875,7 @@ HANDLER is a Lisp function to be called when a method call is received. It must accept the input arguments of METHOD. The return value of HANDLER is used for composing the returning D-Bus message. If HANDLER returns a reply message with an empty -argument list, HANDLER must return the symbol `:ignore' in order +argument list, HANDLER must return the keyword `:ignore' in order to distinguish it from nil (the boolean false). If HANDLER detects an error, it shall return the list `(:error @@ -838,8 +912,9 @@ discovering the still incomplete interface." (defun dbus-unregister-object (object) "Unregister OBJECT from D-Bus. OBJECT must be the result of a preceding `dbus-register-method', -`dbus-register-property' or `dbus-register-signal' call. It -returns t if OBJECT has been unregistered, nil otherwise. +`dbus-register-signal', `dbus-register-property' or +`dbus-register-monitor' call. The function returns t if OBJECT +has been unregistered, nil otherwise. When OBJECT identifies the last method or property, which is registered for the respective service, Emacs releases its @@ -877,7 +952,10 @@ association to the service from D-Bus." (when (eq type :signal) (dbus-call-method bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus - "RemoveMatch" (nth 4 elt))))) + "RemoveMatch" (nth 4 elt))) + ;; Delete monitor connection by reestablishing private bus. + (when (eq type :monitor) + (dbus-init-bus bus 'private)))) ;; Check, whether there is still a registered function or property ;; for the given service. If not, unregister the service from the @@ -887,16 +965,19 @@ association to the service from D-Bus." (progn (maphash (lambda (k v) - (dolist (e v) - (ignore-errors - (and - ;; Bus. - (equal bus (cadr k)) - ;; Service. - (string-equal service (cadr e)) - ;; Non-empty object path. - (nth 2 e) - (throw :found t))))) + (when (consp v) + (dolist (e v) + (ignore-errors + (and + ;; Type. + (eq type (car k)) + ;; Bus. + (equal bus (cadr k)) + ;; Service. + (string-equal service (cadr e)) + ;; Non-empty object path. + (nth 2 e) + (throw :found t)))))) dbus-registered-objects-table) nil)))) (dbus-unregister-service bus service)) @@ -964,26 +1045,37 @@ STRING must have been encoded with `dbus-escape-as-identifier'." "Check whether EVENT is a well formed D-Bus event. EVENT is a list which starts with symbol `dbus-event': - (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS) + (dbus-event BUS TYPE SERIAL SERVICE DESTINATION PATH + INTERFACE MEMBER HANDLER &rest ARGS) BUS identifies the D-Bus the message is coming from. It is -either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. TYPE is the D-Bus message type which -has caused the event, SERIAL is the serial number of the received -D-Bus message. SERVICE and PATH are the unique name and the -object path of the D-Bus object emitting the message. INTERFACE -and MEMBER denote the message which has been sent. HANDLER is -the function which has been registered for this message. ARGS -are the arguments passed to HANDLER, when it is called during -event handling in `dbus-handle-event'. +either a Lisp keyword, `:system', `:session', `:systemp-private' +or `:session-private', or a string denoting the bus address. + +TYPE is the D-Bus message type which has caused the event, SERIAL +is the serial number of the received D-Bus message when TYPE is +equal `dbus-message-type-method-return' or `dbus-message-type-error'. + +SERVICE and PATH are the unique name and the object path of the +D-Bus object emitting the message. DESTINATION is the D-Bus name +the message is dedicated to, or nil in case the message is a +broadcast signal. + +INTERFACE and MEMBER denote the message which has been sent. +When TYPE is `dbus-message-type-error', MEMBER is the error name. + +HANDLER is the function which has been registered for this +message. ARGS are the typed arguments as returned from the +message. They are passed to HANDLER without type information, +when it is called during event handling in `dbus-handle-event'. This function signals a `dbus-error' if the event is not well formed." (when dbus-debug (message "DBus-Event %s" event)) (unless (and (listp event) (eq (car event) 'dbus-event) - ;; Bus symbol. - (or (symbolp (nth 1 event)) + ;; Bus keyword. + (or (keywordp (nth 1 event)) (stringp (nth 1 event))) ;; Type. (and (natnump (nth 2 event)) @@ -995,50 +1087,95 @@ formed." (= dbus-message-type-error (nth 2 event)) (or (stringp (nth 4 event)) (null (nth 4 event)))) - ;; Object path. + ;; Destination. (or (= dbus-message-type-method-return (nth 2 event)) (= dbus-message-type-error (nth 2 event)) - (stringp (nth 5 event))) - ;; Interface. + (or (stringp (nth 5 event)) + (null (nth 5 event)))) + ;; Object path. (or (= dbus-message-type-method-return (nth 2 event)) (= dbus-message-type-error (nth 2 event)) (stringp (nth 6 event))) - ;; Member. + ;; Interface. (or (= dbus-message-type-method-return (nth 2 event)) (= dbus-message-type-error (nth 2 event)) (stringp (nth 7 event))) + ;; Member. + (or (= dbus-message-type-method-return (nth 2 event)) + (stringp (nth 8 event))) ;; Handler. - (functionp (nth 8 event))) + (functionp (nth 9 event)) + ;; Arguments. + (listp (nthcdr 10 event))) (signal 'dbus-error (list "Not a valid D-Bus event" event)))) +(defun dbus-delete-types (&rest args) + "Delete type information from arguments retrieved via `dbus-handle-event'. +Basic type arguments (TYPE VALUE) will be transformed into VALUE, and +compound type arguments (TYPE VALUE) will be transformed into (VALUE)." + (car + (mapcar + (lambda (elt) + (cond + ((atom elt) elt) + ((memq (car elt) dbus-compound-types) + (mapcar #'dbus-delete-types (cdr elt))) + (t (cadr elt)))) + args))) + +(defun dbus-flatten-types (arg) + "Flatten type information from argument retrieved via `dbus-handle-event'. +Basic type arguments (TYPE VALUE) will be transformed into TYPE VALUE, and +compound type arguments (TYPE VALUE) will be kept as is." + (let (result) + (dolist (elt arg) + (cond + ((atom elt) (push elt result)) + ((and (not (memq (car elt) dbus-compound-types))) + (push (car elt) result) + (push (cadr elt) result)) + (t + (push (cons (car elt) (dbus-flatten-types (cdr elt))) result)))) + (nreverse result))) + ;;;###autoload (defun dbus-handle-event (event) "Handle events from the D-Bus. EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being -part of the event, is called with arguments ARGS. +part of the event, is called with arguments ARGS (without type information). If the HANDLER returns a `dbus-error', it is propagated as return message." (interactive "e") (condition-case err - (let (result) + (let (monitor args result) ;; We ignore not well-formed events. (dbus-check-event event) - ;; Error messages must be propagated. - (when (= dbus-message-type-error (nth 2 event)) - (signal 'dbus-error (nthcdr 9 event))) - ;; Apply the handler. - (setq result (apply (nth 8 event) (nthcdr 9 event))) - ;; Return an (error) message when it is a message call. - (when (= dbus-message-type-method-call (nth 2 event)) - (dbus-ignore-errors - (if (eq (car-safe result) :error) - (apply #'dbus-method-error-internal - (nth 1 event) (nth 4 event) (nth 3 event) (cdr result)) - (if (eq result :ignore) - (dbus-method-return-internal - (nth 1 event) (nth 4 event) (nth 3 event)) - (apply #'dbus-method-return-internal - (nth 1 event) (nth 4 event) (nth 3 event) - (if (consp result) result (list result)))))))) + ;; Remove type information. + (setq args (mapcar #'dbus-delete-types (nthcdr 10 event))) + (setq monitor + (gethash + (list :monitor (nth 1 event)) dbus-registered-objects-table)) + (if monitor + ;; A monitor event shall not trigger other operations, and + ;; it shall not trigger D-Bus errors. + (setq result (dbus-ignore-errors (apply (nth 9 event) args))) + ;; Error messages must be propagated. The error name is in + ;; the member slot. + (when (= dbus-message-type-error (nth 2 event)) + (signal 'dbus-error (cons (nth 8 event) args))) + ;; Apply the handler. + (setq result (apply (nth 9 event) args)) + ;; Return an (error) message when it is a message call. + (when (= dbus-message-type-method-call (nth 2 event)) + (dbus-ignore-errors + (if (eq (car-safe result) :error) + (apply #'dbus-method-error-internal + (nth 1 event) (nth 4 event) (nth 3 event) (cdr result)) + (if (eq result :ignore) + (dbus-method-return-internal + (nth 1 event) (nth 4 event) (nth 3 event)) + (apply #'dbus-method-return-internal + (nth 1 event) (nth 4 event) (nth 3 event) + (if (consp result) result (list result))))))))) ;; Error handling. (dbus-error ;; Return an error message when it is a message call. @@ -1054,8 +1191,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message." (defun dbus-event-bus-name (event) "Return the bus name the event is coming from. -The result is either a Lisp symbol, `:system' or `:session', or a -string denoting the bus address. EVENT is a D-Bus event, see +The result is either a Lisp keyword, `:system' or `:session', or +a string denoting the bus address. EVENT is a D-Bus event, see `dbus-check-event'. This function signals a `dbus-error' if the event is not well formed." (dbus-check-event event) @@ -1086,13 +1223,21 @@ formed." (dbus-check-event event) (nth 4 event)) +(defun dbus-event-destination-name (event) + "Return the name of the D-Bus object the event is dedicated to. +The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. +This function signals a `dbus-error' if the event is not well +formed." + (dbus-check-event event) + (nth 5 event)) + (defun dbus-event-path-name (event) "Return the object path of the D-Bus object the event is coming from. The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. This function signals a `dbus-error' if the event is not well formed." (dbus-check-event event) - (nth 5 event)) + (nth 6 event)) (defun dbus-event-interface-name (event) "Return the interface name of the D-Bus object the event is coming from. @@ -1100,15 +1245,32 @@ The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. This function signals a `dbus-error' if the event is not well formed." (dbus-check-event event) - (nth 6 event)) + (nth 7 event)) (defun dbus-event-member-name (event) "Return the member name the event is coming from. -It is either a signal name or a method name. The result is a -string. EVENT is a D-Bus event, see `dbus-check-event'. This -function signals a `dbus-error' if the event is not well formed." +It is either a signal name, a method name or an error name. The +result is a string. EVENT is a D-Bus event, see +`dbus-check-event'. This function signals a `dbus-error' if the +event is not well formed." (dbus-check-event event) - (nth 7 event)) + (nth 8 event)) + +(defun dbus-event-handler (event) + "Return the handler the event is applied with. +The result is a function. EVENT is a D-Bus event, see +`dbus-check-event'. This function signals a `dbus-error' if the +event is not well formed." + (dbus-check-event event) + (nth 9 event)) + +(defun dbus-event-arguments (event) + "Return the arguments the event is carrying on. +The result is a list of arguments. EVENT is a D-Bus event, see +`dbus-check-event'. This function signals a `dbus-error' if the +event is not well formed." + (dbus-check-event event) + (nthcdr 10 event)) ;;; D-Bus registered names. @@ -1118,10 +1280,11 @@ function signals a `dbus-error' if the event is not well formed." BUS defaults to `:system' when nil or omitted. The result is a list of strings, which is nil when there are no activatable service names at all." - (dbus-ignore-errors - (dbus-call-method - (or bus :system) dbus-service-dbus - dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + (or bus :system) dbus-service-dbus + dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))) (defun dbus-list-names (bus) "Return the service names registered at D-Bus BUS. @@ -1129,9 +1292,10 @@ The result is a list of strings, which is nil when there are no registered service names at all. Well known names are strings like \"org.freedesktop.DBus\". Names starting with \":\" are unique names for services." - (dbus-ignore-errors - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))) (defun dbus-list-known-names (bus) "Retrieve all services which correspond to a known name in BUS. @@ -1144,18 +1308,20 @@ A service has a known name if it doesn't start with \":\"." "Return the unique names registered at D-Bus BUS and queued for SERVICE. The result is a list of strings, or nil when there are no queued name owner service names at all." - (dbus-ignore-errors - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus - dbus-interface-dbus "ListQueuedOwners" service))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "ListQueuedOwners" service)))) (defun dbus-get-name-owner (bus service) "Return the name owner of SERVICE registered at D-Bus BUS. The result is either a string, or nil if there is no name owner." - (dbus-ignore-errors - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus - dbus-interface-dbus "GetNameOwner" service))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "GetNameOwner" service)))) (defun dbus-ping (bus service &optional timeout) "Check whether SERVICE is registered for D-Bus BUS. @@ -1183,7 +1349,8 @@ check whether SERVICE is already running, you can instead write "Default handler for the \"org.freedesktop.DBus.Peer\" interface. It will be registered for all objects created by `dbus-register-service'." (let* ((last-input-event last-input-event) - (method (dbus-event-member-name last-input-event))) + (method (dbus-event-member-name last-input-event)) + (path (dbus-event-path-name last-input-event))) (cond ;; "Ping" does not return an output parameter. ((string-equal method "Ping") @@ -1193,7 +1360,11 @@ It will be registered for all objects created by `dbus-register-service'." (signal 'dbus-error (list - (format "%s.GetMachineId not implemented" dbus-interface-peer))))))) + (format "%s.GetMachineId not implemented" dbus-interface-peer)))) + (t `(:error ,dbus-error-unknown-method + ,(format-message + "No such method \"%s.%s\" at path \"%s\"" + dbus-interface-peer method path)))))) ;;; D-Bus introspection. @@ -1214,16 +1385,17 @@ It will be registered for all objects created by `dbus-register-service'." "Return all interfaces and sub-nodes of SERVICE, registered at object path PATH at bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. SERVICE must be a known service name, -and PATH must be a valid object path. The last two parameters -are strings. The result, the introspection data, is a string in -XML format." +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE must be a known service +name, and PATH must be a valid object path. The last two +parameters are strings. The result, the introspection data, is a +string in XML format." ;; We don't want to raise errors. - (dbus-ignore-errors - (dbus-call-method - bus service path dbus-interface-introspectable "Introspect" - :timeout 1000))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus service path dbus-interface-introspectable "Introspect" + :timeout 1000)))) (defalias 'dbus--parse-xml-buffer (if (libxml-available-p) @@ -1385,37 +1557,38 @@ string and a member of the list returned by (defun dbus-introspect-get-signature (bus service path interface name &optional direction) - "Return signature of a `method' or `signal' represented by NAME as a string. + "Return signature of a `method', `property' or `signal' represented by NAME. If NAME is a `method', DIRECTION can be either \"in\" or \"out\". If DIRECTION is nil, \"in\" is assumed. -If NAME is a `signal', and DIRECTION is non-nil, DIRECTION must -be \"out\"." +If NAME is a `signal' or a `property', DIRECTION is ignored." ;; For methods, we use "in" as default direction. (let ((object (or (dbus-introspect-get-method bus service path interface name) (dbus-introspect-get-signal + bus service path interface name) + (dbus-introspect-get-property bus service path interface name)))) - (when (and (string-equal - "method" (dbus-introspect-get-attribute object "name")) - (not (stringp direction))) + (when (and (eq 'method (car object)) (not (stringp direction))) (setq direction "in")) ;; In signals, no direction is given. - (when (string-equal "signal" (dbus-introspect-get-attribute object "name")) + (when (eq 'signal (car object)) (setq direction nil)) ;; Collect the signatures. - (mapconcat - (lambda (x) - (let ((arg (dbus-introspect-get-argument - bus service path interface name x))) - (if (or (not (stringp direction)) - (string-equal - direction - (dbus-introspect-get-attribute arg "direction"))) - (dbus-introspect-get-attribute arg "type") - ""))) - (dbus-introspect-get-argument-names bus service path interface name) - ""))) + (if (eq 'property (car object)) + (dbus-introspect-get-attribute object "type") + (mapconcat + (lambda (x) + (let ((arg (dbus-introspect-get-argument + bus service path interface name x))) + (if (or (not (stringp direction)) + (string-equal + direction + (dbus-introspect-get-attribute arg "direction"))) + (dbus-introspect-get-attribute arg "type") + ""))) + (dbus-introspect-get-argument-names bus service path interface name) + "")))) ;;; D-Bus properties. @@ -1423,37 +1596,45 @@ be \"out\"." (defun dbus-get-property (bus service path interface property) "Return the value of PROPERTY of INTERFACE. It will be checked at BUS, SERVICE, PATH. The result can be any -valid D-Bus value, or nil if there is no PROPERTY." - (dbus-ignore-errors - ;; "Get" returns a variant, so we must use the `car'. - (car - (dbus-call-method - bus service path dbus-interface-properties - "Get" :timeout 500 interface property)))) - -(defun dbus-set-property (bus service path interface property value) - "Set value of PROPERTY of INTERFACE to VALUE. -It will be checked at BUS, SERVICE, PATH. When the value is -successfully set return VALUE. Otherwise, return nil." - (dbus-ignore-errors - ;; "Set" requires a variant. +valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read." + ;; "Get" returns a variant, so we must use the `car'. + (car (dbus-call-method bus service path dbus-interface-properties - "Set" :timeout 500 interface property (list :variant value)) - ;; Return VALUE. - (dbus-get-property bus service path interface property))) + "Get" :timeout 500 interface property))) + +(defun dbus-set-property (bus service path interface property &rest args) + "Set value of PROPERTY of INTERFACE to VALUE. +It will be checked at BUS, SERVICE, PATH. VALUE can be preceded +by a TYPE keyword. When the value is successfully set, and the +property's access type is not `:write', return VALUE. Otherwise, +return nil. + +\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)" + ;; "Set" requires a variant. + (dbus-call-method + bus service path dbus-interface-properties + "Set" :timeout 500 interface property (cons :variant args)) + ;; Return VALUE. + (condition-case err + (dbus-get-property bus service path interface property) + (dbus-error + (if (string-equal dbus-error-access-denied (cadr err)) + (car args) + (signal (car err) (cdr err)))))) (defun dbus-get-all-properties (bus service path interface) "Return all properties of INTERFACE at BUS, SERVICE, PATH. The result is a list of entries. Every entry is a cons of the name of the property, and its value. If there are no properties, nil is returned." - (dbus-ignore-errors - ;; "GetAll" returns "a{sv}". - (mapcar (lambda (dict) - (cons (car dict) (caadr dict))) - (dbus-call-method bus service path dbus-interface-properties - "GetAll" :timeout 500 interface)))) + (let (dbus-debug) + (dbus-ignore-errors + ;; "GetAll" returns "a{sv}". + (mapcar (lambda (dict) + (cons (car dict) (caadr dict))) + (dbus-call-method bus service path dbus-interface-properties + "GetAll" :timeout 500 interface))))) (defun dbus-get-this-registered-property (bus _service path interface property) "Return PROPERTY entry of `dbus-registered-objects-table'. @@ -1465,7 +1646,8 @@ Filter out not matching PATH." (gethash (list :property bus interface property) dbus-registered-objects-table))) -(defun dbus-get-other-registered-property (bus _service path interface property) +(defun dbus-get-other-registered-properties + (bus _service path interface property) "Return PROPERTY entry of `dbus-registered-objects-table'. Filter out matching PATH." ;; Remove matching entries. @@ -1476,12 +1658,11 @@ Filter out matching PATH." dbus-registered-objects-table))) (defun dbus-register-property - (bus service path interface property access value - &optional emits-signal dont-register-service) + (bus service path interface property access &rest args) "Register PROPERTY on the D-Bus BUS. -BUS is either a Lisp symbol, `:system' or `:session', or a string -denoting the bus address. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. SERVICE is the D-Bus service name of the D-Bus. It must be a known name (see discussion of DONT-REGISTER-SERVICE below). @@ -1491,9 +1672,11 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE is the name of the interface used at PATH, PROPERTY is the name of the property of INTERFACE. ACCESS indicates, whether the property can be changed by other services via D-Bus. It must be either -the symbol `:read', `:write' or `:readwrite'. VALUE is the -initial value of the property, it can be of any valid type (see -`dbus-call-method' for details). +the keyword `:read', `:write' or `:readwrite'. + +VALUE is the initial value of the property, it can be of any +valid type (see `dbus-call-method' for details). VALUE can be +preceded by a TYPE keyword. If PROPERTY already exists on PATH, it will be overwritten. For properties with access type `:read' this is the only way to @@ -1511,62 +1694,85 @@ not registered. This means that other D-Bus clients have no way of noticing the newly registered property. When interfaces are constructed incrementally by adding single methods or properties at a time, DONT-REGISTER-SERVICE can be used to prevent other -clients from discovering the still incomplete interface." - (unless (member access '(:read :write :readwrite)) - (signal 'wrong-type-argument (list "Access type invalid" access))) - - ;; Add handlers for the three property-related methods. - (dbus-register-method - bus service path dbus-interface-properties "Get" - #'dbus-property-handler 'dont-register) - (dbus-register-method - bus service path dbus-interface-properties "GetAll" - #'dbus-property-handler 'dont-register) - (dbus-register-method - bus service path dbus-interface-properties "Set" - #'dbus-property-handler 'dont-register) - - ;; Register SERVICE. - (unless (or dont-register-service (member service (dbus-list-names bus))) - (dbus-register-service bus service)) - - ;; Send the PropertiesChanged signal. - (when emits-signal - (dbus-send-signal - bus service path dbus-interface-properties "PropertiesChanged" - (if (member access '(:read :readwrite)) - `(:array (:dict-entry ,property (:variant ,value))) - '(:array: :signature "{sv}")) - (if (eq access :write) - `(:array ,property) - '(:array)))) - - ;; Create a hash table entry. We use nil for the unique name, - ;; because the property might be accessed from anybody. - (let ((key (list :property bus interface property)) - (val - (cons - (list - nil service path - (cons - (if emits-signal (list access :emits-signal) (list access)) - value)) - (dbus-get-other-registered-property - bus service path interface property)))) - (puthash key val dbus-registered-objects-table) - - ;; Return the object. - (list key (list service path)))) +clients from discovering the still incomplete interface. + +\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \ +[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)" + (let (;; Read basic type keyword. + (type (when (keywordp (car args)) (pop args))) + (value (pop args)) + (emits-signal (pop args)) + (dont-register-service (pop args))) + (unless (member access '(:read :write :readwrite)) + (signal 'wrong-type-argument (list "Access type invalid" access))) + (unless (or type (consp value)) + (setq type + (cond + ((memq value '(t nil)) :boolean) + ((natnump value) :uint32) + ((fixnump value) :int32) + ((floatp value) :double) + ((stringp value) :string) + (t + (signal 'wrong-type-argument (list "Value type invalid" value)))))) + (unless (consp value) + (setq value (list type value))) + (setq value (if (member (car value) dbus-compound-types) + (list :variant value) (cons :variant value))) + (dbus-check-arguments bus service value) + + ;; Add handlers for the three property-related methods. + (dbus-register-method + bus service path dbus-interface-properties "Get" + #'dbus-property-handler 'dont-register) + (dbus-register-method + bus service path dbus-interface-properties "GetAll" + #'dbus-property-handler 'dont-register) + (dbus-register-method + bus service path dbus-interface-properties "Set" + #'dbus-property-handler 'dont-register) + + ;; Register SERVICE. + (unless (or dont-register-service (member service (dbus-list-names bus))) + (dbus-register-service bus service)) + + ;; Send the PropertiesChanged signal. + (when emits-signal + (dbus-send-signal + bus service path dbus-interface-properties "PropertiesChanged" + interface + ;; changed_properties. + (if (eq access :write) + '(:array: :signature "{sv}") + `(:array (:dict-entry ,property ,value))) + ;; invalidated_properties. + (if (eq access :write) + `(:array ,property) + '(:array)))) + + ;; Create a hash table entry. We use nil for the unique name, + ;; because the property might be accessed from anybody. + (let ((key (list :property bus interface property)) + (val + (cons + (list nil service path (list access emits-signal value)) + (dbus-get-other-registered-properties + bus service path interface property)))) + (puthash key val dbus-registered-objects-table) + + ;; Return the object. + (list key (list service path))))) (defun dbus-property-handler (&rest args) "Default handler for the \"org.freedesktop.DBus.Properties\" interface. It will be registered for all objects created by `dbus-register-property'." - (let ((bus (dbus-event-bus-name last-input-event)) - (service (dbus-event-service-name last-input-event)) - (path (dbus-event-path-name last-input-event)) - (method (dbus-event-member-name last-input-event)) - (interface (car args)) - (property (cadr args))) + (let* ((last-input-event last-input-event) + (bus (dbus-event-bus-name last-input-event)) + (service (dbus-event-service-name last-input-event)) + (path (dbus-event-path-name last-input-event)) + (method (dbus-event-member-name last-input-event)) + (interface (car args)) + (property (cadr args))) (cond ;; "Get" returns a variant. ((string-equal method "Get") @@ -1575,46 +1781,51 @@ It will be registered for all objects created by `dbus-register-property'." (object (car (last (car entry))))) (cond ((not (consp object)) - `(:error ,dbus-error-invalid-args + `(:error ,dbus-error-unknown-property ,(format-message "No such property \"%s\" at path \"%s\"" property path))) - ((eq (car object) :write) + ((eq :write (car object)) `(:error ,dbus-error-access-denied ,(format-message "Property \"%s\" at path \"%s\" is not readable" property path))) - ;; Return the result. - (t `((:variant ,(cdar (last (car entry))))))))) + ;; Return the result. Since variant is a list, we must embed + ;; it into another list. + (t (list (nth 2 object)))))) - ;; "Set" expects a variant. + ;; "Set" needs the third typed argument from `last-input-event'. ((string-equal method "Set") - (let* ((value (caar (cddr args))) + (let* ((value (dbus-flatten-types (nth 12 last-input-event))) (entry (dbus-get-this-registered-property bus service path interface property)) (object (car (last (car entry))))) (cond ((not (consp object)) - `(:error ,dbus-error-invalid-args + `(:error ,dbus-error-unknown-property ,(format-message "No such property \"%s\" at path \"%s\"" property path))) - ((eq (car object) :read) + ((eq :read (car object)) `(:error ,dbus-error-property-read-only ,(format-message "Property \"%s\" at path \"%s\" is not writable" property path))) (t (puthash (list :property bus interface property) - (cons (append (butlast (car entry)) - (list (cons (car object) value))) - (dbus-get-other-registered-property + (cons (append + (butlast (car entry)) + ;; Reuse ACCESS and EMITS-SIGNAL. + (list (append (butlast object) (list value)))) + (dbus-get-other-registered-properties bus service path interface property)) dbus-registered-objects-table) ;; Send the "PropertiesChanged" signal. - (when (member :emits-signal (car object)) + (when (nth 1 object) (dbus-send-signal bus service path dbus-interface-properties "PropertiesChanged" - (if (or (member :read (car object)) - (member :readwrite (car object))) - `(:array (:dict-entry ,property (:variant ,value))) - '(:array: :signature "{sv}")) - (if (eq (car object) :write) + interface + ;; changed_properties. + (if (eq :write (car object)) + '(:array: :signature "{sv}") + `(:array (:dict-entry ,property ,value))) + ;; invalidated_properties. + (if (eq :write (car object)) `(:array ,property) '(:array)))) ;; Return empty reply. @@ -1625,18 +1836,25 @@ It will be registered for all objects created by `dbus-register-property'." (let (result) (maphash (lambda (key val) - (dolist (item val) - (when (and (equal (butlast key) (list :property bus interface)) - (string-equal path (nth 2 item)) - (not (functionp (car (last item))))) - (push - (list :dict-entry - (car (last key)) - (list :variant (cdar (last item)))) - result)))) + (when (consp val) + (dolist (item val) + (let ((object (car (last item)))) + (when (and (equal (butlast key) (list :property bus interface)) + (string-equal path (nth 2 item)) + (consp object) + (not (eq :write (car object)))) + (push + (list :dict-entry (car (last key)) (nth 2 object)) + result)))))) dbus-registered-objects-table) - ;; Return the result, or an empty array. - (list :array (or result '(:signature "{sv}")))))))) + ;; Return the result, or an empty array. An array must be + ;; embedded in a list. + (list (cons :array (or result '(:signature "{sv}")))))) + + (t `(:error ,dbus-error-unknown-method + ,(format-message + "No such method \"%s.%s\" at path \"%s\"" + dbus-interface-properties method path)))))) ;;; D-Bus object manager. @@ -1676,10 +1894,11 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow." (let ((result ;; Direct call. Fails, if the target does not support the ;; object manager interface. - (dbus-ignore-errors - (dbus-call-method - bus service path dbus-interface-objectmanager - "GetManagedObjects" :timeout 1000)))) + (let (dbus-debug) + (dbus-ignore-errors + (dbus-call-method + bus service path dbus-interface-objectmanager + "GetManagedObjects" :timeout 1000))))) (if result ;; Massage the returned structure. @@ -1723,35 +1942,38 @@ It will be registered for all objects created by `dbus-register-service'." ;; Check for object path wildcard interfaces. (maphash (lambda (key val) - (when (and (equal (butlast key 2) (list :method bus)) - (null (nth 2 (car-safe val)))) - (push (nth 2 key) interfaces))) + (when (equal (butlast key 2) (list :property bus)) + (dolist (item val) + (unless (nth 2 item) ; Path. + (push (nth 2 key) interfaces))))) dbus-registered-objects-table) ;; Check all registered object paths. (maphash (lambda (key val) - (let ((object (or (nth 2 (car-safe val)) ""))) - (when (and (equal (butlast key 2) (list :method bus)) - (string-prefix-p path object)) - (dolist (interface (cons (nth 2 key) interfaces)) - (unless (assoc object result) - (push (list object) result)) - (unless (assoc interface (cdr (assoc object result))) - (setcdr - (assoc object result) - (append - (list (cons - interface - ;; We simulate "org.freedesktop.DBus.Properties.GetAll" - ;; by using an appropriate D-Bus event. - (let ((last-input-event - (append - (butlast last-input-event 4) - (list object dbus-interface-properties - "GetAll" #'dbus-property-handler)))) - (dbus-property-handler interface)))) - (cdr (assoc object result))))))))) + (when (equal (butlast key 2) (list :property bus)) + (dolist (item val) + (let ((object (or (nth 2 item) ""))) ; Path. + (when (string-prefix-p path object) + (dolist (interface (cons (nth 2 key) (delete-dups interfaces))) + (unless (assoc object result) + (push (list object) result)) + (unless (assoc interface (cdr (assoc object result))) + (setcdr + (assoc object result) + (append + (list (cons + interface + ;; We simulate + ;; "org.freedesktop.DBus.Properties.GetAll" + ;; by using an appropriate D-Bus event. + (let ((last-input-event + (append + (butlast last-input-event 4) + (list object dbus-interface-properties + "GetAll" #'dbus-property-handler)))) + (dbus-property-handler interface)))) + (cdr (assoc object result))))))))))) dbus-registered-objects-table) ;; Return the result, or an empty array. @@ -1766,13 +1988,195 @@ It will be registered for all objects created by `dbus-register-service'." result) '(:signature "{oa{sa{sv}}}")))))) +(cl-defun dbus-register-monitor + (bus &optional handler &key type sender destination path interface member) + "Register HANDLER for monitor events on the D-Bus BUS. + +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. + +HANDLER is the function to be called when a monitor event +arrives. It is called with the `args' slot of the monitor event, +which are stripped off the type keywords. If HANDLER is nil, the +default handler `dbus-monitor-handler' is applied. + +The other arguments are keyword-value pairs. `:type TYPE' +defines the message type to be monitored. If given, it must be +equal one of the strings \"method_call\", \"method_return\", +\"error\" or \"signal\". + +`:sender SENDER' and `:destination DESTINATION' are D-Bus names. +They can be unique names, or well-known service names. + +`:path PATH' is the D-Bus object to be monitored. `:interface +INTERFACE' is the name of an interface, and `:member MEMBER' is +either a method name, a signal name, or an error name." + (let ((bus-private (if (eq bus :system) :system-private + (if (eq bus :session) :session-private bus))) + rule key key1 value) + (unless handler (setq handler #'dbus-monitor-handler)) + ;; Compose rule. + (setq rule + (string-join + (delq nil (mapcar + (lambda (item) + (when (cdr item) + (format "%s='%s'" (car item) (cdr item)))) + `(("type" . ,type) ("sender" . ,sender) + ("destination" . ,destination) ("path" . ,path) + ("interface" . ,interface) ("member" . ,member)))) + ",") + rule (or rule "")) + + (unless (ignore-errors (dbus-get-unique-name bus-private)) + (dbus-init-bus bus 'private)) + (dbus-call-method + bus-private dbus-service-dbus dbus-path-dbus dbus-interface-monitoring + "BecomeMonitor" `(:array :string ,rule) :uint32 0) + + (when dbus-debug (message "Matching rule \"%s\" created" rule)) + + ;; Create a hash table entry. + (setq key (list :monitor bus-private) + key1 (list nil nil nil handler rule) + value (gethash key dbus-registered-objects-table)) + (unless (member key1 value) + (puthash key (cons key1 value) dbus-registered-objects-table)) + + (when dbus-debug (message "%s" dbus-registered-objects-table)) + + ;; Return the object. + (list key (list nil nil handler)))) + +(defconst dbus-monitor-method-call + (propertize "method-call" 'face 'font-lock-function-name-face) + "Text to be inserted for D-Bus method-call in monitor.") + +(defconst dbus-monitor-method-return + (propertize "method-return" 'face 'font-lock-function-name-face) + "Text to be inserted for D-Bus method-return in monitor.") + +(defconst dbus-monitor-error (propertize "error" 'face 'font-lock-warning-face) + "Text to be inserted for D-Bus error in monitor.") + +(defconst dbus-monitor-signal + (propertize "signal" 'face 'font-lock-type-face) + "Text to be inserted for D-Bus signal in monitor.") + +(defun dbus-monitor-goto-serial () + "Goto D-Bus message with the same serial number." + (interactive) + (when (mouse-event-p last-input-event) (mouse-set-point last-input-event)) + (when-let ((point (get-text-property (point) 'dbus-serial))) + (goto-char point))) + +(defun dbus-monitor-handler (&rest _args) + "Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\" interface. +It will be applied for all objects created by `dbus-register-monitor' +which don't declare an own handler. The printed timestamps do +not reflect the time the D-Bus message has passed the D-Bus +daemon, it is rather the timestamp the corresponding D-Bus event +has been handled by this function." + (with-current-buffer (get-buffer-create "*D-Bus Monitor*") + (special-mode) + ;; Move forward and backward between messages. + (local-set-key [?n] #'forward-paragraph) + (local-set-key [?p] #'backward-paragraph) + ;; Follow serial links. + (local-set-key (kbd "RET") #'dbus-monitor-goto-serial) + (local-set-key [mouse-2] #'dbus-monitor-goto-serial) + (let* ((inhibit-read-only t) + (text-quoting-style 'grave) + (point (point)) + (eobp (eobp)) + (event last-input-event) + (type (dbus-event-message-type event)) + (sender (dbus-event-service-name event)) + (destination (dbus-event-destination-name event)) + (serial (dbus-event-serial-number event)) + (path (dbus-event-path-name event)) + (interface (dbus-event-interface-name event)) + (member (dbus-event-member-name event)) + (arguments (dbus-event-arguments event)) + (time (time-to-seconds (current-time)))) + (save-excursion + ;; Check for matching method-call. + (goto-char (point-max)) + (when (and (or (= type dbus-message-type-method-return) + (= type dbus-message-type-error)) + (re-search-backward + (format + (concat + "^method-call time=\\(\\S-+\\) " + ".*sender=%s .*serial=\\(%d\\) ") + destination serial) + nil 'noerror)) + (setq serial + (propertize + (match-string 2) 'dbus-serial (match-beginning 0) + 'help-echo "RET, mouse-1, mouse-2: goto method-call" + 'face 'link 'follow-link 'mouse-face 'mouse-face 'highlight) + time (format "%f (%f)" time (- time (read (match-string 1))))) + (set-text-properties + (match-beginning 2) (match-end 2) + `(dbus-serial ,(point-max) + help-echo + ,(format + "RET, mouse-1, mouse-2: goto %s" + (if (= type dbus-message-type-error) "error" "method-return")) + face link follow-link mouse-face mouse-face highlight))) + ;; Insert D-Bus message. + (goto-char (point-max)) + (insert + (format + (concat + "%s time=%s sender=%s -> destination=%s serial=%s " + "path=%s interface=%s member=%s\n") + (cond + ((= type dbus-message-type-method-call) dbus-monitor-method-call) + ((= type dbus-message-type-method-return) dbus-monitor-method-return) + ((= type dbus-message-type-error) dbus-monitor-error) + ((= type dbus-message-type-signal) dbus-monitor-signal)) + time sender destination serial path interface member)) + (dolist (arg arguments) + (pp (dbus-flatten-types arg) (current-buffer))) + (insert "\n") + ;; Show byte arrays as string. + (goto-char point) + (while (re-search-forward + "(:array\\( :byte [[:digit:]]+\\)+)" nil 'noerror) + (put-text-property + (match-beginning 0) (match-end 0) + 'help-echo (dbus-byte-array-to-string (read (match-string 0))))) + ;; Show fixed numbers. + (goto-char point) + (while (re-search-forward + (concat + (regexp-opt + '(":int16" ":uint16" ":int32" ":uint32" ":int64" ":uint64")) + " \\([-+[:digit:]]+\\)") + nil 'noerror) + (put-text-property + (match-beginning 1) (match-end 1) + 'help-echo + (format + "#o%o, #x%X" (read (match-string 1)) (read (match-string 1))))) + ;; Show floating numbers. + (goto-char point) + (while (re-search-forward ":double \\([-+.[:digit:]]+\\)" nil 'noerror) + (put-text-property + (match-beginning 1) (match-end 1) + 'help-echo (format "%e" (read (match-string 1)))))) + (when eobp + (goto-char (point-max)))))) + (defun dbus-handle-bus-disconnect () "React to a bus disconnection. BUS is the bus that disconnected. This routine unregisters all handlers on the given bus and causes all synchronous calls pending at the time of disconnect to fail." (let ((bus (dbus-event-bus-name last-input-event)) - (keys-to-remove)) + keys-to-remove) (maphash (lambda (key value) (when (and (eq (nth 0 key) :serial) @@ -1782,13 +2186,14 @@ pending at the time of disconnect to fail." (list 'dbus-event bus dbus-message-type-error - (nth 2 key) - nil - nil - nil - nil - value) - (list 'dbus-error "Bus disconnected" bus)) + (nth 2 key) ; serial + nil ; service + nil ; destination + nil ; path + nil ; interface + nil ; member + value) ; handler + (list 'dbus-error dbus-error-disconnected "Bus disconnected" bus)) (push key keys-to-remove))) dbus-registered-objects-table) (dolist (key keys-to-remove) @@ -1797,10 +2202,11 @@ pending at the time of disconnect to fail." (defun dbus-init-bus (bus &optional private) "Establish the connection to D-Bus BUS. -BUS can be either the symbol `:system' or the symbol `:session', or it -can be a string denoting the address of the corresponding bus. For -the system and session buses, this function is called when loading -`dbus.el', there is no need to call it again. +BUS can be either the keyword `:system' or the keyword +`:session', or it can be a string denoting the address of the +corresponding bus. For the system and session buses, this +function is called when loading `dbus.el', there is no need to +call it again. The function returns the number of connections this Emacs session has established to the BUS under the same unique name (see @@ -1810,13 +2216,13 @@ example, if Emacs is linked with the GTK+ toolkit, and it runs in a GTK+-aware environment like GNOME, another connection might already be established. -When PRIVATE is non-nil, a new connection is established instead of -reusing an existing one. It results in a new unique name at the bus. -This can be used, if it is necessary to distinguish from another -connection used in the same Emacs process, like the one established by -GTK+. It should be used with care for at least the `:system' and -`:session' buses, because other Emacs Lisp packages might already use -this connection to those buses." +When PRIVATE is non-nil, a new connection is established instead +of reusing an existing one. It results in a new unique name at +the bus. This can be used, if it is necessary to distinguish +from another connection used in the same Emacs process, like the +one established by GTK+. If BUS is the keyword `:system' or the +keyword `:session', the new connection is identified by the +keywords `:system-private' or `:session-private', respectively." (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) (prog1 @@ -1842,6 +2248,8 @@ this connection to those buses." ;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and ;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved. ;; +;; * Cache introspection data. +;; ;; * Run handlers in own threads. ;;; dbus.el ends here diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index bc939e0d396..bb1474b8b5b 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -1,4 +1,4 @@ -;;; eudc-vars.el --- Emacs Unified Directory Client +;;; eudc-vars.el --- Emacs Unified Directory Client -*- lexical-binding: t -*- ;; Copyright (C) 1998-2020 Free Software Foundation, Inc. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index b720edc7fef..ebc75e0e8a7 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -134,6 +134,15 @@ The string will be passed through `substitute-command-keys'." :type '(choice (const :tag "Unlimited" nil) integer)) +(defcustom eww-retrieve-command nil + "Command to retrieve an URL via an external program. +If nil, `url-retrieve' is used to download the data. If non-nil, +this should be a list where the first item is the program, and +the rest are the arguments." + :version "28.1" + :type '(choice (const :tag "Use `url-retrieve'" nil) + (repeat string))) + (defcustom eww-use-external-browser-for-content-type "\\`\\(video/\\|audio/\\|application/ogg\\)" "Always use external browser for specified content-type." @@ -346,9 +355,34 @@ killed after rendering." (let ((eww-buffer (current-buffer))) (with-current-buffer buffer (eww-render nil url nil eww-buffer))) - (url-retrieve url #'eww-render + (eww-retrieve url #'eww-render (list url nil (current-buffer)))))) +(defun eww-retrieve (url callback cbargs) + (if (null eww-retrieve-command) + (url-retrieve url #'eww-render + (list url nil (current-buffer))) + (let ((buffer (generate-new-buffer " *eww retrieve*")) + (error-buffer (generate-new-buffer " *eww error*"))) + (with-current-buffer buffer + (set-buffer-multibyte nil) + (make-process + :name "*eww fetch*" + :buffer (current-buffer) + :stderr error-buffer + :command (append eww-retrieve-command (list url)) + :sentinel (lambda (process _) + (unless (process-live-p process) + (when (buffer-live-p error-buffer) + (when (get-buffer-process error-buffer) + (delete-process (get-buffer-process error-buffer) )) + (kill-buffer error-buffer)) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (goto-char (point-min)) + (insert "Content-type: text/html; charset=utf-8\n\n") + (apply #'funcall callback nil cbargs)))))))))) + (function-put 'eww 'browse-url-browser-kind 'internal) (defun eww--dwim-expand-url (url) @@ -416,11 +450,11 @@ killed after rendering." ;;;###autoload (defun eww-search-words () - "Search the web for the text between BEG and END. + "Search the web for the text in the region. If region is active (and not whitespace), search the web for -the text between BEG and END. Else, prompt the user for a search -string. See the `eww-search-prefix' variable for the search -engine used." +the text between region beginning and end. Else, prompt the +user for a search string. See the variable `eww-search-prefix' +for the search engine used." (interactive) (if (use-region-p) (let ((region-string (buffer-substring (region-beginning) (region-end)))) @@ -661,47 +695,83 @@ Currently this means either text/html or application/xhtml+xml." (eww-handle-link dom) (let ((start (point))) (shr-tag-a dom) - (put-text-property start (point) - 'keymap - (if (mm-images-in-region-p start (point)) - eww-image-link-keymap - eww-link-keymap)))) + (if (dom-attr dom 'href) + (put-text-property start (point) + 'keymap + (if (mm-images-in-region-p start (point)) + eww-image-link-keymap + eww-link-keymap))))) + +(defun eww--limit-string-pixelwise (string pixels) + (if (not pixels) + string + (with-temp-buffer + (insert string) + (if (< (eww--pixel-column) pixels) + string + ;; Iterate to find appropriate length. + (while (and (> (eww--pixel-column) pixels) + (not (bobp))) + (forward-char -1)) + ;; Return at least one character. + (buffer-substring (point-min) (max (point) + (1+ (point-min)))))))) + +(defun eww--pixel-column () + (if (not (get-buffer-window (current-buffer))) + (save-window-excursion + ;; Avoid errors if the selected window is a dedicated one, + ;; and they just want to insert a document into it. + (set-window-dedicated-p nil nil) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size nil (line-beginning-position) (point)))) + (car (window-text-pixel-size nil (line-beginning-position) (point))))) (defun eww-update-header-line-format () (setq header-line-format (and eww-header-line-format - (let ((title (plist-get eww-data :title)) - (peer (plist-get eww-data :peer)) - (url (plist-get eww-data :url))) - (when (zerop (length title)) - (setq title "[untitled]")) + (let ((peer (plist-get eww-data :peer)) + (url (plist-get eww-data :url)) + (title (propertize + (if (zerop (length (plist-get eww-data :title))) + "[untitled]" + (plist-get eww-data :title)) + 'face 'variable-pitch))) + ;; This connection is https. + (when peer + (add-face-text-property 0 (length title) + (if (plist-get peer :warnings) + 'eww-invalid-certificate + 'eww-valid-certificate) + t title)) ;; Limit the length of the title so that the host name ;; of the URL is always visible. (when url + (setq url (propertize url 'face 'variable-pitch)) (let* ((parsed (url-generic-parse-url url)) - (host-length (length (format "%s://%s" - (url-type parsed) - (url-host parsed)))) - (width (window-width))) + (host-length (shr-string-pixel-width + (propertize + (format "%s://%s" (url-type parsed) + (url-host parsed)) + 'face 'variable-pitch))) + (width (window-width nil t))) (cond ;; The host bit is wider than the window, so nix ;; the title. - ((> (+ host-length 5) width) + ((> (+ host-length (shr-string-pixel-width "xxxxx")) width) (setq title "")) ;; Trim the title. - ((> (+ (length title) host-length 2) width) - (setq title (concat - (substring title 0 (- width - host-length - 5)) - "...")))))) - ;; This connection has is https. - (when peer - (setq title - (propertize title 'face - (if (plist-get peer :warnings) - 'eww-invalid-certificate - 'eww-valid-certificate)))) + ((> (+ (shr-string-pixel-width (concat title "xx")) + host-length) + width) + (setq title + (concat + (eww--limit-string-pixelwise + title (- width host-length + (shr-string-pixel-width + (propertize "...: " 'face + 'variable-pitch)))) + (propertize "..." 'face 'variable-pitch))))))) (replace-regexp-in-string "%" "%%" (format-spec @@ -1085,7 +1155,7 @@ just re-display the HTML already fetched." (eww-display-html 'utf-8 url (plist-get eww-data :dom) (point) (current-buffer))) (let ((url-mime-accept-string eww-accept-content-types)) - (url-retrieve url #'eww-render + (eww-retrieve url #'eww-render (list url (point) (current-buffer) encode)))))) ;; Form support. @@ -1120,6 +1190,7 @@ just re-display the HTML already fetched." (define-key map [(control e)] 'eww-end-of-text) (define-key map [?\t] 'shr-next-link) (define-key map [?\M-\t] 'shr-previous-link) + (define-key map [backtab] 'shr-previous-link) map)) (defvar eww-textarea-map @@ -1129,11 +1200,14 @@ just re-display the HTML already fetched." (define-key map [(control c) (control c)] 'eww-submit) (define-key map [?\t] 'shr-next-link) (define-key map [?\M-\t] 'shr-previous-link) + (define-key map [backtab] 'shr-previous-link) map)) (defvar eww-select-map (let ((map (make-sparse-keymap))) (define-key map "\r" 'eww-change-select) + (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] 'eww-change-select) (define-key map [(control c) (control c)] 'eww-submit) map)) @@ -1436,26 +1510,30 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (setq display (plist-get (cdr elem) :display)))) display)) -(defun eww-change-select () +(defun eww--form-items (form) + (cl-loop for elem in form + when (and (consp elem) + (eq (car elem) 'item)) + collect (cdr elem))) + +(defun eww-change-select (event) "Change the value of the select drop-down menu under point." - (interactive) - (let* ((input (get-text-property (point) 'eww-form)) - (completion-ignore-case t) - (options - (delq nil - (mapcar (lambda (elem) - (and (consp elem) - (eq (car elem) 'item) - (cons (plist-get (cdr elem) :display) - (plist-get (cdr elem) :value)))) - input))) - (display (completing-read "Change value: " options nil 'require-match)) - (inhibit-read-only t)) - ;; If the user doesn't enter anything, don't change anything. - (when (> (length display) 0) - (plist-put input :value (cdr (assoc-string display options t))) - (goto-char - (eww-update-field display))))) + (interactive (list last-nonmenu-event)) + (mouse-set-point event) + (let ((input (get-text-property (point) 'eww-form))) + (popup-menu + (cons + "Change Value" + (mapcar + (lambda (elem) + (vector (plist-get elem :display) + (lambda () + (interactive) + (plist-put input :value (plist-get elem :value)) + (goto-char (eww-update-field (plist-get elem :display)))) + t)) + (eww--form-items input))) + event))) (defun eww-update-field (string &optional offset) (unless offset @@ -1559,7 +1637,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (cond ((member (plist-get input :type) '("checkbox" "radio")) (when (plist-get input :checked) - (push (cons name (plist-get input :value)) + (push (cons name (or (plist-get input :value) "on")) values))) ((equal (plist-get input :type) "file") (when-let ((file (plist-get input :filename))) diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index e713c94117b..8ad721964dd 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -348,8 +348,11 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." (t nil)))) (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))) - (when verify-hostname-error - (push :hostname verify-error)) + ;; Only add :hostname if `verify-error' is not t, since t + ;; means "include :hostname" Bug#38602. + (and verify-hostname-error + (not (eq verify-error t)) + (push :hostname verify-error)) `(:priority ,priority-string :hostname ,hostname diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index bfacc73a2a4..944cc6cef6c 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -1,4 +1,4 @@ -;;; hmac-def.el --- A macro for defining HMAC functions. +;;; hmac-def.el --- A macro for defining HMAC functions. -*- lexical-binding: t -*- ;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 700653250fb..5639d52f815 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -29,7 +29,7 @@ ;; `ldapsearch' to actually perform the searches. That program can be ;; found in all LDAP developer kits such as: ;; - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) -;; - OpenLDAP (http://www.openldap.org/) +;; - OpenLDAP (https://www.openldap.org/) ;;; Code: diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index f01a5deb7ec..94cd9e21566 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1133,11 +1133,15 @@ For instance, \"foo.png\" will result in \"image/png\"." `mailcap--computed-mime-data' determines the method to use." (let ((method (mailcap-mime-info type))) (if (stringp method) - (shell-command-on-region (point-min) (point-max) - ;; Use stdin as the "%s". - (format method "-") - (current-buffer) - t) + (let ((file (make-temp-file "emacs-mailcap" nil + (cadr (split-string type "/"))))) + (unwind-protect + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) file nil 'silent) + (delete-region (point-min) (point-max)) + (shell-command (format method file))) + (when (file-exists-p file) + (delete-file file)))) (funcall method)))) (provide 'mailcap) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index ef3651b0335..8c7d33a67d4 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -771,7 +771,7 @@ This command uses `smbclient-program' to connect to HOST." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Full list is available at: -;; http://www.iana.org/assignments/port-numbers +;; https://www.iana.org/assignments/port-numbers (defvar network-connection-service-alist (list (cons 'echo 7) diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index 3c7f243e801..01db97c29d4 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -1,4 +1,5 @@ -;;; netrc.el --- .netrc parsing functionality +;;; netrc.el --- .netrc parsing functionality -*- lexical-binding: t -*- + ;; Copyright (C) 1996-2020 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -40,8 +41,7 @@ (defcustom netrc-file "~/.authinfo" "File where user credentials are stored." :version "24.1" - :type 'file - :group 'netrc) + :type 'file) (defvar netrc-services-file "/etc/services" "The name of the services file.") diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index b8f1bccd788..f45abf780f7 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -68,9 +68,6 @@ considered to be running if the newsticker timer list is not empty." ;; Hard-coding URLs like this is a recipe for propagating obsolete info. (defconst newsticker--raw-url-list-defaults '( - ;; 2017/12: no response. -;;; ("CNET News.com" -;;; "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml") ("Debian Security Advisories" "http://www.debian.org/security/dsa.en.rdf") ("Debian Security Advisories - Long format" @@ -81,11 +78,6 @@ considered to be running if the newsticker timer list is not empty." 3600) ("LWN (Linux Weekly News)" "https://lwn.net/headlines/rss") - ;; Not updated since 2010. -;;; ("NY Times: Technology" -;;; "http://www.nytimes.com/services/xml/rss/userland/Technology.xml") -;;; ("NY Times" -;;; "http://www.nytimes.com/services/xml/rss/userland/HomePage.xml") ("Quote of the day" "http://feeds.feedburner.com/quotationspage/qotd" "07:00" @@ -898,7 +890,7 @@ Argument BUFFER is the buffer of the retrieval process." ;; Atom 1.0 feed. ;; (and (eq 'feed (xml-node-name topnode)) - ;; (string= "http://www.w3.org/2005/Atom" + ;; (string= "https://www.w3.org/2005/Atom" ;; (xml-get-attribute topnode 'xmlns))) (setq image-url (newsticker--get-logo-url-atom-1.0 topnode)) (setq icon-url (newsticker--get-icon-url-atom-1.0 topnode)) diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 6329e7660f7..535122a31fb 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -54,7 +54,7 @@ ;; as well as the following Atom formats: ;; * Atom 0.3 ;; * Atom 1.0 -;; (see http://www.ietf.org/internet-drafts/draft-ietf-atompub-format-11.txt) +;; (see https://www.ietf.org/internet-drafts/draft-ietf-atompub-format-11.txt) ;; That makes Newsticker.el an "Atom aggregator, "RSS reader", "RSS ;; aggregator", and "Feed Reader". diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index cc22427e6d1..2b300401650 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -164,7 +164,7 @@ STATUS SETTINGS. HOST is the host domain, PORT is a TCP port number, STATUS is the peer status returned by `gnutls-peer-status', and SETTINGS is the persistent and session settings for the host HOST. Please refer to the contents of -`nsm-setting-file' for details. If a problem is found, the check +`nsm-settings-file' for details. If a problem is found, the check function is required to return an error message, and nil otherwise. diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 9401430799c..6d1cf2da71f 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -132,23 +132,89 @@ is not given." domain ;buffer field )))) +;; Poor man's bignums: natural numbers represented as lists of bytes +;; in little-endian order. +;; When this code no longer needs to run on Emacs 26 or older, all this +;; silliness should be simplified to use ordinary Lisp integers. + +(eval-and-compile ; for compile-time simplification + (defun ntlm--bignat-of-int (x) + "Convert the natural number X into a bignat." + (declare (pure t)) + (and (not (zerop x)) + (cons (logand x #xff) (ntlm--bignat-of-int (ash x -8))))) + + (defun ntlm--bignat-add (a b &optional carry) + "Add the bignats A and B and the natural number CARRY." + (declare (pure t)) + (and (or a b (and carry (not (zerop carry)))) + (let ((s (+ (if a (car a) 0) + (if b (car b) 0) + (or carry 0)))) + (cons (logand s #xff) + (ntlm--bignat-add (cdr a) (cdr b) (ash s -8)))))) + + (defun ntlm--bignat-shift-left (x n) + "Multiply the bignat X by 2^{8N}." + (declare (pure t)) + (if (zerop n) x (ntlm--bignat-shift-left (cons 0 x) (1- n)))) + + (defun ntlm--bignat-mul-byte (a b) + "Multiply the bignat A with the byte B." + (declare (pure t)) + (let ((p (mapcar (lambda (x) (* x b)) a))) + (ntlm--bignat-add + (mapcar (lambda (x) (logand x #xff)) p) + (cons 0 (mapcar (lambda (x) (ash x -8)) p))))) + + (defun ntlm--bignat-mul (a b) + "Multiply the bignats A and B." + (declare (pure t)) + (and a b (ntlm--bignat-add (ntlm--bignat-mul-byte a (car b)) + (cons 0 (ntlm--bignat-mul a (cdr b)))))) + + (defun ntlm--bignat-of-string (s) + "Convert the string S (in decimal) to a bignat." + (declare (pure t)) + (ntlm--bignat-of-digits (reverse (string-to-list s)))) + + (defun ntlm--bignat-of-digits (digits) + "Convert the little-endian list DIGITS of decimal digits to a bignat." + (declare (pure t)) + (and digits + (ntlm--bignat-add + nil + (ntlm--bignat-mul-byte (ntlm--bignat-of-digits (cdr digits)) 10) + (- (car digits) ?0)))) + + (defun ntlm--bignat-to-int64 (x) + "Convert the bignat X to a 64-bit little-endian number as a string." + (declare (pure t)) + (apply #'unibyte-string (mapcar (lambda (n) (or (nth n x) 0)) + (number-sequence 0 7)))) + ) + (defun ntlm--time-to-timestamp (time) "Convert TIME to an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a microsecond since January 1, 1601 as a 64-bit little-endian signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." - (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time))) - (us (nth 2 time)) - (ps (nth 3 time)) + (let* ((s-hi (ntlm--bignat-of-int (nth 0 time))) + (s-lo (ntlm--bignat-of-int (nth 1 time))) + (s (ntlm--bignat-add (ntlm--bignat-shift-left s-hi 2) s-lo)) + (us*10 (ntlm--bignat-of-int (* (nth 2 time) 10))) + (ps/1e5 (ntlm--bignat-of-int (/ (nth 3 time) 100000))) + ;; tenths of microseconds between 1601-01-01 and 1970-01-01 + (to-unix-epoch (ntlm--bignat-of-string "116444736000000000")) (tenths-of-us-since-jan-1-1601 - (+ (* s 10000000) (* us 10) (/ ps 100000) - ;; tenths of microseconds between 1601-01-01 and 1970-01-01 - 116444736000000000))) - (apply #'unibyte-string - (mapcar (lambda (i) - (logand (ash tenths-of-us-since-jan-1-1601 (* i -8)) - #xff)) - (number-sequence 0 7))))) + (ntlm--bignat-add + (ntlm--bignat-add + (ntlm--bignat-add + (ntlm--bignat-mul s (ntlm--bignat-of-int 10000000)) + us*10) + ps/1e5) + to-unix-epoch))) + (ntlm--bignat-to-int64 tenths-of-us-since-jan-1-1601))) (defun ntlm-compute-timestamp () "Current time as an NTLMv2 timestamp, as a unibyte string." diff --git a/lisp/net/puny.el b/lisp/net/puny.el index cc406076c58..5c58fe02cbf 100644 --- a/lisp/net/puny.el +++ b/lisp/net/puny.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; Written by looking at -;; http://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion +;; https://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion ;;; Code: @@ -196,12 +196,12 @@ For instance \"xn--bcher-kva\" => \"bücher\"." (cl-incf i))) (buffer-string))) -;; http://www.unicode.org/reports/tr39/#Restriction_Level_Detection -;; http://www.unicode.org/reports/tr31/#Table_Candidate_Characters_for_Inclusion_in_Identifiers +;; https://www.unicode.org/reports/tr39/#Restriction_Level_Detection +;; https://www.unicode.org/reports/tr31/#Table_Candidate_Characters_for_Inclusion_in_Identifiers (defun puny-highly-restrictive-string-p (string) "Say whether STRING is \"highly restrictive\" in the Unicode IDNA sense. -See http://www.unicode.org/reports/tr39/#Restriction_Level_Detection +See https://www.unicode.org/reports/tr39/#Restriction_Level_Detection for details. The main idea is that if you're mixing scripts (like latin and cyrillic), you may confuse the user by using homographs." diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index f296ae3afe1..63e6eedb200 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -56,7 +56,7 @@ :group 'applications) (defcustom rcirc-server-alist - '(("irc.freenode.net" :channels ("#rcirc") + '(("chat.freenode.net" :channels ("#rcirc") ;; Don't use the TLS port by default, in case gnutls is not available. ;; :port 7000 :encryption tls )) diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el index ec5b53ee917..6882c23d789 100644 --- a/lisp/net/sasl-ntlm.el +++ b/lisp/net/sasl-ntlm.el @@ -4,7 +4,7 @@ ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; Keywords: SASL, NTLM -;; Version: 1.00 +;; Old-Version: 1.00 ;; Created: February 2001 ;; Package: sasl diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index 10d061fba20..dc1b468a118 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; This package provides an implementation of the Secret Service API -;; <http://www.freedesktop.org/wiki/Specifications/secret-storage-spec>. +;; <https://www.freedesktop.org/wiki/Specifications/secret-storage-spec>. ;; This API is meant to make GNOME-Keyring- and KWallet-like daemons ;; available under a common D-BUS interface and thus increase ;; interoperability between GNOME, KDE and other applications having diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 6517596130c..2e5dd5ffa50 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -146,6 +146,14 @@ same domain as the main data." :version "24.4" :type 'boolean) +(defcustom shr-offer-extend-specpdl t + "Non-nil means offer to extend the specpdl if the HTML nests deeply. +Complicated HTML can require more nesting than the current specpdl +size permits. If this variable is t, ask the user whether to increase +the specpdl size. If nil, just give up." + :version "28.1" + :type 'boolean) + (defvar shr-content-function nil "If bound, this should be a function that will return the content. This is used for cid: URLs, and the function is called with the @@ -527,7 +535,8 @@ size, and full-buffer size." (start (point))) ;; shr uses many frames per nested node. (if (and (> shr-depth (/ max-specpdl-size 15)) - (not (and (y-or-n-p "Too deeply nested to render properly; increase `max-specpdl-size'?") + (not (and shr-offer-extend-specpdl + (y-or-n-p "Too deeply nested to render properly; increase `max-specpdl-size'?") (setq max-specpdl-size (* max-specpdl-size 2))))) (setq shr-warning "Not rendering the complete page because of too-deep nesting") @@ -555,7 +564,10 @@ size, and full-buffer size." ;; If the element was empty, we don't have anything to put the ;; anchor on. So just insert a dummy character. (when (= start (point)) - (insert ?*) + (if (not (bolp)) + (insert ? ) + (insert ? ) + (shr-mark-fill start)) (put-text-property (1- (point)) (point) 'display "")) (put-text-property start (1+ start) 'shr-target-id id)) ;; If style is set, then this node has set the color. @@ -675,8 +687,11 @@ size, and full-buffer size." (goto-char start) (when (looking-at "[ \t\n\r]+") (replace-match "" t t)) - (while (re-search-forward "[ \t\n\r]+" nil t) + (while (re-search-forward "[\t\n\r]+" nil t) (replace-match " " t t)) + (goto-char start) + (while (re-search-forward " +" nil t) + (replace-match " " t t)) (shr--translate-insertion-chars) (goto-char (point-max))) ;; We may have removed everything we inserted if it was just @@ -714,7 +729,8 @@ size, and full-buffer size." (forward-char 1)))) (defun shr-fill-line () - (let ((shr-indentation (get-text-property (point) 'shr-indentation)) + (let ((shr-indentation (or (get-text-property (point) 'shr-indentation) + shr-indentation)) (continuation (get-text-property (point) 'shr-continuation-indentation)) start) @@ -932,6 +948,22 @@ size, and full-buffer size." (looking-at " *$"))) ;; We're already at a new paragraph; do nothing. ) + ((and (not (bolp)) + (save-excursion + (beginning-of-line) + (looking-at " *$")) + (save-excursion + (forward-line -1) + (looking-at " *$")) + ;; Check all chars on the current line and see whether + ;; they're all placeholders. + (cl-loop for pos from (line-beginning-position) upto (1- (point)) + unless (get-text-property pos 'shr-target-id) + return nil + finally return t)) + ;; We have some invisible markers from <div id="foo"></div>; + ;; do nothing. + ) ((and prefix (= prefix (- (point) (line-beginning-position)))) ;; Do nothing; we're at the start of a <li>. diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index d6dc008e87a..7475a7b59d5 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -1,4 +1,4 @@ -;;; sieve-mode.el --- Sieve code editing commands for Emacs +;;; sieve-mode.el --- Sieve code editing commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index 441e6b14f7b..76d9ced58a6 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -24,9 +24,7 @@ ;; INTRODUCTION ;; ------------ -;; This package provides a major mode for editing SNMP MIBs. It -;; provides all the modern Emacs 19 bells and whistles: default -;; fontification via font-lock, imenu search functions, etc. +;; This package provides a major mode for editing SNMP MIBs. ;; ;; SNMP mode also uses tempo, a textual boilerplate insertion package ;; distributed with Emacs, to add in boilerplate SNMP MIB structures. diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 7425e8763fb..241ce9efcb3 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -5,7 +5,7 @@ ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Created: December, 2009 -;; Version: 3.1.5 +;; Version: 3.2.0 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client @@ -551,30 +551,77 @@ This is a specialization of `soap-encode-value' for (soap-validate-xs-basic-type value-string type) (insert value-string))))) -;; Inspired by rng-xsd-convert-date-time. -(defun soap-decode-date-time (date-time-string datatype) +(defun soap-decode-date-time (date-time-string &optional datatype) "Decode DATE-TIME-STRING as DATATYPE. DATE-TIME-STRING should be in ISO 8601 basic or extended format. -DATATYPE is one of dateTime, time, date, gYearMonth, gYear, -gMonthDay, gDay or gMonth. - -Return a list in a format (SEC MINUTE HOUR DAY MONTH YEAR -SEC-FRACTION DATATYPE ZONE). This format is meant to be similar -to that returned by `decode-time' (and compatible with -`encode-time'). The differences are the SEC (seconds) -field is always an integer, the DOW (day-of-week) field -is replaced with SEC-FRACTION, a float representing the -fractional seconds, and the DST (daylight savings time) field is -replaced with DATATYPE, a symbol representing the XSD primitive -datatype. This symbol can be used to determine which fields -apply and which don't when it's not already clear from context. -For example a datatype of `time' means the year, month and day +DATATYPE can be omitted, or one of the symbols dateTime, time, +date, gYearMonth, gYear, gMonthDay, gDay, or gMonth. If Emacs is +a version that supports fractional seconds, DATATYPE can also be +dateTime-subsecond, or time-subsecond. On older versions of +Emacs (prior to 27.1), which do not support fractional seconds, +leaving DATATYPE nil means that subseconds in DATE-TIME-STRING +will be ignored. + +Return a list in a format identical or similar to that returned +by `decode-time'. The returned format is always compatible with +`encode-time'. If DATATYPE is omitted or nil, this function will +return a list that has exactly the same format as that returned +by `decode-time'. + +Note that on versions of Emacs that predate support for +fractional seconds, `encode-time' will not notice the SUBSECOND +field so it must be handled specially. + +The formats returned by this function are as follows, where _ +means \"should be ignored\": + + DATATYPE | Return format +------------+---------------------------------------------------------------- + nil | (SECOND MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF) + dateTime | (SECOND MINUTE HOUR DAY MONTH YEAR SUBSECOND dateTime UTCOFF) + time | (SECOND MINUTE HOUR _ _ _ SUBSECOND time _) + date | (_ _ _ DAY MONTH YEAR _ date _) + gYearMonth | (_ _ _ _ MONTH YEAR _ gYearMonth _) + gYear | (_ _ _ _ _ YEAR _ gYear _) + gMonthDay | (_ _ _ DAY MONTH _ _ gMonthDay _) + gDay | (_ _ _ DAY _ _ _ gDay _) + gMonth | (_ _ _ _ MONTH _ _ gMonth _) + +When DATATYPE is dateTime or time, the DOW (day-of-week) field is +replaced with SUBSECOND, a float representing the fractional +seconds, and the DST (daylight savings time) field is replaced +with DATATYPE, a symbol representing the XSD primitive datatype. +This symbol can be used to determine which fields apply and which +do not, when it is not already clear from context. For example a +datatype of `time' means the year, month, day and time zone fields should be ignored. -This function will throw an error if DATE-TIME-STRING represents -a leap second, since the XML Schema 1.1 standard explicitly -disallows them." - (let* ((datetime-regexp (cadr (get datatype 'rng-xsd-convert))) +New code that depends on Emacs 27.1 or newer anyway, and that +wants dateTime or time but with the first argument with subsecond +resolution, i.e., (TICKS . HZ), can set DATATYPE to +dateTime-subsecond or time-subsecond respectively. This function +throws an error if dateTime-subsecond or time-subsecond is +specified when Emacs does not support subsecond resolution. + +This function throws an error if DATE-TIME-STRING represents a +leap second, since the XML Schema 1.1 standard does not support +representing leap seconds." + (let* ((new-decode-time (condition-case nil + (not (null + (with-no-warnings (decode-time nil nil t)))) + (wrong-number-of-arguments))) + (new-decode-time-second nil) + (no-support "This Emacs version does not support %s") + (datetime-regexp-type + (cl-case datatype + ((dateTime-subsecond time-subsecond) + (if new-decode-time + (intern (replace-regexp-in-string + "-subsecond" "" (symbol-name datatype))) + (error (format no-support (symbol-name datatype))))) + ((nil) 'dateTime) + (otherwise datatype))) + (datetime-regexp (cadr (get datetime-regexp-type 'rng-xsd-convert))) (year-sign (progn (string-match datetime-regexp date-time-string) (match-string 1 date-time-string))) @@ -585,6 +632,7 @@ disallows them." (minute (match-string 6 date-time-string)) (second (match-string 7 date-time-string)) (second-fraction (match-string 8 date-time-string)) + (time-zone nil) (has-time-zone (match-string 9 date-time-string)) (time-zone-sign (match-string 10 date-time-string)) (time-zone-hour (match-string 11 date-time-string)) @@ -605,11 +653,28 @@ disallows them." (if hour (string-to-number hour) 0)) (setq minute (if minute (string-to-number minute) 0)) + (when new-decode-time + (setq new-decode-time-second + (if second + (if second-fraction + (let* ((second-fraction-significand + (replace-regexp-in-string "\\." "" second-fraction)) + (hertz + (expt 10 (length second-fraction-significand))) + (ticks (+ (* hertz (string-to-number second)) + (string-to-number + second-fraction-significand)))) + (cons ticks hertz)) + (cons second 1))))) (setq second (if second (string-to-number second) 0)) (setq second-fraction (if second-fraction - (float (string-to-number second-fraction)) + (progn + (when (and (not datatype) (not new-decode-time)) + (message + "soap-decode-date-time: Discarding fractional seconds")) + (float (string-to-number second-fraction))) 0.0)) (setq has-time-zone (and has-time-zone t)) (setq time-zone-sign @@ -618,6 +683,14 @@ disallows them." (if time-zone-hour (string-to-number time-zone-hour) 0)) (setq time-zone-minute (if time-zone-minute (string-to-number time-zone-minute) 0)) + (setq time-zone (if has-time-zone + (* (rng-xsd-time-to-seconds + time-zone-hour + time-zone-minute + 0) + time-zone-sign) + ;; UTC. + 0)) (unless (and ;; XSD does not allow year 0. (> year 0) @@ -635,18 +708,22 @@ disallows them." (>= time-zone-minute 0) (<= time-zone-minute 59)) (error "Invalid or unsupported time: %s" date-time-string)) - ;; Return a value in a format similar to that returned by decode-time, and - ;; suitable for (apply #'encode-time ...). - ;; FIXME: Nobody uses this idiosyncratic value. Perhaps stop returning it? - (list second minute hour day month year second-fraction datatype - (if has-time-zone - (* (rng-xsd-time-to-seconds - time-zone-hour - time-zone-minute - 0) - time-zone-sign) - ;; UTC. - 0)))) + ;; Return a value in a format identical or similar to that + ;; returned by decode-time, and always suitable for (apply + ;; #'encode-time ...). + (if datatype + (list (if (memq datatype '(dateTime-subsecond time-subsecond)) + new-decode-time-second + second) + minute hour day month year second-fraction datatype time-zone) + (let ((time + (apply + #'encode-time (list + (if new-decode-time new-decode-time-second second) + minute hour day month year nil nil time-zone)))) + (if new-decode-time + (with-no-warnings (decode-time time nil t)) + (decode-time time)))))) (defun soap-decode-xs-basic-type (type node) "Use TYPE, a `soap-xs-basic-type', to decode the contents of NODE. @@ -1716,6 +1793,7 @@ This is a specialization of `soap-encode-value' for ((and (not (eq indicator 'choice)) (= instance-count 0) (not (soap-xs-element-optional? element)) + (not (soap-xs-complex-type-optional? type)) (and (soap-xs-complex-type-p element-type) (not (soap-xs-complex-type-optional-p element-type)))) @@ -2000,7 +2078,7 @@ This is a specialization of `soap-decode-type' for soap-headers ; list of (message part use) soap-body ; message parts present in the body use ; 'literal or 'encoded, see - ; http://www.w3.org/TR/wsdl#_soap:body + ; https://www.w3.org/TR/wsdl#_soap:body ) (cl-defstruct (soap-binding (:include soap-element)) @@ -2033,6 +2111,8 @@ This is a specialization of `soap-decode-type' for ;; Add the XSD types to the wsdl document (let ((ns (soap-make-xs-basic-types + ;; The following string is a name and not an URL, so + ;; the "http:" should not be changed. "http://www.w3.org/2001/XMLSchema" "xsd"))) (soap-wsdl-add-namespace ns wsdl) (soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl)) @@ -2918,8 +2998,6 @@ reference multiRef parts which are external to RESPONSE-NODE." ;;;; SOAP type encoding -;; FIXME: Use `cl-defmethod' (but this requires Emacs-25). - (defun soap-encode-attributes (value type) "Encode XML attributes for VALUE according to TYPE. This is a generic function which determines the attribute encoder @@ -3027,7 +3105,7 @@ SERVICE-URL should be provided when WS-Addressing is being used." (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<soap:Envelope\n") (when (eq use 'encoded) (insert " soapenc:encodingStyle=\"\ -https://schemas.xmlsoap.org/soap/encoding/\"\n")) +http://schemas.xmlsoap.org/soap/encoding/\"\n")) (dolist (nstag soap-encoded-namespaces) (insert " xmlns:" nstag "=\"") (let ((nsname (cdr (assoc nstag soap-well-known-xmlns)))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 49ecaa58ee8..3d3b955e8c2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -437,27 +437,25 @@ Emacs dired can't find files." (and parents (file-directory-p dir))) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) -(defun tramp-adb-handle-delete-directory (directory &optional recursive _trash) +(defun tramp-adb-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (expand-file-name directory)) - (with-parsed-tramp-file-name (file-truename directory) nil - (tramp-flush-directory-properties v localname)) - (with-parsed-tramp-file-name directory nil - (tramp-flush-directory-properties v localname) + (tramp-skeleton-delete-directory directory recursive trash (tramp-adb-barf-unless-okay v (format "%s %s" (if recursive "rm -r" "rmdir") (tramp-shell-quote-argument localname)) "Couldn't delete %s" directory))) -(defun tramp-adb-handle-delete-file (filename &optional _trash) +(defun tramp-adb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-adb-barf-unless-okay - v (format "rm %s" (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename))) + (if (and delete-by-moving-to-trash trash) + (move-file-to-trash filename) + (tramp-adb-barf-unless-okay + v (format "rm %s" (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename)))) (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 9502cc35300..931a9717310 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -163,7 +163,7 @@ "List of suffixes which indicate a file archive. It must be supported by libarchive(3).") -;; <http://unix-memo.readthedocs.io/en/latest/vfs.html> +;; <https://unix-memo.readthedocs.io/en/latest/vfs.html> ;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress. ;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 218594b551c..c554a8d0c2d 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -45,6 +45,14 @@ (declare-function tramp-handle-temporary-file-directory "tramp") (defvar tramp-temp-name-prefix) +(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version) + "The Emacs version used for compilation.") + +(unless (= emacs-major-version + (car (version-to-list tramp-compat-emacs-compiled-version))) + (warn "Tramp has been compiled with Emacs %s, this is Emacs %s" + tramp-compat-emacs-compiled-version emacs-version)) + ;; For not existing functions, obsolete functions, or functions with a ;; changed argument list, there are compiler warnings. We want to ;; avoid them in cases we know what we do. diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index c9788fcff52..286b60a48c2 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -120,7 +120,7 @@ initializing a new crypted remote directory." "Whether to keep the encfs configuration file in the crypted remote directory." :group 'tramp :version "28.1" - :type 'booleanp) + :type 'boolean) ;;;###tramp-autoload (defvar tramp-crypt-directories nil @@ -651,21 +651,22 @@ absolute file names." (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)))) +;; Crypted files won't be trashed. (defun tramp-crypt-handle-delete-directory - (directory &optional recursive trash) + (directory &optional recursive _trash) "Like `delete-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name directory) nil (tramp-flush-directory-properties v localname) (let (tramp-crypt-enabled) - (delete-directory - (tramp-crypt-encrypt-file-name directory) recursive trash)))) + (delete-directory (tramp-crypt-encrypt-file-name directory) recursive)))) -(defun tramp-crypt-handle-delete-file (filename &optional trash) +;; Crypted files won't be trashed. +(defun tramp-crypt-handle-delete-file (filename &optional _trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-flush-file-properties v localname) (let (tramp-crypt-enabled) - (delete-file (tramp-crypt-encrypt-file-name filename) trash)))) + (delete-file (tramp-crypt-encrypt-file-name filename))))) (defun tramp-crypt-handle-directory-files (directory &optional full match nosort) "Like `directory-files' for Tramp files." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 6467d8f88b4..bf55777e335 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -691,8 +691,7 @@ It has been changed in GVFS 1.14.") ("gvfs-move" . "move") ("gvfs-rename" . "rename") ("gvfs-rm" . "remove") - ("gvfs-set-attribute" . "set") - ("gvfs-trash" . "trash")) + ("gvfs-set-attribute" . "set")) "List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".") ;; <http://www.pygtk.org/docs/pygobject/gio-constants.html> @@ -1080,24 +1079,21 @@ file names." (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (with-parsed-tramp-file-name directory nil + (tramp-skeleton-delete-directory directory recursive trash (if (and recursive (not (file-symlink-p directory))) (mapc (lambda (file) (if (eq t (tramp-compat-file-attribute-type (file-attributes file))) - (delete-directory file recursive trash) - (delete-file file trash))) + (delete-directory file recursive) + (delete-file file))) (directory-files directory 'full directory-files-no-dot-files-regexp)) (when (directory-files directory nil directory-files-no-dot-files-regexp) (tramp-error v 'file-error "Couldn't delete non-empty %s" directory))) - (tramp-flush-directory-properties v localname) - (unless - (tramp-gvfs-send-command - v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm") - (tramp-gvfs-url-file-name directory)) + (unless (tramp-gvfs-send-command + v "gvfs-rm" (tramp-gvfs-url-file-name directory)) ;; Propagate the error. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) @@ -1108,15 +1104,15 @@ file names." "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (unless - (tramp-gvfs-send-command - v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm") - (tramp-gvfs-url-file-name filename)) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error "Couldn't delete %s" filename))))) + (if (and delete-by-moving-to-trash trash) + (move-file-to-trash filename) + (unless (tramp-gvfs-send-command + v "gvfs-rm" (tramp-gvfs-url-file-name filename)) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error "Couldn't delete %s" filename)))))) (defun tramp-gvfs-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7a3f3fe8f02..860641b2589 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -118,7 +118,9 @@ detected as prompt when being sent on echoing hosts, therefore.") ;;;###tramp-autoload (defcustom tramp-use-ssh-controlmaster-options t - "Whether to use `tramp-ssh-controlmaster-options'." + "Whether to use `tramp-ssh-controlmaster-options'. +Set it to nil, if you use Control* or Proxy* options in your ssh +configuration." :group 'tramp :version "24.4" :type 'boolean) @@ -478,7 +480,7 @@ The string is used in `tramp-methods'.") ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin ;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin -;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! +;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! ;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin ;; QNAP QTS: --- @@ -754,7 +756,7 @@ for($i = 0; $i < $n; $i++) $stat[1]); } printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null" - "Perl script implementing `directory-files-attributes' as Lisp `read'able + "Perl script implementing `directory-files-and-attributes' as Lisp `read'able output. Escape sequence %s is replaced with name of Perl binary. This string is passed to `format', so percent characters need to be doubled.") @@ -2521,13 +2523,10 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (expand-file-name directory)) - (with-parsed-tramp-file-name directory nil - (tramp-flush-directory-properties v localname) + (tramp-skeleton-delete-directory directory recursive trash (tramp-barf-unless-okay v (format "cd / && %s %s" - (or (and trash (tramp-get-remote-trash v)) - (if recursive "rm -rf" "rmdir")) + (if recursive "rm -rf" "rmdir") (tramp-shell-quote-argument localname)) "Couldn't delete %s" directory))) @@ -2536,11 +2535,11 @@ The method used must be an out-of-band method." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-barf-unless-okay - v (format "%s %s" - (or (and trash (tramp-get-remote-trash v)) "rm -f") - (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename))) + (if (and delete-by-moving-to-trash trash) + (move-file-to-trash filename) + (tramp-barf-unless-okay + v (format "rm -f %s" (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename)))) ;; Dired. @@ -2807,7 +2806,7 @@ implementation will be used." (signal 'wrong-type-argument (list #'stringp name))) (unless (or (null buffer) (bufferp buffer) (stringp buffer)) (signal 'wrong-type-argument (list #'stringp buffer))) - (unless (consp command) + (unless (or (null command) (consp command)) (signal 'wrong-type-argument (list #'consp command))) (unless (or (null coding) (and (symbolp coding) (memq coding coding-system-list)) @@ -2848,8 +2847,10 @@ implementation will be used." ;; command. (heredoc (and (stringp program) (string-match-p "sh$" program) + (= (length args) 2) (string-equal "-c" (car args)) - (= (length args) 2))) + ;; Don't if there is a string. + (not (string-match-p "'\\|\"" (cadr args))))) ;; When PROGRAM is nil, we just provide a tty. (args (if (not heredoc) args (let ((i 250)) @@ -4384,7 +4385,7 @@ process to set up. VEC specifies the connection." (t (tramp-message vec 5 "Checking remote host type for `send-process-string' bug") - (if (string-match-p "^FreeBSD" uname) 500 0)))) + (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0)))) ;; Set remote PATH variable. (tramp-set-remote-path vec) @@ -4406,12 +4407,12 @@ process to set up. VEC specifies the connection." ;; IRIX64 bash expands "!" even when in single quotes. This ;; destroys our shell functions, we must disable it. See - ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. + ;; <https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. (when (string-match-p "^IRIX64" uname) (tramp-send-command vec "set +H" t)) ;; Disable tab expansion. - (if (string-match-p "BSD\\|Darwin" uname) + (if (string-match-p "BSD\\|DragonFly\\|Darwin" uname) (tramp-send-command vec "stty tabs" t) (tramp-send-command vec "stty tab0" t)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 1b6af2a2e33..c236e1cb65f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -635,41 +635,39 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (file-attributes filename)) (unless ok-if-already-exists 'nofollow))))) -(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash) +(defun tramp-smb-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (directory-file-name (expand-file-name directory))) - (when (file-exists-p directory) - (when recursive - (mapc - (lambda (file) - (if (file-directory-p file) - (delete-directory file recursive) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files directory 'full directory-files-no-dot-files-regexp))) - - (with-parsed-tramp-file-name directory nil + (tramp-skeleton-delete-directory directory recursive trash + (when (file-exists-p directory) + (when recursive + (mapc + (lambda (file) + (if (file-directory-p file) + (delete-directory file recursive) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files directory 'full directory-files-no-dot-files-regexp))) + ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-directory-properties v localname) (unless (tramp-smb-send-command v (format "%s \"%s\"" - (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir") + (if (tramp-smb-get-cifs-capabilities v) + "posix_rmdir" "rmdir") (tramp-smb-get-localname v))) ;; Error. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (search-forward-regexp tramp-smb-errors nil t) - (tramp-error - v 'file-error "%s `%s'" (match-string 0) directory))) + (tramp-error v 'file-error "%s `%s'" (match-string 0) directory))) ;; "rmdir" does not report an error. So we check ourselves. (when (file-exists-p directory) - (tramp-error - v 'file-error "`%s' not removed." directory))))) + (tramp-error v 'file-error "`%s' not removed." directory))))) -(defun tramp-smb-handle-delete-file (filename &optional _trash) +(defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (setq filename (expand-file-name filename)) (when (file-exists-p filename) @@ -677,17 +675,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-properties v localname) - (unless (tramp-smb-send-command - v (format - "%s \"%s\"" - (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") - (tramp-smb-get-localname v))) - ;; Error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-errors nil t) - (tramp-error - v 'file-error "%s `%s'" (match-string 0) filename)))))) + (if (and delete-by-moving-to-trash trash) + (move-file-to-trash filename) + (unless (tramp-smb-send-command + v (format + "%s \"%s\"" + (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") + (tramp-smb-get-localname v))) + ;; Error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (search-forward-regexp tramp-smb-errors nil t) + (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))))))) (defun tramp-smb-handle-directory-files (directory &optional full match nosort) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 98727dc4a87..558a57b2ead 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -321,29 +321,25 @@ absolute file names." (defun tramp-sudoedit-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (expand-file-name directory)) - (with-parsed-tramp-file-name directory nil - (tramp-flush-directory-properties v localname) - (unless - (tramp-sudoedit-send-command - v (or (and trash "trash") - (if recursive '("rm" "-rf") "rmdir")) - (tramp-compat-file-name-unquote localname)) + (tramp-skeleton-delete-directory directory recursive trash + (unless (tramp-sudoedit-send-command + v (if recursive '("rm" "-rf") "rmdir") + (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Couldn't delete %s" directory)))) (defun tramp-sudoedit-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (unless - (tramp-sudoedit-send-command - v (if (and trash delete-by-moving-to-trash) "trash" "rm") - (tramp-compat-file-name-unquote localname)) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error "Couldn't delete %s" filename))))) + (if (and delete-by-moving-to-trash trash) + (move-file-to-trash filename) + (unless (tramp-sudoedit-send-command + v "rm" (tramp-compat-file-name-unquote localname)) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error "Couldn't delete %s" filename)))))) (defun tramp-sudoedit-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 96446399dd6..f3966479dbf 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -584,6 +584,11 @@ This regexp must match both `tramp-initial-end-of-output' and "Regexp matching password-like prompts. The regexp should match at end of buffer. +This variable is, by default, initialised from +`password-word-equivalents' when Tramp is loaded, and it is +usually more convenient to add new passphrases to that variable +instead of altering this variable. + The `sudo' program appears to insert a `^@' character into the prompt." :version "24.4" :type 'regexp) @@ -1230,6 +1235,8 @@ have been gone since last remote command execution. A value of t would require an immediate reread during filename completion, nil means to use always cached values for the directory contents." :type '(choice (const nil) (const t) integer)) +(make-obsolete-variable + 'tramp-completion-reread-directory-timeout 'remote-file-name-inhibit-cache "27.2") ;;; Internal Variables: @@ -1292,7 +1299,7 @@ If nil, return `tramp-default-port'." (or (tramp-file-name-port vec) (tramp-get-method-parameter vec 'tramp-default-port))) -;; Comparision of file names is performed by `tramp-equal-remote'. +;; Comparison of file names is performed by `tramp-equal-remote'. (defun tramp-file-name-equal-p (vec1 vec2) "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'." (and (tramp-file-name-p vec1) (tramp-file-name-p vec2) @@ -3857,7 +3864,7 @@ It does not support `:stderr'." p)))))) (defun tramp-handle-make-symbolic-link - (target linkname &optional ok-if-already-exists) + (target linkname &optional ok-if-already-exists) "Like `make-symbolic-link' for Tramp files. This is the fallback implementation for backends which do not support symbolic links." @@ -3870,8 +3877,7 @@ support symbolic links." (tramp-run-real-handler #'make-symbolic-link (list target linkname ok-if-already-exists)))) -(defun tramp-handle-shell-command - (command &optional output-buffer error-buffer) +(defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) (command (substring command 0 asynchronous)) @@ -4634,7 +4640,7 @@ If it doesn't exist, generate a new one." (with-tramp-connection-property (tramp-get-connection-process vec) "device" (cons -1 (setq tramp-devices (1+ tramp-devices))))) -;; Comparision of vectors is performed by `tramp-file-name-equal-p'. +;; Comparison of vectors is performed by `tramp-file-name-equal-p'. (defun tramp-equal-remote (file1 file2) "Check, whether the remote parts of FILE1 and FILE2 are identical. The check depends on method, user and host name of the files. If @@ -4655,6 +4661,7 @@ If both files are local, the function returns t." (and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2) (string-equal (file-remote-p file1) (file-remote-p file2))))) +;; See also `file-modes-symbolic-to-number'. (defun tramp-mode-string-to-int (mode-string) "Convert a ten-letter \"drwxrwxrwx\"-style MODE-STRING into mode bits." (let* (case-fold-search @@ -4734,6 +4741,7 @@ If both files are local, the function returns t." "A list of file types returned from the `stat' system call. This is used to map a mode number to a permission string.") +;; See also `file-modes-number-to-symbolic'. (defun tramp-file-mode-from-int (mode) "Turn an integer representing a file MODE into an ls(1)-like string." (let ((type (cdr @@ -5326,6 +5334,25 @@ name of a process or buffer, or nil to default to the current buffer." (lambda () (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) +(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) + "Skeleton for `tramp-*-handle-delete-directory'. +BODY is the backend specific code." + (declare (indent 3) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (if (and (not ,recursive) + (directory-files + ,directory nil directory-files-no-dot-files-regexp)) + (tramp-error + v 'file-error "Directory is not empty, not moving to trash") + (move-file-to-trash ,directory)) + ,@body) + (tramp-flush-directory-properties v localname))) + +(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) + ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' diff --git a/lisp/notifications.el b/lisp/notifications.el index e6ce9a5d76d..f83898622ec 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; This package provides an implementation of the Desktop Notifications -;; <http://developer.gnome.org/notification-spec/>. +;; <https://developer.gnome.org/notification-spec/>. ;; In order to activate this package, you must add the following code ;; into your .emacs: @@ -108,7 +108,7 @@ (setq notifications-on-action-object nil))))) (defun notifications-on-closed-signal (id &optional reason) - "Dispatch signals to callback functions from `notifications-on-closed-map'." + "Dispatch signals to callback functions from `notifications-on-close-map'." ;; notification-daemon prior 0.4.0 does not send a reason. So we ;; make it optional, and assume `undefined' as default. (let* ((bus (dbus-event-bus-name last-input-event)) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 644de03cf4c..5bb904e6915 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -2230,7 +2230,7 @@ ENDP is t in the former case, nil in the latter." (skip-line-prefix fill-prefix) fill-prefix)) -(defun nxml-newline-and-indent (soft) +(defun nxml-newline-and-indent (&optional soft) (delete-horizontal-space) (if soft (insert-and-inherit ?\n) (newline 1)) (nxml-indent-line)) diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index f5bdf79349a..622ba911995 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -24,7 +24,7 @@ ;; This handles the regular expressions in the syntax defined by: ;; W3C XML Schema Part 2: Datatypes -;; <http://www.w3.org/TR/xmlschema-2/#regexs> +;; <https://www.w3.org/TR/xmlschema-2/#regexs> ;; ;; The main entry point is `xsdre-translate'. ;; @@ -1219,7 +1219,7 @@ Code is inserted into the current buffer." ;; The rest of the file was auto-generated by doing M-x xsdre-gen-categories ;; on UnicodeData-3.1.0.txt available from -;; http://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt +;; https://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt (xsdre-def-primitive-category 'Lu '((65 . 90) diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el index bf16fb25cd0..b1448e72e86 100644 --- a/lisp/obsolete/complete.el +++ b/lisp/obsolete/complete.el @@ -431,6 +431,8 @@ of `minibuffer-completion-table' and the minibuffer contents.") (let ((result (try-completion string alist predicate))) (if (eq result t) string result))) +(defvar completion-base-size) + ;; TODO document MODE magic... (defun PC-do-completion (&optional mode beg end goto-end) "Internal function to do the work of partial completion. diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el index 8f554282aed..cd26edeaa24 100644 --- a/lisp/obsolete/erc-hecomplete.el +++ b/lisp/obsolete/erc-hecomplete.el @@ -4,7 +4,7 @@ ;; Inc. ;; Author: Alex Schroeder <alex@gnu.org> -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion +;; URL: https://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion ;; Obsolete-since: 24.1 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index 65d60bee11d..ef62ae7356c 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -1615,7 +1615,7 @@ (org-babel-load-in-session-maybe, org-babel-pop-to-session-maybe): Use it. (org-babel-execute-src-block): Use `copy-tree' to prevent setf - from modifying users variables withing let-bound `info' variable. + from modifying users variables within let-bound `info' variable. * ob-exp.el (org-export-babel-evaluate): Add a 'inline-only option. @@ -1821,7 +1821,7 @@ it is an ARRAY ref, otherwise print it without a final newline. (org-babel-perl-preface): Content of this variable is prepended to body before invocation of perl. Rename input parameter body to - ibody and let-bind body to concatentation of + ibody and let-bind body to concatenation of `org-babel-perl-preface' and ibody. Implement results interpretation so that tables are easier to produce. @@ -3142,7 +3142,7 @@ relatively to the current timestamp, not to today's date. * org-agenda.el (org-agenda-filter-apply): - Deactive `org-agenda-entry-text-mode' when filtering. + Deactivate `org-agenda-entry-text-mode' when filtering. (org-agenda-entry-text-mode): Don't allow in filtered views. Don't show the maximum number of lines when turning off. @@ -3439,7 +3439,7 @@ (org-edit-src-exit): Cancel the timer. (org-edit-src-save): Prevent saving when editing fixed-width buffer, exiting will save already. - (org-edit-src-exit): Inconditionally kill the src/example + (org-edit-src-exit): Unconditionally kill the src/example editing buffer. * org-pcomplete.el (pcomplete/org-mode/file-option): @@ -3490,7 +3490,7 @@ * org-pcomplete.el (pcomplete/org-mode/file-option/x): Resurrect. Use `org-default-options' to initialize completion - fonctions for the most important keywords. + functions for the most important keywords. * org-macs.el (org-default-options): Rename and adapt from `org-get-current-options'. @@ -3588,7 +3588,7 @@ new sorting strategies. (org-agenda-get-todos, org-agenda-get-timestamps) (org-agenda-get-deadlines, org-agenda-get-scheduled): Add a - `ts-date' text property with scheduled, deadline or timetamp + `ts-date' text property with scheduled, deadline or timestamp date. (org-cmp-ts): New function to compare timestamps. (org-em): Add a docstring. @@ -4800,7 +4800,7 @@ (org-element-timestamp-interpreter): Parse warning delays. * ox-beamer.el (org-beamer--format-section): Fix regression which - prevents frames from being propely exported. + prevents frames from being properly exported. * ox.el (org-export-with-backend): Ensure function will use provided back-end. @@ -4888,7 +4888,7 @@ which is always nil in this back-end. * org.el (org-adaptive-fill-function): Look for a fill prefix at - the beginning of the paragraph and subsquently on its second line + the beginning of the paragraph and subsequently on its second line instead of the current line. * ob-core.el (org-babel-get-src-block-info): Look for indentation @@ -5595,7 +5595,7 @@ (org-export-async-start): Do not call `org-mode' since this is done already in the previous function. - * ox-beamer.el (org-beamer-keyword): Remove frame arount toc when + * ox-beamer.el (org-beamer-keyword): Remove frame around toc when generated from a TOC keyword. * org.el (org-export-backends): Do not reset list of loaded @@ -5629,7 +5629,7 @@ during a body-only export. * ox.el (org-export-as): Store export options in :export-options - porperty within communication channel. + property within communication channel. * ox-latex.el (org-latex-item): Fix wrong behavior when a counter is set in an ordered list while its parent is not ordered. @@ -5714,7 +5714,7 @@ (org-create-formula-image-with-dvipng) (org-create-formula-image-with-imagemagick): Use new function. - * ox.el (org-export-get-previous-element): Change order of retured + * ox.el (org-export-get-previous-element): Change order of returned elements in `org-export-get-previous-element'. * org-element.el (org-element-all-successors): Add `plain-link' @@ -5839,10 +5839,10 @@ Remove reference to now renamed `e-ascii' back-end. * ox-beamer.el (org-beamer-template): Allow to span documentclass - options accross multiple lines in template. + options across multiple lines in template. * ox-latex.el (org-latex-template): Allow to span documentclass - options accross multiple lines in template. + options across multiple lines in template. * ox-texinfo.el (org-texinfo--get-node): Upcase property name. (org-texinfo--get-node): New function. @@ -6524,7 +6524,7 @@ * org.el (org-open-at-point): The new code is being run in the same spot as `org-open-link-functions'. In case they failed, check if link matches "^id:" and if so, load the id interface and - follwo the link. + follow the link. 2013-11-12 Rasmus Pank Roulund <rasmus@gmx.us> (tiny change) @@ -6717,7 +6717,7 @@ 2013-11-12 Vitalie Spinu <spinuvit@gmail.com> * ob-tangle.el (org-babel-find-file-noselect-refresh): - Call `find-file-noselect' with 'nowarn argument to surpress + Call `find-file-noselect' with 'nowarn argument to suppress `yes-or-no-p' reversion message. * ob-core.el (org-babel-where-is-src-block-head): @@ -6990,7 +6990,7 @@ docstrings. Also fix typos. * org-list.el (org-list-struct-fix-box): When a checkbox has to be - resetted because of a non-nil ORDERED property value, make sure it + reset because of a non-nil ORDERED property value, make sure it had a checkbox already. 2013-02-07 Tokuya Kameshima <kametoku@gmail.com> (tiny change) @@ -9533,7 +9533,7 @@ * org-latex.el (org-export-latex-make-header): Ditto. * org-clock.el (org-clocktable-write-default): Temporarily disable - `delete-active-region' so that we don't accidently delete an + `delete-active-region' so that we don't accidentally delete an active region when exporting a subtree/region. * org-clock.el (org-program-exists): Remove. @@ -10419,7 +10419,7 @@ space character when auto-filling. * org.el (org-mode): Call external initalizers. Now both filling - code and comments code have their own independant part in org.el. + code and comments code have their own independent part in org.el. (org-setup-filling): Rename from `org-set-autofill-regexps'. (org-setup-comments-handling): New function. @@ -10652,7 +10652,7 @@ (org-list-struct-apply-struct, org-insert-item): Remove rule check. - * org-footnote.el (org-footnote-normalize): Fix positionning in + * org-footnote.el (org-footnote-normalize): Fix positioning in HTML export without a footnote section. * org-list.el (org-list-struct-indent): @@ -11318,7 +11318,7 @@ 2012-04-01 Shaun Johnson <shaun@slugfest.demon.co.uk> (tiny change) * org-exp-blocks.el (org-ditaa-jar-path): Better heuristic to find - the libary name. + the library name. 2012-04-01 Suvayu Ali <fatkasuvayu+linux@gmail.com> @@ -11917,7 +11917,7 @@ 2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com> * org-footnote.el (org-footnote-at-definition-p): Make sure to - move point at the beginning of the separator before skiping white + move point at the beginning of the separator before skipping white spaces. Refactor code. 2012-04-01 Eric Schulte <eric.schulte@gmx.com> @@ -13692,7 +13692,7 @@ 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> * org-publish.el (org-publish-cache-file-needs-publishing): - Fix regexp to not inlcude newlines. + Fix regexp to not include newlines. 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> @@ -14560,7 +14560,7 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> * org-footnote.el (org-footnote-normalize): Effectively remove - any footnote tag in non Org buffers, as detailled in the + any footnote tag in non Org buffers, as detailed in the docstring of `org-footnote-tag-for-non-org-mode-files'. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -15622,7 +15622,7 @@ 2011-07-28 David Maus <dmaus@ictsoc.de> * ob-haskell.el (org-babel-haskell-export-to-lhs): - Call `kill-buffer' with argument indiciating to kill current + Call `kill-buffer' with argument indicating to kill current buffer. Emacs 22 compatibility. 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -18049,7 +18049,7 @@ * org-table.el (org-table-fedit-finish): Read more general LHS of formulas. - (org-table-formula-handle-@L): New function to hanle @L references. + (org-table-formula-handle-@L): New function to handle @L references. (org-table-current-ncol): New variable. (org-table-line-to-dline): New function. (org-table-get-stored-formulas): Accept range formulas as matches. @@ -18058,7 +18058,7 @@ only the region marked by the range, not the content. (org-table-recalculate): Call `org-table-expand-lhs-ranges' to expand range targets. Also check for duplicate access to fields. - (org-table-expand-lhs-ranges): New funktion. + (org-table-expand-lhs-ranges): New function. (org-table-get-remote-range): Bind `org-table-current-ncol' to protect the caller's value. (org-table-edit-formulas): Support highlighting of range targets. @@ -19339,8 +19339,8 @@ * org-crypt.el (org-encrypt-string): New function. (org-encrypt-entry): Use org-encrypt-string to encrypt, so we use - cached crypted values. - (org-decrypt-entry): Store crypted text in decrypted text. + cached encrypted values. + (org-decrypt-entry): Store encrypted text in decrypted text. 2011-07-28 Dan Davison <dandavison7@gmail.com> @@ -20331,7 +20331,7 @@ 2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> * org-clock.el (org-quarter-to-date): Define variables. - (org-clock-special-range): Defin variables. Use org-floor*. + (org-clock-special-range): Define variables. Use org-floor*. (org-clocktable-write-default): Define tcol. * org-compat.el (org-floor*): New function. @@ -22854,7 +22854,7 @@ 2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-cycle-item-indentation): Do return t if and - only if cycling is possible and succeded. + only if cycling is possible and succeeded. 2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> @@ -28181,7 +28181,7 @@ * org-src.el (org-src-lang-modes): New variable. (org-edit-src-code): Translate language. - * org-exp.el (org-export-format-source-code-or-example): Deal wit + * org-exp.el (org-export-format-source-code-or-example): Deal with the new structure of the `org-export-latex-listings-langs' variable. @@ -28529,7 +28529,7 @@ * org.el (org-adapt-indentation): Slightly improve the docstring. (org-occur): Sends an error when the user inputs an empty string. - (org-priority): Bugfix: the tag alignement should happen within + (org-priority): Bugfix: the tag alignment should happen within save-excursion. 2009-08-06 Bastien Guerry <bzg@gnu.org> @@ -28830,7 +28830,7 @@ * org-agenda.el (org-agenda-mode): Reset list of marks. (org-agenda-mode-map): Define new keys for refile and bulk action. - (org-agenda-menu): Add menu itesm for refile and bulk action. + (org-agenda-menu): Add menu items for refile and bulk action. (org-agenda-refile): New function. (org-agenda-set-tags): Optional arguments TAG and ONOFF. (org-agenda-marked-entries): New variable. @@ -29490,7 +29490,7 @@ New functions. (org-protocol-check-filename-for-protocol): Call `server-edit'. - * org.el (org-default-properties): New default properteis for + * org.el (org-default-properties): New default properties for completion. * org-exp.el (org-export-add-subtree-options): Add new properties @@ -29842,7 +29842,7 @@ * org-faces.el (org-checkbox): New face. * org-exp.el (org-export-html-preprocess): Only create LaTeX - fragement images if there is an export file. + fragment images if there is an export file. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -30465,7 +30465,7 @@ workings of `org-toggle-heading'. (org-toggle-item): Rename from `org-toggle-region-items'. No longer needs a region defined, but will use it if there is one. - (org-ctrl-c-minus): Simplify, relying more on the inernal + (org-ctrl-c-minus): Simplify, relying more on the internal workings of `org-toggle-item'. * org-export-latex.el (org-export-latex-preprocess): Fix bug in @@ -30674,7 +30674,7 @@ converter. * org-exp.el (org-export-preprocess-string): Remove clock lines - and timestamps already in the preprocesor. + and timestamps already in the preprocessor. (org-export-remove-timestamps, org-export-remove-clock-lines): New functions. (org-export-as-ascii, org-export-as-html): Add the timestamps @@ -31158,14 +31158,14 @@ 2008-11-24 Carsten Dominik <carsten.dominik@gmail.com> * org-agenda.el (org-get-closed): Re-apply changes - accidentially overwritten by last commit to Emacs. + accidentally overwritten by last commit to Emacs. * org.el (org-outline-path-complete-in-steps): New option. (org-refile-get-location): Honor `org-outline-path-complete-in-steps'. (org-agenda-change-all-lines, org-tags-sparse-tree) (org-time-string-to-absolute, org-small-year-to-year) - (org-link-escape): Re-apply changes accidentially overwritten + (org-link-escape): Re-apply changes accidentally overwritten by last commit to Emacs. 2008-11-23 Carsten Dominik <carsten.dominik@gmail.com> diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el index 56a57cdf649..d04a40dd3b3 100644 --- a/lisp/org/ob-coq.el +++ b/lisp/org/ob-coq.el @@ -27,7 +27,7 @@ ;; session evaluation is supported. Requires both coq.el and ;; coq-inferior.el, both of which are distributed with Coq. ;; -;; http://coq.inria.fr/ +;; https://coq.inria.fr/ ;;; Code: (require 'ob) diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 8f66d102074..655e253d925 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -30,11 +30,11 @@ ;;; Requirements: -;; - a non-browser javascript engine such as node.js http://nodejs.org/ -;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; - a non-browser javascript engine such as node.js https://nodejs.org/ +;; or mozrepl https://wiki.github.com/bard/mozrepl/ ;; ;; - for session based evaluation mozrepl and moz.el are required see -;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; https://wiki.github.com/bard/mozrepl/emacs-integration for ;; configuration instructions ;;; Code: diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index 5bf9e2beee4..49886e292e5 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -26,7 +26,7 @@ ;; Org-Babel support for evaluating plantuml script. ;; ;; Inspired by Ian Yang's org-export-blocks-format-plantuml -;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el +;; https://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el ;;; Requirements: diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 90956271cf5..1b8088eaee4 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -30,10 +30,10 @@ ;; - ruby and irb executables :: http://www.ruby-lang.org/ ;; ;; - ruby-mode :: Can be installed through ELPA, or from -;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el +;; https://github.com/eschulte/rinari/raw/master/util/ruby-mode.el ;; ;; - inf-ruby mode :: Can be installed through ELPA, or from -;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el +;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el ;;; Code: (require 'ob) diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el index 60c081dcb38..c101574696c 100644 --- a/lisp/org/ob-sass.el +++ b/lisp/org/ob-sass.el @@ -35,7 +35,7 @@ ;;; Requirements: -;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el +;; - sass-mode :: https://github.com/nex3/haml/blob/master/extra/sass-mode.el ;;; Code: (require 'ob) diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el index c563a6c3e55..678047c8008 100644 --- a/lisp/org/ob-stan.el +++ b/lisp/org/ob-stan.el @@ -41,7 +41,7 @@ ;; For more information and usage examples, visit ;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html ;; -;; [1] http://mc-stan.org/ +;; [1] https://mc-stan.org/ ;;; Code: (require 'ob) diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el index e9c214f7dfc..b1c22756226 100644 --- a/lisp/org/ob-vala.el +++ b/lisp/org/ob-vala.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; ob-vala.el provides Babel support for the Vala language -;; (see http://live.gnome.org/Vala for details) +;; (see https://live.gnome.org/Vala for details) ;;; Requirements: diff --git a/lisp/org/ol-bibtex.el b/lisp/org/ol-bibtex.el index ad6622714dd..f139d645dad 100644 --- a/lisp/org/ol-bibtex.el +++ b/lisp/org/ol-bibtex.el @@ -318,7 +318,7 @@ is non-nil." "Controls whether inherited tags are converted to bibtex keywords. It is relevant only if `org-bibtex-tags-are-keywords' is non-nil. Tag inheritance itself is controlled by `org-use-tag-inheritance' -and `org-exclude-tags-from-inheritance'." +and `org-tags-exclude-from-inheritance'." :group 'org-bibtex :version "26.1" :package-version '(Org . "8.3") diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el index 99472315f67..71d55cd7c8d 100644 --- a/lisp/org/ol-gnus.el +++ b/lisp/org/ol-gnus.el @@ -34,7 +34,7 @@ (require 'gnus-sum) (require 'gnus-util) (require 'nnheader) -(require 'nnir) +(require 'nnselect) (require 'ol) @@ -140,9 +140,9 @@ If `org-store-link' was called with a prefix arg the meaning of (`(nnvirtual . ,_) (save-excursion (car (nnvirtual-map-article (gnus-summary-article-number))))) - (`(nnir . ,_) + (`(nnselect . ,_) (save-excursion - (nnir-article-group (gnus-summary-article-number)))) + (nnselect-article-group (gnus-summary-article-number)))) (_ gnus-newsgroup-name))) (header (if (eq major-mode 'gnus-article-mode) ;; When in an article, first move to summary diff --git a/lisp/org/org-num.el b/lisp/org/org-num.el index a6ddce733c8..5b8e1dbb6d1 100644 --- a/lisp/org/org-num.el +++ b/lisp/org/org-num.el @@ -131,7 +131,7 @@ For example, add \"ARCHIVE\" to this list to avoid numbering archived sub-trees. Tag in this list prevent numbering the whole sub-tree, -irrespective to `org-use-tags-inheritance', or other means to +irrespective to `org-use-tag-inheritance', or other means to control tag inheritance." :group 'org-appearance :package-version '(Org . "9.3") diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index abba29952e6..5c37cb1af52 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -6122,7 +6122,7 @@ which will prompt for the width." ;; Here are two examples of different styles. ;; Unicode block characters are used to give a smooth effect. -;; See http://en.wikipedia.org/wiki/Block_Elements +;; See https://en.wikipedia.org/wiki/Block_Elements ;; Use one of those drawing functions ;; - orgtbl-ascii-draw (the default ascii) ;; - orgtbl-uc-draw-grid (unicode with a grid effect) @@ -6136,7 +6136,7 @@ which will prompt for the width." It is a variant of orgtbl-ascii-draw with Unicode block characters, for a smooth display. Bars appear as grids (to the extent the font allows)." - ;; http://en.wikipedia.org/wiki/Block_Elements + ;; https://en.wikipedia.org/wiki/Block_Elements ;; best viewed with the "DejaVu Sans Mono" font. (orgtbl-ascii-draw value min max width " \u258F\u258E\u258D\u258C\u258B\u258A\u2589")) diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 9ae2700549c..fe3b5f8da10 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -4,7 +4,7 @@ ;; ;; Author: Rasmus Pank Roulund <emacs at pank dot eu> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org +;; Homepage: https://orgmode.org ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org.el b/lisp/org/org.el index f1a7f61a9a1..1ab8ab68880 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -223,7 +223,8 @@ byte-compiled before it is loaded." (org-babel-tangle-file file tangled-file "emacs-lisp")) (if compile (progn - (byte-compile-file tangled-file 'load) + (byte-compile-file tangled-file) + (load tangled-file) (message "Compiled and loaded %s" tangled-file)) (load-file tangled-file) (message "Loaded %s" tangled-file)))) @@ -2059,7 +2060,7 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (choice :tag "Interpretation" ;;Quick and dirty way to see - ;;`org-todo-interpretations'. This takes the + ;;`org-todo-interpretation'. This takes the ;;place of item arguments :convert-widget (lambda (widget) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 797efb90b79..2f8fd0c645b 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -5459,7 +5459,7 @@ transcoding it." (apostrophe :utf-8 "’" :html "’")) ("da" ;; one may use: »...«, "...", ›...‹, or '...'. - ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ + ;; https://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ ;; LaTeX quotes require Babel! (primary-opening :utf-8 "»" :html "»" :latex ">>" :texinfo "@guillemetright{}") @@ -5553,7 +5553,7 @@ transcoding it." (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") (apostrophe :utf-8 "’" :html "’")) ("ru" - ;; http://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5 + ;; https://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5 ;; http://www.artlebedev.ru/kovodstvo/sections/104/ (primary-opening :utf-8 "«" :html "«" :latex "{}<<" :texinfo "@guillemetleft{}") diff --git a/lisp/outline.el b/lisp/outline.el index 6158ed594e9..47e6528859f 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1,4 +1,4 @@ -;;; outline.el --- outline mode commands for Emacs +;;; outline.el --- outline mode commands for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 1993-1995, 1997, 2000-2020 Free Software ;; Foundation, Inc. @@ -166,7 +166,7 @@ in the file it applies to.") ;; Remove extra separator (cdr ;; Flatten the major mode's menus into a single menu. - (apply 'append + (apply #'append (mapcar (lambda (x) (if (consp x) ;; Add a separator between each @@ -179,6 +179,12 @@ in the file it applies to.") (let ((map (make-sparse-keymap))) (define-key map "\C-c" outline-mode-prefix-map) (define-key map [menu-bar] outline-mode-menu-bar-map) + ;; Only takes effect if point is on a heading. + (define-key map (kbd "TAB") + `(menu-item "" outline-cycle + :filter ,(lambda (cmd) + (when (outline-on-heading-p) cmd)))) + (define-key map (kbd "<backtab>") #'outline-cycle-buffer) map)) (defvar outline-font-lock-keywords @@ -190,47 +196,45 @@ in the file it applies to.") (defface outline-1 '((t :inherit font-lock-function-name-face)) - "Level 1." - :group 'outlines) + "Level 1.") (defface outline-2 '((t :inherit font-lock-variable-name-face)) - "Level 2." - :group 'outlines) + "Level 2.") (defface outline-3 '((t :inherit font-lock-keyword-face)) - "Level 3." - :group 'outlines) + "Level 3.") (defface outline-4 '((t :inherit font-lock-comment-face)) - "Level 4." - :group 'outlines) + "Level 4.") (defface outline-5 '((t :inherit font-lock-type-face)) - "Level 5." - :group 'outlines) + "Level 5.") (defface outline-6 '((t :inherit font-lock-constant-face)) - "Level 6." - :group 'outlines) + "Level 6.") (defface outline-7 '((t :inherit font-lock-builtin-face)) - "Level 7." - :group 'outlines) + "Level 7.") (defface outline-8 '((t :inherit font-lock-string-face)) - "Level 8." - :group 'outlines) + "Level 8.") (defvar outline-font-lock-faces [outline-1 outline-2 outline-3 outline-4 outline-5 outline-6 outline-7 outline-8]) + +(defvar outline-level #'outline-level + "Function of no args to compute a header's nesting level in an outline. +It can assume point is at the beginning of a header line and that the match +data reflects the `outline-regexp'.") +;;;###autoload(put 'outline-level 'risky-local-variable t) (defun outline-font-lock-face () "Return one of `outline-font-lock-faces' for current level." @@ -273,21 +277,20 @@ beginning of the line. The longer the match, the deeper the level. Turning on outline mode calls the value of `text-mode-hook' and then of `outline-mode-hook', if they are non-nil." - (make-local-variable 'line-move-ignore-invisible) - (setq line-move-ignore-invisible t) + (setq-local line-move-ignore-invisible t) ;; Cause use of ellipses for invisible text. (add-to-invisibility-spec '(outline . t)) - (set (make-local-variable 'paragraph-start) - (concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) + (setq-local paragraph-start + (concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) ;; Inhibit auto-filling of header lines. - (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) - (set (make-local-variable 'paragraph-separate) - (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) - (set (make-local-variable 'font-lock-defaults) - '(outline-font-lock-keywords t nil nil backward-paragraph)) - (setq imenu-generic-expression - (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) - (add-hook 'change-major-mode-hook 'outline-show-all nil t)) + (setq-local auto-fill-inhibit-regexp outline-regexp) + (setq-local paragraph-separate + (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) + (setq-local font-lock-defaults + '(outline-font-lock-keywords t nil nil backward-paragraph)) + (setq-local imenu-generic-expression + (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) + (add-hook 'change-major-mode-hook #'outline-show-all nil t)) (defvar outline-minor-mode-map) @@ -296,7 +299,6 @@ Turning on outline mode calls the value of `text-mode-hook' and then of The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps." :type 'key-sequence - :group 'outlines :initialize 'custom-initialize-default :set (lambda (sym val) (define-key outline-minor-mode-map outline-minor-mode-prefix nil) @@ -310,7 +312,6 @@ After that, changing the prefix key requires manipulating keymaps." See the command `outline-mode' for more information on this mode." nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) (cons outline-minor-mode-prefix outline-mode-prefix-map)) - :group 'outlines (if outline-minor-mode (progn ;; Turn off this mode if we change major modes. @@ -325,14 +326,8 @@ See the command `outline-mode' for more information on this mode." (remove-from-invisibility-spec '(outline . t)) ;; When turning off outline mode, get rid of any outline hiding. (outline-show-all))) - -(defvar outline-level 'outline-level - "Function of no args to compute a header's nesting level in an outline. -It can assume point is at the beginning of a header line and that the match -data reflects the `outline-regexp'.") -;;;###autoload(put 'outline-level 'risky-local-variable t) -(defvar outline-heading-alist () +(defvar-local outline-heading-alist () "Alist associating a heading for every possible level. Each entry is of the form (HEADING . LEVEL). This alist is used two ways: to find the heading corresponding to @@ -351,7 +346,6 @@ within each set. For example in texinfo mode: Instead of sorting the entries in each set, you can also separate the sets with nil.") -(make-variable-buffer-local 'outline-heading-alist) ;; This used to count columns rather than characters, but that made ^L ;; appear to be at level 2 instead of 1. Columns would be better for @@ -396,6 +390,8 @@ at the end of the buffer." If POS is nil, use `point' instead." (eq (get-char-property (or pos (point)) 'invisible) 'outline)) +(define-error 'outline-before-first-heading "Before first heading") + (defun outline-back-to-heading (&optional invisible-ok) "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." @@ -406,7 +402,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." (while (not found) (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") nil t) - (error "Before first heading")) + (signal 'outline-before-first-heading nil)) (setq found (and (or invisible-ok (not (outline-invisible-p))) (point))))) (goto-char found) @@ -471,9 +467,9 @@ nil for WHICH, or do not pass any argument)." (if current-prefix-arg nil 'subtree)))) (cond ((eq which 'region) - (outline-map-region 'outline-promote (region-beginning) (region-end))) + (outline-map-region #'outline-promote (region-beginning) (region-end))) (which - (outline-map-region 'outline-promote + (outline-map-region #'outline-promote (point) (save-excursion (outline-get-next-sibling) (point)))) (t @@ -510,9 +506,9 @@ nil for WHICH, or do not pass any argument)." (if current-prefix-arg nil 'subtree)))) (cond ((eq which 'region) - (outline-map-region 'outline-demote (region-beginning) (region-end))) + (outline-map-region #'outline-demote (region-beginning) (region-end))) (which - (outline-map-region 'outline-demote + (outline-map-region #'outline-demote (point) (save-excursion (outline-get-next-sibling) (point)))) (t @@ -692,12 +688,12 @@ This puts point at the start of the current subtree, and mark at the end." (goto-char beg))) -(defvar outline-isearch-open-invisible-function nil +(defvar outline-isearch-open-invisible-function + #'outline-isearch-open-invisible "Function called if `isearch' finishes in an invisible overlay. -The function is called with the overlay as its only argument. -If nil, `outline-show-entry' is called to reveal the invisible text.") +The function is called with the overlay as its only argument.") -(put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible) +(put 'outline 'reveal-toggle-invisible #'outline-reveal-toggle-invisible) (defun outline-flag-region (from to flag) "Hide or show lines from FROM to TO, according to FLAG. If FLAG is nil then text is shown, while if FLAG is t the text is hidden." @@ -711,7 +707,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden." (overlay-put o 'invisible 'outline) (overlay-put o 'isearch-open-invisible (or outline-isearch-open-invisible-function - 'outline-isearch-open-invisible)))) + #'outline-isearch-open-invisible)))) ;; Seems only used by lazy-lock. I.e. obsolete. (run-hooks 'outline-view-change-hook)) @@ -771,8 +767,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden." (outline-end-of-heading) (outline-flag-region (point) (progn (outline-next-preface) (point)) t))) -(define-obsolete-function-alias - 'hide-entry 'outline-hide-entry "25.1") +(define-obsolete-function-alias 'hide-entry #'outline-hide-entry "25.1") (defun outline-show-entry () "Show the body directly following this heading. @@ -788,8 +783,7 @@ Show the heading too, if it is currently invisible." (point))) nil))) -(define-obsolete-function-alias - 'show-entry 'outline-show-entry "25.1") +(define-obsolete-function-alias 'show-entry #'outline-show-entry "25.1") (defun outline-hide-body () "Hide all body lines in buffer, leaving all headings visible. @@ -797,8 +791,7 @@ Note that this does not hide the lines preceding the first heading line." (interactive) (outline-hide-region-body (point-min) (point-max))) -(define-obsolete-function-alias - 'hide-body 'outline-hide-body "25.1") +(define-obsolete-function-alias 'hide-body #'outline-hide-body "25.1") (defun outline-hide-region-body (start end) "Hide all body lines between START and END, but not headings." @@ -822,23 +815,21 @@ Note that this does not hide the lines preceding the first heading line." (run-hooks 'outline-view-change-hook)) (define-obsolete-function-alias - 'hide-region-body 'outline-hide-region-body "25.1") + 'hide-region-body #'outline-hide-region-body "25.1") (defun outline-show-all () "Show all of the text in the buffer." (interactive) (outline-flag-region (point-min) (point-max) nil)) -(define-obsolete-function-alias - 'show-all 'outline-show-all "25.1") +(define-obsolete-function-alias 'show-all #'outline-show-all "25.1") (defun outline-hide-subtree () "Hide everything after this heading at deeper levels." (interactive) (outline-flag-subtree t)) -(define-obsolete-function-alias - 'hide-subtree 'outline-hide-subtree "25.1") +(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1") (defun outline-hide-leaves () "Hide the body after this heading and at deeper levels." @@ -851,16 +842,14 @@ Note that this does not hide the lines preceding the first heading line." (point) (progn (outline-end-of-subtree) (point))))) -(define-obsolete-function-alias - 'hide-leaves 'outline-hide-leaves "25.1") +(define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1") (defun outline-show-subtree () "Show everything after this heading at deeper levels." (interactive) (outline-flag-subtree nil)) -(define-obsolete-function-alias - 'show-subtree 'outline-show-subtree "25.1") +(define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1") (defun outline-show-heading () "Show the current heading and move to its end." @@ -915,8 +904,7 @@ of the current heading, or to 1 if the current line is not a heading." (outline-flag-region (1- (point)) (point) nil)))) (run-hooks 'outline-view-change-hook)) -(define-obsolete-function-alias - 'hide-sublevels 'outline-hide-sublevels "25.1") +(define-obsolete-function-alias 'hide-sublevels #'outline-hide-sublevels "25.1") (defun outline-hide-other () "Hide everything except current body and parent and top-level headings. @@ -934,8 +922,7 @@ This also unhides the top heading-less body, if any." nil)))) (run-hooks 'outline-view-change-hook)) -(define-obsolete-function-alias - 'hide-other 'outline-hide-other "25.1") +(define-obsolete-function-alias 'hide-other #'outline-hide-other "25.1") (defun outline-toggle-children () "Show or hide the current subtree depending on its current state." @@ -979,8 +966,7 @@ This also unhides the top heading-less body, if any." (interactive) (outline-show-children 1000)) -(define-obsolete-function-alias - 'show-branches 'outline-show-branches "25.1") +(define-obsolete-function-alias 'show-branches #'outline-show-branches "25.1") (defun outline-show-children (&optional level) "Show all direct subheadings of this heading. @@ -1009,8 +995,7 @@ Default is enough to cause the following heading to appear." (if (eobp) (point-max) (1+ (point))))))) (run-hooks 'outline-view-change-hook)) -(define-obsolete-function-alias - 'show-children 'outline-show-children "25.1") +(define-obsolete-function-alias 'show-children #'outline-show-children "25.1") @@ -1125,6 +1110,79 @@ convenient way to make a table of contents of the buffer." (insert "\n\n")))))) (kill-new (buffer-string))))))) +(defun outline--cycle-state () + "Return the cycle state of current heading. +Return either 'hide-all, 'headings-only, or 'show-all." + (save-excursion + (let (start end ov-list heading-end) + (outline-back-to-heading) + (setq start (point)) + (outline-end-of-heading) + (setq heading-end (point)) + (outline-end-of-subtree) + (setq end (point)) + (setq ov-list (cl-remove-if-not + (lambda (o) (eq (overlay-get o 'invisible) 'outline)) + (overlays-in start end))) + (cond ((eq ov-list nil) 'show-all) + ;; (eq (length ov-list) 1) wouldn’t work: what if there is + ;; one folded subheading? + ((and (eq (overlay-end (car ov-list)) end) + (eq (overlay-start (car ov-list)) heading-end)) + 'hide-all) + (t 'headings-only))))) + +(defun outline-has-subheading-p () + "Return t if this heading has subheadings, nil otherwise." + (save-excursion + (outline-back-to-heading) + (< (save-excursion (outline-next-heading) (point)) + (save-excursion (outline-end-of-subtree) (point))))) + +(defun outline-cycle () + "Cycle between `hide all', `headings only' and `show all'. + +`Hide all' means hide all subheadings and their bodies. +`Headings only' means show sub headings but not their bodies. +`Show all' means show all subheadings and their bodies." + (interactive) + (condition-case nil + (pcase (outline--cycle-state) + ('hide-all + (if (outline-has-subheading-p) + (progn (outline-show-children) + (message "Only headings")) + (outline-show-subtree) + (message "Show all"))) + ('headings-only + (outline-show-subtree) + (message "Show all")) + ('show-all + (outline-hide-subtree) + (message "Hide all"))) + (outline-before-first-heading nil))) + +(defvar-local outline--cycle-buffer-state 'show-all + "Internal variable used for tracking buffer cycle state.") + +(defun outline-cycle-buffer () + "Cycle the whole buffer like in `outline-cycle'." + (interactive) + (pcase outline--cycle-buffer-state + ('show-all + (outline-hide-sublevels 1) + (setq outline--cycle-buffer-state 'top-level) + (message "Top level headings")) + ('top-level + (outline-show-all) + (outline-hide-region-body (point-min) (point-max)) + (setq outline--cycle-buffer-state 'all-heading) + (message "All headings")) + ('all-heading + (outline-show-all) + (setq outline--cycle-buffer-state 'show-all) + (message "Show all")))) + (provide 'outline) (provide 'noutline) diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index d7c5b381d29..fa84b31675e 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -67,12 +67,13 @@ nil (function (lambda (entry) - (when (and (file-readable-p entry) - (file-regular-p entry)) - (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'" - entry))) - (or (and unzip-p zipped) - (and (not unzip-p) (not zipped))))))))) + (or (file-directory-p entry) + (when (and (file-readable-p entry) + (file-regular-p entry)) + (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'" + entry))) + (or (and unzip-p zipped) + (and (not unzip-p) (not zipped)))))))))) ;;;###autoload (defun pcomplete/bzip2 () diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index 822f6f37e78..13de4b65e5b 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -82,10 +82,14 @@ being via `pcmpl-ssh-known-hosts-file'." ;;;###autoload (defun pcomplete/xargs () "Completion for `xargs'." - (pcomplete-here (funcall pcomplete-command-completion-function)) + ;; FIXME: Add completion of xargs-specific arguments. + (funcall pcomplete-command-completion-function) (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) pcomplete-default-completion-function))) +;; FIXME: Add completion of sudo-specific arguments. +(defalias 'pcomplete/sudo #'pcomplete/xargs) + ;;;###autoload (defalias 'pcomplete/time 'pcomplete/xargs) @@ -144,7 +148,7 @@ documentation), this function returns nil." ;; ssh support by Phil Hagelberg. -;; http://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el +;; https://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el (defun pcmpl-ssh-known-hosts () "Return a list of hosts found in `pcmpl-ssh-known-hosts-file'." @@ -217,6 +221,29 @@ Includes files as well as host names followed by a colon." (pcmpl-ssh-hosts))))))) (complete-with-action action table string pred)))))) +(defsubst pcmpl-unix-complete-hostname () + "Complete a command that wants a hostname for an argument." + (pcomplete-here (pcomplete-read-host-names))) + +(defalias 'pcomplete/ftp 'pcmpl-unix-complete-hostname) +(defalias 'pcomplete/ncftp 'pcmpl-unix-complete-hostname) +(defalias 'pcomplete/ping 'pcmpl-unix-complete-hostname) +(defalias 'pcomplete/rlogin 'pcmpl-unix-complete-hostname) + +;;;###autoload +(defun pcomplete/telnet () + (pcomplete-opt "xl(pcmpl-unix-user-names)") + (pcmpl-unix-complete-hostname)) + +;;;###autoload +(defun pcomplete/rsh () + "Complete `rsh', which, after the user and hostname, is like xargs." + (pcomplete-opt "l(pcmpl-unix-user-names)") + (pcmpl-unix-complete-hostname) + (pcomplete-here (funcall pcomplete-command-completion-function)) + (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) + pcomplete-default-completion-function))) + (provide 'pcmpl-unix) ;;; pcmpl-unix.el ends here diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 5244ada5231..0fd426e3d1f 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -141,7 +141,7 @@ (pcomplete-here* (pcomplete-dirs-or-entries))))))) -;;;; ack - http://betterthangrep.com +;;;; ack - https://betterthangrep.com ;; Usage: ;; - To complete short options type '-' first @@ -286,5 +286,37 @@ long options." (pcmpl-x-ag-options)))) (pcomplete-here* (pcomplete-dirs-or-entries))))) +;;;###autoload +(defun pcomplete/bcc32 () + "Completion function for Borland's C++ compiler." + (let ((cur (pcomplete-arg 0))) + (cond + ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur) + (pcomplete-here + '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc" + "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup" + "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil" + "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci" + "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf" + "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par" + "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret" + "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai" + "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur))) + ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur) + (pcomplete-here (pcomplete-dirs) (match-string 2 cur))) + ((string-match "\\`-[Ee]\\(.*\\)\\'" cur) + (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'") + (match-string 1 cur))) + ((string-match "\\`-o\\(.*\\)\\'" cur) + (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'") + (match-string 1 cur))) + (t + (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz")))) + (while (pcomplete-here + (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'")))) + +;;;###autoload +(defalias 'pcomplete/bcc 'pcomplete/bcc32) + (provide 'pcmpl-x) ;;; pcmpl-x.el ends here diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 32e61e84e0d..014f9628b99 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -325,6 +325,10 @@ already terminated by a character, this variable should be locally modified to be an empty string, or the desired separation string." :type 'string) +(defcustom pcomplete-hosts-file "/etc/hosts" + "The name of the /etc/hosts file." + :type '(choice (const :tag "No hosts file" nil) file)) + ;;; Internal Variables: ;; for cycling completion support @@ -1289,6 +1293,46 @@ If specific documentation can't be given, be generic." (skip-chars-backward "\n") (buffer-substring (point-min) (point)))) +;; hostname completion + +(defvar pcomplete--host-name-cache nil + "A cache the names of frequently accessed hosts.") + +(defvar pcomplete--host-name-cache-timestamp nil + "A timestamp of when the hosts file was read.") + +(defun pcomplete-read-hosts-file (filename) + "Read in the hosts from FILENAME, default `pcomplete-hosts-file'." + (let (hosts) + (with-temp-buffer + (insert-file-contents (or filename pcomplete-hosts-file)) + (goto-char (point-min)) + (while (re-search-forward + ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?" + "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t) + (push (cons (match-string 1) + (split-string (match-string 2))) + hosts))) + (nreverse hosts))) + +(defun pcomplete-read-hosts (file result-var timestamp-var) + "Read the contents of /etc/hosts for host names." + (if (or (not (symbol-value result-var)) + (not (symbol-value timestamp-var)) + (time-less-p + (symbol-value timestamp-var) + (file-attribute-modification-time (file-attributes file)))) + (progn + (set result-var (apply #'nconc (pcomplete-read-hosts-file file))) + (set timestamp-var (current-time)))) + (symbol-value result-var)) + +(defun pcomplete-read-host-names () + "Read the contents of /etc/hosts for host names." + (if pcomplete-hosts-file + (pcomplete-read-hosts pcomplete-hosts-file 'pcomplete--host-name-cache + 'pcomplete--host-name-cache-timestamp))) + ;; create a set of aliases which allow completion functions to be not ;; quite so verbose diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 7c4941e7256..3d4843a39c6 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -582,7 +582,7 @@ Solutions are sorted from least to greatest Hamming weight." (math-sub dest org)))) ;; transferm is the transfer matrix, ie it is the 25x25 - ;; matrix applied everytime a flip is carried out where a + ;; matrix applied every time a flip is carried out where a ;; flip is defined by a 25x1 Dirac vector --- ie all zeros ;; but 1 in the position that is flipped. (transferm diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 903c0686063..d512a718b48 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -28,7 +28,7 @@ ;; possible in as few moves as possible. ;; Bubbles is an implementation of the "Same Game", similar to "Same -;; GNOME" and many others, see <http://en.wikipedia.org/wiki/SameGame>. +;; GNOME" and many others, see <https://en.wikipedia.org/wiki/SameGame>. ;; Installation ;; ------------ diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index a03d0a9a052..8a69f9decf0 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -4,7 +4,7 @@ ;; Author: Ron Schnell <ronnie@driver-aces.com> ;; Created: 25 Jul 1992 -;; Version: 2.02 +;; Old-Version: 2.02 ;; Keywords: games ;; This file is part of GNU Emacs. @@ -1957,7 +1957,7 @@ to swim.") (defun dun-help (_args) (dun-mprincl -"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). +"Welcome to dunnet by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). Here is some useful information (read carefully because there are one or more clues in here): - If you have a key that can open a door, you do not need to explicitly diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 9b74eb913e0..bb8ae5693f6 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc. ;; Author: Glynn Clements <glynn@sensei.co.uk> -;; Version: 1.02 +;; Old-Version: 1.02 ;; Created: 1997-08-13 ;; Keywords: games @@ -635,6 +635,8 @@ FILE is created there." (save-excursion (setq file (expand-file-name file (or directory temporary-file-directory))) + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) (find-file-other-window file) (setq buffer-read-only nil) (goto-char (point-max)) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index ba74afce298..a9417e9e0ac 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -121,8 +121,8 @@ Has to contain \"%d\" to output the actual number." :group 'gametree) (defcustom gametree-make-heading-function - (function (lambda (level) - (insert (make-string level ?*)))) + (lambda (level) + (insert (make-string level ?*))) "A function of one numeric argument, LEVEL, to insert a heading at point. You should change this if you change `outline-regexp'." :type 'function diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index f69e0622c9a..7b4a59b6fcd 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -45,7 +45,7 @@ ;; Installation ;; ;; type at your prompt "emacs -l handwrite.el" or put this file on your -;; Emacs-Lisp load path, add the following into your init file: +;; Emacs Lisp load path, add the following into your init file: ;; ;; (require 'handwrite) ;; diff --git a/lisp/printing.el b/lisp/printing.el index b8879befae3..90ef02fe7b1 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -5,7 +5,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, print, PostScript ;; Version: 6.9.3 -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre (defconst pr-version "6.9.3" "printing.el, v 6.9.3 <2007/12/09 vinicius> @@ -64,7 +64,7 @@ Please send all bug fixes and enhancements to ;; interface to ps-print package and it also provides some extra stuff. ;; ;; To download the latest ps-print package see -;; `http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'. +;; `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'. ;; Please, see README file for ps-print installation instructions. ;; ;; `printing' was inspired by: @@ -944,8 +944,8 @@ Please send all bug fixes and enhancements to ;; ;; * For `printing' package: ;; -;; printing `http://www.emacswiki.org/cgi-bin/emacs/download/printing.el' -;; ps-print `http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage' +;; printing `https://www.emacswiki.org/cgi-bin/emacs/download/printing.el' +;; ps-print `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage' ;; ;; * For GNU or Unix system: ;; @@ -4721,7 +4721,7 @@ Each element has the form: (MENU-PART . NUMBER-OF-ITEMS) -See `pr-visible-entry-alist'.") +See `pr-visible-entry-list'.") (defun pr-menu-index (entry index) @@ -5284,22 +5284,18 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-interactive-n-up (mess) - (or (stringp mess) (setq mess "*")) - (save-match-data - (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ") - (prompt "") - (str (read-string (format fmt-prompt prompt mess) nil nil "1")) - int) - (while (if (string-match "^\\s *[0-9]+$" str) - (setq int (string-to-number str) - prompt (cond ((< int 1) "Integer below 1; ") - ((> int 100) "Integer above 100; ") - (t nil))) - (setq prompt "Invalid integer syntax; ")) - (ding) - (setq str - (read-string (format fmt-prompt prompt mess) str nil "1"))) - int))) + (unless (stringp mess) + (setq mess "*")) + (let (int) + (while (or (< (setq int (read-number (format "[%s] N-up printing:" mess) 1)) + 0) + (> int 100)) + (if (< int 0) + (message "Integer below 1") + (message "Integer above 100")) + (sit-for 1) + (ding)) + int)) (defun pr-interactive-dir (mess) @@ -5323,7 +5319,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-interactive-regexp (mess) - (read-string (format "[%s] File regexp to print: " mess) nil nil "")) + (read-string (format "[%s] File regexp to print: " mess))) (defun pr-interactive-dir-args (mess) diff --git a/lisp/proced.el b/lisp/proced.el index ff2db33afb6..203d70331ce 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1,4 +1,4 @@ -;;; proced.el --- operate on system processes like dired +;;; proced.el --- operate on system processes like dired -*- lexical-binding:t -*- ;; Copyright (C) 2008-2020 Free Software Foundation, Inc. @@ -55,17 +55,15 @@ :group 'unix :prefix "proced-") -(defcustom proced-signal-function 'signal-process +(defcustom proced-signal-function #'signal-process "Name of signal function. It can be an elisp function (usually `signal-process') or a string specifying the external command (usually \"kill\")." - :group 'proced :type '(choice (function :tag "function") (string :tag "command"))) (defcustom proced-renice-command "renice" "Name of renice command." - :group 'proced :version "24.3" :type '(string :tag "command")) @@ -95,7 +93,6 @@ the external command (usually \"kill\")." ("USR1" . " (User-defined signal 1)") ("USR2" . " (User-defined signal 2)")) "List of signals, used for minibuffer completion." - :group 'proced :type '(repeat (cons (string :tag "signal name") (string :tag "description")))) @@ -205,7 +202,6 @@ of point. The function must return a list of PIDs that is used for the refined listing. HELP-ECHO is a string that is shown when mouse is over this field. If REFINER is nil no refinement is done." - :group 'proced :type '(repeat (list :tag "Attribute" (symbol :tag "Key") (string :tag "Header") @@ -239,7 +235,6 @@ of a system process. It returns a cons cell of the form (KEY . VALUE) like `process-attributes'. This cons cell is appended to the list returned by `proced-process-attributes'. If the function returns nil, the value is ignored." - :group 'proced :type '(repeat (function :tag "Attribute"))) ;; Formatting and sorting rules are defined "per attribute". If formatting @@ -263,7 +258,6 @@ The cdr is a list of attribute keys appearing in `proced-grammar-alist'. An element of this list may also be a list of attribute keys that specifies alternatives. If the first attribute is absent for a process, use the second one, etc." - :group 'proced :type '(alist :key-type (symbol :tag "Format Name") :value-type (repeat :tag "Keys" (choice (symbol :tag "") @@ -274,7 +268,6 @@ one, etc." "Current format of Proced listing. It can be the car of an element of `proced-format-alist'. It can also be a list of keys appearing in `proced-grammar-alist'." - :group 'proced :type '(choice (symbol :tag "Format Name") (repeat :tag "Keys" (symbol :tag "")))) (make-variable-buffer-local 'proced-format) @@ -304,7 +297,6 @@ An elementary filter can be one of the following: of each. Accept the process if FUN returns non-nil. \(fun-all . FUN) Apply function FUN to entire process list. FUN must return the filtered list." - :group 'proced :type '(repeat (cons :tag "Filter" (symbol :tag "Filter Name") (repeat :tag "Filters" @@ -318,7 +310,6 @@ An elementary filter can be one of the following: It can be the car of an element of `proced-filter-alist'. It can also be a list of elementary filters as in the cdrs of the elements of `proced-filter-alist'." - :group 'proced :type '(choice (symbol :tag "Filter Name") (repeat :tag "Filters" (choice (cons :tag "Key . Regexp" (symbol :tag "Key") regexp) @@ -332,38 +323,32 @@ of `proced-filter-alist'." It must be the KEY of an element of `proced-grammar-alist'. It can also be a list of KEYs as in the SORT-SCHEMEs of the elements of `proced-grammar-alist'." - :group 'proced :type '(choice (symbol :tag "Sort Scheme") (repeat :tag "Key List" (symbol :tag "Key")))) (make-variable-buffer-local 'proced-sort) (defcustom proced-descend t "Non-nil if proced listing is sorted in descending order." - :group 'proced :type '(boolean :tag "Descending Sort Order")) (make-variable-buffer-local 'proced-descend) (defcustom proced-goal-attribute 'args "If non-nil, key of the attribute that defines the `goal-column'." - :group 'proced :type '(choice (const :tag "none" nil) (symbol :tag "key"))) (defcustom proced-auto-update-interval 5 "Time interval in seconds for auto updating Proced buffers." - :group 'proced :type 'integer) (defcustom proced-auto-update-flag nil "Non-nil for auto update of a Proced buffer. Can be changed interactively via `proced-toggle-auto-update'." - :group 'proced :type 'boolean) (make-variable-buffer-local 'proced-auto-update-flag) (defcustom proced-tree-flag nil "Non-nil for display of Proced buffer as process tree." - :group 'proced :type 'boolean) (make-variable-buffer-local 'proced-tree-flag) @@ -371,26 +356,23 @@ Can be changed interactively via `proced-toggle-auto-update'." "Normal hook run after displaying or updating a Proced buffer. May be used to adapt the window size via `fit-window-to-buffer'." :type 'hook - :options '(fit-window-to-buffer) - :group 'proced) + :options '(fit-window-to-buffer)) (defcustom proced-after-send-signal-hook nil "Normal hook run after sending a signal to processes by `proced-send-signal'. May be used to revert the process listing." :type 'hook - :options '(proced-revert) - :group 'proced) + :options '(proced-revert)) ;; Internal variables (defvar proced-available (not (null (list-system-processes))) "Non-nil means Proced is known to work on this system.") -(defvar proced-process-alist nil +(defvar-local proced-process-alist nil "Alist of processes displayed by Proced. The car of each element is the PID, and the cdr is a list of cons pairs, see `proced-process-attributes'.") -(make-variable-buffer-local 'proced-process-alist) (defvar proced-sort-internal nil "Sort scheme for listing (internal format). @@ -408,26 +390,22 @@ It is a list of lists (KEY PREDICATE REVERSE).") (defface proced-mark '((t (:inherit font-lock-constant-face))) - "Face used for Proced marks." - :group 'proced-faces) + "Face used for Proced marks.") (defface proced-marked '((t (:inherit error))) - "Face used for marked processes." - :group 'proced-faces) + "Face used for marked processes.") (defface proced-sort-header '((t (:inherit font-lock-keyword-face))) - "Face used for header of attribute used for sorting." - :group 'proced-faces) + "Face used for header of attribute used for sorting.") (defvar proced-re-mark "^[^ \n]" "Regexp matching a marked line. Important: the match ends just after the marker.") -(defvar proced-header-line nil +(defvar-local proced-header-line nil "Headers in Proced buffer as a string.") -(make-variable-buffer-local 'proced-header-line) (defvar proced-temp-alist nil "Temporary alist (internal variable).") @@ -615,14 +593,23 @@ Important: the match ends just after the marker.") (defun proced-header-line () "Return header line for Proced buffer." - (list (propertize " " - 'display - (list 'space :align-to - (line-number-display-width 'columns))) - (if (<= (window-hscroll) (length proced-header-line)) - (replace-regexp-in-string ;; preserve text properties - "\\(%\\)" "\\1\\1" - (substring proced-header-line (window-hscroll)))))) + (let ((base (line-number-display-width 'columns)) + (hl (if (<= (window-hscroll) (length proced-header-line)) + (substring proced-header-line (window-hscroll))))) + (when hl + ;; From buff-menu.el: Turn whitespace chars in the header into + ;; stretch specs so they work regardless of the header-line face. + (let ((pos 0)) + (while (string-match "[ \t\n]+" hl pos) + (setq pos (match-end 0)) + (put-text-property (match-beginning 0) pos 'display + `(space :align-to ,(+ pos base)) + hl))) + (setq hl (replace-regexp-in-string ;; preserve text properties + "\\(%\\)" "\\1\\1" + hl))) + (list (propertize " " 'display `(space :align-to ,base)) + hl))) (defun proced-pid-at-point () "Return pid of system process at point. @@ -676,8 +663,8 @@ After displaying or updating a Proced buffer, Proced runs the normal hook (setq buffer-read-only t truncate-lines t header-line-format '(:eval (proced-header-line))) - (add-hook 'post-command-hook 'force-mode-line-update nil t) - (set (make-local-variable 'revert-buffer-function) 'proced-revert) + (add-hook 'post-command-hook #'force-mode-line-update nil t) ;; FIXME: Why? + (set (make-local-variable 'revert-buffer-function) #'proced-revert) (set (make-local-variable 'font-lock-defaults) '(proced-font-lock-keywords t nil nil beginning-of-line)) (if (and (not proced-auto-update-timer) proced-auto-update-interval) @@ -940,11 +927,12 @@ Return the filtered process list." (if (funcall (car filter) (cdr process)) (push process new-alist)))) (t ;; apply predicate to specified attribute - (let ((fun (if (stringp (cdr filter)) - `(lambda (val) - (string-match ,(cdr filter) val)) - (cdr filter))) - value) + (let* ((cdrfilter (cdr filter)) + (fun (if (stringp cdrfilter) + (lambda (val) + (string-match cdrfilter val)) + cdrfilter)) + value) (dolist (process process-alist) (setq value (cdr (assq (car filter) (cdr process)))) (if (and value (funcall fun value)) @@ -1023,7 +1011,7 @@ The list of children does not include grandchildren." "Return list of children PIDs of PPID (including PPID)." (let ((cpids (cdr (assq ppid proced-temp-alist)))) (if cpids - (cons ppid (apply 'append (mapcar 'proced-children-pids cpids))) + (cons ppid (apply #'append (mapcar #'proced-children-pids cpids))) (list ppid)))) (defun proced-process-tree (process-alist) @@ -1114,7 +1102,7 @@ Return the rearranged process list." proced-process-tree) (if (cdr process-tree) (let ((proced-tree-depth (1+ proced-tree-depth))) - (mapc 'proced-tree-insert (cdr process-tree)))))) + (mapc #'proced-tree-insert (cdr process-tree)))))) ;; Refining @@ -1207,7 +1195,7 @@ Return `equal' if T1 equals T2. Return nil otherwise." ;;; Sorting -(define-obsolete-function-alias 'proced-xor 'xor "27.1") +(define-obsolete-function-alias 'proced-xor #'xor "27.1") (defun proced-sort-p (p1 p2) "Predicate for sorting processes P1 and P2." @@ -1436,10 +1424,11 @@ Replace newline characters by \"^J\" (two characters)." ;; Loop over all attributes (while (setq grammar (assq (pop format) proced-grammar-alist)) (let* ((key (car grammar)) - (fun (cond ((stringp (nth 2 grammar)) - `(lambda (arg) (format ,(nth 2 grammar) arg))) - ((not (nth 2 grammar)) 'identity) - ( t (nth 2 grammar)))) + (nth2grm (nth 2 grammar)) + (fun (cond ((stringp nth2grm) + (lambda (arg) (format nth2grm arg))) + ((not nth2grm) #'identity) + (t nth2grm))) (whitespace (if format whitespace "")) ;; Text properties: ;; We use the text property `proced-key' to store in each @@ -1479,13 +1468,13 @@ Replace newline characters by \"^J\" (two characters)." (end-of-line) (setq value (cdr (assq key (cdr process)))) (insert (if value - (apply 'propertize (funcall fun value) fprops) + (apply #'propertize (funcall fun value) fprops) (format (concat "%" (number-to-string (nth 3 grammar)) "s") unknown)) whitespace) (forward-line)) (push (format (concat "%" (number-to-string (nth 3 grammar)) "s") - (apply 'propertize (nth 1 grammar) hprops)) + (apply #'propertize (nth 1 grammar) hprops)) header-list)) ( ;; last field left-justified @@ -1493,10 +1482,10 @@ Replace newline characters by \"^J\" (two characters)." (dolist (process process-alist) (end-of-line) (setq value (cdr (assq key (cdr process)))) - (insert (if value (apply 'propertize (funcall fun value) fprops) + (insert (if value (apply #'propertize (funcall fun value) fprops) unknown)) (forward-line)) - (push (apply 'propertize (nth 1 grammar) hprops) header-list)) + (push (apply #'propertize (nth 1 grammar) hprops) header-list)) (t ;; calculated field width (let ((width (length (nth 1 grammar))) @@ -1504,14 +1493,14 @@ Replace newline characters by \"^J\" (two characters)." (dolist (process process-alist) (setq value (cdr (assq key (cdr process)))) (if value - (setq value (apply 'propertize (funcall fun value) fprops) + (setq value (apply #'propertize (funcall fun value) fprops) width (max width (length value)) field-list (cons value field-list)) (push unknown field-list) (setq width (max width (length unknown))))) (let ((afmt (concat "%" (if (eq 'left (nth 3 grammar)) "-" "") (number-to-string width) "s"))) - (push (format afmt (apply 'propertize (nth 1 grammar) hprops)) + (push (format afmt (apply #'propertize (nth 1 grammar) hprops)) header-list) (dolist (value (nreverse field-list)) (end-of-line) @@ -1527,7 +1516,7 @@ Replace newline characters by \"^J\" (two characters)." (forward-line)) ;; Set header line (setq proced-header-line - (mapconcat 'identity (nreverse header-list) whitespace)) + (mapconcat #'identity (nreverse header-list) whitespace)) (if (string-match "[ \t]+$" proced-header-line) (setq proced-header-line (substring proced-header-line 0 (match-beginning 0)))) @@ -1742,7 +1731,7 @@ The value returned is the value of the last form in BODY." (setq truncate-lines t proced-header-line header-line ; inherit header line header-line-format '(:eval (proced-header-line))) - (add-hook 'post-command-hook 'force-mode-line-update nil t) + (add-hook 'post-command-hook #'force-mode-line-update nil t) ;FIXME: Why? (let ((inhibit-read-only t)) (erase-buffer) (buffer-disable-undo) @@ -1780,8 +1769,8 @@ supported but discouraged. It will be removed in a future version of Emacs." (format "%d processes" (length process-alist)))) (completion-ignore-case t) (completion-extra-properties - '(:annotation-function - (lambda (s) (cdr (assoc s proced-signal-list)))))) + `(:annotation-function + ,(lambda (s) (cdr (assoc s proced-signal-list)))))) (proced-with-processes-buffer process-alist (list (completing-read (concat "Send signal [" pnum "] (default TERM): ") @@ -1805,8 +1794,8 @@ supported but discouraged. It will be removed in a future version of Emacs." (format "%d processes" (length process-alist)))) (completion-ignore-case t) (completion-extra-properties - '(:annotation-function - (lambda (s) (cdr (assoc s proced-signal-list)))))) + `(:annotation-function + ,(lambda (s) (cdr (assoc s proced-signal-list)))))) (proced-with-processes-buffer process-alist (setq signal (completing-read (concat "Send signal [" pnum "] (default TERM): ") diff --git a/lisp/profiler.el b/lisp/profiler.el index 3243e6432f2..bf8aacccc37 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -305,7 +305,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (let ((fun-map (make-hash-table :test 'profiler-function-equal)) (parent-map (make-hash-table :test 'eq)) (leftover-tree (profiler-make-calltree - :entry (intern "...") :parent tree))) + :entry '... :parent tree))) (push leftover-tree (profiler-calltree-children tree)) (maphash (lambda (backtrace _count) @@ -816,7 +816,7 @@ If MODE is `cpu' or `cpu+mem', time-based profiler will be started. Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started." (interactive (list (if (not (fboundp 'profiler-cpu-start)) 'mem - (intern (completing-read "Mode (default cpu): " + (intern (completing-read (format-prompt "Mode" "cpu") '("cpu" "mem" "cpu+mem") nil t nil nil "cpu"))))) (cl-ecase mode diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 24e1f8831a0..9dacd5856cf 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -52,7 +52,7 @@ ;; ;; * Probably. Show rules/dependencies for ANT like for Makefile (does ANT ;; support vocabularies and grammar inheritance?), I have to look at -;; jde-ant.el: http://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html +;; jde-ant.el: https://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html ;; * Probably. Make `indent-region' faster, especially in actions. ELP ;; profiling in a class init action shows half the time is spent in ;; `antlr-next-rule', the other half in `c-guess-basic-syntax'. @@ -720,9 +720,8 @@ imenu." "Major mode menu." `("Antlr" ,@(if (cond-emacs-xemacs - :EMACS (and antlr-options-use-submenus - (>= emacs-major-version 21)) - :XEMACS antlr-options-use-submenus) + :EMACS antlr-options-use-submenus + :XEMACS antlr-options-use-submenus) `(("Insert File Option" :filter ,(lambda (x) (antlr-options-menu-filter 1 x))) ("Insert Grammar Option" @@ -1875,7 +1874,7 @@ cell where the two values determine the area inside the braces." (defun antlr-option-spec (level option specs existsp) "Return version correct option value specification. Return specification for option OPTION of kind level LEVEL. SPECS -should correspond to the VALUE-SPEC... in `antlr-option-alists'. +should correspond to the VALUE-SPEC... in `antlr-options-alists'. EXISTSP determines whether the option already exists." (let (value) (while (and specs (>= antlr-tool-version (caar specs))) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 87e88163ac7..98e58be2303 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -42,7 +42,7 @@ ;; See documentation of function `bat-mode'. ;; ;; Separate package `dos-indent' (Matthew Fidler) provides rudimentary -;; indentation, see http://www.emacswiki.org/emacs/dos-indent.el. +;; indentation, see https://www.emacswiki.org/emacs/dos-indent.el. ;; ;; Acknowledgements: ;; diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 9a3d7adf61d..77e263f1aad 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -434,6 +434,15 @@ to it is returned. This function does not modify the point or the mark." (setq count (+ count (skip-chars-backward "\\\\")))) (not (zerop (logand count 1)))))) +(defmacro c-will-be-unescaped (beg end) + ;; Would the character after END be unescaped after the removal of (BEG END)? + ;; This is regardless of its current status. It is assumed that (>= POS END). + `(save-excursion + (let (count) + (goto-char ,beg) + (setq count (skip-chars-backward "\\\\")) + (zerop (logand count 1))))) + (defvar c-use-extents) (defmacro c-next-single-property-change (position prop &optional object limit) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 7b8b174c430..1649f507363 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -2238,7 +2238,7 @@ comment at the start of cc-engine.el for more info." ((and c-opt-cpp-prefix (looking-at c-noise-macro-name-re)) - ;; Skip over a noise macro. + ;; Skip over a noise macro without parens. (goto-char (match-end 1)) (not (eobp))) @@ -2697,7 +2697,7 @@ comment at the start of cc-engine.el for more info." ;; or the car of the list is the "position element" of ELT, the position ;; where ELT is valid. ;; - ;; POINT is left at the postition for which the returned state is valid. It + ;; POINT is left at the position for which the returned state is valid. It ;; will be either the position element of ELT, or one character before ;; that. (The latter happens in Emacs <= 25 and XEmacs, when ELT indicates ;; its position element directly follows a potential first character of a @@ -2767,7 +2767,7 @@ comment at the start of cc-engine.el for more info." ((nth 3 state) ; A string (list (point) (nth 3 state) (nth 8 state))) ((and (nth 4 state) ; A comment - (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment. + (not (eq (nth 7 state) 'syntax-table))) ; but not a pseudo comment. (list (point) (if (eq (nth 7 state) 1) 'c++ 'c) (nth 8 state))) @@ -2894,7 +2894,7 @@ comment at the start of cc-engine.el for more info." (setq nc-list (cdr nc-list)))))) (defun c-semi-get-near-cache-entry (here) - ;; Return the near cache entry at the highest postion before HERE, if any, + ;; Return the near cache entry at the highest position before HERE, if any, ;; or nil. The near cache entry is of the form (POSITION . STATE), where ;; STATE has the form of a result of `parse-partial-sexp'. (let ((nc-pos-state @@ -7170,7 +7170,7 @@ comment at the start of cc-engine.el for more info." ;; characters.) If the raw string is not terminated, E\) and E\" are set to ;; nil. ;; - ;; Note: this function is dependant upon the correct syntax-table text + ;; Note: this function is dependent upon the correct syntax-table text ;; properties being set. (let ((state (c-semi-pp-to-literal (point))) open-quote-pos open-paren-pos close-paren-pos close-quote-pos id) @@ -8426,6 +8426,7 @@ comment at the start of cc-engine.el for more info." ;; 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 - 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. @@ -8450,9 +8451,12 @@ comment at the start of cc-engine.el for more info." ;; 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)) (goto-char (match-end 1)) (c-forward-syntactic-ws) - (setq res 'prefix))) + (or (eq res 'no-id) + (setq res 'prefix)))) (cond ((looking-at c-typeof-key) ; e.g. C++'s "decltype". @@ -8503,28 +8507,30 @@ comment at the start of cc-engine.el for more info." (setq res t)) (unless res (goto-char start))) ; invalid syntax - ((progn - (setq pos nil) - (if (looking-at c-identifier-start) - (save-excursion - (setq id-start (point) - name-res (c-forward-name)) - (when name-res - (setq id-end (point) - id-range c-last-identifier-range)))) - (and (cond ((looking-at c-primitive-type-key) - (setq res t)) - ((c-with-syntax-table c-identifier-syntax-table - (looking-at c-known-type-key)) - (setq res 'known))) - (or (not id-end) - (>= (save-excursion - (save-match-data - (goto-char (match-end 1)) - (c-forward-syntactic-ws) - (setq pos (point)))) - id-end) - (setq res nil)))) + ((and + (not (eq res 'no-id)) + (progn + (setq pos nil) + (if (looking-at c-identifier-start) + (save-excursion + (setq id-start (point) + name-res (c-forward-name)) + (when name-res + (setq id-end (point) + id-range c-last-identifier-range)))) + (and (cond ((looking-at c-primitive-type-key) + (setq res t)) + ((c-with-syntax-table c-identifier-syntax-table + (looking-at c-known-type-key)) + (setq res 'known))) + (or (not id-end) + (>= (save-excursion + (save-match-data + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (setq pos (point)))) + id-end) + (setq res nil))))) ;; Looking at a primitive or known type identifier. We've ;; checked for a name first so that we don't go here if the ;; known type match only is a prefix of another name. @@ -8599,7 +8605,7 @@ comment at the start of cc-engine.el for more info." (goto-char start) (setq res nil))))) - (when res + (when (not (memq res '(nil no-id))) ;; Skip trailing type modifiers. If any are found we know it's ;; a type. (when c-opt-type-modifier-key @@ -9102,7 +9108,7 @@ This function might do hidden buffer changes." (let ((cdd-pos (point)) cdd-next-pos cdd-id-start cdd-id-end cdd-decl-res cdd-got-func cdd-got-type cdd-got-init - c-last-identifier-range cdd-exhausted) + c-last-identifier-range cdd-exhausted cdd-after-block) ;; The following `while' applies `cdd-function' to a single declarator id ;; each time round. It loops only when CDD-LIST is non-nil. @@ -9130,6 +9136,12 @@ This function might do hidden buffer changes." (catch 'is-function (while (progn + (while + (cond + ((looking-at c-decl-hangon-key) + (c-forward-keyword-clause 1)) + ((looking-at c-noise-macro-with-parens-name-re) + (c-forward-noise-clause)))) (if (eq (char-after) ?\)) (throw 'is-function t)) (setq cdd-got-type (c-forward-type)) @@ -9155,23 +9167,25 @@ This function might do hidden buffer changes." (c-forward-syntactic-ws cdd-limit) (setq cdd-exhausted t))) ; unbalanced parens - (cdd-got-init ; "=" sign OR opening "(", "[", or "{" - ;; Skip an initializer expression. If we're at a '=' - ;; then accept a brace list directly after it to cope - ;; with array initializers. Otherwise stop at braces - ;; to avoid going past full function and class blocks. - (if (and (if (and (eq cdd-got-init ?=) - (= (c-forward-token-2 1 nil cdd-limit) 0) - (looking-at "{")) - (c-go-list-forward (point) cdd-limit) - t) - ;; FIXME: Should look for c-decl-end markers here; - ;; we might go far into the following declarations - ;; in e.g. ObjC mode (see e.g. methods-4.m). - (c-syntactic-re-search-forward "[;,{]" cdd-limit 'move t)) + (cdd-got-init ; "=" sign OR opening "(", "[", or "(" + ;; Skip an initializer expression in braces, whether or not (in + ;; C++ Mode) preceded by an "=". Be careful that the brace list + ;; isn't a code block or a struct (etc.) block. + (cond + ((and (eq cdd-got-init ?=) + (zerop (c-forward-token-2 1 nil cdd-limit)) + (eq (char-after) ?{) + (c-go-list-forward (point) cdd-limit))) + ((and (eq cdd-got-init ?{) + c-recognize-bare-brace-inits + (setq cdd-after-block + (save-excursion + (c-go-list-forward (point) cdd-limit))) + (not (c-looking-at-statement-block))) + (goto-char cdd-after-block))) + (if (c-syntactic-re-search-forward "[;,{]" cdd-limit 'move t) (backward-char) - (setq cdd-exhausted t) - )) + (setq cdd-exhausted t))) (t (c-forward-syntactic-ws cdd-limit))) @@ -9444,12 +9458,11 @@ This function might do hidden buffer changes." (when (setq found-type (c-forward-type t)) ; brace-block-too ;; Found a known or possible type or a prefix of a known type. - (when (and (c-major-mode-is 'c++-mode) ; C++11 style "auto"? - (eq prev-kwd-sym (c-keyword-sym "auto")) - (looking-at "[=(]")) ; FIXME!!! proper regexp. - (setq new-style-auto t) - (setq found-type nil) - (goto-char start)) ; position of foo in "auto foo" + (when (and (eq found-type 'no-id) + (save-excursion + (and (c-forward-name) ; over the identifier + (looking-at "[=(]")))) ; FIXME!!! proper regexp. + (setq new-style-auto t)) ; position of foo in "auto foo" (when at-type ;; Got two identifiers with nothing but whitespace @@ -9532,7 +9545,7 @@ This function might do hidden buffer changes." ;; over all specifiers and type identifiers. The reason ;; to do this for a known type prefix is to make things ;; like "unsigned INT16" work. - (and found-type (not (eq found-type t)))))) + (and found-type (not (memq found-type '(t no-id))))))) (cond ((eq at-type t) @@ -9552,6 +9565,10 @@ This function might do hidden buffer changes." ;; followed by another type. (setq at-type t)) + ((eq at-type 'no-id) + ;; For an auto type, we assume we definitely have a type construct. + (setq at-type t)) + ((not at-type) ;; Got no type but set things up to continue anyway to handle ;; the various cases when a declaration doesn't start with a @@ -9780,6 +9797,16 @@ This function might do hidden buffer changes." (save-excursion (goto-char after-paren-pos) (c-forward-syntactic-ws) + (progn + (while + (cond + ((and + c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause)) + ((looking-at c-decl-hangon-key) + (c-forward-keyword-clause 1)))) + t) (or (c-forward-type) ;; Recognize a top-level typeless ;; function declaration in C. @@ -11749,7 +11776,22 @@ comment at the start of cc-engine.el for more info." (save-excursion (c-backward-syntactic-ws) (point)) nil nil)) (and (consp res) - (eq (car res) after-type-id-pos)))))) + (cond + ((eq (car res) after-type-id-pos)) + ((> (car res) after-type-id-pos) nil) + (t + (catch 'find-decl + (save-excursion + (goto-char (car res)) + (c-do-declarators + (point-max) t nil nil + (lambda (id-start id-end tok not-top func init) + (cond + ((> id-start after-type-id-pos) + (throw 'find-decl nil)) + ((eq id-start after-type-id-pos) + (throw 'find-decl t))))) + nil))))))))) (cons bufpos (or in-paren inexpr-brace-list))) ((or (eq (char-after) ?\;) ;; Brace lists can't contain a semicolon, so we're done. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 386cc2f16fe..bb7e5bea6e6 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1073,17 +1073,18 @@ casts and declarations are fontified. Used on level 2 and higher." (defun c-font-lock-declarators (limit list types not-top &optional template-class) ;; Assuming the point is at the start of a declarator in a declaration, - ;; fontify the identifier it declares. (If TYPES is set, it does this via - ;; the macro `c-fontify-types-and-refs'.) + ;; fontify the identifier it declares. (If TYPES is t, it does this via the + ;; macro `c-fontify-types-and-refs'.) ;; ;; If LIST is non-nil, also fontify the ids in any following declarators in ;; a comma separated list (e.g. "foo" and "*bar" in "int foo = 17, *bar;"); ;; additionally, mark the commas with c-type property 'c-decl-id-start or ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; - ;; If TYPES is non-nil, fontify all identifiers as types. If NOT-TOP is - ;; non-nil, we are not at the top-level ("top-level" includes being directly - ;; inside a class or namespace, etc.). + ;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as + ;; either variables or functions, otherwise TYPES is a face to use. If + ;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes + ;; being directly inside a class or namespace, etc.). ;; ;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters ;; and was introduced by, e.g. "typename" or "class", such that if there is @@ -1100,9 +1101,10 @@ casts and declarations are fontified. Used on level 2 and higher." () (c-do-declarators limit list not-top - (if types 'c-decl-type-start 'c-decl-id-start) + (cond ((eq types t) 'c-decl-type-start) + ((null types) 'c-decl-id-start)) (lambda (id-start _id-end end-pos _not-top is-function init-char) - (if types + (if (eq types t) ;; Register and fontify the identifier as a type. (let ((c-promote-possible-types t)) (goto-char id-start) @@ -1121,9 +1123,10 @@ casts and declarations are fontified. Used on level 2 and higher." ;; `c-forward-declarator'. (c-put-font-lock-face (car c-last-identifier-range) (cdr c-last-identifier-range) - (if is-function - 'font-lock-function-name-face - 'font-lock-variable-name-face)))) + (cond + ((not (memq types '(nil t))) types) + (is-function 'font-lock-function-name-face) + (t 'font-lock-variable-name-face))))) (and template-class (eq init-char ?=) ; C++ "<class X = Y>"? (progn @@ -1357,7 +1360,8 @@ casts and declarations are fontified. Used on level 2 and higher." 'c-decl-id-start))))) (c-font-lock-declarators (min limit (point-max)) decl-list - (cadr decl-or-cast) (not toplev) template-class)) + (not (null (cadr decl-or-cast))) + (not toplev) template-class)) ;; A declaration has been successfully identified, so do all the ;; fontification of types and refs that've been recorded. @@ -2004,6 +2008,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." ,@(when (c-major-mode-is 'c++-mode) '(c-font-lock-c++-lambda-captures)) + ,@(when (c-lang-const c-using-key) + `(c-font-lock-c++-using)) + ;; The first two rules here mostly find occurrences that ;; `c-font-lock-declarations' has found already, but not ;; declarations containing blocks in the type (see note below). @@ -2263,6 +2270,40 @@ need for `c-font-lock-extra-types'.") ;;; C++. +(defun c-font-lock-c++-using (limit) + ;; Fontify any clauses starting with the keyword `using'. + ;; + ;; This function will be called from font-lock- for a region bounded by + ;; POINT and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; fontification". + (let (pos after-name) + (while (c-syntactic-re-search-forward c-using-key limit 'end) + (while ; Do one declarator of a comma separated list, each time around. + (progn + (c-forward-syntactic-ws) + (setq pos (point)) ; token after "using". + (when (and (c-on-identifier) + (c-forward-name)) + (setq after-name (point)) + (cond + ((eq (char-after) ?=) ; using foo = <type-id>; + (goto-char pos) + (c-font-lock-declarators limit nil t nil)) + ((save-excursion + (and c-colon-type-list-re + (c-go-up-list-backward) + (eq (char-after) ?{) + (eq (car (c-beginning-of-decl-1)) 'same) + (looking-at c-colon-type-list-re))) + ;; Inherited protected member: leave unfontified + ) + (t (goto-char pos) + (c-font-lock-declarators limit nil c-label-face-name nil))) + (eq (char-after) ?,))) + (forward-char))) ; over the comma. + nil)) (defun c-font-lock-c++-new (limit) ;; FIXME!!! Put in a comment about the context of this function's diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index b77bf3303b6..80c461c76cb 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2121,7 +2121,9 @@ fontified with the keyword face and not the type face." t nil c '("const" "restrict" "volatile") c++ '("const" "noexcept" "volatile") - objc '("const" "volatile")) + objc '("const" "volatile") + t (append (c-lang-const c-no-type-kwds) + (c-lang-const c-type-modifier-prefix-kwds))) (c-lang-defconst c-opt-type-modifier-prefix-key ;; Adorned regexp matching `c-type-modifier-prefix-kwds', or nil in @@ -2338,6 +2340,26 @@ will be handled." t (c-make-keywords-re t (c-lang-const c-typedef-decl-kwds))) (c-lang-defvar c-typedef-decl-key (c-lang-const c-typedef-decl-key)) +(c-lang-defconst c-using-kwds + "Keywords which behave like `using' in C++" + t nil + c++ '("using")) + +(c-lang-defconst c-using-key + ;; Regexp matching C++'s `using'. + t (c-make-keywords-re t (c-lang-const c-using-kwds))) +(c-lang-defvar c-using-key (c-lang-const c-using-key)) + +(c-lang-defconst c-no-type-kwds + "Keywords which remove the need to specify a type in declarations" + t nil + c++ '("auto")) + +(c-lang-defconst c-no-type-key + ;; Regexp matching an entry from `c-no-type-kwds' + t (c-make-keywords-re t (c-lang-const c-no-type-kwds))) +(c-lang-defvar c-no-type-key (c-lang-const c-no-type-key)) + (c-lang-defconst c-typeless-decl-kwds "Keywords introducing declarations where the (first) identifier \(declarator) follows directly after the keyword, without any type. @@ -2351,7 +2373,6 @@ will be handled." ;; {...}"). t (append (c-lang-const c-class-decl-kwds) (c-lang-const c-brace-list-decl-kwds)) - c++ (append (c-lang-const c-typeless-decl-kwds) '("auto")) ; C++11. ;; Note: "manages" for CORBA CIDL clashes with its presence on ;; `c-type-list-kwds' for IDL. idl (append (c-lang-const c-typeless-decl-kwds) @@ -2386,9 +2407,11 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', `c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses will be handled." t nil - (c c++) '("auto" "extern" "inline" "register" "static") + (c c++) '("extern" "inline" "register" "static") + c (append '("auto") (c-lang-const c-modifier-kwds)) c++ (append '("constexpr" "explicit" "friend" "mutable" "template" - "thread_local" "using" "virtual") + "thread_local" "virtual") + ;; "using" is now handled specially (2020-09-14). (c-lang-const c-modifier-kwds)) objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static") ;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead. @@ -3701,6 +3724,20 @@ Foo bar = gnu;" c++ t) (c-lang-defvar c-recognize-paren-inits (c-lang-const c-recognize-paren-inits)) +(c-lang-defconst c-recognize-bare-brace-inits + "Non-nil means that brace initializers without \"=\" exist, +i.e. constructs like + +int foo[] {1, 2, 3}; + +in addition to the more classic + +int foo[] = {1, 2, 3};" + t nil + c++ t) +(c-lang-defvar c-recognize-bare-brace-inits + (c-lang-const c-recognize-bare-brace-inits)) + (c-lang-defconst c-recognize-paren-inexpr-blocks "Non-nil to recognize gcc style in-expression blocks, i.e. compound statements surrounded by parentheses inside expressions." diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 2ffbde99aa4..c6dd671051d 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1478,9 +1478,11 @@ Note that the style variables are always made local to the buffer." (c-will-be-escaped end beg end)) (c-remove-string-fences end) (goto-char (1+ end))) - ;; Are we unescaping a newline by inserting stuff between \ and \n? - ((and (eq end beg) - (c-is-escaped end)) + ;; Are we unescaping a newline ... + ((and + (c-is-escaped end) + (or (eq beg end) ; .... by inserting stuff between \ and \n? + (c-will-be-unescaped beg end))) ; ... by removing an odd number of \s? (goto-char (1+ end))) ; To after the NL which is being unescaped. (t (goto-char end))) @@ -1518,10 +1520,11 @@ Note that the style variables are always made local to the buffer." (not (c-characterp c-multiline-string-start-char)))) (when (and (eq end-literal-type 'string) (not (eq (char-before (cdr end-limits)) ?\()) - (memq (char-after (car end-limits)) c-string-delims) - (equal (c-get-char-property (car end-limits) 'syntax-table) - '(15))) - (c-remove-string-fences (car end-limits)) + (memq (char-after (car end-limits)) c-string-delims)) + (setq c-new-END (max c-new-END (cdr end-limits))) + (when (equal (c-get-char-property (car end-limits) 'syntax-table) + '(15)) + (c-remove-string-fences (car end-limits))) (setq c-new-END (max c-new-END (cdr end-limits)))) (when (and (eq beg-literal-type 'string) @@ -1594,8 +1597,12 @@ Note that the style variables are always made local to the buffer." ; insertion/deletion of string delimiters. (max (progn - (goto-char (min (1+ end) ; 1+, in case a NL has become escaped. - (point-max))) + (goto-char + (if (and (memq (char-after end) '(?\n ?\r)) + (c-is-escaped end)) + (min (1+ end) ; 1+, if we're inside an escaped NL. + (point-max)) + end)) (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t) (point)) @@ -2259,7 +2266,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (defun c-fl-decl-end (pos) ;; If POS is inside a declarator, return the end of the token that follows ;; the declarator, otherwise return nil. POS being in a literal does not - ;; count as being in a declarator (on pragmatic grounds). + ;; count as being in a declarator (on pragmatic grounds). POINT is not + ;; preserved. (goto-char pos) (let ((lit-start (c-literal-start)) enclosing-attribute pos1) @@ -2272,12 +2280,31 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (let ((lim (save-excursion (and (c-beginning-of-macro) (progn (c-end-of-macro) (point)))))) - (when (and (c-forward-declarator lim) - (or (not (eq (char-after) ?\()) - (c-go-list-forward nil lim)) - (eq (c-forward-token-2 1 nil lim) 0)) - (c-backward-syntactic-ws) - (point))))))) + (and (c-forward-declarator lim) + (if (eq (char-after) ?\() + (and + (c-go-list-forward nil lim) + (progn (c-forward-syntactic-ws lim) + (not (eobp))) + (progn + (if (looking-at c-symbol-char-key) + ;; Deal with baz (foo((bar)) type var), where + ;; foo((bar)) is not semantically valid. The result + ;; must be after var). + (and + (goto-char pos) + (setq pos1 (c-on-identifier)) + (goto-char pos1) + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?\()) + (c-fl-decl-end (1- (point)))) + (c-backward-syntactic-ws) + (point)))) + (and (progn (c-forward-syntactic-ws lim) + (not (eobp))) + (c-backward-syntactic-ws) + (point))))))))) (defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 36be9f6c74e..855e467571d 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -395,8 +395,7 @@ a null operation." ;; remain. This is not necessary for c-offsets-alist, since ;; c-get-style-variables contains every valid offset type in the ;; fallback entry. - (setq c-special-indent-hook - (default-value 'c-special-indent-hook))) + (kill-local-variable 'c-special-indent-hook)) (mapc (lambda (elem) (c-set-style-1 elem dont-override)) ;; Need to go through the variables backwards when we @@ -644,7 +643,7 @@ CC Mode by making sure the proper entries are present on (defun c-make-styles-buffer-local (&optional this-buf-only-p) "Make all CC Mode style variables buffer local. -If `this-buf-only-p' is non-nil, the style variables will be made +If THIS-BUF-ONLY-P is non-nil, the style variables will be made buffer local only in the current buffer. Otherwise they'll be made permanently buffer local in any buffer that changes their values. @@ -662,7 +661,6 @@ any reason to call this function directly." ;; Hooks must be handled specially (if this-buf-only-p (if (featurep 'xemacs) (make-local-hook 'c-special-indent-hook)) - (with-no-warnings (make-variable-buffer-local 'c-special-indent-hook)) (setq c-style-variables-are-local-p t)) )) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index b885f6ae1d8..9e6f9527ca1 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1670,7 +1670,8 @@ indented as a statement." like \"INLINE\" which are syntactic noise. Such a macro/extension is complete in itself, never having parentheses. All these names must be syntactically valid identifiers. Alternatively, this variable may be a regular expression -which matches the names of such macros. +which matches the names of such macros, in which case it must have a submatch +1 which matches the actual noise macro name. If you change this variable's value, call the function `c-make-noise-macro-regexps' to set the necessary internal variables (or do @@ -1686,7 +1687,8 @@ this implicitly by reinitializing C/C++/Objc Mode on any buffer)." which optionally have arguments in parentheses, and which expand to nothing. All these names must be syntactically valid identifiers. These are recognized by CC Mode only in declarations. Alternatively, this variable may be a -regular expression which matches the names of such macros. +regular expression which matches the names of such macros, in which case it +must have a submatch 1 which matches the actual noise macro name. If you change this variable's value, call the function `c-make-noise-macro-regexps' to set the necessary internal variables (or do diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el index 7ef43fd4490..cb6bd6c34bb 100644 --- a/lisp/progmodes/cl-font-lock.el +++ b/lisp/progmodes/cl-font-lock.el @@ -23,7 +23,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -277,6 +277,7 @@ (define-minor-mode cl-font-lock-built-in-mode "Highlight built-in functions, variables, and types in `lisp-mode'." :global t + :group 'tools (funcall (if cl-font-lock-built-in-mode #'font-lock-add-keywords diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 13b672bd53b..de0ea428d5e 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -33,6 +33,7 @@ (eval-when-compile (require 'cl-lib)) (require 'tool-bar) (require 'comint) +(require 'text-property-search) (defgroup compilation nil "Run compiler as inferior of Emacs, parse error messages." @@ -64,7 +65,8 @@ If nil, use Emacs default." If the replacement is nil, the file will not be considered an error after all. If not nil, it should be a regexp replacement string." - :type '(repeat (list regexp string)) + :type '(repeat (list regexp (choice (const :tag "No replacement" nil) + string))) :version "27.1") (defvar compilation-filter-hook nil @@ -449,6 +451,9 @@ during global destruction\\.$\\)" 1 2) \\([0-9]+\\) of file://\\(.+\\)" 4 2 3 (1)) + (shellcheck + "^In \\(.+\\) line \\([0-9]+\\):" 1 2) + (sparc-pascal-file "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\ [12][09][0-9][0-9] +\\(.*\\):$" @@ -740,6 +745,18 @@ variable, and you might not notice. Therefore, `compile-command' is considered unsafe if this variable is nil." :type 'boolean) +(defcustom compilation-search-all-directories t + "Whether further upward directories should be used when searching a file. +When doing a parallel build, several files from different +directories can be compiled at the same time. This makes it +difficult to determine the base directory for a relative file +name in a compiler error or warning. If this variable is +non-nil, instead of just relying on the previous directory change +in the compilation buffer, all other directories further upwards +will be used as well." + :type 'boolean + :version "28.1") + ;;;###autoload (defcustom compilation-ask-about-save t "Non-nil means \\[compile] asks which buffers to save before compiling. @@ -1046,9 +1063,9 @@ from a different message." (:constructor nil) (:copier nil) ;; (:type list) ;Old representation. - (:constructor compilation--make-message (loc type end-loc)) + (:constructor compilation--make-message (loc type end-loc rule)) (:conc-name compilation--message->)) - loc type end-loc) + loc type end-loc rule) (defvar compilation--previous-directory-cache nil "A pair (POS . RES) caching the result of previous directory search. @@ -1121,7 +1138,7 @@ POS and RES.") (cons (match-string-no-properties idx) dir)) ;; Place a `compilation-message' everywhere we change text-properties ;; so compilation--remove-properties can know what to remove. - compilation-message ,(compilation--make-message nil 0 nil) + compilation-message ,(compilation--make-message nil 0 nil nil) mouse-face highlight keymap compilation-button-map help-echo "mouse-2: visit destination directory"))) @@ -1160,7 +1177,8 @@ POS and RES.") ;; all information needed to later jump to corresponding source code. ;; Return a property list with all meta information on this error location. -(defun compilation-error-properties (file line end-line col end-col type fmt) +(defun compilation-error-properties (file line end-line col end-col type fmt + rule) (unless (text-property-not-all (match-beginning 0) (point) 'compilation-message nil) (if file @@ -1224,12 +1242,12 @@ POS and RES.") 2))) ;; Remove matches like /bin/sh and do other file name transforms. (save-match-data - (let ((file-name - (and (consp file) - (not (bufferp (car file))) - (if (cdr file) - (expand-file-name (car file) (cdr file)) - (car file))))) + (when-let ((file-name + (and (consp file) + (not (bufferp (car file))) + (if (cdr file) + (expand-file-name (car file) (cdr file)) + (car file))))) (cl-loop for (regexp replacement) in compilation-transform-file-match-alist when (string-match regexp file-name) @@ -1248,7 +1266,7 @@ POS and RES.") (current-buffer) (match-beginning 0))) (compilation-internal-error-properties - file line end-line col end-col type fmt)))) + file line end-line col end-col type fmt rule)))) (defun compilation-beginning-of-line (&optional n) "Like `beginning-of-line', but accounts for lines hidden by `selective-display'." @@ -1271,13 +1289,15 @@ just char-counts." (let ((tab-width 8)) (move-to-column (max col 0))) (goto-char (min (+ (line-beginning-position) col) (line-end-position))))) -(defun compilation-internal-error-properties (file line end-line col end-col type fmts) +(defun compilation-internal-error-properties (file line end-line col end-col + type fmts rule) "Get the meta-info that will be added as text-properties. LINE, END-LINE, COL, END-COL are integers or nil. TYPE can be 0, 1, or 2, meaning error, warning, or just info. FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or (BUFFER) or nil. FMTS is a list of format specs for transforming the file name. +RULE is the name (symbol) of the rule used or nil if anonymous. (See `compilation-error-regexp-alist'.)" (unless file (setq file '("*unknown*"))) (let* ((file-struct (compilation-get-file-structure file fmts)) @@ -1364,7 +1384,7 @@ FMTS is a list of format specs for transforming the file name. ;; Must start with face `(font-lock-face ,compilation-message-face - compilation-message ,(compilation--make-message loc type end-loc) + compilation-message ,(compilation--make-message loc type end-loc rule) help-echo ,(if col "mouse-2: visit this file, line and column" (if line @@ -1456,105 +1476,109 @@ This updates the appropriate variable used by the mode-line." "Parse errors between START and END. The errors recognized are the ones specified in RULES which default to `compilation-error-regexp-alist' if RULES is nil." - (dolist (item (or rules compilation-error-regexp-alist)) - (if (symbolp item) - (setq item (cdr (assq item - compilation-error-regexp-alist-alist)))) - (let ((case-fold-search compilation-error-case-fold-search) - (file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item)) - (type (nth 4 item)) - (pat (car item)) - end-line end-col fmt - props) - - ;; omake reports some error indented, so skip the indentation. - ;; another solution is to modify (some?) regexps in - ;; `compilation-error-regexp-alist'. - ;; note that omake usage is not limited to ocaml and C (for stubs). - ;; FIXME-omake: Doing it here seems wrong, at least it should depend on - ;; whether or not omake's own error messages are recognized. - (cond - ((not (memq 'omake compilation-error-regexp-alist)) nil) - ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) - nil) ;; Not anchored or anchored but already allows empty spaces. - (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) - - (if (and (consp file) (not (functionp file))) - (setq fmt (cdr file) - file (car file))) - (if (and (consp line) (not (functionp line))) - (setq end-line (cdr line) - line (car line))) - (if (and (consp col) (not (functionp col))) - (setq end-col (cdr col) - col (car col))) - - (unless (or (null (nth 5 item)) (integerp (nth 5 item))) - (error "HYPERLINK should be an integer: %s" (nth 5 item))) - - (goto-char start) - (while (re-search-forward pat end t) - (when (setq props (compilation-error-properties - file line end-line col end-col (or type 2) fmt)) - - (when (integerp file) - (let ((this-type (if (consp type) - (compilation-type type) - (or type 2)))) - (compilation--note-type this-type) - - (compilation--put-prop - file 'font-lock-face - (symbol-value (aref [compilation-info-face - compilation-warning-face - compilation-error-face] - this-type))))) - - (compilation--put-prop - line 'font-lock-face compilation-line-face) - (compilation--put-prop - end-line 'font-lock-face compilation-line-face) - - (compilation--put-prop - col 'font-lock-face compilation-column-face) - (compilation--put-prop - end-col 'font-lock-face compilation-column-face) - - ;; Obey HIGHLIGHT. - (dolist (extra-item (nthcdr 6 item)) - (let ((mn (pop extra-item))) - (when (match-beginning mn) - (let ((face (eval (car extra-item)))) - (cond - ((null face)) - ((or (symbolp face) (stringp face)) - (put-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face face)) - ((and (listp face) - (eq (car face) 'face) - (or (symbolp (cadr face)) - (stringp (cadr face)))) - (compilation--put-prop mn 'font-lock-face (cadr face)) - (add-text-properties - (match-beginning mn) (match-end mn) - (nthcdr 2 face))) - (t - (error "Don't know how to handle face %S" - face))))))) - (let ((mn (or (nth 5 item) 0))) - (when compilation-debug + (let ((case-fold-search compilation-error-case-fold-search) + (omake-included (memq 'omake compilation-error-regexp-alist))) + (dolist (rule-item (or rules compilation-error-regexp-alist)) + (let* ((item + (if (symbolp rule-item) + (cdr (assq rule-item compilation-error-regexp-alist-alist)) + rule-item)) + (pat (car item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + (type (nth 4 item)) + (rule (and (symbolp rule-item) rule-item)) + end-line end-col fmt + props) + + ;; omake reports some error indented, so skip the indentation. + ;; another solution is to modify (some?) regexps in + ;; `compilation-error-regexp-alist'. + ;; note that omake usage is not limited to ocaml and C (for stubs). + ;; FIXME-omake: Doing it here seems wrong, at least it should depend on + ;; whether or not omake's own error messages are recognized. + (cond + ((not omake-included) nil) + ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) + nil) ;; Not anchored or anchored but already allows empty spaces. + (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) + + (if (and (consp file) (not (functionp file))) + (setq fmt (cdr file) + file (car file))) + (if (and (consp line) (not (functionp line))) + (setq end-line (cdr line) + line (car line))) + (if (and (consp col) (not (functionp col))) + (setq end-col (cdr col) + col (car col))) + + (unless (or (null (nth 5 item)) (integerp (nth 5 item))) + (error "HYPERLINK should be an integer: %s" (nth 5 item))) + + (goto-char start) + (while (re-search-forward pat end t) + (when (setq props (compilation-error-properties + file line end-line col end-col + (or type 2) fmt rule)) + + (when (integerp file) + (let ((this-type (if (consp type) + (compilation-type type) + (or type 2)))) + (compilation--note-type this-type) + + (compilation--put-prop + file 'font-lock-face + (symbol-value (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + this-type))))) + + (compilation--put-prop + line 'font-lock-face compilation-line-face) + (compilation--put-prop + end-line 'font-lock-face compilation-line-face) + + (compilation--put-prop + col 'font-lock-face compilation-column-face) + (compilation--put-prop + end-col 'font-lock-face compilation-column-face) + + ;; Obey HIGHLIGHT. + (dolist (extra-item (nthcdr 6 item)) + (let ((mn (pop extra-item))) + (when (match-beginning mn) + (let ((face (eval (car extra-item)))) + (cond + ((null face)) + ((or (symbolp face) (stringp face)) + (put-text-property + (match-beginning mn) (match-end mn) + 'font-lock-face face)) + ((and (listp face) + (eq (car face) 'face) + (or (symbolp (cadr face)) + (stringp (cadr face)))) + (compilation--put-prop mn 'font-lock-face (cadr face)) + (add-text-properties + (match-beginning mn) (match-end mn) + (nthcdr 2 face))) + (t + (error "Don't know how to handle face %S" + face))))))) + (let ((mn (or (nth 5 item) 0))) + (when compilation-debug + (font-lock-append-text-property + (match-beginning 0) (match-end 0) + 'compilation-debug (vector 'std item props))) + (add-text-properties + (match-beginning mn) (match-end mn) + (cddr props)) (font-lock-append-text-property - (match-beginning 0) (match-end 0) - 'compilation-debug (vector 'std item props))) - (add-text-properties - (match-beginning mn) (match-end mn) - (cddr props)) - (font-lock-append-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face (cadr props)))))))) + (match-beginning mn) (match-end mn) + 'font-lock-face (cadr props))))))))) (defvar compilation--parsed -1) (make-variable-buffer-local 'compilation--parsed) @@ -1569,7 +1593,14 @@ to `compilation-error-regexp-alist' if RULES is nil." ;; grep.el) don't need to flush-parse when they modify the buffer ;; in a way that impacts buffer positions but does not require ;; re-parsing. - (setq compilation--parsed (point-min-marker))) + (setq compilation--parsed + (set-marker (make-marker) + (save-excursion + (goto-char (point-min)) + (text-property-search-forward 'compilation-header-end) + ;; If we have no end marker, this will be + ;; `point-min' still. + (point))))) (when (< compilation--parsed limit) (let ((start (max compilation--parsed (point-min)))) (move-marker compilation--parsed limit) @@ -1814,6 +1845,9 @@ Returns the compilation buffer created." mode-name (substring (current-time-string) 0 19)) command "\n") + ;; Mark the end of the header so that we don't interpret + ;; anything in it as an error. + (put-text-property (1- (point)) (point) 'compilation-header-end t) (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. @@ -2090,8 +2124,7 @@ Returns the compilation buffer created." '(menu-item "Compile..." compile :help "Compile the program including the current buffer. Default: run `make'")) map) - "Keymap for compilation log buffers. -`compilation-minor-mode-map' is a parent of this.") + "Keymap for compilation log buffers.") (defvar compilation-mode-tool-bar-map ;; When bootstrapping, tool-bar-map is not properly initialized yet, @@ -2902,6 +2935,28 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (find-file-noselect name)) fmts (cdr fmts))) (setq dirs (cdr dirs))) + ;; If we haven't found it, this might be a parallel build. + ;; Search the directories further up the buffer. + (when (and (null buffer) + compilation-search-all-directories) + (with-current-buffer (marker-buffer marker) + (save-excursion + (goto-char (marker-position marker)) + (when-let ((prev (compilation--previous-directory (point)))) + (goto-char prev)) + (setq dirs (cdr (or (get-text-property + (1- (point)) 'compilation-directory) + (get-text-property + (point) 'compilation-directory)))))) + (while (and dirs (null buffer)) + (setq thisdir (car dirs) + fmts formats) + (while (and fmts (null buffer)) + (setq name (expand-file-name (format (car fmts) filename) thisdir) + buffer (and (file-exists-p name) + (find-file-noselect name)) + fmts (cdr fmts))) + (setq dirs (cdr dirs)))) (while (null buffer) ;Repeat until the user selects an existing file. ;; The file doesn't exist. Ask the user where to find it. (save-excursion ;This save-excursion is probably not right. @@ -3065,7 +3120,7 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." ;; 'font-lock-face 'font-lock-warning-face) (put-text-property src (line-end-position) 'compilation-message - (compilation--make-message loc 2 nil))))))) + (compilation--make-message loc 2 nil nil))))))) (goto-char limit) nil) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index af179e2797e..ebbea6bed92 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -7,6 +7,7 @@ ;; Jonathan Rockway <jon@jrock.us> ;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, Perl +;; Package-Requires: ((emacs "26.1")) ;; This file is part of GNU Emacs. @@ -32,7 +33,7 @@ ;; support. ;; The latest version is available from -;; http://github.com/jrockway/cperl-mode +;; https://github.com/jrockway/cperl-mode ;; ;; (perhaps in the moosex-declare branch) @@ -47,6 +48,10 @@ ;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< ;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< ;; `cperl-praise', `cperl-speed'. <<<<<< +;; +;; Or search for "Short extra-docs" further down in this file for +;; details on how to use `cperl-mode' instead of `perl-mode' and lots +;; of other details. ;; The mode information (on C-h m) provides some customization help. ;; If you use font-lock feature of this mode, it is advisable to use @@ -66,15 +71,28 @@ ;; (define-key global-map [M-S-down-mouse-3] 'imenu) -;;;; Font lock bugs as of v4.32: - -;; The following kinds of Perl code erroneously start strings: -;; \$` \$' \$" -;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../ -;; likewise with m, tr, y, q, qX instead of s - ;;; Code: +;;; Compatibility with older versions (for publishing on ELPA) +;; The following helpers allow cperl-mode.el to work with older +;; versions of Emacs. +;; +;; Whenever the minimum version is bumped (see "Package-Requires" +;; above), please eliminate the corresponding compatibility-helpers. +;; Whenever you create a new compatibility-helper, please add it here. + +;; Available in Emacs 27.1: time-convert +(defalias 'cperl--time-convert + (if (fboundp 'time-convert) 'time-convert + 'encode-time)) + +;; Available in Emacs 28: format-prompt +(defalias 'cperl--format-prompt + (if (fboundp 'format-prompt) 'format-prompt + (lambda (msg default) + (if default (format "%s (default %s): " msg default) + (concat msg ": "))))) + (eval-when-compile (require 'cl-lib)) (defvar msb-menu-cond) @@ -82,13 +100,6 @@ (defvar vc-rcs-header) (defvar vc-sccs-header) -(defmacro cperl-force-face (arg descr) ; Takes unquoted arg - `(progn - (or (facep (quote ,arg)) - (make-face ,arg)) - (or (boundp (quote ,arg)) ; We use unquoted variants too - (defvar ,arg (quote ,arg) ,descr)))) - (defun cperl-choose-color (&rest list) (let (answer) (while list @@ -663,10 +674,6 @@ micro-docs on what I know about CPerl problems.") (defvar cperl-problems 'please-ignore-this-line "Description of problems in CPerl mode. -Some faces will not be shown on some versions of Emacs unless you -install choose-color.el, available from - http://ilyaz.org/software/emacs - `fill-paragraph' on a comment may leave the point behind the paragraph. It also triggers a bug in some versions of Emacs (CPerl tries to detect it and bulk out). @@ -814,7 +821,7 @@ capable syntax engines). (defvar cperl-speed 'please-ignore-this-line "This is an incomplete compendium of what is available in other parts -of CPerl documentation. (Please inform me if I skept anything.) +of CPerl documentation. (Please inform me if I skipped anything.) There is a perception that CPerl is slower than alternatives. This part of documentation is designed to overcome this misconception. @@ -1234,6 +1241,7 @@ versions of Emacs." ["Auto fill" auto-fill-mode t]) ("Indent styles..." ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-set-style "PBP") t] ["PerlStyle" (cperl-set-style "PerlStyle") t] ["GNU" (cperl-set-style "GNU") t] ["C++" (cperl-set-style "C++") t] @@ -1553,12 +1561,12 @@ Variables controlling indentation style: `cperl-min-label-indent' Minimal indentation for line that is a label. -Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith - `cperl-indent-level' 5 4 2 4 - `cperl-brace-offset' 0 0 0 0 - `cperl-continued-brace-offset' -5 -4 0 0 - `cperl-label-offset' -5 -4 -2 -4 - `cperl-continued-statement-offset' 5 4 2 4 +Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith + `cperl-indent-level' 5 4 2 4 4 + `cperl-brace-offset' 0 0 0 0 0 + `cperl-continued-brace-offset' -5 -4 0 0 0 + `cperl-label-offset' -5 -4 -2 -2 -4 + `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the corresponding variables. Use \\[cperl-set-style] to do this. Use @@ -1714,10 +1722,9 @@ or as help on variables `cperl-tips', `cperl-problems', (if cperl-hook-after-change (add-hook 'after-change-functions #'cperl-after-change-function nil t)) ;; After hooks since fontification will break this - (if cperl-pod-here-scan - (or cperl-syntaxify-by-font-lock - (progn (or cperl-faces-init (cperl-init-faces-weak)) - (cperl-find-pods-heres)))) + (when (and cperl-pod-here-scan + (not cperl-syntaxify-by-font-lock)) + (cperl-find-pods-heres)) ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) @@ -3261,9 +3268,6 @@ Works before syntax recognition is done." result)) -(defvar font-lock-string-face) -;;(defvar font-lock-reference-face) -(defvar font-lock-constant-face) (defsubst cperl-postpone-fontification (b e type val &optional now) ;; Do after syntactic fontification? (if cperl-syntaxify-by-font-lock @@ -3329,16 +3333,6 @@ Works before syntax recognition is done." (setq end (point))))) (or end pos))))) -;; These are needed for byte-compile (at least with v19) -(defvar cperl-nonoverridable-face) -(defvar font-lock-variable-name-face) -(defvar font-lock-function-name-face) -(defvar font-lock-keyword-face) -(defvar font-lock-builtin-face) -(defvar font-lock-type-face) -(defvar font-lock-comment-face) -(defvar font-lock-warning-face) - (defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos) "Syntactically mark (and fontify) attributes of a subroutine. Should be called with the point before leading colon of an attribute." @@ -4485,7 +4479,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', 'syntax-table cperl-st-cfence)))) (setq was-subgr nil)) (t ; (?#)-comment - ;; Inside "(" and "\" arn't special in any way + ;; Inside "(" and "\" aren't special in any way ;; Works also if the outside delimiters are (). (or;;(if (eq (char-after b) ?\) ) ;;(re-search-forward @@ -5473,17 +5467,6 @@ indentation and initial hashes. Behaves usually outside of comment." (or cperl-faces-init (cperl-init-faces)) cperl-font-lock-keywords-2) -(defun cperl-init-faces-weak () - ;; Allow `cperl-find-pods-heres' to run. - (or (boundp 'font-lock-constant-face) - (cperl-force-face font-lock-constant-face - "Face for constant and label names")) - (or (boundp 'font-lock-warning-face) - (cperl-force-face font-lock-warning-face - "Face for things which should stand out")) - ;;(setq font-lock-constant-face 'font-lock-constant-face) - ) - (defun cperl-init-faces () (condition-case errs (progn @@ -5611,7 +5594,7 @@ indentation and initial hashes. Behaves usually outside of comment." "wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually "\\|[sm]" ; Added manually "\\)\\>") - 2 'cperl-nonoverridable-face) + 2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted ;; (mapconcat #'identity ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" ;; "#include" "#define" "#undef") @@ -5647,11 +5630,7 @@ indentation and initial hashes. Behaves usually outside of comment." 2 font-lock-function-name-face) '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$" 1 font-lock-function-name-face) - (cond ((featurep 'font-lock-extra) - '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - (2 font-lock-string-face t) - (0 '(restart 2 t)))) ; To highlight $a{bc}{ef} - (font-lock-anchored + (cond (font-lock-anchored '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" (2 font-lock-string-face t) ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" @@ -5669,15 +5648,7 @@ indentation and initial hashes. Behaves usually outside of comment." ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" ;;; (2 (cons font-lock-variable-name-face '(underline)))) - (cond ((featurep 'font-lock-extra) - '("^[ \t]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" - (3 font-lock-variable-name-face) - (4 '(another 4 nil - ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" - (1 font-lock-variable-name-face) - (2 '(restart 2 nil) nil t))) - nil t))) ; local variables, multiple - (font-lock-anchored + (cond (font-lock-anchored ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var `(,(concat "\\<\\(state\\|my\\|local\\|our\\)" cperl-maybe-white-and-comment-rex @@ -5779,164 +5750,6 @@ indentation and initial hashes. Behaves usually outside of comment." t-font-lock-keywords-1 cperl-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) - (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) - (eval ; Avoid a warning - '(font-lock-require-faces - (list - ;; Color-light Color-dark Gray-light Gray-dark Mono - (list 'font-lock-comment-face - ["Firebrick" "OrangeRed" "DimGray" "Gray80"] - nil - [nil nil t t t] - [nil nil t t t] - nil) - (list 'font-lock-string-face - ["RosyBrown" "LightSalmon" "Gray50" "LightGray"] - nil - nil - [nil nil t t t] - nil) - (list 'font-lock-function-name-face - (vector - "Blue" "LightSkyBlue" "Gray50" "LightGray" - (cdr (assq 'background-color ; if mono - (frame-parameters)))) - (vector - nil nil nil nil - (cdr (assq 'foreground-color ; if mono - (frame-parameters)))) - [nil nil t t t] - nil - nil) - (list 'font-lock-variable-name-face - ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"] - nil - [nil nil t t t] - [nil nil t t t] - nil) - (list 'font-lock-type-face - ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"] - nil - [nil nil t t t] - nil - [nil nil t t t]) - (list 'font-lock-warning-face - ["Pink" "Red" "Gray50" "LightGray"] - ["gray20" "gray90" - "gray80" "gray20"] - [nil nil t t t] - nil - [nil nil t t t] - ) - (list 'font-lock-constant-face - ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] - nil - [nil nil t t t] - nil - [nil nil t t t]) - (list 'cperl-nonoverridable-face - ["chartreuse3" ("orchid1" "orange") - nil "Gray80"] - [nil nil "gray90"] - [nil nil nil t t] - [nil nil t t] - [nil nil t t t]) - (list 'cperl-array-face - ["blue" "yellow" nil "Gray80"] - ["lightyellow2" ("navy" "os2blue" "darkgreen") - "gray90"] - t - nil - nil) - (list 'cperl-hash-face - ["red" "red" nil "Gray80"] - ["lightyellow2" ("navy" "os2blue" "darkgreen") - "gray90"] - t - t - nil)))) - ;; Do it the dull way, without choose-color - (cperl-force-face font-lock-constant-face - "Face for constant and label names") - (cperl-force-face font-lock-variable-name-face - "Face for variable names") - (cperl-force-face font-lock-type-face - "Face for data types") - (cperl-force-face cperl-nonoverridable-face - "Face for data types from another group") - (cperl-force-face font-lock-warning-face - "Face for things which should stand out") - (cperl-force-face font-lock-comment-face - "Face for comments") - (cperl-force-face font-lock-function-name-face - "Face for function names") - ;;(defvar font-lock-constant-face 'font-lock-constant-face) - ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) - ;;(or (boundp 'font-lock-type-face) - ;; (defconst font-lock-type-face - ;; 'font-lock-type-face - ;; "Face to use for data types.")) - ;;(or (boundp 'cperl-nonoverridable-face) - ;; (defconst cperl-nonoverridable-face - ;; 'cperl-nonoverridable-face - ;; "Face to use for data types from another group.")) - (if (and - (not (facep 'cperl-array-face)) - (facep 'font-lock-emphasized-face)) - (copy-face 'font-lock-emphasized-face 'cperl-array-face)) - (if (and - (not (facep 'cperl-hash-face)) - (facep 'font-lock-other-emphasized-face)) - (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face)) - (if (and - (not (facep 'cperl-nonoverridable-face)) - (facep 'font-lock-other-type-face)) - (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face)) - ;;(or (boundp 'cperl-hash-face) - ;; (defconst cperl-hash-face - ;; 'cperl-hash-face - ;; "Face to use for hashes.")) - ;;(or (boundp 'cperl-array-face) - ;; (defconst cperl-array-face - ;; 'cperl-array-face - ;; "Face to use for arrays.")) - (let ((background 'light)) - (and (not (facep 'font-lock-constant-face)) - (facep 'font-lock-reference-face) - (copy-face 'font-lock-reference-face 'font-lock-constant-face)) - (if (facep 'font-lock-type-face) nil - (copy-face 'default 'font-lock-type-face) - (cond - ((eq background 'light) - (set-face-foreground 'font-lock-type-face - (if (x-color-defined-p "seagreen") - "seagreen" - "sea green"))) - ((eq background 'dark) - (set-face-foreground 'font-lock-type-face - (if (x-color-defined-p "os2pink") - "os2pink" - "pink"))) - (t - (set-face-background 'font-lock-type-face "gray90")))) - (if (facep 'cperl-nonoverridable-face) - nil - (copy-face 'font-lock-type-face 'cperl-nonoverridable-face) - (cond - ((eq background 'light) - (set-face-foreground 'cperl-nonoverridable-face - (if (x-color-defined-p "chartreuse3") - "chartreuse3" - "chartreuse"))) - ((eq background 'dark) - (set-face-foreground 'cperl-nonoverridable-face - (if (x-color-defined-p "orchid1") - "orchid1" - "orange"))))) - (if (facep 'font-lock-variable-name-face) nil - (copy-face 'italic 'font-lock-variable-name-face)) - (if (facep 'font-lock-constant-face) nil - (copy-face 'italic 'font-lock-constant-face)))) (setq cperl-faces-init t)) (error (message "cperl-init-faces (ignored): %s" errs)))) @@ -6046,7 +5859,19 @@ if (foo) { stop; } -### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil +### PBP (=Perl Best Practices) 4/0/0/-4/4/nil/nil +if (foo) { + bar + baz; + label: + { + boon; + } +} +else { + stop; +} +### PerlStyle (=CPerl with 4 as indent) 4/0/0/-2/4/t/nil if (foo) { bar baz; @@ -6149,6 +5974,18 @@ else (cperl-extra-newline-before-brace-multiline . nil) (cperl-merge-trailing-else . t)) + ("PBP" ;; Perl Best Practices by Damian Conway + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-continued-statement-offset . 4) + (cperl-extra-newline-before-brace . nil) + (cperl-extra-newline-before-brace-multiline . nil) + (cperl-merge-trailing-else . nil) + (cperl-indent-parens-as-block . t) + (cperl-tab-always-indent . t)) + ("PerlStyle" ; CPerl with 4 as indent (cperl-indent-level . 4) (cperl-brace-offset . 0) @@ -6220,7 +6057,8 @@ See examples in `cperl-style-examples'.") "Set CPerl mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles -are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. +are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" +and \"Whitesmith\". The current value of style is memorized (unless there is a memorized data already), may be restored by `cperl-set-style-back'. @@ -6306,7 +6144,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', (interactive (let* ((default (cperl-word-at-point)) (read (read-string - (format-prompt "Find doc for Perl function" default)))) + (cperl--format-prompt "Find doc for Perl function" default)))) (list (if (equal read "") default read)))) @@ -8265,7 +8103,7 @@ the appropriate statement modifier." (interactive (list (let* ((default-entry (cperl-word-at-point)) (input (read-string - (format-prompt "perldoc entry" default-entry)))) + (cperl--format-prompt "perldoc entry" default-entry)))) (if (string= input "") (if (string= default-entry "") (error "No perldoc args given") @@ -8492,7 +8330,7 @@ start with default arguments, then refine the slowdown regions." (or l (setq l 1)) (or step (setq step 500)) (or lim (setq lim 40)) - (let* ((timems (function (lambda () (car (time-convert nil 1000))))) + (let* ((timems (function (lambda () (car (cperl--time-convert nil 1000))))) (tt (funcall timems)) (c 0) delta tot) (goto-char (point-min)) (forward-line (1- l)) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index bcbe669c16e..65ef83f7698 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -1,4 +1,4 @@ -;;; cpp.el --- highlight or hide text according to cpp conditionals +;;; cpp.el --- highlight or hide text according to cpp conditionals -*- lexical-binding: t -*- ;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index ab3321f6868..ca45795adc0 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -557,8 +557,7 @@ Variables controlling indentation style and extra features: dcl-imenu-label-call Change the text that is used as sub-listing labels in imenu. -Loading this package calls the value of the variable -`dcl-mode-load-hook' with no args, if that value is non-nil. +To run code after DCL mode has loaded, use `with-eval-after-load'. Turning on DCL mode calls the value of the variable `dcl-mode-hook' with no args, if that value is non-nil. @@ -2192,6 +2191,8 @@ otherwise return nil." (provide 'dcl-mode) +(make-obsolete-variable 'dcl-mode-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'dcl-mode-load-hook) ; for your customizations ;;; dcl-mode.el ends here diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index bf9b0e961ba..be82c72910b 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -38,7 +38,7 @@ ;; ----------- ;; ;; See the URL: -;; `http://www.ietf.org/rfc/rfc2234.txt' +;; `https://www.ietf.org/rfc/rfc2234.txt' ;; or ;; `http://www.faqs.org/rfcs/rfc2234.html' ;; or diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index bdebf0db2c1..ddddb27a11c 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -38,11 +38,11 @@ ;; ---------- ;; ;; See the URLs: -;; `http://www.w3.org/TR/2004/REC-xml-20040204/' +;; `https://www.w3.org/TR/2004/REC-xml-20040204/' ;; (Extensible Markup Language (XML) 1.0 (Third Edition)) -;; `http://www.w3.org/TR/html40/' +;; `https://www.w3.org/TR/html40/' ;; (HTML 4.01 Specification) -;; `http://www.w3.org/TR/NOTE-html-970421' +;; `https://www.w3.org/TR/NOTE-html-970421' ;; (HTML DTD with support for Style Sheets) ;; ;; diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 20e2d4ca31c..546f1f8a87f 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -38,7 +38,7 @@ ;; ------------ ;; ;; See the URL: -;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' +;; `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' ;; (Extensible Markup Language (XML) 1.0 (Third Edition)) ;; ;; diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 22c70bf734d..991cd6fc519 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -5,7 +5,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Version: 4.4 -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -326,7 +326,7 @@ Please send all bug fixes and enhancements to ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. ;; ;; `abnf' ebnf2ps recognizes the syntax described in the URL: -;; `http://www.ietf.org/rfc/rfc2234.txt' +;; `https://www.ietf.org/rfc/rfc2234.txt' ;; ("Augmented BNF for Syntax Specifications: ABNF"). ;; ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: @@ -342,11 +342,11 @@ Please send all bug fixes and enhancements to ;; `ebnf-yac-ignore-error-recovery'. ;; ;; `ebnfx' ebnf2ps recognizes the syntax described in the URL: -;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' +;; `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)") ;; ;; `dtd' ebnf2ps recognizes the syntax described in the URL: -;; `http://www.w3.org/TR/2004/REC-xml-20040204/' +;; `https://www.w3.org/TR/2004/REC-xml-20040204/' ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)") ;; ;; Any other value is treated as `ebnf'. @@ -1779,7 +1779,7 @@ Valid values are: `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. `abnf' ebnf2ps recognizes the syntax described in the URL: - `http://www.ietf.org/rfc/rfc2234.txt' + `https://www.ietf.org/rfc/rfc2234.txt' (\"Augmented BNF for Syntax Specifications: ABNF\"). `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: @@ -1795,11 +1795,11 @@ Valid values are: `ebnf-yac-ignore-error-recovery'. `ebnfx' ebnf2ps recognizes the syntax described in the URL: - `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' + `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' (\"Extensible Markup Language (XML) 1.0 (Third Edition)\") `dtd' ebnf2ps recognizes the syntax described in the URL: - `http://www.w3.org/TR/2004/REC-xml-20040204/' + `https://www.w3.org/TR/2004/REC-xml-20040204/' (\"Extensible Markup Language (XML) 1.0 (Third Edition)\") Any other value is treated as `ebnf'." diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 1c9e805f039..ffd7d03d7a9 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -3544,7 +3544,7 @@ completion." ;;; Tags query replace & search (defvar ebrowse-tags-loop-call '(ignore) - "Function call for `ebrowse-loop-continue'. + "Function call for `ebrowse-tags-loop-continue'. Passed to `apply' for each file in the tree. If it returns nil, proceed with the next file.") diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 72b94a57b4a..ce2b924d514 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -196,7 +196,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (if (and (buffer-modified-p) (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) (save-buffer)) - (byte-recompile-file buffer-file-name nil 0 t)) + (byte-recompile-file buffer-file-name nil 0) + (load buffer-file-name)) (defun emacs-lisp-macroexpand () "Macroexpand the form after point. @@ -683,7 +684,7 @@ otherwise build the summary from TYPE and SYMBOL." "List of functions to be run from `elisp--xref-find-definitions' to add additional xrefs. Called with one arg; the symbol whose definition is desired. Each function should return a list of xrefs, or nil; the first -non-nil result supercedes the xrefs produced by +non-nil result supersedes the xrefs produced by `elisp--xref-find-definitions'.") (cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier) @@ -896,8 +897,10 @@ non-nil result supercedes the xrefs produced by (let ((buffer-point (find-function-search-for-symbol symbol type file))) (with-current-buffer (car buffer-point) (save-excursion - (goto-char (or (cdr buffer-point) (point-min))) - (point-marker)))))) + (save-restriction + (widen) + (goto-char (or (cdr buffer-point) (point-min))) + (point-marker))))))) (cl-defmethod xref-location-group ((l xref-elisp-location)) (xref-elisp-location-file l)) @@ -1190,7 +1193,8 @@ character)." ;; Setup the lexical environment if lexical-binding is enabled. (elisp--eval-last-sexp-print-value (eval (macroexpand-all - (eval-sexp-add-defvars (elisp--preceding-sexp))) + (eval-sexp-add-defvars + (elisp--eval-defun-1 (macroexpand (elisp--preceding-sexp))))) lexical-binding) (if insert-value (current-buffer) t) no-truncate char-print-limit))) @@ -1246,6 +1250,10 @@ POS specifies the starting position where EXP was found and defaults to point." Interactively, 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 +function for details. + 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, @@ -1405,6 +1413,30 @@ which see." or argument string for functions. 2 - `function' if function args, `variable' if variable documentation.") +(defun elisp--documentation-one-liner () + (let* (str + (callback (lambda (doc &rest plist) + (setq str + (format "%s: %s" + (propertize (prin1-to-string + (plist-get plist :thing)) + 'face (plist-get plist :face)) + doc))))) + (or (progn (elisp-eldoc-var-docstring callback) str) + (progn (elisp-eldoc-funcall callback) str)))) + +(defalias 'elisp-eldoc-documentation-function 'elisp--documentation-one-liner + "Return Elisp documentation for the thing at point as one-line string. +This is meant as a backward compatibility aide to the \"old\" +Elisp eldoc behaviour. Consider variable docstrings and function +signatures only, in this order. If none applies, returns nil. +Changes to `eldoc-documentation-functions' and +`eldoc-documentation-strategy' are _not_ reflected here. As such +it is preferrable to use ElDoc's interfaces directly.") + +(make-obsolete 'elisp-eldoc-documentation-function + "use ElDoc's interfaces instead." "28.1") + (defun elisp-eldoc-funcall (callback &rest _ignored) "Document function call at point. Intended for `eldoc-documentation-functions' (which see)." diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 2c5c36504a9..8879726ad59 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1845,7 +1845,7 @@ Also see the documentation of the `tags-file-name' variable." Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. -For non-interactive use, superceded by `fileloop-initialize-replace'." +For non-interactive use, superseded by `fileloop-initialize-replace'." (declare (advertised-calling-convention (from to &optional delimited) "27.1")) (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) (fileloop-initialize-replace @@ -2135,8 +2135,10 @@ file name, add `tag-partial-file-name-match-p' to the list value.") (let ((buffer (find-file-noselect file))) (with-current-buffer buffer (save-excursion - (etags-goto-tag-location tag-info) - (point-marker)))))) + (save-restriction + (widen) + (etags-goto-tag-location tag-info) + (point-marker))))))) (cl-defmethod xref-location-line ((l xref-etags-location)) (with-slots (tag-info) l diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 22f1cfd7c89..1fbbc892c03 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -1649,25 +1649,28 @@ Return (TYPE NAME), or nil if not found." (interactive) (let ((count 1) (case-fold-search t) matching-beg) (beginning-of-line) - (while (and (> count 0) - (re-search-backward f90-program-block-re nil 'move)) - (beginning-of-line) - (skip-chars-forward " \t0-9") - ;; Check if in string in case using non-standard feature where - ;; continued strings do not need "&" at start of continuations. - (cond ((f90-in-string)) - ((setq matching-beg (f90-looking-at-program-block-start)) - (setq count (1- count))) - ((f90-looking-at-program-block-end) - (setq count (1+ count))))) - (beginning-of-line) - (if (zerop count) - matching-beg - ;; Note this includes the case of an un-named main program, - ;; in which case we go to (point-min). - (if (called-interactively-p 'interactive) - (message "No beginning found")) - nil))) + ;; Check whether we're already at the start of a subprogram. + (or (f90-looking-at-program-block-start) + ;; We're not; search backwards. + (while (and (> count 0) + (re-search-backward f90-program-block-re nil 'move)) + (beginning-of-line) + (skip-chars-forward " \t0-9") + ;; Check if in string in case using non-standard feature where + ;; continued strings do not need "&" at start of continuations. + (cond ((f90-in-string)) + ((setq matching-beg (f90-looking-at-program-block-start)) + (setq count (1- count))) + ((f90-looking-at-program-block-end) + (setq count (1+ count))))) + (beginning-of-line) + (if (zerop count) + matching-beg + ;; Note this includes the case of an un-named main program, + ;; in which case we go to (point-min). + (if (called-interactively-p 'interactive) + (message "No beginning found")) + nil)))) (defun f90-end-of-subprogram () "Move point to the end of the current subprogram. diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el index 19565ef9b13..d1985b4f777 100644 --- a/lisp/progmodes/flymake-cc.el +++ b/lisp/progmodes/flymake-cc.el @@ -88,7 +88,7 @@ SOURCE." (cond ((derived-mode-p 'c++-mode) "c++") (t "c"))))) -(defvar-local flymake-cc--proc nil "Internal variable for `flymake-gcc'") +(defvar-local flymake-cc--proc nil "Internal variable for `flymake-cc'") ;; forward declare this to shoosh compiler (instead of requiring ;; flymake-proc) diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 62f6d1aaea2..152dc725c74 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -37,7 +37,7 @@ ;;; Bugs/todo: ;; - Only uses "Makefile", not "makefile" or "GNUmakefile" -;; (from http://bugs.debian.org/337339). +;; (from https://bugs.debian.org/337339). ;;; Code: diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index bdb775795ab..b286208fff9 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -226,10 +226,10 @@ Specifically, start it when the saved buffer is actually displayed." (defcustom flymake-suppress-zero-counters :warning "Control appearance of zero-valued diagnostic counters in mode line. -If set to t, supress all zero counters. If set to a severity +If set to t, suppress all zero counters. If set to a severity symbol like `:warning' (the default) suppress zero counters less severe than that severity, according to `warning-numeric-level'. -If set to nil, don't supress any zero counters." +If set to nil, don't suppress any zero counters." :type 'symbol) (when (fboundp 'define-fringe-bitmap) @@ -632,7 +632,7 @@ associated `flymake-category' return DEFAULT." for (ov-prop . value) in (append (reverse (flymake--diag-overlay-properties diagnostic)) - (reverse ; ensure ealier props override later ones + (reverse ; ensure earlier props override later ones (flymake--lookup-type-property type 'flymake-overlay-control)) (alist-get type flymake-diagnostic-types-alist)) do (overlay-put ov ov-prop value)) @@ -1004,7 +1004,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 alrady already ON, we must cleanup + ;; If Flymake happened to be already already ON, we must cleanup ;; existing diagnostic overlays, lest we forget them by blindly ;; reinitializing `flymake--backend-state' in the next line. ;; See https://github.com/joaotavora/eglot/issues/223. diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index abc860b9478..d84c3795653 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,4 +1,4 @@ -;;; fortran.el --- Fortran mode for GNU Emacs +;;; fortran.el --- Fortran mode for GNU Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1986, 1993-1995, 1997-2020 Free Software Foundation, ;; Inc. @@ -495,14 +495,15 @@ This is used to fontify fixed-format Fortran comments." ;; `byte-compile', but simple benchmarks indicate that it's probably not ;; worth the trouble (about 0.5% of slow down). (eval ;I hate `eval', but it's hard to avoid it here. - '(syntax-propertize-rules + `(syntax-propertize-rules ("^[CcDd\\*]" (0 "<")) ;; We mark all chars after line-length as "comment-start", rather than ;; just the first one. This is so that a closing ' that's past the ;; line-length will indeed be ignored (and will result in a string that ;; leaks into subsequent lines). - ((format "^[^CcDd\\*\t\n].\\{%d\\}\\(.+\\)" (1- line-length)) - (1 "<"))))) + (,(format "^[^CcDd\\*\t\n].\\{%d\\}\\(.+\\)" (1- line-length)) + (1 "<"))) + t)) (defvar fortran-font-lock-keywords fortran-font-lock-keywords-1 "Default expressions to highlight in Fortran mode.") diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index c1184211d06..4bebf88d356 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -8,7 +8,7 @@ ;; This file is part of GNU Emacs. -;; Homepage: http://www.emacswiki.org/emacs/GDB-MI +;; Homepage: https://www.emacswiki.org/emacs/GDB-MI ;; 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 @@ -89,8 +89,6 @@ ;;; Code: (require 'gud) -(require 'json) -(require 'bindat) (require 'cl-lib) (require 'cl-seq) (eval-when-compile (require 'pcase)) @@ -167,7 +165,7 @@ May be manually changed by user with `gdb-select-frame'.") "Associative list of threads provided by \"-thread-info\" MI command. Keys are thread numbers (in strings) and values are structures as -returned from -thread-info by `gdb-json-partial-output'. Updated in +returned from -thread-info by `gdb-mi--partial-output'. Updated in `gdb-thread-list-handler-custom'.") (defvar gdb-running-threads-count nil @@ -186,7 +184,7 @@ See also `gdb-running-threads-count'.") "Associative list of breakpoints provided by \"-break-list\" MI command. Keys are breakpoint numbers (in string) and values are structures -as returned from \"-break-list\" by `gdb-json-partial-output' +as returned from \"-break-list\" by `gdb-mi--partial-output' \(\"body\" field is used). Updated in `gdb-breakpoints-list-handler-custom'.") @@ -516,8 +514,6 @@ contains fields of corresponding MI *stopped async record: Note that \"reason\" is only present in non-stop debugging mode. -`bindat-get-field' may be used to access the fields of response. - Each function is called after the new current thread was selected and GDB buffers were updated in `gdb-stopped'." :type '(repeat function) @@ -643,13 +639,14 @@ and looks under `gdb-window-configuration-directory'. Note that this variable only takes effect when variable `gdb-many-windows' is t." - :type 'string + :type '(choice (const :tag "None" nil) + string) :group 'gdb :version "28.1") (defcustom gdb-display-source-buffer-action '(nil . ((inhibit-same-window . t))) "`display-buffer' action used when GDB displays a source buffer." - :type 'list + :type 'sexp :group 'gdb :version "28.1") @@ -739,8 +736,10 @@ NOARG must be t when this macro is used outside `gud-def'." (unless (zerop (length string)) (remove-function (process-filter proc) #'gdb--check-interpreter) (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) - ;; Apparently we're not running with -i=mi. - (let ((msg "Error: you did not specify -i=mi on GDB's command line!")) + ;; Apparently we're not running with -i=mi (or we're, for + ;; instance, debugging something inside a Docker instance with + ;; Emacs on the outside). + (let ((msg "Error: Either -i=mi wasn't specified on the GDB command line, or the extra socket couldn't be established. Consider using `M-x gud-gdb' instead.")) (message msg) (setq string (concat (propertize msg 'font-lock-face 'error) "\n" string))) @@ -1124,11 +1123,11 @@ no input, and GDB is waiting for input." "\\)") nil t) (tooltip-show - (concat expr " = " (read (match-string 1))) + (concat expr " = " (gdb-mi--c-string-from-string (match-string 1))) (or gud-tooltip-echo-area (not (display-graphic-p))))) ((re-search-forward "msg=\\(\".+\"\\)$" nil t) - (tooltip-show (read (match-string 1)) + (tooltip-show (gdb-mi--c-string-from-string (match-string 1)) (or gud-tooltip-echo-area (not (display-graphic-p)))))))) @@ -1141,7 +1140,7 @@ no input, and GDB is waiting for input." (if (search-forward "expands to: " nil t) (unless (looking-at "\\S-+.*(.*).*") (gdb-input (concat "-data-evaluate-expression \"" expr "\"") - `(lambda () (gdb-tooltip-print ,expr))))))) + (lambda () (gdb-tooltip-print expr))))))) (defun gdb-init-buffer () (set (make-local-variable 'gud-minor-mode) 'gdbmi) @@ -1261,23 +1260,26 @@ With arg, enter name of variable to be watched in the minibuffer." (tooltip-identifier-from-point (point))))))) (set-text-properties 0 (length expr) nil expr) (gdb-input (concat "-var-create - * " expr "") - `(lambda () (gdb-var-create-handler ,expr)))))) + (lambda () (gdb-var-create-handler expr)))))) (message "gud-watch is a no-op in this mode.")))) +(defsubst gdb-mi--field (value field) + (cdr (assq field value))) + (defun gdb-var-create-handler (expr) - (let* ((result (gdb-json-partial-output))) - (if (not (bindat-get-field result 'msg)) + (let* ((result (gdb-mi--partial-output))) + (if (not (gdb-mi--field result 'msg)) (let ((var - (list (bindat-get-field result 'name) + (list (gdb-mi--field result 'name) (if (and (string-equal gdb-current-language "c") gdb-use-colon-colon-notation gdb-selected-frame) (setq expr (concat gdb-selected-frame "::" expr)) expr) - (bindat-get-field result 'numchild) - (bindat-get-field result 'type) - (bindat-get-field result 'value) + (gdb-mi--field result 'numchild) + (gdb-mi--field result 'type) + (gdb-mi--field result 'value) nil - (bindat-get-field result 'has_more) + (gdb-mi--field result 'has_more) gdb-frame-address))) (push var gdb-var-list) (speedbar 1) @@ -1298,41 +1300,31 @@ With arg, enter name of variable to be watched in the minibuffer." (raise-frame speedbar-frame)) (speedbar-timer-fn)) -(defun gdb-var-evaluate-expression-handler (varnum changed) - (goto-char (point-min)) - (re-search-forward (concat ".*value=\\(" gdb--string-regexp "\\)") - nil t) - (let ((var (assoc varnum gdb-var-list))) - (when var - (if changed (setcar (nthcdr 5 var) 'changed)) - (setcar (nthcdr 4 var) (read (match-string 1))))) - (gdb-speedbar-update)) - ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. (defun gdb-var-list-children (varnum) (gdb-input (concat "-var-update " varnum) 'ignore) (gdb-input (concat "-var-list-children --all-values " varnum) - `(lambda () (gdb-var-list-children-handler ,varnum)))) + (lambda () (gdb-var-list-children-handler varnum)))) (defun gdb-var-list-children-handler (varnum) (let* ((var-list nil) - (output (bindat-get-field (gdb-json-partial-output "child"))) - (children (bindat-get-field output 'children))) + (output (gdb-mi--partial-output 'child)) + (children (gdb-mi--field output 'children))) (catch 'child-already-watched (dolist (var gdb-var-list) (if (string-equal varnum (car var)) (progn ;; With dynamic varobjs numchild may have increased. - (setcar (nthcdr 2 var) (bindat-get-field output 'numchild)) + (setcar (nthcdr 2 var) (gdb-mi--field output 'numchild)) (push var var-list) (dolist (child children) - (let ((varchild (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) + (let ((varchild (list (gdb-mi--field child 'name) + (gdb-mi--field child 'exp) + (gdb-mi--field child 'numchild) + (gdb-mi--field child 'type) + (gdb-mi--field child 'value) nil - (bindat-get-field child 'has_more)))) + (gdb-mi--field child 'has_more)))) (if (assoc (car varchild) gdb-var-list) (throw 'child-already-watched nil)) (push varchild var-list)))) @@ -1375,7 +1367,7 @@ With arg, enter name of variable to be watched in the minibuffer." (varnum (car var)) (value (read-string "New value: "))) (gdb-input (concat "-var-assign " varnum " " value) - `(lambda () (gdb-edit-value-handler ,value))))) + (lambda () (gdb-edit-value-handler value))))) (defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)") @@ -1391,17 +1383,17 @@ With arg, enter name of variable to be watched in the minibuffer." 'gdb-var-update)) (defun gdb-var-update-handler () - (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) + (let ((changelist (gdb-mi--field (gdb-mi--partial-output) 'changelist))) (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) (let ((temp-var-list gdb-var-list)) (dolist (change changelist) - (let* ((varnum (bindat-get-field change 'name)) + (let* ((varnum (gdb-mi--field change 'name)) (var (assoc varnum gdb-var-list)) - (new-num (bindat-get-field change 'new_num_children))) + (new-num (gdb-mi--field change 'new_num_children))) (when var - (let ((scope (bindat-get-field change 'in_scope)) - (has-more (bindat-get-field change 'has_more))) + (let ((scope (gdb-mi--field change 'in_scope)) + (has-more (gdb-mi--field change 'has_more))) (cond ((string-equal scope "false") (if gdb-delete-out-of-scope (gdb-var-delete-1 var varnum) @@ -1413,12 +1405,12 @@ With arg, enter name of variable to be watched in the minibuffer." (not new-num) (string-equal (nth 2 var) "0")) (setcar (nthcdr 4 var) - (bindat-get-field change 'value)) + (gdb-mi--field change 'value)) (setcar (nthcdr 5 var) 'changed))) ((string-equal scope "invalid") (gdb-var-delete-1 var varnum))))) (let ((var-list nil) var1 - (children (bindat-get-field change 'new_children))) + (children (gdb-mi--field change 'new_children))) (when new-num (setq var1 (pop temp-var-list)) (while var1 @@ -1434,13 +1426,13 @@ With arg, enter name of variable to be watched in the minibuffer." (push (pop temp-var-list) var-list)) (dolist (child children) (let ((varchild - (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) + (list (gdb-mi--field child 'name) + (gdb-mi--field child 'exp) + (gdb-mi--field child 'numchild) + (gdb-mi--field child 'type) + (gdb-mi--field child 'value) 'changed - (bindat-get-field child 'has_more)))) + (gdb-mi--field child 'has_more)))) (push varchild var-list)))) ;; Remove deleted children from list. ((< new previous) @@ -1521,7 +1513,7 @@ thread." (defun gdb-current-buffer-frame () "Get current stack frame object for thread of current buffer." - (bindat-get-field (gdb-current-buffer-thread) 'frame)) + (gdb-mi--field (gdb-current-buffer-thread) 'frame)) (defun gdb-buffer-type (buffer) "Get value of `gdb-buffer-type' for BUFFER." @@ -1583,9 +1575,9 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (defun gdb-bind-function-to-buffer (expr buffer) "Return a function which will evaluate EXPR in BUFFER." - `(lambda (&rest args) - (with-current-buffer ,buffer - (apply ',expr args)))) + (lambda (&rest args) + (with-current-buffer buffer + (apply expr args)))) ;; Used to display windows with thread-bound buffers (defmacro def-gdb-preempt-display-buffer (name buffer &optional doc @@ -2056,7 +2048,7 @@ For all-stop mode, thread information is unavailable while target is running." (let ((old-value gud-running)) (setq gud-running - (string= (bindat-get-field (gdb-current-buffer-thread) 'state) + (string= (gdb-mi--field (gdb-current-buffer-thread) 'state) "running")) ;; Set frame number to "0" when _current_ threads stops. (when (and (gdb-current-buffer-thread) @@ -2313,7 +2305,8 @@ a GDB/MI reply message." ;; Suppress "No registers." GDB 6.8 and earlier ;; duplicates MI error message on internal stream. ;; Don't print to GUD buffer. - (if (not (string-equal (read c-string) "No registers.\n")) + (if (not (string-equal (gdb-mi--c-string-from-string c-string) + "No registers.\n")) (gdb-internals c-string))) @@ -2435,7 +2428,7 @@ the end of the current result or async record is reached." is-complete))) -; The following grammar rules are not yet implemented by this GDBMI-BNF parser. +; The following grammar rules are not parsed directly by this GDBMI-BNF parser. ; The handling of those rules is currently done by the handlers registered ; in gdbmi-bnf-result-state-configs ; @@ -2457,19 +2450,17 @@ the end of the current result or async record is reached." ; list ==> ; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]" +;; FIXME: This is fragile: it relies on the assumption that all the +;; non-ASCII strings output by GDB, including names of the source +;; files, values of string variables in the inferior, etc., are all +;; encoded in the same encoding. + (defcustom gdb-mi-decode-strings nil "When non-nil, decode octal escapes in GDB output into non-ASCII text. If the value is a coding-system, use that coding-system to decode the bytes reconstructed from octal escapes. Any other non-nil value -means to decode using the coding-system set for the GDB process. - -Warning: setting this non-nil might mangle strings reported by GDB -that have literal substrings which match the \\nnn octal escape -patterns, where nnn is an octal number between 200 and 377. So -we only recommend to set this variable non-nil if the program you -are debugging really reports non-ASCII text, or some of its source -file names include non-ASCII characters." +means to decode using the coding-system set for the GDB process." :type '(choice (const :tag "Don't decode" nil) (const :tag "Decode using default coding-system" t) @@ -2477,47 +2468,9 @@ file names include non-ASCII characters." :group 'gdb :version "25.1") -;; The idea of the following function was suggested -;; by Kenichi Handa <handa@gnu.org>. -;; -;; FIXME: This is fragile: it relies on the assumption that all the -;; non-ASCII strings output by GDB, including names of the source -;; files, values of string variables in the inferior, etc., are all -;; encoded in the same encoding. It also assumes that the \nnn -;; sequences are not split between chunks of output of the GDB process -;; due to buffering, and arrive together. Finally, if some string -;; included literal \nnn strings (as opposed to non-ASCII characters -;; converted by GDB/MI to octal escapes), this decoding will mangle -;; those strings. When/if GDB acquires the ability to not -;; escape-protect non-ASCII characters in its MI output, this kludge -;; should be removed. -(defun gdb-mi-decode (string) - "Decode octal escapes in MI output STRING into multibyte text." - (let ((coding - (if (coding-system-p gdb-mi-decode-strings) - gdb-mi-decode-strings - (with-current-buffer - (gdb-get-buffer-create 'gdb-partial-output-buffer) - buffer-file-coding-system)))) - (with-temp-buffer - (set-buffer-multibyte nil) - (prin1 string (current-buffer)) - (goto-char (point-min)) - ;; prin1 quotes the octal escapes as well, which interferes with - ;; their interpretation by 'read' below. Remove the extra - ;; backslashes to countermand that. - (while (re-search-forward "\\\\\\(\\\\[2-3][0-7][0-7]\\)" nil t) - (replace-match "\\1" nil nil)) - (goto-char (point-min)) - (decode-coding-string (read (current-buffer)) coding)))) - (defun gud-gdbmi-marker-filter (string) "Filter GDB/MI output." - ;; If required, decode non-ASCII text encoded with octal escapes. - (or (null gdb-mi-decode-strings) - (setq string (gdb-mi-decode string))) - ;; Record transactions if logging is enabled. (when gdb-enable-debug (push (cons 'recv string) gdb-debug-log) @@ -2547,7 +2500,7 @@ file names include non-ASCII characters." (defun gdb-gdb (_output-field) ;; This is needed because the "explore" command is not ended by the - ;; likes of "end" or "quit", but instead by a RET at the approriate + ;; likes of "end" or "quit", but instead by a RET at the appropriate ;; place, and we know we have exited "explore" when we get the ;; "(gdb)" prompt. (and (> gdb-control-level 0) @@ -2564,7 +2517,7 @@ file names include non-ASCII characters." (defun gdb-thread-exited (_token output-field) "Handle =thread-exited async record. Unset `gdb-thread-number' if current thread exited and update threads list." - (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) + (let* ((thread-id (gdb-mi--field (gdb-mi--from-string output-field) 'id))) (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, @@ -2578,8 +2531,8 @@ Unset `gdb-thread-number' if current thread exited and update threads list." "Handler for =thread-selected MI output record. Sets `gdb-thread-number' to new id." - (let* ((result (gdb-json-string output-field)) - (thread-id (bindat-get-field result 'id))) + (let* ((result (gdb-mi--from-string output-field)) + (thread-id (gdb-mi--field result 'id))) (gdb-setq-thread-number thread-id) ;; Typing `thread N' in GUD buffer makes GDB emit `^done' followed ;; by `=thread-selected' notification. `^done' causes `gdb-update' @@ -2594,7 +2547,7 @@ Sets `gdb-thread-number' to new id." (defun gdb-running (_token output-field) (let* ((thread-id - (bindat-get-field (gdb-json-string output-field) 'thread-id))) + (gdb-mi--field (gdb-mi--from-string output-field) 'thread-id))) ;; We reset gdb-frame-number to nil if current thread has gone ;; running. This can't be done in gdb-thread-list-handler-custom ;; because we need correct gdb-frame-number by the time @@ -2623,11 +2576,11 @@ Sets `gdb-thread-number' to new id." "Given the contents of *stopped MI async record, select new current thread and update GDB buffers." ;; Reason is available with target-async only - (let* ((result (gdb-json-string output-field)) - (reason (bindat-get-field result 'reason)) - (thread-id (bindat-get-field result 'thread-id)) - (retval (bindat-get-field result 'return-value)) - (varnum (bindat-get-field result 'gdb-result-var))) + (let* ((result (gdb-mi--from-string output-field)) + (reason (gdb-mi--field result 'reason)) + (thread-id (gdb-mi--field result 'thread-id)) + (retval (gdb-mi--field result 'return-value)) + (varnum (gdb-mi--field result 'gdb-result-var))) ;; -data-list-register-names needs to be issued for any stopped ;; thread @@ -2670,7 +2623,7 @@ current thread and update GDB buffers." ;; gdb-switch-when-another-stopped: (when (or gdb-switch-when-another-stopped (not (string= "stopped" - (bindat-get-field (gdb-current-buffer-thread) 'state)))) + (gdb-mi--field (gdb-current-buffer-thread) 'state)))) ;; Switch if current reason has been selected or we have no ;; reasons (if (or (eq gdb-switch-reasons t) @@ -2703,7 +2656,7 @@ current thread and update GDB buffers." (if (string= output-field "\"\\n\"") "" (let ((error-message - (read output-field))) + (gdb-mi--c-string-from-string output-field))) (put-text-property 0 (length error-message) 'face font-lock-warning-face @@ -2714,7 +2667,8 @@ current thread and update GDB buffers." ;; (frontend MI commands should not print to this stream) (defun gdb-console (output-field) (setq gdb-filter-output - (gdb-concat-output gdb-filter-output (read output-field)))) + (gdb-concat-output gdb-filter-output + (gdb-mi--c-string-from-string output-field)))) (defun gdb-done (token-number output-field is-complete) (gdb-done-or-error token-number 'done output-field is-complete)) @@ -2731,7 +2685,8 @@ current thread and update GDB buffers." ;; MI error - send to minibuffer (when (eq type 'error) ;; Skip "msg=" from `output-field' - (message "%s" (read (substring output-field 4))) + (message "%s" (gdb-mi--c-string-from-string + (substring output-field 4))) ;; Don't send to the console twice. (If it is a console error ;; it is also in the console stream.) (setq output-field nil))) @@ -2779,83 +2734,154 @@ current thread and update GDB buffers." (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) (erase-buffer))) -(defun gdb-jsonify-buffer (&optional fix-key fix-list) - "Prepare GDB/MI output in current buffer for parsing with `json-read'. - -Field names are wrapped in double quotes and equal signs are -replaced with semicolons. - -If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from -partial output. This is used to get rid of useless keys in lists -in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and --break-info are examples of MI commands which issue such -responses. - -If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with -\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken --break-info output when it contains breakpoint script field -incompatible with GDB/MI output syntax. +;; Parse GDB/MI result records: this process converts +;; list [...] -> list +;; tuple {...} -> list +;; result KEY=VALUE -> (KEY . VALUE) where KEY is a symbol +;; c-string "..." -> string + +(defun gdb-mi--parse-tuple-or-list (end-char) + "Parse a tuple or list, either returned as a Lisp list. +END-CHAR is the ending delimiter; will stop at end-of-buffer otherwise." + (let ((items nil)) + (while (not (or (eobp) + (eq (following-char) end-char))) + (let ((item (gdb-mi--parse-result-or-value))) + (push item items) + (when (eq (following-char) ?,) + (forward-char)))) + (when (eq (following-char) end-char) + (forward-char)) + (nreverse items))) + +(defun gdb-mi--parse-c-string () + "Parse a c-string." + (let ((start (point)) + (pieces nil) + (octals-used nil)) + (while (and (re-search-forward (rx (or ?\\ ?\"))) + (not (eq (preceding-char) ?\"))) + (push (buffer-substring start (1- (point))) pieces) + (cond + ((looking-at (rx (any "0-7") (? (any "0-7") (? (any "0-7"))))) + (push (unibyte-string (string-to-number (match-string 0) 8)) pieces) + (setq octals-used t) + (goto-char (match-end 0))) + ((looking-at (rx (any "ntrvfab\"\\"))) + (push (cdr (assq (following-char) + '((?n . "\n") + (?t . "\t") + (?r . "\r") + (?v . "\v") + (?f . "\f") + (?a . "\a") + (?b . "\b") + (?\" . "\"") + (?\\ . "\\")))) + pieces) + (forward-char)) + (t + (warn "Unrecognised escape char: %c" (following-char)))) + (setq start (point))) + (push (buffer-substring start (1- (point))) pieces) + (let ((s (apply #'concat (nreverse pieces)))) + (if (and octals-used gdb-mi-decode-strings) + (let ((coding + (if (coding-system-p gdb-mi-decode-strings) + gdb-mi-decode-strings + (buffer-local-value + 'buffer-file-coding-system + ;; FIXME: This is somewhat expensive. + (gdb-get-buffer-create 'gdb-partial-output-buffer))))) + (decode-coding-string s coding)) + s)))) + +;; FIXME: Ideally this function should not be needed. +(defun gdb-mi--c-string-from-string (string) + "Parse a c-string from (the beginning of) STRING." + (with-temp-buffer + (insert string) + (goto-char (1+ (point-min))) ; Skip leading double quote. + (gdb-mi--parse-c-string))) -If `default-directory' is remote, full file names are adapted accordingly." - (save-excursion +(defun gdb-mi--parse-value () + "Parse a value." + (cond + ((eq (following-char) ?\{) + (forward-char) + (gdb-mi--parse-tuple-or-list ?\})) + ((eq (following-char) ?\[) + (forward-char) + (gdb-mi--parse-tuple-or-list ?\])) + ((eq (following-char) ?\") + (forward-char) + (gdb-mi--parse-c-string)) + (t (error "Bad start of result or value: %c" (following-char))))) + +(defun gdb-mi--parse-result-or-value () + "Parse a result (key=value) or value." + (if (looking-at (rx (group (+ (any "a-zA-Z" ?_ ?-))) "=")) + (progn + (goto-char (match-end 0)) + (let* ((variable (intern (match-string 1))) + (value (gdb-mi--parse-value))) + (cons variable value))) + (gdb-mi--parse-value))) + +(defun gdb-mi--parse-results () + "Parse zero or more result productions as a list." + (gdb-mi--parse-tuple-or-list nil)) + +(defun gdb-mi--fix-key (key value) + "Convert any result (key-value pair) in VALUE whose key is KEY to its value." + (cond + ((atom value) value) + ((symbolp (car value)) + (if (eq (car value) key) + (cdr value) + (cons (car value) (gdb-mi--fix-key key (cdr value))))) + (t (mapcar (lambda (x) (gdb-mi--fix-key key x)) value)))) + +(defun gdb-mi--extend-fullname (remote value) + "Prepend REMOTE to any result string with `fullname' as the key in VALUE." + (cond + ((atom value) value) + ((symbolp (car value)) + (if (and (eq (car value) 'fullname) + (stringp (cdr value))) + (cons 'fullname (concat remote (cdr value))) + (cons (car value) (gdb-mi--extend-fullname remote (cdr value))))) + (t (mapcar (lambda (x) (gdb-mi--extend-fullname remote x)) value)))) + +(defun gdb-mi--read-buffer (fix-key) + "Parse the current buffer as a list of result productions. +If FIX-KEY is a non-nil symbol, convert all FIX-KEY=VALUE results into VALUE. +This is used to get rid of useless keys in lists in MI messages; +eg, [key=.., key=..]. -stack-list-frames and -break-info are +examples of MI commands which issue such responses." + (goto-char (point-min)) + (let ((results (gdb-mi--parse-results))) (let ((remote (file-remote-p default-directory))) (when remote - (goto-char (point-min)) - (while (re-search-forward "[\\[,]fullname=\"\\(.+\\)\"" nil t) - (replace-match (concat remote "\\1") nil nil nil 1)))) - (goto-char (point-min)) + (setq results (gdb-mi--extend-fullname remote results)))) (when fix-key - (save-excursion - (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t) - (replace-match "" nil nil nil 1)))) - (when fix-list - (save-excursion - ;; Find positions of braces which enclose broken list - (while (re-search-forward (concat fix-list "={\"") nil t) - (let ((p1 (goto-char (- (point) 2))) - (p2 (progn (forward-sexp) - (1- (point))))) - ;; Replace braces with brackets - (save-excursion - (goto-char p1) - (delete-char 1) - (insert "[") - (goto-char p2) - (delete-char 1) - (insert "]")))))) - (goto-char (point-min)) - (insert "{") - (let ((re (concat "\\([[:alnum:]_-]+\\)="))) - (while (re-search-forward re nil t) - (replace-match "\"\\1\":" nil nil) - (if (eq (char-after) ?\") (forward-sexp) (forward-char)))) - (goto-char (point-max)) - (insert "}"))) + (setq results (gdb-mi--fix-key fix-key results))) + results)) -(defun gdb-json-read-buffer (&optional fix-key fix-list) - "Prepare and parse GDB/MI output in current buffer with `json-read'. +(defun gdb-mi--from-string (string &optional fix-key) + "Prepare and parse STRING containing GDB/MI output. -FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." - (gdb-jsonify-buffer fix-key fix-list) - (save-excursion - (goto-char (point-min)) - (let ((json-array-type 'list)) - (json-read)))) - -(defun gdb-json-string (string &optional fix-key fix-list) - "Prepare and parse STRING containing GDB/MI output with `json-read'. - -FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." +FIX-KEY works as in `gdb-mi--read-buffer'." (with-temp-buffer (insert string) - (gdb-json-read-buffer fix-key fix-list))) + (gdb-mi--read-buffer fix-key))) -(defun gdb-json-partial-output (&optional fix-key fix-list) - "Prepare and parse gdb-partial-output-buffer with `json-read'. +(defun gdb-mi--partial-output (&optional fix-key) + "Prepare and parse gdb-partial-output-buffer. -FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'." +FIX-KEY works as in `gdb-mi--read-buffer'." (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (gdb-json-read-buffer fix-key fix-list))) + (gdb-mi--read-buffer fix-key))) (defun gdb-line-posns (line) "Return a pair of LINE beginning and end positions." @@ -2936,14 +2962,6 @@ calling `gdb-table-string'." (gdb-table-row-properties table)) "\n"))) -;; bindat-get-field goes deep, gdb-get-many-fields goes wide -(defun gdb-get-many-fields (struct &rest fields) - "Return a list of FIELDS values from STRUCT." - (let ((values)) - (dolist (field fields) - (push (bindat-get-field struct field) values)) - (nreverse values))) - (defmacro def-gdb-auto-update-trigger (trigger-name gdb-command handler-name &optional signal-list) @@ -3031,26 +3049,27 @@ See `def-gdb-auto-update-handler'." 'gdb-invalidate-breakpoints) (defun gdb-breakpoints-list-handler-custom () - (let ((breakpoints-list (bindat-get-field - (gdb-json-partial-output "bkpt" "script") - 'BreakpointTable 'body)) + (let ((breakpoints-list (gdb-mi--field + (gdb-mi--field (gdb-mi--partial-output 'bkpt) + 'BreakpointTable) + 'body)) (table (make-gdb-table))) (setq gdb-breakpoints-list nil) (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What")) (dolist (breakpoint breakpoints-list) (add-to-list 'gdb-breakpoints-list - (cons (bindat-get-field breakpoint 'number) + (cons (gdb-mi--field breakpoint 'number) breakpoint)) - (let ((at (bindat-get-field breakpoint 'at)) - (pending (bindat-get-field breakpoint 'pending)) - (func (bindat-get-field breakpoint 'func)) - (type (bindat-get-field breakpoint 'type))) + (let ((at (gdb-mi--field breakpoint 'at)) + (pending (gdb-mi--field breakpoint 'pending)) + (func (gdb-mi--field breakpoint 'func)) + (type (gdb-mi--field breakpoint 'type))) (gdb-table-add-row table (list - (bindat-get-field breakpoint 'number) + (gdb-mi--field breakpoint 'number) (or type "") - (or (bindat-get-field breakpoint 'disp) "") - (let ((flag (bindat-get-field breakpoint 'enabled))) + (or (gdb-mi--field breakpoint 'disp) "") + (let ((flag (gdb-mi--field breakpoint 'enabled))) (if (string-equal flag "y") (eval-when-compile (propertize "y" 'font-lock-face @@ -3058,10 +3077,10 @@ See `def-gdb-auto-update-handler'." (eval-when-compile (propertize "n" 'font-lock-face font-lock-comment-face)))) - (bindat-get-field breakpoint 'addr) - (or (bindat-get-field breakpoint 'times) "") + (gdb-mi--field breakpoint 'addr) + (or (gdb-mi--field breakpoint 'times) "") (if (and type (string-match ".*watchpoint" type)) - (bindat-get-field breakpoint 'what) + (gdb-mi--field breakpoint 'what) (or pending at (concat "in " (propertize (or func "unknown") @@ -3086,11 +3105,11 @@ See `def-gdb-auto-update-handler'." (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is ; an associative list - (line (bindat-get-field breakpoint 'line))) + (line (gdb-mi--field breakpoint 'line))) (when line - (let ((file (bindat-get-field breakpoint 'fullname)) - (flag (bindat-get-field breakpoint 'enabled)) - (bptno (bindat-get-field breakpoint 'number))) + (let ((file (gdb-mi--field breakpoint 'fullname)) + (flag (gdb-mi--field breakpoint 'enabled)) + (bptno (gdb-mi--field breakpoint 'number))) (unless (and file (file-exists-p file)) (setq file (cdr (assoc bptno gdb-location-alist)))) (if (or (null file) @@ -3098,11 +3117,11 @@ See `def-gdb-auto-update-handler'." ;; If the full filename is not recorded in the ;; breakpoint structure or in `gdb-location-alist', use ;; -file-list-exec-source-file to extract it. - (when (setq file (bindat-get-field breakpoint 'file)) + (when (setq file (gdb-mi--field breakpoint 'file)) (gdb-input (concat "list " file ":1") 'ignore) (gdb-input "-file-list-exec-source-file" - `(lambda () (gdb-get-location - ,bptno ,line ,flag)))) + (lambda () (gdb-get-location + bptno line flag)))) (with-current-buffer (find-file-noselect file 'nowarn) (gdb-init-buffer) ;; Only want one breakpoint icon at each location. @@ -3354,7 +3373,7 @@ corresponding to the mode line clicked." 'gdb-invalidate-threads) (defun gdb-thread-list-handler-custom () - (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads)) + (let ((threads-list (gdb-mi--field (gdb-mi--partial-output) 'threads)) (table (make-gdb-table)) (marked-line nil)) (setq gdb-threads-list nil) @@ -3363,9 +3382,9 @@ corresponding to the mode line clicked." (set-marker gdb-thread-position nil) (dolist (thread (reverse threads-list)) - (let ((running (equal (bindat-get-field thread 'state) "running"))) + (let ((running (equal (gdb-mi--field thread 'state) "running"))) (add-to-list 'gdb-threads-list - (cons (bindat-get-field thread 'id) + (cons (gdb-mi--field thread 'id) thread)) (cl-incf (if running gdb-running-threads-count @@ -3374,37 +3393,41 @@ corresponding to the mode line clicked." (gdb-table-add-row table (list - (bindat-get-field thread 'id) + (gdb-mi--field thread 'id) (concat (if gdb-thread-buffer-verbose-names - (concat (bindat-get-field thread 'target-id) " ") "") - (bindat-get-field thread 'state) + (concat (gdb-mi--field thread 'target-id) " ") "") + (gdb-mi--field thread 'state) ;; Include frame information for stopped threads (if (not running) (concat - " in " (bindat-get-field thread 'frame 'func) + " in " (gdb-mi--field (gdb-mi--field thread 'frame) 'func) (if gdb-thread-buffer-arguments (concat " (" - (let ((args (bindat-get-field thread 'frame 'args))) + (let ((args (gdb-mi--field (gdb-mi--field thread 'frame) + 'args))) (mapconcat (lambda (arg) - (apply #'format "%s=%s" - (gdb-get-many-fields arg 'name 'value))) + (format "%s=%s" + (gdb-mi--field arg 'name) + (gdb-mi--field arg 'value))) args ",")) ")") "") (if gdb-thread-buffer-locations - (gdb-frame-location (bindat-get-field thread 'frame)) "") + (gdb-frame-location (gdb-mi--field thread 'frame)) "") (if gdb-thread-buffer-addresses - (concat " at " (bindat-get-field thread 'frame 'addr)) "")) + (concat " at " (gdb-mi--field (gdb-mi--field thread 'frame) + 'addr)) + "")) ""))) (list 'gdb-thread thread 'mouse-face 'highlight 'help-echo "mouse-2, RET: select thread"))) (when (string-equal gdb-thread-number - (bindat-get-field thread 'id)) + (gdb-mi--field thread 'id)) (setq marked-line (length gdb-threads-list)))) (insert (gdb-table-string table " ")) (when marked-line @@ -3436,11 +3459,11 @@ If `gdb-thread' is nil, error is signaled." "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." `(def-gdb-thread-buffer-command ,name - (,buffer-command (bindat-get-field thread 'id)) + (,buffer-command (gdb-mi--field thread 'id)) ,doc)) (def-gdb-thread-buffer-command gdb-select-thread - (let ((new-id (bindat-get-field thread 'id))) + (let ((new-id (gdb-mi--field thread 'id))) (gdb-setq-thread-number new-id) (gdb-input (concat "-thread-select " new-id) 'ignore) (gdb-update)) @@ -3492,7 +3515,7 @@ on the current line." line." `(def-gdb-thread-buffer-command ,name (if gdb-non-stop - (let ((gdb-thread-number (bindat-get-field thread 'id)) + (let ((gdb-thread-number (gdb-mi--field thread 'id)) (gdb-gud-control-all-threads nil)) (call-interactively #',gud-command)) (error "Available in non-stop mode only, customize `gdb-non-stop-setting'")) @@ -3591,20 +3614,20 @@ in `gdb-memory-format'." (error "Unknown format")))) (defun gdb-read-memory-custom () - (let* ((res (gdb-json-partial-output)) - (err-msg (bindat-get-field res 'msg))) + (let* ((res (gdb-mi--partial-output)) + (err-msg (gdb-mi--field res 'msg))) (if (not err-msg) - (let ((memory (bindat-get-field res 'memory))) + (let ((memory (gdb-mi--field res 'memory))) (when gdb-memory-last-address ;; Nil means last retrieve emits error or just started the session. (setq gdb--memory-display-warning nil)) - (setq gdb-memory-address (bindat-get-field res 'addr)) - (setq gdb-memory-next-page (bindat-get-field res 'next-page)) - (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) + (setq gdb-memory-address (gdb-mi--field res 'addr)) + (setq gdb-memory-next-page (gdb-mi--field res 'next-page)) + (setq gdb-memory-prev-page (gdb-mi--field res 'prev-page)) (setq gdb-memory-last-address gdb-memory-address) (dolist (row memory) - (insert (concat (bindat-get-field row 'addr) ":")) - (dolist (column (bindat-get-field row 'data)) + (insert (concat (gdb-mi--field row 'addr) ":")) + (dolist (column (gdb-mi--field row 'data)) (insert (gdb-pad-string column (+ 2 (gdb-memory-column-width gdb-memory-unit @@ -3943,8 +3966,8 @@ DOC is an optional documentation string." (def-gdb-auto-update-trigger gdb-invalidate-disassembly (let* ((frame (gdb-current-buffer-frame)) - (file (bindat-get-field frame 'fullname)) - (line (bindat-get-field frame 'line))) + (file (gdb-mi--field frame 'fullname)) + (line (gdb-mi--field frame 'line))) (if file (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line) ;; If we're unable to get a file name / line for $PC, simply @@ -4000,22 +4023,22 @@ DOC is an optional documentation string." 'gdb-invalidate-disassembly) (defun gdb-disassembly-handler-custom () - (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns)) - (address (bindat-get-field (gdb-current-buffer-frame) 'addr)) + (let* ((instructions (gdb-mi--field (gdb-mi--partial-output) 'asm_insns)) + (address (gdb-mi--field (gdb-current-buffer-frame) 'addr)) (table (make-gdb-table)) (marked-line nil)) (dolist (instr instructions) (gdb-table-add-row table (list - (bindat-get-field instr 'address) + (gdb-mi--field instr 'address) (let - ((func-name (bindat-get-field instr 'func-name)) - (offset (bindat-get-field instr 'offset))) + ((func-name (gdb-mi--field instr 'func-name)) + (offset (gdb-mi--field instr 'offset))) (if func-name (format "<%s+%s>:" func-name offset) "")) - (bindat-get-field instr 'inst))) - (when (string-equal (bindat-get-field instr 'address) + (gdb-mi--field instr 'inst))) + (when (string-equal (gdb-mi--field instr 'address) address) (progn (setq marked-line (length (gdb-table-rows table))) @@ -4034,15 +4057,15 @@ DOC is an optional documentation string." (setq mode-name (gdb-current-context-mode-name (concat "Disassembly: " - (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (gdb-mi--field (gdb-current-buffer-frame) 'func)))))) (defun gdb-disassembly-place-breakpoints () (gdb-remove-breakpoint-icons (point-min) (point-max)) (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) - (bptno (bindat-get-field breakpoint 'number)) - (flag (bindat-get-field breakpoint 'enabled)) - (address (bindat-get-field breakpoint 'addr))) + (bptno (gdb-mi--field breakpoint 'number)) + (flag (gdb-mi--field breakpoint 'enabled)) + (address (gdb-mi--field breakpoint 'addr))) (save-excursion (goto-char (point-min)) (if (re-search-forward (concat "^" address) nil t) @@ -4072,10 +4095,10 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call - (concat (if (equal "y" (bindat-get-field breakpoint 'enabled)) + (concat (if (equal "y" (gdb-mi--field breakpoint 'enabled)) "-break-disable " "-break-enable ") - (bindat-get-field breakpoint 'number))) + (gdb-mi--field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) (defun gdb-delete-breakpoint () @@ -4086,7 +4109,7 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call (concat "-break-delete " - (bindat-get-field breakpoint 'number))) + (gdb-mi--field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) (defun gdb-goto-breakpoint (&optional event) @@ -4100,9 +4123,9 @@ DOC is an optional documentation string." (beginning-of-line) (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint - (let ((bptno (bindat-get-field breakpoint 'number)) - (file (bindat-get-field breakpoint 'fullname)) - (line (bindat-get-field breakpoint 'line))) + (let ((bptno (gdb-mi--field breakpoint 'number)) + (file (gdb-mi--field breakpoint 'fullname)) + (line (gdb-mi--field breakpoint 'line))) (save-selected-window (let* ((buffer (find-file-noselect (if (file-exists-p file) file @@ -4133,28 +4156,28 @@ DOC is an optional documentation string." FRAME must have either \"file\" and \"line\" members or \"from\" member." - (let ((file (bindat-get-field frame 'file)) - (line (bindat-get-field frame 'line)) - (from (bindat-get-field frame 'from))) + (let ((file (gdb-mi--field frame 'file)) + (line (gdb-mi--field frame 'line)) + (from (gdb-mi--field frame 'from))) (let ((res (or (and file line (concat file ":" line)) from))) (if res (concat " of " res) "")))) (defun gdb-stack-list-frames-custom () - (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack)) + (let ((stack (gdb-mi--field (gdb-mi--partial-output 'frame) 'stack)) (table (make-gdb-table))) (set-marker gdb-stack-position nil) (dolist (frame stack) (gdb-table-add-row table (list - (bindat-get-field frame 'level) + (gdb-mi--field frame 'level) "in" (concat - (bindat-get-field frame 'func) + (gdb-mi--field frame 'func) (if gdb-stack-buffer-locations (gdb-frame-location frame) "") (if gdb-stack-buffer-addresses - (concat " at " (bindat-get-field frame 'addr)) ""))) + (concat " at " (gdb-mi--field frame 'addr)) ""))) `(mouse-face highlight help-echo "mouse-2, RET: Select frame" gdb-frame ,frame))) @@ -4214,7 +4237,7 @@ member." (let ((frame (get-text-property (point) 'gdb-frame))) (if frame (if (gdb-buffer-shows-main-thread-p) - (let ((new-level (bindat-get-field frame 'level))) + (let ((new-level (gdb-mi--field frame 'level))) (setq gdb-frame-number new-level) (gdb-input (concat "-stack-select-frame " new-level) 'ignore) @@ -4260,7 +4283,7 @@ member." (save-excursion (if event (posn-set-point (event-end event))) (beginning-of-line) - (let* ((var (bindat-get-field + (let* ((var (gdb-mi--field (get-text-property (point) 'gdb-local-variable) 'name)) (value (read-string (format "New value (%s): " var)))) (gud-basic-call @@ -4269,12 +4292,12 @@ member." ;; Don't display values of arrays or structures. ;; These can be expanded using gud-watch. (defun gdb-locals-handler-custom () - (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals)) + (let ((locals-list (gdb-mi--field (gdb-mi--partial-output) 'locals)) (table (make-gdb-table))) (dolist (local locals-list) - (let ((name (bindat-get-field local 'name)) - (value (bindat-get-field local 'value)) - (type (bindat-get-field local 'type))) + (let ((name (gdb-mi--field local 'name)) + (value (gdb-mi--field local 'value)) + (type (gdb-mi--field local 'type))) (when (not value) (setq value "<complex data type>")) (if (or (not value) @@ -4300,7 +4323,7 @@ member." (setq mode-name (gdb-current-context-mode-name (concat "Locals: " - (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (gdb-mi--field (gdb-current-buffer-frame) 'func)))))) (defvar gdb-locals-header (list @@ -4366,11 +4389,11 @@ member." (defun gdb-registers-handler-custom () (when gdb-register-names (let ((register-values - (bindat-get-field (gdb-json-partial-output) 'register-values)) + (gdb-mi--field (gdb-mi--partial-output) 'register-values)) (table (make-gdb-table))) (dolist (register register-values) - (let* ((register-number (bindat-get-field register 'number)) - (value (bindat-get-field register 'value)) + (let* ((register-number (gdb-mi--field register 'number)) + (value (gdb-mi--field register 'value)) (register-name (nth (string-to-number register-number) gdb-register-names))) (gdb-table-add-row @@ -4394,8 +4417,7 @@ member." (save-excursion (if event (posn-set-point (event-end event))) (beginning-of-line) - (let* ((var (bindat-get-field - (get-text-property (point) 'gdb-register-name))) + (let* ((var (get-text-property (point) 'gdb-register-name)) (value (read-string (format "New value (%s): " var)))) (gud-basic-call (concat "-gdb-set variable $" var " = " value))))) @@ -4457,7 +4479,7 @@ member." (defun gdb-changed-registers-handler () (setq gdb-changed-registers nil) (dolist (register-number - (bindat-get-field (gdb-json-partial-output) 'changed-registers)) + (gdb-mi--field (gdb-mi--partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () @@ -4465,7 +4487,7 @@ member." ;; only once (in gdb-init-1) (setq gdb-register-names nil) (dolist (register-name - (bindat-get-field (gdb-json-partial-output) 'register-names)) + (gdb-mi--field (gdb-mi--partial-output) 'register-names)) (push register-name gdb-register-names)) (setq gdb-register-names (reverse gdb-register-names))) @@ -4476,7 +4498,8 @@ If buffers already exist for any of these files, `gud-minor-mode' is set in them." (goto-char (point-min)) (while (re-search-forward gdb-source-file-regexp nil t) - (push (read (match-string 1)) gdb-source-file-list)) + (push (gdb-mi--c-string-from-string (match-string 1)) + gdb-source-file-list)) (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (member buffer-file-name gdb-source-file-list) @@ -4492,13 +4515,13 @@ Called from `gdb-update'." (defun gdb-frame-handler () "Set `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." - (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) + (let ((frame (gdb-mi--field (gdb-mi--partial-output) 'frame))) (when frame - (setq gdb-selected-frame (bindat-get-field frame 'func)) - (setq gdb-selected-file (bindat-get-field frame 'fullname)) - (setq gdb-frame-number (bindat-get-field frame 'level)) - (setq gdb-frame-address (bindat-get-field frame 'addr)) - (let ((line (bindat-get-field frame 'line))) + (setq gdb-selected-frame (gdb-mi--field frame 'func)) + (setq gdb-selected-file (gdb-mi--field frame 'fullname)) + (setq gdb-frame-number (gdb-mi--field frame 'level)) + (setq gdb-frame-address (gdb-mi--field frame 'addr)) + (let ((line (gdb-mi--field frame 'line))) (setq gdb-selected-line (and line (string-to-number line))) (when (and gdb-selected-file gdb-selected-line) (setq gud-last-frame (cons gdb-selected-file gdb-selected-line)) @@ -4523,7 +4546,7 @@ overlay arrow in source buffer." (goto-char (point-min)) (setq gdb-prompt-name nil) (re-search-forward gdb-prompt-name-regexp nil t) - (setq gdb-prompt-name (read (match-string 1))) + (setq gdb-prompt-name (gdb-mi--c-string-from-string (match-string 1))) ;; Insert first prompt. (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) @@ -4560,17 +4583,17 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let* ((buf-type (gdb-buffer-type buf)) (existing-window (get-window-with-predicate - #'(lambda (w) - (and (eq buf-type - (gdb-buffer-type (window-buffer w))) - (not (window-dedicated-p w))))))) + (lambda (w) + (and (eq buf-type + (gdb-buffer-type (window-buffer w))) + (not (window-dedicated-p w))))))) (if existing-window (set-window-buffer existing-window buf) (let ((dedicated-window (get-window-with-predicate - #'(lambda (w) - (eq buf-type - (gdb-buffer-type (window-buffer w))))))) + (lambda (w) + (eq buf-type + (gdb-buffer-type (window-buffer w))))))) (if dedicated-window (set-window-buffer (split-window dedicated-window nil split-horizontal) buf) @@ -4635,7 +4658,7 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let ((menu (make-sparse-keymap "GDB-MI"))) (define-key menu [gdb-customize] - '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb)) + `(menu-item "Customize" ,(lambda () (interactive) (customize-group 'gdb)) :help "Customize Gdb Graphical Mode options.")) (define-key menu [gdb-many-windows] '(menu-item "Display Other Windows" gdb-many-windows @@ -4644,32 +4667,32 @@ SPLIT-HORIZONTAL and show BUF in the new window." (define-key menu [sep1] '(menu-item "--")) (define-key menu [all-threads] - '(menu-item "GUD controls all threads" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads t)) + `(menu-item "GUD controls all threads" + ,(lambda () + (interactive) + (setq gdb-gud-control-all-threads t)) :help "GUD start/stop commands apply to all threads" :button (:radio . gdb-gud-control-all-threads))) (define-key menu [current-thread] - '(menu-item "GUD controls current thread" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads nil)) + `(menu-item "GUD controls current thread" + ,(lambda () + (interactive) + (setq gdb-gud-control-all-threads nil)) :help "GUD start/stop commands apply to current thread only" :button (:radio . (not gdb-gud-control-all-threads)))) (define-key menu [sep2] '(menu-item "--")) (define-key menu [gdb-customize-reasons] - '(menu-item "Customize switching..." - (lambda () - (interactive) - (customize-option 'gdb-switch-reasons)))) + `(menu-item "Customize switching..." + ,(lambda () + (interactive) + (customize-option 'gdb-switch-reasons)))) (define-key menu [gdb-switch-when-another-stopped] - (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped - gdb-switch-when-another-stopped - "Automatically switch to stopped thread" - "GDB thread switching %s" - "Switch to stopped thread")) + (menu-bar-make-toggle-command + gdb-toggle-switch-when-another-stopped + gdb-switch-when-another-stopped + "Automatically switch to stopped thread" + "GDB thread switching %s" "Switch to stopped thread")) (define-key gud-menu-map [mi] `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi)))) @@ -4972,7 +4995,7 @@ buffers, if required." ;; This function is called only once on startup. (goto-char (point-min)) (if (re-search-forward gdb-source-file-regexp nil t) - (setq gdb-main-file (read (match-string 1)))) + (setq gdb-main-file (gdb-mi--c-string-from-string (match-string 1)))) (if gdb-many-windows (gdb-setup-windows) (gdb-get-buffer-create 'gdb-breakpoints-buffer) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index c71a90344ff..96838269749 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -100,6 +100,13 @@ To change the default value, use \\[customize] or call the function :set #'grep-apply-setting :version "22.1") +(defcustom grep-match-regexp "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m" + "Regular expression matching grep markers to highlight. +It matches SGR ANSI escape sequences which are emitted by grep to +color its output. This variable is used in `grep-filter'." + :type 'regexp + :version "28.1") + (defcustom grep-scroll-output nil "Non-nil to scroll the *grep* buffer window as output appears. @@ -590,7 +597,7 @@ This function is called from `compilation-filter-hook'." (when (< (point) end) (setq end (copy-marker end)) ;; Highlight grep matches and delete marking sequences. - (while (re-search-forward "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m" end 1) + (while (re-search-forward grep-match-regexp end 1) (replace-match (propertize (match-string 1) 'face nil 'font-lock-face grep-match-face) t t) @@ -696,10 +703,10 @@ The value depends on `grep-command', `grep-template', (let ((grep-options (concat (if grep-use-null-device "-n" "-nH") (if grep-use-null-filename-separator " --null") - (if (grep-probe grep-program - `(nil nil nil "-e" "foo" ,null-device) - nil 1) - " -e")))) + (when (grep-probe grep-program + `(nil nil nil "-e" "foo" ,null-device) + nil 1) + " -e")))) (unless grep-command (setq grep-command (format "%s %s %s " grep-program @@ -952,10 +959,10 @@ The substitution is based on variables bound dynamically, and these include `opts', `dir', `files', `null-device', `excl' and `regexp'.") -(defun grep-expand-template (template &optional regexp files dir excl) +(defun grep-expand-template (template &optional regexp files dir excl more-opts) "Expand grep COMMAND string replacing <C>, <D>, <F>, <R>, and <X>." (let* ((command template) - (env `((opts . ,(let (opts) + (env `((opts . ,(let ((opts more-opts)) (when (and case-fold-search (isearch-no-upper-case-p regexp t)) (push "-i" opts)) @@ -1051,6 +1058,8 @@ REGEXP is used as a string in the prompt." (or (cdr (assoc files grep-files-aliases)) files)))) +(defvar grep-use-directories-skip 'auto-detect) + ;;;###autoload (defun lgrep (regexp &optional files dir confirm) "Run grep, searching for REGEXP in FILES in directory DIR. @@ -1096,6 +1105,12 @@ command before it's run." (if (string= command grep-command) (setq command nil)) (setq dir (file-name-as-directory (expand-file-name dir))) + (unless (or (not grep-use-directories-skip) (eq grep-use-directories-skip t)) + (setq grep-use-directories-skip + (grep-probe grep-program + `(nil nil nil "--directories=skip" "foo" + ,null-device) + nil 1))) (setq command (grep-expand-template grep-template regexp @@ -1112,7 +1127,9 @@ command before it's run." (shell-quote-argument (cdr ignore)))))) grep-find-ignored-files - " --exclude="))))) + " --exclude="))) + (and (eq grep-use-directories-skip t) + '("--directories=skip")))) (when command (if confirm (setq command diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 092d15983e5..81021bc64f4 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1845,7 +1845,7 @@ and source-file directory for your debugger." ;; JDB command will get out of the debugger. There is some truly ;; pathetic JDB documentation available at: ;; -;; http://java.sun.com/products/jdk/1.1/debugging/ +;; https://java.sun.com/products/jdk/1.1/debugging/ ;; ;; KNOWN PROBLEMS AND FIXME's: ;; @@ -2358,17 +2358,17 @@ during jdb initialization depending on the value of (if (< n gud-jdb-lowest-stack-level) (progn (setq gud-jdb-lowest-stack-level n) t))) t) - (if (setq file-found - (gud-jdb-find-source (match-string 2 gud-marker-acc))) - (setq gud-last-frame - (cons file-found - (string-to-number - (let - ((numstr (match-string 4 gud-marker-acc))) - (if (string-match "[.,]" numstr) - (replace-match "" nil nil numstr) - numstr))))) - (message "Could not find source file."))) + (let ((class (match-string 2 gud-marker-acc))) + (if (setq file-found (gud-jdb-find-source class)) + (setq gud-last-frame + (cons file-found + (string-to-number + (let + ((numstr (match-string 4 gud-marker-acc))) + (if (string-match "[.,]" numstr) + (replace-match "" nil nil numstr) + numstr))))) + (message "Could not find source file for %s" class)))) ;; Set the accumulator to the remaining text. (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 0b1ba80edcb..25e75235aa4 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -250,7 +250,7 @@ Effective only if `hide-ifdef-expand-reinclusion-protection' is t." (defvar hide-ifdef-env-backup nil "This variable is a backup of the previously cleared `hide-ifdef-env'. -This backup prevents any accidental clearance of `hide-fidef-env' by +This backup prevents any accidental clearance of `hide-ifdef-env' by `hif-clear-all-ifdef-defined'.") (defvar hif-outside-read-only nil @@ -301,7 +301,7 @@ Several variables affect how the hiding is done: ;; `hide-ifdef-env' is now a global variable. ;; We can still simulate the behavior of older hideif versions (i.e. ;; `hide-ifdef-env' being buffer local) by clearing this variable - ;; (C-c @ C) everytime before hiding current buffer. + ;; (C-c @ C) every time before hiding current buffer. ;; (set (make-local-variable 'hide-ifdef-env) ;; (default-value 'hide-ifdef-env)) (set 'hide-ifdef-env (default-value 'hide-ifdef-env)) @@ -1490,7 +1490,7 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for more details." (test (hif-canonicalize hif-ifx-regexp)) (range (hif-find-range)) (elifs (hif-range-elif range)) - (if-part t) ; Everytime we start from if-part + (if-part t) ; Every time we start from if-part (complete nil)) ;; (message "test = %s" test) (sit-for 1) @@ -1650,7 +1650,7 @@ first arg will be `hif-etc'." ;; postponed the evaluation process one stage and store the "parsed tree" ;; into symbol database. The evaluation process was then "strings -> tokens ;; -> [parsed tree] -> value". Hideif therefore run slower since it need to -;; evaluate the parsed tree everytime when trying to expand the symbol. These +;; evaluate the parsed tree every time when trying to expand the symbol. These ;; temporarily code changes are obsolete and not in Emacs source repository. ;; ;; Furthermore, CPP did allow partial expression to be defined in several @@ -1659,7 +1659,7 @@ first arg will be `hif-etc'." ;; further, otherwise those partial expression will be fail on parsing and ;; we'll miss all macros that reference it. The evaluation process thus ;; became "strings -> [tokens] -> parsed tree -> value." This degraded the -;; performance since we need to parse tokens and evaluate them everytime +;; performance since we need to parse tokens and evaluate them every time ;; when that symbol is referenced. ;; ;; In real cases I found a lot portion of macros are "simple macros" that diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 625e08e4d79..2ad66ccc5e0 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -264,7 +264,10 @@ This has effect only if `search-invisible' is set to `open'." (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) - (js-mode "{" "}" "/[*/]" nil))) + (js-mode "{" "}" "/[*/]" nil) + (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil) + ;; Add more support here. + )) "Alist for initializing the hideshow variables for different modes. Each element has the form (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index b0542a99da8..4cb82786aef 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -49,15 +49,14 @@ ;; ;; New versions of IDLWAVE, documentation, and more information available ;; from: -;; http://github.com/jdtsmith/idlwave +;; https://github.com/jdtsmith/idlwave ;; ;; INSTALLATION ;; ============ -;; Put this file on the emacs load path and load it with the following -;; line in your init file: +;; Load it with the following line in your init file: ;; -;; (add-hook 'idlwave-load-hook -;; (lambda () (require 'idlw-complete-structtag))) +;; (with-eval-after-load 'idlwave +;; (require 'idlw-complete-structtag)) ;; ;; DESCRIPTION ;; =========== diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index ec4fd58886a..2d4ea465c42 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -32,7 +32,7 @@ ;; along with new versions of IDLWAVE, documentation, and more ;; information, at: ;; -;; http://github.com/jdtsmith/idlwave +;; https://github.com/jdtsmith/idlwave ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 99ac0877c8b..38127fccbc3 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -40,7 +40,7 @@ ;; ;; New versions of IDLWAVE, documentation, and more information ;; available from: -;; http://github.com/jdtsmith/idlwave +;; https://github.com/jdtsmith/idlwave ;; ;; INSTALLATION: ;; ============= @@ -58,7 +58,7 @@ ;; The newest version of this file can be found on the maintainers ;; web site. ;; -;; http://github.com/jdtsmith/idlwave +;; https://github.com/jdtsmith/idlwave ;; ;; DOCUMENTATION ;; ============= @@ -896,7 +896,7 @@ IDL has currently stepped.") Info documentation for this package is available. Use \\[idlwave-info] to display (complain to your sysadmin if that does not work). For PostScript and HTML versions of the documentation, check IDLWAVE's - homepage at URL `http://github.com/jdtsmith/idlwave'. + homepage at URL `https://github.com/jdtsmith/idlwave'. IDLWAVE has customize support - see the group `idlwave'. 8. Keybindings diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 23c129c1afc..1866e50d680 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -29,7 +29,7 @@ ;; New versions of IDLWAVE, documentation, and more information ;; available from: -;; http://github.com/jdtsmith/idlwave +;; https://github.com/jdtsmith/idlwave ;;; Code: diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 90e56943f20..86f9f336723 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -44,7 +44,7 @@ ;; ;; New versions of IDLWAVE, documentation, and more information ;; available from: -;; http://github.com/jdtsmith/idlwave +;; https://github.com/jdtsmith/idlwave ;; ;; INSTALLATION ;; ============ @@ -64,7 +64,7 @@ ;; The newest version of this file is available from the maintainer's ;; Webpage: ;; -;; http://github.com/jdtsmith/idlwave +;; https://github.com/jdtsmith/idlwave ;; ;; DOCUMENTATION ;; ============= @@ -164,7 +164,7 @@ "Major mode for editing IDL .pro files." :tag "IDLWAVE" :link '(url-link :tag "Home Page" - "http://github.com/jdtsmith/idlwave") + "https://github.com/jdtsmith/idlwave") :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" "idlw-shell.el") :link '(emacs-commentary-link :tag "Commentary in idlwave.el" "idlwave.el") @@ -1846,7 +1846,7 @@ The main features of this mode are \\[idlwave-info] to display (complain to your sysadmin if that does not work). For Postscript, PDF, and HTML versions of the documentation, check IDLWAVE's homepage at URL - `http://github.com/jdtsmith/idlwave'. + `https://github.com/jdtsmith/idlwave'. IDLWAVE has customize support - see the group `idlwave'. 10.Keybindings @@ -6727,8 +6727,7 @@ accumulate information on matching completions." (not super-classes))) ; no possibilities for inheritance ;; In these cases, we do not have to do anything list - (let* ((do-prop (and (>= show-classes 0) - (>= emacs-major-version 21))) + (let* ((do-prop (>= show-classes 0)) (do-buf (not (= show-classes 0))) (do-dots t) (inherit (if (and (not (eq type 'class-tag)) super-classes) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5c50e2accdf..f3cfbbb948f 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4656,8 +4656,19 @@ could set `js-jsx-syntax' to t in your init file, or in a one of the aforementioned options instead of using this mode." :group 'js (js-jsx-enable) + (setq-local comment-region-function #'js-jsx--comment-region) (js-use-syntactic-mode-name)) +(defun js-jsx--comment-region (beg end &optional arg) + (if (or (js-jsx--context) + (save-excursion + (skip-chars-forward " \t") + (js-jsx--looking-at-start-tag-p))) + (let ((comment-start "{/* ") + (comment-end " */}")) + (comment-region-default beg end arg)) + (comment-region-default beg end arg))) + ;;;###autoload (defalias 'javascript-mode 'js-mode) (eval-after-load 'folding diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index 442c2309777..b17f255ba6a 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -1,4 +1,4 @@ -;;; ld-script.el --- GNU linker script editing mode for Emacs +;;; ld-script.el --- GNU linker script editing mode for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 95fead9b374..ec0f425de92 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -1,4 +1,4 @@ -;;; m4-mode.el --- m4 code editing commands for Emacs +;;; m4-mode.el --- m4 code editing commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc. @@ -48,14 +48,12 @@ "File name of the m4 executable. If m4 is not in your PATH, set this to an absolute file name." :version "24.4" - :type 'file - :group 'm4) + :type 'file) ;;options to m4 (defcustom m4-program-options nil "Options to pass to `m4-program'." - :type '(repeat string) - :group 'm4) + :type '(repeat string)) ;;to use --prefix-builtins, you can use ;;(defconst m4-program-options '("-P")) @@ -72,8 +70,7 @@ If m4 is not in your PATH, set this to an absolute file name." (defcustom m4-mode-hook nil "Hook called by `m4-mode'." - :type 'hook - :group 'm4) + :type 'hook) ;;this may still need some work (defvar m4-mode-syntax-table @@ -125,7 +122,7 @@ If m4 is not in your PATH, set this to an absolute file name." (interactive) (shell-command-on-region (point-min) (point-max) - (mapconcat 'identity (cons m4-program m4-program-options) "\s") + (mapconcat #'identity (cons m4-program m4-program-options) "\s") "*m4-output*" nil) (switch-to-buffer-other-window "*m4-output*")) @@ -134,7 +131,7 @@ If m4 is not in your PATH, set this to an absolute file name." (interactive) (shell-command-on-region (point) (mark) - (mapconcat 'identity (cons m4-program m4-program-options) "\s") + (mapconcat #'identity (cons m4-program m4-program-options) "\s") "*m4-output*" nil) (switch-to-buffer-other-window "*m4-output*")) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 235279e226e..ac3d0817097 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1413,7 +1413,7 @@ Fill comments, backslashed lines, and variable definitions specially." "Leave the browser and return to the makefile buffer." (interactive) (let ((my-client makefile-browser-client)) - (setq makefile-browser-client nil) ; we quitted, so NO client! + (setq makefile-browser-client nil) ; we quit, so NO client! (set-buffer-modified-p nil) (quit-window t) (pop-to-buffer my-client))) @@ -1721,7 +1721,9 @@ matched in a rule action." (while (progn (skip-chars-forward makefile-dependency-skip bound) (< (point) (or bound (point-max)))) (forward-char) - (or (eq (char-after) ?=) + ;; The GNU immediate assignment operator is ":=", while the + ;; POSIX operator is "::=". + (or (looking-at ":?=") (get-text-property (1- (point)) 'face) (if (> (line-beginning-position) (+ (point-min) 2)) (eq (char-before (line-end-position 0)) ?\\)) diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 468c116b674..b9f60598f63 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -1,11 +1,11 @@ -;;; mixal-mode.el --- Major mode for the mix asm language. +;;; mixal-mode.el --- Major mode for the mix asm language. -*- lexical-binding:t -*- ;; Copyright (C) 2003-2020 Free Software Foundation, Inc. ;; Author: Pieter E.J. Pareit <pieter.pareit@gmail.com> -;; Maintainer: emacs-devel@gnu.org +;; Maintainer: Jose A Ortega Ruiz <jao@gnu.org> ;; Created: 09 Nov 2002 -;; Version: 0.1 +;; Version: 0.4 ;; Keywords: languages, Knuth, mix, mixal, asm, mixvm, The Art Of Computer Programming ;; This file is part of GNU Emacs. @@ -24,6 +24,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: + ;; Major mode for the mix asm language. ;; The mix asm language is described in "The Art Of Computer Programming". ;; @@ -34,8 +35,9 @@ ;; ;; 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 -;; automatic. If you want to start the mode manual, use `M-x mixal-mode'. +;; 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 ;; default behavior. You can compile a source file with `C-c c' you can ;; run a compiled file with `C-c r' or run it in debug mode with `C-c d'. @@ -45,6 +47,9 @@ ;; Have fun. ;;; History: +;; Version 0.4: +;; 16/10/20: Jose A Ortega Ruiz <jao@gnu.org> +;; Add missed instructions: SLB,SRB,JAE,JAO,JXE,JXO ;; Version 0.3: ;; 12/10/05: Stefan Monnier <monnier@iro.umontreal.ca> ;; Use font-lock-syntactic-keywords to detect/mark comments. @@ -683,6 +688,18 @@ Register J is set to the value of the next instruction that would have been executed when there was no jump." 1) + (JAE jump "jump A even" 40 + "Jump if the content of rA is even. +Register J is set to the value of the next instruction that would have +been executed when there was no jump." + 1) + + (JAO jump "jump A odd" 40 + "Jump if the content of rA is odd. +Register J is set to the value of the next instruction that would have +been executed when there was no jump." + 1) + (JXN jump "jump X negative" 47 "Jump if the content of rX is negative. Register J is set to the value of the next instruction that would have @@ -719,12 +736,24 @@ Register J is set to the value of the next instruction that would have been executed when there was no jump." 1) - (J1N jump "jump I1 negative" 41 - "Jump if the content of rI1 is negative. + (JXE jump "jump X even" 47 + "Jump if the content of rX is even. +Register J is set to the value of the next instruction that would have +been executed when there was no jump." + 1) + + (JXO jump "jump X odd" 47 + "Jump if the content of rX is odd. Register J is set to the value of the next instruction that would have been executed when there was no jump." 1) + (J1N jump "jump I1 negative" 41 + "Jump if the content of rI1 is negative. +Register J is set to the value of the next instruction that would have +been executed when there was no jump." + 1) + (J1Z jump "jump I1 zero" 41 "Jump if the content of rI1 is zero. Register J is set to the value of the next instruction that would have @@ -950,7 +979,6 @@ Zeros will be added to the left." Zeros will be added to the right." 2) - (SRAX miscellaneous "shift right AX" 6 "Shift AX, M bytes right. Zeros will be added to the left." @@ -966,6 +994,14 @@ The bytes that fall off to the left will be added to the right." The bytes that fall off to the right will be added to the left." 2) + (SLB miscellaneous "shift left AX binary" 6 + "Shift AX, M binary places left." + 2) + + (SRB miscellaneous "shift right AX binary" 6 + "Shift AX, M binary places right." + 2) + (MOVE miscellaneous "move" 7 number "Move MOD words from M to the location stored in rI1." (+ 1 (* 2 number))) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 127b24cb890..7265aeee45d 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -258,7 +258,7 @@ ;; (or some similar separator), or by one of the special keywords ;; corresponding to builtin functions that can take their first arg ;; without parentheses. Of course, that presume we're looking at the - ;; *opening* slash. We can afford to mis-match the closing ones + ;; *opening* slash. We can afford to mismatch the closing ones ;; here, because they will be re-treated separately later in ;; perl-font-lock-special-syntactic-constructs. ((concat perl--syntax-exp-intro-regexp "\\(/\\)") diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 7180ba317c3..8f7482a23d7 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -66,6 +66,9 @@ ;; `project-combine-directories' and `project-subtract-directories', ;; mainly for use in the abovementioned generics' implementations. ;; +;; `project-known-project-roots' and `project-remember-project' to +;; interact with the "known projects" list. +;; ;; Commands: ;; ;; `project-prefix-map' contains the full list of commands defined in @@ -937,6 +940,7 @@ Arguments the same as in `compile'." (interactive (list (let ((command (eval compile-command))) + (require 'compile) (if (or compilation-read-command current-prefix-arg) (compilation-read-command command) command)) @@ -1021,7 +1025,7 @@ Each condition is either: The car can be one of the following: * `major-mode': the buffer is killed if the buffer's major mode is eq to the cons-cell's cdr - * `defived-mode': the buffer is killed if the buffer's major + * `derived-mode': the buffer is killed if the buffer's major mode is derived from the major mode denoted by the cons-cell's cdr * `not': the cdr is interpreted as a negation of a condition. @@ -1030,7 +1034,7 @@ Each condition is either: * `or': the cdr is a list of recursive conditions, of which at least one has to be met. -If any of these conditions are satified for a buffer in the +If any of these conditions are satisfied for a buffer in the current project, it will be killed." :type '(repeat (choice regexp function symbol (cons :tag "Major mode" @@ -1105,7 +1109,7 @@ identical. Only the buffers that match a condition in `project-kill-buffer-conditions' will be killed. If NO-CONFIRM is non-nil, the command will not ask the user for confirmation. NO-CONFIRM is always nil when the command is invoked -interactivly." +interactively." (interactive) (let* ((pr (project-current t)) (bufs (project--buffers-to-kill pr))) @@ -1225,7 +1229,7 @@ command to run when KEY is pressed. LABEL is used to distinguish the menu entries in the dispatch menu.") (defun project--keymap-prompt () - "Return a prompt for the project swithing dispatch menu." + "Return a prompt for the project switching dispatch menu." (mapconcat (pcase-lambda (`(,key ,label)) (format "[%s] %s" diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index a209d21807f..124f652ed69 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -776,12 +776,6 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (modify-syntax-entry ?> "." table) (modify-syntax-entry ?| "." table) (modify-syntax-entry ?\' "\"" table) - - ;; Any better way to handle the 0'<char> construct?!? - (when (and prolog-char-quote-workaround - (not (fboundp 'syntax-propertize-rules))) - (modify-syntax-entry ?0 "\\" table)) - (modify-syntax-entry ?% "<" table) (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?* ". 23b" table) @@ -1047,21 +1041,19 @@ VERSION is of the format (Major . Minor)" alist))) (defconst prolog-syntax-propertize-function - (when (fboundp 'syntax-propertize-rules) - (syntax-propertize-rules - ;; GNU Prolog only accepts 0'\' rather than 0'', but the only - ;; possible meaning of 0'' is rather clear. - ("\\<0\\(''?\\)" - (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) - (string-to-syntax "_")))) - ;; We could check that we're not inside an atom, but I don't think - ;; that 'foo 8'z could be a valid syntax anyway, so why bother? - ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_")) - ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal - ;; escape sequences in atoms, so be careful not to let the terminating \ - ;; escape a subsequent quote. - ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_")) - ))) + (syntax-propertize-rules + ;; GNU Prolog only accepts 0'\' rather than 0'', but the only + ;; possible meaning of 0'' is rather clear. + ("\\<0\\(''?\\)" + (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "_")))) + ;; We could check that we're not inside an atom, but I don't think + ;; that 'foo 8'z could be a valid syntax anyway, so why bother? + ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_")) + ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal + ;; escape sequences in atoms, so be careful not to let the terminating \ + ;; escape a subsequent quote. + ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_")))) (defun prolog-mode-variables () "Set some common variables to Prolog code specific values." @@ -1886,14 +1878,7 @@ Argument BOUND is a buffer position limiting searching." bound t))) point)) -(defsubst prolog-face-name-p (facename) - ;; Return t if FACENAME is the name of a face. This method is - ;; necessary since facep in XEmacs only returns t for the actual - ;; face objects (while it's only their names that are used just - ;; about anywhere else) without providing a predicate that tests - ;; face names. This function (including the above commentary) is - ;; borrowed from cc-mode. - (memq facename (face-list))) +(define-obsolete-function-alias 'prolog-face-name-p 'facep "28.1") ;; Set everything up (defun prolog-font-lock-keywords () @@ -1928,6 +1913,8 @@ Argument BOUND is a buffer position limiting searching." (t (:underline t))) "Face name to use for compiler warnings." :group 'prolog-faces) + (define-obsolete-face-alias 'prolog-warning-face + 'font-lock-warning-face "28.1") (defface prolog-builtin-face '((((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Cyan")) @@ -1937,15 +1924,11 @@ Argument BOUND is a buffer position limiting searching." (t (:bold t))) "Face name to use for compiler warnings." :group 'prolog-faces) - (defvar prolog-warning-face - (if (prolog-face-name-p 'font-lock-warning-face) - 'font-lock-warning-face - 'prolog-warning-face) + (define-obsolete-face-alias 'prolog-builtin-face + 'font-lock-builtin-face "28.1") + (defvar prolog-warning-face 'font-lock-warning-face "Face name to use for built in predicates.") - (defvar prolog-builtin-face - (if (prolog-face-name-p 'font-lock-builtin-face) - 'font-lock-builtin-face - 'prolog-builtin-face) + (defvar prolog-builtin-face 'font-lock-builtin-face "Face name to use for built in predicates.") (defvar prolog-redo-face 'prolog-redo-face "Face name to use for redo trace lines.") @@ -2291,12 +2274,12 @@ between them)." (progn (goto-char cbeg) (search-forward-regexp "%+[ \t]*" end t) - (prolog-replace-in-string (buffer-substring beg (point)) - "[^ \t%]" " ")) + (replace-regexp-in-string "[^ \t%]" " " + (buffer-substring beg (point)))) ;(goto-char beg) (if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*" end t) - (prolog-replace-in-string (buffer-substring beg (point)) "/" " ") + (replace-regexp-in-string "/" " " (buffer-substring beg (point))) (beginning-of-line) (when (search-forward-regexp "^[ \t]+" end t) (buffer-substring beg (point))))))))) @@ -2336,11 +2319,10 @@ In effect it sets the `fill-prefix' when inside comments and then calls (do-auto-fill) )) -(defalias 'prolog-replace-in-string - (if (fboundp 'replace-in-string) - #'replace-in-string - (lambda (str regexp newtext &optional literal) - (replace-regexp-in-string regexp newtext str nil literal)))) +(defun prolog-replace-in-string (str regexp newtext &optional literal) + (declare (obsolete replace-regexp-in-string "28.1")) + (replace-regexp-in-string regexp newtext str nil literal)) + ;;------------------------------------------------------------------- ;; Online help @@ -2369,12 +2351,8 @@ In effect it sets the `fill-prefix' when inside comments and then calls ;; in prolog-help-function-i (t (let* ((word (prolog-atom-under-point)) - (predicate (read-string - (format "Help on predicate%s: " - (if word - (concat " (default " word ")") - "")) - nil nil word)) + (predicate (read-string (format-prompt "Help on predicate" word) + nil nil word)) ;;point ) (if prolog-help-function-i @@ -3087,12 +3065,8 @@ The module name should be written manually just before the semi-colon." (insert "%%% -*- Module: ; -*-\n") (backward-char 6)) -(defalias 'prolog-uncomment-region - (if (fboundp 'uncomment-region) #'uncomment-region - (lambda (beg end) - "Uncomment the region between BEG and END." - (interactive "r") - (comment-region beg end -1)))) +(define-obsolete-function-alias 'prolog-uncomment-region + 'uncomment-region "28.1") (defun prolog-indent-predicate () "Indent the current predicate." @@ -3378,7 +3352,7 @@ PREFIX is the prefix of the search regexp." "Commands for Prolog code manipulation." '("Prolog" ["Comment region" comment-region (use-region-p)] - ["Uncomment region" prolog-uncomment-region (use-region-p)] + ["Uncomment region" uncomment-region (use-region-p)] ["Add comment/move to comment" indent-for-comment t] ["Convert variables in region to '_'" prolog-variables-to-anonymous :active (use-region-p) :included (not (eq prolog-system 'mercury))] diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index ccbcb081305..53b654001e3 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4,7 +4,7 @@ ;; Author: Fabián E. Gallina <fgallina@gnu.org> ;; URL: https://github.com/fgallina/python.el -;; Version: 0.26.1 +;; Version: 0.27 ;; Package-Requires: ((emacs "24.1") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 @@ -135,7 +135,7 @@ ;; values enable completion for both CPython and IPython, and probably ;; any readline based shell (it's known to work with PyPy). If your ;; Python installation lacks readline (like CPython for Windows), -;; installing pyreadline (URL `http://ipython.org/pyreadline.html') +;; installing pyreadline (URL `https://ipython.org/pyreadline.html') ;; should suffice. To troubleshoot why you are not getting any ;; completions, you can try the following in your Python shell: @@ -501,6 +501,52 @@ The type returned can be `comment', `string' or `paren'." font-lock-string-face) font-lock-comment-face)) +(defun python--f-string-p (ppss) + "Return non-nil if the pos where PPSS was found is inside an f-string." + (and (nth 3 ppss) + (let ((spos (1- (nth 8 ppss)))) + (and (memq (char-after spos) '(?f ?F)) + (or (< (point-min) spos) + (not (memq (char-syntax (char-before spos)) '(?w ?_)))))))) + +(defun python--font-lock-f-strings (limit) + "Mark {...} holes as being code. +Remove the (presumably `font-lock-string-face') `face' property from +the {...} holes that appear within f-strings." + ;; FIXME: This will fail to properly highlight strings appearing + ;; within the {...} of an f-string. + ;; We could presumably fix it by running + ;; `font-lock-fontify-syntactically-region' (as is done in + ;; `sm-c--cpp-fontify-syntactically', for example) after removing + ;; the `face' property, but I'm not sure it's worth the effort and + ;; the risks. + (let ((ppss (syntax-ppss))) + (while + (progn + (while (and (not (python--f-string-p ppss)) + (re-search-forward "\\<f['\"]" limit 'move)) + (setq ppss (syntax-ppss))) + (< (point) limit)) + (cl-assert (python--f-string-p ppss)) + (let ((send (save-excursion + (goto-char (nth 8 ppss)) + (condition-case nil + (progn (let ((forward-sexp-function nil)) + (forward-sexp 1)) + (min limit (1- (point)))) + (scan-error limit))))) + (while (re-search-forward "{" send t) + (if (eq ?\{ (char-after)) + (forward-char 1) ;Just skip over {{ + (let ((beg (match-beginning 0)) + (end (condition-case nil + (progn (up-list 1) (min send (point))) + (scan-error send)))) + (goto-char end) + (put-text-property beg end 'face nil)))) + (goto-char (min limit (1+ send))) + (setq ppss (syntax-ppss)))))) + (defvar python-font-lock-keywords-level-1 `((,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_)))) (1 font-lock-function-name-face)) @@ -567,7 +613,8 @@ This is the medium decoration level, including everything in builtins.") (defvar python-font-lock-keywords-maximum-decoration - `(,@python-font-lock-keywords-level-2 + `((python--font-lock-f-strings) + ,@python-font-lock-keywords-level-2 ;; Constants (,(rx symbol-start (or @@ -575,7 +622,8 @@ builtins.") ;; copyright, license, credits, quit and exit are added by the site ;; module and they are not intended to be used in programs "copyright" "credits" "exit" "license" "quit") - symbol-end) . font-lock-constant-face) + symbol-end) + . font-lock-constant-face) ;; Decorators. (,(rx line-start (* (any " \t")) (group "@" (1+ (or word ?_)) (0+ "." (1+ (or word ?_))))) @@ -609,7 +657,8 @@ builtins.") ;; OS specific "VMSError" "WindowsError" ) - symbol-end) . font-lock-type-face) + symbol-end) + . font-lock-type-face) ;; assignments ;; support for a = b = c = 5 (,(lambda (limit) @@ -2059,7 +2108,7 @@ that they are prioritized when looking for executables." When this variable is non-nil, values are exported into remote hosts PATH before starting processes. Values defined in `python-shell-exec-path' will take precedence to paths defined -here. Normally you wont use this variable directly unless you +here. Normally you won't use this variable directly unless you plan to ensure a particular set of paths to all Python shell executed through tramp connections." :version "25.1" @@ -2078,7 +2127,7 @@ virtualenv." :group 'python) (defcustom python-shell-setup-codes nil - "List of code run by `python-shell-send-setup-codes'." + "List of code run by `python-shell-send-setup-code'." :type '(repeat symbol) :group 'python) @@ -2378,9 +2427,11 @@ regexps: `python-shell-prompt-regexp', (defun python-shell-prompt-set-calculated-regexps () "Detect and set input and output prompt regexps. -Build and set the values for `python-shell-input-prompt-regexp' -and `python-shell-output-prompt-regexp' using the values from -`python-shell-prompt-regexp', `python-shell-prompt-block-regexp', +Build and set the values for +`python-shell--prompt-calculated-input-regexp' and +`python-shell--prompt-calculated-output-regexp' using the values +from `python-shell-prompt-regexp', +`python-shell-prompt-block-regexp', `python-shell-prompt-pdb-regexp', `python-shell-prompt-output-regexp', `python-shell-prompt-input-regexps', @@ -2442,7 +2493,7 @@ of `python-shell-buffer-name'." (defun python-shell-internal-get-process-name () "Calculate the appropriate process name for Internal Python process. -The name is calculated from `python-shell-global-buffer-name' and +The name is calculated from `python-shell-buffer-name' and the `buffer-name'." (format "%s[%s]" python-shell-internal-buffer-name (buffer-name))) @@ -3074,7 +3125,7 @@ Returns the output. See `python-shell-send-string-no-output'." (define-obsolete-function-alias 'python-send-string 'python-shell-internal-send-string "24.3") -(defun python-shell-buffer-substring (start end &optional nomain) +(defun python-shell-buffer-substring (start end &optional nomain no-cookie) "Send buffer substring from START to END formatted for shell. This is a wrapper over `buffer-substring' that takes care of different transformations for the code sent to be evaluated in @@ -3088,9 +3139,16 @@ the python shell: 4. Wraps indented regions under an \"if True:\" block so the interpreter evaluates them correctly." (let* ((start (save-excursion - ;; Normalize start to the line beginning position. + ;; If we're at the start of the expression, and + ;; there's just blank space ahead of it, then expand + ;; the region to include the start of the line. + ;; This makes things work better with the rest of + ;; the data we're sending over. (goto-char start) - (line-beginning-position))) + (if (string-blank-p + (buffer-substring (line-beginning-position) start)) + (line-beginning-position) + start))) (substring (buffer-substring-no-properties start end)) (starts-at-point-min-p (save-restriction (widen) @@ -3100,12 +3158,13 @@ the python shell: (goto-char start) (python-util-forward-comment 1) (current-indentation)))) - (fillstr (when (not starts-at-point-min-p) - (concat - (format "# -*- coding: %s -*-\n" encoding) - (make-string - ;; Subtract 2 because of the coding cookie. - (- (line-number-at-pos start) 2) ?\n))))) + (fillstr (and (not no-cookie) + (not starts-at-point-min-p) + (concat + (format "# -*- coding: %s -*-\n" encoding) + (make-string + ;; Subtract 2 because of the coding cookie. + (- (line-number-at-pos start) 2) ?\n))))) (with-temp-buffer (python-mode) (when fillstr @@ -3144,7 +3203,8 @@ the python shell: (line-beginning-position) (line-end-position)))) (buffer-substring-no-properties (point-min) (point-max))))) -(defun python-shell-send-region (start end &optional send-main msg) +(defun python-shell-send-region (start end &optional send-main msg + no-cookie) "Send the region delimited by START and END to inferior Python process. When optional argument SEND-MAIN is non-nil, allow execution of code inside blocks delimited by \"if __name__== \\='__main__\\=':\". @@ -3154,7 +3214,8 @@ non-nil, forces display of a user-friendly message if there's no process running; defaults to t when called interactively." (interactive (list (region-beginning) (region-end) current-prefix-arg t)) - (let* ((string (python-shell-buffer-substring start end (not send-main))) + (let* ((string (python-shell-buffer-substring start end (not send-main) + no-cookie)) (process (python-shell-get-process-or-error msg)) (original-string (buffer-substring-no-properties start end)) (_ (string-match "\\`\n*\\(.*\\)" original-string))) @@ -3178,7 +3239,7 @@ interactively." (python-shell-send-region (save-excursion (python-nav-beginning-of-statement)) (save-excursion (python-nav-end-of-statement)) - send-main msg))) + send-main msg t))) (defun python-shell-send-buffer (&optional send-main msg) "Send the entire buffer to inferior Python process. @@ -3200,27 +3261,29 @@ optional argument MSG is non-nil, forces display of a user-friendly message if there's no process running; defaults to t when called interactively." (interactive (list current-prefix-arg t)) - (save-excursion - (python-shell-send-region - (progn - (end-of-line 1) - (while (and (or (python-nav-beginning-of-defun) - (beginning-of-line 1)) - (> (current-indentation) 0))) - (when (not arg) - (while (and - (eq (forward-line -1) 0) - (if (looking-at (python-rx decorator)) - t - (forward-line 1) - nil)))) - (point-marker)) - (progn - (or (python-nav-end-of-defun) - (end-of-line 1)) - (point-marker)) - nil ;; noop - msg))) + (let ((starting-pos (point))) + (save-excursion + (python-shell-send-region + (progn + (end-of-line 1) + (while (and (or (python-nav-beginning-of-defun) + (beginning-of-line 1)) + (> (current-indentation) 0))) + (when (not arg) + (while (and + (eq (forward-line -1) 0) + (if (looking-at (python-rx decorator)) + t + (forward-line 1) + nil)))) + (point-marker)) + (progn + (goto-char starting-pos) + (or (python-nav-end-of-defun) + (end-of-line 1)) + (point-marker)) + nil ;; noop + msg)))) (defun python-shell-send-file (file-name &optional process temp-file-name delete msg) @@ -3796,7 +3859,7 @@ was `continue'. This behavior slightly differentiates the `continue' command from the `exit' command listed in `python-pdbtrack-exit-command'. See `python-pdbtrack-activate' for pdbtracking session overview." - :type 'list + :type '(repeat string) :version "27.1") (defcustom python-pdbtrack-exit-command '("q" "quit" "exit") @@ -3805,7 +3868,7 @@ After one of this commands is sent to pdb, pdbtracking session is considered over. See `python-pdbtrack-activate' for pdbtracking session overview." - :type 'list + :type '(repeat string) :version "27.1") (defcustom python-pdbtrack-kill-buffers t @@ -4130,7 +4193,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (goto-char (point-max))) (point-marker))) (multi-line-p - ;; Docstring styles may vary for oneliners and multi-liners. + ;; Docstring styles may vary for one-liners and multi-liners. (> (count-matches "\n" str-start-pos str-end-pos) 0)) (delimiters-style (pcase python-fill-docstring-style @@ -4712,7 +4775,7 @@ customize how labels are formatted." (defun python-imenu-create-flat-index (&optional alist prefix) "Return flat outline of the current Python buffer for Imenu. Optional argument ALIST is the tree to be flattened; when nil -`python-imenu-build-index' is used with +`python-imenu-create-index' is used with `python-imenu-format-parent-item-jump-label-function' `python-imenu-format-parent-item-label-function' `python-imenu-format-item-label-function' set to @@ -5129,21 +5192,22 @@ point's current `syntax-ppss'." (>= 2 (let (last-backward-sexp-point) - (while (save-excursion - (python-nav-backward-sexp) - (setq backward-sexp-point (point)) - (and (= indentation (current-indentation)) - ;; Make sure we're always moving point. - ;; If we get stuck in the same position - ;; on consecutive loop iterations, - ;; bail out. - (prog1 (not (eql last-backward-sexp-point - backward-sexp-point)) - (setq last-backward-sexp-point - backward-sexp-point)) - (looking-at-p - (concat "[uU]?[rR]?" - (python-rx string-delimiter))))) + (while (and (<= counter 2) + (save-excursion + (python-nav-backward-sexp) + (setq backward-sexp-point (point)) + (and (= indentation (current-indentation)) + ;; Make sure we're always moving point. + ;; If we get stuck in the same position + ;; on consecutive loop iterations, + ;; bail out. + (prog1 (not (eql last-backward-sexp-point + backward-sexp-point)) + (setq last-backward-sexp-point + backward-sexp-point)) + (looking-at-p + (concat "[uU]?[rR]?" + (python-rx string-delimiter)))))) ;; Previous sexp was a string, restore point. (goto-char backward-sexp-point) (cl-incf counter)) @@ -5335,7 +5399,7 @@ To use `flake8' you would set this to (\"flake8\" \"-\")." :group 'python-flymake :type '(repeat string)) -;; The default regexp accomodates for older pyflakes, which did not +;; The default regexp accommodates for older pyflakes, which did not ;; report the column number, and at the same time it's compatible with ;; flake8 output, although it may be redefined to explicitly match the ;; TYPE @@ -5535,7 +5599,7 @@ REPORT-FN is Flymake's callback function." (^ '(- (1+ (current-indentation)))))) (with-no-warnings - ;; supress warnings about eldoc-documentation-function being obsolete + ;; suppress warnings about eldoc-documentation-function being obsolete (if (null eldoc-documentation-function) ;; Emacs<25 (set (make-local-variable 'eldoc-documentation-function) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 831acf87bf0..14f00597bfc 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -4,7 +4,7 @@ ;; Authors: Yukihiro Matsumoto ;; Nobuyoshi Nakada -;; URL: http://www.emacswiki.org/cgi-bin/wiki/RubyMode +;; URL: https://www.emacswiki.org/cgi-bin/wiki/RubyMode ;; Created: Fri Feb 4 14:49:13 JST 1994 ;; Keywords: languages ruby ;; Version: 1.2 @@ -142,12 +142,11 @@ This should only be called after matching against `ruby-here-doc-beg-re'." "Regexp to match symbols.") (defvar ruby-use-smie t) +(make-obsolete-variable 'ruby-use-smie nil "28.1") (defvar ruby-mode-map (let ((map (make-sparse-keymap))) (unless ruby-use-smie - (define-key map (kbd "M-C-b") 'ruby-backward-sexp) - (define-key map (kbd "M-C-f") 'ruby-forward-sexp) (define-key map (kbd "M-C-q") 'ruby-indent-exp)) (when ruby-use-smie (define-key map (kbd "M-C-d") 'smie-down-list)) @@ -170,14 +169,8 @@ This should only be called after matching against `ruby-here-doc-beg-re'." "--" ["Toggle String Quotes" ruby-toggle-string-quotes t] "--" - ["Backward Sexp" ruby-backward-sexp - :visible (not ruby-use-smie)] - ["Backward Sexp" backward-sexp - :visible ruby-use-smie] - ["Forward Sexp" ruby-forward-sexp - :visible (not ruby-use-smie)] - ["Forward Sexp" forward-sexp - :visible ruby-use-smie] + ["Backward Sexp" backward-sexp t] + ["Forward Sexp" forward-sexp t] ["Indent Sexp" ruby-indent-exp :visible (not ruby-use-smie)] ["Indent Sexp" prog-indent-sexp @@ -741,10 +734,10 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (defun ruby-mode-variables () "Set up initial buffer-local variables for Ruby mode." (setq indent-tabs-mode ruby-indent-tabs-mode) - (if ruby-use-smie - (smie-setup ruby-smie-grammar #'ruby-smie-rules - :forward-token #'ruby-smie--forward-token - :backward-token #'ruby-smie--backward-token) + (smie-setup ruby-smie-grammar #'ruby-smie-rules + :forward-token #'ruby-smie--forward-token + :backward-token #'ruby-smie--backward-token) + (unless ruby-use-smie (setq-local indent-line-function #'ruby-indent-line)) (setq-local comment-start "# ") (setq-local comment-end "") @@ -1378,7 +1371,8 @@ move forward." The defun begins at or after the point. This function is called by `end-of-defun'." (interactive "p") - (ruby-forward-sexp) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (ruby-forward-sexp)) (let (case-fold-search) (when (looking-back (concat "^\\s *" ruby-block-end-re) (line-beginning-position)) @@ -1467,11 +1461,14 @@ With ARG, move out of multiple blocks." (defun ruby-forward-sexp (&optional arg) "Move forward across one balanced expression (sexp). With ARG, do it many times. Negative ARG means move backward." + (declare (obsolete forward-sexp "28.1")) ;; TODO: Document body (interactive "p") (cond (ruby-use-smie (forward-sexp arg)) - ((and (numberp arg) (< arg 0)) (ruby-backward-sexp (- arg))) + ((and (numberp arg) (< arg 0)) + (with-suppressed-warnings ((obsolete ruby-backward-sexp)) + (ruby-backward-sexp (- arg)))) (t (let ((i (or arg 1))) (condition-case nil @@ -1515,11 +1512,14 @@ With ARG, do it many times. Negative ARG means move backward." (defun ruby-backward-sexp (&optional arg) "Move backward across one balanced expression (sexp). With ARG, do it many times. Negative ARG means move forward." + (declare (obsolete backward-sexp "28.1")) ;; TODO: Document body (interactive "p") (cond (ruby-use-smie (backward-sexp arg)) - ((and (numberp arg) (< arg 0)) (ruby-forward-sexp (- arg))) + ((and (numberp arg) (< arg 0)) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (ruby-forward-sexp (- arg)))) (t (let ((i (or arg 1))) (condition-case nil @@ -1671,7 +1671,8 @@ See `add-log-current-defun-function'." (defun ruby-block-contains-point (pt) (save-excursion (save-match-data - (ruby-forward-sexp) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (ruby-forward-sexp)) (> (point) pt)))) (defun ruby-brace-to-do-end (orig end) @@ -1749,7 +1750,8 @@ If the result is do-end block, it will always be multiline." (progn (goto-char (or (match-beginning 1) (match-beginning 2))) (setq beg (point)) - (save-match-data (ruby-forward-sexp)) + (with-suppressed-warnings ((obsolete ruby-forward-sexp)) + (save-match-data (ruby-forward-sexp))) (setq end (point)) (> end start))) (if (match-beginning 1) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 3c249b7bc0e..3b24cabe8bd 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -4,7 +4,7 @@ ;; Inc. ;; Author: Daniel Pfeiffer <occitan@esperanto.org> -;; Version: 2.0f +;; Old-Version: 2.0f ;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, unix @@ -386,6 +386,7 @@ name symbol." ?~ "_" ?, "_" ?= "." + ?/ "." ?\; "." ?| "." ?& "." diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index e554b2b8b0b..6b0df2d700d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -232,9 +232,6 @@ (require 'cl-lib) (require 'comint) -;; Need the following to allow GNU Emacs 19 to compile the file. -(eval-when-compile - (require 'regexp-opt)) (require 'custom) (require 'thingatpt) (require 'view) @@ -342,8 +339,7 @@ file. Since that is a plaintext file, this could be dangerous." (const :format "" :completion) (sexp :tag ":completion") (const :format "" :must-match) - (restricted-sexp - :match-alternatives (listp stringp)))) + (symbol :tag ":must-match"))) (const port))) ;; SQL Product support @@ -838,11 +834,11 @@ host key." (setq w (locate-user-emacs-file (concat "sql-wallet" ext) (concat ".sql-wallet" ext))) (when (file-exists-p w) - (setq wallet w))))) + (setq wallet (list w)))))) "Identification of the password wallet. See `sql-password-search-wallet-function' to understand how this value is used to locate the password wallet." - :type `(plist-get (symbol-plist 'auth-sources) 'custom-type) + :type (plist-get (symbol-plist 'auth-sources) 'custom-type) :version "27.1") (defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet @@ -2809,8 +2805,8 @@ See `sql-product-alist' for a list of products and supported features." The KEYWORDS-ONLY flag is passed to font-lock to specify whether only keywords should be highlighted and syntactic highlighting -skipped. The IMENU flag indicates whether `imenu-mode' should -also be configured." +skipped. The IMENU flag indicates whether `imenu' should also be +configured." (let ;; Get the product-specific syntax-alist. @@ -4294,14 +4290,14 @@ Here is an example for your init file. It keeps the SQLi buffer a certain length. \(add-hook \\='sql-interactive-mode-hook - (function (lambda () - (setq comint-output-filter-functions #\\='comint-truncate-buffer)))) + (lambda () + (setq comint-output-filter-functions #\\='comint-truncate-buffer))) Here is another example. It will always put point back to the statement you entered, right above the output it created. \(setq comint-output-filter-functions - (function (lambda (STR) (comint-show-output))))" + (lambda (STR) (comint-show-output)))" :syntax-table sql-mode-syntax-table ;; FIXME: The doc above uses `setq' on `comint-output-filter-functions', ;; whereas hooks should be manipulated with things like `add/remove-hook'. diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 33aad2d39f7..d4d51e8b50c 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -407,10 +407,64 @@ This variable is generally set from `tcl-proc-regexp', `tcl-typeword-list', and `tcl-keyword-list' by the function `tcl-set-font-lock-keywords'.") +(eval-and-compile + (defconst tcl--word-delimiters "[;{ \t\n")) + +(defun tcl--syntax-of-quote (pos) + "Decide whether a double quote opens a string or not." + ;; This is pretty tricky, because strings can be written as "..." + ;; or as {...} or without any quoting at all for some simple and not so + ;; simple cases (e.g. `abc' but also `a"b'). To make things more + ;; interesting, code is represented as strings, so the content of + ;; strings can be later re-lexed to find nested strings. + (save-excursion + (let ((ppss (syntax-ppss pos))) + (cond + ((nth 8 ppss) nil) ;; Within a string or a comment. + ((not (memq (char-before pos) + (cons nil + (eval-when-compile + (mapcar #'identity tcl--word-delimiters))))) + ;; The double quote appears within some other lexical entity. + ;; FIXME: Similar treatment should be used for `{' which can appear + ;; within non-delimited strings (but only at top-level, so + ;; maybe it's not worth worrying about). + (string-to-syntax ".")) + ((zerop (nth 0 ppss)) + ;; Not within a { ... }, so can't be truncated by a }. + ;; FIXME: The syntax-table also considers () and [] as paren + ;; delimiters just like {}, even though Tcl treats them differently. + ;; Tho I'm not sure it's worth worrying about, either. + nil) + (t + ;; A double quote within a {...}: leave it as a normal string + ;; delimiter only if we don't find a closing } before we + ;; find a closing ". + (let ((type nil) + (depth 0)) + (forward-char 1) + (while (and (not type) + (re-search-forward "[\"{}\\]" nil t)) + (pcase (char-after (match-beginning 0)) + (?\\ (forward-char 1)) + (?\" (setq type 'matched)) + (?\{ (cl-incf depth)) + (?\} (if (zerop depth) (setq type 'unmatched) + (cl-incf depth))))) + (when (> (line-beginning-position) pos) + ;; The quote is not on the same line as the deciding + ;; factor, so make sure we revisit this choice later. + (put-text-property pos (point) 'syntax-multiline t)) + (when (eq type 'unmatched) + ;; The quote has no matching close because a } closes the + ;; surrounding string before, so it doesn't really "open a string". + (string-to-syntax ".")))))))) + (defconst tcl-syntax-propertize-function (syntax-propertize-rules ;; Mark the few `#' that are not comment-markers. - ("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) + ((concat "[^" tcl--word-delimiters "][ \t]*\\(#\\)") (1 ".")) + ("\"" (0 (tcl--syntax-of-quote (match-beginning 0))))) "Syntactic keywords for `tcl-mode'.") ;; FIXME need some way to recognize variables because array refs look @@ -593,6 +647,8 @@ already exist." '(tcl-font-lock-keywords nil nil nil beginning-of-defun)) (set (make-local-variable 'syntax-propertize-function) tcl-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) (set (make-local-variable 'imenu-generic-expression) tcl-imenu-generic-expression) @@ -1555,21 +1611,21 @@ The first line is assumed to look like \"#!.../program ...\"." (char-to-string char))) string "")) + + ;; -;; Bug reporting. +;; Obsolete. ;; - -;; These are relics kept "just in case". -(defalias 'tcl-uncomment-region 'uncomment-region) -(defalias 'tcl-indent-for-comment 'comment-indent) -(defalias 'add-log-tcl-defun 'tcl-add-log-defun) -(defalias 'indent-tcl-exp 'tcl-indent-exp) -(defalias 'calculate-tcl-indent 'tcl-calculate-indent) -(defalias 'tcl-beginning-of-defun 'beginning-of-defun) -(defalias 'tcl-end-of-defun 'end-of-defun) -(defalias 'tcl-mark-defun 'mark-defun) -(defun tcl-mark () (mark t)) +(define-obsolete-function-alias 'tcl-uncomment-region #'uncomment-region "28.1") +(define-obsolete-function-alias 'tcl-indent-for-comment #'comment-indent "28.1") +(define-obsolete-function-alias 'add-log-tcl-defun #'tcl-add-log-defun "28.1") +(define-obsolete-function-alias 'indent-tcl-exp #'tcl-indent-exp "28.1") +(define-obsolete-function-alias 'calculate-tcl-indent #'tcl-calculate-indent "28.1") +(define-obsolete-function-alias 'tcl-beginning-of-defun #'beginning-of-defun "28.1") +(define-obsolete-function-alias 'tcl-end-of-defun #'end-of-defun "28.1") +(define-obsolete-function-alias 'tcl-mark-defun #'mark-defun "28.1") +(defun tcl-mark () (declare (obsolete nil "28.1")) (mark t)) (provide 'tcl) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 5a469bb9677..b1abefe534e 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -1284,7 +1284,7 @@ won't merge conflict." (defcustom verilog-auto-inst-template-required nil "If non-nil, when creating a port with AUTOINST, require a template. -Any port which does not have a template will be ommitted from the +Any port which does not have a template will be omitted from the instantiation. If nil, if a port is not templated it will be inserted to connect diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index de2053c3c99..a1c4c08c263 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1325,7 +1325,7 @@ FILES must be a list of absolute file names." ;; call-process-region *is* measurably faster, even for a program ;; doing some actual work (for a period of time). Even though ;; call-process-region also creates a temp file internally - ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). + ;; (https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). (if (not (file-remote-p default-directory)) (apply #'call-process-region start end program nil buffer display args) diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 65e8011f771..571e1a68c5e 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -5,7 +5,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Kenichi Handa <handa@gnu.org> (multi-byte characters) ;; Keywords: wp, print, PostScript -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; Package: ps-print ;; This file is part of GNU Emacs. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 67ee4d24390..351c489f487 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -9,7 +9,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, print, PostScript ;; Version: 7.3.5 -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre (eval-when-compile (require 'cl-lib)) @@ -2198,7 +2198,7 @@ The values for `ps-line-number-start': `ps-line-number-step' inclusive. * If `ps-line-number-step' is set to `zebra', must be between 1 and the - value of `ps-zebra-strip-height' inclusive. Use this combination if you + value of `ps-zebra-stripe-height' inclusive. Use this combination if you wish that line number be relative to zebra stripes." :type '(integer :tag "Start Step Interval") :version "20" diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index 7c688d53fa9..c5dcf494c0b 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -8,7 +8,7 @@ ;; Kenichi Handa <handa@gnu.org> (multi-byte characters) ;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, print, PostScript -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; Package: ps-print ;; This file is part of GNU Emacs. @@ -57,7 +57,7 @@ (interactive) (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) -;; Used in `ps-rmail-print-article-from-summary', +;; Used in `ps-rmail-print-message-from-summary', ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'. (defun ps-print-message-from-summary (summary-buffer summary-default) (let ((ps-buf (or (and (boundp summary-buffer) diff --git a/lisp/recentf.el b/lisp/recentf.el index 877edd4be1f..61c39de12b2 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -245,7 +245,10 @@ The following values can be set: - A number Cleanup each time Emacs has been idle that number of seconds. - A time string - Cleanup at specified time string, for example at \"11:00pm\". + Cleanup at specified time string daily, for example at \"11:00pm\". + +If a time string is provided and it is already past the specified time +for the current day, the first cleanup happens immediately as for `mode'. Setting this variable directly does not take effect; use \\[customize]. @@ -257,7 +260,7 @@ cleanup the list." :value mode) (const :tag "Never" :value never) - (number :tag "When idle that seconds" + (number :tag "When idle after (seconds)" :value 300) (string :tag "At time" :value "11:00pm")) @@ -371,7 +374,8 @@ See also the option `recentf-auto-cleanup'.") recentf-auto-cleanup t 'recentf-cleanup)) ((stringp recentf-auto-cleanup) (run-at-time - recentf-auto-cleanup nil 'recentf-cleanup)))))) + ;; Repeat every 24 hours. + recentf-auto-cleanup (* 24 60 60) 'recentf-cleanup)))))) ;;; File functions ;; diff --git a/lisp/repeat.el b/lisp/repeat.el index f275db6fddf..1dabd76e071 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -85,10 +85,6 @@ ;; C-x { shrink-window-horizontally ;; C-x } enlarge-window-horizontally -;; This command was first called `vi-dot', because -;; it was inspired by the `.' command in the vi editor, -;; but it was renamed to make its name more meaningful. - ;;; Code: ;;;;; ************************* USER OPTIONS ************************** ;;;;; diff --git a/lisp/replace.el b/lisp/replace.el index a751822c79a..3a2ab1d24c8 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -126,6 +126,18 @@ This variable affects only `query-replace-regexp'." :type 'boolean :group 'matching) +(defcustom query-replace-highlight-submatches t + "Whether to highlight regexp subexpressions during query replacement. +The faces used to do the highlights are named `isearch-group-1', +`isearch-group-2', etc. (By default, only these 2 are defined.) +When there are more matches than faces, then faces are reused from the +beginning, in a cyclical manner, so the `isearch-group-1' face is +isreused for the third match. If you want to use more distinctive colors, +you can define more of these faces using the same numbering scheme." + :type 'boolean + :group 'matching + :version "28.1") + (defcustom query-replace-lazy-highlight t "Controls the lazy-highlighting during query replacements. When non-nil, all text in the buffer matching the current match @@ -894,7 +906,8 @@ and `search-upper-case' is non-nil, the matching is case-sensitive. Second and third arg RSTART and REND specify the region to operate on. This command operates on (the accessible part of) all lines whose accessible part is entirely contained in the region determined by RSTART -and REND. (A newline ending a line counts as part of that line.) +and REND. (A newline ending a line counts as part of that line.) If RSTART +is non-nil, REND also has to be given. Interactively, in Transient Mark mode when the mark is active, operate on all lines whose accessible part is entirely contained in the region. @@ -1572,6 +1585,19 @@ is not modified." (defvar ido-ignore-item-temp-list) +(defun multi-occur--prompt () + (concat + "Next buffer to search " + (cond + ((or (eq read-buffer-function #'ido-read-buffer) + (bound-and-true-p ido-everywhere)) + (substitute-command-keys + "(\\<ido-completion-map>\\[ido-select-text] to end): ")) + ((bound-and-true-p fido-mode) + (substitute-command-keys + "(\\<icomplete-fido-mode-map>\\[icomplete-fido-exit] to end): ")) + (t "(RET to end): ")))) + (defun multi-occur (bufs regexp &optional nlines) "Show all lines in buffers BUFS containing a match for REGEXP. Optional argument NLINES specifies the number of context lines to show @@ -1587,11 +1613,7 @@ See also `multi-occur-in-matching-buffers'." (buf nil) (ido-ignore-item-temp-list bufs)) (while (not (string-equal - (setq buf (read-buffer - (if (eq read-buffer-function #'ido-read-buffer) - "Next buffer to search (C-j to end): " - "Next buffer to search (RET to end): ") - nil t)) + (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) (cl-pushnew buf bufs) (setq ido-ignore-item-temp-list bufs)) @@ -1674,7 +1696,7 @@ See also `multi-occur'." (with-current-buffer occur-buf ;; Make the default-directory of the *Occur* buffer match that of - ;; the buffer where the occurences come from + ;; the buffer where the occurrences come from (setq default-directory source-buffer-default-directory) (if (stringp nlines) (fundamental-mode) ;; This is for collect operation. @@ -2394,6 +2416,7 @@ It is called with three arguments, as if it were (funcall search-function search-string limit t))) (defvar replace-overlay nil) +(defvar replace-submatches-overlays nil) (defun replace-highlight (match-beg match-end range-beg range-end search-string regexp-flag delimited-flag @@ -2404,6 +2427,25 @@ It is called with three arguments, as if it were (setq replace-overlay (make-overlay match-beg match-end)) (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays (overlay-put replace-overlay 'face 'query-replace))) + + (when (and query-replace-highlight-submatches + regexp-flag) + (mapc 'delete-overlay replace-submatches-overlays) + (setq replace-submatches-overlays nil) + (let ((submatch-data (cddr (butlast (match-data t)))) + (group 0) + ov face) + (while submatch-data + (setq group (1+ group)) + (setq ov (make-overlay (pop submatch-data) (pop submatch-data)) + face (intern-soft (format "isearch-group-%d" group))) + ;; Recycle faces from beginning. + (unless (facep face) + (setq group 1 face 'isearch-group-1)) + (overlay-put ov 'face face) + (overlay-put ov 'priority 1002) + (push ov replace-submatches-overlays)))) + (if query-replace-lazy-highlight (let ((isearch-string search-string) (isearch-regexp regexp-flag) @@ -2424,6 +2466,9 @@ It is called with three arguments, as if it were (defun replace-dehighlight () (when replace-overlay (delete-overlay replace-overlay)) + (when query-replace-highlight-submatches + (mapc 'delete-overlay replace-submatches-overlays) + (setq replace-submatches-overlays nil)) (when query-replace-lazy-highlight (lazy-highlight-cleanup lazy-highlight-cleanup) (setq isearch-lazy-highlight-last-string nil)) @@ -2953,6 +2998,8 @@ characters." (replace-dehighlight) (save-excursion (recursive-edit)) (setq replaced t)) + ((commandp def t) + (call-interactively def)) ;; Note: we do not need to treat `exit-prefix' ;; specially here, since we reread ;; any unrecognized character. diff --git a/lisp/reposition.el b/lisp/reposition.el index 4788e6ee81e..7561cc4c5f3 100644 --- a/lisp/reposition.el +++ b/lisp/reposition.el @@ -1,4 +1,4 @@ -;;; reposition.el --- center a Lisp function or comment on the screen +;;; reposition.el --- center a Lisp function or comment on the screen -*- lexical-binding: t -*- ;; Copyright (C) 1991, 1994, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/reveal.el b/lisp/reveal.el index 92b80071f71..f9e38646349 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -60,6 +60,13 @@ :type 'boolean :group 'reveal) +(defcustom reveal-auto-hide t + "Automatically hide revealed text when leaving it. +If nil, the `reveal-hide-revealed' command can be useful to hide +revealed text manually." + :type 'boolean + :version "28.1") + (defvar reveal-open-spots nil "List of spots in the buffer which are open. Each element has the form (WINDOW . OVERLAY).") @@ -97,7 +104,8 @@ Each element has the form (WINDOW . OVERLAY).") (cdr x)))) reveal-open-spots)))) (setq old-ols (reveal-open-new-overlays old-ols)) - (reveal-close-old-overlays old-ols))))) + (when reveal-auto-hide + (reveal-close-old-overlays old-ols)))))) (defun reveal-open-new-overlays (old-ols) (let ((repeat t)) @@ -196,6 +204,14 @@ Each element has the form (WINDOW . OVERLAY).") (delq (rassoc ol reveal-open-spots) reveal-open-spots))))))) +(defun reveal-hide-revealed () + "Hide all revealed text. +If there is revealed text under point, this command does not hide +that text." + (interactive) + (let ((reveal-auto-hide t)) + (reveal-post-command))) + (defvar reveal-mode-map (let ((map (make-sparse-keymap))) ;; Override the default move-beginning-of-line and move-end-of-line @@ -209,7 +225,9 @@ Each element has the form (WINDOW . OVERLAY).") "Toggle uncloaking of invisible text near point (Reveal mode). Reveal mode is a buffer-local minor mode. When enabled, it -reveals invisible text around point." +reveals invisible text around point. + +Also see the `reveal-auto-hide' variable." :group 'reveal :lighter (global-reveal-mode nil " Reveal") :keymap reveal-mode-map diff --git a/lisp/savehist.el b/lisp/savehist.el index 4e52efe7f1a..5d20239d17f 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -5,7 +5,7 @@ ;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com> ;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience, minibuffer -;; Version: 24 +;; Old-Version: 24 ;; This file is part of GNU Emacs. diff --git a/lisp/server.el b/lisp/server.el index 9934e1c1be9..a660deab8e8 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -728,7 +728,8 @@ If server is running, it is first stopped. NAME defaults to `server-name'. With argument, ask for NAME." (interactive (list (if current-prefix-arg - (read-string "Server name: " nil nil server-name)))) + (read-string (format-prompt "Server name" server-name) + nil nil server-name)))) (when server-mode (with-temp-message nil (server-mode -1))) (let ((file (expand-file-name (or name server-name) (if server-use-tcp @@ -1337,7 +1338,13 @@ The following commands are accepted by the client: "When done with this frame, type \\[delete-frame]"))) ((not (null buffers)) (run-hooks 'server-after-make-frame-hook) - (server-switch-buffer (car buffers) nil (cdr (car files))) + (server-switch-buffer + (car buffers) nil (cdr (car files)) + ;; When triggered from "emacsclient -c", we popped up a + ;; new frame. Ensure that we switch to the requested + ;; buffer in that frame, and not in some other frame + ;; where it may be displayed. + (plist-get (process-plist proc) 'frame)) (run-hooks 'server-switch-hook) (unless nowait (message "%s" (substitute-command-keys @@ -1567,7 +1574,8 @@ starts server process and that is all. Invoked by \\[server-edit]." (server-clients (apply #'server-switch-buffer (server-done))) (t (message "No server editing buffers exist")))) -(defun server-switch-buffer (&optional next-buffer killed-one filepos) +(defun server-switch-buffer (&optional next-buffer killed-one filepos + this-frame-only) "Switch to another buffer, preferably one that has a client. Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it. @@ -1601,7 +1609,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." ;; OK, we know next-buffer is live, let's display and select it. (if (functionp server-window) (funcall server-window next-buffer) - (let ((win (get-buffer-window next-buffer 0))) + (let ((win (get-buffer-window next-buffer + (if this-frame-only nil 0)))) (if (and win (not server-window)) ;; The buffer is already displayed: just reuse the ;; window. If FILEPOS is non-nil, use it to replace the @@ -1619,7 +1628,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." (setq server-window (make-frame))) (select-window (frame-selected-window server-window)))) (when (window-minibuffer-p) - (select-window (next-window nil 'nomini 0))) + (select-window (next-window nil 'nomini + (if this-frame-only nil 0)))) ;; Move to a non-dedicated window, if we have one. (when (window-dedicated-p) (select-window diff --git a/lisp/ses.el b/lisp/ses.el index 5707067e765..bfafc132bf5 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -378,7 +378,7 @@ area of a spreadsheet.") ;; "Side-effect variables". They are set in one function, altered in ;; another as a side effect, then read back by the first, as a way of ;; passing back more than one value. These declarations are just to make -;; the compiler happy, and to conform to standard Emacs-Lisp practice (I +;; the compiler happy, and to conform to standard Emacs Lisp practice (I ;; think the make-local-variable trick above is cleaner). ;; @@ -395,7 +395,7 @@ left-justification of the result. Set to error-signal if `ses-call-printer' encountered an error during printing. Otherwise nil.") (defvar ses-start-time nil - "Time when current operation started. Used by `ses-time-check' to decide + "Time when current operation started. Used by `ses--time-check' to decide when to emit a progress message.") @@ -3672,7 +3672,7 @@ highlighted range in the spreadsheet." ;; 'rowcol' corresponding to 'ses-cell' property of symbol ;; 'sym'. Both must be the same. (unless (eq sym old-name) - (error "Spreadsheet is broken, both symbols %S and %S refering to cell (%d,%d)" sym old-name row col)) + (error "Spreadsheet is broken, both symbols %S and %S referring to cell (%d,%d)" sym old-name row col)) (if new-rowcol ;; the new name is of A1 type, so we test that the coordinate ;; inferred from new name @@ -3685,7 +3685,7 @@ highlighted range in the spreadsheet." (puthash new-name rowcol ses--named-cell-hashmap)) (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list) (cl-pushnew rowcol ses--deferred-write :test #'equal) - ;; Replace name by new name in formula of cells refering to renamed cell. + ;; Replace name by new name in formula of cells referring to renamed cell. (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) diff --git a/lisp/shell.el b/lisp/shell.el index 9667dab2afd..43ad58774b8 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -334,6 +334,7 @@ Thus, this does not include the shell's current directory.") (define-key map "\t" 'completion-at-point) (define-key map (kbd "M-RET") 'shell-resync-dirs) (define-key map "\M-?" 'comint-dynamic-list-filename-completions) + (define-key map (kbd "C-x n d") 'shell-narrow-to-prompt) (define-key map [menu-bar completion] (cons "Complete" (copy-keymap (lookup-key comint-mode-map [menu-bar completion])))) @@ -460,9 +461,12 @@ Thus, this does not include the shell's current directory.") This is the value of `pcomplete-command-completion-function' for Shell buffers. It implements `shell-completion-execonly' for `pcomplete' completion." - (pcomplete-here (pcomplete-entries nil - (if shell-completion-execonly - 'file-executable-p)))) + (if (pcomplete-match "/") + (pcomplete-here (pcomplete-entries nil + (if shell-completion-execonly + 'file-executable-p))) + (pcomplete-here + (nth 2 (shell--command-completion-data))))) (defun shell-completion-vars () "Setup completion vars for `shell-mode' and `read-shell-command'." @@ -1205,7 +1209,7 @@ Returns t if successful." (cwd (file-name-as-directory (expand-file-name default-directory))) (ignored-extensions (and comint-completion-fignore - (mapconcat (function (lambda (x) (concat (regexp-quote x) "\\'"))) + (mapconcat (lambda (x) (concat (regexp-quote x) "\\'")) comint-completion-fignore "\\|"))) (dir "") (comps-in-dir ()) (file "") (abs-file-name "") (completions ())) @@ -1363,6 +1367,48 @@ Returns t if successful." (let ((f (shell-c-a-p-replace-by-expanded-directory))) (if f (funcall f)))) +(defun shell--prompt-begin-position () + ;; We need this convoluted function because `looking-at-p' does not work on + ;; multiline regexps _and_ `re-search-backward' skips the current line. + (save-excursion + (let ((old-point (point))) + (max + (save-excursion + ;; Right result if not on prompt. + (call-interactively #'comint-previous-prompt) + (re-search-backward comint-prompt-regexp) + (point)) + (save-excursion + ;; Right result if on first char after prompt. + (re-search-backward comint-prompt-regexp) + (point)) + (save-excursion + ;; Right result if on prompt. + (call-interactively #'comint-next-prompt) + (re-search-backward comint-prompt-regexp) + (if (<= (point) old-point) + (point) + (point-min))))))) + +(defun shell--prompt-end-position () + (save-excursion + (goto-char (shell--prompt-begin-position)) + (comint-next-prompt 1) + (point))) + +(defun shell-narrow-to-prompt () + "Narrow buffer to the command line (and any following command output) at point." + (interactive) + (let ((begin (shell--prompt-begin-position))) + (narrow-to-region + begin + (save-excursion + (goto-char (shell--prompt-end-position)) + (call-interactively #'comint-next-prompt) + (if (= begin (shell--prompt-begin-position)) + (point-max) + (shell--prompt-begin-position)))))) + (provide 'shell) ;;; shell.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index 376585d8e82..e96c7c9a6ea 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -118,6 +118,27 @@ If non-nil, the value is passed directly to `recenter'." :group 'next-error :version "23.1") +(defcustom next-error-message-highlight nil + "If non-nil, highlight the current error message in the `next-error' buffer. +If the value is `keep', highlighting is permanent, so all visited error +messages are highlighted; this helps to see what messages were visited." + :type '(choice (const :tag "Highlight the current error" t) + (const :tag "Highlight all visited errors" keep) + (const :tag "No highlighting" nil)) + :group 'next-error + :version "28.1") + +(defface next-error-message + '((t (:inherit highlight :extend t))) + "Face used to highlight the current error message in the `next-error' buffer." + :group 'next-error + :version "28.1") + +(defvar next-error--message-highlight-overlay + nil + "Overlay highlighting the current error message in the `next-error' buffer.") +(make-variable-buffer-local 'next-error--message-highlight-overlay) + (defcustom next-error-hook nil "List of hook functions run by `next-error' after visiting source file." :type 'hook @@ -376,6 +397,7 @@ and TO-BUFFER is a target buffer." (when next-error-recenter (recenter next-error-recenter)) (funcall next-error-found-function from-buffer to-buffer) + (next-error-message-highlight from-buffer) (run-hooks 'next-error-hook)) (defun next-error-select-buffer (buffer) @@ -460,6 +482,20 @@ buffer causes automatic display of the corresponding source code location." (next-error-no-select 0)) (error t)))) +(defun next-error-message-highlight (error-buffer) + "Highlight the current error message in the ‘next-error’ buffer." + (when next-error-message-highlight + (with-current-buffer error-buffer + (when (and next-error--message-highlight-overlay + (not (eq next-error-message-highlight 'keep))) + (delete-overlay next-error--message-highlight-overlay)) + (let ((ol (make-overlay (line-beginning-position) (1+ (line-end-position))))) + ;; do not override region highlighting + (overlay-put ol 'priority -50) + (overlay-put ol 'face 'next-error-message) + (overlay-put ol 'window (get-buffer-window)) + (setf next-error--message-highlight-overlay ol))))) + ;;; @@ -516,7 +552,7 @@ This hook is run by `delete-selection-uses-region-p', which see.") "Propertized string representing a hard newline character.") (defun newline (&optional arg interactive) - "Insert a newline, and move to left margin of the new line if it's blank. + "Insert a newline, and move to left margin of the new line. With prefix argument ARG, insert that many newlines. If `electric-indent-mode' is enabled, this indents the final new line @@ -553,7 +589,7 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." (save-excursion (goto-char beforepos) (beginning-of-line) - (and (looking-at "[ \t]$") + (and (looking-at "[ \t]+$") (> (current-left-margin) 0) (delete-region (point) (line-end-position)))) @@ -1098,7 +1134,11 @@ is supplied, or Transient Mark mode is enabled and the mark is active." ;; If the end of the buffer is not already on the screen, ;; then scroll specially to put it near, but not at, the bottom. (overlay-recenter (point)) - (recenter -3)))) + ;; FIXME: Arguably if `scroll-conservatively' is set, then + ;; we should pass -1 to `recenter'. + (recenter (if (and scroll-minibuffer-conservatively + (window-minibuffer-p)) + -1 -3))))) (defcustom delete-active-region t "Whether single-char deletion commands delete an active region. @@ -1231,7 +1271,43 @@ that uses or sets the mark." "History of values entered with `goto-line'.") (make-variable-buffer-local 'goto-line-history) -(defun goto-line (line &optional buffer) +(defun goto-line-read-args (&optional relative) + "Read arguments for `goto-line' related commands." + (if (and current-prefix-arg (not (consp current-prefix-arg))) + (list (prefix-numeric-value current-prefix-arg)) + ;; Look for a default, a number in the buffer at point. + (let* ((default + (save-excursion + (skip-chars-backward "0-9") + (if (looking-at "[0-9]") + (string-to-number + (buffer-substring-no-properties + (point) + (progn (skip-chars-forward "0-9") + (point))))))) + ;; Decide if we're switching buffers. + (buffer + (if (consp current-prefix-arg) + (other-buffer (current-buffer) t))) + (buffer-prompt + (if buffer + (concat " in " (buffer-name buffer)) + ""))) + ;; Read the argument, offering that number (if any) as default. + (list (read-number (format "Goto%s line%s: " + (if (buffer-narrowed-p) + (if relative " relative" " absolute") + "") + buffer-prompt) + (list default (if (or relative (not (buffer-narrowed-p))) + (line-number-at-pos) + (save-restriction + (widen) + (line-number-at-pos)))) + 'goto-line-history) + buffer)))) + +(defun goto-line (line &optional buffer relative) "Go to LINE, counting from line 1 at beginning of buffer. If called interactively, a numeric prefix argument specifies LINE; without a numeric prefix argument, read LINE from the @@ -1241,6 +1317,13 @@ If optional argument BUFFER is non-nil, switch to that buffer and move to line LINE there. If called interactively with \\[universal-argument] as argument, BUFFER is the most recently selected other buffer. +If optional argument RELATIVE is non-nil, counting starts at the beginning +of the accessible portion of the (potentially narrowed) buffer. + +If the variable `widen-automatically' is non-nil, cancel narrowing and +leave all lines accessible. If `widen-automatically' is nil, just move +point to the edge of visible portion and don't change the buffer bounds. + Prior to moving point, this function sets the mark (without activating it), unless Transient Mark mode is enabled and the mark is already active. @@ -1252,32 +1335,7 @@ What you probably want instead is something like: If at all possible, an even better solution is to use char counts rather than line counts." (declare (interactive-only forward-line)) - (interactive - (if (and current-prefix-arg (not (consp current-prefix-arg))) - (list (prefix-numeric-value current-prefix-arg)) - ;; Look for a default, a number in the buffer at point. - (let* ((default - (save-excursion - (skip-chars-backward "0-9") - (if (looking-at "[0-9]") - (string-to-number - (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "0-9") - (point))))))) - ;; Decide if we're switching buffers. - (buffer - (if (consp current-prefix-arg) - (other-buffer (current-buffer) t))) - (buffer-prompt - (if buffer - (concat " in " (buffer-name buffer)) - ""))) - ;; Read the argument, offering that number (if any) as default. - (list (read-number (format "Goto line%s: " buffer-prompt) - (list default (line-number-at-pos)) - 'goto-line-history) - buffer)))) + (interactive (goto-line-read-args)) ;; Switch to the desired buffer, one way or another. (if buffer (let ((window (get-buffer-window buffer))) @@ -1286,12 +1344,29 @@ rather than line counts." ;; Leave mark at previous position (or (region-active-p) (push-mark)) ;; Move to the specified line number in that buffer. - (save-restriction - (widen) - (goto-char (point-min)) - (if (eq selective-display t) - (re-search-forward "[\n\C-m]" nil 'end (1- line)) - (forward-line (1- line))))) + (let ((pos (save-restriction + (unless relative (widen)) + (goto-char (point-min)) + (if (eq selective-display t) + (re-search-forward "[\n\C-m]" nil 'end (1- line)) + (forward-line (1- line))) + (point)))) + (when (and (not relative) + (buffer-narrowed-p) + widen-automatically + ;; Position is outside narrowed part of buffer + (or (> (point-min) pos) (> pos (point-max)))) + (widen)) + (goto-char pos))) + +(defun goto-line-relative (line &optional buffer) + "Go to LINE, counting from line at (point-min). +The line number is relative to the accessible portion of the narrowed +buffer. The argument BUFFER is the same as in the function `goto-line'." + (declare (interactive-only forward-line)) + (interactive (goto-line-read-args t)) + (with-suppressed-warnings ((interactive-only goto-line)) + (goto-line line buffer t))) (defun count-words-region (start end &optional arg) "Count the number of words in the region. @@ -1500,7 +1575,11 @@ in *Help* buffer. See also the command `describe-char'." encoded encoding-msg display-prop under-display) (if (or (not coding) (eq (coding-system-type coding) t)) - (setq coding (default-value 'buffer-file-coding-system))) + (setq coding (or (default-value 'buffer-file-coding-system) + ;; A nil value of `buffer-file-coding-system' + ;; means "no conversion" which means each byte + ;; is a char and vice versa. + 'binary))) (if (eq (char-charset char) 'eight-bit) (setq encoding-msg (format "(%d, #o%o, #x%x%s, raw-byte)" char char char char-name-fmt)) @@ -1881,22 +1960,20 @@ to get different commands to edit and resubmit." '(metadata (annotation-function . read-extended-command--annotation) (category . command)) - (let ((pred - (if (memq action '(nil t)) - ;; Exclude obsolete commands from completions. - (lambda (sym) - (and (funcall pred sym) - (or (equal string (symbol-name sym)) - (not (get sym 'byte-obsolete-info))))) - pred))) - (complete-with-action action obarray string pred)))) + (complete-with-action action obarray string pred))) #'commandp t nil 'extended-command-history))) (defun read-extended-command--annotation (command-name) - (let* ((function (and (stringp command-name) (intern-soft command-name))) - (binding (where-is-internal function overriding-local-map t))) - (when (and binding (not (stringp binding))) - (format " (%s)" (key-description binding))))) + (let* ((fun (and (stringp command-name) (intern-soft command-name))) + (binding (where-is-internal fun overriding-local-map t)) + (obsolete (get fun 'byte-obsolete-info)) + (alias (symbol-function fun))) + (cond ((symbolp alias) + (format " (%s)" alias)) + (obsolete + (format " (%s)" (car obsolete))) + ((and binding (not (stringp binding))) + (format " (%s)" (key-description binding)))))) (defcustom suggest-key-bindings t "Non-nil means show the equivalent key-binding when M-x command has one. @@ -2032,13 +2109,18 @@ invoking, give a prefix argument to `execute-extended-command'." ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. CMD must be a symbol that satisfies the `commandp' predicate. -Optional second arg RECORD-FLAG non-nil -means unconditionally put this command in the variable `command-history'. -Otherwise, that is done only if an arg is read using the minibuffer. -The argument KEYS specifies the value to use instead of (this-command-keys) -when reading the arguments; if it is nil, (this-command-keys) is used. -The argument SPECIAL, if non-nil, means that this command is executing -a special event, so ignore the prefix argument and don't clear it." + +Optional second arg RECORD-FLAG non-nil means unconditionally put +this command in the variable `command-history'. Otherwise, that +is done only if an arg is read using the minibuffer. + +The argument KEYS specifies the value to use instead of the +return value of the `this-command-keys' function when reading the +arguments; if it is nil, `this-command-keys' is used. + +The argument SPECIAL, if non-nil, means that this command is +executing a special event, so ignore the prefix argument and +don't clear it." (setq debug-on-next-call nil) (let ((prefixarg (unless special ;; FIXME: This should probably be done around @@ -2752,11 +2834,12 @@ Contrary to `undo', this will not redo a previous undo." (let ((undo-no-redo t)) (undo arg))) (defun undo-redo (&optional arg) - "Undo the last ARG undos." + "Undo the last ARG undos, i.e., redo the last ARG changes. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive "*p") (cond ((not (undo--last-change-was-undo-p buffer-undo-list)) - (user-error "No undo to undo")) + (user-error "No undone changes to redo")) (t (let* ((ul buffer-undo-list) (new-ul @@ -4372,7 +4455,7 @@ Also, delete any process that is exited or signaled." ((thread-name (process-thread p))) (t "--"))) (cmd - (if (memq type '(network serial)) + (if (memq type '(network serial pipe)) (let ((contact (process-contact p t t))) (if (eq type 'network) (format "(%s %s)" @@ -7239,15 +7322,16 @@ Mode' for details." :lighter " Wrap" (if visual-line-mode (progn - (set (make-local-variable 'visual-line--saved-state) nil) - ;; Save the local values of some variables, to be restored if - ;; visual-line-mode is turned off. - (dolist (var '(line-move-visual truncate-lines - truncate-partial-width-windows - word-wrap fringe-indicator-alist)) - (if (local-variable-p var) - (push (cons var (symbol-value var)) - visual-line--saved-state))) + (unless visual-line--saved-state + (setq-local visual-line--saved-state (list nil)) + ;; Save the local values of some variables, to be restored if + ;; visual-line-mode is turned off. + (dolist (var '(line-move-visual truncate-lines + truncate-partial-width-windows + word-wrap fringe-indicator-alist)) + (if (local-variable-p var) + (push (cons var (symbol-value var)) + visual-line--saved-state)))) (set (make-local-variable 'line-move-visual) t) (set (make-local-variable 'truncate-partial-width-windows) nil) (setq truncate-lines nil @@ -7261,7 +7345,8 @@ Mode' for details." (kill-local-variable 'truncate-partial-width-windows) (kill-local-variable 'fringe-indicator-alist) (dolist (saved visual-line--saved-state) - (set (make-local-variable (car saved)) (cdr saved))) + (when (car saved) + (set (make-local-variable (car saved)) (cdr saved)))) (kill-local-variable 'visual-line--saved-state))) (defun turn-on-visual-line-mode () @@ -7806,11 +7891,17 @@ a specialization of overwrite mode, entered by setting the Line numbers do not appear for very large buffers and buffers with very long lines; see variables `line-number-display-limit' -and `line-number-display-limit-width'." +and `line-number-display-limit-width'. + +See `mode-line-position-line-format' for how this number is +presented." :init-value t :global t :group 'mode-line) (define-minor-mode column-number-mode - "Toggle column number display in the mode line (Column Number mode)." + "Toggle column number display in the mode line (Column Number mode). + +See `mode-line-position-column-format' for how this number is +presented." :global t :group 'mode-line) (define-minor-mode size-indication-mode @@ -7929,6 +8020,7 @@ The function should return non-nil if the two tokens do not match.") (blinkpos (save-excursion (save-restriction + (syntax-propertize (point)) (if blink-matching-paren-distance (narrow-to-region (max (minibuffer-prompt-end) ;(point-min) unless minibuf. @@ -7939,7 +8031,6 @@ The function should return non-nil if the two tokens do not match.") (not blink-matching-paren-dont-ignore-comments)))) (condition-case () (progn - (syntax-propertize (point)) (forward-sexp -1) ;; backward-sexp skips backward over prefix chars, ;; so move back to the matching paren. diff --git a/lisp/skeleton.el b/lisp/skeleton.el index ea4e5dbc227..6e2c10d9711 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -339,7 +339,8 @@ automatically, and you are prompted to fill in the variable parts."))) (dlet ((str (or str `(setq str (skeleton-read ',(car skeleton-il) - nil ,recursive))))) + nil ,recursive)))) + resume:) (when (and (eq (cadr skeleton-il) '\n) (not recursive) (save-excursion (skip-chars-backward " \t") (bolp))) (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) diff --git a/lisp/so-long.el b/lisp/so-long.el index f8a5cc920d9..6ae8d0aec8a 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -833,7 +833,7 @@ available in Emacs versions < 27). For more information refer to info node `(emacs) Bidirectional Editing' and info node `(elisp) Bidirectional Display'. Buffers are made read-only by default to prevent potentially-slow editing from -occurring inadvertantly, as buffers with excessively long lines are likely not +occurring inadvertently, as buffers with excessively long lines are likely not intended to be edited manually." :type '(alist :key-type (variable :tag "Variable") :value-type (sexp :tag "Value")) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index aab6a3a1283..991c8a33d46 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -899,12 +899,9 @@ This basically creates a sparse keymap, and makes its parent be "Additional menu items while in file-mode.") (defvar speedbar-easymenu-definition-trailer - (append - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - (list ["Customize..." speedbar-customize t])) - (list + '(["Customize..." speedbar-customize t] ["Close" dframe-close-frame t] - ["Quit" delete-frame t] )) + ["Quit" delete-frame t]) "Menu items appearing at the end of the speedbar menu.") (defvar speedbar-desired-buffer nil @@ -1392,7 +1389,7 @@ Argument ARG represents to force a refresh past any caches that may exist." (if (and (file-exists-p f) (string-match "\\.el\\'" f)) (progn (dframe-select-attached-frame speedbar-frame) - (byte-compile-file f nil) + (byte-compile-file f) (select-frame sf) (speedbar-reset-scanners))) )) diff --git a/lisp/startup.el b/lisp/startup.el index 9f6b0601772..b6793e0b776 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1505,7 +1505,7 @@ Consider using a subdirectory instead, e.g.: %s" (defun x-apply-session-resources () "Apply X resources which specify initial values for Emacs variables. This is called from a window-system initialization function, such -as `x-initialize-window-system' for X, either at startup (prior +as `window-system-initialization' for X, either at startup (prior to reading the init file), or afterwards when the user first opens a graphical frame. diff --git a/lisp/strokes.el b/lisp/strokes.el index 08a381801d7..c2f03cac0f1 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -102,7 +102,7 @@ ;; The default value (9) should be fine for most decent computers. ;; NOTE: This variable should not be set to a number less than 3. -;; `strokes-display-strokes-buffer' will allow you to hide the strokes +;; `strokes-use-strokes-buffer' will allow you to hide the strokes ;; buffer when doing simple strokes. This is a speedup for slow ;; computers as well as people who don't want to see their strokes. @@ -581,7 +581,7 @@ The grid is a square whose dimension is [0,GRID-RESOLUTION)." (defun strokes-fill-stroke (unfilled-stroke &optional force) "Fill in missing grid locations in the list of UNFILLED-STROKE. -If FORCE is non-nil, then fill the stroke even if it's `stroke-click'. +If FORCE is non-nil, then fill the stroke even if it's `strokes-click-p'. NOTE: This is where the global variable `strokes-last-stroke' is set." (setq strokes-last-stroke ; this is global (if (and (strokes-click-p unfilled-stroke) @@ -1629,7 +1629,7 @@ Optional FORCE non-nil will ignore the buffer's read-only status." ;; The comment below is what I'd have to do if I wanted to ;; deal with random newlines in the midst of the compressed ;; strings. If I do this, I'll also have to change - ;; `strokes-xpm-to-compress-string' to deal with the newline, + ;; `strokes-xpm-to-compressed-string' to deal with the newline, ;; and possibly other whitespace stuff. YUCK! ;; (while (re-search-forward "\\+/\\(\\w\\|\\)+/" nil t nil (get-buffer buffer)) (while (with-current-buffer buffer diff --git a/lisp/subr.el b/lisp/subr.el index 08ff38ff8c1..286851dfc83 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -193,9 +193,9 @@ except that PLACE is evaluated only once (after NEWELT)." (list 'setq place (list 'cons newelt place)) (require 'macroexp) - (macroexp-let2 macroexp-copyable-p v newelt + (macroexp-let2 macroexp-copyable-p x newelt (gv-letplace (getter setter) place - (funcall setter `(cons ,v ,getter)))))) + (funcall setter `(cons ,x ,getter)))))) (defmacro pop (place) "Return the first element of PLACE's value, and remove it from the list. @@ -279,8 +279,11 @@ Then evaluate RESULT to get return value, default nil. (defmacro dotimes (spec &rest body) "Loop a certain number of times. Evaluate BODY with VAR bound to successive integers running from 0, -inclusive, to COUNT, exclusive. Then evaluate RESULT to get -the return value (nil if RESULT is omitted). Its use is deprecated. +inclusive, to COUNT, exclusive. + +Finally RESULT is evaluated to get the return value (nil if +RESULT is omitted). Using RESULT is deprecated, and may result +in compilation warnings about unused variables. \(fn (VAR COUNT [RESULT]) BODY...)" (declare (indent 1) (debug dolist)) @@ -829,10 +832,11 @@ Elements of ALIST that are not conses are ignored." If KEY is not found in ALIST, return DEFAULT. Equality with KEY is tested by TESTFN, defaulting to `eq'. -You can use `alist-get' in PLACE expressions. This will modify -an existing association (more precisely, the first one if -multiple exist), or add a new element to the beginning of ALIST, -destructively modifying the list stored in ALIST. +You can use `alist-get' in \"place expressions\"; i.e., as a +generalized variable. Doing this will modify an existing +association (more precisely, the first one if multiple exist), or +add a new element to the beginning of ALIST, destructively +modifying the list stored in ALIST. Example: @@ -882,10 +886,6 @@ side-effects, and the argument LIST is not modified." ;;;; Keymap support. -;; Declare before first use of `save-match-data', -;; where it is used internally. -(defvar save-match-data-internal) - (defun kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such @@ -896,7 +896,7 @@ This is the same format used for saving keyboard macros (see For an approximate inverse of this, see `key-description'." ;; Don't use a defalias, since the `pure' property is true only for ;; the calling convention of `kbd'. - (declare (pure t)) + (declare (pure t) (side-effect-free t)) ;; A pure function is expected to preserve the match data. (save-match-data (read-kbd-macro keys))) @@ -1363,7 +1363,8 @@ EVENT is nil, the value of `posn-at-point' is used instead. The following accessor functions are used to access the elements of the position: -`posn-window': The window the event is in. +`posn-window': The window of the event end, or its frame if the +event end point belongs to no window. `posn-area': A symbol identifying the area the event occurred in, or nil if the event occurred in the text area. `posn-point': The buffer position of the event. @@ -1419,8 +1420,9 @@ than a window, return nil." (defsubst posn-window (position) "Return the window in POSITION. -POSITION should be a list of the form returned by the `event-start' -and `event-end' functions." +If POSITION is outside the frame where the event was initiated, +return that frame instead. POSITION should be a list of the form +returned by the `event-start' and `event-end' functions." (nth 0 position)) (defsubst posn-area (position) @@ -1447,9 +1449,14 @@ a click on a scroll bar)." (defun posn-set-point (position) "Move point to POSITION. Select the corresponding window as well." - (if (not (windowp (posn-window position))) + (if (framep (posn-window position)) + (progn + (unless (windowp (frame-selected-window (posn-window position))) + (error "Position not in text area of window")) + (select-window (frame-selected-window (posn-window position)))) + (unless (windowp (posn-window position)) (error "Position not in text area of window")) - (select-window (posn-window position)) + (select-window (posn-window position))) (if (numberp (posn-point position)) (goto-char (posn-point position)))) @@ -1619,8 +1626,8 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete-variable 'x-gtk-use-window-move nil "26.1") (defvaralias 'messages-buffer-max-lines 'message-log-max) -(define-obsolete-variable-alias 'inhibit-null-byte-detection - 'inhibit-nul-byte-detection "27.1") +(define-obsolete-variable-alias 'inhibit-nul-byte-detection + 'inhibit-null-byte-detection "28.1") (make-obsolete-variable 'load-dangerous-libraries "no longer used." "27.1") @@ -1823,6 +1830,7 @@ FUN is then called once." (defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body) "Like (with-wrapper-hook HOOK ARGS BODY), but without warnings." + (declare (debug (form sexp body))) ;; We need those two gensyms because CL's lexical scoping is not available ;; for function arguments :-( (let ((funs (make-symbol "funs")) @@ -2343,13 +2351,19 @@ use `start-file-process'." (if program (list :command (cons program program-args)))))) -(defun process-lines (program &rest args) +(defun process-lines-handling-status (program status-handler &rest args) "Execute PROGRAM with ARGS, returning its output as a list of lines. -Signal an error if the program returns with a non-zero exit status." +If STATUS-HANDLER is non-NIL, it must be a function with one +argument, which will be called with the exit status of the +program before the output is collected. If STATUS-HANDLER is +NIL, an error is signalled if the program returns with a non-zero +exit status." (with-temp-buffer (let ((status (apply 'call-process program nil (current-buffer) nil args))) - (unless (eq status 0) - (error "%s exited with status %s" program status)) + (if status-handler + (funcall status-handler status) + (unless (eq status 0) + (error "%s exited with status %s" program status))) (goto-char (point-min)) (let (lines) (while (not (eobp)) @@ -2360,6 +2374,18 @@ Signal an error if the program returns with a non-zero exit status." (forward-line 1)) (nreverse lines))))) +(defun process-lines (program &rest args) + "Execute PROGRAM with ARGS, returning its output as a list of lines. +Signal an error if the program returns with a non-zero exit status. +Also see `process-lines-ignore-status'." + (apply #'process-lines-handling-status program nil args)) + +(defun process-lines-ignore-status (program &rest args) + "Execute PROGRAM with ARGS, returning its output as a list of lines. +The exit status of the program is ignored. +Also see `process-lines'." + (apply #'process-lines-handling-status program #'identity args)) + (defun process-live-p (process) "Return non-nil if PROCESS is alive. A process is considered alive if its status is `run', `open', @@ -2592,7 +2618,15 @@ keyboard-quit events while waiting for a valid input." (unless (get-text-property 0 'face prompt) (setq prompt (propertize prompt 'face 'minibuffer-prompt))) (setq char (let ((inhibit-quit inhibit-keyboard-quit)) - (read-key prompt))) + (read-char-from-minibuffer + prompt + ;; If we have a dynamically bound `help-form' + ;; here, then the `C-h' (i.e., `help-char') + ;; character should output that instead of + ;; being a command char. + (if help-form + (cons help-char chars) + chars)))) (and show-help (buffer-live-p (get-buffer helpbuf)) (kill-buffer helpbuf)) (cond @@ -3229,7 +3263,7 @@ See Info node `(elisp)Security Considerations'." ;; First, quote argument so that CommandLineToArgvW will ;; understand it. See - ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx + ;; https://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx ;; After we perform that level of quoting, escape shell ;; metacharacters so that cmd won't mangle our argument. If the ;; argument contains no double quote characters, we can just @@ -4410,6 +4444,27 @@ Unless optional argument INPLACE is non-nil, return a new string." (aset newstr i tochar))) newstr)) +(defun string-replace (fromstring tostring instring) + "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs." + (declare (pure t) (side-effect-free t)) + (when (equal fromstring "") + (signal 'wrong-length-argument fromstring)) + (let ((start 0) + (result nil) + pos) + (while (setq pos (string-search fromstring instring start)) + (unless (= start pos) + (push (substring instring start pos) result)) + (push tostring result) + (setq start (+ pos (length fromstring)))) + (if (null result) + ;; No replacements were done, so just return the original string. + instring + ;; Get any remaining bit. + (unless (= start (length instring)) + (push (substring instring start) result)) + (apply #'concat (nreverse result))))) + (defun replace-regexp-in-string (regexp rep string &optional fixedcase literal subexp start) "Replace all matches for REGEXP with REP in STRING. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index cee88cb4275..26049552242 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -363,22 +363,18 @@ to `tab-bar-tab-name-truncated'." :group 'tab-bar :version "27.1") -(defvar tab-bar-tab-name-ellipsis nil) +(defvar tab-bar-tab-name-ellipsis t) (defun tab-bar-tab-name-truncated () "Generate tab name from the buffer of the selected window. Truncate it to the length specified by `tab-bar-tab-name-truncated-max'. Append ellipsis `tab-bar-tab-name-ellipsis' in this case." - (let ((tab-name (buffer-name (window-buffer (minibuffer-selected-window)))) - (ellipsis (cond - (tab-bar-tab-name-ellipsis) - ((char-displayable-p ?…) "…") - ("...")))) + (let ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))) (if (< (length tab-name) tab-bar-tab-name-truncated-max) tab-name (propertize (truncate-string-to-width tab-name tab-bar-tab-name-truncated-max nil nil - ellipsis) + tab-bar-tab-name-ellipsis) 'help-echo tab-name)))) @@ -665,7 +661,8 @@ to get the name of the last visited tab, the second last, and so on." (let* ((recent-tabs (mapcar (lambda (tab) (alist-get 'name tab)) (tab-bar--tabs-recent)))) - (list (completing-read "Switch to tab by name (default recent): " + (list (completing-read (format-prompt "Switch to tab by name" + (car recent-tabs)) recent-tabs nil nil nil nil recent-tabs)))) (tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0)))) @@ -800,7 +797,6 @@ After the tab is created, the hooks in (nth to-index tabs))) (cond - (tab-bar-mode) ((eq tab-bar-show t) (tab-bar-mode 1)) ((and (natnump tab-bar-show) @@ -1566,6 +1562,20 @@ Like \\[find-file-other-frame] (which see), but creates a new tab." value) (switch-to-buffer-other-tab value)))) +(defun find-file-read-only-other-tab (filename &optional wildcards) + "Edit file FILENAME, in another tab, but don't allow changes. +Like \\[find-file-other-frame] (which see), but creates a new tab. + +Like \\[find-file-other-tab], but marks buffer as read-only. +Use \\[read-only-mode] to permit editing." + (interactive + (find-file-read-args "Find file read-only in other tab: " + (confirm-nonexistent-file-or-buffer))) + (find-file--read-only (lambda (filename wildcards) + (window-buffer + (find-file-other-tab filename wildcards))) + filename wildcards)) + (defun other-tab-prefix () "Display the buffer of the next command in a new tab. The next buffer is the buffer displayed by the next command invoked @@ -1595,6 +1605,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (define-key tab-prefix-map "b" 'switch-to-buffer-other-tab) (define-key tab-prefix-map "f" 'find-file-other-tab) (define-key tab-prefix-map "\C-f" 'find-file-other-tab) +(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab) (define-key tab-prefix-map "t" 'other-tab-prefix) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index e8c4dc4d93c..46bf89f14eb 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -240,8 +240,7 @@ to `tab-line-tab-name-truncated-buffer'." :group 'tab-line :version "27.1") -(defvar tab-line-tab-name-ellipsis - (if (char-displayable-p ?…) "…" "...")) +(defvar tab-line-tab-name-ellipsis t) (defun tab-line-tab-name-truncated-buffer (buffer &optional _buffers) "Generate tab name from BUFFER. @@ -642,6 +641,16 @@ using the `previous-buffer' command." (with-selected-window window (switch-to-buffer buffer)))))) +(defcustom tab-line-switch-cycling nil + "Enable cycling tab switch. +If non-nil, `tab-line-switch-to-prev-tab' in the first tab +switches to the last tab and `tab-line-switch-to-next-tab' in the +last tab switches to the first tab. This variable is not consulted +when `tab-line-tabs-function' is `tab-line-tabs-window-buffers'." + :type 'boolean + :group 'tab-line + :version "28.1") + (defun tab-line-switch-to-prev-tab (&optional mouse-event) "Switch to the previous tab. Its effect is the same as using the `previous-buffer' command @@ -652,13 +661,16 @@ Its effect is the same as using the `previous-buffer' command (switch-to-prev-buffer window) (with-selected-window (or window (selected-window)) (let* ((tabs (funcall tab-line-tabs-function)) - (tab (nth (1- (seq-position - tabs (current-buffer) - (lambda (tab buffer) - (if (bufferp tab) - (eq buffer tab) - (eq buffer (cdr (assq 'buffer tab))))))) - tabs)) + (pos (seq-position + tabs (current-buffer) + (lambda (tab buffer) + (if (bufferp tab) + (eq buffer tab) + (eq buffer (cdr (assq 'buffer tab))))))) + (tab (if pos + (if (and tab-line-switch-cycling (<= pos 0)) + (nth (1- (length tabs)) tabs) + (nth (1- pos) tabs)))) (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab))))) (when (bufferp buffer) (switch-to-buffer buffer))))))) @@ -673,13 +685,16 @@ Its effect is the same as using the `next-buffer' command (switch-to-next-buffer window) (with-selected-window (or window (selected-window)) (let* ((tabs (funcall tab-line-tabs-function)) - (tab (nth (1+ (seq-position - tabs (current-buffer) - (lambda (tab buffer) - (if (bufferp tab) - (eq buffer tab) - (eq buffer (cdr (assq 'buffer tab))))))) - tabs)) + (pos (seq-position + tabs (current-buffer) + (lambda (tab buffer) + (if (bufferp tab) + (eq buffer tab) + (eq buffer (cdr (assq 'buffer tab))))))) + (tab (if pos + (if (and tab-line-switch-cycling (<= (length tabs) (1+ pos))) + (car tabs) + (nth (1+ pos) tabs)))) (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab))))) (when (bufferp buffer) (switch-to-buffer buffer))))))) @@ -764,11 +779,15 @@ from the tab line." (global-set-key [tab-line mouse-5] 'tab-line-hscroll-right) (global-set-key [tab-line wheel-up] 'tab-line-hscroll-left) (global-set-key [tab-line wheel-down] 'tab-line-hscroll-right) +(global-set-key [tab-line wheel-left] 'tab-line-hscroll-left) +(global-set-key [tab-line wheel-right] 'tab-line-hscroll-right) (global-set-key [tab-line S-mouse-4] 'tab-line-switch-to-prev-tab) (global-set-key [tab-line S-mouse-5] 'tab-line-switch-to-next-tab) (global-set-key [tab-line S-wheel-up] 'tab-line-switch-to-prev-tab) (global-set-key [tab-line S-wheel-down] 'tab-line-switch-to-next-tab) +(global-set-key [tab-line S-wheel-left] 'tab-line-switch-to-prev-tab) +(global-set-key [tab-line S-wheel-right] 'tab-line-switch-to-next-tab) (provide 'tab-line) diff --git a/lisp/talk.el b/lisp/talk.el index 5541b0a4c69..a18cf263435 100644 --- a/lisp/talk.el +++ b/lisp/talk.el @@ -90,7 +90,7 @@ Each element has the form (DISPLAY FRAME BUFFER).") (let ((frame (nth 1 (car tail))) (this-buffer (nth 2 (car tail))) (buffers - (mapcar (function (lambda (elt) (nth 2 elt))) + (mapcar (lambda (elt) (nth 2 elt)) talk-display-alist))) ;; Put this display's own talk buffer ;; at the front of the list. diff --git a/lisp/tempo.el b/lisp/tempo.el index bc398e7eb67..f6612354b1c 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -75,7 +75,7 @@ ;; ftp.lysator.liu.se in the directory /pub/emacs ;; There is also a WWW page at -;; http://www.lysator.liu.se/~davidk/elisp/ which has some information +;; https://www.lysator.liu.se/~davidk/elisp/ which has some information ;;; Known bugs: @@ -306,8 +306,8 @@ mode, ON-REGION is ignored and assumed true if the region is active." (goto-char tempo-region-start)) (save-excursion (tempo-insert-mark (point-marker)) - (mapc (function (lambda (elt) - (tempo-insert elt on-region))) + (mapc (lambda (elt) + (tempo-insert elt on-region)) (symbol-value template)) (tempo-insert-mark (point-marker))) (tempo-forward-mark)) @@ -449,9 +449,9 @@ never prompted." "Tries all the user-defined element handlers in `tempo-user-elements'." ;; Sigh... I need (some list) (catch 'found - (mapc (function (lambda (handler) - (let ((result (funcall handler element))) - (if result (throw 'found result))))) + (mapc (lambda (handler) + (let ((result (funcall handler element))) + (if result (throw 'found result)))) tempo-user-elements) (throw 'found nil))) @@ -542,7 +542,7 @@ and insert the results." ;;; tempo-forward-mark (defun tempo-forward-mark () - "Jump to the next mark in `tempo-forward-mark-list'." + "Jump to the next mark in `tempo-marks'." (interactive) (let ((next-mark (catch 'found (mapc @@ -560,7 +560,7 @@ and insert the results." ;;; tempo-backward-mark (defun tempo-backward-mark () - "Jump to the previous mark in `tempo-back-mark-list'." + "Jump to the previous mark in `tempo-marks'." (interactive) (let ((prev-mark (catch 'found (let (last) @@ -640,11 +640,11 @@ If `tempo-dirty-collection' is nil, the old collection is reused." tempo-collection) (setq tempo-collection (apply (function append) - (mapcar (function (lambda (tag-list) + (mapcar (lambda (tag-list) ; If the format for ; tempo-local-tags changes, ; change this - (eval (car tag-list)))) + (eval (car tag-list))) tempo-local-tags)))) (setq tempo-dirty-collection nil))) diff --git a/lisp/term.el b/lisp/term.el index f0470d806cd..8cbbfff1b63 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -554,7 +554,7 @@ See also `term-dynamic-complete'. This is a good thing to set in mode hooks.") (defvar term-input-filter - (function (lambda (str) (not (string-match "\\`\\s *\\'" str)))) + (lambda (str) (not (string-match "\\`\\s *\\'" str))) "Predicate for filtering additions to input history. Only inputs answering true to this function are saved on the input history list. Default is to save anything that isn't all whitespace.") @@ -860,6 +860,7 @@ is buffer-local." (define-key map [prior] 'term-send-prior) (define-key map [next] 'term-send-next) (define-key map [xterm-paste] #'term--xterm-paste) + (define-key map [?\C-/] #'term-send-C-_) map) "Keyboard map for sending characters directly to the inferior process.") @@ -1282,6 +1283,7 @@ without any interpretation." (defun term-send-next () (interactive) (term-send-raw-string "\e[6~")) (defun term-send-del () (interactive) (term-send-raw-string "\e[3~")) (defun term-send-backspace () (interactive) (term-send-raw-string "\C-?")) +(defun term-send-C-_ () (interactive) (term-send-raw-string "\C-_")) (defun term-char-mode () "Switch to char (\"raw\") sub-mode of term mode. @@ -2803,7 +2805,7 @@ See `term-prompt-regexp'." ;; References: ;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html -;; [ECMA-48]: http://www.ecma-international.org/publications/standards/Ecma-048.htm +;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm ;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html (defconst term-control-seq-regexp @@ -3638,8 +3640,8 @@ The top-most line is line 0." (message "Terminal-emulator pager break help...") (sit-for 0) (with-electric-help - (function (lambda () - (princ (substitute-command-keys + (lambda () + (princ (substitute-command-keys "\\<term-pager-break-map>\ Terminal-emulator MORE break.\n\ Type one of the following keys:\n\n\ @@ -3657,7 +3659,7 @@ Type one of the following keys:\n\n\ Any other key is passed through to the program running under the terminal emulator and disables pager processing until all pending output has been dealt with.")) - nil)))) + nil))) (defun term-pager-continue (new-count) (let ((process (get-buffer-process (current-buffer)))) diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 674c33b45c1..8ce7fbbcafd 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -1,4 +1,4 @@ -;;; AT386.el --- terminal support package for IBM AT keyboards +;;; AT386.el --- terminal support package for IBM AT keyboards -*- lexical-binding: t -*- ;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/internal.el b/lisp/term/internal.el index 5e22c0f6afe..9a6f4fac1ee 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -1,4 +1,4 @@ -;;; internal.el --- support for PC internal terminal +;;; internal.el --- support for PC internal terminal -*- lexical-binding: t -*- ;; Copyright (C) 1993-1994, 1998-1999, 2001-2020 Free Software ;; Foundation, Inc. @@ -400,9 +400,9 @@ If TABLE is nil or omitted, `standard-display-table' is used." ;; The following alist was compiled from: ;; ;; Ralf Brown's Interrupt List. file INTERRUP.F, D-2138, Table 01400 -;; http://www.ethnologue.com/country_index.asp (official languages) -;; http://unicode.org/onlinedat/languages.html -;; http://unicode.org/onlinedat/countries.html +;; https://www.ethnologue.com/country_index.asp (official languages) +;; https://unicode.org/onlinedat/languages.html +;; https://unicode.org/onlinedat/countries.html ;; ;; Only the official languages listed for each country. ;; diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el index 8a99ddf8c0d..7a92aa7adaa 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -1,4 +1,4 @@ -;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps +;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -*- lexical-binding: t -*- ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el index aab4110b3ae..3bcaa2ecd18 100644 --- a/lisp/term/lk201.el +++ b/lisp/term/lk201.el @@ -1,4 +1,4 @@ -;; Define function key sequences for DEC terminals. +;; Define function key sequences for DEC terminals. -*- lexical-binding: t -*- (defvar lk201-function-map (let ((map (make-sparse-keymap))) diff --git a/lisp/term/news.el b/lisp/term/news.el index e01d6f64be3..33c7aa6ccaa 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -1,4 +1,4 @@ -;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard +;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 6acf6cd1992..cc7a3762b4a 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -511,15 +511,9 @@ string dropped into the current buffer." (set-frame-selected-window nil window) (raise-frame) (setq window (selected-window)) - (cond ((memq 'ns-drag-operation-generic operations) - ;; Perform the default action for the type. - (if (eq type 'file) - (dolist (data objects) - (dnd-handle-one-url window 'private (concat "file:" data))) - (dnd-insert-text window 'private string))) - ((memq 'ns-drag-operation-copy operations) - ;; Try to open the file/URL. If type is nil, try to open - ;; it as a URL anyway. + (cond ((or (memq 'ns-drag-operation-generic operations) + (memq 'ns-drag-operation-copy operations)) + ;; Perform the default/copy action. (dolist (data objects) (dnd-handle-one-url window 'private (if (eq type 'file) (concat "file:" data) @@ -632,15 +626,21 @@ This function has been overloaded in Nextstep.") (defvar ns-input-fontsize) (defun ns-respond-to-change-font () - "Respond to changeFont: event, expecting `ns-input-font' and\n\ -`ns-input-fontsize' of new font." + "Set the font chosen in the font-picker panel. +Respond to changeFont: event, expecting ns-input-font and +ns-input-fontsize of new font." (interactive) - (modify-frame-parameters (selected-frame) - (list (cons 'fontsize ns-input-fontsize))) - (modify-frame-parameters (selected-frame) - (list (cons 'font ns-input-font))) - (set-frame-font ns-input-font)) - + (let ((face 'default)) + (set-face-attribute face t + :family ns-input-font + :height (* 10 ns-input-fontsize)) + (set-face-attribute face (selected-frame) + :family ns-input-font + :height (* 10 ns-input-fontsize)) + (let ((spec (list (list t (face-attr-construct 'default))))) + (put face 'customized-face spec) + (custom-push-theme 'theme-face face 'user 'set spec) + (put face 'face-modified nil)))) ;; Default fontset for macOS. This is mainly here to show how a fontset ;; can be set up manually. Ordinarily, fontsets are auto-created whenever diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index 31e3d6ede4f..71ee9086937 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -1,4 +1,4 @@ -;;; rxvt.el --- define function key sequences and standard colors for rxvt +;;; rxvt.el --- define function key sequences and standard colors for rxvt -*- lexical-binding: t -*- ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. diff --git a/lisp/term/sun.el b/lisp/term/sun.el index 41915e1b07c..7d1cd9f2cfe 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -1,4 +1,4 @@ -;;; sun.el --- keybinding for standard default sunterm keys +;;; sun.el --- keybinding for standard default sunterm keys -*- lexical-binding: t -*- ;; Copyright (C) 1987, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index c0e6a12b735..fc8ad80ae5c 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -1,4 +1,4 @@ -;;; tvi970.el --- terminal support for the Televideo 970 +;;; tvi970.el --- terminal support for the Televideo 970 -*- lexical-binding: t -*- ;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index 9e9fc4dd7de..6d72d4a05b6 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -1,4 +1,4 @@ -;;; wyse50.el --- terminal support code for Wyse 50 +;;; wyse50.el --- terminal support code for Wyse 50 -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1993-1994, 2001-2020 Free Software Foundation, ;; Inc. diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 9f08772ec30..5ce9a90ea65 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -1,10 +1,10 @@ -;;; artist.el --- draw ascii graphics with your mouse +;;; artist.el --- draw ascii graphics with your mouse -*- lexical-binding: t -*- ;; Copyright (C) 2000-2020 Free Software Foundation, Inc. ;; Author: Tomas Abrahamsson <tab@lysator.liu.se> ;; Keywords: mouse -;; Version: 1.2.6 +;; Old-Version: 1.2.6 ;; Release-date: 6-Aug-2004 ;; Location: http://www.lysator.liu.se/~tab/artist/ @@ -115,8 +115,6 @@ ;;; Requirements: -;; Artist requires Emacs 19.28 or higher. -;; ;; Artist requires the `rect' package (which comes with Emacs) to be ;; loadable, unless the variable `artist-interface-with-rect' is set ;; to nil. @@ -127,9 +125,6 @@ ;;; Known bugs: -;; The shifted operations are not available when drawing with the mouse -;; in Emacs 19.29 and 19.30. -;; ;; It is not possible to change between shifted and unshifted operation ;; while drawing with the mouse. (See the comment in the function ;; artist-shift-has-changed for further details.) @@ -598,7 +593,7 @@ This variable is initialized by the `artist-make-prev-next-op-alist' function.") (define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report) (define-key map [menu-bar artist] (cons "Artist" artist-menu-map)) map) - "Keymap for `artist-minor-mode'.") + "Keymap for `artist-mode'.") (defvar artist-replacement-table (make-vector 256 0) "Replacement table for `artist-replace-char'.") @@ -1849,9 +1844,7 @@ Return a list (RETURN-CODE STDOUT STDERR)." nil)) (tmp-stdout-buffer (get-buffer-create (concat "*artist-" program "*"))) - (tmp-stderr-file-name (make-temp-file "artist-stdout.")) - (binary-process-input nil) ; for msdos - (binary-process-output nil)) + (tmp-stderr-file-name (make-temp-file "artist-stdout."))) ;; Prepare stdin (if stdin (artist-string-to-file stdin tmp-stdin-file-name)) @@ -1963,7 +1956,8 @@ Return a list (RETURN-CODE STDOUT STDERR)." (defsubst artist-get-char-at-xy (x y) "Return the character found at column X, row Y. -Also updates the variables `artist-draw-min-y' and `artist-draw-max-y'." +Also updates the variables `artist-draw-region-min-y' and +`artist-draw-region-max-y'." (artist-move-to-xy x y) (let ((curr-y (artist-current-line))) (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y)) @@ -1998,25 +1992,11 @@ The replacement is used to convert tabs and new-lines to spaces." (defun artist-replace-chars (new-char count) "Replace characters at point with NEW-CHAR. COUNT chars are replaced." - ;; Check that the variable exists first. The doc says it was added in 19.23. - (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20)) - (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3))) - ;; This is a bug workaround for Emacs 20, versions up to 20.3: - ;; The self-insert-command doesn't care about the overwrite-mode, - ;; so the insertion is done in the same way as in picture mode. - ;; This seems to be a little bit slower. - (let* ((replaced-c (artist-get-replacement-char new-char)) - (replaced-s (make-string count replaced-c))) - (artist-move-to-xy (+ (artist-current-column) count) - (artist-current-line)) - (delete-char (- count)) - (insert replaced-s)) - ;; In emacs-19, the self-insert-command works better - (let ((overwrite-mode 'overwrite-mode-textual) - (fill-column 32765) ; Large :-) - (blink-matching-paren nil)) - (setq last-command-event (artist-get-replacement-char new-char)) - (self-insert-command count)))) + (let ((overwrite-mode 'overwrite-mode-textual) + (fill-column 32765) ; Large :-) + (blink-matching-paren nil)) + (setq last-command-event (artist-get-replacement-char new-char)) + (self-insert-command count))) (defsubst artist-replace-string (string &optional see-thru) "Replace contents at point with STRING. @@ -2739,7 +2719,7 @@ SHAPE-INFO is a list of four straight lines." ;; Filling rectangles and squares ;; -(defun artist-fill-rect (rect x1 y1 x2 y2) +(defun artist-fill-rect (_rect x1 y1 x2 y2) "Fill rectangle RECT from X1,Y1 to X2,Y2." (let ((x (1+ (min x1 x2))) (y (1+ (min y1 y2))) @@ -2751,7 +2731,7 @@ SHAPE-INFO is a list of four straight lines." (artist-replace-chars artist-fill-char w) (setq y (1+ y)))))) -(defun artist-fill-square (square x1 y1 x2 y2) +(defun artist-fill-square (_square x1 y1 x2 y2) "Fill a SQUARE from X1,Y1 to X2,Y2." (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2)) (new-x1 (elt square-corners 0)) @@ -2813,7 +2793,7 @@ to append to the end of the list, when doing free-hand drawing)." (setq artist-key-poly-point-list (list (cons x1 y1)))) -(defun artist-pen-set-arrow-points (x1 y1) +(defun artist-pen-set-arrow-points (_x1 _y1) "Set arrow points for pen drawing using X1, Y1. Also, the `artist-key-poly-point-list' is reversed." @@ -3014,11 +2994,11 @@ Returns a list of points. Each point is on the form (X1 . Y1)." ;; Step to next spray point (setq spray-points (cdr spray-points))))) -(defun artist-spray-clear-circle (circle x1 y1 x2 y2) +(defun artist-spray-clear-circle (circle _x1 _y1 _x2 _y2) "Clear circle CIRCLE at X1, Y1 through X2, Y2." (artist-undraw-circle circle)) -(defun artist-spray-set-radius (circle x1 y1 x2 y2) +(defun artist-spray-set-radius (_circle x1 y1 x2 y2) "Set spray radius from CIRCLE at X1, Y1 through X2, Y2." (let ((dx (- x2 x1)) (dy (- y2 y1))) @@ -3511,8 +3491,7 @@ POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. The Y-RADIUS must be 0, but the X-RADIUS must not be 0." - (let ((point-list nil) - (width (max (- (abs (* 2 x-radius)) 1))) + (let ((width (max (- (abs (* 2 x-radius)) 1))) (left-edge (1+ (- x1 (abs x-radius)))) (line-char (if artist-line-char-set artist-line-char ?-)) (i 0) @@ -3620,7 +3599,7 @@ FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]." ; ; Filling ellipses ; -(defun artist-fill-ellipse (ellipse x y x-radius y-radius) +(defun artist-fill-ellipse (ellipse _x _y _x-radius _y-radius) "Fill an ELLIPSE centered at X,Y with radius X-RADIUS and Y-RADIUS." (let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1))) (mapcar @@ -3740,11 +3719,11 @@ original contents of that area in the buffer." (setq x (1+ x))) last-x))) -(defun artist-ff-is-topmost-line (x y) +(defun artist-ff-is-topmost-line (_x y) "Determine whether the position X,Y is on the topmost line or not." (= y 0)) -(defun artist-ff-is-bottommost-line (x y) +(defun artist-ff-is-bottommost-line (_x y) "Determine whether the position X,Y is on the bottommost line or not." (save-excursion (goto-char (point-max)) @@ -3760,7 +3739,6 @@ original contents of that area in the buffer." (defun artist-flood-fill (x1 y1) "Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'." (let ((stack nil) - (input-queue nil) ;; We are flood-filling the area that has this character. (c (artist-get-char-at-xy-conv x1 y1)) (artist-fill-char (if artist-fill-char-set @@ -3902,7 +3880,7 @@ Optional argument STATE can be used to set state (default is nil)." (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn)))) -(defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2) +(defun artist-set-arrow-points-for-2points (shape _x1 _y1 _x2 _y2) "Generic function for setting arrow-points for 2-point shapes. The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2." (let* ((endpoint1 (artist-2point-get-endpoint1 shape)) @@ -3924,28 +3902,24 @@ The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2." ;; on the draw-how ;; -(defun artist-key-undraw-continously (x y) +(defun artist-key-undraw-continously (_x _y) "Undraw current continuous shape with point at X, Y." ;; No undraw-info for continuous shapes nil) -(defun artist-key-undraw-poly (x y) +(defun artist-key-undraw-poly (_x _y) "Undraw current poly shape with point at X, Y." - (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)) - (x1 (artist-endpoint-get-x artist-key-endpoint1)) - (y1 (artist-endpoint-get-y artist-key-endpoint1))) + (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))) (artist-funcall undraw-fn artist-key-shape))) -(defun artist-key-undraw-1point (x y) +(defun artist-key-undraw-1point (_x _y) "Undraw current 1-point shape at X, Y." ;; No undraw-info for 1-point shapes nil) -(defun artist-key-undraw-2points (x y) +(defun artist-key-undraw-2points (_x _y) "Undraw current 2-point shape at X, Y." - (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)) - (x1 (artist-endpoint-get-x artist-key-endpoint1)) - (y1 (artist-endpoint-get-y artist-key-endpoint1))) + (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))) (artist-funcall undraw-fn artist-key-shape))) (defun artist-key-undraw-common () @@ -4089,7 +4063,7 @@ Trimming here means removing white space at end of a line." (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2)))))) -(defun artist-key-do-continously-1point (x y) +(defun artist-key-do-continously-1point (_x _y) "Update current 1-point shape at X,Y." ;; Nothing to do continuously for operations ;; where we have only one input point @@ -4289,8 +4263,7 @@ If optional argument THIS-IS-LAST-POINT is non-nil, this point is the last." (defun artist-key-set-point-1point (x y) "Set point for current 1-point shape at X,Y." - (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) - (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go)) + (let ((init-fn (artist-go-get-init-fn-from-symbol artist-curr-go)) (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go)) (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)) (draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) @@ -4820,7 +4793,7 @@ If optional argument STATE is positive, turn borders on." (orig-draw-region-min-y artist-draw-region-min-y) (orig-draw-region-max-y artist-draw-region-max-y) (orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil)) - (echoq-keystrokes 10000) ; a lot of seconds + (echo-keystrokes 0) ; Don't echo unfinished commands. ;; Remember original binding for the button-up event to this ;; button-down event. (key (artist-compute-up-event-key ev)) @@ -4936,7 +4909,7 @@ If optional argument STATE is positive, turn borders on." ;; Mouse routines ;; -(defsubst artist-shift-has-changed (shift-state ev) +(defsubst artist-shift-has-changed (_shift-state _ev) "From the last SHIFT-STATE and EV, determine if the shift-state has changed." ;; This one simply doesn't work. ;; @@ -4961,6 +4934,12 @@ If optional argument STATE is positive, turn borders on." (cons (+ window-x window-start-x) (+ window-y window-start-y)))) +(defun artist--adjust-x (x) + "Adjust the X position wrt. `display-line-numbers-mode'." + (let ((adjust (line-number-display-width))) + (if (= adjust 0) + x + (- x adjust 2)))) (defun artist-mouse-draw-continously (ev) "Generic function for shapes that require 1 point as input. @@ -4982,10 +4961,9 @@ The event, EV, is the mouse event." (ev-start (event-start ev)) (initial-win (posn-window ev-start)) (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) - (x1 (car ev-start-pos)) + (x1 (artist--adjust-x (car ev-start-pos))) (y1 (cdr ev-start-pos)) - (shape) - (timer)) + (timer nil)) (select-window (posn-window ev-start)) (artist-funcall init-fn x1 y1) (if (not artist-rubber-banding) @@ -4999,7 +4977,7 @@ The event, EV, is the mouse event." (member 'down (event-modifiers ev))) (setq ev-start-pos (artist-coord-win-to-buf (posn-col-row (event-start ev)))) - (setq x1 (car ev-start-pos)) + (setq x1 (artist--adjust-x (car ev-start-pos))) (setq y1 (cdr ev-start-pos)) ;; Cancel previous timer @@ -5029,7 +5007,7 @@ The event, EV, is the mouse event." (setq draw-fn (artist-go-get-draw-fn-from-symbol op)))) ;; Draw the new shape - (setq shape (artist-funcall draw-fn x1 y1)) + (artist-funcall draw-fn x1 y1) (artist-move-to-xy x1 y1) ;; Start the timer to call `draw-fn' repeatedly every @@ -5079,7 +5057,7 @@ The event, EV, is the mouse event." (ev-start (event-start ev)) (initial-win (posn-window ev-start)) (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) - (x1-last (car ev-start-pos)) + (x1-last (artist--adjust-x (car ev-start-pos))) (y1-last (cdr ev-start-pos)) (x2 x1-last) (y2 y1-last) @@ -5171,7 +5149,7 @@ The event, EV, is the mouse event." ;; (setq ev-start-pos (artist-coord-win-to-buf (posn-col-row (event-start ev)))) - (setq x2 (car ev-start-pos)) + (setq x2 (artist--adjust-x (car ev-start-pos))) (setq y2 (cdr ev-start-pos)) ;; Draw the new shape (if not rubber-banding, place both marks) @@ -5198,7 +5176,7 @@ The event, EV, is the mouse event." ;; set x2 and y2 (setq ev-start-pos (artist-coord-win-to-buf (posn-col-row (event-start ev)))) - (setq x2 (car ev-start-pos)) + (setq x2 (artist--adjust-x (car ev-start-pos))) (setq y2 (cdr ev-start-pos)) ;; First undraw last shape @@ -5274,7 +5252,6 @@ Operation is done once. The event, EV, is the mouse event." (shifted (artist-go-get-symbol-shift artist-curr-go t)) (shift-state (artist-event-is-shifted ev)) (op (if shift-state shifted unshifted)) - (draw-how (artist-go-get-draw-how-from-symbol op)) (init-fn (artist-go-get-init-fn-from-symbol op)) (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op)) (exit-fn (artist-go-get-exit-fn-from-symbol op)) @@ -5283,7 +5260,7 @@ Operation is done once. The event, EV, is the mouse event." (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op)) (ev-start (event-start ev)) (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) - (x1 (car ev-start-pos)) + (x1 (artist--adjust-x (car ev-start-pos))) (y1 (cdr ev-start-pos))) (select-window (posn-window ev-start)) (artist-funcall init-fn x1 y1) @@ -5317,7 +5294,7 @@ The event, EV, is the mouse event." (ev-start (event-start ev)) (initial-win (posn-window ev-start)) (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) - (x1 (car ev-start-pos)) + (x1 (artist--adjust-x (car ev-start-pos))) (y1 (cdr ev-start-pos)) (x2) (y2) @@ -5331,7 +5308,7 @@ The event, EV, is the mouse event." (member 'down (event-modifiers ev))) (setq ev-start-pos (artist-coord-win-to-buf (posn-col-row (event-start ev)))) - (setq x2 (car ev-start-pos)) + (setq x2 (artist--adjust-x (car ev-start-pos))) (setq y2 (cdr ev-start-pos)) (if (not (eq initial-win (posn-window (event-start ev)))) @@ -5406,8 +5383,7 @@ The event, EV, is the mouse event." (interactive) (require 'reporter) (if (y-or-n-p "Do you want to submit a bug report on Artist? ") - (let ((to artist-maintainer-address) - (vars '(window-system + (let ((vars '(window-system window-system-version ;; artist-rubber-banding @@ -5594,8 +5570,8 @@ The event, EV, is the mouse event." ;; - artist-key-set-point-xxx for setting a point in the ;; mode, to be called from `artist-key-set-point-common'. ;; -;; - artist-key-do-continuously-xxx to be called from -;; `artist-key-do-continuously-common' whenever the user +;; - artist-key-do-continously-xxx to be called from +;; `artist-key-do-continously-common' whenever the user ;; moves around. ;; ;; As for the artist-mouse-draw-xxx, these two functions must diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 910bd7dbb9d..715379fa80f 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -85,8 +85,8 @@ If this is a function, call it to generate the initial field text." :type '(choice (const :tag "None" nil) (string :tag "Initial text") (function :tag "Initialize Function") - (const :tag "Default" t))) -(put 'bibtex-include-OPTkey 'risky-local-variable t) + (const :tag "Default" t)) + :risky t) (defcustom bibtex-user-optional-fields '(("annote" "Personal annotation (ignored)")) @@ -97,8 +97,8 @@ in `bibtex-BibTeX-entry-alist' (which see)." :type '(repeat (group (string :tag "Field") (string :tag "Comment") (option (choice :tag "Init" - (const nil) string function))))) -(put 'bibtex-user-optional-fields 'risky-local-variable t) + (const nil) string function)))) + :risky t) (defcustom bibtex-entry-format '(opts-or-alts required-fields numerical-fields) @@ -148,20 +148,18 @@ The value nil means do no formatting at all." (const unify-case) (const braces) (const strings) - (const sort-fields)))) -(put 'bibtex-entry-format 'safe-local-variable - (lambda (x) - (or (eq x t) - (let ((OK t)) - (while (consp x) - (unless (memq (pop x) - '(opts-or-alts required-fields numerical-fields - page-dashes whitespace inherit-booktitle realign - last-comma delimiters unify-case braces strings - sort-fields)) - (setq OK nil))) - (unless (null x) (setq OK nil)) - OK)))) + (const sort-fields))) + :safe (lambda (x) + (or (eq x t) + (let ((ok t)) + (while (consp x) + (unless (memq (pop x) + '( opts-or-alts required-fields numerical-fields + page-dashes whitespace inherit-booktitle + realign last-comma delimiters unify-case + braces strings sort-fields )) + (setq ok nil))) + (unless x ok))))) (defcustom bibtex-field-braces-alist nil "Alist of field regexps that \\[bibtex-clean-entry] encloses by braces. @@ -207,9 +205,8 @@ See also `bibtex-sort-ignore-string-entries'." (const plain) (const crossref) (const entry-class) - (const t))) -(put 'bibtex-maintain-sorted-entries 'safe-local-variable - (lambda (a) (memq a '(nil t plain crossref entry-class)))) + (const t)) + :safe (lambda (a) (memq a '(nil t plain crossref entry-class)))) (defcustom bibtex-sort-entry-class '(("String") @@ -223,18 +220,17 @@ to all entries not explicitly mentioned." :group 'bibtex :type '(repeat (choice :tag "Class" (const :tag "catch-all" (catch-all)) - (repeat :tag "Entry type" string)))) -(put 'bibtex-sort-entry-class 'safe-local-variable - (lambda (x) (let ((OK t)) - (while (consp x) - (let ((y (pop x))) - (while (consp y) - (let ((z (pop y))) - (unless (or (stringp z) (eq z 'catch-all)) - (setq OK nil)))) - (unless (null y) (setq OK nil)))) - (unless (null x) (setq OK nil)) - OK))) + (repeat :tag "Entry type" string))) + :safe (lambda (x) + (let ((ok t)) + (while (consp x) + (let ((y (pop x))) + (while (consp y) + (let ((z (pop y))) + (unless (or (stringp z) (eq z 'catch-all)) + (setq ok nil)))) + (when y (setq ok nil)))) + (unless x ok)))) (defcustom bibtex-sort-ignore-string-entries t "If non-nil, BibTeX @String entries are not sort-significant. @@ -459,8 +455,8 @@ ALTERNATIVE if non-nil is an integer that numbers sets of alternatives, starting from zero." :group 'bibtex :version "26.1" ; add Conference - :type 'bibtex-entry-alist) -(put 'bibtex-BibTeX-entry-alist 'risky-local-variable t) + :type 'bibtex-entry-alist + :risky t) (defcustom bibtex-biblatex-entry-alist ;; Compare in biblatex documentation: @@ -714,8 +710,8 @@ alternatives, starting from zero." It has the same format as `bibtex-BibTeX-entry-alist'." :group 'bibtex :version "24.1" - :type 'bibtex-entry-alist) -(put 'bibtex-biblatex-entry-alist 'risky-local-variable t) + :type 'bibtex-entry-alist + :risky t) (define-widget 'bibtex-field-alist 'lazy "Format of `bibtex-BibTeX-entry-alist' and friends." @@ -857,8 +853,8 @@ To interactively change the dialect use the command `bibtex-set-dialect'." (bibtex-set-dialect value))) :type '(choice (const BibTeX) (const biblatex) - (symbol :tag "Custom"))) -(put 'bibtex-dialect 'safe-local-variable 'symbolp) + (symbol :tag "Custom")) + :safe #'symbolp) (defcustom bibtex-no-opt-remove-re "\\`option" "If a field name matches this regexp, the prefix OPT is not removed. @@ -1059,9 +1055,8 @@ See `bibtex-generate-autokey' for details." (const :tag "Downcase" downcase) (const :tag "Capitalize" capitalize) (const :tag "Upcase" upcase) - (function :tag "Conversion function"))) -(put 'bibtex-autokey-name-case-convert-function 'safe-local-variable - (lambda (x) (memq x '(upcase downcase capitalize identity)))) + (function :tag "Conversion function" :value identity)) + :safe (lambda (x) (memq x '(upcase downcase capitalize identity)))) (defcustom bibtex-autokey-name-length 'infty "Number of characters from name to incorporate into key. @@ -1313,8 +1308,8 @@ The following is a complex example, see URL `http://link.aps.org/'. (regexp :tag "Regexp") (choice (string :tag "Replacement") (integer :tag "Sub-match") - (function :tag "Filter")))))))) -(put 'bibtex-generate-url-list 'risky-local-variable t) + (function :tag "Filter"))))))) + :risky t) (defcustom bibtex-cite-matcher-alist '(("\\\\cite[ \t\n]*{\\([^}]+\\)}" . 1)) @@ -1536,21 +1531,19 @@ At most `bibtex-entry-kill-ring-max' items are kept here.") (defvar bibtex-last-kill-command nil "Type of the last kill command (either `field' or `entry').") -(defvar bibtex-strings +(defvar-local bibtex-strings (lazy-completion-table bibtex-strings (lambda () (bibtex-parse-strings (bibtex-string-files-init)))) "Completion table for BibTeX string keys. Initialized from `bibtex-predefined-strings' and `bibtex-string-files'.") -(make-variable-buffer-local 'bibtex-strings) (put 'bibtex-strings 'risky-local-variable t) -(defvar bibtex-reference-keys +(defvar-local bibtex-reference-keys (lazy-completion-table bibtex-reference-keys (lambda () (bibtex-parse-keys nil t))) "Completion table for BibTeX reference keys. The CDRs of the elements are t for header keys and nil for crossref keys.") -(make-variable-buffer-local 'bibtex-reference-keys) (put 'bibtex-reference-keys 'risky-local-variable t) (defvar bibtex-buffer-last-parsed-tick nil diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 8c824461d22..747657b1ed5 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -100,7 +100,7 @@ "Identifiers for types of media.") (defconst css-property-alist - ;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html). + ;; CSS 2.1 properties (https://www.w3.org/TR/CSS21/propidx.html). ;; ;; Properties duplicated by any of the CSS3 modules below have been ;; removed. @@ -190,7 +190,7 @@ ("z-index" "auto" integer) ;; CSS Animations - ;; (http://www.w3.org/TR/css3-animations/#property-index) + ;; (https://www.w3.org/TR/css3-animations/#property-index) ("animation" single-animation-name time single-timing-function single-animation-iteration-count single-animation-direction single-animation-fill-mode single-animation-play-state) @@ -204,7 +204,7 @@ ("animation-timing-function" single-timing-function) ;; CSS Backgrounds and Borders Module Level 3 - ;; (http://www.w3.org/TR/css3-background/#property-index) + ;; (https://www.w3.org/TR/css3-background/#property-index) ("background" bg-layer final-bg-layer) ("background-attachment" attachment) ("background-clip" box) @@ -249,7 +249,7 @@ ("box-shadow" "none" shadow) ;; CSS Basic User Interface Module Level 3 (CSS3 UI) - ;; (http://www.w3.org/TR/css3-ui/#property-index) + ;; (https://www.w3.org/TR/css3-ui/#property-index) ("box-sizing" "content-box" "border-box") ("caret-color" "auto" color) ("cursor" uri x y "auto" "default" "none" "context-menu" "help" @@ -272,7 +272,7 @@ ("text-overflow" "clip" "ellipsis" string) ;; CSS Color Module Level 3 - ;; (http://www.w3.org/TR/css3-color/#property) + ;; (https://www.w3.org/TR/css3-color/#property) ("color" color) ("opacity" alphavalue) @@ -304,7 +304,7 @@ ("grid-template-rows" "none" track-list auto-track-list) ;; CSS Flexible Box Layout Module Level 1 - ;; (http://www.w3.org/TR/css-flexbox-1/#property-index) + ;; (https://www.w3.org/TR/css-flexbox-1/#property-index) ("align-content" "flex-start" "flex-end" "center" "space-between" "space-around" "stretch") ("align-items" "flex-start" "flex-end" "center" "baseline" @@ -323,7 +323,7 @@ ("order" integer) ;; CSS Fonts Module Level 3 - ;; (http://www.w3.org/TR/css3-fonts/#property-index) + ;; (https://www.w3.org/TR/css3-fonts/#property-index) ("font" font-style font-variant-css21 font-weight font-stretch font-size line-height font-family "caption" "icon" "menu" "message-box" "small-caption" "status-bar") @@ -419,7 +419,7 @@ ("columns" column-width column-count) ;; CSS Overflow Module Level 3 - ;; (http://www.w3.org/TR/css-overflow-3/#property-index) + ;; (https://www.w3.org/TR/css-overflow-3/#property-index) ("max-lines" "none" integer) ("overflow" "visible" "hidden" "scroll" "auto" "paged-x" "paged-y" "paged-x-controls" "paged-y-controls" "fragments") @@ -448,7 +448,7 @@ ("text-underline-position" "auto" "under" "left" "right") ;; CSS Text Module Level 3 - ;; (http://www.w3.org/TR/css3-text/#property-index) + ;; (https://www.w3.org/TR/css3-text/#property-index) ("hanging-punctuation" "none" "first" "force-end" "allow-end" "last") ("hyphens" "none" "manual" "auto") @@ -470,7 +470,7 @@ ("word-wrap" "normal" "break-word") ;; CSS Transforms Module Level 1 - ;; (http://www.w3.org/TR/css3-2d-transforms/#property-index) + ;; (https://www.w3.org/TR/css3-2d-transforms/#property-index) ("backface-visibility" "visible" "hidden") ("perspective" "none" length) ("perspective-origin" "left" "center" "right" "top" "bottom" @@ -481,7 +481,7 @@ ("transform-style" "flat" "preserve-3d") ;; CSS Transitions - ;; (http://www.w3.org/TR/css3-transitions/#property-index) + ;; (https://www.w3.org/TR/css3-transitions/#property-index) ("transition" single-transition) ("transition-delay" time) ("transition-duration" time) @@ -503,7 +503,7 @@ ("writing-mode" "horizontal-tb" "vertical-rl" "vertical-lr") ;; Filter Effects Module Level 1 - ;; (http://www.w3.org/TR/filter-effects/#property-index) + ;; (https://www.w3.org/TR/filter-effects/#property-index) ("color-interpolation-filters" "auto" "sRGB" "linearRGB") ("filter" "none" filter-function-list) ("flood-color" color) @@ -1356,21 +1356,19 @@ the string PROPERTY." (defun css--complete-property-value () "Complete property value at point." - (let ((property - (save-excursion - (re-search-backward ":[^/]" (line-beginning-position) t) - (when (eq (char-after) ?:) - (let ((property-end (point))) - (skip-chars-backward "-[:alnum:]") - (let ((prop (buffer-substring (point) property-end))) - (car (member prop css-property-ids)))))))) + (let ((property (and (looking-back "\\([[:alnum:]-]+\\):[^/][^;]*" + (or (ppss-innermost-start (syntax-ppss)) + (point)) + t) + (member (match-string-no-properties 1) + css-property-ids)))) (when property (let ((end (point))) (save-excursion (skip-chars-backward "[:graph:]") (list (point) end (append '("inherit" "initial" "unset") - (css--property-values property)))))))) + (css--property-values (car property))))))))) (defvar css--html-tags (mapcar #'car html-tag-alist) "List of HTML tags. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 6889d7eadac..2757074f9f8 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -387,9 +387,13 @@ like <img alt=\"Some thing.\">." ;;*---------------------------------------------------------------------*/ ;;* Programming mode */ ;;*---------------------------------------------------------------------*/ -(defvar flyspell-prog-text-faces +(defcustom flyspell-prog-text-faces '(font-lock-string-face font-lock-comment-face font-lock-doc-face) - "Faces corresponding to text in programming-mode buffers.") + "Faces corresponding to text in programming-mode buffers." + :type '(set (const font-lock-string-face) + (const font-lock-comment-face) + (const font-lock-doc-face)) + :version "28.1") (defun flyspell-generic-progmode-verify () "Used for `flyspell-generic-check-word-predicate' in programming modes." @@ -520,12 +524,25 @@ invoking `ispell-change-dictionary'. Consider using the `ispell-parser' to check your text. For instance consider adding: -\(add-hook \\='tex-mode-hook (function (lambda () (setq ispell-parser \\='tex)))) +\(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex))) in your init file. \\[flyspell-region] checks all words inside a region. \\[flyspell-buffer] checks the whole buffer." - :lighter flyspell-mode-line-string + :lighter (flyspell-mode-line-string + ;; If `flyspell-mode-line-string' is nil, then nothing of + ;; the following is displayed in the mode line. + ((:propertize flyspell-mode-line-string) + (:propertize + (:eval + (concat "/" (substring (or ispell-local-dictionary + ispell-dictionary + "--") + 0 2))) + help-echo "mouse-1: Change dictionary" + local-map (keymap + (mode-line keymap + (mouse-1 . ispell-change-dictionary)))))) :keymap flyspell-mode-map :group 'flyspell (if flyspell-mode diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 86452ff1e87..05a4bd058c4 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -198,14 +198,13 @@ Must be greater than 1." :type 'integer :group 'ispell) -;; XXX Add enchant to this list once enchant >= 2.1.0 is widespread. -;; Before that, adding it is useless, as if it is found, it will just -;; cause an error; and one of the other spelling engines below is -;; almost certainly installed in any case, for enchant to use. (defcustom ispell-program-name (or (executable-find "aspell") (executable-find "ispell") (executable-find "hunspell") + ;; Enchant is commonly installed as `enchant-2', so use this + ;; name and avoid old versions of `enchant'. + (executable-find "enchant-2") "ispell") "Program invoked by \\[ispell-word] and \\[ispell-region] commands." :type 'string @@ -330,7 +329,7 @@ The function must take one string argument and return a string." :group 'ispell) ;; FIXME framepop.el last updated c 2003 (?), -;; probably something else replaces it these days. +;; use posframe. (defcustom ispell-use-framepop-p nil "When non-nil ispell uses framepop to display choices in a dedicated frame. You can set this variable to dynamically use framepop if you are in a @@ -1237,11 +1236,11 @@ If LANG is omitted, get the extra word characters for the default language." "Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'." (let* ((dictionaries (split-string - (ispell--call-enchant-lsmod "-list-dicts" (buffer-string)) " ([^)]+)\n")) + (ispell--call-enchant-lsmod "-list-dicts") " ([^)]+)\n" t)) (found (mapcar #'(lambda (lang) `(,lang "[[:alpha:]]" "[^[:alpha:]]" - ,(ispell--get-extra-word-characters) t nil nil utf-8)) + ,(ispell--get-extra-word-characters lang) t nil nil utf-8)) dictionaries))) ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist ;; which have no element in FOUND at all. @@ -3938,7 +3937,7 @@ in your init file: You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: - (function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))" + (lambda () (local-set-key \"\\C-ci\" \\='ispell-message))" (interactive) (save-excursion (goto-char (point-min)) diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index 54e20779bdc..329f3e7241d 100644 --- a/lisp/textmodes/mhtml-mode.el +++ b/lisp/textmodes/mhtml-mode.el @@ -22,6 +22,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'pcase)) (require 'sgml-mode) (require 'js) (require 'css-mode) @@ -303,6 +304,17 @@ This is used by `mhtml--pre-command'.") (flyspell-generic-progmode-verify) t))) +;; Support for hideshow.el (see `hs-special-modes-alist'). +(defun mhtml-forward (arg) + "Move point forward past a structured expression. +If point is on a tag, move to the end of the tag. +Otherwise, this calls `forward-sexp'. +Prefix arg specifies how many times to move (default 1)." + (interactive "P") + (pcase (get-text-property (point) 'mhtml-submode) + ('nil (sgml-skip-tag-forward arg)) + (submode (forward-sexp arg)))) + ;;;###autoload (define-derived-mode mhtml-mode html-mode '((sgml-xml-mode "XHTML+" "HTML+") (:eval (mhtml--submode-lighter))) diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 7a82f8f0e6a..5216812b587 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -1,4 +1,4 @@ -;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model +;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 5fadec491a5..adda28cb81b 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2363,7 +2363,7 @@ If user selects enumerations, a further prompt is given. User need to input a starting item, for example 'e' for 'A)' style. The position is also arranged by `rst-insert-list-new-tag'." (let* ((itemstyle (completing-read - "Select preferred item style [#.]: " + (format-prompt "Select preferred item style" "#.") rst-initial-items nil t nil nil "#.")) (cnt (if (string-match (rst-re 'cntexp-tag) itemstyle) (match-string 0 itemstyle))) @@ -2371,21 +2371,23 @@ also arranged by `rst-insert-list-new-tag'." (save-match-data (cond ((equal cnt "a") - (let ((itemno (read-string "Give starting value [a]: " - nil nil "a"))) + (let ((itemno (read-string + (format-prompt "Give starting value" "a") + nil nil "a"))) (downcase (substring itemno 0 1)))) ((equal cnt "A") - (let ((itemno (read-string "Give starting value [A]: " - nil nil "A"))) + (let ((itemno (read-string + (format-prompt "Give starting value" "A") + nil nil "A"))) (upcase (substring itemno 0 1)))) ((equal cnt "I") - (let ((itemno (read-number "Give starting value [1]: " 1))) + (let ((itemno (read-number "Give starting value: " 1))) (rst-arabic-to-roman itemno))) ((equal cnt "i") - (let ((itemno (read-number "Give starting value [1]: " 1))) + (let ((itemno (read-number "Give starting value: " 1))) (downcase (rst-arabic-to-roman itemno)))) ((equal cnt "1") - (let ((itemno (read-number "Give starting value [1]: " 1))) + (let ((itemno (read-number "Give starting value: " 1))) (number-to-string itemno))))))) (if no (setq itemstyle (replace-match no t t itemstyle))) @@ -2860,7 +2862,7 @@ file-write hook to always make it up-to-date automatically." ;; FIXME: Updating the toc on saving would be nice. However, this doesn't work ;; correctly: ;; -;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) +;; (add-hook 'write-contents-functions 'rst-toc-update-fun) ;; (defun rst-toc-update-fun () ;; ;; Disable undo for the write file hook. ;; (let ((buffer-undo-list t)) (rst-toc-update) )) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index e0ef786953e..f3d8695e248 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1188,10 +1188,9 @@ and move to the line in the SGML document that caused it." (or sgml-saved-validate-command (concat sgml-validate-command " " - (shell-quote-argument - (let ((name (buffer-file-name))) - (and name - (file-name-nondirectory name))))))))) + (when-let ((name (buffer-file-name))) + (shell-quote-argument + (file-name-nondirectory name)))))))) (setq sgml-saved-validate-command command) (save-some-buffers (not compilation-ask-about-save) nil) (compilation-start command)) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index cfe6ce5ce61..25aa58046f4 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -339,8 +339,8 @@ ;; When using `table-cell-map-hook' do not use `local-set-key'. ;; ;; (add-hook 'table-cell-map-hook -;; (function (lambda () -;; (local-set-key [<key sequence>] '<function>)))) +;; (lambda () +;; (local-set-key [<key sequence>] '<function>))) ;; ;; Adding the above to your init file is a common way to customize a ;; mode specific keymap. However it does not work for this package. @@ -349,8 +349,8 @@ ;; explicitly. The correct way of achieving above task is: ;; ;; (add-hook 'table-cell-map-hook -;; (function (lambda () -;; (define-key table-cell-map [<key sequence>] '<function>)))) +;; (lambda () +;; (define-key table-cell-map [<key sequence>] '<function>))) ;; ;; ----- ;; Menu: @@ -2929,7 +2929,7 @@ buffer, and leaves the previous contents of the buffer untouched. References used for this implementation: HTML: - URL `http://www.w3.org' + URL `https://www.w3.org' LaTeX: URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html' @@ -3279,7 +3279,7 @@ Currently this method is for LaTeX only." (with-temp-buffer (insert line) (goto-char (point-min)) - (while (re-search-forward "\\([#$~_^%{}]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t) + (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t) (if (match-beginning 1) (save-excursion (goto-char (match-beginning 1)) @@ -3503,9 +3503,9 @@ column must consists from cells of same width." (let ((cell-list (table--vertical-cell-list 'top-to-bottom))) (unless (and (table--uniform-list-p - (mapcar (function (lambda (cell) (car (table--get-coordinate (car cell))))) cell-list)) + (mapcar (lambda (cell) (car (table--get-coordinate (car cell)))) cell-list)) (table--uniform-list-p - (mapcar (function (lambda (cell) (car (table--get-coordinate (cdr cell))))) cell-list))) + (mapcar (lambda (cell) (car (table--get-coordinate (cdr cell)))) cell-list))) (error "Cells in this column are not in uniform width")) (unless lu-coord (setq lu-coord (table--get-coordinate (caar cell-list)))) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index a905d148009..37ab11ad89f 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -422,7 +422,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (push (cons "--" (match-beginning 0)) menu)) ;; Sort in increasing buffer position order. - (sort menu (function (lambda (a b) (< (cdr a) (cdr b)))))))) + (sort menu (lambda (a b) (< (cdr a) (cdr b))))))) ;;;; ;;;; Outline support @@ -3541,6 +3541,8 @@ There might be text before point." (process-send-region tex-chktex--process (point-min) (point-max)) (process-send-eof tex-chktex--process)))) +(make-obsolete-variable 'tex-mode-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'tex-mode-load-hook) (provide 'tex-mode) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 3c2d766ffb1..558a3fd7368 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -278,7 +278,7 @@ If nil, construct the regexp from `thing-at-point-uri-schemes'.") "Regexp matching a URI without a scheme component.") (defvar thing-at-point-uri-schemes - ;; Officials from http://www.iana.org/assignments/uri-schemes.html + ;; Officials from https://www.iana.org/assignments/uri-schemes.html '("aaa://" "about:" "acap://" "apt:" "bzr://" "bzr+ssh://" "attachment:/" "chrome://" "cid:" "content://" "crid://" "cvs://" "data:" "dav:" "dict://" "doi:" "dns:" "dtn:" "feed:" "file:/" diff --git a/lisp/thumbs.el b/lisp/thumbs.el index dd259ec1ff6..3aa7ff0836b 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -30,7 +30,7 @@ ;; your images, use image-dired.el ;; ;; The 'convert' program from 'ImageMagick' -;; [URL:http://www.imagemagick.org/] is required. +;; [URL:https://www.imagemagick.org/] is required. ;; ;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some ;; time. The peoples at #emacs@freenode.net for numerous help. RMS diff --git a/lisp/time.el b/lisp/time.el index 534f1283429..eca9a0752e4 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -1,4 +1,4 @@ -;;; time.el --- display time, load and mail indicator in mode line of Emacs +;;; time.el --- display time, load and mail indicator in mode line of Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2020 Free Software ;; Foundation, Inc. @@ -284,6 +284,60 @@ Switches from the 1 to 5 to 15 minute load average, and then back to 1." (defvar month) (defvar dayname)) +(defun display-time-update--load () + (if (null display-time-load-average) + "" + (condition-case () + ;; Do not show values less than + ;; `display-time-load-average-threshold'. + (if (> (* display-time-load-average-threshold 100) + (nth display-time-load-average (load-average))) + "" + ;; The load average number is mysterious, so + ;; provide some help. + (let ((str (format " %03d" + (nth display-time-load-average + (load-average))))) + (propertize + (concat (substring str 0 -2) "." (substring str -2)) + 'local-map (make-mode-line-mouse-map + 'mouse-2 'display-time-next-load-average) + 'mouse-face 'mode-line-highlight + 'help-echo (concat + "System load average for past " + (if (= 0 display-time-load-average) + "1 minute" + (if (= 1 display-time-load-average) + "5 minutes" + "15 minutes")) + "; mouse-2: next")))) + (error "")))) + +(defun display-time-update--mail () + (let ((mail-spool-file (or display-time-mail-file + (getenv "MAIL") + (concat rmail-spool-directory + (user-login-name))))) + (cond + (display-time-mail-function + (funcall display-time-mail-function)) + (display-time-mail-directory + (display-time-mail-check-directory)) + ((and (stringp mail-spool-file) + (or (null display-time-server-down-time) + ;; If have been down for 20 min, try again. + (time-less-p 1200 (time-since + display-time-server-down-time)))) + (let ((start-time (current-time))) + (prog1 + (display-time-file-nonempty-p mail-spool-file) + ;; Record whether mail file is accessible. + (setq display-time-server-down-time + (let ((end-time (current-time))) + (and (time-less-p 20 (time-subtract + end-time start-time)) + (float-time end-time)))))))))) + (defun display-time-update () "Update the display-time info for the mode line. However, don't redisplay right now. @@ -291,57 +345,9 @@ However, don't redisplay right now. This is used for things like Rmail `g' that want to force an update which can wait for the next redisplay." (let* ((now (current-time)) - (time (current-time-string now)) - (load (if (null display-time-load-average) - "" - (condition-case () - ;; Do not show values less than - ;; `display-time-load-average-threshold'. - (if (> (* display-time-load-average-threshold 100) - (nth display-time-load-average (load-average))) - "" - ;; The load average number is mysterious, so - ;; provide some help. - (let ((str (format " %03d" - (nth display-time-load-average - (load-average))))) - (propertize - (concat (substring str 0 -2) "." (substring str -2)) - 'local-map (make-mode-line-mouse-map - 'mouse-2 'display-time-next-load-average) - 'mouse-face 'mode-line-highlight - 'help-echo (concat - "System load average for past " - (if (= 0 display-time-load-average) - "1 minute" - (if (= 1 display-time-load-average) - "5 minutes" - "15 minutes")) - "; mouse-2: next")))) - (error "")))) - (mail-spool-file (or display-time-mail-file - (getenv "MAIL") - (concat rmail-spool-directory - (user-login-name)))) - (mail (cond - (display-time-mail-function - (funcall display-time-mail-function)) - (display-time-mail-directory - (display-time-mail-check-directory)) - ((and (stringp mail-spool-file) - (or (null display-time-server-down-time) - ;; If have been down for 20 min, try again. - (time-less-p 1200 (time-since - display-time-server-down-time)))) - (let ((start-time (current-time))) - (prog1 - (display-time-file-nonempty-p mail-spool-file) - ;; Record whether mail file is accessible. - (setq display-time-server-down-time - (let ((end-time (current-time))) - (and (time-less-p 20 (time-subtract - end-time start-time)) - (float-time end-time))))))))) + (time (current-time-string now)) + (load (display-time-update--load)) + (mail (display-time-update--mail)) (24-hours (substring time 11 13)) (hour (string-to-number 24-hours)) (12-hours (int-to-string (1+ (% (+ hour 11) 12)))) @@ -525,6 +531,9 @@ See `world-clock'." (setq-local revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) +(defvar world-clock--timer nil + "The current world clock timer.") + (defun world-clock-display (alist) "Replace current buffer text with times in various zones, based on ALIST." (let ((inhibit-read-only t) @@ -551,9 +560,9 @@ See `world-clock'." (delete-char -1)) (goto-char (point-min))) -;; Old name -- preserved for backwards compatibility. ;;;###autoload -(defalias 'display-time-world #'world-clock) +(define-obsolete-function-alias 'display-time-world + #'world-clock "28.1") ;;;###autoload (defun world-clock () @@ -565,7 +574,8 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (pop-to-buffer buffer) (pop-to-buffer world-clock-buffer-name) (when world-clock-timer-enable - (run-at-time t world-clock-timer-second #'world-clock-update) + (setq world-clock--timer + (run-at-time t world-clock-timer-second #'world-clock-update)) (add-hook 'kill-buffer-hook #'world-clock-cancel-timer nil t))) (world-clock-display (time--display-world-list)) (world-clock-mode) @@ -573,12 +583,9 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (defun world-clock-cancel-timer () "Cancel the world clock timer." - (let ((list timer-list)) - (while list - (let ((elt (pop list))) - (when (equal (symbol-name (timer--function elt)) - "world-clock-update") - (cancel-timer elt)))))) + (when world-clock--timer + (cancel-timer world-clock--timer) + (setq world-clock--timer nil))) (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." @@ -588,19 +595,23 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (world-clock-cancel-timer))) ;;;###autoload -(defun emacs-uptime (&optional format) +(defun emacs-uptime (&optional format here) "Return a string giving the uptime of this instance of Emacs. FORMAT is a string to format the result, using `format-seconds'. -For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"." - (interactive) +For example, the Unix uptime command format is \"%D, %z%2h:%.2m\". +If the optional argument HERE is non-nil, insert string at +point." + (interactive "i\nP") (let ((str (format-seconds (or format "%Y, %D, %H, %M, %z%S") (time-convert (time-since before-init-time) 'integer)))) - (if (called-interactively-p 'interactive) - (message "%s" str) - str))) + (if here + (insert str) + (if (called-interactively-p 'interactive) + (message "%s" str) + str)))) ;;;###autoload (defun emacs-init-time () diff --git a/lisp/tmm.el b/lisp/tmm.el index e9f3f5b038f..4c2855751c2 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -42,25 +42,7 @@ (defvar tmm-next-shortcut-digit) (defvar tmm-table-undef) -(defun tmm-menubar-keymap () - "Return the current menu-bar keymap. - -The ordering of the return value respects `menu-bar-final-items'." - (let ((menu-bar '()) - (menu-end '())) - (map-keymap - (lambda (key binding) - (push (cons key binding) - ;; If KEY is the name of an item that we want to put last, - ;; move it to the end. - (if (memq key menu-bar-final-items) - menu-end - menu-bar))) - (tmm-get-keybind [menu-bar])) - `(keymap ,@(nreverse menu-bar) ,@(nreverse menu-end)))) - ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) -;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) ;;;###autoload (defun tmm-menubar (&optional x-position) @@ -74,30 +56,12 @@ to invoke `tmm-menubar' instead, customize the variable `tty-menu-open-use-tmm' to a non-nil value." (interactive) (run-hooks 'menu-bar-update-hook) - ;; Obey menu-bar-final-items; put those items last. - (let ((menu-bar (tmm-menubar-keymap)) - menu-bar-item) - (if x-position - (let ((column 0) - prev-key) - (catch 'done - (map-keymap - (lambda (key binding) - (when (> column x-position) - (setq menu-bar-item prev-key) - (throw 'done nil)) - (setq prev-key key) - (pcase binding - ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item. - `(menu-item ,name ,_cmd ;Extended menu item. - . ,(and props - (guard (let ((visible - (plist-get props :visible))) - (or (null visible) - (eval visible))))))) - (setq column (+ column (length name) 1))))) - menu-bar)))) - (tmm-prompt menu-bar nil menu-bar-item))) + (let ((menu-bar (menu-bar-keymap)) + (menu-bar-item-cons (and x-position + (menu-bar-item-at-x x-position)))) + (tmm-prompt menu-bar + nil + (and menu-bar-item-cons (car menu-bar-item-cons))))) ;;;###autoload (defun tmm-menubar-mouse (event) @@ -517,14 +481,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys." (or (assoc str tmm-km-list) (push (cons str (cons event km)) tmm-km-list)))))) -(defun tmm-get-keybind (keyseq) - "Return the current binding of KEYSEQ, merging prefix definitions. -If KEYSEQ is a prefix key that has local and global bindings, -we merge them into a single keymap which shows the proper order of the menu. -However, for the menu bar itself, the value does not take account -of `menu-bar-final-items'." - (lookup-key (cons 'keymap (nreverse (current-active-maps))) keyseq)) - (provide 'tmm) ;;; tmm.el ends here diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 7df1e28e06f..84562164300 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -1,4 +1,4 @@ -;;; tool-bar.el --- setting up the tool bar +;;; tool-bar.el --- setting up the tool bar -*- lexical-binding: t -*- ;; Copyright (C) 2000-2020 Free Software Foundation, Inc. @@ -139,7 +139,7 @@ ICON.xbm, using `find-image'. Use this function only to make bindings in the global value of `tool-bar-map'. To define items in any other map, use `tool-bar-local-item'." - (apply 'tool-bar-local-item icon def key tool-bar-map props)) + (apply #'tool-bar-local-item icon def key tool-bar-map props)) (defun tool-bar--image-expression (icon) "Return an expression that evaluates to an image spec for ICON." @@ -191,7 +191,7 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap. Use this function only to make bindings in the global value of `tool-bar-map'. To define items in any other map, use `tool-bar-local-item-from-menu'." - (apply 'tool-bar-local-item-from-menu command icon + (apply #'tool-bar-local-item-from-menu command icon (default-value 'tool-bar-map) map props)) ;;;###autoload diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 5f5a4788b26..ffc3d499e30 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -1,4 +1,4 @@ -;;; tooltip.el --- show tooltip windows +;;; tooltip.el --- show tooltip windows -*- lexical-binding:t -*- ;; Copyright (C) 1997, 1999-2020 Free Software Foundation, Inc. @@ -70,24 +70,20 @@ echo area, instead of making a pop-up window." (defcustom tooltip-delay 0.7 "Seconds to wait before displaying a tooltip the first time." - :type 'number - :group 'tooltip) + :type 'number) (defcustom tooltip-short-delay 0.1 "Seconds to wait between subsequent tooltips on different items." - :type 'number - :group 'tooltip) + :type 'number) (defcustom tooltip-recent-seconds 1 "Display tooltips if changing tip items within this many seconds. Do so after `tooltip-short-delay'." - :type 'number - :group 'tooltip) + :type 'number) (defcustom tooltip-hide-delay 10 "Hide tooltips automatically after this many seconds." - :type 'number - :group 'tooltip) + :type 'number) (defcustom tooltip-x-offset 5 "X offset, in pixels, for the display of tooltips. @@ -98,8 +94,7 @@ interfere with clicking where you wish. If `tooltip-frame-parameters' includes the `left' parameter, the value of `tooltip-x-offset' is ignored." - :type 'integer - :group 'tooltip) + :type 'integer) (defcustom tooltip-y-offset +20 "Y offset, in pixels, for the display of tooltips. @@ -110,8 +105,7 @@ interfere with clicking where you wish. If `tooltip-frame-parameters' includes the `top' parameter, the value of `tooltip-y-offset' is ignored." - :type 'integer - :group 'tooltip) + :type 'integer) (defcustom tooltip-frame-parameters '((name . "tooltip") @@ -127,8 +121,7 @@ Note that font and color parameters are ignored, and the attributes of the `tooltip' face are used instead." :type '(repeat (cons :format "%v" (symbol :tag "Parameter") - (sexp :tag "Value"))) - :group 'tooltip + (sexp :tag "Value"))) :version "26.1") (defface tooltip @@ -139,15 +132,13 @@ of the `tooltip' face are used instead." (t :inherit variable-pitch)) "Face for tooltips." - :group 'tooltip :group 'basic-faces) (defcustom tooltip-use-echo-area nil "Use the echo area instead of tooltip frames for help and GUD tooltips. This variable is obsolete; instead of setting it to t, disable `tooltip-mode' (which has a similar effect)." - :type 'boolean - :group 'tooltip) + :type 'boolean) (make-obsolete-variable 'tooltip-use-echo-area "disable Tooltip mode instead" "24.1" 'set) @@ -161,7 +152,6 @@ the echo area is resized as needed to accommodate the full text of the tooltip. This variable has effect only on GUI frames." :type 'boolean - :group 'tooltip :version "27.1") diff --git a/lisp/type-break.el b/lisp/type-break.el index 5877292bab0..a9ec19b2565 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -51,8 +51,6 @@ ;; this, but I think the health of my hands is far more important than a ;; few pages of virtual memory. -;; This program has no hope of working in Emacs 18. - ;; This package was inspired by Roland McGrath's hanoi-break.el. ;; Several people contributed feedback and ideas, including ;; Roland McGrath <roland@gnu.org> @@ -958,11 +956,7 @@ FRAC should be the inverse of the fractional value; for example, a value of sum)) (defun type-break-time-stamp (&optional when) - (if (fboundp 'format-time-string) - (format-time-string type-break-time-stamp-format when) - ;; Emacs 19.28 and prior do not have format-time-string. - ;; In that case, result is not customizable. Upgrade today! - (format "[%s] " (substring (current-time-string when) 11 16)))) + (format-time-string type-break-time-stamp-format when)) (defun type-break-format-time (secs) (let ((mins (/ secs 60))) diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 70e8ecee745..e6a1b35bc06 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -104,6 +104,14 @@ would have the following buffer names in the various styles: post-forward-angle-brackets name<bar/mumble> name<quux/mumble> nil name name<2> +The value can be set to a customized function with two arguments +BASE and EXTRA-STRINGS where BASE is a string and EXTRA-STRINGS +is a list of strings. For example the current implementation for +post-forward-angle-brackets could be: + +(defun my-post-forward-angle-brackets (base extra-string) + (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\")) + The \"mumble\" part may be stripped as well, depending on the setting of `uniquify-strip-common-suffix'. For more options that you can set, browse the `uniquify' custom group." @@ -111,6 +119,7 @@ you can set, browse the `uniquify' custom group." (const reverse) (const post-forward) (const post-forward-angle-brackets) + (function :tag "Other") (const :tag "numeric suffixes" nil)) :version "24.4" :require 'uniquify) @@ -364,20 +373,22 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (cond ((null extra-string) base) ((string-equal base "") ;Happens for dired buffers on the root directory. - (mapconcat 'identity extra-string "/")) + (mapconcat #'identity extra-string "/")) ((eq uniquify-buffer-name-style 'reverse) - (mapconcat 'identity + (mapconcat #'identity (cons base (nreverse extra-string)) (or uniquify-separator "\\"))) ((eq uniquify-buffer-name-style 'forward) - (mapconcat 'identity (nconc extra-string (list base)) + (mapconcat #'identity (nconc extra-string (list base)) "/")) ((eq uniquify-buffer-name-style 'post-forward) (concat base (or uniquify-separator "|") - (mapconcat 'identity extra-string "/"))) + (mapconcat #'identity extra-string "/"))) ((eq uniquify-buffer-name-style 'post-forward-angle-brackets) - (concat base "<" (mapconcat 'identity extra-string "/") + (concat base "<" (mapconcat #'identity extra-string "/") ">")) + ((functionp uniquify-buffer-name-style) + (funcall uniquify-buffer-name-style base extra-string)) (t (error "Bad value for uniquify-buffer-name-style: %s" uniquify-buffer-name-style))))) diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1 index cf168ebf470..0309440defa 100644 --- a/lisp/url/ChangeLog.1 +++ b/lisp/url/ChangeLog.1 @@ -449,7 +449,7 @@ 2012-04-10 William Xu <william.xwl@gmail.com> (tiny change) - * url.el (url-retrieve-internal): Hexify multibye URL string first + * url.el (url-retrieve-internal): Hexify multibyte URL string first when necessary (bug#7017). 2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index f2044617b94..8f39b5ae010 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -39,7 +39,7 @@ ;;; ------------------------ ;;; This implements the BASIC authorization type. See the online ;;; documentation at -;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html +;;; https://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html ;;; for the complete documentation on this type. ;;; ;;; This is very insecure, but it works as a proof-of-concept diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index a67e5dcd125..056ad1e0188 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -125,8 +125,8 @@ The actual return value is the last modification time of the cache file." (setq fname (and fname (mapconcat - (function (lambda (x) - (if (= x ?~) "" (char-to-string x)))) + (lambda (x) + (if (= x ?~) "" (char-to-string x))) fname "")) fname (cond ((null fname) nil) diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el index fa57815e204..c1cdf901d6c 100644 --- a/lisp/url/url-domsuf.el +++ b/lisp/url/url-domsuf.el @@ -1,4 +1,4 @@ -;;; url-domsuf.el --- Say what domain names can have cookies set. +;;; url-domsuf.el --- Say what domain names can have cookies set. -*- lexical-binding:t -*- ;; Copyright (C) 2012-2020 Free Software Foundation, Inc. @@ -24,7 +24,7 @@ ;;; Commentary: ;; The rules for what domains can have cookies set is defined here: -;; http://publicsuffix.org/list/ +;; https://publicsuffix.org/list/ ;;; Code: @@ -87,17 +87,6 @@ (setq allowedp nil)))) allowedp)) -;; Tests: - -;; TODO convert to a proper test. -;; (url-domsuf-cookie-allowed-p "com") => nil -;; (url-domsuf-cookie-allowed-p "foo.bar.bd") => t -;; (url-domsuf-cookie-allowed-p "bar.bd") => nil -;; (url-domsuf-cookie-allowed-p "co.uk") => nil -;; (url-domsuf-cookie-allowed-p "foo.bar.hokkaido.jo") => t -;; (url-domsuf-cookie-allowed-p "bar.yokohama.jp") => nil -;; (url-domsuf-cookie-allowed-p "city.yokohama.jp") => t - (provide 'url-domsuf) ;;; url-domsuf.el ends here diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 03a3b37f398..9647df1c13c 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -22,7 +22,7 @@ ;;; Commentary: ;; IRC URLs are defined in -;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt +;; https://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt ;;; Code: diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index e35823ab9af..f9dce2418f6 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -1,4 +1,4 @@ -;;; url-vars.el --- Variables for Uniform Resource Locator tool +;;; url-vars.el --- Variables for Uniform Resource Locator tool -*- lexical-binding:t -*- ;; Copyright (C) 1996-1999, 2001, 2004-2020 Free Software Foundation, ;; Inc. diff --git a/lisp/url/url.el b/lisp/url/url.el index 321e79c019f..33a5ebcdccc 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -24,7 +24,7 @@ ;;; Commentary: -;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes +;; Registered URI schemes: https://www.iana.org/assignments/uri-schemes ;;; Code: diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 9c41d508b6b..5aeb8feb990 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -83,7 +83,10 @@ When editing a diff file, the line numbers in the hunk headers need to be kept consistent with the actual diff. This can either be done on the fly (but this sometimes interacts poorly with the undo mechanism) or whenever the file is written (can be slow -when editing big diffs)." +when editing big diffs). + +If this variable is nil, the hunk header numbers are updated when +the file is written instead." :type 'boolean) (defcustom diff-advance-after-apply-hunk t @@ -205,6 +208,8 @@ and hunk-based syntax highlighting otherwise as a fallback." ;; `d' because it duplicates the context :-( --Stef ("\C-c\C-d" . diff-unified->context) ("\C-c\C-w" . diff-ignore-whitespace-hunk) + ;; `l' because it "refreshes" the hunk like C-l refreshes the screen + ("\C-c\C-l" . diff-refresh-hunk) ("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-( ("\C-c\C-f" . next-error-follow-minor-mode)) "Keymap for `diff-mode'. See also `diff-mode-shared-map'.") @@ -241,6 +246,8 @@ and hunk-based syntax highlighting otherwise as a fallback." :help "Split the current (unified diff) hunk at point into two hunks"] ["Ignore whitespace changes" diff-ignore-whitespace-hunk :help "Re-diff the current hunk, ignoring whitespace differences"] + ["Recompute the hunk" diff-refresh-hunk + :help "Re-diff the current hunk, keeping the whitespace differences"] ["Highlight fine changes" diff-refine-hunk :help "Highlight changes of hunk at point at a finer granularity"] ["Kill current hunk" diff-hunk-kill @@ -930,8 +937,12 @@ If the OLD prefix arg is passed, tell the file NAME of the old file." (progn (diff-hunk-prev) (point)) (error (point-min))))) (header-files - ;; handle filenames with spaces; + ;; handle file names with spaces; ;; cf. diff-font-lock-keywords / diff-file-header + ;; FIXME if there are nonascii characters in the file names, + ;; GNU diff displays them as octal escapes. + ;; This function should undo that, so as to return file names + ;; that are usable in Emacs. (if (looking-at "[-*][-*][-*] \\([^\t\n]+\\).*\n[-+][-+][-+] \\([^\t\n]+\\)") (list (if old (match-string 1) (match-string 2)) (if old (match-string 2) (match-string 1))) @@ -1853,7 +1864,10 @@ SWITCHED is non-nil if the patch is already applied." (buf (if revision (let ((vc-find-revision-no-save t)) (vc-find-revision (expand-file-name file) revision diff-vc-backend)) - (find-file-noselect file)))) + ;; NOPROMPT is only non-nil when called from + ;; `which-function-mode', so avoid "File x changed + ;; on disk. Reread from disk?" warnings. + (find-file-noselect file noprompt)))) ;; Update the user preference if he so wished. (when (> (prefix-numeric-value other-file) 8) (setq diff-jump-to-old-file other)) @@ -2035,8 +2049,15 @@ For use in `add-log-current-defun-function'." (defun diff-ignore-whitespace-hunk () "Re-diff the current hunk, ignoring whitespace differences." (interactive) + (diff-refresh-hunk t)) + +(defun diff-refresh-hunk (&optional ignore-whitespace) + "Re-diff the current hunk." + (interactive) (let* ((char-offset (- (point) (diff-beginning-of-hunk t))) - (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b"))) + (opt-type (pcase (char-after) + (?@ "-u") + (?* "-c"))) (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") (error "Can't find line number")) (string-to-number (match-string 1)))) @@ -2047,7 +2068,12 @@ For use in `add-log-current-defun-function'." (file1 (make-temp-file "diff1")) (file2 (make-temp-file "diff2")) (coding-system-for-read buffer-file-coding-system) - old new) + opts old new) + (when ignore-whitespace + (setq opts '("-b"))) + (when opt-type + (setq opts (cons opt-type opts))) + (unwind-protect (save-excursion (setq old (diff-hunk-text hunk nil char-offset)) @@ -2056,8 +2082,9 @@ For use in `add-log-current-defun-function'." (write-region (concat lead (car new)) nil file2 nil 'nomessage) (with-temp-buffer (let ((status - (call-process diff-command nil t nil - opts file1 file2))) + (apply 'call-process + `(,diff-command nil t nil + ,@opts ,file1 ,file2)))) (pcase status (0 nil) ;Nothing to reformat. (1 (goto-char (point-min)) @@ -2169,9 +2196,10 @@ Return new point, if it was moved." (smerge-refine-regions beg-del beg-add beg-add end-add nil #'diff-refine-preproc props-r props-a))))) ('context - (let* ((middle (save-excursion (re-search-forward "^---" end))) + (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) - (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (while (and middle + (re-search-forward "^\\(?:!.*\n\\)+" middle t)) (smerge-refine-regions (match-beginning 0) (match-end 0) (save-excursion (goto-char other) diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 9e7e771963c..b7f17bf3c73 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -145,9 +145,17 @@ Possible values are: (defun diff-no-select (old new &optional switches no-async buf) ;; Noninteractive helper for creating and reverting diff buffers - "Compare the OLD and NEW file/buffer, and return a diff buffer. + "Compare the OLD and NEW file/buffer. +If the optional SWITCHES is nil, the switches specified in the +variable ‘diff-switches’ are passed to the diff command, +otherwise SWITCHES is used. SWITCHES can be a string or a list +of strings. -See `diff' for the meaning of the arguments." +If NO-ASYNC is non-nil, call diff synchronously. + +By default, this function creates the diff in the \"*Diff*\" +buffer. If BUF is non-nil, BUF is used instead. This function +returns the buffer used." (unless (bufferp new) (setq new (expand-file-name new))) (unless (bufferp old) (setq old (expand-file-name old))) (or switches (setq switches diff-switches)) ; If not specified, use default. @@ -250,6 +258,8 @@ This requires the external program `diff' to be in your `exec-path'." (interactive "bBuffer: ") (let ((buf (get-buffer (or buffer (current-buffer))))) (with-current-buffer (or (buffer-base-buffer buf) buf) + (unless buffer-file-name + (error "Buffer is not visiting a file")) (diff buffer-file-name (current-buffer) nil 'noasync)))) ;;;###autoload diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 52878bad8a7..e28d8574b1c 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -4129,10 +4129,10 @@ Mail anyway? (y or n) ") (ediff-with-current-buffer standard-output (fundamental-mode)) (princ (format "\nCtl buffer: %S\n" ediff-control-buffer)) - (ediff-print-diff-vector (intern "ediff-difference-vector-A")) - (ediff-print-diff-vector (intern "ediff-difference-vector-B")) - (ediff-print-diff-vector (intern "ediff-difference-vector-C")) - (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor")) + (ediff-print-diff-vector 'ediff-difference-vector-A) + (ediff-print-diff-vector 'ediff-difference-vector-B) + (ediff-print-diff-vector 'ediff-difference-vector-C) + (ediff-print-diff-vector 'ediff-difference-vector-Ancestor) )) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index cd19b4e065b..1c69bdf4135 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -244,7 +244,9 @@ If the optional argument STRIDE is present, that is a step-width to use when going through the comment ring." ;; Why substring rather than regexp ? -sm (interactive - (list (read-string "Comment substring: " nil nil log-edit-last-comment-match))) + (list (read-string (format-prompt "Comment substring" + log-edit-last-comment-match) + nil nil log-edit-last-comment-match))) (unless stride (setq stride 1)) (if (string= str "") (setq str log-edit-last-comment-match) @@ -261,7 +263,9 @@ when going through the comment ring." (defun log-edit-comment-search-forward (str) "Search forwards through comment history for a substring match of STR." (interactive - (list (read-string "Comment substring: " nil nil log-edit-last-comment-match))) + (list (read-string (format-prompt "Comment substring" + log-edit-last-comment-match) + nil nil log-edit-last-comment-match))) (log-edit-comment-search-backward str -1)) (defun log-edit-comment-to-change-log (&optional whoami file-name) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index cb0494ee91c..1e4343cc6be 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -1624,8 +1624,7 @@ With prefix argument, prompt for cvs flags." (defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags) "Diff the selected files against the repository. This command compares the files in your working area against the -revision which they are based upon. -See also `cvs-diff-ignore-marks'." +revision which they are based upon." (interactive (list (cvs-add-branch-prefix (cvs-add-secondary-branch-prefix diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 18bcc6c2f10..5198bccf846 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -408,7 +408,7 @@ should be applied to the background or to the foreground." (if (null current-prefix-arg) vc-annotate-display-mode (float (string-to-number - (read-string "Annotate span days (default 20): " + (read-string (format-prompt "Annotate span days" 20) nil nil "20"))))))) (vc-ensure-vc-buffer) (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index f98730ed221..e2d0ca69a20 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -26,7 +26,7 @@ ;;; Commentary: -;; See <URL:http://bazaar.canonical.com/> concerning bzr. +;; See <URL:https://bazaar.canonical.com/> concerning bzr. ;; This library provides bzr support in VC. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 6c219005cea..cdf8ab984e8 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -451,11 +451,7 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry)) (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry)) (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil) - ;; `ewoc-invalidate' will kill line and insert new text, - ;; let's keep point column. - (let ((p (point))) - (ewoc-invalidate vc-ewoc node) - (goto-char p))) + (ewoc-invalidate vc-ewoc node)) ;; If the state is nil, the file does not exist ;; anymore, so remember the entry so we can remove ;; it after we are done inserting all ENTRIES. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 84aeb0a1105..91554bb6d83 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1573,8 +1573,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-extra-status-menu () vc-git-extra-menu-map) (defun vc-git-root (file) - (or (vc-file-getprop file 'git-root) - (vc-file-setprop file 'git-root (vc-find-root file ".git")))) + (vc-find-root file ".git")) ;; grep-compute-defaults autoloads grep. (declare-function grep-read-regexp "grep" ()) @@ -1707,12 +1706,13 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (vc-resynch-buffer (vc-git-root default-directory) t t)) (defun vc-git-stash-list () - (delete - "" - (split-string - (replace-regexp-in-string - "^stash@" " " (vc-git--run-command-string nil "stash" "list")) - "\n"))) + (when-let ((out (vc-git--run-command-string nil "stash" "list"))) + (delete + "" + (split-string + (replace-regexp-in-string + "^stash@" " " out) + "\n")))) (defun vc-git-stash-get-at-point (point) (save-excursion @@ -1794,9 +1794,9 @@ The difference to vc-do-command is that this function always invokes (defun vc-git--call (buffer command &rest args) ;; We don't need to care the arguments. If there is a file name, it ;; is always a relative one. This works also for remote - ;; directories. We enable `inhibit-nul-byte-detection', otherwise + ;; directories. We enable `inhibit-null-byte-detection', otherwise ;; Tramp's eol conversion might be confused. - (let ((inhibit-nul-byte-detection t) + (let ((inhibit-null-byte-detection t) (coding-system-for-read (or coding-system-for-read vc-git-log-output-coding-system)) (coding-system-for-write diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index e108b3a340f..06dd09490d2 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -51,8 +51,8 @@ :group 'vc-svn) ;; Might be nice if svn defaulted to non-interactive if stdin not tty. -;; http://svn.haxx.se/dev/archive-2008-05/0762.shtml -;; http://svn.haxx.se/dev/archive-2009-04/0094.shtml +;; https://svn.haxx.se/dev/archive-2008-05/0762.shtml +;; https://svn.haxx.se/dev/archive-2009-04/0094.shtml ;; Maybe newer ones do? (defcustom vc-svn-global-switches (unless (eq system-type 'darwin) ; bug#13513 '("--non-interactive")) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4cbd2658f80..8def7da3776 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -979,12 +979,22 @@ be reported. If NO-ERROR is nil, signal an error that no VC backend is responsible for the given file." (or (and (not (file-directory-p file)) (vc-backend file)) - (catch 'found - ;; First try: find a responsible backend. If this is for registration, - ;; it must be a backend under which FILE is not yet registered. - (dolist (backend vc-handled-backends) - (and (vc-call-backend backend 'responsible-p file) - (throw 'found backend)))) + ;; First try: find a responsible backend. If this is for registration, + ;; it must be a backend under which FILE is not yet registered. + (let ((dirs (delq nil + (mapcar + (lambda (backend) + (when-let ((dir (vc-call-backend + backend 'responsible-p file))) + (cons backend dir))) + vc-handled-backends)))) + ;; Just a single response (or none); use it. + (if (< (length dirs) 2) + (caar dirs) + ;; Several roots; we seem to have one vc inside another's + ;; directory. Choose the most specific. + (caar (sort dirs (lambda (d1 d2) + (< (length (cdr d2)) (length (cdr d1)))))))) (unless no-error (error "No VC backend is responsible for %s" file)))) @@ -1038,7 +1048,9 @@ If the current buffer is in `vc-dir' or Dired mode, FILESET is the list of marked files, or the current directory if no files are marked. Otherwise, if the current buffer is visiting a version-controlled -file, FILESET is a single-file list containing that file's name. +file or is an indirect buffer whose base buffer visits a +version-controlled file, FILESET is a single-file list containing +that file's name. Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file is unregistered, FILESET is a single-file list containing the name of the visited file. @@ -1052,6 +1064,14 @@ possible values of STATE are explained in `vc-state', and MODEL in the returned list. BEWARE: this function may change the current buffer." + (with-current-buffer (or (buffer-base-buffer) (current-buffer)) + (vc-deduce-fileset-1 not-state-changing + allow-unregistered + state-model-only-files))) + +(defun vc-deduce-fileset-1 (not-state-changing + allow-unregistered + state-model-only-files) (let (backend) (cond ((derived-mode-p 'vc-dir-mode) @@ -1073,7 +1093,7 @@ BEWARE: this function may change the current buffer." (derived-mode-p 'dired-mode))))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) - (vc-deduce-fileset not-state-changing allow-unregistered state-model-only-files))) + (vc-deduce-fileset-1 not-state-changing allow-unregistered state-model-only-files))) ((and (not buffer-file-name) (setq backend (vc-responsible-backend default-directory))) (list backend nil)) @@ -1883,6 +1903,10 @@ state of each file in the fileset." t (list backend (list rootdir)) rev1 rev2 (called-interactively-p 'interactive))))) +(defun vc-maybe-buffer-sync (not-urgent) + (with-current-buffer (or (buffer-base-buffer) (current-buffer)) + (when buffer-file-name (vc-buffer-sync not-urgent)))) + ;;;###autoload (defun vc-diff (&optional historic not-urgent) "Display diffs between file revisions. @@ -1895,9 +1919,17 @@ saving the buffer." (interactive (list current-prefix-arg t)) (if historic (call-interactively 'vc-version-diff) - (when buffer-file-name (vc-buffer-sync not-urgent)) - (vc-diff-internal t (vc-deduce-fileset t) nil nil - (called-interactively-p 'interactive)))) + (vc-maybe-buffer-sync not-urgent) + (let ((fileset (vc-deduce-fileset t))) + (vc-buffer-sync-fileset fileset not-urgent) + (vc-diff-internal t fileset nil nil + (called-interactively-p 'interactive))))) + +(defun vc-buffer-sync-fileset (fileset not-urgent) + (dolist (filename (cadr fileset)) + (when-let ((buffer (find-buffer-visiting filename))) + (with-current-buffer buffer + (vc-buffer-sync not-urgent))))) ;;;###autoload (defun vc-diff-mergebase (_files rev1 rev2) @@ -1974,7 +2006,7 @@ saving the buffer." (interactive (list current-prefix-arg t)) (if historic (call-interactively 'vc-version-ediff) - (when buffer-file-name (vc-buffer-sync not-urgent)) + (vc-maybe-buffer-sync not-urgent) (vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil))) ;;;###autoload @@ -1991,7 +2023,7 @@ saving the buffer." (if historic ;; We want the diff for the VC root dir. (call-interactively 'vc-root-version-diff) - (when buffer-file-name (vc-buffer-sync not-urgent)) + (vc-maybe-buffer-sync not-urgent) (let ((backend (vc-deduce-backend)) (default-directory default-directory) rootdir working-revision) @@ -2031,16 +2063,17 @@ Return nil if the root directory cannot be identified." If the current file is named `F', the revision is named `F.~REV~'. If `F.~REV~' already exists, use it instead of checking it out again." (interactive - (save-current-buffer + (with-current-buffer (or (buffer-base-buffer) (current-buffer)) (vc-ensure-vc-buffer) (list (vc-read-revision "Revision to visit (default is working revision): " (list buffer-file-name))))) + (set-buffer (or (buffer-base-buffer) (current-buffer))) (vc-ensure-vc-buffer) (let* ((file buffer-file-name) (revision (if (string-equal rev "") - (vc-working-revision file) - rev))) + (vc-working-revision file) + rev))) (switch-to-buffer-other-window (vc-find-revision file revision)))) (defun vc-find-revision (file revision &optional backend) diff --git a/lisp/wdired.el b/lisp/wdired.el index 6defbf8bc86..bb32da3e3a2 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -255,7 +255,7 @@ See `wdired-mode'." (setq buffer-read-only nil) (dired-unadvertise default-directory) (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t) - (add-hook 'after-change-functions 'wdired--restore-dired-filename-prop nil t) + (add-hook 'after-change-functions 'wdired--restore-properties nil t) (setq major-mode 'wdired-mode) (setq mode-name "Editable Dired") (setq revert-buffer-function 'wdired-revert) @@ -266,7 +266,7 @@ See `wdired-mode'." (wdired-preprocess-files) (if wdired-allow-to-change-permissions (wdired-preprocess-perms)) - (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link)) + (if (fboundp 'make-symbolic-link) (wdired-preprocess-symlinks)) (buffer-enable-undo) ; Performance hack. See above. (set-buffer-modified-p nil) @@ -288,6 +288,7 @@ or \\[wdired-abort-changes] to abort changes"))) (save-excursion (goto-char (point-min)) (let ((b-protection (point)) + (used-F (dired-check-switches dired-actual-switches "F" "classify")) filename) (while (not (eobp)) (setq filename (dired-get-filename nil t)) @@ -299,8 +300,16 @@ or \\[wdired-abort-changes] to abort changes"))) (add-text-properties (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only))) (put-text-property b-protection (point) 'read-only t) - (setq b-protection (dired-move-to-end-of-filename t)) + (dired-move-to-end-of-filename t) (put-text-property (point) (1+ (point)) 'end-name t)) + (when (and used-F (looking-at "[*/@|=>]$")) (forward-char)) + (when (save-excursion + (and (re-search-backward + dired-permission-flags-regexp nil t) + (looking-at "l") + (search-forward " -> " (line-end-position) t))) + (goto-char (line-end-position))) + (setq b-protection (point)) (forward-line)) (put-text-property b-protection (point-max) 'read-only t)))) @@ -327,7 +336,8 @@ relies on WDired buffer's properties. Optional arg NO-DIR with value non-nil means don't include directory. Optional arg OLD with value non-nil means return old filename." ;; FIXME: Use dired-get-filename's new properties. - (let (beg end file) + (let ((used-F (dired-check-switches dired-actual-switches "F" "classify")) + beg end file) (save-excursion (setq end (line-end-position)) (beginning-of-line) @@ -339,12 +349,25 @@ non-nil means return old filename." ;; the filename end is found even when the filename is empty. ;; Fixes error and spurious newlines when marking files for ;; deletion. - (setq end (next-single-property-change beg 'end-name)) + (setq end (next-single-property-change beg 'end-name nil end)) + (when (save-excursion + (and (re-search-forward + dired-permission-flags-regexp nil t) + (goto-char (match-beginning 0)) + (looking-at "l") + (search-forward " -> " (line-end-position) t))) + (goto-char (match-beginning 0)) + (setq end (point))) + (when (and used-F + (save-excursion + (goto-char end) + (looking-back "[*/@|=>]$" (1- (point))))) + (setq end (1- end))) (setq file (buffer-substring-no-properties (1+ beg) end))) ;; Don't unquote the old name, it wasn't quoted in the first place (and file (setq file (wdired-normalize-filename file (not old))))) (if (or no-dir old) - file + (if no-dir (file-relative-name file) file) (and file (> (length file) 0) (concat (dired-current-directory) file)))))) @@ -366,7 +389,7 @@ non-nil means return old filename." (setq mode-name "Dired") (dired-advertise) (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) - (remove-hook 'after-change-functions 'wdired--restore-dired-filename-prop t) + (remove-hook 'after-change-functions 'wdired--restore-properties t) (set (make-local-variable 'revert-buffer-function) 'dired-revert)) @@ -427,9 +450,9 @@ non-nil means return old filename." (when files-renamed (setq errors (+ errors (wdired-do-renames files-renamed)))) ;; We have to be in wdired-mode when wdired-do-renames is executed - ;; so that wdired--restore-dired-filename-prop runs, but we have - ;; to change back to dired-mode before reverting the buffer to - ;; avoid using wdired-revert, which changes back to wdired-mode. + ;; so that wdired--restore-properties runs, but we have to change + ;; back to dired-mode before reverting the buffer to avoid using + ;; wdired-revert, which changes back to wdired-mode. (wdired-change-to-dired-mode) (if changes (progn @@ -451,11 +474,15 @@ non-nil means return old filename." '(old-name nil end-name nil old-link nil end-link nil end-perm nil old-perm nil perm-changed nil)) - (message "(No changes to be performed)"))) + (message "(No changes to be performed)") + ;; Deleting file indicator characters or editing the symlink + ;; arrow in WDired are noops, so redisplay them immediately on + ;; returning to Dired. + (revert-buffer))) (when files-deleted (wdired-flag-for-deletion files-deleted)) (when (> errors 0) - (dired-log-summary (format "%d rename actions failed" errors) nil))) + (dired-log-summary (format "%d actions failed" errors) nil))) (set-buffer-modified-p nil) (setq buffer-undo-list nil)) @@ -609,14 +636,24 @@ Optional arguments are ignored." ;; dired-filename text property, which allows functions that look for ;; this property (e.g. dired-isearch-filenames) to work in wdired-mode ;; and also avoids an error with non-nil wdired-use-interactive-rename -;; (bug#32173). -(defun wdired--restore-dired-filename-prop (beg end _len) +;; (bug#32173). Also prevents editing the symlink arrow (which is a +;; noop) from corrupting the link name (see bug#18475 for elaboration). +(defun wdired--restore-properties (beg end _len) (save-match-data (save-excursion (let ((lep (line-end-position)) (used-F (dired-check-switches dired-actual-switches "F" "classify"))) + ;; Deleting the space between the link name and the arrow (a + ;; noop) also deletes the end-name property, so restore it. + (when (and (save-excursion + (re-search-backward dired-permission-flags-regexp nil t) + (looking-at "l")) + (get-text-property (1- (point)) 'dired-filename) + (not (get-text-property (point) 'dired-filename)) + (not (get-text-property (point) 'end-name))) + (put-text-property (point) (1+ (point)) 'end-name t)) (beginning-of-line) (when (re-search-forward directory-listing-before-filename-regexp lep t) @@ -680,33 +717,36 @@ says how many lines to move; default is one line." (save-excursion (goto-char (point-min)) (while (not (eobp)) - (if (looking-at dired-re-sym) - (progn - (re-search-forward " -> \\(.*\\)$") - (put-text-property (- (match-beginning 1) 2) - (1- (match-beginning 1)) 'old-link - (match-string-no-properties 1)) - (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t) - (put-text-property (1- (match-beginning 1)) - (match-beginning 1) - 'rear-nonsticky '(read-only)) - (put-text-property (match-beginning 1) - (match-end 1) 'read-only nil))) + (when (looking-at dired-re-sym) + (re-search-forward " -> \\(.*\\)$") + (put-text-property (1- (match-beginning 1)) + (match-beginning 1) 'old-link + (match-string-no-properties 1)) + (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t) + (unless wdired-allow-to-redirect-links + (put-text-property (match-beginning 0) + (match-end 1) 'read-only t))) (forward-line))))) - (defun wdired-get-previous-link (&optional old move) "Return the next symlink target. If OLD, return the old target. If MOVE, move point before it." (let (beg end target) (setq beg (previous-single-property-change (point) 'old-link nil)) - (if beg - (progn - (if old - (setq target (get-text-property (1- beg) 'old-link)) - (setq end (next-single-property-change beg 'end-link)) - (setq target (buffer-substring-no-properties (1+ beg) end))) - (if move (goto-char (1- beg))))) + (when beg + (when (save-excursion + (goto-char beg) + (and (looking-at " ") + (looking-back " ->" (line-beginning-position)))) + (setq beg (1+ beg))) + (if old + (setq target (get-text-property (1- beg) 'old-link)) + (setq end (save-excursion + (goto-char beg) + (next-single-property-change beg 'end-link nil + (line-end-position)))) + (setq target (buffer-substring-no-properties beg end))) + (if move (goto-char (1- beg)))) (and target (wdired-normalize-filename target t)))) (declare-function make-symbolic-link "fileio.c") @@ -871,26 +911,26 @@ Like original function but it skips read-only words." (mouse-set-point event) (wdired-toggle-bit)) -;; Allowed chars for 4000 bit are Ss in position 3 -;; Allowed chars for 2000 bit are Ssl in position 6 -;; Allowed chars for 1000 bit are Tt in position 9 +;; Allowed chars for #o4000 bit are Ss in position 3 +;; Allowed chars for #o2000 bit are Ssl in position 6 +;; Allowed chars for #o1000 bit are Tt in position 9 (defun wdired-perms-to-number (perms) - (let ((nperm 0777)) - (if (= (elt perms 1) ?-) (setq nperm (- nperm 400))) - (if (= (elt perms 2) ?-) (setq nperm (- nperm 200))) + (let ((nperm #o0777)) + (if (= (elt perms 1) ?-) (setq nperm (- nperm #o400))) + (if (= (elt perms 2) ?-) (setq nperm (- nperm #o200))) (let ((p-bit (elt perms 3))) - (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100))) - (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000)))) - (if (= (elt perms 4) ?-) (setq nperm (- nperm 40))) - (if (= (elt perms 5) ?-) (setq nperm (- nperm 20))) + (if (memq p-bit '(?- ?S)) (setq nperm (- nperm #o100))) + (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm #o4000)))) + (if (= (elt perms 4) ?-) (setq nperm (- nperm #o40))) + (if (= (elt perms 5) ?-) (setq nperm (- nperm #o20))) (let ((p-bit (elt perms 6))) - (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10))) - (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000)))) + (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm #o10))) + (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm #o2000)))) (if (= (elt perms 7) ?-) (setq nperm (- nperm 4))) (if (= (elt perms 8) ?-) (setq nperm (- nperm 2))) (let ((p-bit (elt perms 9))) (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1))) - (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000)))) + (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm #o1000)))) nperm)) ;; Perform the changes in the permissions of the files that have @@ -900,7 +940,7 @@ Like original function but it skips read-only words." (errors 0) (prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced) 'old-perm 'perm-changed)) - filename perms-ori perms-new perm-tmp) + filename perms-ori perms-new) (goto-char (next-single-property-change (point-min) prop-wanted nil (point-max))) (while (not (eobp)) @@ -911,14 +951,12 @@ Like original function but it skips read-only words." (setq changes t) (setq filename (wdired-get-filename nil t)) (if (= (length perms-new) 10) - (progn - (setq perm-tmp - (int-to-string (wdired-perms-to-number perms-new))) - (unless (equal 0 (process-file dired-chmod-program - nil nil nil perm-tmp filename)) - (setq errors (1+ errors)) - (dired-log "%s %s `%s' failed\n\n" - dired-chmod-program perm-tmp filename))) + (condition-case nil + (set-file-modes filename (wdired-perms-to-number perms-new)) + (error + (setq errors (1+ errors)) + (dired-log "Setting mode of `%s' to `%s' failed\n\n" + filename perms-new))) (setq errors (1+ errors)) (dired-log "Cannot parse permission `%s' for file `%s'\n\n" perms-new filename))) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 8a1bb8ade87..94ed6dc47fe 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -5,7 +5,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: data, wp ;; Version: 13.2.2 -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -445,6 +445,8 @@ See also `whitespace-display-mappings' for documentation." (const :tag "(Face) Lines" lines) (const :tag "(Face) Lines, only overlong part" lines-tail) (const :tag "(Face) NEWLINEs" newline) + (const :tag "(Face) Missing newlines at EOB" + missing-newline-at-eof) (const :tag "(Face) Empty Lines At BOB And/Or EOB" empty) (const :tag "(Face) Indentation SPACEs" indentation::tab) (const :tag "(Face) Indentation TABs" @@ -726,7 +728,7 @@ and the cons cdr is used for TABs visualization. Used when `whitespace-style' includes `indentation', `indentation::tab' or `indentation::space'." - :type '(cons (regexp :tag "Indentation SPACEs") + :type '(cons (string :tag "Indentation SPACEs") (regexp :tag "Indentation TABs")) :group 'whitespace) @@ -757,8 +759,8 @@ and the cons cdr is used for TABs visualization. Used when `whitespace-style' includes `space-after-tab', `space-after-tab::tab' or `space-after-tab::space'." - :type '(cons (regexp :tag "SPACEs After TAB") - regexp) + :type '(cons (string :tag "SPACEs After TAB") + string) :group 'whitespace) (defcustom whitespace-big-indent-regexp @@ -2471,7 +2473,8 @@ It should be added buffer-locally to `write-file-functions'." (provide 'whitespace) - +(make-obsolete-variable 'whitespace-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'whitespace-load-hook) diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index 097e769de8f..53f918cff9c 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -187,7 +187,7 @@ if that value is non-nil." (define-widget 'widget-browse 'push-button "Button for creating a widget browser. -The :value of the widget shuld be the widget to be browsed." +The :value of the widget should be the widget to be browsed." :format "%[[%v]%]" :value-create 'widget-browse-value-create :action 'widget-browse-action) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index e9799dc00fd..4e2cf7416d4 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -203,27 +203,100 @@ nil means read a single character." :group 'widgets :type 'boolean) +(defun widget--simplify-menu (extended) + "Convert the EXTENDED menu into a menu composed of simple menu items. + +Each item in the simplified menu is of the form (ITEM-STRING . REAL-BINDING), +where both elements are taken from the EXTENDED MENU. ITEM-STRING is the +correspondent ITEM-NAME in the menu-item entry: + (menu-item ITEM-NAME REAL-BINDING . ITEM-PROPERTY-LIST), and REAL-BINDING is +the symbol in the key vector, as in `define-key'. + (See `(elisp)Defining Menus' for more information.) + +Only visible, enabled and meaningful menu items make their way into +the returned simplified menu. That is: +For the menu item to be visible, it has to either lack a :visible form in its +item-property-list, or the :visible form has to evaluate to a non-nil value. +For the menu item to be enabled, it has to either lack a :enabled form in its +item-property-list, or the :enable form has to evaluate to a non-nil value. +Additionally, if the menu item is a radio button, then its selected form has +to evaluate to nil for the menu item to be meaningful." + (let (simplified) + (map-keymap (lambda (ev def) + (when (and (eq (nth 0 def) 'menu-item) + (nth 2 def)) ; Only menu-items with a real binding. + ;; Loop through the item-property-list, looking for + ;; :visible, :enable (or :active) and :button properties. + (let ((plist (nthcdr 3 def)) + (enable t) ; Enabled by default. + (visible t) ; Visible by default. + selected keyword value) + (while (and plist (cdr plist) + (keywordp (setq keyword (car plist)))) + (setq value (cadr plist)) + (cond ((memq keyword '(:visible :included)) + (setq visible value)) + ((memq keyword '(:enable :active)) + (setq enable value)) + ((and (eq keyword :button) + (eq (car value) :radio)) + (setq selected (cdr value)))) + (setq plist (cddr plist))) + (when (and (eval visible) + (eval enable) + (or (not selected) + (not (eval selected)))) + (push (cons (nth 1 def) ev) simplified))))) + extended) + (reverse simplified))) + (defun widget-choose (title items &optional event) "Choose an item from a list. First argument TITLE is the name of the list. -Second argument ITEMS is a list whose members are either +Second argument ITEMS should be a menu, either with simple item definitions, +or with extended item definitions. +When ITEMS has simple item definitions, it is a list whose members are either (NAME . VALUE), to indicate selectable items, or just strings to indicate unselectable items. + +When ITEMS is a menu that uses an extended format, then ITEMS should be a +keymap, and each binding should look like this: + (menu-item ITEM-NAME REAL-BINDING . ITEM-PROPERTY-LIST) +or like this: (menu-item ITEM-NAME) to indicate a non-selectable item. +REAL-BINDING should be a symbol, and should not be a keymap, because submenus +are not supported. + Optional third argument EVENT is an input event. -The user is asked to choose between each NAME from the items alist, -and the VALUE of the chosen element will be returned. If EVENT is a -mouse event, and the number of elements in items is less than +If EVENT is a mouse event, and the number of elements in items is less than `widget-menu-max-size', a popup menu will be used, otherwise the -minibuffer." +minibuffer. + +The user is asked to choose between each NAME from ITEMS. +If ITEMS has simple item definitions, then this function returns the VALUE of +the chosen element. If ITEMS is a keymap, then the return value is the symbol +in the key vector, as in the argument of `define-key'." (cond ((and (< (length items) widget-menu-max-size) event (display-popup-menus-p)) ;; Mouse click. - (x-popup-menu event - (list title (cons "" items)))) + (if (keymapp items) + ;; Modify the keymap prompt, and then restore the old one, if any. + (let ((prompt (keymap-prompt items))) + (unwind-protect + (progn + (setq items (delete prompt items)) + (push title (cdr items)) + ;; Return just the first element of the list of events. + (car (x-popup-menu event items))) + (setq items (delete title items)) + (when prompt + (push prompt (cdr items))))) + (x-popup-menu event (list title (cons "" items))))) ((or widget-menu-minibuffer-flag (> (length items) widget-menu-max-shortcuts)) + (when (keymapp items) + (setq items (widget--simplify-menu items))) ;; Read the choice of name from the minibuffer. (setq items (cl-remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) @@ -233,6 +306,8 @@ minibuffer." (setq val try)) (cdr (assoc val items)))))) (t + (when (keymapp items) + (setq items (widget--simplify-menu items))) ;; Construct a menu of the choices ;; and then use it for prompting for a single character. (let* ((next-digit ?0) @@ -303,12 +378,15 @@ the :notify function can't know the new value.") (or (not widget-field-add-space) (widget-get widget :size)))) (if (functionp help-echo) (setq help-echo 'widget-mouse-help)) - (when (= (char-before to) ?\n) + (when (and (or (> to (1+ from)) (null (widget-get widget :size))) + (= (char-before to) ?\n)) ;; When the last character in the field is a newline, we want to ;; give it a `field' char-property of `boundary', which helps the ;; C-n/C-p act more naturally when entering/leaving the field. We - ;; do this by making a small secondary overlay to contain just that - ;; one character. + ;; do this by making a small secondary overlay to contain just that + ;; one character. BUT we only do this if there is more than one + ;; character (so we don't do this for the character widget), + ;; or if the size of the editable field isn't specified. (let ((overlay (make-overlay (1- to) to nil t nil))) (overlay-put overlay 'field 'boundary) ;; We need the real field for tabbing. @@ -973,86 +1051,91 @@ Note that such modes will need to require wid-edit.") "If non-nil, `widget-button-click' moves point to a button after invoking it. If nil, point returns to its original position after invoking a button.") +(defun widget-button--check-and-call-button (event button) + "Call BUTTON if BUTTON is a widget and EVENT is correct for it. +If nothing was called, return non-nil." + (let* ((oevent event) + (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) + (pos (widget-event-point event)) + newpoint) + (catch 'button-press-cancelled + ;; Mouse click on a widget button. Do the following + ;; in a save-excursion so that the click on the button + ;; doesn't change point. + (save-selected-window + (select-window (posn-window (event-start event))) + (save-excursion + (goto-char (posn-point (event-start event))) + (let* ((overlay (widget-get button :button-overlay)) + (pressed-face (or (widget-get button :pressed-face) + widget-button-pressed-face)) + (face (overlay-get overlay 'face)) + (mouse-face (overlay-get overlay 'mouse-face))) + (unwind-protect + ;; Read events, including mouse-movement + ;; events, waiting for a release event. If we + ;; began with a mouse-1 event and receive a + ;; movement event, that means the user wants + ;; to perform drag-selection, so cancel the + ;; button press and do the default mouse-1 + ;; action. For mouse-2, just highlight/ + ;; unhighlight the button the mouse was + ;; initially on when we move over it. + (save-excursion + (when face ; avoid changing around image + (overlay-put overlay 'face pressed-face) + (overlay-put overlay 'mouse-face pressed-face)) + (unless (widget-apply button :mouse-down-action event) + (let ((track-mouse t)) + (while (not (widget-button-release-event-p event)) + (setq event (read-event)) + (when (and mouse-1 (mouse-movement-p event)) + (push event unread-command-events) + (setq event oevent) + (throw 'button-press-cancelled t)) + (unless (or (integerp event) + (memq (car event) + '(switch-frame select-window)) + (eq (car event) 'scroll-bar-movement)) + (setq pos (widget-event-point event)) + (if (and pos + (eq (get-char-property pos 'button) + button)) + (when face + (overlay-put overlay 'face pressed-face) + (overlay-put overlay 'mouse-face pressed-face)) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face)))))) + + ;; When mouse is released over the button, run + ;; its action function. + (when (and pos (eq (get-char-property pos 'button) button)) + (goto-char pos) + (widget-apply-action button event) + (if widget-button-click-moves-point + (setq newpoint (point))))) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face)))) + + (when newpoint + (goto-char newpoint))) + nil))) + (defun widget-button-click (event) "Invoke the button that the mouse is pointing at." (interactive "e") (if (widget-event-point event) - (let* ((oevent event) - (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) + (let* ((mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) (pos (widget-event-point event)) (start (event-start event)) - (button (get-char-property + (button (get-char-property pos 'button (and (windowp (posn-window start)) - (window-buffer (posn-window start))))) - newpoint) + (window-buffer (posn-window start)))))) + (when (or (null button) - (catch 'button-press-cancelled - ;; Mouse click on a widget button. Do the following - ;; in a save-excursion so that the click on the button - ;; doesn't change point. - (save-selected-window - (select-window (posn-window (event-start event))) - (save-excursion - (goto-char (posn-point (event-start event))) - (let* ((overlay (widget-get button :button-overlay)) - (pressed-face (or (widget-get button :pressed-face) - widget-button-pressed-face)) - (face (overlay-get overlay 'face)) - (mouse-face (overlay-get overlay 'mouse-face))) - (unwind-protect - ;; Read events, including mouse-movement - ;; events, waiting for a release event. If we - ;; began with a mouse-1 event and receive a - ;; movement event, that means the user wants - ;; to perform drag-selection, so cancel the - ;; button press and do the default mouse-1 - ;; action. For mouse-2, just highlight/ - ;; unhighlight the button the mouse was - ;; initially on when we move over it. - (save-excursion - (when face ; avoid changing around image - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (unless (widget-apply button :mouse-down-action event) - (let ((track-mouse t)) - (while (not (widget-button-release-event-p event)) - (setq event (read-event)) - (when (and mouse-1 (mouse-movement-p event)) - (push event unread-command-events) - (setq event oevent) - (throw 'button-press-cancelled t)) - (unless (or (integerp event) - (memq (car event) '(switch-frame select-window)) - (eq (car event) 'scroll-bar-movement)) - (setq pos (widget-event-point event)) - (if (and pos - (eq (get-char-property pos 'button) - button)) - (when face - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))))) - - ;; When mouse is released over the button, run - ;; its action function. - (when (and pos (eq (get-char-property pos 'button) button)) - (goto-char pos) - (widget-apply-action button event) - (if widget-button-click-moves-point - (setq newpoint (point))))) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))) - - (if newpoint (goto-char newpoint)) - ;; This loses if the widget action switches windows. -- cyd - ;; (unless (pos-visible-in-window-p (widget-event-point event)) - ;; (mouse-set-point event) - ;; (beginning-of-line) - ;; (recenter)) - ) - nil)) - (let ((up t) command) + (widget-button--check-and-call-button event button)) + (let ((up t) + command) ;; Mouse click not on a widget button. Find the global ;; command to run, and check whether it is bound to an ;; up event. @@ -1361,7 +1444,8 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." (signal 'text-read-only '("Attempt to change text outside editable field"))) (widget-field-use-before-change - (widget-apply from-field :notify from-field)))))) + (widget-apply from-field :notify + from-field (list 'before-change from to))))))) (defun widget-add-change () (remove-hook 'post-command-hook 'widget-add-change t) @@ -1398,7 +1482,7 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." (> (point) begin)) (delete-char -1))))))) (widget-specify-secret field)) - (widget-apply field :notify field)))) + (widget-apply field :notify field (list 'after-change from to))))) ;;; Widget Functions ;; @@ -1911,6 +1995,16 @@ If END is omitted, it defaults to the length of LIST." "Show the variable specified by WIDGET." (describe-variable (widget-value widget))) +;;; The `face-link' Widget. + +(define-widget 'face-link 'link + "A link to an Emacs face." + :action 'widget-face-link-action) + +(defun widget-face-link-action (widget &optional _event) + "Show the variable specified by WIDGET." + (describe-face (widget-value widget))) + ;;; The `file-link' Widget. (define-widget 'file-link 'link @@ -2627,7 +2721,10 @@ Return an alist of (TYPE MATCH)." (define-widget 'insert-button 'push-button "An insert button for the `editable-list' widget." :tag "INS" - :help-echo "Insert a new item into the list at this position." + :help-echo (lambda (widget) + (if (widget-get (widget-get widget :parent) :last-deleted) + "Insert back the last deleted item from this list, at this position." + "Insert a new item into the list at this position.")) :action 'widget-insert-button-action) (defun widget-insert-button-action (widget &optional _event) @@ -2640,7 +2737,7 @@ Return an alist of (TYPE MATCH)." (define-widget 'delete-button 'push-button "A delete button for the `editable-list' widget." :tag "DEL" - :help-echo "Delete this item from the list." + :help-echo "Delete this item from the list, saving it for later reinsertion." :action 'widget-delete-button-action) (defun widget-delete-button-action (widget &optional _event) @@ -2730,9 +2827,18 @@ Return an alist of (TYPE MATCH)." (cons found value))) (defun widget-editable-list-insert-before (widget before) - ;; Insert a new child in the list of children. + "Insert a new widget as a child of WIDGET. + +If there is a recently deleted child, the new widget is that deleted child. +Otherwise, the new widget is the default child of WIDGET. + +The new widget gets inserted at the position of the BEFORE child." (save-excursion (let ((children (widget-get widget :children)) + (last-deleted (when-let ((lst (widget-get widget :last-deleted))) + (prog1 + (pop lst) + (widget-put widget :last-deleted lst)))) (inhibit-read-only t) (inhibit-modification-hooks t)) (cond (before @@ -2740,7 +2846,11 @@ Return an alist of (TYPE MATCH)." (t (goto-char (widget-get widget :value-pos)))) (let ((child (widget-editable-list-entry-create - widget nil nil))) + widget (and last-deleted + (widget-apply last-deleted + :value-to-external + (widget-get last-deleted :value))) + last-deleted))) (when (< (widget-get child :entry-from) (widget-get widget :from)) (set-marker (widget-get widget :from) (widget-get child :entry-from))) @@ -2753,6 +2863,15 @@ Return an alist of (TYPE MATCH)." (widget-apply widget :notify widget)) (defun widget-editable-list-delete-at (widget child) + "Delete the widget CHILD from the known children of widget WIDGET. + +Save CHILD into the :last-deleted list, so it can be inserted later." + ;; Save the current value of CHILD, to use if the user later inserts the + ;; widget. + (widget-put child :value (widget-apply child :value-get)) + (let ((lst (widget-get widget :last-deleted))) + (push child lst) + (widget-put widget :last-deleted lst)) ;; Delete child from list of children. (save-excursion (let ((buttons (copy-sequence (widget-get widget :buttons))) @@ -3162,8 +3281,9 @@ It reads a file name from an editable text field." #'completion-file-name-table (not read-file-name-completion-ignore-case)) :match (lambda (widget value) - (or (not (widget-get widget :must-match)) - (file-exists-p value))) + (and (stringp value) + (or (not (widget-get widget :must-match)) + (file-exists-p value)))) :validate (lambda (widget) (let ((value (widget-value widget))) (unless (widget-apply widget :match value) @@ -3464,8 +3584,31 @@ To use this type, you must define :match or :match-alternatives." :match 'widget-restricted-sexp-match :value-to-internal (lambda (widget value) (if (widget-apply widget :match value) - (prin1-to-string value) - value))) + (widget-sexp-value-to-internal widget value) + value)) + :value-to-external (lambda (widget value) + ;; We expect VALUE to be a string, so we can convert it + ;; into the external format just by `read'ing it. + ;; But for a restricted-sexp widget with a bad default + ;; value, we might end up calling read with a nil + ;; argument, resulting in an undesired prompt to the + ;; user. A bad default value is not always a big + ;; problem, but might end up in a messed up buffer, + ;; so display a warning here. (Bug#25152) + (unless (stringp value) + (display-warning + 'widget-bad-default-value + (format-message + "\nA widget of type %S has a bad default value. +value: %S +match function: %S +match-alternatives: %S" + (widget-type widget) + value + (widget-get widget :match) + (widget-get widget :match-alternatives)) + :warning)) + (read value))) (defun widget-restricted-sexp-match (widget value) (let ((alternatives (widget-get widget :match-alternatives)) @@ -3507,19 +3650,76 @@ To use this type, you must define :match or :match-alternatives." :value 0 :size 1 :format "%{%t%}: %v\n" - :valid-regexp "\\`.\\'" + :valid-regexp "\\`\\(.\\|\n\\)\\'" :error "This field should contain a single character" :value-get (lambda (w) (widget-field-value-get w t)) :value-to-internal (lambda (_widget value) (if (stringp value) value - (char-to-string value))) + (let ((disp + (widget-character--change-character-display + value))) + (if disp + (propertize (char-to-string value) 'display disp) + (char-to-string value))))) :value-to-external (lambda (_widget value) (if (stringp value) (aref value 0) value)) :match (lambda (_widget value) - (characterp value))) + (characterp value)) + :notify #'widget-character-notify) + +;; Only some escape sequences, not all of them. (Bug#15925) +(defvar widget-character--escape-sequences-alist + '((?\t . ?t) + (?\n . ?n) + (?\s . ?s)) + "Alist that associates escape sequences to a character. +Each element has the form (ESCAPE-SEQUENCE . CHARACTER). + +The character widget uses this alist to display the +non-printable character represented by ESCAPE-SEQUENCE as \\CHARACTER, +since that makes it easier to see what's in the widget.") + +(defun widget-character--change-character-display (c) + "Return a string to represent the character C, or nil. + +The character widget represents some characters (e.g., the newline character +or the tab character) specially, to make it easier for the user to see what's +in it. For those characters, return a string to display that character in a +more user-friendly way. + +For the caller, nil should mean that it is good enough to use the return value +of `char-to-string' for the representation of C." + (let ((char (alist-get c widget-character--escape-sequences-alist))) + (and char (propertize (format "\\%c" char) 'face 'escape-glyph)))) + +(defun widget-character-notify (widget child &optional event) + "Notify function for the character widget. + +This function allows the widget character to better display some characters, +like the newline character or the tab character." + (when (eq (car-safe event) 'after-change) + (let* ((start (nth 1 event)) + (end (nth 2 event)) + str) + (if (eql start end) + (when (char-equal (widget-value widget) ?\s) + ;; The character widget is not really empty: + ;; its value is a single space character. + ;; We need to propertize it again, if it became empty for a while. + (let ((ov (widget-get widget :field-overlay))) + (put-text-property + (overlay-start ov) (overlay-end ov) + 'display (widget-character--change-character-display ?\s)))) + (setq str (buffer-substring-no-properties start end)) + ;; This assumes the user enters one character at a time, + ;; and does nothing crazy, like yanking a long string. + (let ((disp (widget-character--change-character-display (aref str 0)))) + (when disp + (put-text-property start end 'display disp)))))) + (widget-default-notify widget child event)) (define-widget 'list 'group "A Lisp list." diff --git a/lisp/window.el b/lisp/window.el index bb34a6d7b4c..865f6fdd5cc 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2172,7 +2172,8 @@ the font." (with-selected-window (window-normalize-window window t) (let* ((window-width (window-body-width window t)) (font-width (window-font-width window face)) - (ncols (/ window-width font-width))) + (ncols (- (/ window-width font-width) + (ceiling (line-number-display-width 'columns))))) (if (and (display-graphic-p) overflow-newline-into-fringe (not @@ -3431,7 +3432,7 @@ routines." "Resize minibuffer-only frame FRAME." (if (functionp resize-mini-frames) (funcall resize-mini-frames frame) - (fit-frame-to-buffer frame))) + (fit-mini-frame-to-buffer frame))) (defun window--sanitize-window-sizes (horizontal) "Assert that all windows on selected frame are large enough. @@ -5479,7 +5480,7 @@ frame. The selected window is not changed by this function." (set-window-parameter (window-parent new) 'window-side window-side)))) ((eq window-combination-resize 'atom) - ;; Make sure `window--check-frame' won't destroy an existing + ;; Make sure `window--check' won't destroy an existing ;; atomic window in case the new window gets nested inside. (unless (window-parameter window 'window-atom) (set-window-parameter window 'window-atom t)) @@ -7711,7 +7712,7 @@ indirectly called by the latter." (with-current-buffer (window-buffer window) (cond ((memq major-mode allowed-modes) 'same) - ((derived-mode-p allowed-modes) + ((apply #'derived-mode-p allowed-modes) 'derived))))) (when (and mode? (not (and inhibit-same-window-p @@ -8924,6 +8925,14 @@ Return 0 otherwise." (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) +(defun fit-mini-frame-to-buffer (&optional frame) + "Adjust size of minibuffer FRAME to display its contents. +FRAME should be a minibuffer-only frame and defaults to the +selected one. Unlike `fit-frame-to-buffer' FRAME will fit to the +contents of its buffer with any leading or trailing empty lines +included." + (fit-frame-to-buffer-1 frame)) + (defun fit-frame-to-buffer (&optional frame max-height min-height max-width min-width only) "Adjust size of FRAME to display the contents of its buffer exactly. FRAME can be any live frame and defaults to the selected one. @@ -8942,8 +8951,18 @@ horizontally only. The new position and size of FRAME can be additionally determined by customizing the options `fit-frame-to-buffer-sizes' and `fit-frame-to-buffer-margins' or setting the corresponding -parameters of FRAME." +parameters of FRAME. + +Any leading or trailing empty lines of the buffer content are not +considered." (interactive) + (fit-frame-to-buffer-1 frame max-height min-height max-width min-width only t t)) + +(defun fit-frame-to-buffer-1 (&optional frame max-height min-height max-width min-width only from to) + "Helper function for `fit-frame-to-buffer'. +FROM and TO are the buffer positions to determine the size to fit +to, see `window-text-pixel-size'. The remaining arguments are as +for `fit-frame-to-buffer'." (unless (fboundp 'display-monitor-attributes-list) (user-error "Cannot resize frame in non-graphic Emacs")) (setq frame (window-normalize-frame frame)) @@ -9078,7 +9097,7 @@ parameters of FRAME." ;; Note: Currently, for a new frame the sizes of the header ;; and mode line may be estimated incorrectly (size - (window-text-pixel-size window t t max-width max-height)) + (window-text-pixel-size window from to max-width max-height)) (width (max (car size) min-width)) (height (max (cdr size) min-height))) ;; Don't change height or width when the window's size is fixed @@ -10184,4 +10203,6 @@ 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) +(provide 'window) + ;;; window.el ends here diff --git a/lisp/woman.el b/lisp/woman.el index eeacceadc27..96ae7fe5794 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2289,6 +2289,12 @@ Currently set only from \\='\\\" t in the first line of the source file.") (setq fill-column woman-fill-column tab-width woman-tab-width) + ;; Ignore the \, and \/ kerning operators. See + ;; https://www.gnu.org/software/groff/manual/groff.html#Ligatures-and-Kerning + (goto-char (point-min)) + (while (re-search-forward "\\\\[,/]" nil t) + (replace-match "" t t)) + ;; Hide unpaddable and digit-width spaces \(space) and \0: (goto-char from) (while (re-search-forward "\\\\[ 0]" nil t) diff --git a/lisp/xml.el b/lisp/xml.el index 10ef8e2087a..c96ff80446a 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -655,7 +655,7 @@ Leave point at the first non-blank character after the tag." (setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns)) (goto-char end-pos) - ;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize + ;; See also: https://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize ;; Do we have a string between quotes (or double-quotes), ;; or a simple word ? @@ -1015,7 +1015,10 @@ The first line is indented with the optional INDENT-STRING." (defalias 'xml-print 'xml-debug-print) -(defun xml-escape-string (string) +(defconst xml-invalid-characters-re + "[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]") + +(defun xml-escape-string (string &optional noerror) "Convert STRING into a string containing valid XML character data. Replace occurrences of &<>\\='\" in STRING with their default XML entity references (e.g., replace each & with &). @@ -1026,15 +1029,17 @@ restriction on \" or \\=', but we just substitute for these too \(as is permitted by the spec). If STRING contains characters that are invalid in XML (as defined -by https://www.w3.org/TR/xml/#charsets), signal an error of type -`xml-invalid-character'." +by https://www.w3.org/TR/xml/#charsets), operate depending on the +value of NOERROR: if it is non-nil, remove them; else, signal an +error of type `xml-invalid-character'." (with-temp-buffer (insert string) (goto-char (point-min)) - (when (re-search-forward - "[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]" - nil t) - (signal 'xml-invalid-character (list (char-before) (match-beginning 0)))) + (while (re-search-forward xml-invalid-characters-re nil t) + (if noerror + (replace-match "") + (signal 'xml-invalid-character + (list (char-before) (match-beginning 0))))) (dolist (substitution '(("&" . "&") ("<" . "<") (">" . ">") diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 2b9fab556e0..f9c08f9a174 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -76,7 +76,11 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." ;; to guard against that. (copy-sequence event)) vec) - (is-move vec) + (is-move + (if track-mouse vec + ;; Mouse movement events are currently supposed to be + ;; suppressed. Return no event. + [])) (t (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) (down-data (nth 1 down)) @@ -237,7 +241,10 @@ which is the \"1006\" extension implemented in Xterm >= 277." (xterm-mouse--read-event-sequence extension)) (t (error "Unsupported XTerm mouse protocol"))))) - (when click + (when (and click + ;; In very obscure circumstances, the click may become + ;; invalid (see bug#17378). + (>= (nth 1 click) 0)) (let* ((type (nth 0 click)) (x (nth 1 click)) (y (nth 2 click)) @@ -260,7 +267,7 @@ which is the \"1006\" extension implemented in Xterm >= 277." (eq y 1))) 'tab-bar 'menu-bar)) - (nthcdr 2 (posn-at-x-y x y))))) + (nthcdr 2 (posn-at-x-y x y (selected-frame)))))) (event (list type posn))) (setcar (nthcdr 3 posn) timestamp) @@ -318,11 +325,13 @@ down the SHIFT key while pressing the mouse button." (if xterm-mouse-mode ;; Turn it on (progn - (setq mouse-position-function #'xterm-mouse-position-function) + (setq mouse-position-function #'xterm-mouse-position-function + tty-menu-calls-mouse-position-function t) (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list))) ;; Turn it off (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list)) - (setq mouse-position-function nil))) + (setq mouse-position-function nil + tty-menu-calls-mouse-position-function nil))) (defun xterm-mouse-tracking-enable-sequence () "Return a control sequence to enable XTerm mouse tracking. @@ -336,8 +345,8 @@ modern xterms: position (<= 223), which can be reported in this basic mode. -\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse - motion events during dragging operations. +\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse + motion events. \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension to the basic mouse mode, which uses UTF-8 @@ -357,7 +366,7 @@ given escape sequence takes precedence over the former." (apply #'concat (xterm-mouse--tracking-sequence ?h))) (defconst xterm-mouse-tracking-enable-sequence - "\e[?1000h\e[?1002h\e[?1005h\e[?1006h" + "\e[?1000h\e[?1003h\e[?1005h\e[?1006h" "Control sequence to enable xterm mouse tracking. Enables basic mouse tracking, mouse motion events and finally extended tracking on terminals that support it. The following @@ -368,8 +377,8 @@ escape sequences are understood by modern xterms: position (<= 223), which can be reported in this basic mode. -\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse - motion events during dragging operations. +\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse + motion events. \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension to the basic mouse mode, which uses UTF-8 @@ -397,7 +406,7 @@ The control sequence resets the modes set by (apply #'concat (nreverse (xterm-mouse--tracking-sequence ?l)))) (defconst xterm-mouse-tracking-disable-sequence - "\e[?1006l\e[?1005l\e[?1002l\e[?1000l" + "\e[?1006l\e[?1005l\e[?1003l\e[?1000l" "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.") (make-obsolete-variable @@ -411,7 +420,7 @@ SUFFIX is the last character of each escape sequence (?h to enable, ?l to disable)." (mapcar (lambda (code) (format "\e[?%d%c" code suffix)) - `(1000 1002 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) + `(1000 1003 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal) "Enable xterm mouse tracking on TERMINAL." diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 074320855c5..caf57ae43fe 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -217,7 +217,7 @@ If N is omitted or nil, scroll down by one line." (defun xwidget-webkit-scroll-forward (&optional n) "Scroll webkit horizontally by N chars. The width of char is calculated with `window-font-width'. -If N is ommited or nil, scroll forwards by one char." +If N is omitted or nil, scroll forwards by one char." (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) @@ -227,7 +227,7 @@ If N is ommited or nil, scroll forwards by one char." (defun xwidget-webkit-scroll-backward (&optional n) "Scroll webkit back by N chars. The width of char is calculated with `window-font-width'. -If N is ommited or nil, scroll backwards by one char." +If N is omitted or nil, scroll backwards by one char." (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) @@ -318,7 +318,7 @@ If non-nil, plugins are enabled. Otherwise, disabled.")) (defcustom xwidget-webkit-download-dir "~/Downloads/" "Directory where download file saved." - :version "27.1" + :version "28.1" :type 'file) (defun xwidget-webkit-save-as-file (url mime-type file-name) @@ -348,7 +348,7 @@ If non-nil, use a new xwidget webkit session after bookmark jump. Otherwise, it will use `xwidget-webkit-last-session'. When you set this variable to nil, consider further customization with `xwidget-webkit-last-session-buffer'." - :version "27.1" + :version "28.1" :type 'boolean) (defun xwidget-webkit-bookmark-make-record () diff --git a/m4/pkg.m4 b/m4/pkg.m4 index 13a88901786..f9075e56c87 100644 --- a/m4/pkg.m4 +++ b/m4/pkg.m4 @@ -86,7 +86,7 @@ dnl Check to see whether a particular set of modules exists. Similar to dnl PKG_CHECK_MODULES(), but does not set variables or print errors. dnl dnl Please remember that m4 expands AC_REQUIRE([PKG_PROG_PKG_CONFIG]) -dnl only at the first occurence in configure.ac, so if the first place +dnl only at the first occurrence in configure.ac, so if the first place dnl it's called might be skipped (such as if it is within an "if", you dnl have to call PKG_CHECK_EXISTS manually AC_DEFUN([PKG_CHECK_EXISTS], diff --git a/make-dist b/make-dist index 6901a4cfa1c..de4f343ddd4 100755 --- a/make-dist +++ b/make-dist @@ -110,7 +110,7 @@ while [ $# -gt 0 ]; do ;; ## Include the test/ directory. - ## This is for backward compability to when --no-tests was the default. + ## This is for backward compatibility to when --no-tests was the default. "--tests") with_tests=yes ;; diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in index be1a84faa66..42a4656f9d5 100644 --- a/msdos/autogen/Makefile.in +++ b/msdos/autogen/Makefile.in @@ -26,7 +26,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see <http://www.gnu.org/licenses/>. +# along with this file. If not, see <https://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that @@ -49,7 +49,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see <http://www.gnu.org/licenses/>. +# along with this file. If not, see <https://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that diff --git a/msdos/autogen/config.in b/msdos/autogen/config.in index 6101abd1fa6..6475d99d6f1 100644 --- a/msdos/autogen/config.in +++ b/msdos/autogen/config.in @@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */ +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* No code in Emacs #includes config.h twice, but some bits of code diff --git a/nextstep/ChangeLog.1 b/nextstep/ChangeLog.1 index 463705a66a8..5d866e6e274 100644 --- a/nextstep/ChangeLog.1 +++ b/nextstep/ChangeLog.1 @@ -14,7 +14,7 @@ 2014-11-03 Jan Djärv <jan.h.d@swipnet.se> - * INSTALL: Remove univeral binary section. + * INSTALL: Remove universal binary section. 2014-10-20 Glenn Morris <rgm@gnu.org> diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index c3d4dfa4c28..0a0e0330a24 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -22,7 +22,7 @@ MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit Windows -- it's located at http://mingw-w64.org/. MSYS2 is a Cygwin-derived software distribution for Windows which provides -build tools for MinGW-w64 -- see http://msys2.github.io/. +build tools for MinGW-w64 -- see https://msys2.github.io/. ** Download and install MinGW-w64 and MSYS2 diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 4cbae16dc5a..2c754f93e8f 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -39,6 +39,32 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # undef __POSIX_2008_DEPRECATED # define __POSIX_2008_DEPRECATED # endif +/* Old versions of MinGW don't have these in the w32api headers, and + Gnulib uses them in some files. */ +# ifndef _WIN32_WINNT_WIN2K +# define _WIN32_WINNT_WIN2K 0x0500 +# endif +# ifndef _WIN32_WINNT_WINXP +# define _WIN32_WINNT_WINXP 0x0501 +# endif +# ifndef _WIN32_WINNT_WS03 +# define _WIN32_WINNT_WS03 0x0502 +# endif +# ifndef _WIN32_WINNT_VISTA +# define _WIN32_WINNT_VISTA 0x0600 +# endif +# ifndef _WIN32_WINNT_WIN7 +# define _WIN32_WINNT_WIN7 0x0601 +# endif +# ifndef _WIN32_WINNT_WIN8 +# define _WIN32_WINNT_WIN8 0x0602 +# endif +# ifndef _WIN32_WINNT_WINBLUE +# define _WIN32_WINNT_WINBLUE 0x0603 +# endif +# ifndef _WIN32_WINNT_WIN10 +# define _WIN32_WINNT_WIN10 0x0A00 +# endif #endif /* #undef const */ diff --git a/src/ChangeLog.10 b/src/ChangeLog.10 index 1c954b20eec..fbbd3608909 100644 --- a/src/ChangeLog.10 +++ b/src/ChangeLog.10 @@ -9344,7 +9344,7 @@ * dispextern.h (struct glyph_row): New member overlay_arrow_bitmap. It replaces the corresponding member from struct window, as a window may now show multiple overlay arrows. - Remove member overlay_arrow_p, superseeded by overlay_arrow_bitmap. + Remove member overlay_arrow_p, superseded by overlay_arrow_bitmap. * dispnew.c (row_equal_p, update_window_line, scrolling_window): Compare overlay_arrow_bitmap than overlay_arrow_p members. @@ -11141,7 +11141,7 @@ * eval.c (Fdefun, Fdefmacro): Use (defun . FN_NAME) in LOADHIST_ATTACH. (Fdefvaralias, Fdefvar, Fdefconst): Use just SYM in LOADHIST_ATTACH. (Qdefvar): Var deleted. - (syms_of_eval): Don't initialze it. + (syms_of_eval): Don't initialize it. * lread.c (syms_of_lread) <load-history>: Doc fix. @@ -18716,7 +18716,7 @@ and line_height, and use corresponding new members in struct frame. All uses changed. (FRAME_LINE_HEIGHT, FRAME_INTERNAL_BORDER_WIDTH): Remove macros; - superseeded by corresponding macros in frame.h. + superseded by corresponding macros in frame.h. * msdos.c: Make (several) trivial substitutions for renamed and new macros in dispextern.h, frame.h and window.h. @@ -19145,7 +19145,7 @@ (syms_of_xfaces): Declare Vface_font_rescale_alist as a Lisp variable. * lread.c (read1): Before calling index, check if the 2nd - arguemnt is in ASCII range. + argument is in ASCII range. 2003-04-08 Richard M. Stallman <rms@gnu.org> @@ -19945,7 +19945,7 @@ 2003-03-09 David Kastrup <dak@gnu.org> * process.c (read_process_output): We have allocated enough space - for readmax and carryover, so actually use the alloted space. + for readmax and carryover, so actually use the allotted space. 2003-03-09 Jan Djärv <jan.h.d@swipnet.se> @@ -24638,7 +24638,7 @@ * w32gui.h (struct XImage): Define. * w32term.c (w32_read_socket) <WM_XBUTTONUP>: Use XFASTINT to - extract mouse co-ordinates. + extract mouse coordinates. 2002-03-20 Jason Rumney <jasonr@gnu.org> @@ -25377,7 +25377,7 @@ Handle literal output of strings by sharing the main-line code for strings, using local var `literal'. Handle :propertize feature. - (syms_of_xdisp): Initialze and staticpro QCpropertize and + (syms_of_xdisp): Initialize and staticpro QCpropertize and mode_line_proptrans_alist. 2002-02-11 Kim F. Storm <storm@cua.dk> diff --git a/src/ChangeLog.11 b/src/ChangeLog.11 index 2942d35561a..cf9e87a6a80 100644 --- a/src/ChangeLog.11 +++ b/src/ChangeLog.11 @@ -947,7 +947,7 @@ (c_string_pos, number_of_chars, message_dolog): (message_log_check_duplicate, set_message_1, store_mode_line_noprop): (display_mode_element, display_string): - Switch between char * and unsigned char * to stay compatible wth + Switch between char * and unsigned char * to stay compatible with C89 pointer rules. * regex.c: Conform to C89 pointer rules. @@ -9492,7 +9492,7 @@ * coding.c (decode_coding_ccl): Fix previous change for the multibyte case. (encode_coding_ccl): Don't setup ccl program here. Fix for the - case that the output buffer is fullfilled. + case that the output buffer is fulfilled. (encode_coding): Setup ccl program here. 2010-03-23 Dan Nicolaescu <dann@ics.uci.edu> @@ -9772,10 +9772,10 @@ 2010-02-17 Kenichi Handa <handa@m17n.org> * coding.c (decode_coding_ccl): Don't setup ccl program here. - Fix for the case that the output buffer is fullfilled. + Fix for the case that the output buffer is fulfilled. (decode_coding): Setup ccl program here. Keep looping when the decoder stopped because the output buffer is - fullfilled (bug#5534). + fulfilled (bug#5534). * ccl.c (ccl_driver): Never reset ic to CCL_HEADER_MAIN. @@ -10126,7 +10126,7 @@ 2010-01-06 Jan Djärv <jan.h.d@swipnet.se> - * font.c (font_open_entity): Enable chache and call cached_font_ok + * font.c (font_open_entity): Enable cache and call cached_font_ok for the driver if defined. (QCuser_spec): New symbol. (font_spec_from_name): Save name as user-spec. @@ -23923,7 +23923,7 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * alloc.c (NSTATICS): Increas to 0x600. + * alloc.c (NSTATICS): Increase to 0x600. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -25309,12 +25309,12 @@ * coding.c (enum iso_code_class_type): Delete ISO_carriage_return. (CODING_GET_INFO): Delete argument eol_type. Change callers. - (decode_coding_utf_8): Don't do eol converion. + (decode_coding_utf_8): Don't do eol conversion. (detect_coding_utf_16): Check coding->src_chars, not coding->src_bytes. Add heuristics for those that have no signature. (decode_coding_emacs_mule, decode_coding_iso_2022) (decode_coding_sjis, decode_coding_big5, decode_coding_charset): - Don't do eol converion. + Don't do eol conversion. (adjust_coding_eol_type): Return a new coding system. (detect_coding): Don't detect eol. Fix for utf-16 detection. (decode_eol): In case of CRLF->LF conversion, use del_range_2 on @@ -25952,7 +25952,7 @@ (font_list): The argument REGISTRY is now a list of registry names. (choose_face_font): If we are choosing an ASCII font, and ATTRS specifies an explicit font name, return the name as is. Make a - list of registy names. + list of registry names. * xfns.c (x_set_font, x_create_tip_frame): Adjust for the change of x_new_fontset. @@ -26647,7 +26647,7 @@ (fontset_set): Delete. (fontset_face): New arg FACE. Return face ID, not face. Complete re-write to handle new fontset structure. Change caller. - (free_face_fontset): Use ASET istead of AREF (X) = Y. + (free_face_fontset): Use ASET instead of AREF (X) = Y. (face_for_char): Don't call lookup_face. (make_fontset_for_ascii_face): New arg FACE. (fs_load_font): New arg CHARSET_ID. Don't check @@ -31141,7 +31141,7 @@ * term.c (term_mouse_highlight): Remove unused variables. (Fterm_open_connection): Set gpm_zerobased to 1. (term_mouse_movement, term_mouse_click, handle_one_term_event): - Use zero based co-ordinates. + Use zero based coordinates. (handle_one_term_event): Report a drag as mouse movement too. * Makefile.in (MOUSE_SUPPORT): Define for HAVE_GPM. diff --git a/src/ChangeLog.12 b/src/ChangeLog.12 index 0397a495212..04983fe03e6 100644 --- a/src/ChangeLog.12 +++ b/src/ChangeLog.12 @@ -239,7 +239,7 @@ * lisp.h (find_next_newline_no_quit): Rename to find_next_newline. * xdisp.c (back_to_previous_line_start, forward_to_next_line_start) - (get_visually_first_element, move_it_vertically_backward): Ajust users. + (get_visually_first_element, move_it_vertically_backward): Adjust users. * bidi.c (bidi_find_paragraph_start): Likewise. * indent.c (vmotion): Likewise. @@ -7335,7 +7335,7 @@ 2012-08-17 Chong Yidong <cyd@gnu.org> - * xfaces.c (merge_face_vectors): If the target font specfies a + * xfaces.c (merge_face_vectors): If the target font specifies a font spec, make the font's attributes take precedence over directly-specified attributes. (merge_face_ref): Recognize :font. @@ -9265,7 +9265,7 @@ * nsmenu.m (ns_update_menubar, ns_menu_show, process_dialog) (initFromContents): Use SSDATA where appropriate. - (ns_update_menubar): Add braces to ambigous if-else. + (ns_update_menubar): Add braces to ambiguous if-else. (initWithTitle): Put () around assignment in if statement. (ns_menu_show): Remove unused variables window and keymap. (update_frame_tool_bar): Remove unused variable selected_p. @@ -14333,7 +14333,7 @@ 2011-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org> - * process.c (wait_reading_process_output): Fix asynchrounous + * process.c (wait_reading_process_output): Fix asynchronous GnuTLS socket handling on some versions of the GnuTLS library. (wait_reading_process_output): Add comment and URL. @@ -21271,7 +21271,7 @@ not the number of arguments given. This is simpler and lets GCC 4.6.0 generate slightly better code. - * ftfont.c: Distingish more carefully between FcChar8 and char. + * ftfont.c: Distinguish more carefully between FcChar8 and char. The previous code passed unsigned char * to a functions like strlen and xstrcasecmp that expect char *, which does not conform to the C standard. diff --git a/src/ChangeLog.13 b/src/ChangeLog.13 index 791de9a6a8b..87055d70315 100644 --- a/src/ChangeLog.13 +++ b/src/ChangeLog.13 @@ -580,7 +580,7 @@ (x_intersect_rectangles, clear_mouse_face, display_tty_menu_item): * lisp.h (setup_echo_area_for_printing, message_with_string) (pos_visible_p): Use bool for boolean. - * xdisp.c: Use bool, true, false intstead of int, 1, 0. + * xdisp.c: Use bool, true, false instead of int, 1, 0. Remove unnecessary forward decls. (trace_move) [DEBUG_TRACE_MOVE]: Now static. (CHECK_IT, CHECK_WINDOW_END): @@ -685,7 +685,7 @@ Inhibit resizing fullwidth-/height frames in one direction only. Update frame_size_history. (adjust_frame_size): Call frame_size_history_add. - (make_frame): Initalize after_make_frame slot. + (make_frame): Initialize after_make_frame slot. (Fmake_terminal_frame): Adjust adjust_frame_size call. (Fcan_run_window_configuration_change_hook): Rename to Fframe_after_make_frame. Set after_make_frame slot. @@ -1419,7 +1419,7 @@ 2015-01-12 Paul Eggert <eggert@cs.ucla.edu> - Port to 32-bit MingGW --with-wide-int + Port to 32-bit MinGW --with-wide-int Problem reported by Eli Zaretskii in: https://lists.gnu.org/r/emacs-devel/2015-01/msg00265.html * lisp.h (struct Lisp_Sub_Char_Table): Check that offset matches @@ -1635,7 +1635,7 @@ 2015-01-06 Jan Djärv <jan.h.d@swipnet.se> * nsterm.m (x_set_window_size): Call updateFrameSize to get real - size instead of using widht/height. The frame may be + size instead of using width/height. The frame may be constrained (Bug#19482). 2015-01-05 Paul Eggert <eggert@cs.ucla.edu> @@ -2102,7 +2102,7 @@ Partially disabled previous change. * image.c (svg_load): Temporarily disabled filename thing for - not-a-file case as it can cause crashs. + not-a-file case as it can cause crashes. 2014-12-17 Ulf Jasper <ulf.jasper@web.de> @@ -2807,7 +2807,7 @@ * nsselect.m (QCLIPBOARD, QSECONDARY, QTEXT, QFILE_NAME) (NXPrimaryPboard, NXSecondaryPboard): Declare static. (Qforeign_selection): Remove. - (ns_get_local_selection): Identation fix. + (ns_get_local_selection): Indentation fix. (syms_of_nsselect): Remove Qforeign_selection, ns-lost-selection-hooks * nsselect.m (ns_get_local_selection): Remove calling of @@ -5162,7 +5162,7 @@ 2014-07-27 Jan Djärv <jan.h.d@swipnet.se> * nsterm.m (applicationDidFinishLaunching antialiasThresholdDidChange): - Reinstate code removed by the prevoius commit to this file. + Reinstate code removed by the previous commit to this file. 2014-07-27 Martin Rudalics <rudalics@gmx.at> @@ -7847,11 +7847,11 @@ * w32.c (unsetenv): Remove unused var `retval'. (emacs_gnutls_pull): Remove unused vars `fdset' and `timeout'. - * w32notify.c (watch_worker): Remove unnecesary var sleep_result. + * w32notify.c (watch_worker): Remove unnecessary var sleep_result. (start_watching): Remove unused var `thr'. * w32proc.c (sys_spawnve): Comment out unused vars `first', `last'. - (find_child_console): Remove unnecesary var `thread_id'. + (find_child_console): Remove unnecessary var `thread_id'. * w32term.c (w32_read_socket): Comment out unused vars `row', `columns'. (x_focus_frame): #ifdef 0 unused variable `dpyinfo'. @@ -9004,7 +9004,7 @@ * widget.c (pixel_to_text_size): New function. (update_wm_hints): Have size hints respect value of frame_resize_pixelwise. - (EmacsFrameResize): Alway process resize requests pixelwise. + (EmacsFrameResize): Always process resize requests pixelwise. * window.c (grow_mini_window): Make sure mini window is at least one line tall. * xdisp.c (display_menu_bar): Make sure menubar extends till @@ -10768,7 +10768,7 @@ * search.c (find_newline): Rewrite to prefer offsets to pointers. This avoids undefined behavior when subtracting pointers into - different aways. On my platform it also makes the code a tad + different always. On my platform it also makes the code a tad smaller and presumably faster. 2013-11-11 Stefan Monnier <monnier@iro.umontreal.ca> @@ -13849,7 +13849,7 @@ 2013-08-13 Jan Djärv <jan.h.d@swipnet.se> - * nsterm.m (ns_set_vertical_scroll_bar): Fix breakage intruduced by + * nsterm.m (ns_set_vertical_scroll_bar): Fix breakage introduced by 2013-08-13 checkin below. Change bool to BOOL, rule is: All Obj-C code uses BOOL, except for interfaces callable from C. @@ -14041,7 +14041,7 @@ the caller. Do not lock the temp file. Unwind-protect the file and the file-descriptor. (Fcall_process_region): If the input is /dev/null, unwind-protect it. - If an asynchrounous process, record it here, not in call_process. + If an asynchronous process, record it here, not in call_process. (syms_of_callproc) [MSDOS]: Initialize synch_process_tempfile. * eval.c (set_unwind_protect): New function. * fileio.c (write_region): New function, generalized from the @@ -14764,7 +14764,7 @@ All callers changed. (create_process): Recover pty_flag from process, not from volatile local. (create_pty): Stay inside array even when pty allocation fails. - (Fmake_serial_process): Omit unnecessary initializaiton of pty_flag. + (Fmake_serial_process): Omit unnecessary initialization of pty_flag. * lread.c (Fload): Avoid initialization only when lint checking. Mention that it's needed only for older GCCs. @@ -17372,7 +17372,7 @@ 2013-03-31 Dmitry Antipov <dmantipov@yandex.ru> * frame.h (struct frame): Drop scroll_bottom_vpos - member becaue all real users are dead long ago. + member because all real users are dead long ago. (FRAME_SCROLL_BOTTOM_VPOS): Remove. * xdisp.c (redisplay_internal): Adjust user. @@ -17394,7 +17394,7 @@ (menuNeedsUpdate:): Add check for ! COCOA || OSX < 10.5 (Bug#12698). * nsterm.m (menu_will_open_state, menu_mouse_point) - (menu_pending_title): New varaibles. + (menu_pending_title): New variables. (ns_get_pending_menu_title, ns_check_menu_open) (ns_check_pending_open_menu): New functions. diff --git a/src/ChangeLog.3 b/src/ChangeLog.3 index 973251859c1..4e403058837 100644 --- a/src/ChangeLog.3 +++ b/src/ChangeLog.3 @@ -11656,8 +11656,8 @@ pixel_to_glyph_translation, and rewritten. Just get coordinates, don't return anything. (buffer_posn_from_coords): New function - given a window and - co-ordinates on the screen, find the buffer position at those - co-ordinates. + coordinates on the screen, find the buffer position at those + coordinates. 1991-01-08 Jim Blandy (jimb@geech.ai.mit.edu) @@ -16140,7 +16140,7 @@ New format %S converts everything (even strings) with prin1. * doprnt.c (doprnt): Treat %s like %S. - * print.c (Fprin1_to_string): Opt 3nd arg non-nil does princ. + * print.c (Fprin1_to_string): Opt 3rd arg non-nil does princ. 1988-12-31 Richard Stallman (rms@sugar-bombs.ai.mit.edu) diff --git a/src/ChangeLog.8 b/src/ChangeLog.8 index 17522e450f0..c7b99a443d5 100644 --- a/src/ChangeLog.8 +++ b/src/ChangeLog.8 @@ -1572,7 +1572,7 @@ (wait_reading_process_input): Use emacs_strerror, not strerror. * process.c (status_message, sigchld_handler): Synchronize locale, - then use strsignal istead of sys_siglist. + then use strsignal instead of sys_siglist. * w32proc.c (sys_wait): Likewise. * s/aix3-1.h, s/bsd4-1.h, s/dgux.h, s/gnu-linux.h, s/hiuxmpp.h: @@ -7560,7 +7560,7 @@ (recompute_basic_faces): Realize basic faces only if face cache is allocated, i.e. after init_frame_faces has been called. - * frame.c (make_frame): Initialze face cache with null. + * frame.c (make_frame): Initialize face cache with null. * xfaces.c (same_size_fonts): Remove. @@ -9810,7 +9810,7 @@ 1997-10-13 Gerd Moellmann <gerd@acm.org> * xdisp.c (redisplay_window): Use available current matrix to - skip faster when only point is moved withing the window. + skip faster when only point is moved within the window. * intervals.c: Include stdio.h. (find_interval): Trace to stderr to catch some nasty error @@ -9859,7 +9859,7 @@ * emacs.c: FreeBSD headers for profiling removed. * dispnew.c (direct_output_for_insert): Don't use PT-1 for - display cursor, use DEC_POS instread. + display cursor, use DEC_POS instead. * xfaces.c (load_font): Use x_load_font to load fonts so that all fonts are in the font table. @@ -11940,7 +11940,7 @@ This avoids a conflict with a system header file paths.h on GNU/Linux. * callproc.c, lread.c, w32fns.c, xfns.c, xrdb.c: - Use epaths.h istead of paths.h. + Use epaths.h instead of paths.h. 1999-02-26 Andreas Schwab <schwab@gnu.org> diff --git a/src/ChangeLog.9 b/src/ChangeLog.9 index 9f12748fbeb..0c1f72a6787 100644 --- a/src/ChangeLog.9 +++ b/src/ChangeLog.9 @@ -10388,7 +10388,7 @@ ISO_control_0 and ISO_control_1. * coding.h (enum iso_code_class_type): Member ISO_control_code is - devided into ISO_control_0 and ISO_control_1. + divided into ISO_control_0 and ISO_control_1. (struct coding_system): New members src_multibyte, dst_multibyte, errors, and result. Delete member fake_multibyte. (CODING_REQUIRE_DECODING): Return 1 if coding->dst_multibyte is diff --git a/src/alloc.c b/src/alloc.c index b12922b5858..f90d09265d0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1658,7 +1658,7 @@ sdata_size (ptrdiff_t n) #define GC_STRING_EXTRA GC_STRING_OVERRUN_COOKIE_SIZE /* Exact bound on the number of bytes in a string, not counting the - terminating NUL. A string cannot contain more bytes than + terminating null. A string cannot contain more bytes than STRING_BYTES_BOUND, nor can it be so long that the size_t arithmetic in allocate_string_data would overflow while it is calculating a value to be passed to malloc. */ diff --git a/src/bidi.c b/src/bidi.c index 1017bd2d523..225b27b18cd 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -2338,7 +2338,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it) and make it L right away, to avoid the potentially costly loop below. This is important when the buffer has a long series of - control characters, like binary NULs, and no + control characters, like binary nulls, and no R2L characters at all. */ && new_level == 0 && !bidi_explicit_dir_char (bidi_it->ch) @@ -2996,7 +2996,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it) } /* The next two "else if" clauses are shortcuts for the important special case when we have a long sequence of - neutral or WEAK_BN characters, such as whitespace or NULs or + neutral or WEAK_BN characters, such as whitespace or nulls or other control characters, on the base embedding level of the paragraph, and that sequence goes all the way to the end of the paragraph and follows a character whose resolved diff --git a/src/bignum.c b/src/bignum.c index 669df4d9ee3..dce5908a1e4 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -353,7 +353,7 @@ emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp) /* Yield an upper bound on the buffer size needed to contain a C string representing the NUM in base BASE. This includes any - preceding '-' and the terminating NUL. */ + preceding '-' and the terminating null. */ static ptrdiff_t mpz_bufsize (mpz_t const num, int base) { @@ -418,7 +418,7 @@ bignum_to_string (Lisp_Object num, int base) /* Create a bignum by scanning NUM, with digits in BASE. NUM must consist of an optional '-', a nonempty sequence - of base-BASE digits, and a terminating NUL byte, and + of base-BASE digits, and a terminating null byte, and the represented number must not be in fixnum range. */ Lisp_Object diff --git a/src/callint.c b/src/callint.c index f609c96a6fa..f80436f3d91 100644 --- a/src/callint.c +++ b/src/callint.c @@ -712,7 +712,7 @@ invoke it (via an `interactive' spec that contains, for instance, an default: { /* How many bytes are left unprocessed in the specs string? - (Note that this excludes the trailing NUL byte.) */ + (Note that this excludes the trailing null byte.) */ ptrdiff_t bytes_left = string_len - (tem - string); unsigned letter; diff --git a/src/cmds.c b/src/cmds.c index 90526612b7a..c29cf00dad1 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -390,7 +390,7 @@ internal_self_insert (int c, EMACS_INT n) by spaces so that the remaining text won't move. */ ptrdiff_t actual = PT_BYTE; actual -= prev_char_len (actual); - if (FETCH_CHAR (actual) == '\t') + if (FETCH_BYTE (actual) == '\t') /* Rather than add spaces, let's just keep the tab. */ chars_to_delete--; else diff --git a/src/coding.c b/src/coding.c index 221a9cad898..2142e7fa518 100644 --- a/src/coding.c +++ b/src/coding.c @@ -5707,7 +5707,7 @@ setup_coding_system (Lisp_Object coding_system, struct coding_system *coding) coding->common_flags |= CODING_REQUIRE_DETECTION_MASK; coding->spec.undecided.inhibit_nbd = (encode_inhibit_flag - (AREF (attrs, coding_attr_undecided_inhibit_nul_byte_detection))); + (AREF (attrs, coding_attr_undecided_inhibit_null_byte_detection))); coding->spec.undecided.inhibit_ied = (encode_inhibit_flag (AREF (attrs, coding_attr_undecided_inhibit_iso_escape_detection))); @@ -6535,9 +6535,9 @@ detect_coding (struct coding_system *coding) { int c, i; struct coding_detection_info detect_info; - bool nul_byte_found = 0, eight_bit_found = 0; + bool null_byte_found = 0, eight_bit_found = 0; bool inhibit_nbd = inhibit_flag (coding->spec.undecided.inhibit_nbd, - inhibit_nul_byte_detection); + inhibit_null_byte_detection); bool inhibit_ied = inhibit_flag (coding->spec.undecided.inhibit_ied, inhibit_iso_escape_detection); bool prefer_utf_8 = coding->spec.undecided.prefer_utf_8; @@ -6550,7 +6550,7 @@ detect_coding (struct coding_system *coding) if (c & 0x80) { eight_bit_found = 1; - if (nul_byte_found) + if (null_byte_found) break; } else if (c < 0x20) @@ -6565,7 +6565,7 @@ detect_coding (struct coding_system *coding) if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE)) { /* We didn't find an 8-bit code. We may - have found a NUL-byte, but it's very + have found a null-byte, but it's very rare that a binary file conforms to ISO-2022. */ src = src_end; @@ -6577,7 +6577,7 @@ detect_coding (struct coding_system *coding) } else if (! c && !inhibit_nbd) { - nul_byte_found = 1; + null_byte_found = 1; if (eight_bit_found) break; } @@ -6609,7 +6609,7 @@ detect_coding (struct coding_system *coding) coding->head_ascii++; } - if (nul_byte_found || eight_bit_found + if (null_byte_found || eight_bit_found || coding->head_ascii < coding->src_bytes || detect_info.found) { @@ -6627,7 +6627,7 @@ detect_coding (struct coding_system *coding) } else { - if (nul_byte_found) + if (null_byte_found) { detect_info.checked |= ~CATEGORY_MASK_UTF_16; detect_info.rejected |= ~CATEGORY_MASK_UTF_16; @@ -6700,7 +6700,7 @@ detect_coding (struct coding_system *coding) else found = CODING_ID_NAME (this->id); } - else if (nul_byte_found) + else if (null_byte_found) found = Qno_conversion; else if ((detect_info.rejected & CATEGORY_MASK_ANY) == CATEGORY_MASK_ANY) @@ -8476,7 +8476,7 @@ from_unicode (Lisp_Object str) Lisp_Object from_unicode_buffer (const wchar_t *wstr) { - /* We get one of the two final NUL bytes for free. */ + /* We get one of the two final null bytes for free. */ ptrdiff_t len = 1 + sizeof (wchar_t) * wcslen (wstr); AUTO_STRING_WITH_LEN (str, (char *) wstr, len); return from_unicode (str); @@ -8489,7 +8489,7 @@ to_unicode (Lisp_Object str, Lisp_Object *buf) /* We need to make another copy (in addition to the one made by code_convert_string_norecord) to ensure that the final string is _doubly_ zero terminated --- that is, that the string is - terminated by two zero bytes and one utf-16le NUL character. + terminated by two zero bytes and one utf-16le null character. Because strings are already terminated with a single zero byte, we just add one additional zero. */ str = make_uninit_string (SBYTES (*buf) + 1); @@ -8605,7 +8605,7 @@ detect_coding_system (const unsigned char *src, ptrdiff_t id; struct coding_detection_info detect_info; enum coding_category base_category; - bool nul_byte_found = 0, eight_bit_found = 0; + bool null_byte_found = 0, eight_bit_found = 0; if (NILP (coding_system)) coding_system = Qundecided; @@ -8632,7 +8632,7 @@ detect_coding_system (const unsigned char *src, struct coding_system *this UNINIT; int c, i; bool inhibit_nbd = inhibit_flag (coding.spec.undecided.inhibit_nbd, - inhibit_nul_byte_detection); + inhibit_null_byte_detection); bool inhibit_ied = inhibit_flag (coding.spec.undecided.inhibit_ied, inhibit_iso_escape_detection); bool prefer_utf_8 = coding.spec.undecided.prefer_utf_8; @@ -8644,7 +8644,7 @@ detect_coding_system (const unsigned char *src, if (c & 0x80) { eight_bit_found = 1; - if (nul_byte_found) + if (null_byte_found) break; } else if (c < 0x20) @@ -8659,7 +8659,7 @@ detect_coding_system (const unsigned char *src, if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE)) { /* We didn't find an 8-bit code. We may - have found a NUL-byte, but it's very + have found a null-byte, but it's very rare that a binary file confirm to ISO-2022. */ src = src_end; @@ -8671,7 +8671,7 @@ detect_coding_system (const unsigned char *src, } else if (! c && !inhibit_nbd) { - nul_byte_found = 1; + null_byte_found = 1; if (eight_bit_found) break; } @@ -8682,7 +8682,7 @@ detect_coding_system (const unsigned char *src, coding.head_ascii++; } - if (nul_byte_found || eight_bit_found + if (null_byte_found || eight_bit_found || coding.head_ascii < coding.src_bytes || detect_info.found) { @@ -8697,7 +8697,7 @@ detect_coding_system (const unsigned char *src, } else { - if (nul_byte_found) + if (null_byte_found) { detect_info.checked |= ~CATEGORY_MASK_UTF_16; detect_info.rejected |= ~CATEGORY_MASK_UTF_16; @@ -8744,7 +8744,7 @@ detect_coding_system (const unsigned char *src, } if ((detect_info.rejected & CATEGORY_MASK_ANY) == CATEGORY_MASK_ANY - || nul_byte_found) + || null_byte_found) { detect_info.found = CATEGORY_MASK_RAW_TEXT; id = CODING_SYSTEM_ID (Qno_conversion); @@ -8846,7 +8846,7 @@ detect_coding_system (const unsigned char *src, { if (detect_info.found & ~CATEGORY_MASK_UTF_16) { - if (nul_byte_found) + if (null_byte_found) normal_eol = EOL_SEEN_LF; else normal_eol = detect_eol (coding.source, src_bytes, @@ -11320,8 +11320,8 @@ usage: (define-coding-system-internal ...) */) { if (nargs < coding_arg_undecided_max) goto short_args; - ASET (attrs, coding_attr_undecided_inhibit_nul_byte_detection, - args[coding_arg_undecided_inhibit_nul_byte_detection]); + ASET (attrs, coding_attr_undecided_inhibit_null_byte_detection, + args[coding_arg_undecided_inhibit_null_byte_detection]); ASET (attrs, coding_attr_undecided_inhibit_iso_escape_detection, args[coding_arg_undecided_inhibit_iso_escape_detection]); ASET (attrs, coding_attr_undecided_prefer_utf_8, @@ -12086,18 +12086,18 @@ to explicitly specify some coding system that doesn't use ISO-2022 escape sequence (e.g., `latin-1') on reading by \\[universal-coding-system-argument]. */); inhibit_iso_escape_detection = 0; - DEFVAR_BOOL ("inhibit-nul-byte-detection", - inhibit_nul_byte_detection, - doc: /* If non-nil, Emacs ignores NUL bytes on code detection. + DEFVAR_BOOL ("inhibit-null-byte-detection", + inhibit_null_byte_detection, + doc: /* If non-nil, Emacs ignores null bytes on code detection. By default, Emacs treats it as binary data, and does not attempt to decode it. The effect is as if you specified `no-conversion' for reading that text. -Set this to non-nil when a regular text happens to include NUL bytes. -Examples are Index nodes of Info files and NUL-byte delimited output -from GNU Find and GNU Grep. Emacs will then ignore the NUL bytes and +Set this to non-nil when a regular text happens to include null bytes. +Examples are Index nodes of Info files and null-byte delimited output +from GNU Find and GNU Grep. Emacs will then ignore the null bytes and decode text as usual. */); - inhibit_nul_byte_detection = 0; + inhibit_null_byte_detection = 0; DEFVAR_BOOL ("disable-ascii-optimization", disable_ascii_optimization, doc: /* If non-nil, Emacs does not optimize code decoder for ASCII files. @@ -12156,7 +12156,7 @@ internal character representation. */); "automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = CALLMANY (Flist, plist); - args[coding_arg_undecided_inhibit_nul_byte_detection] = make_fixnum (0); + args[coding_arg_undecided_inhibit_null_byte_detection] = make_fixnum (0); args[coding_arg_undecided_inhibit_iso_escape_detection] = make_fixnum (0); Fdefine_coding_system_internal (coding_arg_undecided_max, args); diff --git a/src/coding.h b/src/coding.h index c2a7b2a00ff..4973cf89eb1 100644 --- a/src/coding.h +++ b/src/coding.h @@ -82,7 +82,7 @@ enum define_coding_ccl_arg_index enum define_coding_undecided_arg_index { - coding_arg_undecided_inhibit_nul_byte_detection = coding_arg_max, + coding_arg_undecided_inhibit_null_byte_detection = coding_arg_max, coding_arg_undecided_inhibit_iso_escape_detection, coding_arg_undecided_prefer_utf_8, coding_arg_undecided_max @@ -139,7 +139,7 @@ enum coding_attr_index coding_attr_emacs_mule_full, - coding_attr_undecided_inhibit_nul_byte_detection, + coding_attr_undecided_inhibit_null_byte_detection, coding_attr_undecided_inhibit_iso_escape_detection, coding_attr_undecided_prefer_utf_8, @@ -353,7 +353,7 @@ struct emacs_mule_spec struct undecided_spec { - /* Inhibit NUL byte detection. 1 means always inhibit, + /* Inhibit null byte detection. 1 means always inhibit, -1 means do not inhibit, 0 means rely on user variable. */ int inhibit_nbd; diff --git a/src/composite.c b/src/composite.c index 984e0d9cda8..66c1e86aae1 100644 --- a/src/composite.c +++ b/src/composite.c @@ -637,10 +637,8 @@ compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components, static Lisp_Object gstring_hash_table; -static Lisp_Object gstring_lookup_cache (Lisp_Object); - -static Lisp_Object -gstring_lookup_cache (Lisp_Object header) +Lisp_Object +composition_gstring_lookup_cache (Lisp_Object header) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); ptrdiff_t i = hash_lookup (h, header, NULL); @@ -679,6 +677,27 @@ composition_gstring_from_id (ptrdiff_t id) return HASH_VALUE (h, id); } +/* Remove from the composition hash table every lgstring that + references the given FONT_OBJECT. */ +void +composition_gstring_cache_clear_font (Lisp_Object font_object) +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); + + for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) + { + Lisp_Object k = HASH_KEY (h, i); + + if (!EQ (k, Qunbound)) + { + Lisp_Object gstring = HASH_VALUE (h, i); + + if (EQ (LGSTRING_FONT (gstring), font_object)) + hash_remove_from_table (h, k); + } + } +} + DEFUN ("clear-composition-cache", Fclear_composition_cache, Sclear_composition_cache, 0, 0, 0, doc: /* Internal use only. @@ -1781,7 +1800,7 @@ should be ignored. */) header = fill_gstring_header (frompos, frombyte, topos, font_object, string); - gstring = gstring_lookup_cache (header); + gstring = composition_gstring_lookup_cache (header); if (! NILP (gstring)) return gstring; diff --git a/src/composite.h b/src/composite.h index 239f1e531ef..bdf63fed10e 100644 --- a/src/composite.h +++ b/src/composite.h @@ -330,6 +330,9 @@ extern int composition_update_it (struct composition_it *, ptrdiff_t, ptrdiff_t, Lisp_Object); extern ptrdiff_t composition_adjust_point (ptrdiff_t, ptrdiff_t); +extern Lisp_Object composition_gstring_lookup_cache (Lisp_Object); + +extern void composition_gstring_cache_clear_font (Lisp_Object); INLINE_HEADER_END diff --git a/src/data.c b/src/data.c index 59d148166fe..65589856687 100644 --- a/src/data.c +++ b/src/data.c @@ -906,6 +906,15 @@ Value, if non-nil, is a list (interactive SPEC). */) if (PVSIZE (fun) > COMPILED_INTERACTIVE) return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); } +#ifdef HAVE_MODULES + else if (MODULE_FUNCTIONP (fun)) + { + Lisp_Object form + = module_function_interactive_form (XMODULE_FUNCTION (fun)); + if (! NILP (form)) + return form; + } +#endif else if (AUTOLOADP (fun)) return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil)); else if (CONSP (fun)) diff --git a/src/dbusbind.c b/src/dbusbind.c index 4fce92521a4..dc4db5c8513 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -44,7 +44,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* Alist of D-Bus buses we are polling for messages. The key is the symbol or string of the bus, and the value is the - connection address. */ + connection address. For every bus, just one connection is counted. + If there shall be a second connection to the same bus, a different + symbol or string for the bus must be chosen. On Lisp level, a bus + stands for the associated connection. */ static Lisp_Object xd_registered_buses; /* Whether we are reading a D-Bus event. */ @@ -129,36 +132,23 @@ static bool xd_in_read_queued_messages = 0; #define XD_BASIC_DBUS_TYPE(type) \ (dbus_type_is_valid (type) && dbus_type_is_basic (type)) #else -#ifdef DBUS_TYPE_UNIX_FD -#define XD_BASIC_DBUS_TYPE(type) \ - ((type == DBUS_TYPE_BYTE) \ - || (type == DBUS_TYPE_BOOLEAN) \ - || (type == DBUS_TYPE_INT16) \ - || (type == DBUS_TYPE_UINT16) \ - || (type == DBUS_TYPE_INT32) \ - || (type == DBUS_TYPE_UINT32) \ - || (type == DBUS_TYPE_INT64) \ - || (type == DBUS_TYPE_UINT64) \ - || (type == DBUS_TYPE_DOUBLE) \ - || (type == DBUS_TYPE_STRING) \ - || (type == DBUS_TYPE_OBJECT_PATH) \ - || (type == DBUS_TYPE_SIGNATURE) \ - || (type == DBUS_TYPE_UNIX_FD)) -#else #define XD_BASIC_DBUS_TYPE(type) \ - ((type == DBUS_TYPE_BYTE) \ - || (type == DBUS_TYPE_BOOLEAN) \ - || (type == DBUS_TYPE_INT16) \ - || (type == DBUS_TYPE_UINT16) \ - || (type == DBUS_TYPE_INT32) \ - || (type == DBUS_TYPE_UINT32) \ - || (type == DBUS_TYPE_INT64) \ - || (type == DBUS_TYPE_UINT64) \ - || (type == DBUS_TYPE_DOUBLE) \ - || (type == DBUS_TYPE_STRING) \ - || (type == DBUS_TYPE_OBJECT_PATH) \ - || (type == DBUS_TYPE_SIGNATURE)) + ((type == DBUS_TYPE_BYTE) \ + || (type == DBUS_TYPE_BOOLEAN) \ + || (type == DBUS_TYPE_INT16) \ + || (type == DBUS_TYPE_UINT16) \ + || (type == DBUS_TYPE_INT32) \ + || (type == DBUS_TYPE_UINT32) \ + || (type == DBUS_TYPE_INT64) \ + || (type == DBUS_TYPE_UINT64) \ + || (type == DBUS_TYPE_DOUBLE) \ + || (type == DBUS_TYPE_STRING) \ + || (type == DBUS_TYPE_OBJECT_PATH) \ + || (type == DBUS_TYPE_SIGNATURE) \ +#ifdef DBUS_TYPE_UNIX_FD + || (type == DBUS_TYPE_UNIX_FD) \ #endif + ) #endif /* This was a macro. On Solaris 2.11 it was said to compile for @@ -192,9 +182,39 @@ xd_symbol_to_dbus_type (Lisp_Object object) : DBUS_TYPE_INVALID); } +/* Determine the Lisp symbol of DBusType. */ +static Lisp_Object +xd_dbus_type_to_symbol (int type) +{ + return + (type == DBUS_TYPE_BYTE) ? QCbyte + : (type == DBUS_TYPE_BOOLEAN) ? QCboolean + : (type == DBUS_TYPE_INT16) ? QCint16 + : (type == DBUS_TYPE_UINT16) ? QCuint16 + : (type == DBUS_TYPE_INT32) ? QCint32 + : (type == DBUS_TYPE_UINT32) ? QCuint32 + : (type == DBUS_TYPE_INT64) ? QCint64 + : (type == DBUS_TYPE_UINT64) ? QCuint64 + : (type == DBUS_TYPE_DOUBLE) ? QCdouble + : (type == DBUS_TYPE_STRING) ? QCstring + : (type == DBUS_TYPE_OBJECT_PATH) ? QCobject_path + : (type == DBUS_TYPE_SIGNATURE) ? QCsignature +#ifdef DBUS_TYPE_UNIX_FD + : (type == DBUS_TYPE_UNIX_FD) ? QCunix_fd +#endif + : (type == DBUS_TYPE_ARRAY) ? QCarray + : (type == DBUS_TYPE_VARIANT) ? QCvariant + : (type == DBUS_TYPE_STRUCT) ? QCstruct + : (type == DBUS_TYPE_DICT_ENTRY) ? QCdict_entry + : Qnil; +} + +#define XD_KEYWORDP(object) !NILP (Fkeywordp (object)) + /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */ #define XD_DBUS_TYPE_P(object) \ - (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID))) + XD_KEYWORDP (object) && \ + ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)) /* Determine the DBusType of a given Lisp OBJECT. It is used to convert Lisp objects, being arguments of `dbus-call-method' or @@ -265,10 +285,13 @@ XD_OBJECT_TO_STRING (Lisp_Object object) else \ { \ CHECK_SYMBOL (bus); \ - if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \ + if (!(EQ (bus, QCsystem) || EQ (bus, QCsession) \ + || EQ (bus, QCsystem_private) \ + || EQ (bus, QCsession_private))) \ XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \ /* We do not want to have an autolaunch for the session bus. */ \ - if (EQ (bus, QCsession) && session_bus_address == NULL) \ + if ((EQ (bus, QCsession) || EQ (bus, QCsession_private)) \ + && session_bus_address == NULL) \ XD_SIGNAL2 (build_string ("No connection to bus"), bus); \ } \ } while (0) @@ -360,7 +383,8 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_BOOLEAN: - if (!EQ (object, Qt) && !NILP (object)) + /* There must be an argument. */ + if (EQ (QCboolean, object)) wrong_type_argument (intern ("booleanp"), object); sprintf (signature, "%c", dtype); break; @@ -385,7 +409,12 @@ 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: - CHECK_STRING (object); + /* We dont check the syntax of signature. This will be done by + libdbus. */ + if (dtype == DBUS_TYPE_OBJECT_PATH) + XD_DBUS_VALIDATE_PATH (object) + else + CHECK_STRING (object); sprintf (signature, "%c", dtype); break; @@ -420,12 +449,18 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) { Lisp_Object elt1 = XD_NEXT_VALUE (elt); if (CONSP (elt1) && STRINGP (XCAR (elt1)) && NILP (XCDR (elt1))) - subsig = SSDATA (XCAR (elt1)); + { + subsig = SSDATA (XCAR (elt1)); + elt = Qnil; + } } while (!NILP (elt)) { - if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt))) + char x[DBUS_MAXIMUM_SIGNATURE_LENGTH]; + subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); + xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); + if (strcmp (subsig, x) != 0) wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt)); elt = CDR_SAFE (XD_NEXT_VALUE (elt)); } @@ -440,6 +475,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) CHECK_CONS (object); elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); @@ -451,11 +487,12 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_STRUCT: - /* A struct list might contain any number of elements with - different types. No further check needed. */ + /* A struct list might contain any (but zero) number of elements + with different types. No further check needed. */ CHECK_CONS (object); elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); /* Compose the signature from the elements. It is enclosed by parentheses. */ @@ -486,6 +523,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* First element. */ elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); xd_signature_cat (signature, x); @@ -495,6 +533,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* Second element. */ elt = CDR_SAFE (XD_NEXT_VALUE (elt)); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); xd_signature_cat (signature, x); @@ -595,6 +634,9 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) } case DBUS_TYPE_BOOLEAN: + /* There must be an argument. */ + if (EQ (QCboolean, object)) + wrong_type_argument (intern ("booleanp"), object); { dbus_bool_t val = (NILP (object)) ? FALSE : TRUE; XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); @@ -693,7 +735,12 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: - CHECK_STRING (object); + /* We dont check the syntax of signature. This will be done + by libdbus. */ + if (dtype == DBUS_TYPE_OBJECT_PATH) + XD_DBUS_VALIDATE_PATH (object) + else + CHECK_STRING (object); { /* We need to send a valid UTF-8 string. We could encode `object' but by not encoding it, we guarantee it's valid utf-8, even if @@ -816,7 +863,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); val = val & 0xFF; XD_DEBUG_MESSAGE ("%c %u", dtype, val); - return make_fixnum (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val)); } case DBUS_TYPE_BOOLEAN: @@ -824,7 +871,8 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_bool_t val; dbus_message_iter_get_basic (iter, &val); XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); - return (val == FALSE) ? Qnil : Qt; + return list2 (xd_dbus_type_to_symbol (dtype), + (val == FALSE) ? Qnil : Qt); } case DBUS_TYPE_INT16: @@ -834,7 +882,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_fixnum (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val)); } case DBUS_TYPE_UINT16: @@ -844,7 +892,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_fixnum (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val)); } case DBUS_TYPE_INT32: @@ -854,7 +902,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return INT_TO_INTEGER (val); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_UINT32: @@ -867,7 +915,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %u", dtype, pval); - return INT_TO_INTEGER (val); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_INT64: @@ -876,7 +924,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); intmax_t pval = val; XD_DEBUG_MESSAGE ("%c %"PRIdMAX, dtype, pval); - return INT_TO_INTEGER (val); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_UINT64: @@ -885,7 +933,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); uintmax_t pval = val; XD_DEBUG_MESSAGE ("%c %"PRIuMAX, dtype, pval); - return INT_TO_INTEGER (val); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_DOUBLE: @@ -893,7 +941,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) double val; dbus_message_iter_get_basic (iter, &val); XD_DEBUG_MESSAGE ("%c %f", dtype, val); - return make_float (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_float (val)); } case DBUS_TYPE_STRING: @@ -903,7 +951,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) char *val; dbus_message_iter_get_basic (iter, &val); XD_DEBUG_MESSAGE ("%c %s", dtype, val); - return build_string (val); + return list2 (xd_dbus_type_to_symbol (dtype), build_string (val)); } case DBUS_TYPE_ARRAY: @@ -923,7 +971,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_next (&subiter); } XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result)); - return Fnreverse (result); + return Fcons (xd_dbus_type_to_symbol (dtype), Fnreverse (result)); } default: @@ -953,8 +1001,9 @@ xd_lisp_dbus_to_dbus (Lisp_Object bus) return xmint_pointer (bus); } -/* Return D-Bus connection address. BUS is either a Lisp symbol, - :system or :session, or a string denoting the bus address. */ +/* Return D-Bus connection address. + BUS is either a Lisp symbol, :system, :session, :system-private or + :session-private, or a string denoting the bus address. */ static DBusConnection * xd_get_connection_address (Lisp_Object bus) { @@ -1016,7 +1065,8 @@ xd_add_watch (DBusWatch *watch, void *data) } /* Stop monitoring WATCH for possible I/O. - DATA is the used bus, either a string or QCsystem or QCsession. */ + DATA is the used bus, either a string or QCsystem, QCsession, + QCsystem_private or QCsession_private. */ static void xd_remove_watch (DBusWatch *watch, void *data) { @@ -1031,7 +1081,7 @@ xd_remove_watch (DBusWatch *watch, void *data) /* Unset session environment. */ #if 0 /* This is buggy, since unsetenv is not thread-safe. */ - if (XSYMBOL (QCsession) == data) + if (XSYMBOL (QCsession) == data) || (XSYMBOL (QCsession_private) == data) { XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); unsetenv ("DBUS_SESSION_BUS_ADDRESS"); @@ -1105,6 +1155,11 @@ can be a string denoting the address of the corresponding bus. For the system and session buses, this function is called when loading `dbus.el', there is no need to call it again. +A special case is BUS being the symbol `:system-private' or +`:session-private'. These symbols still denote the system or session +bus, but using a private connection. They should not be used outside +dbus.el. + The function returns a number, which counts the connections this Emacs session has established to the BUS under the same unique name (see `dbus-get-unique-name'). It depends on the libraries Emacs is linked @@ -1127,6 +1182,10 @@ this connection to those buses. */) ptrdiff_t refcount; /* Check parameter. */ + if (!NILP (private)) + bus = EQ (bus, QCsystem) + ? QCsystem_private + : EQ (bus, QCsession) ? QCsession_private : bus; XD_DBUS_VALIDATE_BUS_ADDRESS (bus); /* Close bus if it is already open. */ @@ -1154,8 +1213,9 @@ this connection to those buses. */) else { - DBusBusType bustype = (EQ (bus, QCsystem) - ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION); + DBusBusType bustype + = EQ (bus, QCsystem) || EQ (bus, QCsystem_private) + ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION; if (NILP (private)) connection = dbus_bus_get (bustype, &derror); else @@ -1169,9 +1229,9 @@ this connection to those buses. */) XD_SIGNAL2 (build_string ("No connection to bus"), bus); /* If it is not the system or session bus, we must register - ourselves. Otherwise, we have called dbus_bus_get, which has - configured us to exit if the connection closes - we undo this - setting. */ + ourselves. Otherwise, we have called dbus_bus_get{_private}, + which has configured us to exit if the connection closes - we + undo this setting. */ if (STRINGP (bus)) dbus_bus_register (connection, &derror); else @@ -1186,7 +1246,7 @@ this connection to those buses. */) xd_add_watch, xd_remove_watch, xd_toggle_watch, - SYMBOLP (bus) + XD_KEYWORDP (bus) ? (void *) XSYMBOL (bus) : (void *) XSTRING (bus), NULL)) @@ -1200,6 +1260,9 @@ this connection to those buses. */) dbus_error_free (&derror); } + XD_DEBUG_MESSAGE ("Registered buses: %s", + XD_OBJECT_TO_STRING (xd_registered_buses)); + /* Return reference counter. */ refcount = xd_get_connection_references (connection); XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d", @@ -1252,7 +1315,11 @@ The following usages are expected: `dbus-method-error-internal': (dbus-message-internal - dbus-message-type-error BUS SERVICE SERIAL &rest ARGS) + dbus-message-type-error BUS SERVICE SERIAL ERROR-NAME &rest ARGS) + +`dbus-check-arguments': (does not send a message) + (dbus-message-internal + dbus-message-type-invalid BUS SERVICE &rest ARGS) usage: (dbus-message-internal &rest REST) */) (ptrdiff_t nargs, Lisp_Object *args) @@ -1271,7 +1338,7 @@ usage: (dbus-message-internal &rest REST) */) dbus_uint32_t serial = 0; unsigned int ui_serial; int timeout = -1; - ptrdiff_t count; + ptrdiff_t count, count0; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; /* Initialize parameters. */ @@ -1281,7 +1348,7 @@ usage: (dbus-message-internal &rest REST) */) handler = Qnil; CHECK_FIXNAT (message_type); - if (! (DBUS_MESSAGE_TYPE_INVALID < XFIXNAT (message_type) + if (! (DBUS_MESSAGE_TYPE_INVALID <= XFIXNAT (message_type) && XFIXNAT (message_type) < DBUS_NUM_MESSAGE_TYPES)) XD_SIGNAL2 (build_string ("Invalid message type"), message_type); mtype = XFIXNAT (message_type); @@ -1296,13 +1363,16 @@ usage: (dbus-message-internal &rest REST) */) handler = args[6]; count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6; } - else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) + || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t)); if (mtype == DBUS_MESSAGE_TYPE_ERROR) error_name = args[4]; count = (mtype == DBUS_MESSAGE_TYPE_ERROR) ? 5 : 4; } + else /* DBUS_MESSAGE_TYPE_INVALID */ + count = 3; /* Check parameters. */ XD_DBUS_VALIDATE_BUS_ADDRESS (bus); @@ -1352,7 +1422,7 @@ usage: (dbus-message-internal &rest REST) */) XD_OBJECT_TO_STRING (service), ui_serial); break; - default: /* DBUS_MESSAGE_TYPE_ERROR */ + case DBUS_MESSAGE_TYPE_ERROR: ui_serial = serial; XD_DEBUG_MESSAGE ("%s %s %s %u %s", XD_MESSAGE_TYPE_TO_STRING (mtype), @@ -1360,17 +1430,25 @@ usage: (dbus-message-internal &rest REST) */) XD_OBJECT_TO_STRING (service), ui_serial, XD_OBJECT_TO_STRING (error_name)); + break; + default: /* DBUS_MESSAGE_TYPE_INVALID */ + XD_DEBUG_MESSAGE ("%s %s %s", + XD_MESSAGE_TYPE_TO_STRING (mtype), + XD_OBJECT_TO_STRING (bus), + XD_OBJECT_TO_STRING (service)); } /* Retrieve bus address. */ connection = xd_get_connection_address (bus); - /* Create the D-Bus message. */ - dmessage = dbus_message_new (mtype); + /* Create the D-Bus message. Since DBUS_MESSAGE_TYPE_INVALID is not + a valid message type, we mockup it with DBUS_MESSAGE_TYPE_SIGNAL. */ + dmessage = dbus_message_new + ((mtype == DBUS_MESSAGE_TYPE_INVALID) ? DBUS_MESSAGE_TYPE_SIGNAL : mtype); if (dmessage == NULL) XD_SIGNAL1 (build_string ("Unable to create a new message")); - if (STRINGP (service)) + if ((STRINGP (service)) && (mtype != DBUS_MESSAGE_TYPE_INVALID)) { if (mtype != DBUS_MESSAGE_TYPE_SIGNAL) /* Set destination. */ @@ -1412,7 +1490,8 @@ usage: (dbus-message-internal &rest REST) */) XD_SIGNAL1 (build_string ("Unable to set the message parameter")); } - else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) + || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { if (!dbus_message_set_reply_serial (dmessage, serial)) XD_SIGNAL1 (build_string ("Unable to create a return message")); @@ -1434,6 +1513,7 @@ usage: (dbus-message-internal &rest REST) */) dbus_message_iter_init_append (dmessage, &iter); /* Append parameters to the message. */ + count0 = count - 1; for (; count < nargs; ++count) { dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]); @@ -1441,15 +1521,17 @@ usage: (dbus-message-internal &rest REST) */) { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]); - XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4, + XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s Parameter%"pD"d: %s", + count - count0, XD_OBJECT_TO_STRING (args[count]), + count + 1 - count0, XD_OBJECT_TO_STRING (args[count+1])); ++count; } else { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); - XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4, + XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s", count - count0, XD_OBJECT_TO_STRING (args[count])); } @@ -1460,7 +1542,10 @@ usage: (dbus-message-internal &rest REST) */) xd_append_arg (dtype, args[count], &iter); } - if (!NILP (handler)) + if (mtype == DBUS_MESSAGE_TYPE_INVALID) + result = Qt; + + else if (!NILP (handler)) { /* Send the message. The message is just added to the outgoing message queue. */ @@ -1485,7 +1570,8 @@ usage: (dbus-message-internal &rest REST) */) result = Qnil; } - XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result)); + if (mtype != DBUS_MESSAGE_TYPE_INVALID) + XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result)); /* Cleanup. */ dbus_message_unref (dmessage); @@ -1495,8 +1581,8 @@ usage: (dbus-message-internal &rest REST) */) } /* Read one queued incoming message of the D-Bus BUS. - BUS is either a Lisp symbol, :system or :session, or a string denoting - the bus address. */ + BUS is either a Lisp symbol, :system, :session, :system-private or + :session-private, or a string denoting the bus address. */ static void xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) { @@ -1508,7 +1594,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) int mtype; dbus_uint32_t serial; unsigned int ui_serial; - const char *uname, *path, *interface, *member; + const char *uname, *destination, *path, *interface, *member, *error_name; dmessage = dbus_connection_pop_message (connection); @@ -1533,7 +1619,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) } /* Read message type, message serial, unique name, object path, - interface and member from the message. */ + interface, member and error name from the message. */ mtype = dbus_message_get_type (dmessage); ui_serial = serial = ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) @@ -1541,13 +1627,16 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) ? dbus_message_get_reply_serial (dmessage) : dbus_message_get_serial (dmessage); uname = dbus_message_get_sender (dmessage); + destination = dbus_message_get_destination (dmessage); path = dbus_message_get_path (dmessage); interface = dbus_message_get_interface (dmessage); member = dbus_message_get_member (dmessage); + error_name = dbus_message_get_error_name (dmessage); - XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s", + XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s", XD_MESSAGE_TYPE_TO_STRING (mtype), - ui_serial, uname, path, interface, member, + ui_serial, uname, destination, path, interface, + mtype == DBUS_MESSAGE_TYPE_ERROR ? error_name : member, XD_OBJECT_TO_STRING (args)); if (mtype == DBUS_MESSAGE_TYPE_INVALID) @@ -1562,7 +1651,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) /* There shall be exactly one entry. Construct an event. */ if (NILP (value)) - goto cleanup; + goto monitor; /* Remove the entry. */ Fremhash (key, Vdbus_registered_objects_table); @@ -1571,6 +1660,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) EVENT_INIT (event); event.kind = DBUS_EVENT; event.frame_or_window = Qnil; + /* Handler. */ event.arg = Fcons (value, args); } @@ -1579,7 +1669,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) /* Vdbus_registered_objects_table requires non-nil interface and member. */ if ((interface == NULL) || (member == NULL)) - goto cleanup; + goto monitor; /* Search for a registered function of the message. */ key = list4 (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL ? QCmethod : QCsignal, @@ -1604,6 +1694,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) EVENT_INIT (event); event.kind = DBUS_EVENT; event.frame_or_window = Qnil; + /* Handler. */ event.arg = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args); break; @@ -1612,16 +1703,22 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) } if (NILP (value)) - goto cleanup; + goto monitor; } - /* Add type, serial, uname, path, interface and member to the event. */ - event.arg = Fcons ((member == NULL ? Qnil : build_string (member)), - event.arg); + /* Add type, serial, uname, destination, path, interface and member + or error_name to the event. */ + event.arg + = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR + ? error_name == NULL ? Qnil : build_string (error_name) + : member == NULL ? Qnil : build_string (member), + event.arg); event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)), event.arg); event.arg = Fcons ((path == NULL ? Qnil : build_string (path)), event.arg); + event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)), + event.arg); event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), event.arg); event.arg = Fcons (INT_TO_INTEGER (serial), event.arg); @@ -1635,14 +1732,58 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg)); + /* Monitor. */ + monitor: + /* Search for a registered function of the message. */ + key = list2 (QCmonitor, bus); + value = Fgethash (key, Vdbus_registered_objects_table, Qnil); + + /* There shall be exactly one entry. Construct an event. */ + if (NILP (value)) + goto cleanup; + + /* Construct an event. */ + EVENT_INIT (event); + event.kind = DBUS_EVENT; + event.frame_or_window = Qnil; + + /* Add type, serial, uname, destination, path, interface, member + or error_name and handler to the event. */ + event.arg + = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (CAR_SAFE (value))))), + args); + event.arg + = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR + ? error_name == NULL ? Qnil : build_string (error_name) + : member == NULL ? Qnil : build_string (member), + event.arg); + event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)), + event.arg); + event.arg = Fcons ((path == NULL ? Qnil : build_string (path)), + event.arg); + event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)), + event.arg); + event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), + event.arg); + event.arg = Fcons (INT_TO_INTEGER (serial), event.arg); + event.arg = Fcons (make_fixnum (mtype), event.arg); + + /* Add the bus symbol to the event. */ + event.arg = Fcons (bus, event.arg); + + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); + + XD_DEBUG_MESSAGE ("Monitor event stored: %s", XD_OBJECT_TO_STRING (event.arg)); + /* Cleanup. */ cleanup: dbus_message_unref (dmessage); } /* Read queued incoming messages of the D-Bus BUS. - BUS is either a Lisp symbol, :system or :session, or a string denoting - the bus address. */ + BUS is either a Lisp symbol, :system, :session, :system-private or + :session-private, or a string denoting the bus address. */ static Lisp_Object xd_read_message (Lisp_Object bus) { @@ -1671,7 +1812,7 @@ xd_read_queued_messages (int fd, void *data) while (!NILP (busp)) { key = CAR_SAFE (CAR_SAFE (busp)); - if ((SYMBOLP (key) && XSYMBOL (key) == data) + if ((XD_KEYWORDP (key) && XSYMBOL (key) == data) || (STRINGP (key) && XSTRING (key) == data)) bus = key; busp = CDR_SAFE (busp); @@ -1719,6 +1860,8 @@ syms_of_dbusbind (void) /* Lisp symbols of the system and session buses. */ DEFSYM (QCsystem, ":system"); DEFSYM (QCsession, ":session"); + DEFSYM (QCsystem_private, ":system-private"); + DEFSYM (QCsession_private, ":session-private"); /* Lisp symbol for method call timeout. */ DEFSYM (QCtimeout, ":timeout"); @@ -1744,10 +1887,12 @@ syms_of_dbusbind (void) DEFSYM (QCstruct, ":struct"); DEFSYM (QCdict_entry, ":dict-entry"); - /* Lisp symbols of objects in `dbus-registered-objects-table'. */ + /* Lisp symbols of objects in `dbus-registered-objects-table'. + `:property', which does exist there as well, is not declared here. */ DEFSYM (QCserial, ":serial"); DEFSYM (QCmethod, ":method"); DEFSYM (QCsignal, ":signal"); + DEFSYM (QCmonitor, ":monitor"); DEFVAR_LISP ("dbus-compiled-version", Vdbus_compiled_version, @@ -1804,29 +1949,33 @@ syms_of_dbusbind (void) doc: /* Hash table of registered functions for D-Bus. There are two different uses of the hash table: for accessing -registered interfaces properties, targeted by signals or method calls, -and for calling handlers in case of non-blocking method call returns. +registered interfaces properties, targeted by signals, method calls or +monitors, and for calling handlers in case of non-blocking method call +returns. In the first case, the key in the hash table is the list (TYPE BUS -INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method', -`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or -`:session', or a string denoting the bus address. INTERFACE is a -string which denotes a D-Bus interface, and MEMBER, also a string, is -either a method, a signal or a property INTERFACE is offering. All -arguments but BUS must not be nil. +[INTERFACE MEMBER]). TYPE is one of the Lisp symbols `:method', +`:signal', `:property' or `:monitor'. BUS is either a Lisp symbol, +`:system', `:session', `:system-private' or `:session-private', or a +string denoting the bus address. INTERFACE is a string which denotes +a D-Bus interface, and MEMBER, also a string, is either a method, a +signal or a property INTERFACE is offering. All arguments can be nil. The value in the hash table is a list of quadruple lists ((UNAME SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as registered, UNAME is the corresponding unique name. In case of -registered methods and properties, UNAME is nil. PATH is the object -path of the sending object. All of them can be nil, which means a -wildcard then. OBJECT is either the handler to be called when a D-Bus -message, which matches the key criteria, arrives (TYPE `:method' and -`:signal'), or a cons cell containing the value of the property (TYPE -`:property'). - -For entries of type `:signal', there is also a fifth element RULE, -which keeps the match string the signal is registered with. +registered methods, properties and monitors, UNAME is nil. PATH is +the object path of the sending object. All of them can be nil, which +means a wildcard then. + +OBJECT is either the handler to be called when a D-Bus message, which +matches the key criteria, arrives (TYPE `:method', `:signal' and +`:monitor'), or a list (ACCESS EMITS-SIGNAL VALUE) for TYPE +`:property'. + +For entries of type `:signal' or `:monitor', there is also a fifth +element RULE, which keeps the match string the signal or monitor is +registered with. In the second case, the key in the hash table is the list (:serial BUS SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a diff --git a/src/dired.c b/src/dired.c index f013a4cea03..8256f2626dc 100644 --- a/src/dired.c +++ b/src/dired.c @@ -293,7 +293,8 @@ DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0, There are three optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. -If MATCH is non-nil, mention only file names that match the regexp MATCH. +If MATCH is non-nil, mention only file names whose non-directory part + matches the regexp MATCH. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. Otherwise, the list returned is sorted with `string-lessp'. NOSORT is useful if you plan to sort the result yourself. */) @@ -325,11 +326,12 @@ by `file-attributes'. This function accepts four optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. -If MATCH is non-nil, mention only file names that match the regexp MATCH. +If MATCH is non-nil, mention only file names whose non-directory part + matches the regexp MATCH. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. NOSORT is useful if you plan to sort the result yourself. ID-FORMAT specifies the preferred format of attributes uid and gid, see -`file-attributes' for further documentation. + `file-attributes' for further documentation. On MS-Windows, performance depends on `w32-get-true-file-attributes', which see. */) (Lisp_Object directory, Lisp_Object full, Lisp_Object match, @@ -929,7 +931,7 @@ file_attributes (int fd, char const *name, struct stat s; /* An array to hold the mode string generated by filemodestring, - including its terminating space and NUL byte. */ + including its terminating space and null byte. */ char modes[sizeof "-rwxr-xr-x "]; char *uname = NULL, *gname = NULL; diff --git a/src/dispextern.h b/src/dispextern.h index 956ca96eb61..848d3bcd20e 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -102,7 +102,7 @@ typedef XImage *Emacs_Pix_Context; #endif #ifdef USE_CAIRO -/* Mininal version of XImage. */ +/* Minimal version of XImage. */ typedef struct { int width, height; /* size of image */ @@ -1744,6 +1744,7 @@ struct face bool_bf tty_italic_p : 1; bool_bf tty_underline_p : 1; bool_bf tty_reverse_p : 1; + bool_bf tty_strike_through_p : 1; /* True means that colors of this face may not be freed because they have been copied bitwise from a base face (see @@ -1995,7 +1996,7 @@ struct bidi_string_data { Lisp_Object lstring; /* Lisp string to reorder, or nil */ const unsigned char *s; /* string data, or NULL if reordering buffer */ ptrdiff_t schars; /* the number of characters in the string, - excluding the terminating NUL */ + excluding the terminating null */ ptrdiff_t bufpos; /* buffer position of lstring, or 0 if N/A */ bool_bf from_disp_str : 1; /* True means the string comes from a display property */ @@ -3290,6 +3291,7 @@ enum tool_bar_item_image #define TTY_CAP_BOLD 0x04 #define TTY_CAP_DIM 0x08 #define TTY_CAP_ITALIC 0x10 +#define TTY_CAP_STRIKE_THROUGH 0x20 /*********************************************************************** diff --git a/src/dispnew.c b/src/dispnew.c index d318e26308e..3f2ae3e6ad1 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -1830,7 +1830,7 @@ adjust_frame_glyphs (struct frame *f) /* Don't forget the buffer for decode_mode_spec. */ adjust_decode_mode_spec_buffer (f); - f->glyphs_initialized_p = 1; + f->glyphs_initialized_p = true; unblock_input (); } @@ -2251,7 +2251,7 @@ free_glyphs (struct frame *f) /* Block interrupt input so that we don't get surprised by an X event while we're in an inconsistent state. */ block_input (); - f->glyphs_initialized_p = 0; + f->glyphs_initialized_p = false; /* Release window sub-matrices. */ if (!NILP (f->root_window)) @@ -3236,9 +3236,16 @@ update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p) build_frame_matrix (f); /* Update the display. */ - update_begin (f); - paused_p = update_frame_1 (f, force_p, inhibit_hairy_id_p, 1, false); - update_end (f); + if (FRAME_INITIAL_P (f)) + /* No actual display to update so the "update" is a nop and + obviously isn't interrupted by pending input. */ + paused_p = false; + else + { + update_begin (f); + paused_p = update_frame_1 (f, force_p, inhibit_hairy_id_p, 1, false); + update_end (f); + } if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) { diff --git a/src/doc.c b/src/doc.c index 285c0dbbbee..f1ce266d39f 100644 --- a/src/doc.c +++ b/src/doc.c @@ -233,7 +233,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) } /* Scan the text and perform quoting with ^A (char code 1). - ^A^A becomes ^A, ^A0 becomes a NUL char, and ^A_ becomes a ^_. */ + ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */ from = get_doc_string_buffer + offset; to = get_doc_string_buffer + offset; while (from != p) @@ -415,7 +415,7 @@ string is passed through `substitute-command-keys'. */) } if (NILP (raw)) - doc = Fsubstitute_command_keys (doc); + doc = call1 (Qsubstitute_command_keys, doc); return doc; } @@ -472,7 +472,7 @@ aren't strings. */) tem = Feval (tem, Qnil); if (NILP (raw) && STRINGP (tem)) - tem = Fsubstitute_command_keys (tem); + tem = call1 (Qsubstitute_command_keys, tem); return tem; } @@ -696,315 +696,34 @@ text_quoting_style (void) return CURVE_QUOTING_STYLE; } -DEFUN ("substitute-command-keys", Fsubstitute_command_keys, - Ssubstitute_command_keys, 1, 1, 0, - doc: /* Substitute key descriptions for command names in STRING. -Each substring of the form \\=\\[COMMAND] is replaced by either a -keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND -is not on any keys. - -Each substring of the form \\=\\{MAPVAR} is replaced by a summary of -the value of MAPVAR as a keymap. This summary is similar to the one -produced by `describe-bindings'. The summary ends in two newlines -\(used by the helper function `help-make-xrefs' to find the end of the -summary). - -Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR -as the keymap for future \\=\\[COMMAND] substrings. - -Each grave accent \\=` is replaced by left quote, and each apostrophe \\=' -is replaced by right quote. Left and right quote characters are -specified by `text-quoting-style'. - -\\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\= -into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and \\=\\=\\=` puts \\=` into the -output. - -Return the original STRING if no substitutions are made. -Otherwise, return a new string (without any text properties). */) - (Lisp_Object string) +/* This is just a Lisp wrapper for text_quoting_style above. */ +DEFUN ("get-quoting-style", Fget_quoting_style, + Sget_quoting_style, 0, 0, 0, + doc: /* Return the current effective text quoting style. +See variable `text-quoting-style'. */) + (void) { - char *buf; - bool changed = false; - bool nonquotes_changed = false; - unsigned char *strp; - char *bufp; - ptrdiff_t idx; - ptrdiff_t bsize; - Lisp_Object tem; - Lisp_Object keymap; - unsigned char const *start; - ptrdiff_t length, length_byte; - Lisp_Object name; - ptrdiff_t nchars; - - if (NILP (string)) - return Qnil; - - /* If STRING contains non-ASCII unibyte data, process its - properly-encoded multibyte equivalent instead. This simplifies - the implementation and is OK since substitute-command-keys is - intended for use only on text strings. Keep STRING around, since - it will be returned if no changes occur. */ - Lisp_Object str = Fstring_make_multibyte (string); - - enum text_quoting_style quoting_style = text_quoting_style (); - - nchars = 0; - - /* KEYMAP is either nil (which means search all the active keymaps) - or a specified local map (which means search just that and the - global map). If non-nil, it might come from Voverriding_local_map, - or from a \\<mapname> construct in STRING itself.. */ - keymap = Voverriding_local_map; - - ptrdiff_t strbytes = SBYTES (str); - bsize = strbytes; - - /* Fixed-size stack buffer. */ - char sbuf[MAX_ALLOCA]; - - /* Heap-allocated buffer, if any. */ - char *abuf; - - /* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */ - enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" }; - - ptrdiff_t count = SPECPDL_INDEX (); - - if (bsize <= sizeof sbuf - EXTRA_ROOM) - { - abuf = NULL; - buf = sbuf; - bsize = sizeof sbuf; - } - else - { - buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1); - record_unwind_protect_ptr (xfree, abuf); - } - bufp = buf; - - strp = SDATA (str); - while (strp < SDATA (str) + strbytes) - { - unsigned char *close_bracket; - - if (strp[0] == '\\' && strp[1] == '=' - && strp + 2 < SDATA (str) + strbytes) - { - /* \= quotes the next character; - thus, to put in \[ without its special meaning, use \=\[. */ - changed = nonquotes_changed = true; - strp += 2; - /* Fall through to copy one char. */ - } - else if (strp[0] == '\\' && strp[1] == '[' - && (close_bracket - = memchr (strp + 2, ']', - SDATA (str) + strbytes - (strp + 2)))) - { - bool follow_remap = 1; - - start = strp + 2; - length_byte = close_bracket - start; - idx = close_bracket + 1 - SDATA (str); - - name = Fintern (make_string ((char *) start, length_byte), Qnil); - - do_remap: - tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil); - - if (VECTORP (tem) && ASIZE (tem) > 1 - && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1)) - && follow_remap) - { - name = AREF (tem, 1); - follow_remap = 0; - goto do_remap; - } - - /* Fwhere_is_internal can GC, so take relocation of string - contents into account. */ - strp = SDATA (str) + idx; - start = strp - length_byte - 1; - - if (NILP (tem)) /* but not on any keys */ - { - memcpy (bufp, "M-x ", 4); - bufp += 4; - nchars += 4; - length = multibyte_chars_in_text (start, length_byte); - goto subst; - } - else - { /* function is on a key */ - tem = Fkey_description (tem, Qnil); - goto subst_string; - } - } - /* \{foo} is replaced with a summary of the keymap (symbol-value foo). - \<foo> just sets the keymap used for \[cmd]. */ - else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<') - && (close_bracket - = memchr (strp + 2, strp[1] == '{' ? '}' : '>', - SDATA (str) + strbytes - (strp + 2)))) - { - { - bool generate_summary = strp[1] == '{'; - /* This is for computing the SHADOWS arg for describe_map_tree. */ - Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil); - ptrdiff_t count = SPECPDL_INDEX (); - - start = strp + 2; - length_byte = close_bracket - start; - idx = close_bracket + 1 - SDATA (str); - - /* Get the value of the keymap in TEM, or nil if undefined. - Do this while still in the user's current buffer - in case it is a local variable. */ - name = Fintern (make_string ((char *) start, length_byte), Qnil); - tem = Fboundp (name); - if (! NILP (tem)) - { - tem = Fsymbol_value (name); - if (! NILP (tem)) - tem = get_keymap (tem, 0, 1); - } - - /* Now switch to a temp buffer. */ - struct buffer *oldbuf = current_buffer; - set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); - /* This is for an unusual case where some after-change - function uses 'format' or 'prin1' or something else that - will thrash Vprin1_to_string_buffer we are using. */ - specbind (Qinhibit_modification_hooks, Qt); - - if (NILP (tem)) - { - name = Fsymbol_name (name); - AUTO_STRING (msg_prefix, "\nUses keymap `"); - insert1 (Fsubstitute_command_keys (msg_prefix)); - insert_from_string (name, 0, 0, - SCHARS (name), - SBYTES (name), 1); - AUTO_STRING (msg_suffix, "', which is not currently defined.\n"); - insert1 (Fsubstitute_command_keys (msg_suffix)); - if (!generate_summary) - keymap = Qnil; - } - else if (!generate_summary) - keymap = tem; - else - { - /* Get the list of active keymaps that precede this one. - If this one's not active, get nil. */ - Lisp_Object earlier_maps - = Fcdr (Fmemq (tem, Freverse (active_maps))); - describe_map_tree (tem, 1, Fnreverse (earlier_maps), - Qnil, 0, 1, 0, 0, 1); - } - tem = Fbuffer_string (); - Ferase_buffer (); - set_buffer_internal (oldbuf); - unbind_to (count, Qnil); - } - - subst_string: - /* Convert non-ASCII unibyte data to properly-encoded multibyte, - for the same reason STRING was converted to STR. */ - tem = Fstring_make_multibyte (tem); - start = SDATA (tem); - length = SCHARS (tem); - length_byte = SBYTES (tem); - subst: - nonquotes_changed = true; - subst_quote: - changed = true; - { - ptrdiff_t offset = bufp - buf; - ptrdiff_t avail = bsize - offset; - ptrdiff_t need = strbytes - idx; - if (INT_ADD_WRAPV (need, length_byte + EXTRA_ROOM, &need)) - string_overflow (); - if (avail < need) - { - abuf = xpalloc (abuf, &bsize, need - avail, - STRING_BYTES_BOUND, 1); - if (buf == sbuf) - { - record_unwind_protect_ptr (xfree, abuf); - memcpy (abuf, sbuf, offset); - } - else - set_unwind_protect_ptr (count, xfree, abuf); - buf = abuf; - bufp = buf + offset; - } - memcpy (bufp, start, length_byte); - bufp += length_byte; - nchars += length; - - /* Some of the previous code can GC, so take relocation of - string contents into account. */ - strp = SDATA (str) + idx; - - continue; - } - } - else if ((strp[0] == '`' || strp[0] == '\'') - && quoting_style == CURVE_QUOTING_STYLE) - { - start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM); - length = 1; - length_byte = sizeof uLSQM - 1; - idx = strp - SDATA (str) + 1; - goto subst_quote; - } - else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE) - { - *bufp++ = '\''; - strp++; - nchars++; - changed = true; - continue; - } - - /* Copy one char. */ - do - *bufp++ = *strp++; - while (! CHAR_HEAD_P (*strp)); - nchars++; - } - - if (changed) /* don't bother if nothing substituted */ + switch (text_quoting_style ()) { - tem = make_string_from_bytes (buf, nchars, bufp - buf); - if (!nonquotes_changed) - { - /* Nothing has changed other than quoting, so copy the string’s - text properties. FIXME: Text properties should survive other - changes too; see bug#17052. */ - INTERVAL interval_copy = copy_intervals (string_intervals (string), - 0, SCHARS (string)); - if (interval_copy) - { - set_interval_object (interval_copy, tem); - set_string_intervals (tem, interval_copy); - } - } + case STRAIGHT_QUOTING_STYLE: + return Qstraight; + case CURVE_QUOTING_STYLE: + return Qcurve; + case GRAVE_QUOTING_STYLE: + default: + return Qgrave; } - else - tem = string; - return unbind_to (count, tem); } + void syms_of_doc (void) { + DEFSYM (Qsubstitute_command_keys, "substitute-command-keys"); DEFSYM (Qfunction_documentation, "function-documentation"); DEFSYM (Qgrave, "grave"); DEFSYM (Qstraight, "straight"); + DEFSYM (Qcurve, "curve"); DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name, doc: /* Name of file containing documentation strings of built-in symbols. */); @@ -1036,5 +755,5 @@ otherwise. */); defsubr (&Sdocumentation); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation); - defsubr (&Ssubstitute_command_keys); + defsubr (&Sget_quoting_style); } diff --git a/src/doprnt.c b/src/doprnt.c index b0ba12552bc..ce259d07cfe 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ . For %s and %c, when field width is specified (e.g., %25s), it accounts for the display width of each character, according to char-width-table. That is, it does not assume that each character takes one column on display. + Nor does it assume that each character is a single byte. . If the size of the buffer is not enough to produce the formatted string in its entirety, it makes sure that truncation does not chop the last @@ -35,19 +36,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ sequence. . It accepts a pointer to the end of the format string, so the format string - could include embedded NUL characters. + could include embedded null characters. . It signals an error if the length of the formatted string is about to overflow ptrdiff_t or size_t, to avoid producing strings longer than what Emacs can handle. OTOH, this function supports only a small subset of the standard C formatted - output facilities. E.g., %u and %ll are not supported, and precision is - ignored %s and %c conversions. (See below for the detailed documentation of - what is supported.) However, this is okay, as this function is supposed to - be called from `error' and similar functions, and thus does not need to - support features beyond those in `Fformat_message', which is used - by `error' on the Lisp level. */ + output facilities. E.g., %u is not supported, precision is ignored + in %s and %c conversions, and %lld does not necessarily work and + code should use something like %"pM"d with intmax_t instead. + (See below for the detailed documentation of what is supported.) + However, this is okay, as this function is supposed to be called + from 'error' and similar C functions, and thus does not need to + support all the features of 'Fformat_message', which is used by the + Lisp 'error' function. */ /* In the FORMAT argument this function supports ` and ' as directives that output left and right quotes as per ‘text-quoting style’. It @@ -61,19 +64,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ %e means print a `double' argument in exponential notation. %f means print a `double' argument in decimal-point notation. %g means print a `double' argument in exponential notation - or in decimal-point notation, whichever uses fewer characters. + or in decimal-point notation, depending on the value; + this is often (though not always) the shorter of the two notations. %c means print a `signed int' argument as a single character. %% means produce a literal % character. - A %-sequence may contain optional flag, width, and precision specifiers, and - a length modifier, as follows: + A %-sequence other than %% may contain optional flags, width, precision, + and length, as follows: %<flags><width><precision><length>character where flags is [+ -0], width is [0-9]+, precision is .[0-9]+, and length is empty or l or the value of the pD or pI or PRIdMAX (sans "d") macros. - Also, %% in a format stands for a single % in the output. A % that - does not introduce a valid %-sequence causes undefined behavior. + A % that does not introduce a valid %-sequence causes undefined behavior. + ASCII bytes in FORMAT other than % are copied through as-is; + non-ASCII bytes should not appear in FORMAT. The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only affect %d, %o, @@ -99,7 +104,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ For %e, %f, and %g sequences, the number after the "." in the precision specifier says how many decimal places to show; if zero, the decimal point - itself is omitted. For %s and %S, the precision specifier is ignored. */ + itself is omitted. For %d, %o, and %x sequences, the precision specifies + the minimum number of digits to appear. Precision specifiers are + not supported for other %-sequences. */ #include <config.h> #include <stdio.h> @@ -115,7 +122,50 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ another macro. */ #include "character.h" +/* Enough to handle floating point formats with large numbers. */ +enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 }; + +/* Parse FMT as an unsigned decimal integer, putting its value into *VALUE. + Return the address of the first byte after the integer. + If FMT is not an integer, return FMT and store zero into *VALUE. */ +static char const * +parse_format_integer (char const *fmt, int *value) +{ + int n = 0; + bool overflow = false; + for (; '0' <= *fmt && *fmt <= '9'; fmt++) + { + overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); + overflow |= INT_ADD_WRAPV (n, *fmt - '0', &n); + } + if (overflow || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n) + error ("Format width or precision too large"); + *value = n; + return fmt; +} + +/* Like doprnt, except FORMAT_END must be non-null. + Although this function is never exercised in current Emacs, + it is retained in case some future Emacs version + contains doprnt callers that need such formats. + Having a separate function helps GCC optimize doprnt better. */ +static ptrdiff_t +doprnt_non_null_end (char *buffer, ptrdiff_t bufsize, char const *format, + char const *format_end, va_list ap) +{ + USE_SAFE_ALLOCA; + ptrdiff_t fmtlen = format_end - format; + char *fmt = SAFE_ALLOCA (fmtlen + 1); + memcpy (fmt, format, fmtlen); + fmt[fmtlen] = 0; + ptrdiff_t nbytes = doprnt (buffer, bufsize, fmt, NULL, ap); + SAFE_FREE (); + return nbytes; +} + /* Generate output from a format-spec FORMAT, + terminated at either the first NUL or (if FORMAT_END is non-null + and there are no NUL bytes between FORMAT and FORMAT_END) terminated at position FORMAT_END. (*FORMAT_END is not part of the format, but must exist and be readable.) Output goes in BUFFER, which has room for BUFSIZE chars. @@ -123,7 +173,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ to fit and return BUFSIZE - 1; if this truncates a multibyte sequence, store '\0' into the sequence's first byte. Returns the number of bytes stored into BUFFER, excluding - the terminating NUL byte. Output is always NUL-terminated. + the terminating null byte. Output is always null-terminated. String arguments are passed as C strings. Integers are passed as C integers. */ @@ -131,12 +181,12 @@ ptrdiff_t doprnt (char *buffer, ptrdiff_t bufsize, const char *format, const char *format_end, va_list ap) { + if (format_end) + return doprnt_non_null_end (buffer, bufsize, format, format_end, ap); + const char *fmt = format; /* Pointer into format string. */ char *bufptr = buffer; /* Pointer into output buffer. */ - /* Enough to handle floating point formats with large numbers. */ - enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 }; - /* Use this for sprintf unless we need something really big. */ char tembuf[SIZE_BOUND_EXTRA + 50]; @@ -150,103 +200,91 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, char *big_buffer = NULL; enum text_quoting_style quoting_style = text_quoting_style (); - ptrdiff_t tem = -1; - char *string; - char fixed_buffer[20]; /* Default buffer for small formatting. */ - char *fmtcpy; - int minlen; - char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */ - USE_SAFE_ALLOCA; - - if (format_end == 0) - format_end = format + strlen (format); - - fmtcpy = (format_end - format < sizeof (fixed_buffer) - 1 - ? fixed_buffer - : SAFE_ALLOCA (format_end - format + 1)); bufsize--; /* Loop until end of format string or buffer full. */ - while (fmt < format_end && bufsize > 0) + while (*fmt && bufsize > 0) { char const *fmt0 = fmt; char fmtchar = *fmt++; if (fmtchar == '%') { - ptrdiff_t size_bound = 0; ptrdiff_t width; /* Columns occupied by STRING on display. */ enum { pDlen = sizeof pD - 1, pIlen = sizeof pI - 1, - pMlen = sizeof PRIdMAX - 2 + pMlen = sizeof PRIdMAX - 2, + maxmlen = max (max (1, pDlen), max (pIlen, pMlen)) }; enum { no_modifier, long_modifier, pD_modifier, pI_modifier, pM_modifier } length_modifier = no_modifier; static char const modifier_len[] = { 0, 1, pDlen, pIlen, pMlen }; - int maxmlen = max (max (1, pDlen), max (pIlen, pMlen)); int mlen; + char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */ - /* Copy this one %-spec into fmtcpy. */ - string = fmtcpy; + /* Width and precision specified by this %-sequence. */ + int wid = 0, prec = -1; + + /* FMTSTAR will be a "%*.*X"-like version of this %-sequence. + Start by putting '%' into FMTSTAR. */ + char fmtstar[sizeof "%-+ 0*.*d" + maxmlen]; + char *string = fmtstar; *string++ = '%'; - while (fmt < format_end) + + /* Copy at most one instance of each flag into FMTSTAR. */ + bool minusflag = false, plusflag = false, zeroflag = false, + spaceflag = false; + for (;; fmt++) { - *string++ = *fmt; - if ('0' <= *fmt && *fmt <= '9') + *string = *fmt; + switch (*fmt) { - /* Get an idea of how much space we might need. - This might be a field width or a precision; e.g. - %1.1000f and %1000.1f both might need 1000+ bytes. - Parse the width or precision, checking for overflow. */ - int n = *fmt - '0'; - bool overflow = false; - while (fmt + 1 < format_end - && '0' <= fmt[1] && fmt[1] <= '9') - { - overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); - overflow |= INT_ADD_WRAPV (n, fmt[1] - '0', &n); - *string++ = *++fmt; - } - - if (overflow - || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n) - error ("Format width or precision too large"); - if (size_bound < n) - size_bound = n; + case '-': string += !minusflag; minusflag = true; continue; + case '+': string += !plusflag; plusflag = true; continue; + case ' ': string += !spaceflag; spaceflag = true; continue; + case '0': string += !zeroflag; zeroflag = true; continue; } - else if (! (*fmt == '-' || *fmt == ' ' || *fmt == '.' - || *fmt == '+')) - break; - fmt++; + break; } + /* Parse width and precision, putting "*.*" into FMTSTAR. */ + if ('1' <= *fmt && *fmt <= '9') + fmt = parse_format_integer (fmt, &wid); + if (*fmt == '.') + fmt = parse_format_integer (fmt + 1, &prec); + *string++ = '*'; + *string++ = '.'; + *string++ = '*'; + /* Check for the length modifiers in textual length order, so that longer modifiers override shorter ones. */ for (mlen = 1; mlen <= maxmlen; mlen++) { - if (format_end - fmt < mlen) - break; if (mlen == 1 && *fmt == 'l') length_modifier = long_modifier; - if (mlen == pDlen && memcmp (fmt, pD, pDlen) == 0) + if (mlen == pDlen && strncmp (fmt, pD, pDlen) == 0) length_modifier = pD_modifier; - if (mlen == pIlen && memcmp (fmt, pI, pIlen) == 0) + if (mlen == pIlen && strncmp (fmt, pI, pIlen) == 0) length_modifier = pI_modifier; - if (mlen == pMlen && memcmp (fmt, PRIdMAX, pMlen) == 0) + if (mlen == pMlen && strncmp (fmt, PRIdMAX, pMlen) == 0) length_modifier = pM_modifier; } + /* Copy optional length modifier and conversion specifier + character into FMTSTAR, and append a NUL. */ mlen = modifier_len[length_modifier]; - memcpy (string, fmt + 1, mlen); - string += mlen; + string = mempcpy (string, fmt, mlen + 1); fmt += mlen; *string = 0; - /* Make the size bound large enough to handle floating point formats + /* An idea of how much space we might need. + This might be a field width or a precision; e.g. + %1.1000f and %1000.1f both might need 1000+ bytes. + Make it large enough to handle floating point formats with large numbers. */ - size_bound += SIZE_BOUND_EXTRA; + ptrdiff_t size_bound = max (wid, prec) + SIZE_BOUND_EXTRA; /* Make sure we have that much. */ if (size_bound > size_allocated) @@ -257,48 +295,49 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, sprintf_buffer = big_buffer; size_allocated = size_bound; } - minlen = 0; + int minlen = 0; + ptrdiff_t tem; switch (*fmt++) { default: - error ("Invalid format operation %s", fmtcpy); + error ("Invalid format operation %s", fmt0); -/* case 'b': */ - case 'l': case 'd': switch (length_modifier) { case no_modifier: { int v = va_arg (ap, int); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case long_modifier: { long v = va_arg (ap, long); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pD_modifier: signed_pD_modifier: { ptrdiff_t v = va_arg (ap, ptrdiff_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pI_modifier: { EMACS_INT v = va_arg (ap, EMACS_INT); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pM_modifier: { intmax_t v = va_arg (ap, intmax_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; + default: + eassume (false); } /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; @@ -311,13 +350,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case no_modifier: { unsigned v = va_arg (ap, unsigned); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case long_modifier: { unsigned long v = va_arg (ap, unsigned long); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pD_modifier: @@ -325,15 +364,17 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case pI_modifier: { EMACS_UINT v = va_arg (ap, EMACS_UINT); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pM_modifier: { uintmax_t v = va_arg (ap, uintmax_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; + default: + eassume (false); } /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; @@ -344,18 +385,15 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case 'g': { double d = va_arg (ap, double); - tem = sprintf (sprintf_buffer, fmtcpy, d); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, d); /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; goto doit; } case 'S': - string[-1] = 's'; - FALLTHROUGH; case 's': - if (fmtcpy[1] != 's') - minlen = atoi (&fmtcpy[1]); + minlen = minusflag ? -wid : wid; string = va_arg (ap, char *); tem = strnlen (string, STRING_BYTES_BOUND + 1); if (tem == STRING_BYTES_BOUND + 1) @@ -432,14 +470,12 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, string = charbuf; string[tem] = 0; width = strwidth (string, tem); - if (fmtcpy[1] != 'c') - minlen = atoi (&fmtcpy[1]); + minlen = minusflag ? -wid : wid; goto doit1; } case '%': /* Treat this '%' as normal. */ - fmt0 = fmt - 1; break; } } @@ -450,13 +486,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, src = uLSQM, srclen = sizeof uLSQM - 1; else if (quoting_style == CURVE_QUOTING_STYLE && fmtchar == '\'') src = uRSQM, srclen = sizeof uRSQM - 1; - else if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`') - src = "'", srclen = 1; else { - while (fmt < format_end && !CHAR_HEAD_P (*fmt)) - fmt++; - src = fmt0, srclen = fmt - fmt0; + if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`') + fmtchar = '\''; + eassert (ASCII_CHAR_P (fmtchar)); + *bufptr++ = fmtchar; + continue; } if (bufsize < srclen) @@ -479,8 +515,6 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, xfree (big_buffer); *bufptr = 0; /* Make sure our string ends with a '\0' */ - - SAFE_FREE (); return bufptr - buffer; } diff --git a/src/editfns.c b/src/editfns.c index 7e1e24ef16a..ca6b8981ebf 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3069,7 +3069,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) : FLT_RADIX == 16 ? 4 : -1)), - /* Maximum number of bytes (including terminating NUL) generated + /* Maximum number of bytes (including terminating null) generated by any format, if precision is no more than USEFUL_PRECISION_MAX. On all practical hosts, %Lf is the worst case. */ SPRINTF_BUFSIZE = (sizeof "-." + (LDBL_MAX_10_EXP + 1) diff --git a/src/emacs-module.c b/src/emacs-module.c index a0bab118019..23b8e8620c9 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -41,7 +41,7 @@ rules: module-env-VER.h. Add functions solely at the end of the fragment file for the next (not yet released) major version of Emacs. For example, if the current Emacs release is 26.2, add functions only to - emacs-env-27.h. + module-env-27.h. - emacs-module.h should only depend on standard C headers. In particular, don't include config.h or lisp.h from emacs-module.h. @@ -55,7 +55,7 @@ rules: To add a new module function, proceed as follows: -1. Add a new function pointer field at the end of the emacs-env-*.h +1. Add a new function pointer field at the end of the module-env-*.h file for the next major version of Emacs. 2. Run config.status or configure to regenerate emacs-module.h. @@ -551,7 +551,7 @@ struct Lisp_Module_Function union vectorlike_header header; /* Fields traced by GC; these must come first. */ - Lisp_Object documentation; + Lisp_Object documentation, interactive_form; /* Fields ignored by GC. */ ptrdiff_t min_arity, max_arity; @@ -564,7 +564,7 @@ static struct Lisp_Module_Function * allocate_module_function (void) { return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function, - documentation, PVEC_MODULE_FUNCTION); + interactive_form, PVEC_MODULE_FUNCTION); } #define XSET_MODULE_FUNCTION(var, ptr) \ @@ -630,6 +630,24 @@ module_finalize_function (const struct Lisp_Module_Function *func) func->finalizer (func->data); } +static void +module_make_interactive (emacs_env *env, emacs_value function, emacs_value spec) +{ + MODULE_FUNCTION_BEGIN (); + Lisp_Object lisp_fun = value_to_lisp (function); + CHECK_MODULE_FUNCTION (lisp_fun); + Lisp_Object lisp_spec = value_to_lisp (spec); + /* Normalize (interactive nil) to (interactive). */ + XMODULE_FUNCTION (lisp_fun)->interactive_form + = NILP (lisp_spec) ? list1 (Qinteractive) : list2 (Qinteractive, lisp_spec); +} + +Lisp_Object +module_function_interactive_form (const struct Lisp_Module_Function *fun) +{ + return fun->interactive_form; +} + static emacs_value module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs, emacs_value *args) @@ -773,6 +791,18 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t len) } static emacs_value +module_make_unibyte_string (emacs_env *env, const char *str, ptrdiff_t length) +{ + MODULE_FUNCTION_BEGIN (NULL); + if (! (0 <= length && length <= STRING_BYTES_BOUND)) + overflow_error (); + Lisp_Object lstr = make_uninit_string (length); + memcpy (SDATA (lstr), str, length); + SDATA (lstr)[length] = 0; + return lisp_to_value (env, lstr); +} + +static emacs_value module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr) { MODULE_FUNCTION_BEGIN (NULL); @@ -1446,6 +1476,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->make_float = module_make_float; env->copy_string_contents = module_copy_string_contents; env->make_string = module_make_string; + env->make_unibyte_string = module_make_unibyte_string; env->make_user_ptr = module_make_user_ptr; env->get_user_ptr = module_get_user_ptr; env->set_user_ptr = module_set_user_ptr; @@ -1463,6 +1494,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->get_function_finalizer = module_get_function_finalizer; env->set_function_finalizer = module_set_function_finalizer; env->open_channel = module_open_channel; + env->make_interactive = module_make_interactive; Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } diff --git a/src/emacs.c b/src/emacs.c index 059e1c6d8f0..e9e9661c398 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1273,7 +1273,7 @@ main (int argc, char **argv) || (fcntl (STDIN_FILENO, F_DUPFD_CLOEXEC, STDOUT_FILENO) != STDOUT_FILENO)) { - char *errstring = strerror (errno); + const char *errstring = strerror (errno); fprintf (stderr, "%s: %s: %s\n", argv[0], term, errstring); exit (EXIT_FAILURE); } @@ -2735,7 +2735,7 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) } } else if (cnv_result != 0 && d > path_utf8) - d[-1] = '\0'; /* remove last semi-colon and NUL-terminate PATH */ + d[-1] = '\0'; /* remove last semi-colon and null-terminate PATH */ } while (q); path_copy = path_utf8; #else /* MSDOS */ diff --git a/src/eval.c b/src/eval.c index 126ee2e9555..76708e6e7e2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -544,7 +544,10 @@ usage: (quote ARG) */) DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, doc: /* Like `quote', but preferred for objects which are functions. In byte compilation, `function' causes its argument to be handled by -the byte compiler. `quote' cannot do that. +the byte compiler. Similarly, when expanding macros and expressions, +ARG can be examined and possibly expanded. If `quote' is used +instead, this doesn't happen. + usage: (function ARG) */) (Lisp_Object args) { @@ -1948,6 +1951,15 @@ then strings and vectors are not accepted. */) else if (COMPILEDP (fun)) return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop); +#ifdef HAVE_MODULES + /* Module functions are interactive if their `interactive_form' + field is non-nil. */ + else if (MODULE_FUNCTIONP (fun)) + return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))) + ? if_prop + : Qt; +#endif + /* Strings and vectors are keyboard macros. */ if (STRINGP (fun) || VECTORP (fun)) return (NILP (for_call_interactively) ? Qt : Qnil); @@ -2362,6 +2374,8 @@ eval_sub (Lisp_Object form) DEFUN ("apply", Fapply, Sapply, 1, MANY, 0, doc: /* Call FUNCTION with our remaining args, using our last arg as list of args. Then return the value FUNCTION returns. +With a single argument, call the argument's first element using the +other elements as args. Thus, (apply \\='+ 1 2 \\='(3 4)) returns 10. usage: (apply FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) @@ -2375,7 +2389,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) ptrdiff_t numargs = list_length (spread_arg); if (numargs == 0) - return Ffuncall (nargs - 1, args); + return Ffuncall (max (1, nargs - 1), args); else if (numargs == 1) { args [nargs - 1] = XCAR (spread_arg); diff --git a/src/fileio.c b/src/fileio.c index 1e4ca82e5f3..283813ff89e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1710,7 +1710,7 @@ See also the function `substitute-in-file-name'.") #endif /* Put into BUF the concatenation of DIR and FILE, with an intervening - directory separator if needed. Return a pointer to the NUL byte + directory separator if needed. Return a pointer to the null byte at the end of the concatenated string. */ char * splice_dir_file (char *buf, char const *dir, char const *file) @@ -2919,6 +2919,11 @@ DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, doc: /* Return t if FILENAME names an existing directory. Return nil if FILENAME does not name a directory, or if there was trouble determining whether FILENAME is a directory. + +As a special case, this function will also return t if FILENAME is the +empty string (\"\"). This quirk is due to Emacs interpreting the +empty string (in some cases) as the current directory. + Symbolic links to directories count as directories. See `file-symlink-p' to distinguish symlinks. */) (Lisp_Object filename) diff --git a/src/filelock.c b/src/filelock.c index ee46e0e3e00..39febd366d8 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -296,7 +296,7 @@ typedef struct /* Write the name of the lock file for FNAME into LOCKNAME. Length will be that of FNAME plus two more for the leading ".#", plus one - for the NUL. */ + for the null. */ #define MAKE_LOCK_NAME(lockname, fname) \ (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \ fill_in_lock_file_name (lockname, fname)) diff --git a/src/fns.c b/src/fns.c index a3b8d6ef57d..f50bf8ecb77 100644 --- a/src/fns.c +++ b/src/fns.c @@ -406,7 +406,7 @@ string_version_cmp (Lisp_Object string1, Lisp_Object string2) while ((cmp = filevercmp (p1, p2)) == 0) { - /* If the strings are identical through their first NUL bytes, + /* If the strings are identical through their first null bytes, skip past identical prefixes and try again. */ ptrdiff_t size = strlen (p1) + 1; eassert (size == strlen (p2) + 1); @@ -2295,6 +2295,7 @@ The PLIST is modified by side effects. */) DEFUN ("eql", Feql, Seql, 2, 2, 0, doc: /* Return t if the two args are `eq' or are indistinguishable numbers. +Integers with the same value are `eql'. Floating-point values with the same sign, exponent and fraction are `eql'. This differs from numeric comparison: (eql 0.0 -0.0) returns nil and \(eql 0.0e+NaN 0.0e+NaN) returns t, whereas `=' does the opposite. */) @@ -5454,6 +5455,95 @@ It should not be used for anything security-related. See return make_digest_string (digest, SHA1_DIGEST_SIZE); } +static bool +string_ascii_p (Lisp_Object string) +{ + ptrdiff_t nbytes = SBYTES (string); + for (ptrdiff_t i = 0; i < nbytes; i++) + if (SREF (string, i) > 127) + return false; + return true; +} + +DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0, + doc: /* Search for the string NEEDLE in the string HAYSTACK. +The return value is the position of the first occurrence of NEEDLE in +HAYSTACK, or nil if no match was found. + +The optional START-POS argument says where to start searching in +HAYSTACK and defaults to zero (start at the beginning). +It must be between zero and the length of HAYSTACK, inclusive. + +Case is always significant and text properties are ignored. */) + (register Lisp_Object needle, Lisp_Object haystack, Lisp_Object start_pos) +{ + ptrdiff_t start_byte = 0, haybytes; + char *res, *haystart; + EMACS_INT start = 0; + + CHECK_STRING (needle); + CHECK_STRING (haystack); + + if (!NILP (start_pos)) + { + CHECK_FIXNUM (start_pos); + start = XFIXNUM (start_pos); + if (start < 0 || start > SCHARS (haystack)) + xsignal1 (Qargs_out_of_range, start_pos); + start_byte = string_char_to_byte (haystack, start); + } + + /* If NEEDLE is longer than (the remaining length of) haystack, then + we can't have a match, and return early. */ + if (SCHARS (needle) > SCHARS (haystack) - start) + return Qnil; + + haystart = SSDATA (haystack) + start_byte; + haybytes = SBYTES (haystack) - start_byte; + + /* We can do a direct byte-string search if both strings have the + same multibyteness, or if at least one of them consists of ASCII + characters only. */ + if (STRING_MULTIBYTE (haystack) + ? (STRING_MULTIBYTE (needle) + || SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle)) + : (!STRING_MULTIBYTE (needle) + || SCHARS (needle) == SBYTES (needle) || string_ascii_p (haystack))) + res = memmem (haystart, haybytes, + SSDATA (needle), SBYTES (needle)); + else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */ + { + Lisp_Object multi_needle = string_to_multibyte (needle); + res = memmem (haystart, haybytes, + SSDATA (multi_needle), SBYTES (multi_needle)); + } + else /* unibyte haystack, multibyte needle */ + { + /* The only possible way we can find the multibyte needle in the + unibyte stack (since we know that neither are pure-ASCII) is + if they contain "raw bytes" (and no other non-ASCII chars.) */ + ptrdiff_t nbytes = SBYTES (needle); + for (ptrdiff_t i = 0; i < nbytes; i++) + { + int c = SREF (needle, i); + if (CHAR_BYTE8_HEAD_P (c)) + i++; /* Skip raw byte. */ + else if (!ASCII_CHAR_P (c)) + return Qnil; /* Found a char that can't be in the haystack. */ + } + + /* "Raw bytes" (aka eighth-bit) are represented differently in + multibyte and unibyte strings. */ + Lisp_Object uni_needle = Fstring_to_unibyte (needle); + res = memmem (haystart, haybytes, + SSDATA (uni_needle), SBYTES (uni_needle)); + } + + if (! res) + return Qnil; + + return make_int (string_byte_to_char (haystack, res - SSDATA (haystack))); +} void @@ -5494,6 +5584,7 @@ syms_of_fns (void) defsubr (&Sremhash); defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); + defsubr (&Sstring_search); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); diff --git a/src/font.c b/src/font.c index 2786a772dc3..8dbf8cb8999 100644 --- a/src/font.c +++ b/src/font.c @@ -188,6 +188,9 @@ font_make_object (int size, Lisp_Object entity, int pixelsize) FONT_OBJECT_MAX, PVEC_FONT); int i; + /* Poison the max_width, so we can detect when it hasn't been set. */ + eassert (font->max_width = 1024 * 1024 * 1024); + /* GC can happen before the driver is set up, so avoid dangling pointer here (Bug#17771). */ font->driver = NULL; @@ -1011,7 +1014,7 @@ font_expand_wildcards (Lisp_Object *field, int n) } -/* Parse NAME (NUL terminated) as XLFD and store information in FONT +/* Parse NAME (null terminated) as XLFD and store information in FONT (font-spec or font-entity). Size property of FONT is set as follows: specified XLFD fields FONT property @@ -1355,7 +1358,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) return len < nbytes ? len : -1; } -/* Parse NAME (NUL terminated) and store information in FONT +/* Parse NAME (null terminated) and store information in FONT (font-spec or font-entity). NAME is supplied in either the Fontconfig or GTK font name format. If NAME is successfully parsed, return 0. Otherwise return -1. @@ -1727,7 +1730,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) #endif -/* Parse NAME (NUL terminated) and store information in FONT +/* Parse NAME (null terminated) and store information in FONT (font-spec or font-entity). If NAME is successfully parsed, return 0. Otherwise return -1. */ @@ -2642,6 +2645,11 @@ font_clear_cache (struct frame *f, Lisp_Object cache, if (! NILP (AREF (val, FONT_TYPE_INDEX))) { eassert (font && driver == font->driver); + /* We are going to close the font, so make + sure we don't have any lgstrings lying + around in lgstring cache that reference + the font. */ + composition_gstring_cache_clear_font (val); driver->close_font (font); } } @@ -2810,7 +2818,13 @@ font_list_entities (struct frame *f, Lisp_Object spec) || ! NILP (Vface_ignored_fonts))) val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size); if (ASIZE (val) > 0) - list = Fcons (val, list); + { + list = Fcons (val, list); + /* Querying further backends can be very slow, so we only do + it if the user has explicitly requested it (Bug#43177). */ + if (query_all_font_backends == false) + break; + } } list = Fnreverse (list); @@ -4452,6 +4466,10 @@ GSTRING. */) signal_error ("Invalid glyph-string: ", gstring); if (! NILP (LGSTRING_ID (gstring))) return gstring; + Lisp_Object cached_gstring = + composition_gstring_lookup_cache (LGSTRING_HEADER (gstring)); + if (! NILP (cached_gstring)) + return cached_gstring; font_object = LGSTRING_FONT (gstring); CHECK_FONT_OBJECT (font_object); font = XFONT_OBJECT (font_object); @@ -5165,6 +5183,9 @@ If the named font cannot be opened and loaded, return nil. */) return Qnil; font = XFONT_OBJECT (font_object); + /* Sanity check to make sure we have initialized max_width. */ + eassert (XFONT_OBJECT (font_object)->max_width < 1024 * 1024 * 1024); + info = CALLN (Fvector, AREF (font_object, FONT_NAME_INDEX), AREF (font_object, FONT_FULLNAME_INDEX), @@ -5527,6 +5548,13 @@ Non-nil means don't query fontconfig for color fonts, since they often cause Xft crashes. Only has an effect in Xft builds. */); xft_ignore_color_fonts = true; + DEFVAR_BOOL ("query-all-font-backends", query_all_font_backends, + doc: /* +If non-nil, attempt to query all available font backends. +By default Emacs will stop searching for a matching font at the first +match. */); + query_all_font_backends = false; + #ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_FREETYPE syms_of_ftfont (); diff --git a/src/frame.c b/src/frame.c index c4dfc35a0c5..7c377da4456 100644 --- a/src/frame.c +++ b/src/frame.c @@ -931,18 +931,18 @@ make_frame (bool mini_p) wset_frame (rw, frame); - /* 10 is arbitrary, + /* 80/25 is arbitrary, just so that there is "something there." Correct size will be set up later with adjust_frame_size. */ - SET_FRAME_COLS (f, 10); - SET_FRAME_LINES (f, 10); + SET_FRAME_COLS (f, 80); + SET_FRAME_LINES (f, 25); SET_FRAME_WIDTH (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f)); SET_FRAME_HEIGHT (f, FRAME_LINES (f) * FRAME_LINE_HEIGHT (f)); - rw->total_cols = 10; + rw->total_cols = FRAME_COLS (f); rw->pixel_width = rw->total_cols * FRAME_COLUMN_WIDTH (f); - rw->total_lines = mini_p ? 9 : 10; + rw->total_lines = FRAME_LINES (f) - (mini_p ? 1 : 0); rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); if (mini_p) @@ -1101,7 +1101,7 @@ make_initial_frame (void) terminal = init_initial_terminal (); - f = make_frame (1); + f = make_frame (true); XSETFRAME (frame, f); Vframe_list = Fcons (frame, Vframe_list); @@ -2434,6 +2434,12 @@ passing the normal return value to that function as an argument, and returns whatever that function returns. */) (void) { + return mouse_position (true); +} + +Lisp_Object +mouse_position (bool call_mouse_position_function) +{ struct frame *f; Lisp_Object lispy_dummy; Lisp_Object x, y, retval; @@ -2462,7 +2468,7 @@ and returns whatever that function returns. */) } XSETFRAME (lispy_dummy, f); retval = Fcons (lispy_dummy, Fcons (x, y)); - if (!NILP (Vmouse_position_function)) + if (call_mouse_position_function && !NILP (Vmouse_position_function)) retval = call1 (Vmouse_position_function, retval); return retval; } @@ -6106,7 +6112,7 @@ when the mouse is over clickable text. */); Vmouse_highlight = Qt; DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible, - doc: /* If non-nil, make pointer invisible while typing. + doc: /* If non-nil, make mouse pointer invisible while typing. The pointer becomes visible again when the mouse is moved. */); Vmake_pointer_invisible = Qt; @@ -6182,7 +6188,7 @@ window of that frame is the buffer whose text will be eventually shown in the minibuffer window. Any other non-nil value means to resize minibuffer-only frames by -calling `fit-frame-to-buffer'. */); +calling `fit-mini-frame-to-buffer'. */); resize_mini_frames = Qnil; DEFVAR_LISP ("focus-follows-mouse", focus_follows_mouse, diff --git a/src/frame.h b/src/frame.h index 476bac67faf..16ecfd311c3 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1361,6 +1361,7 @@ extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object); extern void adjust_frame_size (struct frame *, int, int, int, bool, Lisp_Object); extern void frame_size_history_add (struct frame *f, Lisp_Object fun_symbol, int width, int height, Lisp_Object rest); +extern Lisp_Object mouse_position (bool); extern Lisp_Object Vframe_list; diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 7832d4f5ce0..a10308c62ee 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -139,7 +139,8 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) FcPatternDestroy (pat); font_face = cairo_ft_font_face_create_for_pattern (match); - if (!font_face) + if (!font_face + || cairo_font_face_status (font_face) != CAIRO_STATUS_SUCCESS) { unblock_input (); FcPatternDestroy (match); @@ -154,6 +155,18 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) cairo_font_face_destroy (font_face); cairo_font_options_destroy (options); unblock_input (); + if (!scaled_font + || cairo_scaled_font_status (scaled_font) != CAIRO_STATUS_SUCCESS) + { + FcPatternDestroy (match); + return Qnil; + } + ft_face = cairo_ft_scaled_font_lock_face (scaled_font); + if (!ft_face) + { + FcPatternDestroy (match); + return Qnil; + } font_object = font_build_object (VECSIZE (struct font_info), AREF (entity, FONT_TYPE_INDEX), @@ -187,7 +200,8 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) block_input (); cairo_glyph_t stack_glyph; - font->min_width = font->average_width = font->space_width = 0; + font->min_width = font->max_width = 0; + font->average_width = font->space_width = 0; for (char c = 32; c < 127; c++) { cairo_glyph_t *glyphs = &stack_glyph; @@ -211,6 +225,8 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) && (! font->min_width || font->min_width > this_width)) font->min_width = this_width; + if (this_width > font->max_width) + font->max_width = this_width; if (c == 32) font->space_width = this_width; font->average_width += this_width; @@ -231,7 +247,6 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) font->descent = font->height - font->ascent; } - ft_face = cairo_ft_scaled_font_lock_face (scaled_font); if (XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) == 0) { int upEM = ft_face->units_per_EM; @@ -266,6 +281,7 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) font->relative_compose = 0; font->default_ascent = 0; font->vertical_centering = false; + eassert (font->max_width < 512 * 1024 * 1024); return font_object; } diff --git a/src/image.c b/src/image.c index d8c34669cc4..c857b8e62a4 100644 --- a/src/image.c +++ b/src/image.c @@ -2329,8 +2329,14 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) struct image *img; EMACS_UINT hash; - struct face *face = (face_id >= 0) ? FACE_FROM_ID (f, face_id) - : FACE_FROM_ID (f, DEFAULT_FACE_ID); + if (FRAME_FACE_CACHE (f) == NULL) + init_frame_faces (f); + if (FRAME_FACE_CACHE (f)->used == 0) + recompute_basic_faces (f); + if (face_id < 0 || face_id >= FRAME_FACE_CACHE (f)->used) + face_id = DEFAULT_FACE_ID; + + struct face *face = FACE_FROM_ID (f, face_id); unsigned long foreground = FACE_COLOR_TO_PIXEL (face->foreground, f); unsigned long background = FACE_COLOR_TO_PIXEL (face->background, f); @@ -8276,11 +8282,13 @@ gif_load (struct frame *f, struct image *img) if (gif == NULL) { #if HAVE_GIFERRORSTRING - image_error ("Cannot open `%s': %s", - file, build_string (GifErrorString (gif_err))); -#else - image_error ("Cannot open `%s'", file); + const char *errstr = GifErrorString (gif_err); + if (errstr) + image_error ("Cannot open `%s': %s", file, build_string (errstr)); + else #endif + image_error ("Cannot open `%s'", file); + return 0; } } @@ -8306,11 +8314,13 @@ gif_load (struct frame *f, struct image *img) if (!gif) { #if HAVE_GIFERRORSTRING - image_error ("Cannot open memory source `%s': %s", - img->spec, build_string (GifErrorString (gif_err))); -#else - image_error ("Cannot open memory source `%s'", img->spec); + const char *errstr = GifErrorString (gif_err); + if (errstr) + image_error ("Cannot open memory source `%s': %s", + img->spec, build_string (errstr)); + else #endif + image_error ("Cannot open memory source `%s'", img->spec); return 0; } } @@ -8593,9 +8603,9 @@ gif_load (struct frame *f, struct image *img) if (error_text) image_error ("Error closing `%s': %s", img->spec, build_string (error_text)); -#else - image_error ("Error closing `%s'", img->spec); + else #endif + image_error ("Error closing `%s'", img->spec); } /* Maybe fill in the background field while we have ximg handy. */ @@ -9533,10 +9543,16 @@ DEF_DLL_FN (gboolean, rsvg_handle_write, (RsvgHandle *, const guchar *, gsize, GError **)); DEF_DLL_FN (gboolean, rsvg_handle_close, (RsvgHandle *, GError **)); #endif + +#if LIBRSVG_CHECK_VERSION (2, 46, 0) +DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer, + (RsvgHandle *, const char *, const RsvgRectangle *, + RsvgRectangle *, RsvgRectangle *, GError **)); +#else DEF_DLL_FN (void, rsvg_handle_get_dimensions, (RsvgHandle *, RsvgDimensionData *)); +#endif DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *)); - DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *)); DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *)); DEF_DLL_FN (guchar *, gdk_pixbuf_get_pixels, (const GdkPixbuf *)); @@ -9582,7 +9598,11 @@ init_svg_functions (void) LOAD_DLL_FN (library, rsvg_handle_write); LOAD_DLL_FN (library, rsvg_handle_close); #endif +#if LIBRSVG_CHECK_VERSION (2, 46, 0) + LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); +#else LOAD_DLL_FN (library, rsvg_handle_get_dimensions); +#endif LOAD_DLL_FN (library, rsvg_handle_get_pixbuf); LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width); @@ -9617,7 +9637,11 @@ init_svg_functions (void) # undef g_clear_error # undef g_object_unref # undef g_type_init -# undef rsvg_handle_get_dimensions +# if LIBRSVG_CHECK_VERSION (2, 46, 0) +# undef rsvg_handle_get_geometry_for_layer +# else +# undef rsvg_handle_get_dimensions +# endif # undef rsvg_handle_get_pixbuf # if LIBRSVG_CHECK_VERSION (2, 32, 0) # undef g_file_new_for_path @@ -9643,7 +9667,11 @@ init_svg_functions (void) # if ! GLIB_CHECK_VERSION (2, 36, 0) # define g_type_init fn_g_type_init # endif -# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions +# if LIBRSVG_CHECK_VERSION (2, 46, 0) +# define rsvg_handle_get_geometry_for_layer fn_rsvg_handle_get_geometry_for_layer +# else +# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions +# endif # define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf # if LIBRSVG_CHECK_VERSION (2, 32, 0) # define g_file_new_for_path fn_g_file_new_for_path @@ -9726,7 +9754,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, ptrdiff_t size, char *filename) { RsvgHandle *rsvg_handle; - RsvgDimensionData dimension_data; + double viewbox_width, viewbox_height; GError *err = NULL; GdkPixbuf *pixbuf; int width; @@ -9779,15 +9807,38 @@ svg_load_image (struct frame *f, struct image *img, char *contents, #endif /* Get the image dimensions. */ +#if LIBRSVG_CHECK_VERSION (2, 46, 0) + RsvgRectangle zero_rect, viewbox, out_logical_rect; + + rsvg_handle_get_geometry_for_layer (rsvg_handle, NULL, + &zero_rect, &viewbox, + &out_logical_rect, NULL); + viewbox_width = viewbox.x + viewbox.width; + viewbox_height = viewbox.y + viewbox.height; +#else + /* The function used above to get the geometry of the visible area + of the SVG are only available in librsvg 2.46 and above, so in + certain circumstances this code path can result in some parts of + the SVG being cropped. */ + RsvgDimensionData dimension_data; + rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); + viewbox_width = dimension_data.width; + viewbox_height = dimension_data.height; +#endif + compute_image_size (viewbox_width, viewbox_height, img->spec, + &width, &height); + + if (! check_image_size (f, width, height)) + { + image_size_error (); + goto rsvg_error; + } + /* We are now done with the unmodified data. */ g_object_unref (rsvg_handle); - /* Calculate the final image size. */ - compute_image_size (dimension_data.width, dimension_data.height, - img->spec, &width, &height); - /* Wrap the SVG data in another SVG. This allows us to set the width and height, as well as modify the foreground and background colors. */ @@ -9810,7 +9861,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, "xmlns:xi=\"http://www.w3.org/2001/XInclude\" " "style=\"color: #%06X; fill: currentColor;\" " "width=\"%d\" height=\"%d\" preserveAspectRatio=\"none\" " - "viewBox=\"0 0 %d %d\">" + "viewBox=\"0 0 %f %f\">" "<rect width=\"100%%\" height=\"100%%\" fill=\"#%06X\"/>" "<xi:include href=\"data:image/svg+xml;base64,%s\"></xi:include>" "</svg>"; @@ -9835,8 +9886,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents, if (!wrapped_contents || buffer_size <= snprintf (wrapped_contents, buffer_size, wrapper, foreground & 0xFFFFFF, width, height, - dimension_data.width, dimension_data.height, - background & 0xFFFFFF, SSDATA (encoded_contents))) + viewbox_width, viewbox_height, + background & 0xFFFFFF, + SSDATA (encoded_contents))) goto rsvg_error; wrapped_size = strlen (wrapped_contents); @@ -9877,12 +9929,6 @@ svg_load_image (struct frame *f, struct image *img, char *contents, if (err) goto rsvg_error; #endif - rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); - if (! check_image_size (f, dimension_data.width, dimension_data.height)) - { - image_size_error (); - goto rsvg_error; - } /* We can now get a valid pixel buffer from the svg file, if all went ok. */ diff --git a/src/indent.c b/src/indent.c index 581323b91ee..4ecf02b6b96 100644 --- a/src/indent.c +++ b/src/indent.c @@ -524,9 +524,11 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) comes first. Return the resulting buffer position and column in ENDPOS and GOALCOL. PREVCOL gets set to the column of the previous position (it's always - strictly smaller than the goal column). */ + strictly smaller than the goal column), and PREVPOS and PREVBPOS get set + to the corresponding buffer character and byte positions. */ static void -scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol) +scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, + ptrdiff_t *prevpos, ptrdiff_t *prevbpos, ptrdiff_t *prevcol) { int tab_width = SANE_TAB_WIDTH (current_buffer); bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); @@ -540,10 +542,12 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol) register ptrdiff_t col = 0, prev_col = 0; EMACS_INT goal = goalcol ? *goalcol : MOST_POSITIVE_FIXNUM; ptrdiff_t end = endpos ? *endpos : PT; - ptrdiff_t scan, scan_byte, next_boundary; + ptrdiff_t scan, scan_byte, next_boundary, prev_pos, prev_bpos; scan = find_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, NULL, &scan_byte, 1); next_boundary = scan; + prev_pos = scan; + prev_bpos = scan_byte; window = Fget_buffer_window (Fcurrent_buffer (), Qnil); w = ! NILP (window) ? XWINDOW (window) : NULL; @@ -576,6 +580,8 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol) if (col >= goal) break; prev_col = col; + prev_pos = scan; + prev_bpos = scan_byte; { /* Check display property. */ ptrdiff_t endp; @@ -705,6 +711,10 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol) *goalcol = col; if (endpos) *endpos = scan; + if (prevpos) + *prevpos = prev_pos; + if (prevbpos) + *prevbpos = prev_bpos; if (prevcol) *prevcol = prev_col; } @@ -720,7 +730,7 @@ current_column_1 (void) EMACS_INT col = MOST_POSITIVE_FIXNUM; ptrdiff_t opoint = PT; - scan_for_column (&opoint, &col, NULL); + scan_for_column (&opoint, &col, NULL, NULL, NULL); return col; } @@ -988,7 +998,7 @@ to reach COLUMN, add spaces/tabs to get there. The return value is the current column. */) (Lisp_Object column, Lisp_Object force) { - ptrdiff_t pos, prev_col; + ptrdiff_t pos, prev_pos, prev_bpos, prev_col; EMACS_INT col; EMACS_INT goal; @@ -997,7 +1007,7 @@ The return value is the current column. */) col = goal; pos = ZV; - scan_for_column (&pos, &col, &prev_col); + scan_for_column (&pos, &col, &prev_pos, &prev_bpos, &prev_col); SET_PT (pos); @@ -1006,18 +1016,16 @@ The return value is the current column. */) if (!NILP (force) && col > goal) { int c; - ptrdiff_t pos_byte = PT_BYTE; - pos_byte -= prev_char_len (pos_byte); - c = FETCH_CHAR (pos_byte); - if (c == '\t' && prev_col < goal) + c = FETCH_CHAR (prev_bpos); + if (c == '\t' && prev_col < goal && prev_bpos < PT_BYTE) { ptrdiff_t goal_pt, goal_pt_byte; /* Insert spaces in front of the tab to reach GOAL. Do this first so that a marker at the end of the tab gets adjusted. */ - SET_PT_BOTH (PT - 1, PT_BYTE - 1); + SET_PT_BOTH (prev_pos, prev_bpos); Finsert_char (make_fixnum (' '), make_fixnum (goal - prev_col), Qt); /* Now delete the tab, and indent to COL. */ diff --git a/src/insdel.c b/src/insdel.c index c37b0710783..6e245971085 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -714,7 +714,7 @@ insert_char (int c) insert ((char *) str, len); } -/* Insert the NUL-terminated string S before point. */ +/* Insert the null-terminated string S before point. */ void insert_string (const char *s) diff --git a/src/json.c b/src/json.c index 8c9583631ad..744c40a1bef 100644 --- a/src/json.c +++ b/src/json.c @@ -279,10 +279,10 @@ json_release_object (void *object) } /* Signal an error if OBJECT is not a string, or if OBJECT contains - embedded NUL characters. */ + embedded null characters. */ static void -check_string_without_embedded_nuls (Lisp_Object object) +check_string_without_embedded_nulls (Lisp_Object object) { CHECK_STRING (object); CHECK_TYPE (memchr (SDATA (object), '\0', SBYTES (object)) == NULL, @@ -368,11 +368,11 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, CHECK_STRING (key); Lisp_Object ekey = json_encode (key); /* We can't specify the length, so the string must be - NUL-terminated. */ - check_string_without_embedded_nuls (ekey); + null-terminated. */ + check_string_without_embedded_nulls (ekey); const char *key_str = SSDATA (ekey); /* Reject duplicate keys. These are possible if the hash - table test is not `equal'. */ + table test is not `equal'. */ if (json_object_get (json, key_str) != NULL) wrong_type_argument (Qjson_value_p, lisp); int status @@ -419,8 +419,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, CHECK_SYMBOL (key_symbol); Lisp_Object key = SYMBOL_NAME (key_symbol); /* We can't specify the length, so the string must be - NUL-terminated. */ - check_string_without_embedded_nuls (key); + null-terminated. */ + check_string_without_embedded_nulls (key); key_str = SSDATA (key); /* In plists, ensure leading ":" in keys is stripped. It will be reconstructed later in `json_to_lisp'.*/ @@ -563,7 +563,7 @@ false values, t, numbers, strings, or other vectors hashtables, alists or plists. t will be converted to the JSON true value. Vectors will be converted to JSON arrays, whereas hashtables, alists and plists are converted to JSON objects. Hashtable keys must be strings without -embedded NUL characters and must be unique within each object. Alist +embedded null characters and must be unique within each object. Alist and plist keys must be symbols; if a key is duplicate, the first instance is used. @@ -976,7 +976,7 @@ usage: (json-parse-string STRING &rest ARGS) */) Lisp_Object string = args[0]; CHECK_STRING (string); Lisp_Object encoded = json_encode (string); - check_string_without_embedded_nuls (encoded); + check_string_without_embedded_nulls (encoded); struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; json_parse_args (nargs - 1, args + 1, &conf, true); diff --git a/src/keyboard.c b/src/keyboard.c index 590d183c4c6..2e0143379a0 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -103,7 +103,8 @@ static KBOARD *all_kboards; /* True in the single-kboard state, false in the any-kboard state. */ static bool single_kboard; -#define NUM_RECENT_KEYS (300) +/* Minimum allowed size of the recent_keys vector. */ +#define MIN_NUM_RECENT_KEYS (100) /* Index for storing next element into recent_keys. */ static int recent_keys_index; @@ -111,7 +112,10 @@ static int recent_keys_index; /* Total number of elements stored into recent_keys. */ static int total_keys; -/* This vector holds the last NUM_RECENT_KEYS keystrokes. */ +/* Size of the recent_keys vector. */ +static int lossage_limit = 3 * MIN_NUM_RECENT_KEYS; + +/* This vector holds the last lossage_limit keystrokes. */ static Lisp_Object recent_keys; /* Vector holding the key sequence that invoked the current command. @@ -1421,10 +1425,10 @@ command_loop_1 (void) /* Execute the command. */ { - total_keys += total_keys < NUM_RECENT_KEYS; + total_keys += total_keys < lossage_limit; ASET (recent_keys, recent_keys_index, Fcons (Qnil, cmd)); - if (++recent_keys_index >= NUM_RECENT_KEYS) + if (++recent_keys_index >= lossage_limit) recent_keys_index = 0; } Vthis_command = cmd; @@ -2036,7 +2040,7 @@ help_echo_substitute_command_keys (Lisp_Object help) help))) return help; - return Fsubstitute_command_keys (help); + return call1 (Qsubstitute_command_keys, help); } /* Display the help-echo property of the character after the mouse pointer. @@ -3248,15 +3252,15 @@ record_char (Lisp_Object c) int ix1, ix2, ix3; if ((ix1 = recent_keys_index - 1) < 0) - ix1 = NUM_RECENT_KEYS - 1; + ix1 = lossage_limit - 1; ev1 = AREF (recent_keys, ix1); if ((ix2 = ix1 - 1) < 0) - ix2 = NUM_RECENT_KEYS - 1; + ix2 = lossage_limit - 1; ev2 = AREF (recent_keys, ix2); if ((ix3 = ix2 - 1) < 0) - ix3 = NUM_RECENT_KEYS - 1; + ix3 = lossage_limit - 1; ev3 = AREF (recent_keys, ix3); if (EQ (XCAR (c), Qhelp_echo)) @@ -3307,12 +3311,12 @@ record_char (Lisp_Object c) { if (!recorded) { - total_keys += total_keys < NUM_RECENT_KEYS; + total_keys += total_keys < lossage_limit; ASET (recent_keys, recent_keys_index, /* Copy the event, in case it gets modified by side-effect by some remapping function (bug#30955). */ CONSP (c) ? Fcopy_sequence (c) : c); - if (++recent_keys_index >= NUM_RECENT_KEYS) + if (++recent_keys_index >= lossage_limit) recent_keys_index = 0; } else if (recorded < 0) @@ -3326,10 +3330,10 @@ record_char (Lisp_Object c) while (recorded++ < 0 && total_keys > 0) { - if (total_keys < NUM_RECENT_KEYS) + if (total_keys < lossage_limit) total_keys--; if (--recent_keys_index < 0) - recent_keys_index = NUM_RECENT_KEYS - 1; + recent_keys_index = lossage_limit - 1; ASET (recent_keys, recent_keys_index, Qnil); } } @@ -5250,7 +5254,6 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, extra_info))); } -#ifdef HAVE_WINDOW_SYSTEM else if (f) { /* Return mouse pixel coordinates here. */ @@ -5258,7 +5261,9 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, xret = XFIXNUM (x); yret = XFIXNUM (y); - if (FRAME_LIVE_P (f) +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f) + && FRAME_LIVE_P (f) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0 && !NILP (get_frame_param (f, Qdrag_internal_border))) { @@ -5267,8 +5272,8 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, posn = builtin_lisp_symbol (internal_border_parts[part]); } - } #endif + } else window_or_frame = Qnil; @@ -5692,7 +5697,7 @@ make_lispy_event (struct input_event *event) ignore_mouse_drag_p = false; } - /* Now we're releasing a button - check the co-ordinates to + /* Now we're releasing a button - check the coordinates to see if this was a click or a drag. */ else if (event->modifiers & up_modifier) { @@ -6230,7 +6235,7 @@ parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end) static Lisp_Object apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_byte) { - /* Since BASE could contain NULs, we can't use intern here; we have + /* Since BASE could contain nulls, we can't use intern here; we have to use Fintern, which expects a genuine Lisp_String, and keeps a reference to it. */ char new_mods[sizeof "A-C-H-M-S-s-up-down-drag-double-triple-"]; @@ -6640,7 +6645,7 @@ has the same base event type and all the specified modifiers. */) DEFUN ("internal-handle-focus-in", Finternal_handle_focus_in, Sinternal_handle_focus_in, 1, 1, 0, doc: /* Internally handle focus-in events. -This function potentially generates an artifical switch-frame event. */) +This function potentially generates an artificial switch-frame event. */) (Lisp_Object event) { Lisp_Object frame; @@ -7851,7 +7856,7 @@ parse_menu_item (Lisp_Object item, int inmenubar) /* The previous code preferred :key-sequence to :keys, so we preserve this behavior. */ if (STRINGP (keyeq) && !CONSP (keyhint)) - keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq)); + keyeq = concat2 (space_space, call1 (Qsubstitute_command_keys, keyeq)); else { Lisp_Object prefix = keyeq; @@ -10410,6 +10415,64 @@ If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */) ? Qt : Qnil); } +/* Reallocate recent_keys copying the recorded keystrokes + in the right order. */ +static void +update_recent_keys (int new_size, int kept_keys) +{ + int osize = ASIZE (recent_keys); + eassert (recent_keys_index < osize); + eassert (kept_keys <= min (osize, new_size)); + Lisp_Object v = make_nil_vector (new_size); + int i, idx; + for (i = 0; i < kept_keys; ++i) + { + idx = recent_keys_index - kept_keys + i; + while (idx < 0) + idx += osize; + ASET (v, i, AREF (recent_keys, idx)); + } + recent_keys = v; + total_keys = kept_keys; + recent_keys_index = total_keys % new_size; + lossage_limit = new_size; + +} + +DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1, + "(list (read-number \"new-size: \" (lossage-size)))", + doc: /* Return or set the maximum number of keystrokes to save. +If called with a non-nil ARG, set the limit to ARG and return it. +Otherwise, return the current limit. + +The saved keystrokes are shown by `view-lossage'. */) + (Lisp_Object arg) +{ + if (NILP(arg)) + return make_fixnum (lossage_limit); + + if (!FIXNATP (arg)) + user_error ("Value must be a positive integer"); + int osize = ASIZE (recent_keys); + eassert (lossage_limit == osize); + int min_size = MIN_NUM_RECENT_KEYS; + int new_size = XFIXNAT (arg); + + if (new_size == osize) + return make_fixnum (lossage_limit); + + if (new_size < min_size) + { + AUTO_STRING (fmt, "Value must be >= %d"); + Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum (min_size)))); + } + + int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys); + update_recent_keys (new_size, kept_keys); + + return make_fixnum (lossage_limit); +} + DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0, doc: /* Return vector of last few events, not counting those from keyboard macros. If INCLUDE-CMDS is non-nil, include the commands that were run, @@ -10419,21 +10482,21 @@ represented as pseudo-events of the form (nil . COMMAND). */) bool cmds = !NILP (include_cmds); if (!total_keys - || (cmds && total_keys < NUM_RECENT_KEYS)) + || (cmds && total_keys < lossage_limit)) return Fvector (total_keys, XVECTOR (recent_keys)->contents); else { Lisp_Object es = Qnil; - int i = (total_keys < NUM_RECENT_KEYS + int i = (total_keys < lossage_limit ? 0 : recent_keys_index); - eassert (recent_keys_index < NUM_RECENT_KEYS); + eassert (recent_keys_index < lossage_limit); do { Lisp_Object e = AREF (recent_keys, i); if (cmds || !CONSP (e) || !NILP (XCAR (e))) es = Fcons (e, es); - if (++i >= NUM_RECENT_KEYS) + if (++i >= lossage_limit) i = 0; } while (i != recent_keys_index); es = Fnreverse (es); @@ -10504,8 +10567,6 @@ DEFUN ("this-single-command-keys", Fthis_single_command_keys, doc: /* Return the key sequence that invoked this command. More generally, it returns the last key sequence read, either by the command loop or by `read-key-sequence'. -Unlike `this-command-keys', this function's value -does not include prefix arguments. The value is always a vector. */) (void) { @@ -11686,7 +11747,7 @@ syms_of_keyboard (void) staticpro (&modifier_symbols); } - recent_keys = make_nil_vector (NUM_RECENT_KEYS); + recent_keys = make_nil_vector (lossage_limit); staticpro (&recent_keys); this_command_keys = make_nil_vector (40); @@ -11736,6 +11797,7 @@ syms_of_keyboard (void) defsubr (&Srecursive_edit); defsubr (&Sinternal_track_mouse); defsubr (&Sinput_pending_p); + defsubr (&Slossage_size); defsubr (&Srecent_keys); defsubr (&Sthis_command_keys); defsubr (&Sthis_command_keys_vector); @@ -12043,7 +12105,8 @@ See also `pre-command-hook'. */); DEFVAR_LISP ("menu-bar-final-items", Vmenu_bar_final_items, doc: /* List of menu bar items to move to the end of the menu bar. -The elements of the list are event types that may have menu bar bindings. */); +The elements of the list are event types that may have menu bar +bindings. The order of this list controls the order of the items. */); Vmenu_bar_final_items = Qnil; DEFVAR_LISP ("tab-bar-separator-image-expression", Vtab_bar_separator_image_expression, diff --git a/src/keymap.c b/src/keymap.c index 0608bdddeea..e5b4781076f 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -89,11 +89,6 @@ static Lisp_Object where_is_cache_keymaps; static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); -static void describe_command (Lisp_Object, Lisp_Object); -static void describe_translation (Lisp_Object, Lisp_Object); -static void describe_map (Lisp_Object, Lisp_Object, - void (*) (Lisp_Object, Lisp_Object), - bool, Lisp_Object, Lisp_Object *, bool, bool); static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object, void (*) (Lisp_Object, Lisp_Object), bool, Lisp_Object, Lisp_Object, bool, bool); @@ -679,6 +674,23 @@ usage: (map-keymap FUNCTION KEYMAP) */) return Qnil; } +DEFUN ("keymap--get-keyelt", Fkeymap__get_keyelt, Skeymap__get_keyelt, 2, 2, 0, + doc: /* Given OBJECT which was found in a slot in a keymap, +trace indirect definitions to get the actual definition of that slot. +An indirect definition is a list of the form +(KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one +and INDEX is the object to look up in KEYMAP to yield the definition. + +Also if OBJECT has a menu string as the first element, +remove that. Also remove a menu help string as second element. + +If AUTOLOAD, load autoloadable keymaps +that are referred to with indirection. */) + (Lisp_Object object, Lisp_Object autoload) +{ + return get_keyelt (object, NILP (autoload) ? false : true); +} + /* Given OBJECT which was found in a slot in a keymap, trace indirect definitions to get the actual definition of that slot. An indirect definition is a list of the form @@ -2733,7 +2745,7 @@ The optional argument MENUS, if non-nil, says to mention menu bindings. (Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus) { Lisp_Object outbuf, shadow; - bool nomenu = NILP (menus); + Lisp_Object nomenu = NILP (menus) ? Qt : Qnil; Lisp_Object start1; const char *alternate_heading @@ -2782,9 +2794,13 @@ You type Translation\n\ } if (!NILP (Vkey_translation_map)) - describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, - "Key translations", nomenu, 1, 0, 0); - + { + Lisp_Object msg = build_unibyte_string ("Key translations"); + CALLN (Ffuncall, + Qdescribe_map_tree, + Vkey_translation_map, Qnil, Qnil, prefix, + msg, nomenu, Qt, Qnil, Qnil); + } /* Print the (major mode) local map. */ start1 = Qnil; @@ -2793,8 +2809,11 @@ You type Translation\n\ if (!NILP (start1)) { - describe_map_tree (start1, 1, shadow, prefix, - "\f\nOverriding Bindings", nomenu, 0, 0, 0); + Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (start1, shadow); start1 = Qnil; } @@ -2803,8 +2822,11 @@ You type Translation\n\ if (!NILP (start1)) { - describe_map_tree (start1, 1, shadow, prefix, - "\f\nOverriding Bindings", nomenu, 0, 0, 0); + Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (start1, shadow); } else @@ -2824,9 +2846,11 @@ You type Translation\n\ XBUFFER (buffer), Qkeymap); if (!NILP (start1)) { - describe_map_tree (start1, 1, shadow, prefix, - "\f\n`keymap' Property Bindings", nomenu, - 0, 0, 0); + Lisp_Object msg = build_unibyte_string ("\f\n`keymap' Property Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (start1, shadow); } @@ -2835,7 +2859,7 @@ You type Translation\n\ { /* The title for a minor mode keymap is constructed at run time. - We let describe_map_tree do the actual insertion + We let describe-map-tree do the actual insertion because it takes care of other features when doing so. */ char *title, *p; @@ -2855,8 +2879,11 @@ You type Translation\n\ p += strlen (" Minor Mode Bindings"); *p = 0; - describe_map_tree (maps[i], 1, shadow, prefix, - title, nomenu, 0, 0, 0); + Lisp_Object msg = build_unibyte_string (title); + CALLN (Ffuncall, + Qdescribe_map_tree, + maps[i], Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (maps[i], shadow); SAFE_FREE (); } @@ -2866,432 +2893,66 @@ You type Translation\n\ if (!NILP (start1)) { if (EQ (start1, BVAR (XBUFFER (buffer), keymap))) - describe_map_tree (start1, 1, shadow, prefix, - "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); - else - describe_map_tree (start1, 1, shadow, prefix, - "\f\n`local-map' Property Bindings", - nomenu, 0, 0, 0); - - shadow = Fcons (start1, shadow); - } - } - - describe_map_tree (current_global_map, 1, shadow, prefix, - "\f\nGlobal Bindings", nomenu, 0, 1, 0); - - /* Print the function-key-map translations under this prefix. */ - if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) - describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix, - "\f\nFunction key map translations", nomenu, 1, 0, 0); - - /* Print the input-decode-map translations under this prefix. */ - if (!NILP (KVAR (current_kboard, Vinput_decode_map))) - describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix, - "\f\nInput decoding map translations", nomenu, 1, 0, 0); - - return Qnil; -} - -/* Insert a description of the key bindings in STARTMAP, - followed by those of all maps reachable through STARTMAP. - If PARTIAL, omit certain "uninteresting" commands - (such as `undefined'). - If SHADOW is non-nil, it is a list of maps; - don't mention keys which would be shadowed by any of them. - PREFIX, if non-nil, says mention only keys that start with PREFIX. - TITLE, if not 0, is a string to insert at the beginning. - TITLE should not end with a colon or a newline; we supply that. - If NOMENU, then omit menu-bar commands. - - If TRANSL, the definitions are actually key translations - so print strings and vectors differently. - - If ALWAYS_TITLE, print the title even if there are no maps - to look through. - - If MENTION_SHADOW, then when something is shadowed by SHADOW, - don't omit it; instead, mention it but say it is shadowed. - - Any inserted text ends in two newlines (used by `help-make-xrefs'). */ - -void -describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow, - Lisp_Object prefix, const char *title, bool nomenu, - bool transl, bool always_title, bool mention_shadow) -{ - Lisp_Object maps, orig_maps, seen, sub_shadows; - bool something = 0; - const char *key_heading - = "\ -key binding\n\ ---- -------\n"; - - orig_maps = maps = Faccessible_keymaps (startmap, prefix); - seen = Qnil; - sub_shadows = Qnil; - - if (nomenu) - { - Lisp_Object list; - - /* Delete from MAPS each element that is for the menu bar. */ - for (list = maps; CONSP (list); list = XCDR (list)) - { - Lisp_Object elt, elt_prefix, tem; - - elt = XCAR (list); - elt_prefix = Fcar (elt); - if (ASIZE (elt_prefix) >= 1) { - tem = Faref (elt_prefix, make_fixnum (0)); - if (EQ (tem, Qmenu_bar)) - maps = Fdelq (elt, maps); + Lisp_Object msg = build_unibyte_string ("\f\nMajor Mode Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); } - } - } - - if (!NILP (maps) || always_title) - { - if (title) - { - insert_string (title); - if (!NILP (prefix)) + else { - insert_string (" Starting With "); - insert1 (Fkey_description (prefix, Qnil)); + Lisp_Object msg = build_unibyte_string ("\f\n`local-map' Property Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); } - insert_string (":\n"); - } - insert_string (key_heading); - something = 1; - } - for (; CONSP (maps); maps = XCDR (maps)) - { - register Lisp_Object elt, elt_prefix, tail; - - elt = XCAR (maps); - elt_prefix = Fcar (elt); - - sub_shadows = Flookup_key (shadow, elt_prefix, Qt); - if (FIXNATP (sub_shadows)) - sub_shadows = Qnil; - else if (!KEYMAPP (sub_shadows) - && !NILP (sub_shadows) - && !(CONSP (sub_shadows) - && KEYMAPP (XCAR (sub_shadows)))) - /* If elt_prefix is bound to something that's not a keymap, - it completely shadows this map, so don't - describe this map at all. */ - goto skip; - - /* Maps we have already listed in this loop shadow this map. */ - for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail)) - { - Lisp_Object tem; - tem = Fequal (Fcar (XCAR (tail)), elt_prefix); - if (!NILP (tem)) - sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows); + shadow = Fcons (start1, shadow); } - - describe_map (Fcdr (elt), elt_prefix, - transl ? describe_translation : describe_command, - partial, sub_shadows, &seen, nomenu, mention_shadow); - - skip: ; } - if (something) - insert_string ("\n"); -} - -static int previous_description_column; - -static void -describe_command (Lisp_Object definition, Lisp_Object args) -{ - register Lisp_Object tem1; - ptrdiff_t column = current_column (); - int description_column; + Lisp_Object msg = build_unibyte_string ("\f\nGlobal Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + current_global_map, Qt, shadow, prefix, + msg, nomenu, Qnil, Qt, Qnil); - /* If column 16 is no good, go to col 32; - but don't push beyond that--go to next line instead. */ - if (column > 30) + /* Print the function-key-map translations under this prefix. */ + if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) { - insert_char ('\n'); - description_column = 32; + Lisp_Object msg = build_unibyte_string ("\f\nFunction key map translations"); + CALLN (Ffuncall, + Qdescribe_map_tree, + KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix, + msg, nomenu, Qt, Qt, Qt); } - else if (column > 14 || (column > 10 && previous_description_column == 32)) - description_column = 32; - else - description_column = 16; - - Findent_to (make_fixnum (description_column), make_fixnum (1)); - previous_description_column = description_column; - if (SYMBOLP (definition)) + /* Print the input-decode-map translations under this prefix. */ + if (!NILP (KVAR (current_kboard, Vinput_decode_map))) { - tem1 = SYMBOL_NAME (definition); - insert1 (tem1); - insert_string ("\n"); + Lisp_Object msg = build_unibyte_string ("\f\nInput decoding map translations"); + CALLN (Ffuncall, + Qdescribe_map_tree, + KVAR (current_kboard, Vinput_decode_map), Qnil, Qnil, prefix, + msg, nomenu, Qt, Qnil, Qnil); } - else if (STRINGP (definition) || VECTORP (definition)) - insert_string ("Keyboard Macro\n"); - else if (KEYMAPP (definition)) - insert_string ("Prefix Command\n"); - else - insert_string ("??\n"); + return Qnil; } static void -describe_translation (Lisp_Object definition, Lisp_Object args) +describe_vector_princ (Lisp_Object elt, Lisp_Object fun) { - register Lisp_Object tem1; - Findent_to (make_fixnum (16), make_fixnum (1)); - - if (SYMBOLP (definition)) - { - tem1 = SYMBOL_NAME (definition); - insert1 (tem1); - insert_string ("\n"); - } - else if (STRINGP (definition) || VECTORP (definition)) - { - insert1 (Fkey_description (definition, Qnil)); - insert_string ("\n"); - } - else if (KEYMAPP (definition)) - insert_string ("Prefix Command\n"); - else - insert_string ("??\n"); -} - -/* describe_map puts all the usable elements of a sparse keymap - into an array of `struct describe_map_elt', - then sorts them by the events. */ - -struct describe_map_elt -{ - Lisp_Object event; - Lisp_Object definition; - bool shadowed; -}; - -/* qsort comparison function for sorting `struct describe_map_elt' by - the event field. */ - -static int -describe_map_compare (const void *aa, const void *bb) -{ - const struct describe_map_elt *a = aa, *b = bb; - if (FIXNUMP (a->event) && FIXNUMP (b->event)) - return ((XFIXNUM (a->event) > XFIXNUM (b->event)) - - (XFIXNUM (a->event) < XFIXNUM (b->event))); - if (!FIXNUMP (a->event) && FIXNUMP (b->event)) - return 1; - if (FIXNUMP (a->event) && !FIXNUMP (b->event)) - return -1; - if (SYMBOLP (a->event) && SYMBOLP (b->event)) - /* Sort the keystroke names in the "natural" way, with (for - instance) "<f2>" coming between "<f1>" and "<f11>". */ - return string_version_cmp (SYMBOL_NAME (a->event), SYMBOL_NAME (b->event)); - return 0; -} - -/* Describe the contents of map MAP, assuming that this map itself is - reached by the sequence of prefix keys PREFIX (a string or vector). - PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ - -static void -describe_map (Lisp_Object map, Lisp_Object prefix, - void (*elt_describer) (Lisp_Object, Lisp_Object), - bool partial, Lisp_Object shadow, - Lisp_Object *seen, bool nomenu, bool mention_shadow) -{ - Lisp_Object tail, definition, event; - Lisp_Object tem; - Lisp_Object suppress; - Lisp_Object kludge; - bool first = 1; - - /* These accumulate the values from sparse keymap bindings, - so we can sort them and handle them in order. */ - ptrdiff_t length_needed = 0; - struct describe_map_elt *vect; - ptrdiff_t slots_used = 0; - ptrdiff_t i; - - suppress = Qnil; - - if (partial) - suppress = intern ("suppress-keymap"); - - /* This vector gets used to present single keys to Flookup_key. Since - that is done once per keymap element, we don't want to cons up a - fresh vector every time. */ - kludge = make_nil_vector (1); - definition = Qnil; - - map = call1 (Qkeymap_canonicalize, map); - - for (tail = map; CONSP (tail); tail = XCDR (tail)) - length_needed++; - - USE_SAFE_ALLOCA; - SAFE_NALLOCA (vect, 1, length_needed); - - for (tail = map; CONSP (tail); tail = XCDR (tail)) - { - maybe_quit (); - - if (VECTORP (XCAR (tail)) - || CHAR_TABLE_P (XCAR (tail))) - describe_vector (XCAR (tail), - prefix, Qnil, elt_describer, partial, shadow, map, - 1, mention_shadow); - else if (CONSP (XCAR (tail))) - { - bool this_shadowed = 0; - - event = XCAR (XCAR (tail)); - - /* Ignore bindings whose "prefix" are not really valid events. - (We get these in the frames and buffers menu.) */ - if (!(SYMBOLP (event) || FIXNUMP (event))) - continue; - - if (nomenu && EQ (event, Qmenu_bar)) - continue; - - definition = get_keyelt (XCDR (XCAR (tail)), 0); - - /* Don't show undefined commands or suppressed commands. */ - if (NILP (definition)) continue; - if (SYMBOLP (definition) && partial) - { - tem = Fget (definition, suppress); - if (!NILP (tem)) - continue; - } - - /* Don't show a command that isn't really visible - because a local definition of the same key shadows it. */ - - ASET (kludge, 0, event); - if (!NILP (shadow)) - { - tem = shadow_lookup (shadow, kludge, Qt, 0); - if (!NILP (tem)) - { - /* If both bindings are keymaps, this key is a prefix key, - so don't say it is shadowed. */ - if (KEYMAPP (definition) && KEYMAPP (tem)) - ; - /* Avoid generating duplicate entries if the - shadowed binding has the same definition. */ - else if (mention_shadow && !EQ (tem, definition)) - this_shadowed = 1; - else - continue; - } - } - - tem = Flookup_key (map, kludge, Qt); - if (!EQ (tem, definition)) continue; - - vect[slots_used].event = event; - vect[slots_used].definition = definition; - vect[slots_used].shadowed = this_shadowed; - slots_used++; - } - else if (EQ (XCAR (tail), Qkeymap)) - { - /* The same keymap might be in the structure twice, if we're - using an inherited keymap. So skip anything we've already - encountered. */ - tem = Fassq (tail, *seen); - if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix))) - break; - *seen = Fcons (Fcons (tail, prefix), *seen); - } - } - - /* If we found some sparse map events, sort them. */ - - qsort (vect, slots_used, sizeof (struct describe_map_elt), - describe_map_compare); - - /* Now output them in sorted order. */ - - for (i = 0; i < slots_used; i++) - { - Lisp_Object start, end; - - if (first) - { - previous_description_column = 0; - insert ("\n", 1); - first = 0; - } - - ASET (kludge, 0, vect[i].event); - start = vect[i].event; - end = start; - - definition = vect[i].definition; - - /* Find consecutive chars that are identically defined. */ - if (FIXNUMP (vect[i].event)) - { - while (i + 1 < slots_used - && EQ (vect[i+1].event, make_fixnum (XFIXNUM (vect[i].event) + 1)) - && !NILP (Fequal (vect[i + 1].definition, definition)) - && vect[i].shadowed == vect[i + 1].shadowed) - i++; - end = vect[i].event; - } - - /* Now START .. END is the range to describe next. */ - - /* Insert the string to describe the event START. */ - insert1 (Fkey_description (kludge, prefix)); - - if (!EQ (start, end)) - { - insert (" .. ", 4); - - ASET (kludge, 0, end); - /* Insert the string to describe the character END. */ - insert1 (Fkey_description (kludge, prefix)); - } - - /* Print a description of the definition of this character. - elt_describer will take care of spacing out far enough - for alignment purposes. */ - (*elt_describer) (vect[i].definition, Qnil); - - if (vect[i].shadowed) - { - ptrdiff_t pt = max (PT - 1, BEG); - - SET_PT (pt); - insert_string ("\n (this binding is currently shadowed)"); - pt = min (PT + 1, Z); - SET_PT (pt); - } - } - - SAFE_FREE (); + call1 (fun, elt); + Fterpri (Qnil, Qnil); } static void -describe_vector_princ (Lisp_Object elt, Lisp_Object fun) +describe_vector_basic (Lisp_Object elt, Lisp_Object fun) { - Findent_to (make_fixnum (16), make_fixnum (1)); call1 (fun, elt); - Fterpri (Qnil, Qnil); } DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0, @@ -3311,8 +2972,40 @@ DESCRIBER is the output function used; nil means use `princ'. */) return unbind_to (count, Qnil); } +DEFUN ("help--describe-vector", Fhelp__describe_vector, Shelp__describe_vector, 7, 7, 0, + doc: /* Insert in the current buffer a description of the contents of VECTOR. +Call DESCRIBER to insert the description of one value found in VECTOR. + +PREFIX is a string describing the key which leads to the keymap that +this vector is in. + +If PARTIAL, it means do not mention suppressed commands. + +SHADOW is a list of keymaps that shadow this map. +If it is non-nil, look up the key in those maps and don't mention it +if it is defined by any of them. + +ENTIRE-MAP is the keymap in which this vector appears. +If the definition in effect in the whole map does not match +the one in this keymap, we ignore this one. */) + (Lisp_Object vector, Lisp_Object prefix, Lisp_Object describer, + Lisp_Object partial, Lisp_Object shadow, Lisp_Object entire_map, + Lisp_Object mention_shadow) +{ + ptrdiff_t count = SPECPDL_INDEX (); + specbind (Qstandard_output, Fcurrent_buffer ()); + CHECK_VECTOR_OR_CHAR_TABLE (vector); + + bool b_partial = NILP (partial) ? false : true; + bool b_mention_shadow = NILP (mention_shadow) ? false : true; + + describe_vector (vector, prefix, describer, describe_vector_basic, b_partial, + shadow, entire_map, true, b_mention_shadow); + return unbind_to (count, Qnil); +} + /* Insert in the current buffer a description of the contents of VECTOR. - We call ELT_DESCRIBER to insert the description of one value found + Call ELT_DESCRIBER to insert the description of one value found in VECTOR. ELT_PREFIX describes what "comes before" the keys or indices defined @@ -3568,6 +3261,7 @@ void syms_of_keymap (void) { DEFSYM (Qkeymap, "keymap"); + DEFSYM (Qdescribe_map_tree, "describe-map-tree"); staticpro (&apropos_predicate); staticpro (&apropos_accumulate); apropos_predicate = Qnil; @@ -3708,6 +3402,8 @@ be preferred. */); defsubr (&Scurrent_active_maps); defsubr (&Saccessible_keymaps); defsubr (&Skey_description); + defsubr (&Skeymap__get_keyelt); + defsubr (&Shelp__describe_vector); defsubr (&Sdescribe_vector); defsubr (&Ssingle_key_description); defsubr (&Stext_char_description); diff --git a/src/keymap.h b/src/keymap.h index 3ef48fb748e..2f7df2bd955 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -36,8 +36,6 @@ extern Lisp_Object current_global_map; extern char *push_key_description (EMACS_INT, char *); extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); extern Lisp_Object get_keymap (Lisp_Object, bool, bool); -extern void describe_map_tree (Lisp_Object, bool, Lisp_Object, Lisp_Object, - const char *, bool, bool, bool, bool); extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **); extern void initial_define_key (Lisp_Object, int, const char *); extern void initial_define_lispy_key (Lisp_Object, const char *, const char *); diff --git a/src/lisp.h b/src/lisp.h index 88e69b9061d..45353fbef3d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1516,11 +1516,11 @@ STRING_MULTIBYTE (Lisp_Object str) } /* An upper bound on the number of bytes in a Lisp string, not - counting the terminating NUL. This a tight enough bound to + counting the terminating null. This a tight enough bound to prevent integer overflow errors that would otherwise occur during string size calculations. A string cannot contain more bytes than a fixnum can represent, nor can it be so long that C pointer - arithmetic stops working on the string plus its terminating NUL. + arithmetic stops working on the string plus its terminating null. Although the actual size limit (see STRING_BYTES_MAX in alloc.c) may be a bit smaller than STRING_BYTES_BOUND, calculating it here would expose alloc.c internal details that we'd rather keep @@ -2988,7 +2988,7 @@ CHECK_INTEGER (Lisp_Object x) /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, - as a NUL-terminated C string. + as a null-terminated C string. `fnname' should be the name of the function in C. By convention, it starts with F. `sname' should be the name for the C constant structure @@ -4210,6 +4210,8 @@ extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *); extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *); extern Lisp_Object module_function_documentation (struct Lisp_Module_Function const *); +extern Lisp_Object module_function_interactive_form + (const struct Lisp_Module_Function *); extern module_funcptr module_function_address (struct Lisp_Module_Function const *); extern void *module_function_data (const struct Lisp_Module_Function *); @@ -4737,7 +4739,7 @@ extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC; extern void dupstring (char **, char const *); /* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating - NUL byte. This is like stpcpy, except the source is a Lisp string. */ + null byte. This is like stpcpy, except the source is a Lisp string. */ INLINE char * lispstpcpy (char *dest, Lisp_Object string) @@ -4955,7 +4957,7 @@ enum : list4 (a, b, c, d)) /* Declare NAME as an auto Lisp string if possible, a GC-based one if not. - Take its unibyte value from the NUL-terminated string STR, + Take its unibyte value from the null-terminated string STR, an expression that should not have side effects. STR's value is not necessarily copied. The resulting Lisp string should not be modified or given text properties or made visible to @@ -4965,8 +4967,8 @@ enum AUTO_STRING_WITH_LEN (name, str, strlen (str)) /* Declare NAME as an auto Lisp string if possible, a GC-based one if not. - Take its unibyte value from the NUL-terminated string STR with length LEN. - STR may have side effects and may contain NUL bytes. + Take its unibyte value from the null-terminated string STR with length LEN. + STR may have side effects and may contain null bytes. STR's value is not necessarily copied. The resulting Lisp string should not be modified or given text properties or made visible to user code. */ diff --git a/src/lread.c b/src/lread.c index 8064bf4d0eb..a3d5fd7bb81 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2573,6 +2573,13 @@ read_escape (Lisp_Object readcharfun, bool stringp) while (++count <= unicode_hex_count) { c = READCHAR; + if (c < 0) + { + if (unicode_hex_count > 4) + error ("Malformed Unicode escape: \\U%x", i); + else + error ("Malformed Unicode escape: \\u%x", i); + } /* `isdigit' and `isalpha' may be locale-specific, which we don't want. */ int digit = char_hexdigit (c); @@ -4104,6 +4111,9 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { make_symbol_constant (sym); XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; + /* Mark keywords as special. This makes (let ((:key 'foo)) ...) + in lexically bound elisp signal an error, as documented. */ + XSYMBOL (sym)->u.s.declared_special = true; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } diff --git a/src/module-env-25.h b/src/module-env-25.h index 01ce65e9148..97c7787da34 100644 --- a/src/module-env-25.h +++ b/src/module-env-25.h @@ -80,13 +80,13 @@ EMACS_ATTRIBUTE_NONNULL(1); /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 - NUL-terminated string. + null-terminated string. SIZE must point to the total size of the buffer. If BUFFER is NULL or if SIZE is not big enough, write the required buffer size to SIZE and return true. - Note that SIZE must include the last NUL byte (e.g. "abc" needs + Note that SIZE must include the last null byte (e.g. "abc" needs a buffer of size 4). Return true if the string was successfully copied. */ diff --git a/src/module-env-28.h b/src/module-env-28.h index 5d884c148c4..f8820b0606b 100644 --- a/src/module-env-28.h +++ b/src/module-env-28.h @@ -12,3 +12,12 @@ int (*open_channel) (emacs_env *env, emacs_value pipe_process) EMACS_ATTRIBUTE_NONNULL (1); + + void (*make_interactive) (emacs_env *env, emacs_value function, + emacs_value spec) + EMACS_ATTRIBUTE_NONNULL (1); + + /* Create a unibyte Lisp string from a string. */ + emacs_value (*make_unibyte_string) (emacs_env *env, + const char *str, ptrdiff_t len) + EMACS_ATTRIBUTE_NONNULL(1, 2); diff --git a/src/nsfont.m b/src/nsfont.m index 691becda6da..378a6408401 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -39,9 +39,7 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu) #include "pdumper.h" /* TODO: Drop once we can assume gnustep-gui 0.17.1. */ -#ifdef NS_IMPL_GNUSTEP #import <AppKit/NSFontDescriptor.h> -#endif #define NSFONT_TRACE 0 #define LCD_SMOOTHING_MARGIN 2 @@ -237,12 +235,6 @@ ns_char_width (NSFont *sfont, int c) CGFloat w = -1.0; NSString *cstr = [NSString stringWithFormat: @"%c", c]; -#ifdef NS_IMPL_COCOA - NSGlyph glyph = [sfont glyphWithName: cstr]; - if (glyph) - w = [sfont advancementForGlyph: glyph].width; -#endif - if (w < 0.0) { NSDictionary *attrsDictionary = @@ -273,12 +265,6 @@ ns_ascii_average_width (NSFont *sfont) ascii_printable = [[NSString alloc] initWithFormat: @"%s", chars]; } -#ifdef NS_IMPL_COCOA - NSGlyph glyph = [sfont glyphWithName: ascii_printable]; - if (glyph) - w = [sfont advancementForGlyph: glyph].width; -#endif - if (w < (CGFloat) 0.0) { NSDictionary *attrsDictionary = @@ -511,10 +497,6 @@ static NSSet } [charset release]; } -#ifdef NS_IMPL_COCOA - if ([families count] == 0) - [families addObject: @"LastResort"]; -#endif [scriptToFamilies setObject: families forKey: script]; } @@ -734,11 +716,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) traits: traits & ~NSItalicFontMask weight: fixLeopardBug size: pixel_size]; } -#ifdef NS_IMPL_COCOA - /* LastResort not really a family */ - if (nsfont == nil && [@"LastResort" isEqualToString: family]) - nsfont = [NSFont fontWithName: @"LastResort" size: pixel_size]; -#endif if (nsfont == nil) { @@ -765,12 +742,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) font_info->metrics = xzalloc (0x100 * sizeof *font_info->metrics); /* for metrics */ -#ifdef NS_IMPL_COCOA - sfont = [nsfont screenFontWithRenderingMode: - NSFontAntialiasedIntegerAdvancementsRenderingMode]; -#else sfont = [nsfont screenFont]; -#endif if (sfont == nil) sfont = nsfont; @@ -797,11 +769,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) * intended. */ CGFloat adjusted_descender = [sfont descender] + 0.0001; -#ifdef NS_IMPL_GNUSTEP font_info->nsfont = sfont; -#else - font_info->nsfont = nsfont; -#endif [font_info->nsfont retain]; /* set up ns_font (defined in nsgui.h) */ @@ -834,32 +802,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) font_info->max_bounds.rbearing = lrint (brect.size.width - (CGFloat) font_info->width); -#ifdef NS_IMPL_COCOA - /* set up synthItal and the CG font */ - font_info->synthItal = synthItal; - { - ATSFontRef atsFont = ATSFontFindFromPostScriptName - ((CFStringRef)[nsfont fontName], kATSOptionFlagsDefault); - - if (atsFont == kATSFontRefUnspecified) - { - /* see if we can get it by dropping italic (then synthesizing) */ - atsFont = ATSFontFindFromPostScriptName ((CFStringRef) - [[fontMgr convertFont: nsfont toNotHaveTrait: NSItalicFontMask] - fontName], kATSOptionFlagsDefault); - if (atsFont != kATSFontRefUnspecified) - font_info->synthItal = YES; - else - { - /* last resort fallback */ - atsFont = ATSFontFindFromPostScriptName - ((CFStringRef)@"Monaco", kATSOptionFlagsDefault); - } - } - font_info->cgfont = CGFontCreateWithPlatformFont ((void *) &atsFont); - } -#endif - /* set up metrics portion of font struct */ font->ascent = lrint([sfont ascender]); font->descent = -lrint(floor(adjusted_descender)); @@ -901,9 +843,6 @@ nsfont_close (struct font *font) xfree (font_info->glyphs); xfree (font_info->metrics); [font_info->nsfont release]; -#ifdef NS_IMPL_COCOA - CGFontRelease (font_info->cgfont); -#endif xfree (font_info->name); font_info->name = NULL; } @@ -994,7 +933,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, { static unsigned char cbuf[1024]; unsigned char *c = cbuf; -#ifdef NS_IMPL_GNUSTEP #if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION > 22 static CGFloat advances[1024]; CGFloat *adv = advances; @@ -1002,10 +940,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, static float advances[1024]; float *adv = advances; #endif -#else - static CGSize advances[1024]; - CGSize *adv = advances; -#endif struct face *face; NSRect r; struct nsfont_info *font; @@ -1073,11 +1007,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, else { cwidth = LGLYPH_WADJUST (glyph); -#ifdef NS_IMPL_GNUSTEP *(adv-1) += LGLYPH_XOFF (glyph); -#else - (*(adv-1)).width += LGLYPH_XOFF (glyph); -#endif } } } @@ -1088,12 +1018,8 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, cwidth = font->metrics[hi][lo].width; } twidth += cwidth; -#ifdef NS_IMPL_GNUSTEP *adv++ = cwidth; c += CHAR_STRING (*t, c); /* This converts the char to UTF-8. */ -#else - (*adv++).width = cwidth; -#endif } len = adv - advances; r.size.width = twidth; @@ -1163,7 +1089,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, : FRAME_BACKGROUND_COLOR (s->f))); /* render under GNUstep using DPS */ -#ifdef NS_IMPL_GNUSTEP { NSGraphicsContext *context = GSCurrentContext (); @@ -1192,61 +1117,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, DPSgrestore (context); } -#else /* NS_IMPL_COCOA */ - { - CGContextRef gcontext = - [[NSGraphicsContext currentContext] graphicsPort]; - static CGAffineTransform fliptf; - static BOOL firstTime = YES; - - if (firstTime) - { - firstTime = NO; - fliptf = CGAffineTransformMakeScale (1.0, -1.0); - } - - CGContextSaveGState (gcontext); - - // Used to be Fix2X (kATSItalicQDSkew), but Fix2X is deprecated - // and kATSItalicQDSkew is 0.25. - fliptf.c = font->synthItal ? 0.25 : 0.0; - - CGContextSetFont (gcontext, font->cgfont); - CGContextSetFontSize (gcontext, font->size); - if (NILP (ns_antialias_text) || font->size <= ns_antialias_threshold) - CGContextSetShouldAntialias (gcontext, 0); - else - CGContextSetShouldAntialias (gcontext, 1); - - CGContextSetTextMatrix (gcontext, fliptf); - - if (bgCol != nil) - { - /* foreground drawing; erase first to avoid overstrike */ - [bgCol set]; - CGContextSetTextDrawingMode (gcontext, kCGTextFillStroke); - CGContextSetTextPosition (gcontext, r.origin.x, r.origin.y); - CGContextShowGlyphsWithAdvances (gcontext, s->char2b, advances, len); - CGContextSetTextDrawingMode (gcontext, kCGTextFill); - } - - [col set]; - - CGContextSetTextPosition (gcontext, r.origin.x, r.origin.y); - CGContextShowGlyphsWithAdvances (gcontext, s->char2b + from, - advances, len); - - if (face->overstrike) - { - CGContextSetTextPosition (gcontext, r.origin.x+0.5, r.origin.y); - CGContextShowGlyphsWithAdvances (gcontext, s->char2b + from, - advances, len); - } - - CGContextRestoreGState (gcontext); - } -#endif /* NS_IMPL_COCOA */ - unblock_input (); return to-from; } @@ -1264,10 +1134,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, static void ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) { -#ifdef NS_IMPL_COCOA - static EmacsGlyphStorage *glyphStorage; - static char firstTime = 1; -#endif unichar *unichars = xmalloc (0x101 * sizeof (unichar)); unsigned int i, g, idx; unsigned short *glyphs; @@ -1278,14 +1144,6 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) block_input (); -#ifdef NS_IMPL_COCOA - if (firstTime) - { - firstTime = 0; - glyphStorage = [[EmacsGlyphStorage alloc] initWithCapacity: 0x100]; - } -#endif - font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned short)); if (!unichars || !(font_info->glyphs[block])) emacs_abort (); @@ -1299,38 +1157,12 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) unichars[0x100] = 0; { -#ifdef NS_IMPL_COCOA - NSString *allChars = [[NSString alloc] - initWithCharactersNoCopy: unichars - length: 0x100 - freeWhenDone: NO]; - NSGlyphGenerator *glyphGenerator = [NSGlyphGenerator sharedGlyphGenerator]; - /* NSCharacterSet *coveredChars = [nsfont coveredCharacterSet]; */ - unsigned int numGlyphs = [font_info->nsfont numberOfGlyphs]; - NSUInteger gInd = 0, cInd = 0; - - [glyphStorage setString: allChars font: font_info->nsfont]; - [glyphGenerator generateGlyphsForGlyphStorage: glyphStorage - desiredNumberOfCharacters: glyphStorage->maxChar - glyphIndex: &gInd characterIndex: &cInd]; -#endif glyphs = font_info->glyphs[block]; for (i = 0; i < 0x100; i++, glyphs++) { -#ifdef NS_IMPL_GNUSTEP g = unichars[i]; -#else - g = glyphStorage->cglyphs[i]; - /* TODO: is this a good check? Maybe need to use coveredChars. */ - if (g > numGlyphs || g == NSNullGlyph) - g = INVALID_GLYPH; /* Hopefully unused... */ -#endif *glyphs = g; } - -#ifdef NS_IMPL_COCOA - [allChars release]; -#endif } unblock_input (); @@ -1352,19 +1184,12 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) fprintf (stderr, "%p\tComputing metrics for glyphs in block %d\n", font_info, block); -#ifdef NS_IMPL_GNUSTEP /* not implemented yet (as of startup 0.18), so punt */ if (numGlyphs == 0) numGlyphs = 0x10000; -#endif block_input (); -#ifdef NS_IMPL_COCOA - sfont = [font_info->nsfont screenFontWithRenderingMode: - NSFontAntialiasedIntegerAdvancementsRenderingMode]; -#else sfont = [font_info->nsfont screenFont]; -#endif font_info->metrics[block] = xzalloc (0x100 * sizeof (struct font_metrics)); if (!(font_info->metrics[block])) @@ -1397,76 +1222,6 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) } -#ifdef NS_IMPL_COCOA -/* Helper for font glyph setup. */ -@implementation EmacsGlyphStorage - -- init -{ - return [self initWithCapacity: 1024]; -} - -- initWithCapacity: (unsigned long) c -{ - self = [super init]; - maxChar = 0; - maxGlyph = 0; - dict = [NSMutableDictionary new]; - cglyphs = xmalloc (c * sizeof (CGGlyph)); - return self; -} - -- (void) dealloc -{ - if (attrStr != nil) - [attrStr release]; - [dict release]; - xfree (cglyphs); - [super dealloc]; -} - -- (void) setString: (NSString *)str font: (NSFont *)font -{ - [dict setObject: font forKey: NSFontAttributeName]; - if (attrStr != nil) - [attrStr release]; - attrStr = [[NSAttributedString alloc] initWithString: str attributes: dict]; - maxChar = [str length]; - maxGlyph = 0; -} - -/* NSGlyphStorage protocol */ -- (NSUInteger)layoutOptions -{ - return 0; -} - -- (NSAttributedString *)attributedString -{ - return attrStr; -} - -- (void)insertGlyphs: (const NSGlyph *)glyphs length: (NSUInteger)length - forStartingGlyphAtIndex: (NSUInteger)glyphIndex - characterIndex: (NSUInteger)charIndex -{ - len = glyphIndex+length; - for (i =glyphIndex; i<len; i++) - cglyphs[i] = glyphs[i-glyphIndex]; - if (len > maxGlyph) - maxGlyph = len; -} - -- (void)setIntAttribute: (NSInteger)attributeTag value: (NSInteger)val - forGlyphAtIndex: (NSUInteger)glyphIndex -{ - return; -} - -@end -#endif /* NS_IMPL_COCOA */ - - /* Debugging */ void ns_dump_glyphstring (struct glyph_string *s) diff --git a/src/nsimage.m b/src/nsimage.m index 966e7044f12..da6f01cf6a3 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -36,6 +36,14 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #include "coding.h" +#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MAX_ALLOWED < 1070 +# define COLORSPACE_NAME NSCalibratedRGBColorSpace +#else +# define COLORSPACE_NAME \ + ((ns_use_srgb_colorspace && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) \ + ? NSDeviceRGBColorSpace : NSCalibratedRGBColorSpace) +#endif + /* ========================================================================== @@ -295,7 +303,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) pixelsWide: w pixelsHigh: h bitsPerSample: 8 samplesPerPixel: 4 hasAlpha: YES isPlanar: YES - colorSpaceName: NSCalibratedRGBColorSpace + colorSpaceName: COLORSPACE_NAME bytesPerRow: w bitsPerPixel: 0]; [bmRep getBitmapDataPlanes: planes]; @@ -415,7 +423,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) /* keep things simple for now */ bitsPerSample: 8 samplesPerPixel: 4 /*RGB+A*/ hasAlpha: YES isPlanar: YES - colorSpaceName: NSCalibratedRGBColorSpace + colorSpaceName: COLORSPACE_NAME bytesPerRow: width bitsPerPixel: 0]; [bmRep getBitmapDataPlanes: pixmapData]; diff --git a/src/nsmenu.m b/src/nsmenu.m index e313fc03f40..a286a80da17 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -122,7 +122,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) /*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */ block_input (); - pool = [[NSAutoreleasePool alloc] init]; /* Menu may have been created automatically; if so, discard it. */ if ([menu isKindOfClass: [EmacsMenu class]] == NO) @@ -240,7 +239,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) [[submenu title] UTF8String]); discard_menu_items (); unbind_to (specpdl_count, Qnil); - [pool release]; unblock_input (); return; } @@ -298,7 +296,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) free_menubar_widget_value_tree (first_wv); discard_menu_items (); unbind_to (specpdl_count, Qnil); - [pool release]; unblock_input (); return; } @@ -364,7 +361,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) if (NILP (items)) { free_menubar_widget_value_tree (first_wv); - [pool release]; unblock_input (); return; } @@ -395,7 +391,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) if (i == n) { free_menubar_widget_value_tree (first_wv); - [pool release]; unblock_input (); return; } @@ -454,7 +449,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) if (needsSet) [NSApp setMainMenu: menu]; - [pool release]; unblock_input (); } diff --git a/src/nsterm.h b/src/nsterm.h index b56bcad4dc1..f292993d8f7 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -718,22 +718,6 @@ typedef id instancetype; ========================================================================== */ -#ifdef NS_IMPL_COCOA -/* rendering util */ -@interface EmacsGlyphStorage : NSObject <NSGlyphStorage> -{ -@public - NSAttributedString *attrStr; - NSMutableDictionary *dict; - CGGlyph *cglyphs; - unsigned long maxChar, maxGlyph; - long i, len; -} -- (instancetype)initWithCapacity: (unsigned long) c; -- (void) setString: (NSString *)str font: (NSFont *)font; -@end -#endif /* NS_IMPL_COCOA */ - extern NSArray *ns_send_types, *ns_return_types; extern NSString *ns_app_name; extern EmacsMenu *svcsMenu; @@ -811,6 +795,7 @@ struct ns_color_table #define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG(color) * 0x101) #define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG(color) * 0x101) +#ifdef NS_IMPL_GNUSTEP /* this extends font backend font */ struct nsfont_info { @@ -827,14 +812,8 @@ struct nsfont_info float size; #ifdef __OBJC__ NSFont *nsfont; -#if defined (NS_IMPL_COCOA) - CGFontRef cgfont; -#else /* GNUstep */ - void *cgfont; -#endif #else /* ! OBJC */ void *nsfont; - void *cgfont; #endif char bold, ital; /* convenience flags */ char synthItal; @@ -844,7 +823,7 @@ struct nsfont_info unsigned short **glyphs; /* map Unicode index to glyph */ struct font_metrics **metrics; }; - +#endif /* Initialized in ns_initialize_display_info (). */ struct ns_display_info @@ -1107,7 +1086,7 @@ extern void ns_term_shutdown (int sig); #define NS_DUMPGLYPH_MOUSEFACE 3 - +#ifdef NS_IMPL_GNUSTEP /* In nsfont, called from fontset.c */ extern void nsfont_make_fontset_for_font (Lisp_Object name, Lisp_Object font_object); @@ -1115,6 +1094,7 @@ extern void nsfont_make_fontset_for_font (Lisp_Object name, /* In nsfont, for debugging */ struct glyph_string; void ns_dump_glyphstring (struct glyph_string *s) EXTERNALLY_VISIBLE; +#endif /* Implemented in nsterm, published in or needed from nsfns. */ extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern, @@ -1274,6 +1254,19 @@ extern char gnustep_base_version[]; /* version tracking */ ? (min) : (((x)>(max)) ? (max) : (x))) #define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX)) + +#ifdef NS_IMPL_COCOA +/* Add some required AppKit version numbers if they're not defined. */ +#ifndef NSAppKitVersionNumber10_7 +#define NSAppKitVersionNumber10_7 1138 +#endif + +#ifndef NSAppKitVersionNumber10_10 +#define NSAppKitVersionNumber10_10 1343 +#endif +#endif /* NS_IMPL_COCOA */ + + /* macOS 10.7 introduces some new constants. */ #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_7) #define NSFullScreenWindowMask (1 << 14) diff --git a/src/nsterm.m b/src/nsterm.m index 26059ab67cd..fa38350a2f6 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -140,14 +140,9 @@ char const * nstrace_fullscreen_type_name (int fs_type) + (NSColor *)colorForEmacsRed:(CGFloat)red green:(CGFloat)green blue:(CGFloat)blue alpha:(CGFloat)alpha { -#if defined (NS_IMPL_COCOA) \ - && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 if (ns_use_srgb_colorspace -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - && [NSColor respondsToSelector: - @selector(colorWithSRGBRed:green:blue:alpha:)] -#endif - ) + && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) return [NSColor colorWithSRGBRed: red green: green blue: blue @@ -161,28 +156,12 @@ char const * nstrace_fullscreen_type_name (int fs_type) - (NSColor *)colorUsingDefaultColorSpace { - /* FIXME: We're checking for colorWithSRGBRed here so this will only - work in the same place as in the method above. It should really - be a check whether we're on macOS 10.7 or above. */ -#if defined (NS_IMPL_COCOA) \ - && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if ([NSColor respondsToSelector: - @selector(colorWithSRGBRed:green:blue:alpha:)]) -#endif - { - if (ns_use_srgb_colorspace) - return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]]; - else - return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]]; - } -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - else -#endif -#endif /* NS_IMPL_COCOA && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */ -#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - return [self colorUsingColorSpaceName: NSCalibratedRGBColorSpace]; +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + if (ns_use_srgb_colorspace + && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) + return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]]; #endif + return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]]; } @end @@ -2209,10 +2188,6 @@ ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value NSTRACE ("ns_set_appearance"); -#ifndef NSAppKitVersionNumber10_10 -#define NSAppKitVersionNumber10_10 1343 -#endif - if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10) return; @@ -3053,6 +3028,46 @@ ns_scroll_run (struct window *w, struct run *run) static void +ns_clear_under_internal_border (struct frame *f) +{ + NSTRACE ("ns_clear_under_internal_border"); + + if (FRAME_LIVE_P (f) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0) + { + int border_width = FRAME_INTERNAL_BORDER_WIDTH (f); + NSView *view = FRAME_NS_VIEW (f); + NSRect edge_rect, frame_rect = [view bounds]; + NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge}; + + int face_id = + !NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) + : INTERNAL_BORDER_FACE_ID; + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + + if (!face) + face = FRAME_DEFAULT_FACE (f); + + /* Sometimes with new frames we reach this point and have no + face. I'm not sure why we have a live frame but no face, so + just give up. */ + if (!face) + return; + + ns_focus (f, &frame_rect, 1); + [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + for (int i = 0; i < 4 ; i++) + { + NSDivideRect (frame_rect, &edge_rect, &frame_rect, border_width, edge[i]); + + NSRectFill (edge_rect); + } + ns_unfocus (f); + } +} + + +static void ns_after_update_window_line (struct window *w, struct glyph_row *desired_row) /* -------------------------------------------------------------------------- External (RIF): preparatory to fringe update after text was updated @@ -3080,12 +3095,32 @@ ns_after_update_window_line (struct window *w, struct glyph_row *desired_row) height > 0)) { int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); + int face_id = + !NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) + : INTERNAL_BORDER_FACE_ID; + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); block_input (); - ns_clear_frame_area (f, 0, y, width, height); - ns_clear_frame_area (f, - FRAME_PIXEL_WIDTH (f) - width, - y, width, height); + if (face) + { + NSRect r = NSMakeRect (0, y, FRAME_PIXEL_WIDTH (f), height); + ns_focus (f, &r, 1); + + [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + NSRectFill (NSMakeRect (0, y, width, height)); + NSRectFill (NSMakeRect (FRAME_PIXEL_WIDTH (f) - width, + y, width, height)); + + ns_unfocus (f); + } + else + { + ns_clear_frame_area (f, 0, y, width, height); + ns_clear_frame_area (f, + FRAME_PIXEL_WIDTH (f) - width, + y, width, height); + } unblock_input (); } } @@ -3140,10 +3175,12 @@ ns_compute_glyph_string_overhangs (struct glyph_string *s) else { s->left_overhang = 0; +#ifdef NS_IMPL_GNUSTEP if (EQ (font->driver->type, Qns)) s->right_overhang = ((struct nsfont_info *)font)->ital ? FONT_HEIGHT (font) * 0.2 : 0; else +#endif s->right_overhang = 0; } } @@ -5301,7 +5338,7 @@ static struct redisplay_interface ns_redisplay_interface = ns_draw_glyph_string, ns_define_frame_cursor, ns_clear_frame_area, - 0, /* clear_under_internal_border */ + ns_clear_under_internal_border, /* clear_under_internal_border */ ns_draw_window_cursor, ns_draw_vertical_window_border, ns_draw_window_divider, @@ -6449,7 +6486,7 @@ not_in_argv (NSString *arg) if (nsEvArray == nil) nsEvArray = [[NSMutableArray alloc] initWithCapacity: 1]; - [NSCursor setHiddenUntilMouseMoves: YES]; + [NSCursor setHiddenUntilMouseMoves:! NILP (Vmake_pointer_invisible)]; if (hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight)) { @@ -8610,7 +8647,7 @@ not_in_argv (NSString *arg) while ( (file = [fenum nextObject]) ) strings = Fcons ([file lispString], strings); } - else if ([type isEqualToString: NSURLPboardType]) + else if ([type isEqualToString: NSPasteboardTypeURL]) { NSURL *url = [NSURL URLFromPasteboard: pb]; if (url == nil) return NO; @@ -8619,8 +8656,8 @@ not_in_argv (NSString *arg) strings = list1 ([[url absoluteString] lispString]); } - else if ([type isEqualToString: NSStringPboardType] - || [type isEqualToString: NSTabularTextPboardType]) + else if ([type isEqualToString: NSPasteboardTypeString] + || [type isEqualToString: NSPasteboardTypeTabularText]) { NSString *data; diff --git a/src/nsxwidget.h b/src/nsxwidget.h index 3d91594c341..dcdb26cb34c 100644 --- a/src/nsxwidget.h +++ b/src/nsxwidget.h @@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */ +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef NSXWIDGET_H_INCLUDED #define NSXWIDGET_H_INCLUDED diff --git a/src/nsxwidget.m b/src/nsxwidget.m index e81ca7fc0cb..dbd4cb29a62 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */ +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> @@ -33,14 +33,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Thoughts on NS Cocoa xwidget and webkit2: Webkit2 process architecture seems to be very hostile for offscreen - rendering techniques, which is used by GTK xwiget implementation; + rendering techniques, which is used by GTK xwidget implementation; Specifically NSView level view sharing / copying is not working. - *** So only one view can be associcated with a model. *** + *** So only one view can be associated with a model. *** With this decision, implementation is plain and can expect best out of webkit2's rationale. But process and session structures will - diverge from GTK xwiget. Though, cosmetically similar usages can + diverge from GTK xwidget. Though, cosmetically similar usages can be presented and will be preferred, if agreeable. For other widget types, OSR seems possible, but will not care for a diff --git a/src/pdumper.c b/src/pdumper.c index 217ffa67839..909900417d9 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1817,7 +1817,7 @@ dump_field_lv_or_rawptr (struct dump_context *ctx, /* Now value is the Lisp_Object to which we want to point whether or not the field is a raw pointer (in which case we just synthesized - the Lisp_Object outselves) or a Lisp_Object (in which case we + the Lisp_Object ourselves) or a Lisp_Object (in which case we just copied the thing). Add a fixup or relocation. */ intptr_t out_value; @@ -1908,7 +1908,7 @@ dump_field_fixup_later (struct dump_context *ctx, (void) field_relpos (in_start, in_field); } -/* Mark an output object field, which is as wide as a poiner, as being +/* Mark an output object field, which is as wide as a pointer, as being fixed up to point to a specific offset in the dump. */ static void dump_field_ptr_to_dump_offset (struct dump_context *ctx, diff --git a/src/print.c b/src/print.c index bd1769144e0..fa65a3cb268 100644 --- a/src/print.c +++ b/src/print.c @@ -941,7 +941,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, else { Lisp_Object error_conditions = Fget (errname, Qerror_conditions); - errmsg = Fsubstitute_command_keys (Fget (errname, Qerror_message)); + errmsg = call1 (Qsubstitute_command_keys, Fget (errname, Qerror_message)); file_error = Fmemq (Qfile_error, error_conditions); } @@ -1590,27 +1590,34 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, /* Print the data here as a plist. */ ptrdiff_t real_size = HASH_TABLE_SIZE (h); - ptrdiff_t size = real_size; + ptrdiff_t size = h->count; /* Don't print more elements than the specified maximum. */ if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) size = XFIXNAT (Vprint_length); printchar ('(', printcharfun); - for (ptrdiff_t i = 0; i < size; i++) + ptrdiff_t j = 0; + for (ptrdiff_t i = 0; i < real_size; i++) { Lisp_Object key = HASH_KEY (h, i); if (!EQ (key, Qunbound)) { - if (i) printchar (' ', printcharfun); + if (j++) printchar (' ', printcharfun); print_object (key, printcharfun, escapeflag); printchar (' ', printcharfun); print_object (HASH_VALUE (h, i), printcharfun, escapeflag); + if (j == size) + break; } } - if (size < real_size) - print_c_string (" ...", printcharfun); + if (j < h->count) + { + if (j) + printchar (' ', printcharfun); + print_c_string ("...", printcharfun); + } print_c_string ("))", printcharfun); } @@ -1901,8 +1908,31 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { case_Lisp_Int: { - int len = sprintf (buf, "%"pI"d", XFIXNUM (obj)); - strout (buf, len, len, printcharfun); + int c; + intmax_t i; + + if (EQ (Vinteger_output_format, Qt) && CHARACTERP (obj) + && (c = XFIXNUM (obj))) + { + printchar ('?', printcharfun); + if (escapeflag + && (c == ';' || c == '(' || c == ')' || c == '{' || c == '}' + || c == '[' || c == ']' || c == '\"' || c == '\'' || c == '\\')) + printchar ('\\', printcharfun); + printchar (c, printcharfun); + } + else if (INTEGERP (Vinteger_output_format) + && integer_to_intmax (Vinteger_output_format, &i) + && i == 16 && !NILP (Fnatnump (obj))) + { + int len = sprintf (buf, "#x%"pI"x", (EMACS_UINT) XFIXNUM (obj)); + strout (buf, len, len, printcharfun); + } + else + { + int len = sprintf (buf, "%"pI"d", XFIXNUM (obj)); + strout (buf, len, len, printcharfun); + } } break; @@ -1922,7 +1952,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) ptrdiff_t i, i_byte; ptrdiff_t size_byte; /* True means we must ensure that the next character we output - cannot be taken as part of a hex character escape. */ + cannot be taken as part of a hex character escape. */ bool need_nonhex = false; bool multibyte = STRING_MULTIBYTE (obj); @@ -1969,25 +1999,29 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* If we just had a hex escape, and this character could be taken as part of it, output `\ ' to prevent that. */ - if (c_isxdigit (c)) - { - if (need_nonhex) - print_c_string ("\\ ", printcharfun); - printchar (c, printcharfun); - } - else if (c == '\n' && print_escape_newlines - ? (c = 'n', true) - : c == '\f' && print_escape_newlines - ? (c = 'f', true) - : c == '\"' || c == '\\') - { - printchar ('\\', printcharfun); - printchar (c, printcharfun); - } - else if (print_escape_control_characters && c_iscntrl (c)) + if (c_isxdigit (c)) + { + if (need_nonhex) + print_c_string ("\\ ", printcharfun); + printchar (c, printcharfun); + } + else if (c == '\n' && print_escape_newlines + ? (c = 'n', true) + : c == '\f' && print_escape_newlines + ? (c = 'f', true) + : c == '\"' || c == '\\') + { + printchar ('\\', printcharfun); + printchar (c, printcharfun); + } + else if (print_escape_control_characters && c_iscntrl (c)) octalout (c, SDATA (obj), i_byte, size_byte, printcharfun); - else - printchar (c, printcharfun); + else if (!multibyte + && SINGLE_BYTE_CHAR_P (c) + && !ASCII_CHAR_P (c)) + printchar (BYTE8_TO_CHAR (c), printcharfun); + else + printchar (c, printcharfun); need_nonhex = false; } } @@ -2017,7 +2051,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) && len == size_byte); if (! NILP (Vprint_gensym) - && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj)) + && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj)) print_c_string ("#:", printcharfun); else if (size_byte == 0) { @@ -2040,7 +2074,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) || c == ',' || c == '.' || c == '`' || c == '[' || c == ']' || c == '?' || c <= 040 || c == NO_BREAK_SPACE - || confusing) + || confusing) { printchar ('\\', printcharfun); confusing = false; @@ -2105,7 +2139,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) if (!NILP (Vprint_circle)) { - /* With the print-circle feature. */ + /* With the print-circle feature. */ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); if (FIXNUMP (num)) @@ -2157,7 +2191,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { int len; /* We're in trouble if this happens! - Probably should just emacs_abort (). */ + Probably should just emacs_abort (). */ print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun); if (VECTORLIKEP (obj)) len = sprintf (buf, "(PVEC 0x%08zx)", (size_t) ASIZE (obj)); @@ -2236,6 +2270,13 @@ A value of nil means to use the shortest notation that represents the number without losing information. */); Vfloat_output_format = Qnil; + DEFVAR_LISP ("integer-output-format", Vinteger_output_format, + doc: /* The format used to print integers. +When t, print characters from integers that represent a character. +When a number 16, print non-negative integers in the hexadecimal format. +Otherwise, by default print integers in the decimal format. */); + Vinteger_output_format = Qnil; + DEFVAR_LISP ("print-length", Vprint_length, doc: /* Maximum length of list to print before abbreviating. A value of nil means no limit. See also `eval-expression-print-length'. */); diff --git a/src/process.c b/src/process.c index 3aa105ae342..50c425077a9 100644 --- a/src/process.c +++ b/src/process.c @@ -1205,6 +1205,16 @@ not the name of the pty that Emacs uses to talk with that terminal. */) return XPROCESS (process)->tty_name; } +static void +update_process_mark (struct Lisp_Process *p) +{ + Lisp_Object buffer = p->buffer; + if (BUFFERP (buffer)) + set_marker_both (p->mark, buffer, + BUF_ZV (XBUFFER (buffer)), + BUF_ZV_BYTE (XBUFFER (buffer))); +} + DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 2, 2, 0, doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). @@ -1217,7 +1227,11 @@ Return BUFFER. */) if (!NILP (buffer)) CHECK_BUFFER (buffer); p = XPROCESS (process); - pset_buffer (p, buffer); + if (!EQ (p->buffer, buffer)) + { + pset_buffer (p, buffer); + update_process_mark (p); + } if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer)); setup_process_coding_systems (process); @@ -1637,6 +1651,7 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, return Fmapcar (Qcdr, Vprocess_alist); } + /* Starting asynchronous inferior processes. */ DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0, @@ -1805,10 +1820,7 @@ usage: (make-process &rest ARGS) */) : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); /* Make the process marker point into the process buffer (if any). */ - if (BUFFERP (buffer)) - set_marker_both (XPROCESS (proc)->mark, buffer, - BUF_ZV (XBUFFER (buffer)), - BUF_ZV_BYTE (XBUFFER (buffer))); + update_process_mark (XPROCESS (proc)); USE_SAFE_ALLOCA; @@ -2453,10 +2465,7 @@ usage: (make-pipe-process &rest ARGS) */) : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); /* Make the process marker point into the process buffer (if any). */ - if (BUFFERP (buffer)) - set_marker_both (p->mark, buffer, - BUF_ZV (XBUFFER (buffer)), - BUF_ZV_BYTE (XBUFFER (buffer))); + update_process_mark (p); { /* Setup coding systems for communicating with the network stream. */ @@ -3182,12 +3191,7 @@ usage: (make-serial-process &rest ARGS) */) if (!EQ (p->command, Qt)) add_process_read_fd (fd); - if (BUFFERP (buffer)) - { - set_marker_both (p->mark, buffer, - BUF_ZV (XBUFFER (buffer)), - BUF_ZV_BYTE (XBUFFER (buffer))); - } + update_process_mark (p); tem = Fplist_get (contact, QCcoding); @@ -3664,10 +3668,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, pset_status (p, Qlisten); /* Make the process marker point into the process buffer (if any). */ - if (BUFFERP (p->buffer)) - set_marker_both (p->mark, p->buffer, - BUF_ZV (XBUFFER (p->buffer)), - BUF_ZV_BYTE (XBUFFER (p->buffer))); + update_process_mark (p); if (p->is_non_blocking_client) { @@ -5413,14 +5414,16 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, /* If data can be read from the process, do so until exhausted. */ if (wait_proc->infd >= 0) { + unsigned int count = 0; XSETPROCESS (proc, wait_proc); while (true) { int nread = read_process_output (proc, wait_proc->infd); + rarely_quit (++count); if (nread < 0) { - if (errno == EIO || would_block (errno)) + if (errno != EINTR) break; } else diff --git a/src/search.c b/src/search.c index 6fb3716cd43..e7f90949464 100644 --- a/src/search.c +++ b/src/search.c @@ -2748,7 +2748,7 @@ since only regular expressions have distinguished subexpressions. */) /* Put point back where it was in the text, if possible. */ TEMP_SET_PT (clip_to_bounds (BEGV, opoint + (opoint <= 0 ? ZV : 0), ZV)); - /* Now move point "officially" to the start of the inserted replacement. */ + /* Now move point "officially" to the end of the inserted replacement. */ move_if_not_intangible (newpoint); return Qnil; diff --git a/src/syntax.c b/src/syntax.c index 7f0fc341f6e..df07809aaaf 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -1421,7 +1421,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, { AUTO_STRING (prefixdoc, ",\n\t is a prefix character for `backward-prefix-chars'"); - insert1 (Fsubstitute_command_keys (prefixdoc)); + insert1 (call1 (Qsubstitute_command_keys, prefixdoc)); } return syntax; @@ -2354,6 +2354,13 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, /* We have encountered a nested comment of the same style as the comment sequence which began this comment section. */ nesting++; + if (comment_end_can_be_escaped + && (code == Sescape || code == Scharquote)) + { + inc_both (&from, &from_byte); + UPDATE_SYNTAX_TABLE_FORWARD (from); + if (from == stop) continue; /* Failure */ + } inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); @@ -2542,20 +2549,23 @@ between them, return t; otherwise return nil. */) bool fence_found = 0; ptrdiff_t ini = from, ini_byte = from_byte; - while (1) + if (from > stop) { - dec_both (&from, &from_byte); - UPDATE_SYNTAX_TABLE_BACKWARD (from); - c = FETCH_CHAR_AS_MULTIBYTE (from_byte); - if (SYNTAX (c) == Scomment_fence - && !char_quoted (from, from_byte)) + while (1) { - fence_found = 1; - break; + dec_both (&from, &from_byte); + UPDATE_SYNTAX_TABLE_BACKWARD (from); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + if (SYNTAX (c) == Scomment_fence + && !char_quoted (from, from_byte)) + { + fence_found = 1; + break; + } + else if (from == stop) + break; + rarely_quit (++quit_count); } - else if (from == stop) - break; - rarely_quit (++quit_count); } if (fence_found == 0) { diff --git a/src/sysdep.c b/src/sysdep.c index e161172a79b..f6c0ddee01a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -267,12 +267,12 @@ get_current_dir_name_or_unreachable (void) char *pwd; - /* The maximum size of a directory name, including the terminating NUL. + /* The maximum size of a directory name, including the terminating null. Leave room so that the caller can append a trailing slash. */ ptrdiff_t dirsize_max = min (PTRDIFF_MAX, SIZE_MAX) - 1; /* The maximum size of a buffer for a file name, including the - terminating NUL. This is bounded by PATH_MAX, if available. */ + terminating null. This is bounded by PATH_MAX, if available. */ ptrdiff_t bufsize_max = dirsize_max; #ifdef PATH_MAX bufsize_max = min (bufsize_max, PATH_MAX); @@ -3331,7 +3331,7 @@ system_process_attributes (Lisp_Object pid) if (nread) { - /* We don't want trailing NUL characters. */ + /* We don't want trailing null characters. */ for (p = cmdline + nread; cmdline < p && !p[-1]; p--) continue; diff --git a/src/term.c b/src/term.c index 5cbb092ad17..ff1aabfed23 100644 --- a/src/term.c +++ b/src/term.c @@ -105,14 +105,14 @@ struct tty_display_info *tty_list; enum no_color_bit { - NC_STANDOUT = 1 << 0, - NC_UNDERLINE = 1 << 1, - NC_REVERSE = 1 << 2, - NC_ITALIC = 1 << 3, - NC_DIM = 1 << 4, - NC_BOLD = 1 << 5, - NC_INVIS = 1 << 6, - NC_PROTECT = 1 << 7 + NC_STANDOUT = 1 << 0, + NC_UNDERLINE = 1 << 1, + NC_REVERSE = 1 << 2, + NC_ITALIC = 1 << 3, + NC_DIM = 1 << 4, + NC_BOLD = 1 << 5, + NC_STRIKE_THROUGH = 1 << 6, + NC_PROTECT = 1 << 7 }; /* internal state */ @@ -1931,6 +1931,10 @@ turn_on_face (struct frame *f, int face_id) if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE)) OUTPUT1_IF (tty, tty->TS_enter_underline_mode); + if (face->tty_strike_through_p + && MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH)) + OUTPUT1_IF (tty, tty->TS_enter_strike_through_mode); + if (tty->TN_max_colors > 0) { const char *ts; @@ -1971,7 +1975,8 @@ turn_off_face (struct frame *f, int face_id) if (face->tty_bold_p || face->tty_italic_p || face->tty_reverse_p - || face->tty_underline_p) + || face->tty_underline_p + || face->tty_strike_through_p) { OUTPUT1_IF (tty, tty->TS_exit_attribute_mode); if (strcmp (tty->TS_exit_attribute_mode, tty->TS_end_standout_mode) == 0) @@ -2006,11 +2011,20 @@ tty_capable_p (struct tty_display_info *tty, unsigned int caps) if ((caps & (cap)) && (!(TS) || !MAY_USE_WITH_COLORS_P(tty, NC_bit))) \ return 0; - TTY_CAPABLE_P_TRY (tty, TTY_CAP_INVERSE, tty->TS_standout_mode, NC_REVERSE); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode, NC_UNDERLINE); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC); + TTY_CAPABLE_P_TRY (tty, + TTY_CAP_INVERSE, tty->TS_standout_mode, NC_REVERSE); + TTY_CAPABLE_P_TRY (tty, + TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode, + NC_UNDERLINE); + TTY_CAPABLE_P_TRY (tty, + TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD); + TTY_CAPABLE_P_TRY (tty, + TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM); + TTY_CAPABLE_P_TRY (tty, + TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC); + TTY_CAPABLE_P_TRY (tty, + TTY_CAP_STRIKE_THROUGH, tty->TS_enter_strike_through_mode, + NC_STRIKE_THROUGH); /* We can do it! */ return 1; @@ -2402,7 +2416,7 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, pos_y = row->y + WINDOW_TOP_EDGE_Y (w); pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w); - /* Save current cursor co-ordinates. */ + /* Save current cursor coordinates. */ save_y = curY (tty); save_x = curX (tty); cursor_to (f, pos_y, pos_x); @@ -2790,16 +2804,15 @@ tty_menu_calc_size (tty_menu *menu, int *width, int *height) static void mouse_get_xy (int *x, int *y) { - struct frame *sf = SELECTED_FRAME (); - Lisp_Object lmx = Qnil, lmy = Qnil, lisp_dummy; - enum scroll_bar_part part_dummy; - Time time_dummy; - - if (FRAME_TERMINAL (sf)->mouse_position_hook) - (*FRAME_TERMINAL (sf)->mouse_position_hook) (&sf, -1, - &lisp_dummy, &part_dummy, - &lmx, &lmy, - &time_dummy); + Lisp_Object lmx = Qnil, lmy = Qnil; + Lisp_Object mouse = mouse_position (tty_menu_calls_mouse_position_function); + + if (EQ (selected_frame, XCAR (mouse))) + { + lmx = XCAR (XCDR (mouse)); + lmy = XCDR (XCDR (mouse)); + } + if (!NILP (lmx)) { *x = XFIXNUM (lmx); @@ -3842,7 +3855,9 @@ clear_tty_hooks (struct terminal *terminal) terminal->update_begin_hook = 0; terminal->update_end_hook = 0; terminal->set_terminal_window_hook = 0; - terminal->defined_color_hook = 0; + /* Don't clear the defined_color_hook, as that makes it impossible + to unload or load a theme when some TTY frame is suspended. */ + /* terminal->defined_color_hook = 0; */ terminal->mouse_position_hook = 0; terminal->frame_rehighlight_hook = 0; terminal->frame_raise_lower_hook = 0; @@ -4124,6 +4139,7 @@ use the Bourne shell command 'TERM=...; export TERM' (C-shell:\n\ tty->TS_enter_alt_charset_mode = tgetstr ("as", address); tty->TS_exit_alt_charset_mode = tgetstr ("ae", address); tty->TS_exit_attribute_mode = tgetstr ("me", address); + tty->TS_enter_strike_through_mode = tgetstr ("smxx", address); MultiUp (tty) = tgetstr ("UP", address); MultiDown (tty) = tgetstr ("DO", address); @@ -4537,6 +4553,13 @@ What means \"very visible\" is up to your terminal. It may make the cursor bigger, or it may make it blink, or it may do nothing at all. */); visible_cursor = 1; + DEFVAR_BOOL ("tty-menu-calls-mouse-position-function", + tty_menu_calls_mouse_position_function, + doc: /* Non-nil means TTY menu code will call `mouse-position-function'. +This should be set if the function in `mouse-position-function' does not +trigger redisplay. */); + tty_menu_calls_mouse_position_function = 0; + defsubr (&Stty_display_color_p); defsubr (&Stty_display_color_cells); defsubr (&Stty_no_underline); diff --git a/src/termcap.c b/src/termcap.c index cc6f2d11acd..1ace4c93103 100644 --- a/src/termcap.c +++ b/src/termcap.c @@ -162,7 +162,7 @@ tgetst1 (char *ptr, char **area) else ret = *area; - /* Copy the string value, stopping at NUL or colon. + /* Copy the string value, stopping at null or colon. Also process ^ and \ abbreviations. */ p = ptr; r = ret; @@ -424,7 +424,7 @@ tgetent (char *bp, const char *name) return -1; buf.size = BUFSIZE; - /* Add 1 to size to ensure room for terminating NUL. */ + /* Add 1 to size to ensure room for terminating null. */ buf.beg = xmalloc (buf.size + 1); term = indirect ? indirect : (char *)name; @@ -480,7 +480,7 @@ tgetent (char *bp, const char *name) *bp1 = '\0'; /* Does this entry refer to another terminal type's entry? - If something is found, copy it into heap and NUL-terminate it. */ + If something is found, copy it into heap and null-terminate it. */ tc_search_point = find_capability (tc_search_point, "tc"); term = tgetst1 (tc_search_point, 0); } @@ -618,7 +618,7 @@ gobble_line (int fd, register struct termcap_buffer *bufp, char *append_end) { ptrdiff_t ptr_offset = bufp->ptr - buf; ptrdiff_t append_end_offset = append_end - buf; - /* Add 1 to size to ensure room for terminating NUL. */ + /* Add 1 to size to ensure room for terminating null. */ ptrdiff_t size = bufp->size + 1; bufp->beg = buf = xpalloc (buf, &size, 1, -1, 1); bufp->size = size - 1; diff --git a/src/termchar.h b/src/termchar.h index c96b81913b0..c967e7d04f4 100644 --- a/src/termchar.h +++ b/src/termchar.h @@ -136,6 +136,8 @@ struct tty_display_info const char *TS_enter_reverse_mode; /* "mr" -- enter reverse video mode. */ const char *TS_exit_underline_mode; /* "us" -- start underlining. */ const char *TS_enter_underline_mode; /* "ue" -- end underlining. */ + const char *TS_enter_strike_through_mode; /* "smxx" -- turn on strike-through + mode. */ /* "as"/"ae" -- start/end alternate character set. Not really supported, yet. */ diff --git a/src/terminfo.c b/src/terminfo.c index 51fd32e9e01..0765996401f 100644 --- a/src/terminfo.c +++ b/src/terminfo.c @@ -23,9 +23,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* Define these variables that serve as global parameters to termcap, so that we do not need to conditionalize the places in Emacs - that set them. */ + that set them. But don't do that for terminfo, as that could + cause link errors when using -fno-common. */ +#if !TERMINFO char *UP, *BC, PC; +#endif /* Interface to curses/terminfo library. Turns out that all of the terminfo-level routines look diff --git a/src/timefns.c b/src/timefns.c index 71d5e10872a..4a28f707a3b 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1311,7 +1311,7 @@ or (if you need time as a string) `format-time-string'. */) determine how many bytes would be written, use NULL for S and ((size_t) -1) for MAXSIZE. - This function behaves like nstrftime, except it allows NUL + This function behaves like nstrftime, except it allows null bytes in FORMAT. */ static size_t emacs_nmemftime (char *s, size_t maxsize, const char *format, @@ -1320,8 +1320,8 @@ emacs_nmemftime (char *s, size_t maxsize, const char *format, int saved_errno = errno; size_t total = 0; - /* Loop through all the NUL-terminated strings in the format - argument. Normally there's just one NUL-terminated string, but + /* Loop through all the null-terminated strings in the format + argument. Normally there's just one null-terminated string, but there can be arbitrarily many, concatenated together, if the format contains '\0' bytes. nstrftime stops at the first '\0' byte so we must invoke it separately for each such string. */ diff --git a/src/unexmacosx.c b/src/unexmacosx.c index 59cbe3c18b9..8cf68bb92e1 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -447,7 +447,7 @@ unexec_regions_recorder (task_t task, void *rr, unsigned type, while (num && num_unexec_regions < MAX_UNEXEC_REGIONS) { - /* Subtract the size of trailing NUL bytes from filesize. It + /* Subtract the size of trailing null bytes from filesize. It can be smaller than vmsize in segment commands. In such a case, trailing bytes are initialized with zeros. */ for (p = ranges->address + ranges->size; p > ranges->address; p--) diff --git a/src/w16select.c b/src/w16select.c index 5a68162e25c..75933526db1 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -220,11 +220,11 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) /* need to know final size after '\r' chars are inserted (the standard CF_OEMTEXT clipboard format uses CRLF line endings, while Emacs uses just LF internally). */ - truelen = Size + 1; /* +1 for the terminating NUL */ + truelen = Size + 1; /* +1 for the terminating null */ if (!Raw) { - /* avoid using strchr because it recomputes the length everytime */ + /* avoid using strchr because it recomputes the length every time */ while ((dp = memchr (dp, '\n', Size - (dp - dstart))) != 0) { truelen++; @@ -243,7 +243,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) { dosmemput (Data, Size, xbuf_addr); - /* Terminate with a NUL, otherwise Windows does strange things + /* Terminate with a null, otherwise Windows does strange things when the text size is an integral multiple of 32 bytes. */ _farpokeb (_dos_ds, xbuf_addr + Size, '\0'); } @@ -255,7 +255,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) while (Size--) { /* Don't allow them to put binary data into the clipboard, since - it will cause yanked data to be truncated at the first NUL. */ + it will cause yanked data to be truncated at the first null. */ if (*dp == '\0') return 2; if (*dp == '\n') @@ -263,7 +263,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) _farnspokeb (buf_offset++, *dp++); } - /* Terminate with a NUL, otherwise Windows does strange things + /* Terminate with a null, otherwise Windows does strange things when the text size is an integral multiple of 32 bytes. */ _farnspokeb (buf_offset, '\0'); } @@ -354,13 +354,13 @@ get_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) __dpmi_int (0x2f, ®s); if (regs.x.ax != 0) { - unsigned char nul_char = '\0'; + unsigned char null_char = '\0'; unsigned long xbuf_beg = xbuf_addr; /* If last_clipboard_text is NULL, we don't want to slow down the next loop by an additional test. */ register unsigned char *lcdp = - last_clipboard_text == NULL ? &nul_char : last_clipboard_text; + last_clipboard_text == NULL ? &null_char : last_clipboard_text; /* Copy data from low memory, remove CR characters before LF if needed. */ @@ -383,7 +383,7 @@ get_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) /* Windows reportedly rounds up the size of clipboard data (passed in SIZE) to a multiple of 32, and removes trailing spaces from each line without updating SIZE. We therefore - bail out when we see the first NUL character. */ + bail out when we see the first null character. */ else if (c == '\0') break; } @@ -392,7 +392,7 @@ get_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) last time set_clipboard_data was called, pretend there's no data in the clipboard. This is so we don't pass our own text from the clipboard (which might be troublesome if the killed - text includes NUL characters). */ + text includes null characters). */ if (last_clipboard_text && xbuf_addr - xbuf_beg == (long)(lcdp - last_clipboard_text)) dp = (unsigned char *)Data + 1; diff --git a/src/w32.c b/src/w32.c index f391f5e26eb..5ebae324c20 100644 --- a/src/w32.c +++ b/src/w32.c @@ -6144,7 +6144,7 @@ is_symlink (const char *filename) /* If NAME identifies a symbolic link, copy into BUF the file name of the symlink's target. Copy at most BUF_SIZE bytes, and do NOT - NUL-terminate the target name, even if it fits. Return the number + null-terminate the target name, even if it fits. Return the number of bytes copied, or -1 if NAME is not a symlink or any error was encountered while resolving it. The file name copied into BUF is encoded in the current ANSI codepage. */ @@ -6248,10 +6248,10 @@ readlink (const char *name, char *buf, size_t buf_size) size_t size_to_copy = buf_size; /* According to MSDN, PrintNameLength does not include the - terminating NUL character. */ + terminating null character. */ lwname = alloca ((lwname_len + 1) * sizeof(WCHAR)); memcpy (lwname, lwname_src, lwname_len); - lwname[lwname_len/sizeof(WCHAR)] = 0; /* NUL-terminate */ + lwname[lwname_len/sizeof(WCHAR)] = 0; /* null-terminate */ filename_from_utf16 (lwname, resolved); dostounix_filename (resolved); lname_size = strlen (resolved) + 1; @@ -6520,7 +6520,8 @@ acl_get_file (const char *fname, acl_type_t type) { xfree (psd); err = GetLastError (); - if (err == ERROR_NOT_SUPPORTED) + if (err == ERROR_NOT_SUPPORTED + || err == ERROR_ACCESS_DENIED) errno = ENOTSUP; else if (err == ERROR_FILE_NOT_FOUND || err == ERROR_PATH_NOT_FOUND @@ -6538,7 +6539,11 @@ acl_get_file (const char *fname, acl_type_t type) be encoded in the current ANSI codepage. */ || err == ERROR_INVALID_NAME) errno = ENOENT; - else if (err == ERROR_NOT_SUPPORTED) + else if (err == ERROR_NOT_SUPPORTED + /* ERROR_ACCESS_DENIED is what we get for a volume + mounted by WebDAV, which evidently doesn't + support ACLs. */ + || err == ERROR_ACCESS_DENIED) errno = ENOTSUP; else errno = EIO; @@ -9879,7 +9884,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) /* Convert input strings to UTF-16. */ encoded_key = code_convert_string_norecord (lkey, Qutf_16le, 1); memcpy (key_w, SSDATA (encoded_key), SBYTES (encoded_key)); - /* wchar_t strings need to be terminated by 2 NUL bytes. */ + /* wchar_t strings need to be terminated by 2 null bytes. */ key_w [SBYTES (encoded_key)/2] = L'\0'; encoded_vname = code_convert_string_norecord (lname, Qutf_16le, 1); memcpy (value_w, SSDATA (encoded_vname), SBYTES (encoded_vname)); @@ -9971,7 +9976,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) case REG_SZ: if (use_unicode) { - /* pvalue ends with 2 NUL bytes, but we need only one, + /* pvalue ends with 2 null bytes, but we need only one, and AUTO_STRING_WITH_LEN will add it. */ if (pvalue[vsize - 1] == '\0') vsize -= 2; @@ -9980,7 +9985,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) } else { - /* Don't waste a byte on the terminating NUL character, + /* Don't waste a byte on the terminating null character, since make_unibyte_string will add one anyway. */ if (pvalue[vsize - 1] == '\0') vsize--; diff --git a/src/w32fns.c b/src/w32fns.c index ab864332e78..ef69f40611e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -3640,7 +3640,7 @@ get_wm_chars (HWND aWnd, int *buf, int buflen, int ignore_ctrl, int ctrl, non-Emacs window with the same language environment, and using (dead)keys there would change the value stored in the kernel, but not this value. */ /* A layout may emit deadkey=0. It looks like this would reset the state - of the kernel's finite automaton (equivalent to emiting 0-length string, + of the kernel's finite automaton (equivalent to emitting 0-length string, which is otherwise impossible in the dead-key map of a layout). Be ready to treat the case when this delivers WM_(SYS)DEADCHAR. */ static int after_deadkey = -1; @@ -3701,7 +3701,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam, of w32_get_key_modifiers (). */ wmsg.dwModifiers = w32_kbd_mods_to_emacs (console_modifiers, wParam); - /* What follows is just heuristics; the correct treatement requires + /* What follows is just heuristics; the correct treatment requires non-destructive ToUnicode(): http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Can_an_application_on_Windows_accept_keyboard_events?_Part_IV:_application-specific_modifiers @@ -7001,7 +7001,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) Frame parameters may be changed if .Xdefaults contains specifications for the default font. For example, if there is an `Emacs.default.attributeBackground: pink', the `background-color' - attribute of the frame get's set, which let's the internal border + attribute of the frame gets set, which let's the internal border of the tooltip frame appear in pink. Prevent this. */ { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); @@ -7085,7 +7085,7 @@ compute_tip_xy (struct frame *f, /* If multiple monitor support is available, constrain the tip onto the current monitor. This improves the above by allowing negative - co-ordinates if monitor positions are such that they are valid, and + coordinates if monitor positions are such that they are valid, and snaps a tooltip onto a single monitor if we are close to the edge where it would otherwise flow onto the other monitor (or into nothingness if there is a gap in the overlap). */ @@ -7960,7 +7960,7 @@ DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash, { SHFILEOPSTRUCTW file_op_w; /* We need one more element beyond MAX_PATH because this is - a list of file names, with the last element double-NUL + a list of file names, with the last element double-null terminated. */ wchar_t tmp_path_w[MAX_PATH + 1]; @@ -8079,7 +8079,7 @@ operations: \"pastelink\" - create a shortcut in DOCUMENT (which must be a directory) the file or directory whose name is in the clipboard. - \"runas\" - run DOCUMENT, which must be an excutable file, with + \"runas\" - run DOCUMENT, which must be an executable file, with elevated privileges (a.k.a. \"as Administrator\"). \"properties\" - open the property sheet dialog for DOCUMENT. @@ -9732,7 +9732,7 @@ get_dll_version (const char *dll_name) /* Return the number of bytes in UTF-8 encoded string STR that corresponds to at most LIM characters. If STR ends before LIM characters, return the number of bytes in STR including the - terminating NUL byte. */ + terminating null byte. */ static int utf8_mbslen_lim (const char *str, int lim) { diff --git a/src/w32heap.c b/src/w32heap.c index ececc73c026..a72bed62caf 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -191,7 +191,7 @@ free_fn the_free_fn; /* It doesn't seem to be useful to allocate from a file mapping. It would be if the memory was shared. - http://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ + https://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ /* This is the function to commit memory when the heap allocator claims for new memory. Before dumping with unexec, we allocate @@ -246,7 +246,7 @@ init_heap (bool use_dynamic_heap) environment before starting GDB to get low fragmentation heap on XP and older systems, for the price of losing "certain heap debug options"; for the details see - http://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ + https://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ data_region_end = data_region_base; /* Create the private heap. */ @@ -884,7 +884,7 @@ setrlimit (rlimit_resource_t rltype, const struct rlimit *rlp) { case RLIMIT_STACK: case RLIMIT_NOFILE: - /* We cannot modfy these limits, so we always fail. */ + /* We cannot modify these limits, so we always fail. */ errno = EPERM; break; default: diff --git a/src/w32menu.c b/src/w32menu.c index e076043f7b7..da2db78a940 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1485,7 +1485,7 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags) crash Emacs when we try to display those "strings". It is unclear why we get these dwItemData, or what they are: sometimes they point to a wchar_t string that is the menu - title, sometimes to someting that doesn't look like text + title, sometimes to something that doesn't look like text at all. (The problematic data also comes with the 0x0800 bit set, but this bit is not documented, so we don't want to depend on it.) */ diff --git a/src/w32proc.c b/src/w32proc.c index c50f246a454..0cf82013065 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -2007,9 +2007,9 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) } /* we have to do some conjuring here to put argv and envp into the - form CreateProcess wants... argv needs to be a space separated/NUL - terminated list of parameters, and envp is a NUL - separated/double-NUL terminated list of parameters. + form CreateProcess wants... argv needs to be a space separated/null + terminated list of parameters, and envp is a null + separated/double-null terminated list of parameters. Additionally, zero-length args and args containing whitespace or quote chars need to be wrapped in double quotes - for this to work, @@ -3398,10 +3398,10 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */) got_full = GetLocaleInfo (XFIXNUM (lcid), XFIXNUM (longform), full_name, sizeof (full_name)); - /* GetLocaleInfo's return value includes the terminating NUL + /* GetLocaleInfo's return value includes the terminating null character, when the returned information is a string, whereas make_unibyte_string needs the string length without the - terminating NUL. */ + terminating null. */ if (got_full) return make_unibyte_string (full_name, got_full - 1); } diff --git a/src/w32select.c b/src/w32select.c index 9a4b43bc69a..e754e1f1ed2 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -803,7 +803,7 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, (void) ignored; /* Don't pass our own text from the clipboard (which might be - troublesome if the killed text includes NUL characters). */ + troublesome if the killed text includes null characters). */ if (!NILP (current_text)) return ret; @@ -956,7 +956,7 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, truelen = nbytes; dst = src; - /* avoid using strchr because it recomputes the length everytime */ + /* avoid using strchr because it recomputes the length every time */ while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL) { if (dst[1] == '\n') /* safe because of trailing '\0' */ diff --git a/src/w32term.c b/src/w32term.c index 1766b32514f..e0618e4f52d 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5478,15 +5478,15 @@ w32_read_socket (struct terminal *terminal, /* Windows can send us a SIZE_MAXIMIZED message even when fullscreen is fullboth. The following is a simple hack to check that based on the fact that - only a maximized fullscreen frame should have both - top/left outside the screen. */ + only a maximized fullscreen frame should have top + or left outside the screen. */ if (EQ (fullscreen, Qfullwidth) || EQ (fullscreen, Qfullheight) || NILP (fullscreen)) { int x, y; w32_real_positions (f, &x, &y); - if (x < 0 && y < 0) + if (x < 0 || y < 0) store_frame_param (f, Qfullscreen, Qmaximized); } } @@ -6877,7 +6877,7 @@ w32_make_frame_visible (struct frame *f) /* According to a report in emacs-devel 2008-06-03, SW_SHOWNORMAL causes unexpected behavior when unminimizing frames that were previously maximized. But only SW_SHOWNORMAL works properly for - frames that were truely hidden (using make-frame-invisible), so + frames that were truly hidden (using make-frame-invisible), so we need it to avoid Bug#5482. It seems that iconified is only set for minimized windows that are still visible, so use that to determine the appropriate flag to pass ShowWindow. */ diff --git a/src/w32term.h b/src/w32term.h index 8ba248013c7..694493c6c82 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -476,7 +476,7 @@ struct scroll_bar { editing large files, we establish a minimum height by always drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below where they would be normally; the bottom and top are in a - different co-ordinate system. */ + different coordinate system. */ int start, end; /* If the scroll bar handle is currently being dragged by the user, diff --git a/src/xdisp.c b/src/xdisp.c index 406b2d70d58..cc499f33261 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -510,7 +510,7 @@ static Lisp_Object list_of_error; || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) /* These are the category sets we use. They are defined by - kinsoku.el and chracters.el. */ + kinsoku.el and characters.el. */ #define NOT_AT_EOL '<' #define NOT_AT_BOL '>' #define LINE_BREAKABLE '|' @@ -2230,7 +2230,7 @@ estimate_mode_line_height (struct frame *f, enum face_id face_id) } /* Given a pixel position (PIX_X, PIX_Y) on frame F, return glyph - co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the + coordinates in (*X, *Y). Set *BOUNDS to the rectangle that the glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP, do not force the value into range. */ @@ -3744,7 +3744,7 @@ init_to_row_end (struct it *it, struct window *w, struct glyph_row *row) it->continuation_lines_width = row->continuation_lines_width + row->pixel_width; CHECK_IT (it); - /* Initializing IT in the presense of compositions in reordered + /* Initializing IT in the presence of compositions in reordered rows is tricky: row->end above will generally cause us to start at position that is not the first one in the logical order, and we might therefore miss the composition earlier in @@ -7555,7 +7555,7 @@ get_next_display_element (struct it *it) non-ASCII spaces and hyphens specially. */ if (! ASCII_CHAR_P (c) && ! NILP (Vnobreak_char_display)) { - if (c == NO_BREAK_SPACE) + if (blankp (c)) nonascii_space_p = true; else if (c == SOFT_HYPHEN || c == HYPHEN || c == NON_BREAKING_HYPHEN) @@ -10567,7 +10567,7 @@ contains long lines that shall be truncated anyway. The optional argument Y-LIMIT, if non-nil, specifies the maximum Y coordinate beyond which the text is to be ignored; it is therefore -also the maxcomp height that the function can return (excluding the +also the maximum height that the function can return (excluding the height of the mode- or header-line, if any). Y-LIMIT nil or omitted means consider all of the accessible portion of buffer text up to the position specified by TO. Since calculating the text height of a @@ -10619,7 +10619,7 @@ include the height of both, if present, in the return value. */) while (bpos > BEGV_BYTE) { dec_both (&start, &bpos); - c = FETCH_CHAR (bpos); + c = FETCH_BYTE (bpos); if (!(c == ' ' || c == '\t')) break; } @@ -10641,7 +10641,7 @@ include the height of both, if present, in the return value. */) while (bpos > BEGV_BYTE) { dec_both (&end, &bpos); - c = FETCH_CHAR (bpos); + c = FETCH_BYTE (bpos); if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r')) break; } @@ -11043,7 +11043,7 @@ message_log_check_duplicate (ptrdiff_t prev_bol_byte, ptrdiff_t this_bol_byte) /* Display an echo area message M with a specified length of NBYTES - bytes. The string may include NUL characters. If M is not a + bytes. The string may include null characters. If M is not a string, clear out any existing message, and let the mini-buffer text show through. @@ -11146,7 +11146,7 @@ message3_nolog (Lisp_Object m) } -/* Display a NUL-terminated echo area message M. If M is 0, clear +/* Display a null-terminated echo area message M. If M is 0, clear out any existing message, and let the mini-buffer text show through. The buffer M must continue to exist until after the echo area gets @@ -11809,7 +11809,20 @@ resize_mini_window (struct window *w, bool exact_p) height = (max_height / unit) * unit; init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID); move_it_vertically_backward (&it, height - unit); + /* The following move is usually a no-op when the stuff + displayed in the mini-window comes entirely from buffer + text, but it is needed when some of it comes from overlay + strings, especially when there's an after-string at ZV. + This happens with some completion packages, like + icomplete, ido-vertical, etc. With those packages, if we + don't force w->start to be at the beginning of a screen + line, important parts of the stuff in the mini-window, + such as user prompt, will be hidden from view. */ + move_it_by_lines (&it, 0); start = it.current.pos; + /* Prevent redisplay_window from recentering, and thus from + overriding the window-start point we computed here. */ + w->start_at_line_beg = false; } else SET_TEXT_POS (start, BEGV, BEGV_BYTE); @@ -12387,12 +12400,12 @@ unwind_format_mode_line (Lisp_Object vector) mode_line_string_face_prop = AREF (vector, 5); /* Select window before buffer, since it may change the buffer. */ - if (!NILP (old_window)) + if (WINDOW_LIVE_P (old_window)) { /* If the operation that we are unwinding had selected a window on a different frame, reset its frame-selected-window. For a text terminal, reset its top-frame if necessary. */ - if (!NILP (target_frame_window)) + if (WINDOW_LIVE_P (target_frame_window)) { Lisp_Object frame = WINDOW_FRAME (XWINDOW (target_frame_window)); @@ -12409,7 +12422,7 @@ unwind_format_mode_line (Lisp_Object vector) /* Restore point of target_frame_window's buffer (Bug#32777). But do this only after old_window has been reselected to avoid that the window point of target_frame_window moves. */ - if (!NILP (target_frame_window)) + if (WINDOW_LIVE_P (target_frame_window)) { Lisp_Object buffer = AREF (vector, 10); @@ -12837,23 +12850,68 @@ update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run) Tab-bars ***********************************************************************/ -#ifdef HAVE_WINDOW_SYSTEM - -/* Select `frame' temporarily without running all the code in - do_switch_frame. - FIXME: Maybe do_switch_frame should be trimmed down similarly - when `norecord' is set. */ +/* Restore WINDOW as the selected window and its frame as the selected + frame. If WINDOW is dead but the selected frame is live, make the + latter's selected window the selected window. If both, WINDOW and + the selected frame, are dead, assign selected frame and window from + some arbitrary live frame. Abort if no such frame can be found. */ static void -fast_set_selected_frame (Lisp_Object frame) +restore_selected_window (Lisp_Object window) { - if (!EQ (selected_frame, frame)) + if (WINDOW_LIVE_P (window)) + /* If WINDOW is live, make it the selected window and its frame's + selected window and set the selected frame to its frame. */ + { + selected_window = window; + selected_frame = XWINDOW (window)->frame; + FRAME_SELECTED_WINDOW (XFRAME (selected_frame)) = window; + } + else if (FRAMEP (selected_frame) && FRAME_LIVE_P (XFRAME (selected_frame))) + /* If WINDOW is dead but the selected frame is still live, make the + latter's selected window the selected one. */ + selected_window = FRAME_SELECTED_WINDOW (XFRAME (selected_frame)); + else + /* If WINDOW and the selected frame are dead, choose some live, + non-child and non-tooltip frame as the new selected frame and + make its selected window the selected window. */ { - selected_frame = frame; - selected_window = XFRAME (frame)->selected_window; + Lisp_Object tail; + Lisp_Object frame UNINIT; + + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + + if (!FRAME_PARENT_FRAME (f) && !FRAME_TOOLTIP_P (f)) + { + selected_frame = frame; + selected_window = FRAME_SELECTED_WINDOW (f); + + return; + } + } + + /* Abort if we cannot find a live frame. */ + emacs_abort (); } } -#endif /* HAVE_WINDOW_SYSTEM */ +/* Restore WINDOW, if live, as its frame's selected window. */ +static void +restore_frame_selected_window (Lisp_Object window) +{ + if (WINDOW_LIVE_P (window)) + /* If WINDOW is live, make it its frame's selected window. If that + frame is the selected frame, make WINDOW the selected window as + well. */ + { + Lisp_Object frame = XWINDOW (window)->frame; + + FRAME_SELECTED_WINDOW (XFRAME (frame)) = window; + if (EQ (frame, selected_frame)) + selected_window = window; + } +} /* Update the tab-bar item list for frame F. This has to be done before we start to fill in any display lines. Called from @@ -12926,9 +12984,10 @@ update_tab_bar (struct frame *f, bool save_match_data) XFRAME (selected_frame)->selected_window)); #ifdef HAVE_WINDOW_SYSTEM Lisp_Object frame; - record_unwind_protect (fast_set_selected_frame, selected_frame); + record_unwind_protect (restore_selected_window, selected_window); XSETFRAME (frame, f); - fast_set_selected_frame (frame); + selected_frame = frame; + selected_window = FRAME_SELECTED_WINDOW (f); #endif /* Build desired tab-bar items from keymaps. */ @@ -13860,9 +13919,10 @@ update_tool_bar (struct frame *f, bool save_match_data) /* Since we only explicitly preserve selected_frame, check that selected_window would be redundant. */ XFRAME (selected_frame)->selected_window)); - record_unwind_protect (fast_set_selected_frame, selected_frame); + record_unwind_protect (restore_selected_window, selected_window); XSETFRAME (frame, f); - fast_set_selected_frame (frame); + selected_frame = frame; + selected_window = FRAME_SELECTED_WINDOW (f); /* Build desired tool-bar items from keymaps. */ new_tool_bar @@ -15404,7 +15464,8 @@ redisplay_internal (void) /* No redisplay if running in batch mode or frame is not yet fully initialized, or redisplay is explicitly turned off by setting Vinhibit_redisplay. */ - if (FRAME_INITIAL_P (SELECTED_FRAME ()) + if ((FRAME_INITIAL_P (SELECTED_FRAME ()) + && redisplay_skip_initial_frame) || !NILP (Vinhibit_redisplay)) return; @@ -15696,7 +15757,12 @@ redisplay_internal (void) && CHARPOS (this_line_end_pos) == CHARPOS (tlendpos) /* Line has same height as before. Otherwise other lines would have to be shifted up or down. */ - && this_line_pixel_height == line_height_before) + && this_line_pixel_height == line_height_before + /* Cannot use this optimization if hscrolling current + line and this line is the current one, because + display_line above is not informed about the + current-line's vpos, and cannot DTRT in that case. */ + && !hscrolling_current_line_p (w)) { /* If this is not the window's last line, we must adjust the charstarts of the lines below. */ @@ -18754,6 +18820,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Try to scroll by specified few lines. */ if ((0 < scroll_conservatively + || (scroll_minibuffer_conservatively && MINI_WINDOW_P (w)) || 0 < emacs_scroll_step || temp_scroll_step || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)) @@ -18764,7 +18831,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* The function returns -1 if new fonts were loaded, 1 if successful, 0 if not successful. */ int ss = try_scrolling (window, just_this_one_p, - scroll_conservatively, + ((scroll_minibuffer_conservatively + && MINI_WINDOW_P (w)) + ? SCROLL_LIMIT + 1 + : scroll_conservatively), emacs_scroll_step, temp_scroll_step, last_line_misfit); switch (ss) @@ -19308,20 +19378,21 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) if ((flags & TRY_WINDOW_CHECK_MARGINS) && !MINI_WINDOW_P (w)) { - int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int bot_scroll_margin = top_scroll_margin; if (window_wants_header_line (w)) - this_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); + top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); start_display (&it, w, pos); if ((w->cursor.y >= 0 /* not vscrolled */ - && w->cursor.y < this_scroll_margin + && w->cursor.y < top_scroll_margin && CHARPOS (pos) > BEGV) /* rms: considering make_cursor_line_fully_visible_p here seems to give wrong results. We don't want to recenter when the last line is partly visible, we want to allow that case to be handled in the usual way. */ || w->cursor.y > (it.last_visible_y - partial_line_height (&it) - - this_scroll_margin - 1)) + - bot_scroll_margin - 1)) { w->cursor.vpos = -1; clear_glyph_matrix (w->desired_matrix); @@ -21936,13 +22007,14 @@ extend_face_to_end_of_line (struct it *it) in the text area has to be drawn to the end of the text area. */ it->glyph_row->fill_line_p = true; + const int orig_face_id = it->face_id; /* If current character of IT is not ASCII, make sure we have the ASCII face. This will be automatically undone the next time get_next_display_element returns a multibyte character. Note that the character will always be single byte in unibyte text. */ if (!ASCII_CHAR_P (it->c)) - it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil); + it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil); /* The default face, possibly remapped. */ struct face *default_face = @@ -22136,6 +22208,7 @@ extend_face_to_end_of_line (struct it *it) if (stretch_width < 0) it->glyph_row->x = stretch_width; } + it->face_id = orig_face_id; } else #endif /* HAVE_WINDOW_SYSTEM */ @@ -22145,7 +22218,6 @@ extend_face_to_end_of_line (struct it *it) struct text_pos saved_pos = it->position; Lisp_Object saved_object = it->object;; enum display_element_type saved_what = it->what; - int saved_face_id = it->face_id; it->what = IT_CHARACTER; memset (&it->position, 0, sizeof it->position); @@ -22248,7 +22320,7 @@ extend_face_to_end_of_line (struct it *it) it->object = saved_object; it->position = saved_pos; it->what = saved_what; - it->face_id = saved_face_id; + it->face_id = orig_face_id; } } @@ -22263,7 +22335,7 @@ trailing_whitespace_p (ptrdiff_t charpos) int c = 0; while (bytepos < ZV_BYTE - && (c = FETCH_CHAR (bytepos), + && (c = FETCH_BYTE (bytepos), c == ' ' || c == '\t')) ++bytepos; @@ -22810,10 +22882,11 @@ display_count_lines_visually (struct it *it) SET_TEXT_POS (from, PT, PT_BYTE); to = IT_CHARPOS (*it); } - start_display (&tem_it, it->w, from); /* Need to disable visual mode temporarily, since otherwise the - call to move_it_to will cause infinite recursion. */ + call to move_it_to below and inside start_display will cause + infinite recursion. */ specbind (Qdisplay_line_numbers, Qrelative); + start_display (&tem_it, it->w, from); /* Some redisplay optimizations could invoke us very far from PT, which will make the caller painfully slow. There should be no need to go too far beyond the window's bottom, as any @@ -22914,6 +22987,10 @@ maybe_produce_line_number (struct it *it) int lnum_face_id = merge_faces (it->w, Qline_number, 0, DEFAULT_FACE_ID); int current_lnum_face_id = merge_faces (it->w, Qline_number_current_line, 0, DEFAULT_FACE_ID); + /* From here onwards, we must prevent freeing realized faces, because + we are using the above 2 face IDs for the glyphs we produce. */ + bool save_free_realized_faces = inhibit_free_realized_faces; + inhibit_free_realized_faces = true; /* Compute point's line number if needed. */ if ((EQ (Vdisplay_line_numbers, Qrelative) || EQ (Vdisplay_line_numbers, Qvisual) @@ -23043,10 +23120,13 @@ maybe_produce_line_number (struct it *it) it->lnum_width = 0; it->lnum_pixel_width = 0; bidi_unshelve_cache (itdata, false); + inhibit_free_realized_faces = save_free_realized_faces; return; } } + inhibit_free_realized_faces = save_free_realized_faces; + /* Record the width in pixels we need for the line number display. */ it->lnum_pixel_width = tem_it.current_x; /* Copy the produced glyphs into IT's glyph_row. */ @@ -25202,11 +25282,14 @@ static int display_mode_lines (struct window *w) { Lisp_Object old_selected_window = selected_window; - Lisp_Object old_selected_frame = selected_frame; Lisp_Object new_frame = w->frame; - Lisp_Object old_frame_selected_window = XFRAME (new_frame)->selected_window; + ptrdiff_t count = SPECPDL_INDEX (); int n = 0; + record_unwind_protect (restore_selected_window, selected_window); + record_unwind_protect + (restore_frame_selected_window, XFRAME (new_frame)->selected_window); + if (window_wants_mode_line (w)) { Lisp_Object window; @@ -25272,9 +25355,8 @@ display_mode_lines (struct window *w) ++n; } - XFRAME (new_frame)->selected_window = old_frame_selected_window; - selected_frame = old_selected_frame; - selected_window = old_selected_window; + unbind_to (count, Qnil); + if (n > 0) w->must_be_updated_p = true; return n; @@ -25640,8 +25722,10 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, /* Non-ASCII characters in SPEC should cause mode-line element be displayed as a multibyte string. */ ptrdiff_t nbytes = strlen (spec); - if (multibyte_chars_in_text ((const unsigned char *)spec, - nbytes) != nbytes) + ptrdiff_t nchars, mb_nbytes; + parse_str_as_multibyte ((const unsigned char *)spec, nbytes, + &nchars, &mb_nbytes); + if (!(nbytes == nchars || nbytes != mb_nbytes)) multibyte = true; switch (mode_line_target) @@ -26086,7 +26170,7 @@ are the selected window and the WINDOW's buffer). */) return unbind_to (count, str); } -/* Write a NUL-terminated, right justified decimal representation of +/* Write a null-terminated, right justified decimal representation of the positive integer D to BUF using a minimal field width WIDTH. */ static void @@ -26116,7 +26200,7 @@ pint2str (register char *buf, register int width, register ptrdiff_t d) } } -/* Write a NUL-terminated, right justified decimal and "human +/* Write a null-terminated, right justified decimal and "human readable" representation of the nonnegative integer D to BUF using a minimal field width WIDTH. D should be smaller than 999.5e24. */ @@ -26339,7 +26423,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, produce strings from numerical values, so limit preposterously large values of FIELD_WIDTH to avoid overrunning the buffer's end. The size of the buffer is enough for FRAME_MESSAGE_BUF_SIZE - bytes plus the terminating NUL. */ + bytes plus the terminating null. */ int width = min (field_width, FRAME_MESSAGE_BUF_SIZE (f)); struct buffer *b = current_buffer; @@ -34458,7 +34542,14 @@ syms_of_xdisp (void) DEFSYM (Qredisplay_internal_xC_functionx, "redisplay_internal (C function)"); - DEFVAR_BOOL("inhibit-message", inhibit_message, + DEFVAR_BOOL ("scroll-minibuffer-conservatively", + scroll_minibuffer_conservatively, + doc: /* Non-nil means scroll conservatively in minibuffer windows. +When the value is nil, scrolling in minibuffer windows obeys the +settings of `scroll-conservatively'. */); + scroll_minibuffer_conservatively = true; /* bug#44070 */ + + DEFVAR_BOOL ("inhibit-message", inhibit_message, doc: /* Non-nil means calls to `message' are not displayed. They are still logged to the *Messages* buffer. @@ -34466,7 +34557,7 @@ Do NOT set this globally to a non-nil value, as doing that will disable messages everywhere, including in I-search and other places where they are necessary. This variable is intended to be let-bound around code that needs to disable messages temporarily. */); - inhibit_message = 0; + inhibit_message = false; message_dolog_marker1 = Fmake_marker (); staticpro (&message_dolog_marker1); @@ -34667,7 +34758,8 @@ If the value is t, Emacs highlights non-ASCII chars which have the same appearance as an ASCII space or hyphen, using the `nobreak-space' or `nobreak-hyphen' face respectively. -U+00A0 (no-break space), U+00AD (soft hyphen), U+2010 (hyphen), and +All of the non-ASCII characters in the Unicode horizontal whitespace +character class, as well as U+00AD (soft hyphen), U+2010 (hyphen), and U+2011 (non-breaking hyphen) are affected. Any other non-nil value means to display these characters as an escape @@ -34830,8 +34922,7 @@ and is used only on frames for which no explicit name has been set Oracle Developer Studio 12.6. */ Lisp_Object icon_title_name_format = pure_list (empty_unibyte_string, - intern_c_string ("invocation-name"), - build_pure_c_string ("@"), + build_pure_c_string ("%b - GNU Emacs at "), intern_c_string ("system-name")); Vicon_title_format = Vframe_title_format @@ -35007,8 +35098,10 @@ but does not change the fact they are interpreted as raw bytes. */); DEFVAR_LISP ("max-mini-window-height", Vmax_mini_window_height, doc: /* Maximum height for resizing mini-windows (the minibuffer and the echo area). -If a float, it specifies a fraction of the mini-window frame's height. -If an integer, it specifies a number of lines. */); +If a float, it specifies the maximum height in units of the +mini-window frame's height. +If an integer, it specifies the maximum height in units of the +mini-window frame's default font's height. */); Vmax_mini_window_height = make_float (0.25); DEFVAR_LISP ("resize-mini-windows", Vresize_mini_windows, @@ -35186,6 +35279,8 @@ It has no effect when set to 0, or when line numbers are not absolute. */); DEFVAR_BOOL ("display-fill-column-indicator", display_fill_column_indicator, doc: /* Non-nil means display the fill column indicator. +If you set this non-nil, make sure `display-fill-column-indicator-character' +is also non-nil. See Info node `Displaying Boundaries' for details. */); display_fill_column_indicator = false; DEFSYM (Qdisplay_fill_column_indicator, "display-fill-column-indicator"); @@ -35203,8 +35298,8 @@ See Info node `Displaying Boundaries' for details. */); DEFVAR_LISP ("display-fill-column-indicator-character", Vdisplay_fill_column_indicator_character, doc: /* Character to draw the indicator when `display-fill-column-indicator' is non-nil. -The default is U+2502 but a good alternative is (ascii 124) -if the font in fill-column-indicator face does not support Unicode characters. +A good candidate is U+2502, and an alternative is (ascii 124) if the +font of `fill-column-indicator' face does not support Unicode characters. See Info node `Displaying Boundaries' for details. */); Vdisplay_fill_column_indicator_character = Qnil; DEFSYM (Qdisplay_fill_column_indicator_character, "display-fill-column-indicator-character"); @@ -35385,6 +35480,12 @@ When nil, mouse-movement events will not be generated as long as the mouse stays within the extent of a single glyph (except for images). */); mouse_fine_grained_tracking = false; + DEFVAR_BOOL ("redisplay-skip-initial-frame", redisplay_skip_initial_frame, + doc: /* Non-nil to skip redisplay in initial frame. +The initial frame is not displayed anywhere, so skipping it is +best except in special circumstances such as running redisplay tests +in batch mode. */); + redisplay_skip_initial_frame = true; } @@ -35395,6 +35496,8 @@ init_xdisp (void) { CHARPOS (this_line_start_pos) = 0; + echo_area_window = minibuf_window; + if (!noninteractive) { struct window *m = XWINDOW (minibuf_window); @@ -35404,8 +35507,6 @@ init_xdisp (void) struct window *r = XWINDOW (root); int i; - echo_area_window = minibuf_window; - r->top_line = FRAME_TOP_MARGIN (f); r->pixel_top = r->top_line * FRAME_LINE_HEIGHT (f); r->total_cols = FRAME_COLS (f); diff --git a/src/xfaces.c b/src/xfaces.c index 06d2f994de6..73a536b19c6 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -5217,7 +5217,6 @@ tty_supports_face_attributes_p (struct frame *f, || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) - || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])) return false; @@ -5282,6 +5281,15 @@ tty_supports_face_attributes_p (struct frame *f, test_caps |= TTY_CAP_INVERSE; } + /* strike through */ + val = attrs[LFACE_STRIKE_THROUGH_INDEX]; + if (!UNSPECIFIEDP (val)) + { + if (face_attr_equal_p (val, def_attrs[LFACE_STRIKE_THROUGH_INDEX])) + return false; /* same as default */ + else + test_caps |= TTY_CAP_STRIKE_THROUGH; + } /* Color testing. */ @@ -6244,6 +6252,8 @@ realize_tty_face (struct face_cache *cache, face->tty_underline_p = true; if (!NILP (attrs[LFACE_INVERSE_INDEX])) face->tty_reverse_p = true; + if (!NILP (attrs[LFACE_STRIKE_THROUGH_INDEX])) + face->tty_strike_through_p = true; /* Map color names to color indices. */ map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted); diff --git a/src/xfns.c b/src/xfns.c index 78f977bf0aa..46e4bd73a6b 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6535,7 +6535,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) Frame parameters may be changed if .Xdefaults contains specifications for the default font. For example, if there is an `Emacs.default.attributeBackground: pink', the `background-color' - attribute of the frame get's set, which let's the internal border + attribute of the frame gets set, which let's the internal border of the tooltip frame appear in pink. Prevent this. */ { Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); diff --git a/src/xfont.c b/src/xfont.c index 1563b43bf97..32f63c3f7ce 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -133,7 +133,7 @@ compare_font_names (const void *name1, const void *name2) /* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length of the decoding result. LEN is the byte length of XLFD, or -1 if - XLFD is NUL terminated. The caller must assure that OUTPUT is at + XLFD is NULL terminated. The caller must assure that OUTPUT is at least twice (plus 1) as large as XLFD. */ static ptrdiff_t diff --git a/src/xterm.c b/src/xterm.c index 2e0407aff40..98bb0ea8917 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8949,8 +8949,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif #ifdef USE_GTK if (!f - && (f = any) - && configureEvent.xconfigure.window == FRAME_X_WINDOW (f)) + && (f = any) + && configureEvent.xconfigure.window == FRAME_X_WINDOW (f) + && FRAME_VISIBLE_P(f)) { block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) @@ -8963,10 +8964,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, configureEvent.xconfigure.height); #endif f = 0; - } + } #endif - if (f) - { + if (f && FRAME_VISIBLE_P(f)) + { #ifdef USE_GTK /* For GTK+ don't call x_net_wm_state for the scroll bar window. (Bug#24963, Bug#25887) */ @@ -9056,7 +9057,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, xic_set_statusarea (f); #endif - } + } goto OTHER; case ButtonRelease: diff --git a/src/xterm.h b/src/xterm.h index db8d5847814..0f8ba5e82b4 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -890,7 +890,7 @@ struct scroll_bar editing large files, we establish a minimum height by always drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below where they would be normally; the bottom and top are in a - different co-ordinate system. */ + different coordinate system. */ int start, end; /* If the scroll bar handle is currently being dragged by the user, diff --git a/src/xwidget.c b/src/xwidget.c index 154b3e9c82c..031975fafb9 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -114,6 +114,13 @@ Returns the newly constructed xwidget, or nil if construction fails. */) if (EQ (xw->type, Qwebkit)) { block_input (); + WebKitWebContext *webkit_context = webkit_web_context_get_default (); + +# if WEBKIT_CHECK_VERSION (2, 26, 0) + if (!webkit_web_context_get_sandbox_enabled (webkit_context)) + webkit_web_context_set_sandbox_enabled (webkit_context, TRUE); +# endif + xw->widgetwindow_osr = gtk_offscreen_window_new (); gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, xw->height); @@ -152,7 +159,7 @@ Returns the newly constructed xwidget, or nil if construction fails. */) "load-changed", G_CALLBACK (webkit_view_load_changed_cb), xw); - g_signal_connect (G_OBJECT (webkit_web_context_get_default ()), + g_signal_connect (G_OBJECT (webkit_context), "download-started", G_CALLBACK (webkit_download_cb), xw); @@ -793,7 +800,9 @@ DEFUN ("xwidget-webkit-title", WEBKIT_FN_INIT (); #ifdef USE_GTK WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); - return build_string (webkit_web_view_get_title (wkwv)); + const gchar *title = webkit_web_view_get_title (wkwv); + + return build_string (title ? title : ""); #elif defined NS_IMPL_COCOA return nsxwidget_webkit_title (xw); #endif diff --git a/test/ChangeLog.1 b/test/ChangeLog.1 index c364219c362..2bf014d0a95 100644 --- a/test/ChangeLog.1 +++ b/test/ChangeLog.1 @@ -1754,7 +1754,7 @@ * indent/prolog.prolog: Test alignment of ->; with operator at bol. - * indent/css-mode.css (.x2): Test alignement inside braces. + * indent/css-mode.css (.x2): Test alignment inside braces. 2013-10-26 Dmitry Gutov <dgutov@yandex.ru> diff --git a/test/Makefile.in b/test/Makefile.in index d1da02e582c..67d203df297 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -89,11 +89,6 @@ unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS ## To run tests under a debugger, set this to eg: "gdb --args". GDB = -# The locale to run tests under. Tests should work if this is set to -# any supported locale. Use the C locale by default, as it should be -# supported everywhere. -TEST_LOCALE = C - # Set this to 'yes' to run the tests in an interactive instance. TEST_INTERACTIVE ?= no @@ -128,7 +123,7 @@ endif # The actual Emacs command run in the targets below. # Prevent any setting of EMACSLOADPATH in user environment causing problems. -emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) \ +emacs = EMACSLOADPATH= \ EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \ $(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT) @@ -137,7 +132,7 @@ emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) \ # exists, or writing to ~/.bzr.log when running bzr commands). TEST_HOME = /nonexistent -test_module_dir := data/emacs-module +test_module_dir := src/emacs-module-resources .PHONY: all check diff --git a/test/README b/test/README index fe05b5403b1..d0da89d1c2c 100644 --- a/test/README +++ b/test/README @@ -81,6 +81,11 @@ Some tests might take long time to run. In order to summarize the make SUMMARIZE_TESTS=<nn> ... +The backtrace of failing tests are truncated to the default value of +'ert-batch-backtrace-right-margin'. To see more of the backtrace, use + + make TEST_BACKTRACE_LINE_LENGTH=<nn> ... + The tests are run in batch mode by default; sometimes it's useful to get precisely the same environment but run in interactive mode for debugging. To do that, use diff --git a/test/file-organization.org b/test/file-organization.org index 34bd0b90e03..64c0755b3bc 100644 --- a/test/file-organization.org +++ b/test/file-organization.org @@ -1,10 +1,10 @@ -#+TITLE: The Location of Emacs-Lisp Tests +#+TITLE: The Location of Emacs Lisp Tests * The Main Emacs Repository -The Emacs repository contains a very large number of Emacs-Lisp files, many of +The Emacs repository contains a very large number of Emacs Lisp files, many of which pre-date both formal package support for Emacs and automated unit testing. diff --git a/test/lisp/allout-tests.el b/test/lisp/allout-tests.el new file mode 100644 index 00000000000..f7cd6db9cd4 --- /dev/null +++ b/test/lisp/allout-tests.el @@ -0,0 +1,148 @@ +;;; allout-tests.el --- Tests for allout.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'allout) + +(require 'cl-lib) + +(defun allout-tests-obliterate-variable (name) + "Completely unbind variable with NAME." + (if (local-variable-p name (current-buffer)) (kill-local-variable name)) + (while (boundp name) (makunbound name))) + +(defvar allout-tests-globally-unbound nil + "Fodder for allout resumptions tests -- defvar just for byte compiler.") +(defvar allout-tests-globally-true nil + "Fodder for allout resumptions tests -- defvar just for byte compiler.") +(defvar allout-tests-locally-true nil + "Fodder for allout resumptions tests -- defvar just for byte compiler.") + +;; For each resumption case, we also test that the right local/global +;; scopes are affected during resumption effects. + +(ert-deftest allout-test-resumption-unbound-return-to-unbound () + "Previously unbound variables return to the unbound state." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-add-resumptions '(allout-tests-globally-unbound t)) + (should (not (default-boundp 'allout-tests-globally-unbound))) + (should (local-variable-p 'allout-tests-globally-unbound (current-buffer))) + (should (boundp 'allout-tests-globally-unbound)) + (should (equal allout-tests-globally-unbound t)) + (allout-do-resumptions) + (should (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) + (should (not (boundp 'allout-tests-globally-unbound))))) + +(ert-deftest allout-test-resumption-variable-resumed () + "Ensure that variable with prior global value is resumed." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-add-resumptions '(allout-tests-globally-true nil)) + (should (equal (default-value 'allout-tests-globally-true) t)) + (should (local-variable-p 'allout-tests-globally-true (current-buffer))) + (should (equal allout-tests-globally-true nil)) + (allout-do-resumptions) + (should (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) + (should (boundp 'allout-tests-globally-true)) + (should (equal allout-tests-globally-true t)))) + +(ert-deftest allout-test-resumption-prior-value-resumed () + "Ensure that prior local value is resumed." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (set (make-local-variable 'allout-tests-locally-true) t) + (cl-assert (not (default-boundp 'allout-tests-locally-true)) + nil (concat "Test setup mistake -- variable supposed to" + " not have global binding, but it does.")) + (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)) + nil (concat "Test setup mistake -- variable supposed to have" + " local binding, but it lacks one.")) + (allout-add-resumptions '(allout-tests-locally-true nil)) + (should (not (default-boundp 'allout-tests-locally-true))) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true nil)) + (allout-do-resumptions) + (should (boundp 'allout-tests-locally-true)) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true t)) + (should (not (default-boundp 'allout-tests-locally-true))))) + +(ert-deftest allout-test-resumption-multiple-holds () + "Ensure that last of multiple resumptions holds, for various scopes." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (set (make-local-variable 'allout-tests-locally-true) t) + (allout-add-resumptions '(allout-tests-globally-unbound t) + '(allout-tests-globally-true nil) + '(allout-tests-locally-true nil)) + (allout-add-resumptions '(allout-tests-globally-unbound 2) + '(allout-tests-globally-true 3) + '(allout-tests-locally-true 4)) + ;; reestablish many of the basic conditions are maintained after re-add: + (should (not (default-boundp 'allout-tests-globally-unbound))) + (should (local-variable-p 'allout-tests-globally-unbound (current-buffer))) + (should (equal allout-tests-globally-unbound 2)) + (should (default-boundp 'allout-tests-globally-true)) + (should (local-variable-p 'allout-tests-globally-true (current-buffer))) + (should (equal allout-tests-globally-true 3)) + (should (not (default-boundp 'allout-tests-locally-true))) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true 4)) + (allout-do-resumptions) + (should (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) + (should (not (boundp 'allout-tests-globally-unbound))) + (should (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) + (should (boundp 'allout-tests-globally-true)) + (should (equal allout-tests-globally-true t)) + (should (boundp 'allout-tests-locally-true)) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true t)) + (should (not (default-boundp 'allout-tests-locally-true))))) + +(ert-deftest allout-test-resumption-unbinding () + "Ensure that deliberately unbinding registered variables doesn't foul things." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (set (make-local-variable 'allout-tests-locally-true) t) + (allout-add-resumptions '(allout-tests-globally-unbound t) + '(allout-tests-globally-true nil) + '(allout-tests-locally-true nil)) + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (allout-do-resumptions))) + +(provide 'allout-tests) +;;; allout-tests.el ends here diff --git a/test/lisp/allout-widgets-tests.el b/test/lisp/allout-widgets-tests.el new file mode 100644 index 00000000000..2b1bcaa6de3 --- /dev/null +++ b/test/lisp/allout-widgets-tests.el @@ -0,0 +1,87 @@ +;;; allout-widgets-tests.el --- Tests for allout-widgets.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'allout-widgets) + +(require 'cl-lib) + +(ert-deftest allout-test-range-overlaps () + "`allout-range-overlaps' unit tests." + (let* (ranges + got + (try (lambda (from to) + (setq got (allout-range-overlaps from to ranges)) + (setq ranges (cadr got)) + got))) +;; ;; biggie: +;; (setq ranges nil) +;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall +;; ;; ~ 13 seconds for doing repeated funcall +;; (message "time-trial: %s, resulting size %s" +;; (time-trial +;; '(let ((size 10000) +;; doing) +;; (dotimes (count size) +;; (setq doing (random size)) +;; (funcall try doing (+ doing (random 5))) +;; ;;(list doing (+ doing (random 5))) +;; ))) +;; (length ranges)) +;; (sit-for 2) + + ;; fresh: + (setq ranges nil) + (should (equal (funcall try 3 5) '(nil ((3 5))))) + ;; add range at end: + (should (equal (funcall try 10 12) '(nil ((3 5) (10 12))))) + ;; add range at beginning: + (should (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12))))) + ;; insert range somewhere in the middle: + (should (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12))))) + ;; consolidate some: + (should (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12))))) + ;; add more: + (should (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17))))) + ;; add more: + (should (equal (funcall try 20 22) + '(nil ((1 2) (3 9) (10 12) (15 17) (20 22))))) + ;; encompass more: + (should (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22))))) + ;; encompass all: + (should (equal (funcall try 2 25) '(t ((1 25))))) + + ;; fresh slate: + (setq ranges nil) + (should (equal (funcall try 20 25) '(nil ((20 25))))) + (should (equal (funcall try 30 35) '(nil ((20 25) (30 35))))) + (should (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35))))) + (should (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35))))) + (should (equal (funcall try 10 30) '(t ((10 35))))) + (should (equal (funcall try 5 6) '(nil ((5 6) (10 35))))) + (should (equal (funcall try 2 100) '(t ((2 100))))) + + (setq ranges nil))) + +(provide 'allout-widgets-tests) +;;; allout-widgets-tests.el ends here diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index 22ca7e2ec55..e92a4d28c6f 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -32,7 +32,7 @@ (cons 1024 "------S---") ; Bug#28092 (cons 2048 "---S------")))) (dolist (x alist) - (should (equal (cdr x) (archive-int-to-mode (car x))))))) + (should (equal (cdr x) (file-modes-number-to-symbolic (car x))))))) (ert-deftest arc-mode-test-zip-extract-gz () (skip-unless (and archive-zip-extract (executable-find (car archive-zip-extract)))) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index ec3e4bb77ba..9ebf137f87c 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -61,8 +63,9 @@ file-notify-debug nil tramp-verbose 0) -(defconst auto-revert--timeout (1+ auto-revert-interval) - "Time to wait for a message.") +(defun auto-revert--timeout () + "Time to wait for a message." + (+ auto-revert-interval 0.1)) (defvar auto-revert--messages nil "Used to collect messages issued during a section of a test.") @@ -125,14 +128,14 @@ This expects `auto-revert--messages' to be bound by ;; Remote files do not cooperate well with timers. So we count ourselves. (let ((ct (current-time))) (while (and (< (float-time (time-subtract (current-time) ct)) - auto-revert--timeout) + (auto-revert--timeout)) (null (string-match (format-message "Reverting buffer `%s'\\." (buffer-name buffer)) auto-revert--messages))) (if (with-current-buffer buffer auto-revert-use-notify) - (read-event nil nil 0.1) - (sleep-for 0.1))))) + (read-event nil nil 0.05) + (sleep-for 0.05))))) (defmacro auto-revert--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." @@ -152,50 +155,59 @@ This expects `auto-revert--messages' to be bound by (funcall (ert-test-body ert-test)) (error (message "%s" err) (signal (car err) (cdr err))))))) +(defmacro with-auto-revert-test (&rest body) + `(let ((auto-revert-interval-orig auto-revert-interval)) + (unwind-protect + (progn + (customize-set-variable 'auto-revert-interval 0.1) + ,@body) + (customize-set-variable 'auto-revert-interval auto-revert-interval-orig)))) + +(defun auto-revert-tests--write-file (text file time-delta &optional append) + (write-region text nil file append 'no-message) + (set-file-times file (time-subtract (current-time) time-delta))) + (ert-deftest auto-revert-test00-auto-revert-mode () "Check autorevert for a file." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. - (let ((tmpfile (make-temp-file "auto-revert-test")) - buf) - (unwind-protect - (progn - (write-region "any text" nil tmpfile nil 'no-message) - (setq buf (find-file-noselect tmpfile)) - (with-current-buffer buf - (ert-with-message-capture auto-revert--messages - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that it - ;; returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) - - ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf)) - (should (string-match "another text" (buffer-string))) - - ;; When the buffer is modified, it shall not be reverted. - (ert-with-message-capture auto-revert--messages - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) - - ;; Check, that the buffer hasn't been reverted. - (auto-revert--wait-for-revert buf)) - (should-not (string-match "any text" (buffer-string))))) - - ;; Exit. - (ignore-errors - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf)) - (ignore-errors (delete-file tmpfile))))) + (with-auto-revert-test + (let ((tmpfile (make-temp-file "auto-revert-test")) + (times '(60 30 15)) + buf) + (unwind-protect + (progn + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + (setq buf (find-file-noselect tmpfile)) + (with-current-buffer buf + (ert-with-message-capture auto-revert--messages + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that it + ;; returns nil. + (auto-revert-mode 1) + (should auto-revert-mode) + + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf)) + (should (string-match "another text" (buffer-string))) + + ;; When the buffer is modified, it shall not be reverted. + (ert-with-message-capture auto-revert--messages + (set-buffer-modified-p t) + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + + ;; Check, that the buffer hasn't been reverted. + (auto-revert--wait-for-revert buf)) + (should-not (string-match "any text" (buffer-string))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmpfile)))))) (auto-revert--deftest-remote auto-revert-test00-auto-revert-mode "Check autorevert for a remote file.") @@ -203,66 +215,65 @@ This expects `auto-revert--messages' to be bound by ;; This is inspired by Bug#21841. (ert-deftest auto-revert-test01-auto-revert-several-files () "Check autorevert for several files at once." - :tags '(:expensive-test) (skip-unless (executable-find "cp" (file-remote-p temporary-file-directory))) - (let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory))) - (tmpdir1 (make-temp-file "auto-revert-test" 'dir)) - (tmpdir2 (make-temp-file "auto-revert-test" 'dir)) - (tmpfile1 - (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) - (tmpfile2 - (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) - buf1 buf2) - (unwind-protect - (ert-with-message-capture auto-revert--messages - (write-region "any text" nil tmpfile1 nil 'no-message) - (setq buf1 (find-file-noselect tmpfile1)) - (write-region "any text" nil tmpfile2 nil 'no-message) - (setq buf2 (find-file-noselect tmpfile2)) - - (dolist (buf (list buf1 buf2)) - (with-current-buffer buf - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that - ;; it returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode))) - - ;; Modify files. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region - "another text" nil - (expand-file-name (file-name-nondirectory tmpfile1) tmpdir2) - nil 'no-message) - (write-region - "another text" nil - (expand-file-name (file-name-nondirectory tmpfile2) tmpdir2) - nil 'no-message) - ;;(copy-directory tmpdir2 tmpdir1 nil 'copy-contents) - ;; Strange, that `copy-directory' does not work as expected. - ;; The following shell command is not portable on all - ;; platforms, unfortunately. - (shell-command - (format "%s -f %s/* %s" - cp (file-local-name tmpdir2) (file-local-name tmpdir1))) - - ;; Check, that the buffers have been reverted. - (dolist (buf (list buf1 buf2)) - (with-current-buffer buf - (auto-revert--wait-for-revert buf) - (should (string-match "another text" (buffer-string)))))) - - ;; Exit. - (ignore-errors - (dolist (buf (list buf1 buf2)) - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf))) - (ignore-errors (delete-directory tmpdir1 'recursive)) - (ignore-errors (delete-directory tmpdir2 'recursive))))) + (with-auto-revert-test + (let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory))) + (tmpdir1 (make-temp-file "auto-revert-test" 'dir)) + (tmpdir2 (make-temp-file "auto-revert-test" 'dir)) + (tmpfile1 + (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) + (tmpfile2 + (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) + (times '(120 60 30 15)) + buf1 buf2) + (unwind-protect + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "any text" tmpfile1 (pop times)) + (setq buf1 (find-file-noselect tmpfile1)) + (auto-revert-tests--write-file "any text" tmpfile2 (pop times)) + (setq buf2 (find-file-noselect tmpfile2)) + + (dolist (buf (list buf1 buf2)) + (with-current-buffer buf + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that + ;; it returns nil. + (auto-revert-mode 1) + (should auto-revert-mode))) + + ;; Modify files. We wait for a second, in order to have + ;; another timestamp. + (auto-revert-tests--write-file + "another text" + (expand-file-name (file-name-nondirectory tmpfile1) tmpdir2) + (pop times)) + (auto-revert-tests--write-file + "another text" + (expand-file-name (file-name-nondirectory tmpfile2) tmpdir2) + (pop times)) + ;;(copy-directory tmpdir2 tmpdir1 nil 'copy-contents) + ;; Strange, that `copy-directory' does not work as expected. + ;; The following shell command is not portable on all + ;; platforms, unfortunately. + (shell-command + (format "%s -f %s/* %s" + cp (file-local-name tmpdir2) (file-local-name tmpdir1))) + + ;; Check, that the buffers have been reverted. + (dolist (buf (list buf1 buf2)) + (with-current-buffer buf + (auto-revert--wait-for-revert buf) + (should (string-match "another text" (buffer-string)))))) + + ;; Exit. + (ignore-errors + (dolist (buf (list buf1 buf2)) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf))) + (ignore-errors (delete-directory tmpdir1 'recursive)) + (ignore-errors (delete-directory tmpdir2 'recursive)))))) (auto-revert--deftest-remote auto-revert-test01-auto-revert-several-files "Check autorevert for several remote files at once.") @@ -270,84 +281,81 @@ This expects `auto-revert--messages' to be bound by ;; This is inspired by Bug#23276. (ert-deftest auto-revert-test02-auto-revert-deleted-file () "Check autorevert for a deleted file." - :tags '(:expensive-test) ;; Repeated unpredictable failures, bug#32645. ;; Unlikely to be hydra-specific? ; (skip-unless (not (getenv "EMACS_HYDRA_CI"))) - (let ((tmpfile (make-temp-file "auto-revert-test")) - ;; Try to catch bug#32645. - (auto-revert-debug (getenv "EMACS_HYDRA_CI")) - (file-notify-debug (getenv "EMACS_HYDRA_CI")) - buf desc) - (unwind-protect - (progn - (write-region "any text" nil tmpfile nil 'no-message) - (setq buf (find-file-noselect tmpfile)) - (with-current-buffer buf - (should-not - (file-notify-valid-p auto-revert-notify-watch-descriptor)) - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that - ;; it returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) - (setq desc auto-revert-notify-watch-descriptor) - - ;; Remove file while reverting. We simulate this by - ;; modifying `before-revert-hook'. - (add-hook - 'before-revert-hook - (lambda () - (when auto-revert-debug - (message "%s deleted" buffer-file-name)) - (delete-file buffer-file-name)) - nil t) - - (ert-with-message-capture auto-revert--messages - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer hasn't been reverted. File - ;; notification should be disabled, falling back to - ;; polling. - (should (string-match "any text" (buffer-string))) - ;; With w32notify, and on emba, the `stopped' events are not sent. - (or (eq file-notify--library 'w32notify) - (getenv "EMACS_EMBA_CI") - (should-not - (file-notify-valid-p auto-revert-notify-watch-descriptor))) - - ;; Once the file has been recreated, the buffer shall be - ;; reverted. - (kill-local-variable 'before-revert-hook) - (ert-with-message-capture auto-revert--messages - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should (string-match "another text" (buffer-string))) - ;; When file notification is used, it must be reenabled - ;; after recreation of the file. We cannot expect that - ;; the descriptor is the same, so we just check the - ;; existence. - (should (eq (null desc) (null auto-revert-notify-watch-descriptor))) - - ;; An empty file shall still be reverted. - (ert-with-message-capture auto-revert--messages - (sleep-for 1) - (write-region "" nil tmpfile nil 'no-message) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should (string-equal "" (buffer-string))))) - - ;; Exit. - (ignore-errors - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf)) - (ignore-errors (delete-file tmpfile))))) + (with-auto-revert-test + (let ((tmpfile (make-temp-file "auto-revert-test")) + ;; Try to catch bug#32645. + (auto-revert-debug (getenv "EMACS_HYDRA_CI")) + (file-notify-debug (getenv "EMACS_HYDRA_CI")) + (times '(120 60 30 15)) + buf desc) + (unwind-protect + (progn + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + (setq buf (find-file-noselect tmpfile)) + (with-current-buffer buf + (should-not + (file-notify-valid-p auto-revert-notify-watch-descriptor)) + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that + ;; it returns nil. + (auto-revert-mode 1) + (should auto-revert-mode) + (setq desc auto-revert-notify-watch-descriptor) + + ;; Remove file while reverting. We simulate this by + ;; modifying `before-revert-hook'. + (add-hook + 'before-revert-hook + (lambda () + (when auto-revert-debug + (message "%s deleted" buffer-file-name)) + (delete-file buffer-file-name)) + nil t) + + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer hasn't been reverted. File + ;; notification should be disabled, falling back to + ;; polling. + (should (string-match "any text" (buffer-string))) + ;; With w32notify, and on emba, the `stopped' events are not sent. + (or (eq file-notify--library 'w32notify) + (getenv "EMACS_EMBA_CI") + (should-not + (file-notify-valid-p auto-revert-notify-watch-descriptor))) + + ;; Once the file has been recreated, the buffer shall be + ;; reverted. + (kill-local-variable 'before-revert-hook) + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should (string-match "another text" (buffer-string))) + ;; When file notification is used, it must be reenabled + ;; after recreation of the file. We cannot expect that + ;; the descriptor is the same, so we just check the + ;; existence. + (should (eq (null desc) (null auto-revert-notify-watch-descriptor))) + + ;; An empty file shall still be reverted. + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "" tmpfile (pop times)) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should (string-equal "" (buffer-string))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmpfile)))))) (auto-revert--deftest-remote auto-revert-test02-auto-revert-deleted-file "Check autorevert for a deleted remote file.") @@ -357,26 +365,24 @@ This expects `auto-revert--messages' to be bound by ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. (let ((tmpfile (make-temp-file "auto-revert-test")) + (times '(30 15)) buf) (unwind-protect (ert-with-message-capture auto-revert--messages - (write-region "any text" nil tmpfile nil 'no-message) + (auto-revert-tests--write-file "any text" tmpfile (pop times)) (setq buf (find-file-noselect tmpfile)) (with-current-buffer buf ;; `buffer-stale--default-function' checks for ;; `verify-visited-file-modtime'. We must ensure that it ;; returns nil. - (sleep-for 1) (auto-revert-tail-mode 1) (should auto-revert-tail-mode) (erase-buffer) (insert "modified text\n") (set-buffer-modified-p nil) - ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region "another text" nil tmpfile 'append 'no-message) + ;; Modify file. + (auto-revert-tests--write-file "another text" tmpfile (pop times) 'append) ;; Check, that the buffer has been reverted. (auto-revert--wait-for-revert buf) @@ -394,49 +400,47 @@ This expects `auto-revert--messages' to be bound by "Check autorevert for dired." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. - (let* ((tmpfile (make-temp-file "auto-revert-test")) - (name (file-name-nondirectory tmpfile)) - buf) - (unwind-protect - (progn - (setq buf (dired-noselect temporary-file-directory)) - (with-current-buffer buf - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that it - ;; returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) - (should - (string-match name (substring-no-properties (buffer-string)))) - - (ert-with-message-capture auto-revert--messages - ;; Delete file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (delete-file tmpfile) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should-not - (string-match name (substring-no-properties (buffer-string)))) - - (ert-with-message-capture auto-revert--messages - ;; Make dired buffer modified. Check, that the buffer has - ;; been still reverted. - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) - - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should - (string-match name (substring-no-properties (buffer-string)))))) - - ;; Exit. - (ignore-errors - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf)) - (ignore-errors (delete-file tmpfile))))) + (with-auto-revert-test + (let* ((tmpfile (make-temp-file "auto-revert-test")) + (name (file-name-nondirectory tmpfile)) + (times '(30)) + buf) + (unwind-protect + (progn + (setq buf (dired-noselect temporary-file-directory)) + (with-current-buffer buf + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that it + ;; returns nil. + (auto-revert-mode 1) + (should auto-revert-mode) + (should + (string-match name (substring-no-properties (buffer-string)))) + + (ert-with-message-capture auto-revert--messages + ;; Delete file. + (delete-file tmpfile) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should-not + (string-match name (substring-no-properties (buffer-string)))) + + (ert-with-message-capture auto-revert--messages + ;; Make dired buffer modified. Check, that the buffer has + ;; been still reverted. + (set-buffer-modified-p t) + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should + (string-match name (substring-no-properties (buffer-string)))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmpfile)))))) (auto-revert--deftest-remote auto-revert-test04-auto-revert-mode-dired "Check remote autorevert for dired.") @@ -465,117 +469,116 @@ This expects `auto-revert--messages' to be bound by (ert-deftest auto-revert-test05-global-notify () "Test `global-auto-revert-mode' without polling." - :tags '(:expensive-test) (skip-unless (or file-notify--library (file-remote-p temporary-file-directory))) - (let* ((auto-revert-use-notify t) - (auto-revert-avoid-polling t) - (was-in-global-auto-revert-mode global-auto-revert-mode) - (file-1 (make-temp-file "global-auto-revert-test-1")) - (file-2 (make-temp-file "global-auto-revert-test-2")) - (file-3 (make-temp-file "global-auto-revert-test-3")) - (file-2b (concat file-2 "-b")) - require-final-newline buf-1 buf-2 buf-3) - (unwind-protect - (progn - (setq buf-1 (find-file-noselect file-1)) - (setq buf-2 (find-file-noselect file-2)) - (auto-revert-test--write-file "1-a" file-1) - (should (equal (auto-revert-test--buffer-string buf-1) "")) - - (global-auto-revert-mode 1) ; Turn it on. - - (should (buffer-local-value - 'auto-revert-notify-watch-descriptor buf-1)) - (should (buffer-local-value - 'auto-revert-notify-watch-descriptor buf-2)) - - ;; buf-1 should have been reverted immediately when the mode - ;; was enabled. - (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) - - ;; Alter a file. - (auto-revert-test--write-file "2-a" file-2) - ;; Allow for some time to handle notification events. - (auto-revert-test--wait-for-buffer-text buf-2 "2-a" 1) - (should (equal (auto-revert-test--buffer-string buf-2) "2-a")) - - ;; Visit a file, and modify it on disk. - (setq buf-3 (find-file-noselect file-3)) - ;; Newly opened buffers won't be use notification until the - ;; first poll cycle; wait for it. - (auto-revert-test--wait-for - (lambda () (buffer-local-value - 'auto-revert-notify-watch-descriptor buf-3)) - auto-revert--timeout) - (should (buffer-local-value + (with-auto-revert-test + (let* ((auto-revert-use-notify t) + (auto-revert-avoid-polling t) + (was-in-global-auto-revert-mode global-auto-revert-mode) + (file-1 (make-temp-file "global-auto-revert-test-1")) + (file-2 (make-temp-file "global-auto-revert-test-2")) + (file-3 (make-temp-file "global-auto-revert-test-3")) + (file-2b (concat file-2 "-b")) + require-final-newline buf-1 buf-2 buf-3) + (unwind-protect + (progn + (setq buf-1 (find-file-noselect file-1)) + (setq buf-2 (find-file-noselect file-2)) + (auto-revert-test--write-file "1-a" file-1) + (should (equal (auto-revert-test--buffer-string buf-1) "")) + + (global-auto-revert-mode 1) ; Turn it on. + + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-1)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-2)) + + ;; buf-1 should have been reverted immediately when the mode + ;; was enabled. + (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) + + ;; Alter a file. + (auto-revert-test--write-file "2-a" file-2) + ;; Allow for some time to handle notification events. + (auto-revert-test--wait-for-buffer-text buf-2 "2-a" 1) + (should (equal (auto-revert-test--buffer-string buf-2) "2-a")) + + ;; Visit a file, and modify it on disk. + (setq buf-3 (find-file-noselect file-3)) + ;; Newly opened buffers won't be use notification until the + ;; first poll cycle; wait for it. + (auto-revert-test--wait-for + (lambda () (buffer-local-value 'auto-revert-notify-watch-descriptor buf-3)) - (auto-revert-test--write-file "3-a" file-3) - (auto-revert-test--wait-for-buffer-text buf-3 "3-a" 1) - (should (equal (auto-revert-test--buffer-string buf-3) "3-a")) - - ;; Delete a visited file, and re-create it with new contents. - (delete-file file-1) - (sleep-for 0.5) - (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) - (auto-revert-test--write-file "1-b" file-1) - (auto-revert-test--wait-for-buffer-text - buf-1 "1-b" auto-revert--timeout) - (should (buffer-local-value - 'auto-revert-notify-watch-descriptor buf-1)) - - ;; Write a buffer to a new file, then modify the new file on disk. - (with-current-buffer buf-2 - (write-file file-2b)) - (should (equal (auto-revert-test--buffer-string buf-2) "2-a")) - (auto-revert-test--write-file "2-b" file-2b) - (auto-revert-test--wait-for-buffer-text - buf-2 "2-b" auto-revert--timeout) - (should (buffer-local-value - 'auto-revert-notify-watch-descriptor buf-2))) - - ;; Clean up. - (unless was-in-global-auto-revert-mode - (global-auto-revert-mode 0)) ; Turn it off. - (dolist (buf (list buf-1 buf-2 buf-3)) - (ignore-errors (kill-buffer buf))) - (dolist (file (list file-1 file-2 file-2b file-3)) - (ignore-errors (delete-file file))) - ))) + (auto-revert--timeout)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-3)) + (auto-revert-test--write-file "3-a" file-3) + (auto-revert-test--wait-for-buffer-text buf-3 "3-a" 1) + (should (equal (auto-revert-test--buffer-string buf-3) "3-a")) + + ;; Delete a visited file, and re-create it with new contents. + (delete-file file-1) + (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) + (auto-revert-test--write-file "1-b" file-1) + (auto-revert-test--wait-for-buffer-text + buf-1 "1-b" (auto-revert--timeout)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-1)) + + ;; Write a buffer to a new file, then modify the new file on disk. + (with-current-buffer buf-2 + (write-file file-2b)) + (should (equal (auto-revert-test--buffer-string buf-2) "2-a")) + (auto-revert-test--write-file "2-b" file-2b) + (auto-revert-test--wait-for-buffer-text + buf-2 "2-b" (auto-revert--timeout)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-2))) + + ;; Clean up. + (unless was-in-global-auto-revert-mode + (global-auto-revert-mode 0)) ; Turn it off. + (dolist (buf (list buf-1 buf-2 buf-3)) + (ignore-errors (kill-buffer buf))) + (dolist (file (list file-1 file-2 file-2b file-3)) + (ignore-errors (delete-file file))) + )))) (auto-revert--deftest-remote auto-revert-test05-global-notify "Test `global-auto-revert-mode' without polling for remote buffers.") (ert-deftest auto-revert-test06-write-file () "Verify that notification follows `write-file' correctly." - :tags '(:expensive-test) (skip-unless (or file-notify--library (file-remote-p temporary-file-directory))) - (let* ((auto-revert-use-notify t) - (file-1 (make-temp-file "auto-revert-test")) - (file-2 (concat file-1 "-2")) - require-final-newline buf) - (unwind-protect - (progn - (setq buf (find-file-noselect file-1)) - (with-current-buffer buf - (insert "A") - (save-buffer) - - (auto-revert-mode 1) - - (insert "B") - (write-file file-2) - - (auto-revert-test--write-file "C" file-2) - (auto-revert-test--wait-for-buffer-text - buf "C" auto-revert--timeout) - (should (equal (buffer-string) "C")))) - - ;; Clean up. - (ignore-errors (kill-buffer buf)) - (ignore-errors (delete-file file-1)) - (ignore-errors (delete-file file-2))))) + (with-auto-revert-test + (let* ((auto-revert-use-notify t) + (file-1 (make-temp-file "auto-revert-test")) + (file-2 (concat file-1 "-2")) + require-final-newline buf) + (unwind-protect + (progn + (setq buf (find-file-noselect file-1)) + (with-current-buffer buf + (insert "A") + (save-buffer) + + (auto-revert-mode 1) + + (insert "B") + (write-file file-2) + + (auto-revert-test--write-file "C" file-2) + (auto-revert-test--wait-for-buffer-text + buf "C" (auto-revert--timeout)) + (should (equal (buffer-string) "C")))) + + ;; Clean up. + (ignore-errors (kill-buffer buf)) + (ignore-errors (delete-file file-1)) + (ignore-errors (delete-file file-2)))))) (auto-revert--deftest-remote auto-revert-test06-write-file "Test `write-file' in `auto-revert-mode' for remote buffers.") diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el index c5959e46d80..6745e4c1d8a 100644 --- a/test/lisp/bookmark-tests.el +++ b/test/lisp/bookmark-tests.el @@ -24,24 +24,17 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'bookmark) (require 'cl-lib) -(defvar bookmark-tests-data-dir - (file-truename - (expand-file-name "bookmark-resources/" - (file-name-directory (or load-file-name - buffer-file-name)))) - "Base directory of bookmark-tests.el data files.") - -(defvar bookmark-tests-bookmark-file - (expand-file-name "test.bmk" bookmark-tests-data-dir) +(defvar bookmark-tests-bookmark-file (ert-resource-file "test.bmk") "Bookmark file used for testing.") (defvar bookmark-tests-example-file ;; We use abbreviate-file-name here to match the behavior of ;; `bookmark-buffer-file-name'. - (abbreviate-file-name (expand-file-name "example.txt" bookmark-tests-data-dir)) + (abbreviate-file-name (ert-resource-file "example.txt")) "Example file used for testing.") ;; The values below should match `bookmark-tests-bookmark-file'. We cache @@ -83,8 +76,7 @@ the lexically-bound variable `buffer'." ,@body) (kill-buffer buffer)))) -(defvar bookmark-tests-bookmark-file-list - (expand-file-name "test-list.bmk" bookmark-tests-data-dir) +(defvar bookmark-tests-bookmark-file-list (ert-resource-file "test-list.bmk") "Bookmark file used for testing a list of bookmarks.") ;; The values below should match `bookmark-tests-bookmark-file-list' @@ -320,7 +312,7 @@ the lexically-bound variable `buffer'." (with-bookmark-test (should-error (bookmark-insert-annotation "a missing bookmark")) (bookmark-insert-annotation "name") - (should (equal (buffer-string) (bookmark-default-annotation-text "name")))) + (should (string-match "Type the annotation" (buffer-string)))) (with-bookmark-test (bookmark-set-annotation "name" "some stuff") (bookmark-insert-annotation "name") @@ -479,6 +471,8 @@ testing `bookmark-bmenu-list'." (insert "foo") (bookmark-send-edited-annotation) (should (equal (buffer-name (current-buffer)) bookmark-bmenu-buffer)) + (beginning-of-line) + (forward-char 4) (should (looking-at "name")))) (ert-deftest bookmark-test-bmenu-toggle-filenames () @@ -511,6 +505,7 @@ testing `bookmark-bmenu-list'." (ert-deftest bookmark-test-bmenu-mark () (with-bookmark-bmenu-test (bookmark-bmenu-mark) + (forward-line -1) (beginning-of-line) (should (looking-at "^>")))) @@ -571,6 +566,7 @@ testing `bookmark-bmenu-list'." (bookmark-bmenu-mark) (goto-char (point-min)) (bookmark-bmenu-unmark) + (forward-line -1) (beginning-of-line) (should (looking-at "^ ")))) diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el index 11cc14042c6..b463366c33b 100644 --- a/test/lisp/button-tests.el +++ b/test/lisp/button-tests.el @@ -21,6 +21,12 @@ (require 'ert) +(defvar button-tests--map + (let ((map (make-sparse-keymap))) + (define-key map "x" #'ignore) + map) + "Keymap for testing command substitution.") + (ert-deftest button-at () "Test `button-at' behavior." (with-temp-buffer @@ -41,11 +47,13 @@ "Test `button--help-echo' with strings." (with-temp-buffer ;; Text property buttons. - (let ((button (insert-text-button "text" 'help-echo "text help"))) - (should (equal (button--help-echo button) "text help"))) + (let ((button (insert-text-button + "text" 'help-echo "text: \\<button-tests--map>\\[ignore]"))) + (should (equal (button--help-echo button) "text: x"))) ;; Overlay buttons. - (let ((button (insert-button "overlay" 'help-echo "overlay help"))) - (should (equal (button--help-echo button) "overlay help"))))) + (let ((button (insert-button "overlay" 'help-echo + "overlay: \\<button-tests--map>\\[ignore]"))) + (should (equal (button--help-echo button) "overlay: x"))))) (ert-deftest button--help-echo-form () "Test `button--help-echo' with forms." @@ -55,16 +63,17 @@ (form `(funcall (let ((,help "lexical form")) (lambda () ,help)))) (button (insert-text-button "text" 'help-echo form))) - (set help "dynamic form") - (should (equal (button--help-echo button) "dynamic form"))) + (set help "dynamic: \\<button-tests--map>\\[ignore]") + (should (equal (button--help-echo button) "dynamic: x"))) ;; Test overlay buttons with lexical scoping. (setq lexical-binding t) (let* ((help (make-symbol "help")) - (form `(funcall (let ((,help "lexical form")) - (lambda () ,help)))) + (form `(funcall + (let ((,help "lexical: \\<button-tests--map>\\[ignore]")) + (lambda () ,help)))) (button (insert-button "overlay" 'help-echo form))) (set help "dynamic form") - (should (equal (button--help-echo button) "lexical form"))))) + (should (equal (button--help-echo button) "lexical: x"))))) (ert-deftest button--help-echo-function () "Test `button--help-echo' with functions." @@ -77,9 +86,9 @@ (should (eq win owin)) (should (eq obj obuf)) (should (= pos opos)) - "text function")) + "text: \\<button-tests--map>\\[ignore]")) (button (insert-text-button "text" 'help-echo help))) - (should (equal (button--help-echo button) "text function")) + (should (equal (button--help-echo button) "text: x")) ;; Overlay buttons. (setq help (lambda (win obj pos) (should (eq win owin)) @@ -88,9 +97,9 @@ (should (eq (overlay-buffer obj) obuf)) (should (= (overlay-start obj) opos)) (should (= pos opos)) - "overlay function")) + "overlay: \\<button-tests--map>\\[ignore]")) (setq opos (point)) (setq button (insert-button "overlay" 'help-echo help)) - (should (equal (button--help-echo button) "overlay function"))))) + (should (equal (button--help-echo button) "overlay: x"))))) ;;; button-tests.el ends here diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index c8cb97a8bca..b59f4dc988f 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -63,29 +63,26 @@ An existing calc stack is reused, otherwise a new one is created." (calc-top-n 1)) (calc-pop 0))) -;; (ert-deftest test-math-bignum () -;; ;; bug#17556 -;; (let ((n (math-bignum most-negative-fixnum))) -;; (should (math-negp n)) -;; (should (cl-notany #'cl-minusp (cdr n))))) - -(ert-deftest test-calc-remove-units () +(ert-deftest calc-remove-units () (should (calc-tests-equal (calc-tests-simple #'calc-remove-units "-1 m") -1))) -(ert-deftest test-calc-extract-units () - (should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m") - '(var m var-m))) - (should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m*cm") - '(* (float 1 -2) (^ (var m var-m) 2))))) - -(ert-deftest test-calc-convert-units () - ;; Used to ask for `(The expression is unitless when simplified) Old Units: '. - (should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" nil "cm") - '(* -100 (var cm var-cm)))) - ;; Gave wrong result. - (should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" - (math-read-expr "1m") "cm") - '(* -100 (var cm var-cm))))) +(ert-deftest calc-extract-units () + (let ((calc-display-working-message nil)) + (should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m") + '(var m var-m))) + (should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m*cm") + '(* (float 1 -2) (^ (var m var-m) 2)))))) + +(ert-deftest calc-convert-units () + (let ((calc-display-working-message nil)) + ;; Used to ask `(The expression is unitless when simplified) Old Units: '. + (should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" + nil "cm") + '(* -100 (var cm var-cm)))) + ;; Gave wrong result. + (should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" + (math-read-expr "1m") "cm") + '(* -100 (var cm var-cm)))))) (ert-deftest calc-imaginary-i () "Test `math-imaginary-i' for non-special-const values." @@ -94,7 +91,7 @@ An existing calc stack is reused, otherwise a new one is created." (let ((var-i (calcFunc-sqrt -1))) (should (math-imaginary-i)))) -(ert-deftest test-calc-23889 () +(ert-deftest calc-bug-23889 () "Test for https://debbugs.gnu.org/23889 and 25652." (skip-unless t) ;; (>= math-bignum-digit-length 9)) (dolist (mode '(deg rad)) @@ -139,7 +136,7 @@ An existing calc stack is reused, otherwise a new one is created." (nth 1 (calcFunc-cos 1))) 0 4)))))) -(ert-deftest calc-test-trig () +(ert-deftest calc-trig () "Trigonometric simplification; bug#33052." (let ((calc-angle-mode 'rad)) (let ((calc-symbolic-mode t)) @@ -169,7 +166,7 @@ An existing calc stack is reused, otherwise a new one is created." (should (equal (math-simplify '(calcFunc-cot (/ (var pi var-pi) 3))) '(calcFunc-cot (/ (var pi var-pi) 3))))))) -(ert-deftest calc-test-format-radix () +(ert-deftest calc-format-radix () "Test integer formatting (bug#36689)." (let ((calc-group-digits nil)) (let ((calc-number-radix 10)) @@ -194,7 +191,7 @@ An existing calc stack is reused, otherwise a new one is created." (let ((calc-number-radix 36)) (should (equal (math-format-number 12345678901) "36#5,O6A,QT1"))))) -(ert-deftest calc-test-calendar () +(ert-deftest calc-calendar () "Test calendar conversions (bug#36822)." (should (equal (calcFunc-julian (math-parse-date "2019-07-27")) 2458692)) (should (equal (math-parse-date "2019-07-27") '(date 737267))) @@ -216,7 +213,7 @@ An existing calc stack is reused, otherwise a new one is created." (should (equal (math-absolute-from-julian-dt -101 3 1) -36832)) (should (equal (math-absolute-from-julian-dt -4713 1 1) -1721425))) -(ert-deftest calc-test-solve-linear-system () +(ert-deftest calc-solve-linear-system () "Test linear system solving (bug#35374)." ;; x + y = 3 ;; 2x - 3y = -4 @@ -346,27 +343,28 @@ An existing calc stack is reused, otherwise a new one is created." (should-not (Math-num-integerp nil))) (ert-deftest calc-matrix-determinant () - (should (equal (calcFunc-det '(vec (vec 3))) - 3)) - (should (equal (calcFunc-det '(vec (vec 2 3) (vec 6 7))) - -4)) - (should (equal (calcFunc-det '(vec (vec 1 2 3) (vec 4 5 7) (vec 9 6 2))) - 15)) - (should (equal (calcFunc-det '(vec (vec 0 5 7 3) - (vec 0 0 2 0) - (vec 1 2 3 4) - (vec 0 0 0 3))) - 30)) - (should (equal (calcFunc-det '(vec (vec (var a var-a)))) - '(var a var-a))) - (should (equal (calcFunc-det '(vec (vec 2 (var a var-a)) - (vec 7 (var a var-a)))) - '(* -5 (var a var-a)))) - (should (equal (calcFunc-det '(vec (vec 1 0 0 0) - (vec 0 1 0 0) - (vec 0 0 0 1) - (vec 0 0 (var a var-a) 0))) - '(neg (var a var-a))))) + (let ((calc-display-working-message nil)) + (should (equal (calcFunc-det '(vec (vec 3))) + 3)) + (should (equal (calcFunc-det '(vec (vec 2 3) (vec 6 7))) + -4)) + (should (equal (calcFunc-det '(vec (vec 1 2 3) (vec 4 5 7) (vec 9 6 2))) + 15)) + (should (equal (calcFunc-det '(vec (vec 0 5 7 3) + (vec 0 0 2 0) + (vec 1 2 3 4) + (vec 0 0 0 3))) + 30)) + (should (equal (calcFunc-det '(vec (vec (var a var-a)))) + '(var a var-a))) + (should (equal (calcFunc-det '(vec (vec 2 (var a var-a)) + (vec 7 (var a var-a)))) + '(* -5 (var a var-a)))) + (should (equal (calcFunc-det '(vec (vec 1 0 0 0) + (vec 0 1 0 0) + (vec 0 0 0 1) + (vec 0 0 (var a var-a) 0))) + '(neg (var a var-a)))))) (ert-deftest calc-gcd () (should (equal (calcFunc-gcd 3 4) 1)) @@ -397,6 +395,318 @@ An existing calc stack is reused, otherwise a new one is created." (var n var-n) -1 1)) 8))) +(defun calc-tests--fac (n) + (apply #'* (number-sequence 1 n))) + +(defun calc-tests--choose (n k) + "N choose K, reference implementation." + (cond + ((and (integerp n) (integerp k)) + (if (<= 0 n) + (if (<= 0 k n) + (/ (calc-tests--fac n) + (* (calc-tests--fac k) (calc-tests--fac (- n k)))) + 0) ; 0≤n<k + ;; n<0, n and k integers: use extension from M. J. Kronenburg + (cond + ((<= 0 k) + (* (expt -1 k) + (calc-tests--choose (+ (- n) k -1) k))) + ((<= k n) + (* (expt -1 (- n k)) + (calc-tests--choose (+ (- k) -1) (- n k)))) + (t ; n<k<0 + 0)))) + ((natnump k) + ;; Generalisation for any n, integral k≥0: use falling product + (/ (apply '* (number-sequence n (- n (1- k)) -1)) + (calc-tests--fac k))) + (t (error "case not covered")))) + +(defun calc-tests--calc-to-number (x) + "Convert a Calc object to a Lisp number." + (pcase x + ((pred numberp) x) + (`(frac ,p ,q) (/ (float p) q)) + (`(float ,m ,e) (* m (expt 10 e))) + (_ (error "calc object not converted: %S" x)))) + +(ert-deftest calc-choose () + "Test computation of binomial coefficients (bug#16999)." + (let ((calc-display-working-message nil)) + ;; Integral arguments + (dolist (n (number-sequence -6 6)) + (dolist (k (number-sequence -6 6)) + (should (equal (calcFunc-choose n k) + (calc-tests--choose n k))))) + + ;; Fractional n, natural k + (should (equal (calc-tests--calc-to-number + (calcFunc-choose '(frac 15 2) 3)) + (calc-tests--choose 7.5 3))) + + (should (equal (calc-tests--calc-to-number + (calcFunc-choose '(frac 1 2) 2)) + (calc-tests--choose 0.5 2))) + + (should (equal (calc-tests--calc-to-number + (calcFunc-choose '(frac -15 2) 3)) + (calc-tests--choose -7.5 3))))) + +(ert-deftest calc-business-days () + (cl-flet ((m (s) (math-parse-date s)) + (b+ (a b) (calcFunc-badd a b)) + (b- (a b) (calcFunc-bsub a b))) + ;; Sanity check. + (should (equal (m "2020-09-07") '(date 737675))) + + ;; Test with standard business days (Mon-Fri): + (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue + (should (equal (b+ (m "2020-09-08") 1) (m "2020-09-09"))) ; Tue->Wed + (should (equal (b+ (m "2020-09-09") 1) (m "2020-09-10"))) ; Wed->Thu + (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri + (should (equal (b+ (m "2020-09-11") 1) (m "2020-09-14"))) ; Fri->Mon + + (should (equal (b+ (m "2020-09-07") 4) (m "2020-09-11"))) ; Mon->Fri + (should (equal (b+ (m "2020-09-07") 6) (m "2020-09-15"))) ; Mon->Tue + + (should (equal (b+ (m "2020-09-12") 1) (m "2020-09-14"))) ; Sat->Mon + (should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon + + (should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu + (should (equal (b- (m "2020-09-10") 1) (m "2020-09-09"))) ; Thu->Wed + (should (equal (b- (m "2020-09-09") 1) (m "2020-09-08"))) ; Wed->Tue + (should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon + (should (equal (b- (m "2020-09-07") 1) (m "2020-09-04"))) ; Mon->Fri + + (should (equal (b- (m "2020-09-11") 4) (m "2020-09-07"))) ; Fri->Mon + (should (equal (b- (m "2020-09-15") 6) (m "2020-09-07"))) ; Tue->Mon + + (should (equal (b- (m "2020-09-12") 1) (m "2020-09-11"))) ; Sat->Fri + (should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri + + ;; Stepping fractional days + (should (equal (b+ (m "2020-09-08 21:00") '(frac 1 2)) + (m "2020-09-09 09:00"))) + (should (equal (b+ (m "2020-09-11 21:00") '(frac 1 2)) + (m "2020-09-14 09:00"))) + (should (equal (b- (m "2020-09-08 21:00") '(frac 1 2)) + (m "2020-09-08 09:00"))) + (should (equal (b- (m "2020-09-14 06:00") '(frac 1 2)) + (m "2020-09-11 18:00"))) + + ;; Test with a couple of extra days off: + (let ((var-Holidays (list 'vec + '(var sat var-sat) '(var sun var-sun) + (m "2020-09-09") (m "2020-09-11")))) + + (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue + (should (equal (b+ (m "2020-09-08") 1) (m "2020-09-10"))) ; Tue->Thu + (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-14"))) ; Thu->Mon + (should (equal (b+ (m "2020-09-14") 1) (m "2020-09-15"))) ; Mon->Tue + (should (equal (b+ (m "2020-09-15") 1) (m "2020-09-16"))) ; Tue->Wed + + (should (equal (b- (m "2020-09-16") 1) (m "2020-09-15"))) ; Wed->Tue + (should (equal (b- (m "2020-09-15") 1) (m "2020-09-14"))) ; Tue->Mon + (should (equal (b- (m "2020-09-14") 1) (m "2020-09-10"))) ; Mon->Thu + (should (equal (b- (m "2020-09-10") 1) (m "2020-09-08"))) ; Thu->Tue + (should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon + ) + + ;; Test with odd non-business weekdays (Tue, Wed, Sat): + (let ((var-Holidays '(vec (var tue var-tue) + (var wed var-wed) + (var sat var-sat)))) + (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-10"))) ; Mon->Thu + (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri + (should (equal (b+ (m "2020-09-11") 1) (m "2020-09-13"))) ; Fri->Sun + (should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon + + (should (equal (b- (m "2020-09-14") 1) (m "2020-09-13"))) ; Mon->Sun + (should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri + (should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu + (should (equal (b- (m "2020-09-10") 1) (m "2020-09-07"))) ; Thu->Mon + ) + )) + +(ert-deftest calc-unix-date () + (let* ((d-1970-01-01 (math-parse-date "1970-01-01")) + (d-2020-09-07 (math-parse-date "2020-09-07")) + (d-1991-01-09-0600 (math-parse-date "1991-01-09 06:00"))) + ;; calcFunc-unixtime (command "t U") converts a date value to Unix time, + ;; and a number to a date. + (should (equal d-1970-01-01 '(date 719163))) + (should (equal (calcFunc-unixtime d-1970-01-01 0) 0)) + (should (equal (calc-tests--calc-to-number (cadr (calcFunc-unixtime 0 0))) + (cadr d-1970-01-01))) + (should (equal (calcFunc-unixtime d-2020-09-07 0) + (* (- (cadr d-2020-09-07) + (cadr d-1970-01-01)) + 86400))) + (should (equal (calcFunc-unixtime d-1991-01-09-0600 0) + 663400800)) + (should (equal (calc-tests--calc-to-number + (cadr (calcFunc-unixtime 663400800 0))) + 726841.25)) + + (let ((calc-date-format '(U))) + ;; Test parsing Unix time. + (should (equal (calc-tests--calc-to-number + (cadr (math-parse-date "0"))) + 719163)) + (should (equal (calc-tests--calc-to-number + (cadr (math-parse-date "469324800"))) + (+ 719163 (/ 469324800 86400)))) + (should (equal (calc-tests--calc-to-number + (cadr (math-parse-date "663400800"))) + 726841.25)) + + ;; Test formatting Unix time. + (should (equal (math-format-date d-1970-01-01) "0")) + (should (equal (math-format-date d-2020-09-07) + (number-to-string (* (- (cadr d-2020-09-07) + (cadr d-1970-01-01)) + 86400)))) + (should (equal (math-format-date d-1991-01-09-0600) "663400800"))))) + +;; Reference implementations of bit operations: + +(defun calc-tests--clip (x w) + "Clip X to W bits, signed if W is negative, otherwise unsigned." + (cond ((zerop w) x) + ((> w 0) (logand x (- (ash 1 w) 1))) + (t (let ((y (calc-tests--clip x (- w))) + (msb (ash 1 (- (- w) 1)))) + (- y (ash (logand y msb) 1)))))) + +(defun calc-tests--not (x w) + "Bitwise complement of X, word size W." + (calc-tests--clip (lognot x) w)) + +(defun calc-tests--and (x y w) + "Bitwise AND of X and W, word size W." + (calc-tests--clip (logand x y) w)) + +(defun calc-tests--or (x y w) + "Bitwise OR of X and Y, word size W." + (calc-tests--clip (logior x y) w)) + +(defun calc-tests--xor (x y w) + "Bitwise XOR of X and Y, word size W." + (calc-tests--clip (logxor x y) w)) + +(defun calc-tests--diff (x y w) + "Bitwise AND of X and NOT Y, word size W." + (calc-tests--clip (logand x (lognot y)) w)) + +(defun calc-tests--lsh (x n w) + "Logical shift left X by N steps, word size W." + (if (< n 0) + (calc-tests--rsh x (- n) w) + (calc-tests--clip (ash x n) w))) + +(defun calc-tests--rsh (x n w) + "Logical shift right X by N steps, word size W." + (if (< n 0) + (calc-tests--lsh x (- n) w) + ;; First zero-extend, then shift. + (calc-tests--clip + (ash (calc-tests--clip x (abs w)) (- n)) + w))) + +(defun calc-tests--ash (x n w) + "Arithmetic shift left X by N steps, word size W." + (if (< n 0) + (calc-tests--rash x (- n) w) + (calc-tests--clip (ash x n) w))) + +(defun calc-tests--rash (x n w) + "Arithmetic shift right X by N steps, word size W." + (if (< n 0) + (calc-tests--ash x (- n) w) + ;; First sign-extend, then shift. + (calc-tests--clip + (ash (calc-tests--clip x (- (abs w))) (- n)) + w))) + +(defun calc-tests--rot (x n w) + "Rotate X left by N steps, word size W." + (when (zerop w) + (error "Undefined")) + (let* ((aw (abs w)) + (y (calc-tests--clip x aw)) + (steps (mod n aw))) + (calc-tests--clip (logior (ash y steps) (ash y (- steps aw))) + w))) + +(ert-deftest calc-shift-binary () + (dolist (w '(16 32 -16 -32 0)) + (dolist (x '(0 1 #x1234 #x8000 #xabcd #xffff + #x12345678 #xabcdef12 #x80000000 #xffffffff + #x1234567890ab #x1234967890ab + -1 -14 #x-8000 #x-ffff #x-8001 #x-10000 + #x-80000000 #x-ffffffff #x-80000001 #x-100000000)) + (dolist (n '(0 1 4 16 32 -1 -4 -16 -32)) + (should (equal (calcFunc-lsh x n w) + (calc-tests--lsh x n w))) + (should (equal (calcFunc-rsh x n w) + (calc-tests--rsh x n w))) + (should (equal (calcFunc-ash x n w) + (calc-tests--ash x n w))) + (should (equal (calcFunc-rash x n w) + (calc-tests--rash x n w))) + (unless (zerop w) + (should (equal (calcFunc-rot x n w) + (calc-tests--rot x n w))))))) + (should-error (calcFunc-rot 1 1 0))) + +(ert-deftest calc-bit-ops () + (dolist (w '(16 32 -16 -32 0)) + (dolist (x '(0 1 #x1234 #x8000 #xabcd #xffff + #x12345678 #xabcdef12 #x80000000 #xffffffff + #x1234567890ab #x1234967890ab + -1 -14 #x-8000 #x-ffff #x-8001 #x-10000 + #x-80000000 #x-ffffffff #x-80000001 #x-100000000)) + (should (equal (calcFunc-not x w) + (calc-tests--not x w))) + + (dolist (n '(0 1 4 16 32 -1 -4 -16 -32)) + (equal (calcFunc-clip x n) + (calc-tests--clip x n))) + + (dolist (y '(0 1 #x1234 #x8000 #xabcd #xffff + #x12345678 #xabcdef12 #x80000000 #xffffffff + #x1234567890ab #x1234967890ab + -1 -14 #x-8000 #x-ffff #x-8001 #x-10000 + #x-80000000 #x-ffffffff #x-80000001 #x-100000000)) + (should (equal (calcFunc-and x y w) + (calc-tests--and x y w))) + (should (equal (calcFunc-or x y w) + (calc-tests--or x y w))) + (should (equal (calcFunc-xor x y w) + (calc-tests--xor x y w))) + (should (equal (calcFunc-diff x y w) + (calc-tests--diff x y w))))))) + +(ert-deftest calc-latex-input () + ;; Check precedence of "/" in LaTeX input mode. + (should (equal (math-read-exprs "a+b/c*d") + '((+ (var a var-a) (/ (var b var-b) + (* (var c var-c) (var d var-d))))))) + (unwind-protect + (progn + (calc-set-language 'latex) + (should (equal (math-read-exprs "a+b/c*d") + '((+ (var a var-a) (/ (var b var-b) + (* (var c var-c) (var d var-d))))))) + (should (equal (math-read-exprs "a+b\\over c*d") + '((/ (+ (var a var-a) (var b var-b)) + (* (var c var-c) (var d var-d)))))) + (should (equal (math-read-exprs "a/b/c") + '((/ (/ (var a var-a) (var b var-b)) + (var c var-c)))))) + (calc-set-language nil))) + (provide 'calc-tests) ;;; calc-tests.el ends here diff --git a/test/lisp/calendar/icalendar-resources/import-bug-11473.diary-european b/test/lisp/calendar/icalendar-resources/import-bug-11473.diary-european new file mode 100644 index 00000000000..97348ae0498 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-11473.diary-european @@ -0,0 +1,10 @@ +&15/5/2012 15:00-15:30 Query + Desc: + Whassup? + + + Location: phone + Organizer: MAILTO:a.luser@foo.com + Status: CONFIRMED + Class: PUBLIC + UID: 040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000010000000575268034ECDB649A15349B1BF240F15 diff --git a/test/lisp/calendar/icalendar-resources/import-bug-11473.ics b/test/lisp/calendar/icalendar-resources/import-bug-11473.ics new file mode 100644 index 00000000000..bc3a6c69fb7 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-11473.ics @@ -0,0 +1,54 @@ +BEGIN:VCALENDAR +METHOD:REQUEST +PRODID:Microsoft Exchange Server 2007 +VERSION:2.0 +BEGIN:VTIMEZONE +TZID:(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna +BEGIN:STANDARD +DTSTART:16010101T030000 +TZOFFSETFROM:+0200 +TZOFFSETTO:+0100 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=10 +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:16010101T020000 +TZOFFSETFROM:+0100 +TZOFFSETTO:+0200 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=3 +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +ORGANIZER;CN="A. Luser":MAILTO:a.luser@foo.com +ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN="Luser, Oth + er":MAILTO:other.luser@foo.com +DESCRIPTION;LANGUAGE=en-US:\nWhassup?\n\n +SUMMARY;LANGUAGE=en-US:Query +DTSTART;TZID="(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna" + :20120515T150000 +DTEND;TZID="(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna":2 + 0120515T153000 +UID:040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000 + 010000000575268034ECDB649A15349B1BF240F15 +RECURRENCE-ID;TZID="(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, V + ienna":20120515T170000 +CLASS:PUBLIC +PRIORITY:5 +DTSTAMP:20120514T153645Z +TRANSP:OPAQUE +STATUS:CONFIRMED +SEQUENCE:15 +LOCATION;LANGUAGE=en-US:phone +X-MICROSOFT-CDO-APPT-SEQUENCE:15 +X-MICROSOFT-CDO-OWNERAPPTID:1907632092 +X-MICROSOFT-CDO-BUSYSTATUS:TENTATIVE +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +X-MICROSOFT-CDO-ALLDAYEVENT:FALSE +X-MICROSOFT-CDO-IMPORTANCE:1 +X-MICROSOFT-CDO-INSTTYPE:3 +BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:REMINDER +TRIGGER;RELATED=START:-PT15M +END:VALARM +END:VEVENT +END:VCALENDAR
\ No newline at end of file diff --git a/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-american b/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-american new file mode 100644 index 00000000000..392345fe0a2 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-american @@ -0,0 +1,6 @@ +&12/8/2014 18:30-22:55 Norwegian til Tromsoe-Langnes - + Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 + Location: Stavanger-Sola + Organizer: noreply@norwegian.no + Class: PUBLIC + UID: RFCALITEM1 diff --git a/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-european b/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-european new file mode 100644 index 00000000000..6a64cf6a8e9 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-european @@ -0,0 +1,6 @@ +&8/12/2014 18:30-22:55 Norwegian til Tromsoe-Langnes - + Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 + Location: Stavanger-Sola + Organizer: noreply@norwegian.no + Class: PUBLIC + UID: RFCALITEM1 diff --git a/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-iso b/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-iso new file mode 100644 index 00000000000..e0fadbf94dc --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-22092.diary-iso @@ -0,0 +1,6 @@ +&2014/12/8 18:30-22:55 Norwegian til Tromsoe-Langnes - + Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 + Location: Stavanger-Sola + Organizer: noreply@norwegian.no + Class: PUBLIC + UID: RFCALITEM1 diff --git a/test/lisp/calendar/icalendar-resources/import-bug-22092.ics b/test/lisp/calendar/icalendar-resources/import-bug-22092.ics new file mode 100644 index 00000000000..4a4c679da9c --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-22092.ics @@ -0,0 +1,30 @@ +BEGIN:VCALENDAR
+PRODID:-//www.norwegian.no//iCalendar MIMEDIR//EN
+VERSION:2.0
+METHOD:REQUEST
+BEGIN:VEVENT
+UID:RFCALITEM1
+SEQUENCE:1512040950
+DTSTAMP:20141204T095043Z
+ORGANIZER:noreply@norwegian.no
+DTSTART:20141208T173000Z
+ +DTEND:20141208T215500Z
+ +LOCATION:Stavanger-Sola
+ +DESCRIPTION:Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390
+ +X-ALT-DESC;FMTTYPE=text/html:<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"><html><head><META NAME="Generator" CONTENT="MS Exchange Server version 08.00.0681.000"><title></title></head><body><b><font face="Calibri" size="3">Reisereferanse</p></body></html> +SUMMARY:Norwegian til Tromsoe-Langnes -
+ +CATEGORIES:Appointment
+ + +PRIORITY:5
+ +CLASS:PUBLIC
+ +TRANSP:OPAQUE
+END:VEVENT
+END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-american b/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-american new file mode 100644 index 00000000000..b3308f1fcfa --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-american @@ -0,0 +1,5 @@ +&%%(and (not (diary-date 1 6 2016)) (not (diary-date 2 3 2016)) (not (diary-date 3 2 2016)) (not (diary-date 5 4 2016)) (not (diary-date 6 1 2016)) (diary-float t 3 1) (diary-block 12 2 2015 1 1 9999)) 12:46-16:00 Summary + Desc: Desc + Location: Loc + Class: DEFAULT + UID: 9188710a-08a7-4061-bae3-d4cf4972599a diff --git a/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-european b/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-european new file mode 100644 index 00000000000..acba714b527 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-european @@ -0,0 +1,5 @@ +&%%(and (not (diary-date 6 1 2016)) (not (diary-date 3 2 2016)) (not (diary-date 2 3 2016)) (not (diary-date 4 5 2016)) (not (diary-date 1 6 2016)) (diary-float t 3 1) (diary-block 2 12 2015 1 1 9999)) 12:46-16:00 Summary + Desc: Desc + Location: Loc + Class: DEFAULT + UID: 9188710a-08a7-4061-bae3-d4cf4972599a diff --git a/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-iso b/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-iso new file mode 100644 index 00000000000..2c18395dea8 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-24199.diary-iso @@ -0,0 +1,5 @@ +&%%(and (not (diary-date 2016 1 6)) (not (diary-date 2016 2 3)) (not (diary-date 2016 3 2)) (not (diary-date 2016 5 4)) (not (diary-date 2016 6 1)) (diary-float t 3 1) (diary-block 2015 12 2 9999 1 1)) 12:46-16:00 Summary + Desc: Desc + Location: Loc + Class: DEFAULT + UID: 9188710a-08a7-4061-bae3-d4cf4972599a diff --git a/test/lisp/calendar/icalendar-resources/import-bug-24199.ics b/test/lisp/calendar/icalendar-resources/import-bug-24199.ics new file mode 100644 index 00000000000..a307c2da3ca --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-24199.ics @@ -0,0 +1,25 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:Summary +DESCRIPTION:Desc +LOCATION:Loc +DTSTART:20151202T124600 +DTEND:20151202T160000 +RRULE:FREQ=MONTHLY;BYDAY=1WE;INTERVAL=1 +EXDATE:20160106T114600Z +EXDATE:20160203T114600Z +EXDATE:20160302T114600Z +EXDATE:20160504T104600Z +EXDATE:20160601T104600Z +CLASS:DEFAULT +TRANSP:OPAQUE +BEGIN:VALARM +ACTION:DISPLAY +TRIGGER;VALUE=DURATION:-PT3H +END:VALARM +LAST-MODIFIED:20160805T191040Z +UID:9188710a-08a7-4061-bae3-d4cf4972599a +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-american b/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-american new file mode 100644 index 00000000000..c546fa9a97c --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-american @@ -0,0 +1 @@ +&11/5/2018 21:00 event with same start/end time diff --git a/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-european b/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-european new file mode 100644 index 00000000000..28e53960536 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-european @@ -0,0 +1 @@ +&5/11/2018 21:00 event with same start/end time diff --git a/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-iso b/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-iso new file mode 100644 index 00000000000..faa7aeafeb5 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-33277.diary-iso @@ -0,0 +1 @@ +&2018/11/5 21:00 event with same start/end time diff --git a/test/lisp/calendar/icalendar-resources/import-bug-33277.ics b/test/lisp/calendar/icalendar-resources/import-bug-33277.ics new file mode 100644 index 00000000000..a4122a28007 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-33277.ics @@ -0,0 +1,15 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +DTSTART:20181105T200000Z +DTSTAMP:20181105T181652Z +DESCRIPTION: +LAST-MODIFIED:20181105T181646Z +LOCATION: +SEQUENCE:0 +SUMMARY:event with same start/end time +TRANSP:OPAQUE +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-american b/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-american new file mode 100644 index 00000000000..30deea9911a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-american @@ -0,0 +1,7 @@ +&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 4 21 2010)) 11:30-12:00 Scrum + Status: CONFIRMED + Class: PUBLIC + UID: 8814e3f9-7482-408f-996c-3bfe486a1262 +&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 4 22 2010)) Tues + Thurs thinking + Class: PUBLIC + UID: 8814e3f9-7482-408f-996c-3bfe486a1263 diff --git a/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-european b/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-european new file mode 100644 index 00000000000..ba16c02305a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-european @@ -0,0 +1,7 @@ +&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 21 4 2010)) 11:30-12:00 Scrum + Status: CONFIRMED + Class: PUBLIC + UID: 8814e3f9-7482-408f-996c-3bfe486a1262 +&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 22 4 2010)) Tues + Thurs thinking + Class: PUBLIC + UID: 8814e3f9-7482-408f-996c-3bfe486a1263 diff --git a/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-iso b/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-iso new file mode 100644 index 00000000000..7794e586f37 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-6766.diary-iso @@ -0,0 +1,7 @@ +&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 2010 4 21)) 11:30-12:00 Scrum + Status: CONFIRMED + Class: PUBLIC + UID: 8814e3f9-7482-408f-996c-3bfe486a1262 +&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 2010 4 22)) Tues + Thurs thinking + Class: PUBLIC + UID: 8814e3f9-7482-408f-996c-3bfe486a1263 diff --git a/test/lisp/calendar/icalendar-resources/import-bug-6766.ics b/test/lisp/calendar/icalendar-resources/import-bug-6766.ics new file mode 100644 index 00000000000..451391be025 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-bug-6766.ics @@ -0,0 +1,28 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +CLASS:PUBLIC +DTEND;TZID=America/New_York:20100421T120000 +DTSTAMP:20100525T141214Z +DTSTART;TZID=America/New_York:20100421T113000 +RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO,WE,TH,FR +SEQUENCE:1 +STATUS:CONFIRMED +SUMMARY:Scrum +TRANSP:OPAQUE +UID:8814e3f9-7482-408f-996c-3bfe486a1262 +END:VEVENT +BEGIN:VEVENT +CLASS:PUBLIC +DTSTAMP:20100525T141214Z +DTSTART;VALUE=DATE:20100422 +DTEND;VALUE=DATE:20100423 +RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=TU,TH +SEQUENCE:1 +SUMMARY:Tues + Thurs thinking +TRANSP:OPAQUE +UID:8814e3f9-7482-408f-996c-3bfe486a1263 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-duration-2.diary-american b/test/lisp/calendar/icalendar-resources/import-duration-2.diary-american new file mode 100644 index 00000000000..56f41d6ad9e --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration-2.diary-american @@ -0,0 +1,3 @@ +&%%(and (diary-cyclic 1 12 21 2001) (diary-block 12 21 2001 12 29 2001)) Urlaub + Class: PUBLIC + UID: 20041127T183329Z-18215-1001-4536-49109@andromeda diff --git a/test/lisp/calendar/icalendar-resources/import-duration-2.diary-european b/test/lisp/calendar/icalendar-resources/import-duration-2.diary-european new file mode 100644 index 00000000000..999102ab6b4 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration-2.diary-european @@ -0,0 +1,3 @@ +&%%(and (diary-cyclic 1 21 12 2001) (diary-block 21 12 2001 29 12 2001)) Urlaub + Class: PUBLIC + UID: 20041127T183329Z-18215-1001-4536-49109@andromeda diff --git a/test/lisp/calendar/icalendar-resources/import-duration-2.diary-iso b/test/lisp/calendar/icalendar-resources/import-duration-2.diary-iso new file mode 100644 index 00000000000..393937e6cd9 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration-2.diary-iso @@ -0,0 +1,3 @@ +&%%(and (diary-cyclic 1 2001 12 21) (diary-block 2001 12 21 2001 12 29)) Urlaub + Class: PUBLIC + UID: 20041127T183329Z-18215-1001-4536-49109@andromeda diff --git a/test/lisp/calendar/icalendar-resources/import-duration-2.ics b/test/lisp/calendar/icalendar-resources/import-duration-2.ics new file mode 100644 index 00000000000..eb8a03ba36f --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration-2.ics @@ -0,0 +1,17 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +UID:20041127T183329Z-18215-1001-4536-49109@andromeda +DTSTAMP:20041127T183315Z +LAST-MODIFIED:20041127T183329 +SUMMARY:Urlaub +DTSTART;VALUE=DATE:20011221 +DTEND;VALUE=DATE:20011221 +RRULE:FREQ=DAILY;UNTIL=20011229;INTERVAL=1;WKST=SU +CLASS:PUBLIC +SEQUENCE:1 +CREATED:20041127T183329 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-duration.diary-american b/test/lisp/calendar/icalendar-resources/import-duration.diary-american new file mode 100644 index 00000000000..268736a8cd0 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration.diary-american @@ -0,0 +1 @@ +&%%(and (diary-block 2 17 2005 2 23 2005)) duration diff --git a/test/lisp/calendar/icalendar-resources/import-duration.diary-european b/test/lisp/calendar/icalendar-resources/import-duration.diary-european new file mode 100644 index 00000000000..7d852ddcd3c --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration.diary-european @@ -0,0 +1 @@ +&%%(and (diary-block 17 2 2005 23 2 2005)) duration diff --git a/test/lisp/calendar/icalendar-resources/import-duration.diary-iso b/test/lisp/calendar/icalendar-resources/import-duration.diary-iso new file mode 100644 index 00000000000..5d3a714284e --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-block 2005 2 17 2005 2 23)) duration diff --git a/test/lisp/calendar/icalendar-resources/import-duration.ics b/test/lisp/calendar/icalendar-resources/import-duration.ics new file mode 100644 index 00000000000..67f5c73571b --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-duration.ics @@ -0,0 +1,10 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +DTSTART;VALUE=DATE:20050217 +SUMMARY:duration +DURATION:P7D +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-american b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-american new file mode 100644 index 00000000000..d1b1992a022 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-american @@ -0,0 +1,4 @@ +&7/23/2011 event-1 +&7/24/2011 event-2 +&7/25/2011 event-3a +&7/25/2011 event-3b diff --git a/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-european b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-european new file mode 100644 index 00000000000..f068354220c --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-european @@ -0,0 +1,4 @@ +&23/7/2011 event-1 +&24/7/2011 event-2 +&25/7/2011 event-3a +&25/7/2011 event-3b diff --git a/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-iso b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-iso new file mode 100644 index 00000000000..5685e4708a7 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.diary-iso @@ -0,0 +1,4 @@ +&2011/7/23 event-1 +&2011/7/24 event-2 +&2011/7/25 event-3a +&2011/7/25 event-3b diff --git a/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.ics b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.ics new file mode 100644 index 00000000000..69a02c09b1b --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-multiple-vcalendars.ics @@ -0,0 +1,21 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +DTSTART;VALUE=DATE:20110723 +SUMMARY:event-1 +END:VEVENT +BEGIN:VEVENT +DTSTART;VALUE=DATE:20110724 +SUMMARY:event-2 +END:VEVENT +BEGIN:VEVENT +DTSTART;VALUE=DATE:20110725 +SUMMARY:event-3a +END:VEVENT +BEGIN:VEVENT +DTSTART;VALUE=DATE:20110725 +SUMMARY:event-3b +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-american b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-american new file mode 100644 index 00000000000..780e3a8ce64 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-american @@ -0,0 +1 @@ +&9/19/2003 09:00-11:30 non-recurring diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-european b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-european new file mode 100644 index 00000000000..7e0cd21b784 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-european @@ -0,0 +1 @@ +&19/9/2003 09:00-11:30 non-recurring diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-iso b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-iso new file mode 100644 index 00000000000..c7311286619 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.diary-iso @@ -0,0 +1 @@ +&2003/9/19 09:00-11:30 non-recurring diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-1.ics b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.ics new file mode 100644 index 00000000000..cd471efc861 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-1.ics @@ -0,0 +1,10 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:non-recurring +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-american b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-american new file mode 100644 index 00000000000..1d4bb6a337e --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-american @@ -0,0 +1 @@ +&9/19/2003 non-recurring allday diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-european b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-european new file mode 100644 index 00000000000..b56c7f4e17f --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-european @@ -0,0 +1 @@ +&19/9/2003 non-recurring allday diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-iso b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-iso new file mode 100644 index 00000000000..f1c70ab34c3 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.diary-iso @@ -0,0 +1 @@ +&2003/9/19 non-recurring allday diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.ics b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.ics new file mode 100644 index 00000000000..4efa8ffa133 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-all-day.ics @@ -0,0 +1,9 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:non-recurring allday +DTSTART;VALUE=DATE-TIME:20030919 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-american b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-american new file mode 100644 index 00000000000..2eb8c0ab686 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-american @@ -0,0 +1,4 @@ +&11/23/2004 14:45-15:45 another example + Status: TENTATIVE + Class: PRIVATE + UID: 6161a312-3902-11d9-b512-f764153bb28b diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-european b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-european new file mode 100644 index 00000000000..394eae8bb77 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-european @@ -0,0 +1,4 @@ +&23/11/2004 14:45-15:45 another example + Status: TENTATIVE + Class: PRIVATE + UID: 6161a312-3902-11d9-b512-f764153bb28b diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-iso b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-iso new file mode 100644 index 00000000000..5e8bdf417d5 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.diary-iso @@ -0,0 +1,4 @@ +&2004/11/23 14:45-15:45 another example + Status: TENTATIVE + Class: PRIVATE + UID: 6161a312-3902-11d9-b512-f764153bb28b diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.ics b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.ics new file mode 100644 index 00000000000..b145e418791 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-another-example.ics @@ -0,0 +1,23 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +UID + :6161a312-3902-11d9-b512-f764153bb28b +SUMMARY + :another example +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +DTSTART + :20041123T144500 +DTEND + :20041123T154500 +DTSTAMP + :20041118T013641Z +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-american b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-american new file mode 100644 index 00000000000..b22234229cf --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-american @@ -0,0 +1,4 @@ +&%%(and (diary-block 7 19 2004 8 27 2004)) Sommerferien + Status: TENTATIVE + Class: PRIVATE + UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61 diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-european b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-european new file mode 100644 index 00000000000..8043482442f --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-european @@ -0,0 +1,4 @@ +&%%(and (diary-block 19 7 2004 27 8 2004)) Sommerferien + Status: TENTATIVE + Class: PRIVATE + UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61 diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-iso b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-iso new file mode 100644 index 00000000000..e0f1896114f --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.diary-iso @@ -0,0 +1,4 @@ +&%%(and (diary-block 2004 7 19 2004 8 27)) Sommerferien + Status: TENTATIVE + Class: PRIVATE + UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61 diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-block.ics b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.ics new file mode 100644 index 00000000000..0c52ba3d66a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-block.ics @@ -0,0 +1,16 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +UID:748f2da0-0d9b-11d8-97af-b4ec8686ea61 +SUMMARY:Sommerferien +STATUS:TENTATIVE +CLASS:PRIVATE +X-MOZILLA-ALARM-DEFAULT-UNITS:Minuten +X-MOZILLA-RECUR-DEFAULT-INTERVAL:0 +DTSTART;VALUE=DATE:20040719 +DTEND;VALUE=DATE:20040828 +DTSTAMP:20031103T011641Z +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-american b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-american new file mode 100644 index 00000000000..2954d0c4fd1 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-american @@ -0,0 +1,4 @@ +&11/23/2004 14:00-14:30 folded summary + Status: TENTATIVE + Class: PRIVATE + UID: 04979712-3902-11d9-93dd-8f9f4afe08da diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-european b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-european new file mode 100644 index 00000000000..7745fc811b4 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-european @@ -0,0 +1,4 @@ +&23/11/2004 14:00-14:30 folded summary + Status: TENTATIVE + Class: PRIVATE + UID: 04979712-3902-11d9-93dd-8f9f4afe08da diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-iso b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-iso new file mode 100644 index 00000000000..8c19a95ed2d --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.diary-iso @@ -0,0 +1,4 @@ +&2004/11/23 14:00-14:30 folded summary + Status: TENTATIVE + Class: PRIVATE + UID: 04979712-3902-11d9-93dd-8f9f4afe08da diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.ics b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.ics new file mode 100644 index 00000000000..e3ecee9dae8 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-folded-summary.ics @@ -0,0 +1,25 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +UID + :04979712-3902-11d9-93dd-8f9f4afe08da +SUMMARY + :folded summary +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +DTSTART + :20041123T140000 +DTEND + :20041123T143000 +DTSTAMP + :20041118T013430Z +LAST-MODIFIED + :20041118T013640Z +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-american b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-american new file mode 100644 index 00000000000..84cd464c568 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-american @@ -0,0 +1 @@ +&9/19/2003 long summary diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-european b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-european new file mode 100644 index 00000000000..5d6524202c3 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-european @@ -0,0 +1 @@ +&19/9/2003 long summary diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-iso b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-iso new file mode 100644 index 00000000000..d2300522d9a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.diary-iso @@ -0,0 +1 @@ +&2003/9/19 long summary diff --git a/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.ics b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.ics new file mode 100644 index 00000000000..39ae02f10ca --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-non-recurring-long-summary.ics @@ -0,0 +1,10 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:long + summary +DTSTART;VALUE=DATE:20030919 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.diary-american b/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.diary-american new file mode 100644 index 00000000000..e6c8712d254 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.diary-american @@ -0,0 +1,6 @@ +&5/9/2003 07:00-12:00 On-Site Interview + Desc: 10:30am - Blah + Location: Cccc + Organizer: MAILTO:aaaaaaa@aaaaaaa.com + Status: CONFIRMED + UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9 diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.diary-european b/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.diary-european new file mode 100644 index 00000000000..cecca070a51 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.diary-european @@ -0,0 +1,6 @@ +&9/5/2003 07:00-12:00 On-Site Interview + Desc: 10:30am - Blah + Location: Cccc + Organizer: MAILTO:aaaaaaa@aaaaaaa.com + Status: CONFIRMED + UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9 diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.ics b/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.ics new file mode 100644 index 00000000000..decc8df5451 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-05-29.ics @@ -0,0 +1,54 @@ +BEGIN:VCALENDAR +METHOD:REQUEST +PRODID:Microsoft CDO for Microsoft Exchange +VERSION:2.0 +BEGIN:VTIMEZONE +TZID:Kolkata, Chennai, Mumbai, New Delhi +X-MICROSOFT-CDO-TZID:23 +BEGIN:STANDARD +DTSTART:16010101T000000 +TZOFFSETFROM:+0530 +TZOFFSETTO:+0530 +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:16010101T000000 +TZOFFSETFROM:+0530 +TZOFFSETTO:+0530 +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +DTSTAMP:20030509T043439Z +DTSTART;TZID="Kolkata, Chennai, Mumbai, New Delhi":20030509T103000 +SUMMARY:On-Site Interview +UID:040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000 + 010000000DB823520692542408ED02D7023F9DFF9 +ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN="Xxxxx + xxx Xxxxxxxxxxxx":MAILTO:xxxxxxxx@xxxxxxx.com +ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN="Yyyyyyy Y + yyyy":MAILTO:yyyyyyy@yyyyyyy.com +ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN="Zzzz Zzzz + zz":MAILTO:zzzzzz@zzzzzzz.com +ORGANIZER;CN="Aaaaaa Aaaaa":MAILTO:aaaaaaa@aaaaaaa.com +LOCATION:Cccc +DTEND;TZID="Kolkata, Chennai, Mumbai, New Delhi":20030509T153000 +DESCRIPTION:10:30am - Blah +SEQUENCE:0 +PRIORITY:5 +CLASS: +CREATED:20030509T043439Z +LAST-MODIFIED:20030509T043459Z +STATUS:CONFIRMED +TRANSP:OPAQUE +X-MICROSOFT-CDO-BUSYSTATUS:BUSY +X-MICROSOFT-CDO-INSTTYPE:0 +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +X-MICROSOFT-CDO-ALLDAYEVENT:FALSE +X-MICROSOFT-CDO-IMPORTANCE:1 +X-MICROSOFT-CDO-OWNERAPPTID:126441427 +BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:REMINDER +TRIGGER;RELATED=START:-PT00H15M00S +END:VALARM +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.diary-american b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.diary-american new file mode 100644 index 00000000000..f2c914184e7 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.diary-american @@ -0,0 +1,6 @@ +&6/23/2003 11:00-12:00 Dress Rehearsal for XXXX-XXXX + Desc: 753 Zeichen hier radiert + Location: 555 or TN 555-5555 ID 5555 & NochWas (see below) + Organizer: MAILTO:xxx@xxxxx.com + Status: CONFIRMED + UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.diary-european b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.diary-european new file mode 100644 index 00000000000..89cff58af42 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.diary-european @@ -0,0 +1,6 @@ +&23/6/2003 11:00-12:00 Dress Rehearsal for XXXX-XXXX + Desc: 753 Zeichen hier radiert + Location: 555 or TN 555-5555 ID 5555 & NochWas (see below) + Organizer: MAILTO:xxx@xxxxx.com + Status: CONFIRMED + UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.ics b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.ics new file mode 100644 index 00000000000..6bb5b05af17 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18a.ics @@ -0,0 +1,36 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +DTSTAMP:20030618T195512Z +DTSTART;TZID="Mountain Time (US & Canada)":20030623T110000 +SUMMARY:Dress Rehearsal for XXXX-XXXX +UID:040000008200E00074C5B7101A82E00800000000608AA7DA9835C301000000000000000 + 0100000007C3A6D65EE726E40B7F3D69A23BD567E +ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN="AAAAA,AAA + AA (A-AAAAAAA,ex1)":MAILTO:aaaaa_aaaaa@aaaaa.com +ORGANIZER;CN="ABCD,TECHTRAINING + (A-Americas,exgen1)":MAILTO:xxx@xxxxx.com +LOCATION:555 or TN 555-5555 ID 5555 & NochWas (see below) +DTEND;TZID="Mountain Time (US & Canada)":20030623T120000 +DESCRIPTION:753 Zeichen hier radiert +SEQUENCE:0 +PRIORITY:5 +CLASS: +CREATED:20030618T195518Z +LAST-MODIFIED:20030618T195527Z +STATUS:CONFIRMED +TRANSP:OPAQUE +X-MICROSOFT-CDO-BUSYSTATUS:BUSY +X-MICROSOFT-CDO-INSTTYPE:0 +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +X-MICROSOFT-CDO-ALLDAYEVENT:FALSE +X-MICROSOFT-CDO-IMPORTANCE:1 +X-MICROSOFT-CDO-OWNERAPPTID:1022519251 +BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:REMINDER +TRIGGER;RELATED=START:-PT00H15M00S +END:VALARM +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.diary-american b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.diary-american new file mode 100644 index 00000000000..2c0774cdd83 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.diary-american @@ -0,0 +1,6 @@ +&6/23/2003 17:00-18:00 Updated: Dress Rehearsal for ABC01-15 + Desc: Viele Zeichen standen hier früher + Location: 123 or TN 123-1234 ID abcd & SonstWo (see below) + Organizer: MAILTO:bbb@bbbbb.com + Status: CONFIRMED + UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.diary-european b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.diary-european new file mode 100644 index 00000000000..95aac168699 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.diary-european @@ -0,0 +1,6 @@ +&23/6/2003 17:00-18:00 Updated: Dress Rehearsal for ABC01-15 + Desc: Viele Zeichen standen hier früher + Location: 123 or TN 123-1234 ID abcd & SonstWo (see below) + Organizer: MAILTO:bbb@bbbbb.com + Status: CONFIRMED + UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.ics b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.ics new file mode 100644 index 00000000000..1523135adf3 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2003-06-18b.ics @@ -0,0 +1,55 @@ +BEGIN:VCALENDAR +METHOD:REQUEST +PRODID:Microsoft CDO for Microsoft Exchange +VERSION:2.0 +BEGIN:VTIMEZONE +TZID:Mountain Time (US & Canada) +X-MICROSOFT-CDO-TZID:12 +BEGIN:STANDARD +DTSTART:16010101T020000 +TZOFFSETFROM:-0600 +TZOFFSETTO:-0700 +RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=10;BYDAY=-1SU +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:16010101T020000 +TZOFFSETFROM:-0700 +TZOFFSETTO:-0600 +RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=4;BYDAY=1SU +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +DTSTAMP:20030618T230323Z +DTSTART;TZID="Mountain Time (US & Canada)":20030623T090000 +SUMMARY:Updated: Dress Rehearsal for ABC01-15 +UID:040000008200E00074C5B7101A82E00800000000608AA7DA9835C301000000000000000 + 0100000007C3A6D65EE726E40B7F3D69A23BD567E +ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;X-REPLYTIME=20030618T20 + 0700Z;RSVP=TRUE;CN="AAAAA,AAAAAA +\(A-AAAAAAA,ex1)":MAILTO:aaaaaa_aaaaa@aaaaa + .com +ORGANIZER;CN="ABCD,TECHTRAINING +\(A-Americas,exgen1)":MAILTO:bbb@bbbbb.com +LOCATION:123 or TN 123-1234 ID abcd & SonstWo (see below) +DTEND;TZID="Mountain Time (US & Canada)":20030623T100000 +DESCRIPTION:Viele Zeichen standen hier früher +SEQUENCE:0 +PRIORITY:5 +CLASS: +CREATED:20030618T230326Z +LAST-MODIFIED:20030618T230335Z +STATUS:CONFIRMED +TRANSP:OPAQUE +X-MICROSOFT-CDO-BUSYSTATUS:BUSY +X-MICROSOFT-CDO-INSTTYPE:0 +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +X-MICROSOFT-CDO-ALLDAYEVENT:FALSE +X-MICROSOFT-CDO-IMPORTANCE:1 +X-MICROSOFT-CDO-OWNERAPPTID:1022519251 +BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:REMINDER +TRIGGER;RELATED=START:-PT00H15M00S +END:VALARM +END:VEVENT +END:VCALENDAR
\ No newline at end of file diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.diary-american b/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.diary-american new file mode 100644 index 00000000000..a986f700ba2 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.diary-american @@ -0,0 +1,19 @@ +&11/23/2004 14:00-14:30 Jjjjj & Wwwww + Status: TENTATIVE + Class: PRIVATE +&11/23/2004 14:45-15:45 BB Aaaaaaaa Bbbbb + Status: TENTATIVE + Class: PRIVATE +&11/23/2004 11:00-12:00 Hhhhhhhh + Status: TENTATIVE + Class: PRIVATE +&%%(and (diary-cyclic 14 11 12 2004)) 14:00-18:30 MMM Aaaaaaaaa + Status: TENTATIVE + Class: PRIVATE +&%%(and (diary-block 11 19 2004 11 19 2004)) Rrrr/Cccccc ii Aaaaaaaa + Desc: Vvvvv Rrrr aaa Cccccc + Status: TENTATIVE + Class: PRIVATE +&%%(and (diary-cyclic 7 11 1 2004)) Wwww aa hhhh + Status: TENTATIVE + Class: PRIVATE diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.diary-european b/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.diary-european new file mode 100644 index 00000000000..cbfe99eb8e3 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.diary-european @@ -0,0 +1,19 @@ +&23/11/2004 14:00-14:30 Jjjjj & Wwwww + Status: TENTATIVE + Class: PRIVATE +&23/11/2004 14:45-15:45 BB Aaaaaaaa Bbbbb + Status: TENTATIVE + Class: PRIVATE +&23/11/2004 11:00-12:00 Hhhhhhhh + Status: TENTATIVE + Class: PRIVATE +&%%(and (diary-cyclic 14 12 11 2004)) 14:00-18:30 MMM Aaaaaaaaa + Status: TENTATIVE + Class: PRIVATE +&%%(and (diary-block 19 11 2004 19 11 2004)) Rrrr/Cccccc ii Aaaaaaaa + Desc: Vvvvv Rrrr aaa Cccccc + Status: TENTATIVE + Class: PRIVATE +&%%(and (diary-cyclic 7 1 11 2004)) Wwww aa hhhh + Status: TENTATIVE + Class: PRIVATE diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.ics b/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.ics new file mode 100644 index 00000000000..9edb682fcad --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2004-11-19.ics @@ -0,0 +1,120 @@ +BEGIN:VCALENDAR +VERSION + :2.0 +PRODID + :-//Mozilla.org/NONSGML Mozilla Calendar V1.0//EN +BEGIN:VEVENT +SUMMARY + :Jjjjj & Wwwww +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +DTSTART + :20041123T140000 +DTEND + :20041123T143000 +DTSTAMP + :20041118T013430Z +LAST-MODIFIED + :20041118T013640Z +END:VEVENT +BEGIN:VEVENT +SUMMARY + :BB Aaaaaaaa Bbbbb +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +DTSTART + :20041123T144500 +DTEND + :20041123T154500 +DTSTAMP + :20041118T013641Z +END:VEVENT +BEGIN:VEVENT +SUMMARY + :Hhhhhhhh +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +DTSTART + :20041123T110000 +DTEND + :20041123T120000 +DTSTAMP + :20041118T013831Z +END:VEVENT +BEGIN:VEVENT +SUMMARY + :MMM Aaaaaaaaa +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +X-MOZILLA-RECUR-DEFAULT-INTERVAL + :2 +RRULE + :FREQ=WEEKLY;INTERVAL=2;BYDAY=FR +DTSTART + :20041112T140000 +DTEND + :20041112T183000 +DTSTAMP + :20041118T014117Z +END:VEVENT +BEGIN:VEVENT +SUMMARY + :Rrrr/Cccccc ii Aaaaaaaa +DESCRIPTION + :Vvvvv Rrrr aaa Cccccc +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +DTSTART + ;VALUE=DATE + :20041119 +DTEND + ;VALUE=DATE + :20041120 +DTSTAMP + :20041118T013107Z +LAST-MODIFIED + :20041118T014203Z +END:VEVENT +BEGIN:VEVENT +SUMMARY + :Wwww aa hhhh +STATUS + :TENTATIVE +CLASS + :PRIVATE +X-MOZILLA-ALARM-DEFAULT-LENGTH + :0 +RRULE + :FREQ=WEEKLY;INTERVAL=1;BYDAY=MO +DTSTART + ;VALUE=DATE + :20041101 +DTEND + ;VALUE=DATE + :20041102 +DTSTAMP + :20041118T014045Z +LAST-MODIFIED + :20041118T023846Z +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.diary-american b/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.diary-american new file mode 100644 index 00000000000..ce7d835d96b --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.diary-american @@ -0,0 +1,5 @@ +&%%(and (diary-block 2 6 2005 2 6 2005)) Waitangi Day + Desc: abcdef + Status: CONFIRMED + Class: PRIVATE + UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4 diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.diary-european b/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.diary-european new file mode 100644 index 00000000000..3a52b0ab271 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.diary-european @@ -0,0 +1,5 @@ +&%%(and (diary-block 6 2 2005 6 2 2005)) Waitangi Day + Desc: abcdef + Status: CONFIRMED + Class: PRIVATE + UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4 diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.ics b/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.ics new file mode 100644 index 00000000000..9eec71fe751 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2005-02-07.ics @@ -0,0 +1,26 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +UID + :b60d398e-1dd1-11b2-a159-cf8cb05139f4 +SUMMARY + :Waitangi Day +DESCRIPTION + :abcdef +CATEGORIES + :Public Holiday +STATUS + :CONFIRMED +CLASS + :PRIVATE +DTSTART + ;VALUE=DATE + :20050206 +DTEND + ;VALUE=DATE + :20050207 +DTSTAMP + :20050128T011209Z +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.diary-american b/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.diary-american new file mode 100644 index 00000000000..23c93d45d9a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.diary-american @@ -0,0 +1,2 @@ +&%%(and (diary-block 2 17 2005 2 23 2005)) Hhhhhh Aaaaa ii Aaaaaaaa + UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.diary-european b/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.diary-european new file mode 100644 index 00000000000..106e9f3cdd0 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.diary-european @@ -0,0 +1,2 @@ +&%%(and (diary-block 17 2 2005 23 2 2005)) Hhhhhh Aaaaa ii Aaaaaaaa + UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.ics b/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.ics new file mode 100644 index 00000000000..ed9faa9b0bd --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-2005-03-01.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +DTSTART;VALUE=DATE:20050217 +SUMMARY:Hhhhhh Aaaaa ii Aaaaaaaa +UID:6AFA7558-6994-11D9-8A3A-000A95A0E830-RID +DTSTAMP:20050118T210335Z +DURATION:P7D +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.diary-american b/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.diary-american new file mode 100644 index 00000000000..290edb88760 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.diary-american @@ -0,0 +1,4 @@ +&11/16/2014 04:30-05:30 NoDST + Desc: Test event from timezone without DST + Location: Everywhere + UID: 20141116T171439Z-678877132@marudot.com diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.diary-european b/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.diary-european new file mode 100644 index 00000000000..c56b7a6547a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.diary-european @@ -0,0 +1,4 @@ +&16/11/2014 04:30-05:30 NoDST + Desc: Test event from timezone without DST + Location: Everywhere + UID: 20141116T171439Z-678877132@marudot.com diff --git a/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.ics b/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.ics new file mode 100644 index 00000000000..5f147af4f37 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-real-world-no-dst.ics @@ -0,0 +1,26 @@ +BEGIN:VCALENDAR +VERSION:2.0 +PRODID:-//www.marudot.com//iCal Event Maker +X-WR-CALNAME:Test +CALSCALE:GREGORIAN +BEGIN:VTIMEZONE +TZID:Asia/Tehran +TZURL:http://tzurl.org/zoneinfo-outlook/Asia/Tehran +X-LIC-LOCATION:Asia/Tehran +BEGIN:STANDARD +TZOFFSETFROM:+0330 +TZOFFSETTO:+0330 +TZNAME:IRST +DTSTART:19700101T000000 +END:STANDARD +END:VTIMEZONE +BEGIN:VEVENT +DTSTAMP:20141116T171439Z +UID:20141116T171439Z-678877132@marudot.com +DTSTART;TZID="Asia/Tehran":20141116T070000 +DTEND;TZID="Asia/Tehran":20141116T080000 +SUMMARY:NoDST +DESCRIPTION:Test event from timezone without DST +LOCATION:Everywhere +END:VEVENT +END:VCALENDAR
\ No newline at end of file diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american new file mode 100644 index 00000000000..7b86b554dd4 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american @@ -0,0 +1 @@ +&%%(and (diary-anniversary 8 15 2004)) Maria Himmelfahrt diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european new file mode 100644 index 00000000000..3b82ec09fd5 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european @@ -0,0 +1 @@ +&%%(and (diary-anniversary 15 8 2004)) Maria Himmelfahrt diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso new file mode 100644 index 00000000000..7fc99478d4e --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.ics b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.ics new file mode 100644 index 00000000000..2996f494167 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +DTSTART;VALUE=DATE:20040815 +DTEND;VALUE=DATE:20040816 +SUMMARY:Maria Himmelfahrt +RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=8 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-american new file mode 100644 index 00000000000..84b6d109953 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-american @@ -0,0 +1 @@ +&%%(and (diary-cyclic 14 9 19 2003) (diary-block 9 19 2003 10 31 2003)) 09:00-11:30 rrule count bi-weekly 3 times diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-european new file mode 100644 index 00000000000..0bebdf8872f --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-european @@ -0,0 +1 @@ +&%%(and (diary-cyclic 14 19 9 2003) (diary-block 19 9 2003 31 10 2003)) 09:00-11:30 rrule count bi-weekly 3 times diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-iso new file mode 100644 index 00000000000..11429081abe --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-cyclic 14 2003 9 19) (diary-block 2003 9 19 2003 10 31)) 09:00-11:30 rrule count bi-weekly 3 times diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.ics b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.ics new file mode 100644 index 00000000000..888b85bb331 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-bi-weekly.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule count bi-weekly 3 times +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=WEEKLY;COUNT=3;INTERVAL=2 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-american new file mode 100644 index 00000000000..23fe9fcaf32 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-american @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 9 19 2003) (diary-block 9 19 2003 10 2 2003)) 09:00-11:30 rrule count daily long diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-european new file mode 100644 index 00000000000..0d4ab669058 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-european @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 19 9 2003) (diary-block 19 9 2003 2 10 2003)) 09:00-11:30 rrule count daily long diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-iso new file mode 100644 index 00000000000..8cecda5c879 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 2003 9 19) (diary-block 2003 9 19 2003 10 2)) 09:00-11:30 rrule count daily long diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.ics b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.ics new file mode 100644 index 00000000000..73df19a8196 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-long.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule count daily long +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=DAILY;COUNT=14;INTERVAL=1 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-american new file mode 100644 index 00000000000..d69bb08c318 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-american @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 9 19 2003) (diary-block 9 19 2003 9 19 2003)) 09:00-11:30 rrule count daily short diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-european new file mode 100644 index 00000000000..33a1ce4cf51 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-european @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 19 9 2003) (diary-block 19 9 2003 19 9 2003)) 09:00-11:30 rrule count daily short diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-iso new file mode 100644 index 00000000000..a06bcba0dc1 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 2003 9 19) (diary-block 2003 9 19 2003 9 19)) 09:00-11:30 rrule count daily short diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.ics b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.ics new file mode 100644 index 00000000000..92ffe8be654 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-daily-short.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule count daily short +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=DAILY;COUNT=1;INTERVAL=1 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-american new file mode 100644 index 00000000000..4ce8ef842f8 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-american @@ -0,0 +1 @@ +&%%(and (diary-date t 19 t) (diary-block 9 19 2003 5 19 2004)) 09:00-11:30 rrule count every second month diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-european new file mode 100644 index 00000000000..09ec3756295 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-european @@ -0,0 +1 @@ +&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 5 2004)) 09:00-11:30 rrule count every second month diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-iso new file mode 100644 index 00000000000..ae6feb70d4c --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-date t t 19) (diary-block 2003 9 19 2004 5 19)) 09:00-11:30 rrule count every second month diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.ics b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.ics new file mode 100644 index 00000000000..3b27b665498 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-month.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule count every second month +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=MONTHLY;INTERVAL=2;COUNT=5 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-american new file mode 100644 index 00000000000..99543aa9596 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-american @@ -0,0 +1 @@ +&%%(and (diary-date 9 19 t) (diary-block 9 19 2003 9 19 2011)) 09:00-11:30 rrule count every second year diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-european new file mode 100644 index 00000000000..3b330886ce0 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-european @@ -0,0 +1 @@ +&%%(and (diary-date 19 9 t) (diary-block 19 9 2003 19 9 2011)) 09:00-11:30 rrule count every second year diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-iso new file mode 100644 index 00000000000..16af52ea91c --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-date t 9 19) (diary-block 2003 9 19 2011 9 19)) 09:00-11:30 rrule count every second year diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.ics b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.ics new file mode 100644 index 00000000000..ce21c34d09a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-every-second-year.ics @@ -0,0 +1,10 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule count every second year +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=YEARLY;INTERVAL=2;COUNT=5 +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-american new file mode 100644 index 00000000000..ad5ca0b0ed4 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-american @@ -0,0 +1 @@ +&%%(and (diary-date t 19 t) (diary-block 9 19 2003 1 19 2004)) 09:00-11:30 rrule count monthly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-european new file mode 100644 index 00000000000..709de3a3fd5 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-european @@ -0,0 +1 @@ +&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 1 2004)) 09:00-11:30 rrule count monthly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-iso new file mode 100644 index 00000000000..9fc2a2def94 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-date t t 19) (diary-block 2003 9 19 2004 1 19)) 09:00-11:30 rrule count monthly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.ics b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.ics new file mode 100644 index 00000000000..3391ca24252 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-monthly.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule count monthly +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=MONTHLY;INTERVAL=1;COUNT=5 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-american new file mode 100644 index 00000000000..8c1f95b0c05 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-american @@ -0,0 +1 @@ +&%%(and (diary-date 9 19 t) (diary-block 9 19 2003 9 19 2007)) 09:00-11:30 rrule count yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-european new file mode 100644 index 00000000000..e216e224eae --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-european @@ -0,0 +1 @@ +&%%(and (diary-date 19 9 t) (diary-block 19 9 2003 19 9 2007)) 09:00-11:30 rrule count yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-iso new file mode 100644 index 00000000000..3801192ee60 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-date t 9 19) (diary-block 2003 9 19 2007 9 19)) 09:00-11:30 rrule count yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.ics b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.ics new file mode 100644 index 00000000000..d8569933e0c --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-count-yearly.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule count yearly +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=YEARLY;INTERVAL=1;COUNT=5 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-american new file mode 100644 index 00000000000..495fca5f8df --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-american @@ -0,0 +1 @@ +&%%(and (diary-cyclic 2 9 19 2003)) 09:00-11:30 rrule daily diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-european new file mode 100644 index 00000000000..61db14ab24a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-european @@ -0,0 +1 @@ +&%%(and (diary-cyclic 2 19 9 2003)) 09:00-11:30 rrule daily diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-iso new file mode 100644 index 00000000000..0e0a4b19781 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-cyclic 2 2003 9 19)) 09:00-11:30 rrule daily diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.ics b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.ics new file mode 100644 index 00000000000..8c9cb3b2845 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-two-day.ics @@ -0,0 +1,10 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule daily +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=DAILY;INTERVAL=2 +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-american new file mode 100644 index 00000000000..83e5f582d5f --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-american @@ -0,0 +1 @@ +&%%(and (not (diary-date 9 25 2003)) (not (diary-date 9 21 2003)) (diary-cyclic 2 9 19 2003)) 09:00-11:30 rrule daily with exceptions diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-european new file mode 100644 index 00000000000..a3c7fdd4177 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-european @@ -0,0 +1 @@ +&%%(and (not (diary-date 25 9 2003)) (not (diary-date 21 9 2003)) (diary-cyclic 2 19 9 2003)) 09:00-11:30 rrule daily with exceptions diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-iso new file mode 100644 index 00000000000..88b4c892d16 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.diary-iso @@ -0,0 +1 @@ +&%%(and (not (diary-date 2003 9 25)) (not (diary-date 2003 9 21)) (diary-cyclic 2 2003 9 19)) 09:00-11:30 rrule daily with exceptions diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.ics b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.ics new file mode 100644 index 00000000000..5284bf42d8b --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily-with-exceptions.ics @@ -0,0 +1,12 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule daily with exceptions +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=DAILY;INTERVAL=2 +EXDATE:20030921,20030925 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-american new file mode 100644 index 00000000000..9213270fa41 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-american @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 9 19 2003)) 09:00-11:30 rrule daily diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-european new file mode 100644 index 00000000000..2c70cd7da55 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-european @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 19 9 2003)) 09:00-11:30 rrule daily diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-iso new file mode 100644 index 00000000000..b201cb44308 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-cyclic 1 2003 9 19)) 09:00-11:30 rrule daily diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-daily.ics b/test/lisp/calendar/icalendar-resources/import-rrule-daily.ics new file mode 100644 index 00000000000..6d013b0b4f6 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-daily.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule daily +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=DAILY; +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-american new file mode 100644 index 00000000000..bc5453fe425 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-american @@ -0,0 +1 @@ +&%%(and (diary-date t 19 t) (diary-block 9 19 2003 1 1 9999)) 09:00-11:30 rrule monthly no end diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-european new file mode 100644 index 00000000000..f071519701d --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-european @@ -0,0 +1 @@ +&%%(and (diary-date 19 t t) (diary-block 19 9 2003 1 1 9999)) 09:00-11:30 rrule monthly no end diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-iso new file mode 100644 index 00000000000..3709e933337 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-date t t 19) (diary-block 2003 9 19 9999 1 1)) 09:00-11:30 rrule monthly no end diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.ics b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.ics new file mode 100644 index 00000000000..b871658600a --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-no-end.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule monthly no end +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=MONTHLY; +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-american new file mode 100644 index 00000000000..638ab8b2327 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-american @@ -0,0 +1 @@ +&%%(and (diary-date t 19 t) (diary-block 9 19 2003 8 19 2005)) 09:00-11:30 rrule monthly with end diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-european new file mode 100644 index 00000000000..c70cde25f32 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-european @@ -0,0 +1 @@ +&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 8 2005)) 09:00-11:30 rrule monthly with end diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-iso new file mode 100644 index 00000000000..ee51a2142a4 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-date t t 19) (diary-block 2003 9 19 2005 8 19)) 09:00-11:30 rrule monthly with end diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.ics b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.ics new file mode 100644 index 00000000000..d8a1fe2e5af --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-monthly-with-end.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule monthly with end +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=MONTHLY;UNTIL=20050819; +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-american new file mode 100644 index 00000000000..d8bf2eba104 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-american @@ -0,0 +1 @@ +&%%(and (diary-cyclic 7 9 19 2003)) 09:00-11:30 rrule weekly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-european new file mode 100644 index 00000000000..e368fde9709 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-european @@ -0,0 +1 @@ +&%%(and (diary-cyclic 7 19 9 2003)) 09:00-11:30 rrule weekly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-iso new file mode 100644 index 00000000000..49cd9d8ace6 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-cyclic 7 2003 9 19)) 09:00-11:30 rrule weekly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-weekly.ics b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.ics new file mode 100644 index 00000000000..c3f0b8ae933 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-weekly.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule weekly +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=WEEKLY; +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american new file mode 100644 index 00000000000..a54780b9699 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american @@ -0,0 +1 @@ +&%%(and (diary-anniversary 9 19 2003)) 09:00-11:30 rrule yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european new file mode 100644 index 00000000000..a4bd81d6f2b --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european @@ -0,0 +1 @@ +&%%(and (diary-anniversary 19 9 2003)) 09:00-11:30 rrule yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso new file mode 100644 index 00000000000..65a7abe0344 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso @@ -0,0 +1 @@ +&%%(and (diary-anniversary 2003 9 19)) 09:00-11:30 rrule yearly diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.ics b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.ics new file mode 100644 index 00000000000..21cca097f7e --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.ics @@ -0,0 +1,11 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +SUMMARY:rrule yearly +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +RRULE:FREQ=YEARLY;INTERVAL=2 +END:VEVENT +END:VCALENDAR + diff --git a/test/lisp/calendar/icalendar-resources/import-with-timezone.diary-iso b/test/lisp/calendar/icalendar-resources/import-with-timezone.diary-iso new file mode 100644 index 00000000000..f99b59213e5 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-with-timezone.diary-iso @@ -0,0 +1,2 @@ +&2012/1/15 15:00-15:30 standardtime +&2012/12/15 11:00-11:30 daylightsavingtime diff --git a/test/lisp/calendar/icalendar-resources/import-with-timezone.ics b/test/lisp/calendar/icalendar-resources/import-with-timezone.ics new file mode 100644 index 00000000000..110a9835e41 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-with-timezone.ics @@ -0,0 +1,27 @@ +BEGIN:VCALENDAR +BEGIN:VTIMEZONE +TZID:fictional, nonexistent, arbitrary +BEGIN:STANDARD +DTSTART:20100101T000000 +TZOFFSETFROM:+0200 +TZOFFSETTO:-0200 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=01 +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:20101201T000000 +TZOFFSETFROM:-0200 +TZOFFSETTO:+0200 +RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=11 +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +SUMMARY:standardtime +DTSTART;TZID="fictional, nonexistent, arbitrary":20120115T120000 +DTEND;TZID="fictional, nonexistent, arbitrary":20120115T123000 +END:VEVENT +BEGIN:VEVENT +SUMMARY:daylightsavingtime +DTSTART;TZID="fictional, nonexistent, arbitrary":20121215T120000 +DTEND;TZID="fictional, nonexistent, arbitrary":20121215T123000 +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-resources/import-with-uid.diary-american b/test/lisp/calendar/icalendar-resources/import-with-uid.diary-american new file mode 100644 index 00000000000..9b2f06afc26 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-with-uid.diary-american @@ -0,0 +1,2 @@ +&9/19/2003 09:00-11:30 non-recurring + UID: 1234567890uid diff --git a/test/lisp/calendar/icalendar-resources/import-with-uid.diary-european b/test/lisp/calendar/icalendar-resources/import-with-uid.diary-european new file mode 100644 index 00000000000..95db4d40151 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-with-uid.diary-european @@ -0,0 +1,2 @@ +&19/9/2003 09:00-11:30 non-recurring + UID: 1234567890uid diff --git a/test/lisp/calendar/icalendar-resources/import-with-uid.diary-iso b/test/lisp/calendar/icalendar-resources/import-with-uid.diary-iso new file mode 100644 index 00000000000..d372e5a3d1f --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-with-uid.diary-iso @@ -0,0 +1,2 @@ +&2003/9/19 09:00-11:30 non-recurring + UID: 1234567890uid diff --git a/test/lisp/calendar/icalendar-resources/import-with-uid.ics b/test/lisp/calendar/icalendar-resources/import-with-uid.ics new file mode 100644 index 00000000000..db412d9d9f5 --- /dev/null +++ b/test/lisp/calendar/icalendar-resources/import-with-uid.ics @@ -0,0 +1,10 @@ +BEGIN:VCALENDAR +PRODID:-//Emacs//NONSGML icalendar.el//EN +VERSION:2.0 +BEGIN:VEVENT +UID:1234567890uid +SUMMARY:non-recurring +DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +END:VEVENT +END:VCALENDAR diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index bce7de769e0..8b44f639475 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -32,6 +32,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'icalendar) ;; ====================================================================== @@ -51,6 +52,15 @@ (replace-regexp-in-string "[ \t\n]+\\'" "" (replace-regexp-in-string "\\`[ \t\n]+" "" string))) +(defun icalendar-tests--get-file-contents (filename) + "Return contents of file in test data directory named FILENAME." + (with-temp-buffer + (let ((coding-system-for-read 'raw-text) + (inhibit-eol-conversion t)) + (insert-file-contents-literally + (ert-resource-file filename)) + (buffer-string)))) + ;; ====================================================================== ;; Tests of functions ;; ====================================================================== @@ -963,13 +973,16 @@ END:VALARM ;; Import tests ;; ====================================================================== -(defun icalendar-tests--test-import (input expected-iso expected-european - expected-american) +(defun icalendar-tests--test-import (filename expected-iso expected-european + expected-american) "Perform import test. -Argument INPUT icalendar event string. -Argument EXPECTED-ISO expected iso style diary string. -Argument EXPECTED-EUROPEAN expected european style diary string. -Argument EXPECTED-AMERICAN expected american style diary string. +Argument FILENAME ics file to import. +Argument EXPECTED-ISO diary-file containing expected +iso-calendar-style result. +Argument EXPECTED-EUROPEAN diary-file containing expected +european-calendar-style result. +Argument EXPECTED-AMERICAN diary-file containing expected +american-calendar-style result. During import test the timezone is set to Central European Time." (let ((timezone (getenv "TZ"))) (unwind-protect @@ -978,14 +991,7 @@ During import test the timezone is set to Central European Time." ;; Eg hydra.nixos.org. (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") (with-temp-buffer - (if (string-match "^BEGIN:VCALENDAR" input) - (insert input) - (insert "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN\n") - (insert "VERSION:2.0\nBEGIN:VEVENT\n") - (insert input) - (unless (eq (char-before) ?\n) - (insert "\n")) - (insert "END:VEVENT\nEND:VCALENDAR\n")) + (insert (icalendar-tests--get-file-contents filename)) (let ((icalendar-import-format "%s%d%l%o%t%u%c%U") (icalendar-import-format-summary "%s") (icalendar-import-format-location "\n Location: %s") @@ -998,26 +1004,29 @@ During import test the timezone is set to Central European Time." calendar-date-style) (when expected-iso (setq calendar-date-style 'iso) - (icalendar-tests--do-test-import input expected-iso)) + (icalendar-tests--do-test-import + (icalendar-tests--get-file-contents expected-iso))) (when expected-european (setq calendar-date-style 'european) - (icalendar-tests--do-test-import input expected-european)) + (icalendar-tests--do-test-import + (icalendar-tests--get-file-contents expected-european))) (when expected-american (setq calendar-date-style 'american) - (icalendar-tests--do-test-import input expected-american))))) + (icalendar-tests--do-test-import + (icalendar-tests--get-file-contents expected-american)))))) (setenv "TZ" timezone)))) -(defun icalendar-tests--do-test-import (_input expected-output) +(defun icalendar-tests--do-test-import (expected-output) "Actually perform import test. -Argument INPUT input icalendar string. -Argument EXPECTED-OUTPUT expected diary string." +Argument EXPECTED-OUTPUT file containing expected diary string." (let ((temp-file (make-temp-file "icalendar-test-diary"))) ;; Test the Catch-the-mysterious-coding-header logic below. ;; Ruby-mode adds an after-save-hook which inserts the header! ;; (save-excursion ;; (find-file temp-file) ;; (ruby-mode)) - (icalendar-import-buffer temp-file t t) + (let ((coding-system-for-write 'raw-text)) + (icalendar-import-buffer temp-file t t)) (save-excursion (find-file temp-file) ;; Check for the mysterious "# coding: ..." header, remove it @@ -1045,452 +1054,135 @@ Argument EXPECTED-OUTPUT expected diary string." (ert-deftest icalendar-import-non-recurring () "Perform standard import tests." - (icalendar-tests--test-import - "SUMMARY:non-recurring -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000" - "&2003/9/19 09:00-11:30 non-recurring\n" - "&19/9/2003 09:00-11:30 non-recurring\n" - "&9/19/2003 09:00-11:30 non-recurring\n") - (icalendar-tests--test-import - "SUMMARY:non-recurring allday -DTSTART;VALUE=DATE-TIME:20030919" - "&2003/9/19 non-recurring allday\n" - "&19/9/2003 non-recurring allday\n" - "&9/19/2003 non-recurring allday\n") - (icalendar-tests--test-import - ;; Checkdoc removes trailing blanks. Therefore: format! - (format "%s\n%s\n%s" "SUMMARY:long " " summary" - "DTSTART;VALUE=DATE:20030919") - "&2003/9/19 long summary\n" - "&19/9/2003 long summary\n" - "&9/19/2003 long summary\n") - (icalendar-tests--test-import - "UID:748f2da0-0d9b-11d8-97af-b4ec8686ea61 -SUMMARY:Sommerferien -STATUS:TENTATIVE -CLASS:PRIVATE -X-MOZILLA-ALARM-DEFAULT-UNITS:Minuten -X-MOZILLA-RECUR-DEFAULT-INTERVAL:0 -DTSTART;VALUE=DATE:20040719 -DTEND;VALUE=DATE:20040828 -DTSTAMP:20031103T011641Z -" - "&%%(and (diary-block 2004 7 19 2004 8 27)) Sommerferien - Status: TENTATIVE - Class: PRIVATE - UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61 -" - "&%%(and (diary-block 19 7 2004 27 8 2004)) Sommerferien - Status: TENTATIVE - Class: PRIVATE - UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61 -" - "&%%(and (diary-block 7 19 2004 8 27 2004)) Sommerferien - Status: TENTATIVE - Class: PRIVATE - UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61 -") - (icalendar-tests--test-import - "UID - :04979712-3902-11d9-93dd-8f9f4afe08da -SUMMARY - :folded summary -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -DTSTART - :20041123T140000 -DTEND - :20041123T143000 -DTSTAMP - :20041118T013430Z -LAST-MODIFIED - :20041118T013640Z -" - "&2004/11/23 14:00-14:30 folded summary - Status: TENTATIVE - Class: PRIVATE - UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n" - "&23/11/2004 14:00-14:30 folded summary - Status: TENTATIVE - Class: PRIVATE - UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n" - "&11/23/2004 14:00-14:30 folded summary - Status: TENTATIVE - Class: PRIVATE - UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n") - - (icalendar-tests--test-import - "UID - :6161a312-3902-11d9-b512-f764153bb28b -SUMMARY - :another example -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -DTSTART - :20041123T144500 -DTEND - :20041123T154500 -DTSTAMP - :20041118T013641Z -" - "&2004/11/23 14:45-15:45 another example - Status: TENTATIVE - Class: PRIVATE - UID: 6161a312-3902-11d9-b512-f764153bb28b\n" - "&23/11/2004 14:45-15:45 another example - Status: TENTATIVE - Class: PRIVATE - UID: 6161a312-3902-11d9-b512-f764153bb28b\n" - "&11/23/2004 14:45-15:45 another example - Status: TENTATIVE - Class: PRIVATE - UID: 6161a312-3902-11d9-b512-f764153bb28b\n")) + (icalendar-tests--test-import "import-non-recurring-1.ics" + "import-non-recurring-1.diary-iso" + "import-non-recurring-1.diary-european" + "import-non-recurring-1.diary-american") + (icalendar-tests--test-import "import-non-recurring-all-day.ics" + "import-non-recurring-all-day.diary-iso" + "import-non-recurring-all-day.diary-european" + "import-non-recurring-all-day.diary-american") + (icalendar-tests--test-import "import-non-recurring-long-summary.ics" + "import-non-recurring-long-summary.diary-iso" + "import-non-recurring-long-summary.diary-european" + "import-non-recurring-long-summary.diary-american") + (icalendar-tests--test-import "import-non-recurring-block.ics" + "import-non-recurring-block.diary-iso" + "import-non-recurring-block.diary-european" + "import-non-recurring-block.diary-american") + (icalendar-tests--test-import "import-non-recurring-folded-summary.ics" + "import-non-recurring-folded-summary.diary-iso" + "import-non-recurring-folded-summary.diary-european" + "import-non-recurring-folded-summary.diary-american") + (icalendar-tests--test-import "import-non-recurring-another-example.ics" + "import-non-recurring-another-example.diary-iso" + "import-non-recurring-another-example.diary-european" + "import-non-recurring-another-example.diary-american")) + (ert-deftest icalendar-import-rrule () - (icalendar-tests--test-import - "SUMMARY:rrule daily -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=DAILY; -" - "&%%(and (diary-cyclic 1 2003 9 19)) 09:00-11:30 rrule daily\n" - "&%%(and (diary-cyclic 1 19 9 2003)) 09:00-11:30 rrule daily\n" - "&%%(and (diary-cyclic 1 9 19 2003)) 09:00-11:30 rrule daily\n") - ;; RRULE examples - (icalendar-tests--test-import - "SUMMARY:rrule daily -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=DAILY;INTERVAL=2 -" - "&%%(and (diary-cyclic 2 2003 9 19)) 09:00-11:30 rrule daily\n" - "&%%(and (diary-cyclic 2 19 9 2003)) 09:00-11:30 rrule daily\n" - "&%%(and (diary-cyclic 2 9 19 2003)) 09:00-11:30 rrule daily\n") - (icalendar-tests--test-import - "SUMMARY:rrule daily with exceptions -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=DAILY;INTERVAL=2 -EXDATE:20030921,20030925 -" - "&%%(and (not (diary-date 2003 9 25)) (not (diary-date 2003 9 21)) (diary-cyclic 2 2003 9 19)) 09:00-11:30 rrule daily with exceptions\n" - "&%%(and (not (diary-date 25 9 2003)) (not (diary-date 21 9 2003)) (diary-cyclic 2 19 9 2003)) 09:00-11:30 rrule daily with exceptions\n" - "&%%(and (not (diary-date 9 25 2003)) (not (diary-date 9 21 2003)) (diary-cyclic 2 9 19 2003)) 09:00-11:30 rrule daily with exceptions\n") - (icalendar-tests--test-import - "SUMMARY:rrule weekly -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=WEEKLY; -" - "&%%(and (diary-cyclic 7 2003 9 19)) 09:00-11:30 rrule weekly\n" - "&%%(and (diary-cyclic 7 19 9 2003)) 09:00-11:30 rrule weekly\n" - "&%%(and (diary-cyclic 7 9 19 2003)) 09:00-11:30 rrule weekly\n") - (icalendar-tests--test-import - "SUMMARY:rrule monthly no end -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=MONTHLY; -" - "&%%(and (diary-date t t 19) (diary-block 2003 9 19 9999 1 1)) 09:00-11:30 rrule monthly no end\n" - "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 1 1 9999)) 09:00-11:30 rrule monthly no end\n" - "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 1 1 9999)) 09:00-11:30 rrule monthly no end\n") - (icalendar-tests--test-import - "SUMMARY:rrule monthly with end -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=MONTHLY;UNTIL=20050819; -" - "&%%(and (diary-date t t 19) (diary-block 2003 9 19 2005 8 19)) 09:00-11:30 rrule monthly with end\n" - "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 8 2005)) 09:00-11:30 rrule monthly with end\n" - "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 8 19 2005)) 09:00-11:30 rrule monthly with end\n") - (icalendar-tests--test-import - "DTSTART;VALUE=DATE:20040815 -DTEND;VALUE=DATE:20040816 -SUMMARY:Maria Himmelfahrt -RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=8 -" - "&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt\n" - "&%%(and (diary-anniversary 15 8 2004)) Maria Himmelfahrt\n" - "&%%(and (diary-anniversary 8 15 2004)) Maria Himmelfahrt\n") - (icalendar-tests--test-import - "SUMMARY:rrule yearly -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=YEARLY;INTERVAL=2 -" - "&%%(and (diary-anniversary 2003 9 19)) 09:00-11:30 rrule yearly\n" ;FIXME - "&%%(and (diary-anniversary 19 9 2003)) 09:00-11:30 rrule yearly\n" ;FIXME - "&%%(and (diary-anniversary 9 19 2003)) 09:00-11:30 rrule yearly\n") ;FIXME - (icalendar-tests--test-import - "SUMMARY:rrule count daily short -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=DAILY;COUNT=1;INTERVAL=1 -" - "&%%(and (diary-cyclic 1 2003 9 19) (diary-block 2003 9 19 2003 9 19)) 09:00-11:30 rrule count daily short\n" - "&%%(and (diary-cyclic 1 19 9 2003) (diary-block 19 9 2003 19 9 2003)) 09:00-11:30 rrule count daily short\n" - "&%%(and (diary-cyclic 1 9 19 2003) (diary-block 9 19 2003 9 19 2003)) 09:00-11:30 rrule count daily short\n") - (icalendar-tests--test-import - "SUMMARY:rrule count daily long -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=DAILY;COUNT=14;INTERVAL=1 -" - "&%%(and (diary-cyclic 1 2003 9 19) (diary-block 2003 9 19 2003 10 2)) 09:00-11:30 rrule count daily long\n" - "&%%(and (diary-cyclic 1 19 9 2003) (diary-block 19 9 2003 2 10 2003)) 09:00-11:30 rrule count daily long\n" - "&%%(and (diary-cyclic 1 9 19 2003) (diary-block 9 19 2003 10 2 2003)) 09:00-11:30 rrule count daily long\n") - (icalendar-tests--test-import - "SUMMARY:rrule count bi-weekly 3 times -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=WEEKLY;COUNT=3;INTERVAL=2 -" - "&%%(and (diary-cyclic 14 2003 9 19) (diary-block 2003 9 19 2003 10 31)) 09:00-11:30 rrule count bi-weekly 3 times\n" - "&%%(and (diary-cyclic 14 19 9 2003) (diary-block 19 9 2003 31 10 2003)) 09:00-11:30 rrule count bi-weekly 3 times\n" - "&%%(and (diary-cyclic 14 9 19 2003) (diary-block 9 19 2003 10 31 2003)) 09:00-11:30 rrule count bi-weekly 3 times\n") - (icalendar-tests--test-import - "SUMMARY:rrule count monthly -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=MONTHLY;INTERVAL=1;COUNT=5 -" - "&%%(and (diary-date t t 19) (diary-block 2003 9 19 2004 1 19)) 09:00-11:30 rrule count monthly\n" - "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 1 2004)) 09:00-11:30 rrule count monthly\n" - "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 1 19 2004)) 09:00-11:30 rrule count monthly\n") - (icalendar-tests--test-import - "SUMMARY:rrule count every second month -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=MONTHLY;INTERVAL=2;COUNT=5 -" - "&%%(and (diary-date t t 19) (diary-block 2003 9 19 2004 5 19)) 09:00-11:30 rrule count every second month\n" ;FIXME - "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 5 2004)) 09:00-11:30 rrule count every second month\n" ;FIXME - "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 5 19 2004)) 09:00-11:30 rrule count every second month\n") ;FIXME - (icalendar-tests--test-import - "SUMMARY:rrule count yearly -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=YEARLY;INTERVAL=1;COUNT=5 -" - "&%%(and (diary-date t 9 19) (diary-block 2003 9 19 2007 9 19)) 09:00-11:30 rrule count yearly\n" - "&%%(and (diary-date 19 9 t) (diary-block 19 9 2003 19 9 2007)) 09:00-11:30 rrule count yearly\n" - "&%%(and (diary-date 9 19 t) (diary-block 9 19 2003 9 19 2007)) 09:00-11:30 rrule count yearly\n") - (icalendar-tests--test-import - "SUMMARY:rrule count every second year -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -RRULE:FREQ=YEARLY;INTERVAL=2;COUNT=5 -" - "&%%(and (diary-date t 9 19) (diary-block 2003 9 19 2011 9 19)) 09:00-11:30 rrule count every second year\n" ;FIXME!!! - "&%%(and (diary-date 19 9 t) (diary-block 19 9 2003 19 9 2011)) 09:00-11:30 rrule count every second year\n" ;FIXME!!! - "&%%(and (diary-date 9 19 t) (diary-block 9 19 2003 9 19 2011)) 09:00-11:30 rrule count every second year\n") ;FIXME!!! -) + (icalendar-tests--test-import "import-rrule-daily.ics" + "import-rrule-daily.diary-iso" + "import-rrule-daily.diary-european" + "import-rrule-daily.diary-american") + (icalendar-tests--test-import "import-rrule-daily-two-day.ics" + "import-rrule-daily-two-day.diary-iso" + "import-rrule-daily-two-day.diary-european" + "import-rrule-daily-two-day.diary-american") + (icalendar-tests--test-import "import-rrule-daily-with-exceptions.ics" + "import-rrule-daily-with-exceptions.diary-iso" + "import-rrule-daily-with-exceptions.diary-european" + "import-rrule-daily-with-exceptions.diary-american") + (icalendar-tests--test-import "import-rrule-weekly.ics" + "import-rrule-weekly.diary-iso" + "import-rrule-weekly.diary-european" + "import-rrule-weekly.diary-american") + (icalendar-tests--test-import "import-rrule-monthly-no-end.ics" + "import-rrule-monthly-no-end.diary-iso" + "import-rrule-monthly-no-end.diary-european" + "import-rrule-monthly-no-end.diary-american") + (icalendar-tests--test-import "import-rrule-monthly-with-end.ics" + "import-rrule-monthly-with-end.diary-iso" + "import-rrule-monthly-with-end.diary-european" + "import-rrule-monthly-with-end.diary-american") + (icalendar-tests--test-import "import-rrule-anniversary.ics" + "import-rrule-anniversary.diary-iso" + "import-rrule-anniversary.diary-european" + "import-rrule-anniversary.diary-american") + (icalendar-tests--test-import "import-rrule-yearly.ics" + "import-rrule-yearly.diary-iso" + "import-rrule-yearly.diary-european" + "import-rrule-yearly.diary-american") + (icalendar-tests--test-import "import-rrule-count-daily-short.ics" + "import-rrule-count-daily-short.diary-iso" + "import-rrule-count-daily-short.diary-european" + "import-rrule-count-daily-short.diary-american") + (icalendar-tests--test-import "import-rrule-count-daily-long.ics" + "import-rrule-count-daily-long.diary-iso" + "import-rrule-count-daily-long.diary-european" + "import-rrule-count-daily-long.diary-american") + (icalendar-tests--test-import "import-rrule-count-monthly.ics" + "import-rrule-count-monthly.diary-iso" + "import-rrule-count-monthly.diary-european" + "import-rrule-count-monthly.diary-american") + (icalendar-tests--test-import "import-rrule-count-every-second-month.ics" + "import-rrule-count-every-second-month.diary-iso" + "import-rrule-count-every-second-month.diary-european" + "import-rrule-count-every-second-month.diary-american") + (icalendar-tests--test-import "import-rrule-count-yearly.ics" + "import-rrule-count-yearly.diary-iso" + "import-rrule-count-yearly.diary-european" + "import-rrule-count-yearly.diary-american") + (icalendar-tests--test-import "import-rrule-count-every-second-year.ics" + "import-rrule-count-every-second-year.diary-iso" + "import-rrule-count-every-second-year.diary-european" + "import-rrule-count-every-second-year.diary-american") + ) (ert-deftest icalendar-import-duration () - ;; duration - (icalendar-tests--test-import - "DTSTART;VALUE=DATE:20050217 -SUMMARY:duration -DURATION:P7D -" - "&%%(and (diary-block 2005 2 17 2005 2 23)) duration\n" - "&%%(and (diary-block 17 2 2005 23 2 2005)) duration\n" - "&%%(and (diary-block 2 17 2005 2 23 2005)) duration\n") - (icalendar-tests--test-import - "UID:20041127T183329Z-18215-1001-4536-49109@andromeda -DTSTAMP:20041127T183315Z -LAST-MODIFIED:20041127T183329 -SUMMARY:Urlaub -DTSTART;VALUE=DATE:20011221 -DTEND;VALUE=DATE:20011221 -RRULE:FREQ=DAILY;UNTIL=20011229;INTERVAL=1;WKST=SU -CLASS:PUBLIC -SEQUENCE:1 -CREATED:20041127T183329 -" - "&%%(and (diary-cyclic 1 2001 12 21) (diary-block 2001 12 21 2001 12 29)) Urlaub - Class: PUBLIC - UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n" - "&%%(and (diary-cyclic 1 21 12 2001) (diary-block 21 12 2001 29 12 2001)) Urlaub - Class: PUBLIC - UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n" - "&%%(and (diary-cyclic 1 12 21 2001) (diary-block 12 21 2001 12 29 2001)) Urlaub - Class: PUBLIC - UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n")) + (icalendar-tests--test-import "import-duration.ics" + "import-duration.diary-iso" + "import-duration.diary-european" + "import-duration.diary-american") + ;; duration-2: this is actually an rrule test + (icalendar-tests--test-import "import-duration-2.ics" + "import-duration-2.diary-iso" + "import-duration-2.diary-european" + "import-duration-2.diary-american")) (ert-deftest icalendar-import-bug-6766 () ;;bug#6766 -- multiple byday values in a weekly rrule - (icalendar-tests--test-import -"CLASS:PUBLIC -DTEND;TZID=America/New_York:20100421T120000 -DTSTAMP:20100525T141214Z -DTSTART;TZID=America/New_York:20100421T113000 -RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO,WE,TH,FR -SEQUENCE:1 -STATUS:CONFIRMED -SUMMARY:Scrum -TRANSP:OPAQUE -UID:8814e3f9-7482-408f-996c-3bfe486a1262 -END:VEVENT -BEGIN:VEVENT -CLASS:PUBLIC -DTSTAMP:20100525T141214Z -DTSTART;VALUE=DATE:20100422 -DTEND;VALUE=DATE:20100423 -RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=TU,TH -SEQUENCE:1 -SUMMARY:Tues + Thurs thinking -TRANSP:OPAQUE -UID:8814e3f9-7482-408f-996c-3bfe486a1263 -" -"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 2010 4 21)) 11:30-12:00 Scrum - Status: CONFIRMED - Class: PUBLIC - UID: 8814e3f9-7482-408f-996c-3bfe486a1262 -&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 2010 4 22)) Tues + Thurs thinking - Class: PUBLIC - UID: 8814e3f9-7482-408f-996c-3bfe486a1263 -" -"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 21 4 2010)) 11:30-12:00 Scrum - Status: CONFIRMED - Class: PUBLIC - UID: 8814e3f9-7482-408f-996c-3bfe486a1262 -&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 22 4 2010)) Tues + Thurs thinking - Class: PUBLIC - UID: 8814e3f9-7482-408f-996c-3bfe486a1263 -" -"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 4 21 2010)) 11:30-12:00 Scrum - Status: CONFIRMED - Class: PUBLIC - UID: 8814e3f9-7482-408f-996c-3bfe486a1262 -&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 4 22 2010)) Tues + Thurs thinking - Class: PUBLIC - UID: 8814e3f9-7482-408f-996c-3bfe486a1263 -")) + (icalendar-tests--test-import "import-bug-6766.ics" + "import-bug-6766.diary-iso" + "import-bug-6766.diary-european" + "import-bug-6766.diary-american")) (ert-deftest icalendar-import-bug-24199 () ;;bug#24199 -- monthly rule with byday-clause - (icalendar-tests--test-import -" -SUMMARY:Summary -DESCRIPTION:Desc -LOCATION:Loc -DTSTART:20151202T124600 -DTEND:20151202T160000 -RRULE:FREQ=MONTHLY;BYDAY=1WE;INTERVAL=1 -EXDATE:20160106T114600Z -EXDATE:20160203T114600Z -EXDATE:20160302T114600Z -EXDATE:20160504T104600Z -EXDATE:20160601T104600Z -CLASS:DEFAULT -TRANSP:OPAQUE -BEGIN:VALARM -ACTION:DISPLAY -TRIGGER;VALUE=DURATION:-PT3H -END:VALARM -LAST-MODIFIED:20160805T191040Z -UID:9188710a-08a7-4061-bae3-d4cf4972599a -" -"&%%(and (not (diary-date 2016 1 6)) (not (diary-date 2016 2 3)) (not (diary-date 2016 3 2)) (not (diary-date 2016 5 4)) (not (diary-date 2016 6 1)) (diary-float t 3 1) (diary-block 2015 12 2 9999 1 1)) 12:46-16:00 Summary - Desc: Desc - Location: Loc - Class: DEFAULT - UID: 9188710a-08a7-4061-bae3-d4cf4972599a -" -"&%%(and (not (diary-date 6 1 2016)) (not (diary-date 3 2 2016)) (not (diary-date 2 3 2016)) (not (diary-date 4 5 2016)) (not (diary-date 1 6 2016)) (diary-float t 3 1) (diary-block 2 12 2015 1 1 9999)) 12:46-16:00 Summary - Desc: Desc - Location: Loc - Class: DEFAULT - UID: 9188710a-08a7-4061-bae3-d4cf4972599a -" -"&%%(and (not (diary-date 1 6 2016)) (not (diary-date 2 3 2016)) (not (diary-date 3 2 2016)) (not (diary-date 5 4 2016)) (not (diary-date 6 1 2016)) (diary-float t 3 1) (diary-block 12 2 2015 1 1 9999)) 12:46-16:00 Summary - Desc: Desc - Location: Loc - Class: DEFAULT - UID: 9188710a-08a7-4061-bae3-d4cf4972599a -" -)) + (icalendar-tests--test-import "import-bug-24199.ics" + "import-bug-24199.diary-iso" + "import-bug-24199.diary-european" + "import-bug-24199.diary-american")) (ert-deftest icalendar-import-bug-33277 () ;;bug#33277 -- start time equals end time - (icalendar-tests--test-import - "DTSTART:20181105T200000Z -DTSTAMP:20181105T181652Z -DESCRIPTION: -LAST-MODIFIED:20181105T181646Z -LOCATION: -SEQUENCE:0 -SUMMARY:event with same start/end time -TRANSP:OPAQUE -" - - "&2018/11/5 21:00 event with same start/end time\n" - "&5/11/2018 21:00 event with same start/end time\n" - "&11/5/2018 21:00 event with same start/end time\n" - )) + (icalendar-tests--test-import "import-bug-33277.ics" + "import-bug-33277.diary-iso" + "import-bug-33277.diary-european" + "import-bug-33277.diary-american")) (ert-deftest icalendar-import-multiple-vcalendars () - (icalendar-tests--test-import - "DTSTART;VALUE=DATE:20110723 -SUMMARY:event-1 -" - "&2011/7/23 event-1\n" - "&23/7/2011 event-1\n" - "&7/23/2011 event-1\n") - - (icalendar-tests--test-import - "BEGIN:VCALENDAR -PRODID:-//Emacs//NONSGML icalendar.el//EN -VERSION:2.0\nBEGIN:VEVENT -DTSTART;VALUE=DATE:20110723 -SUMMARY:event-1 -END:VEVENT -END:VCALENDAR -BEGIN:VCALENDAR -PRODID:-//Emacs//NONSGML icalendar.el//EN -VERSION:2.0 -BEGIN:VEVENT -DTSTART;VALUE=DATE:20110724 -SUMMARY:event-2 -END:VEVENT -END:VCALENDAR -BEGIN:VCALENDAR -PRODID:-//Emacs//NONSGML icalendar.el//EN -VERSION:2.0 -BEGIN:VEVENT -DTSTART;VALUE=DATE:20110725 -SUMMARY:event-3a -END:VEVENT -BEGIN:VEVENT -DTSTART;VALUE=DATE:20110725 -SUMMARY:event-3b -END:VEVENT -END:VCALENDAR -" - "&2011/7/23 event-1\n&2011/7/24 event-2\n&2011/7/25 event-3a\n&2011/7/25 event-3b\n" - "&23/7/2011 event-1\n&24/7/2011 event-2\n&25/7/2011 event-3a\n&25/7/2011 event-3b\n" - "&7/23/2011 event-1\n&7/24/2011 event-2\n&7/25/2011 event-3a\n&7/25/2011 event-3b\n")) + (icalendar-tests--test-import "import-multiple-vcalendars.ics" + "import-multiple-vcalendars.diary-iso" + "import-multiple-vcalendars.diary-european" + "import-multiple-vcalendars.diary-american")) (ert-deftest icalendar-import-with-uid () "Perform import test with uid." - (icalendar-tests--test-import - "UID:1234567890uid -SUMMARY:non-recurring -DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000" - "&2003/9/19 09:00-11:30 non-recurring\n UID: 1234567890uid\n" - "&19/9/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n" - "&9/19/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n")) + (icalendar-tests--test-import "import-with-uid.ics" + "import-with-uid.diary-iso" + "import-with-uid.diary-european" + "import-with-uid.diary-american")) (ert-deftest icalendar-import-with-timezone () ;; This is known to fail on MS-Windows, because the test assumes @@ -1499,42 +1191,13 @@ DTEND;VALUE=DATE-TIME:20030919T113000" :failed :passed) ;; bug#11473 - (icalendar-tests--test-import - "BEGIN:VCALENDAR -BEGIN:VTIMEZONE -TZID:fictional, nonexistent, arbitrary -BEGIN:STANDARD -DTSTART:20100101T000000 -TZOFFSETFROM:+0200 -TZOFFSETTO:-0200 -RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=01 -END:STANDARD -BEGIN:DAYLIGHT -DTSTART:20101201T000000 -TZOFFSETFROM:-0200 -TZOFFSETTO:+0200 -RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=11 -END:DAYLIGHT -END:VTIMEZONE -BEGIN:VEVENT -SUMMARY:standardtime -DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20120115T120000 -DTEND;TZID=\"fictional, nonexistent, arbitrary\":20120115T123000 -END:VEVENT -BEGIN:VEVENT -SUMMARY:daylightsavingtime -DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20121215T120000 -DTEND;TZID=\"fictional, nonexistent, arbitrary\":20121215T123000 -END:VEVENT -END:VCALENDAR" - ;; "standardtime" begins first sunday in january and is 4 hours behind CET - ;; "daylightsavingtime" begins first sunday in november and is 1 hour before CET - "&2012/1/15 15:00-15:30 standardtime -&2012/12/15 11:00-11:30 daylightsavingtime -" - nil - nil) - ) + ;; "standardtime" begins first sunday in january and is 4 hours behind CET + ;; "daylightsavingtime" begins first sunday in november and is 1 hour before CET + (icalendar-tests--test-import "import-with-timezone.ics" + "import-with-timezone.diary-iso" + nil + nil)) + ;; ====================================================================== ;; Cycle ;; ====================================================================== @@ -1632,237 +1295,27 @@ SUMMARY:and diary-anniversary :failed :passed) ;; 2003-05-29 - (icalendar-tests--test-import - "BEGIN:VCALENDAR -METHOD:REQUEST -PRODID:Microsoft CDO for Microsoft Exchange -VERSION:2.0 -BEGIN:VTIMEZONE -TZID:Kolkata, Chennai, Mumbai, New Delhi -X-MICROSOFT-CDO-TZID:23 -BEGIN:STANDARD -DTSTART:16010101T000000 -TZOFFSETFROM:+0530 -TZOFFSETTO:+0530 -END:STANDARD -BEGIN:DAYLIGHT -DTSTART:16010101T000000 -TZOFFSETFROM:+0530 -TZOFFSETTO:+0530 -END:DAYLIGHT -END:VTIMEZONE -BEGIN:VEVENT -DTSTAMP:20030509T043439Z -DTSTART;TZID=\"Kolkata, Chennai, Mumbai, New Delhi\":20030509T103000 -SUMMARY:On-Site Interview -UID:040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000 - 010000000DB823520692542408ED02D7023F9DFF9 -ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"Xxxxx - xxx Xxxxxxxxxxxx\":MAILTO:xxxxxxxx@xxxxxxx.com -ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"Yyyyyyy Y - yyyy\":MAILTO:yyyyyyy@yyyyyyy.com -ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"Zzzz Zzzz - zz\":MAILTO:zzzzzz@zzzzzzz.com -ORGANIZER;CN=\"Aaaaaa Aaaaa\":MAILTO:aaaaaaa@aaaaaaa.com -LOCATION:Cccc -DTEND;TZID=\"Kolkata, Chennai, Mumbai, New Delhi\":20030509T153000 -DESCRIPTION:10:30am - Blah -SEQUENCE:0 -PRIORITY:5 -CLASS: -CREATED:20030509T043439Z -LAST-MODIFIED:20030509T043459Z -STATUS:CONFIRMED -TRANSP:OPAQUE -X-MICROSOFT-CDO-BUSYSTATUS:BUSY -X-MICROSOFT-CDO-INSTTYPE:0 -X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY -X-MICROSOFT-CDO-ALLDAYEVENT:FALSE -X-MICROSOFT-CDO-IMPORTANCE:1 -X-MICROSOFT-CDO-OWNERAPPTID:126441427 -BEGIN:VALARM -ACTION:DISPLAY -DESCRIPTION:REMINDER -TRIGGER;RELATED=START:-PT00H15M00S -END:VALARM -END:VEVENT -END:VCALENDAR" - nil - "&9/5/2003 07:00-12:00 On-Site Interview - Desc: 10:30am - Blah - Location: Cccc - Organizer: MAILTO:aaaaaaa@aaaaaaa.com - Status: CONFIRMED - UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9 -" - "&5/9/2003 07:00-12:00 On-Site Interview - Desc: 10:30am - Blah - Location: Cccc - Organizer: MAILTO:aaaaaaa@aaaaaaa.com - Status: CONFIRMED - UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9 -") + (icalendar-tests--test-import "import-real-world-2003-05-29.ics" + nil + "import-real-world-2003-05-29.diary-european" + "import-real-world-2003-05-29.diary-american") ;; created with http://apps.marudot.com/ical/ - (icalendar-tests--test-import - "BEGIN:VCALENDAR -VERSION:2.0 -PRODID:-//www.marudot.com//iCal Event Maker -X-WR-CALNAME:Test -CALSCALE:GREGORIAN -BEGIN:VTIMEZONE -TZID:Asia/Tehran -TZURL:http://tzurl.org/zoneinfo-outlook/Asia/Tehran -X-LIC-LOCATION:Asia/Tehran -BEGIN:STANDARD -TZOFFSETFROM:+0330 -TZOFFSETTO:+0330 -TZNAME:IRST -DTSTART:19700101T000000 -END:STANDARD -END:VTIMEZONE -BEGIN:VEVENT -DTSTAMP:20141116T171439Z -UID:20141116T171439Z-678877132@marudot.com -DTSTART;TZID=\"Asia/Tehran\":20141116T070000 -DTEND;TZID=\"Asia/Tehran\":20141116T080000 -SUMMARY:NoDST -DESCRIPTION:Test event from timezone without DST -LOCATION:Everywhere -END:VEVENT -END:VCALENDAR" - nil - "&16/11/2014 04:30-05:30 NoDST - Desc: Test event from timezone without DST - Location: Everywhere - UID: 20141116T171439Z-678877132@marudot.com -" - "&11/16/2014 04:30-05:30 NoDST - Desc: Test event from timezone without DST - Location: Everywhere - UID: 20141116T171439Z-678877132@marudot.com -") - + (icalendar-tests--test-import "import-real-world-no-dst.ics" + nil + "import-real-world-no-dst.diary-european" + "import-real-world-no-dst.diary-american") ;; 2003-06-18 a - (icalendar-tests--test-import - "DTSTAMP:20030618T195512Z -DTSTART;TZID=\"Mountain Time (US & Canada)\":20030623T110000 -SUMMARY:Dress Rehearsal for XXXX-XXXX -UID:040000008200E00074C5B7101A82E00800000000608AA7DA9835C301000000000000000 - 0100000007C3A6D65EE726E40B7F3D69A23BD567E -ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"AAAAA,AAA - AA (A-AAAAAAA,ex1)\":MAILTO:aaaaa_aaaaa@aaaaa.com -ORGANIZER;CN=\"ABCD,TECHTRAINING - (A-Americas,exgen1)\":MAILTO:xxx@xxxxx.com -LOCATION:555 or TN 555-5555 ID 5555 & NochWas (see below) -DTEND;TZID=\"Mountain Time (US & Canada)\":20030623T120000 -DESCRIPTION:753 Zeichen hier radiert -SEQUENCE:0 -PRIORITY:5 -CLASS: -CREATED:20030618T195518Z -LAST-MODIFIED:20030618T195527Z -STATUS:CONFIRMED -TRANSP:OPAQUE -X-MICROSOFT-CDO-BUSYSTATUS:BUSY -X-MICROSOFT-CDO-INSTTYPE:0 -X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY -X-MICROSOFT-CDO-ALLDAYEVENT:FALSE -X-MICROSOFT-CDO-IMPORTANCE:1 -X-MICROSOFT-CDO-OWNERAPPTID:1022519251 -BEGIN:VALARM -ACTION:DISPLAY -DESCRIPTION:REMINDER -TRIGGER;RELATED=START:-PT00H15M00S -END:VALARM" - nil - "&23/6/2003 11:00-12:00 Dress Rehearsal for XXXX-XXXX - Desc: 753 Zeichen hier radiert - Location: 555 or TN 555-5555 ID 5555 & NochWas (see below) - Organizer: MAILTO:xxx@xxxxx.com - Status: CONFIRMED - UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E -" - "&6/23/2003 11:00-12:00 Dress Rehearsal for XXXX-XXXX - Desc: 753 Zeichen hier radiert - Location: 555 or TN 555-5555 ID 5555 & NochWas (see below) - Organizer: MAILTO:xxx@xxxxx.com - Status: CONFIRMED - UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E -") + (icalendar-tests--test-import "import-real-world-2003-06-18a.ics" + nil + "import-real-world-2003-06-18a.diary-european" + "import-real-world-2003-06-18a.diary-american") ;; 2003-06-18 b -- uses timezone - (icalendar-tests--test-import - "BEGIN:VCALENDAR -METHOD:REQUEST -PRODID:Microsoft CDO for Microsoft Exchange -VERSION:2.0 -BEGIN:VTIMEZONE -TZID:Mountain Time (US & Canada) -X-MICROSOFT-CDO-TZID:12 -BEGIN:STANDARD -DTSTART:16010101T020000 -TZOFFSETFROM:-0600 -TZOFFSETTO:-0700 -RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=10;BYDAY=-1SU -END:STANDARD -BEGIN:DAYLIGHT -DTSTART:16010101T020000 -TZOFFSETFROM:-0700 -TZOFFSETTO:-0600 -RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=4;BYDAY=1SU -END:DAYLIGHT -END:VTIMEZONE -BEGIN:VEVENT -DTSTAMP:20030618T230323Z -DTSTART;TZID=\"Mountain Time (US & Canada)\":20030623T090000 -SUMMARY:Updated: Dress Rehearsal for ABC01-15 -UID:040000008200E00074C5B7101A82E00800000000608AA7DA9835C301000000000000000 - 0100000007C3A6D65EE726E40B7F3D69A23BD567E -ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;X-REPLYTIME=20030618T20 - 0700Z;RSVP=TRUE;CN=\"AAAAA,AAAAAA -\(A-AAAAAAA,ex1)\":MAILTO:aaaaaa_aaaaa@aaaaa - .com -ORGANIZER;CN=\"ABCD,TECHTRAINING -\(A-Americas,exgen1)\":MAILTO:bbb@bbbbb.com -LOCATION:123 or TN 123-1234 ID abcd & SonstWo (see below) -DTEND;TZID=\"Mountain Time (US & Canada)\":20030623T100000 -DESCRIPTION:Viele Zeichen standen hier früher -SEQUENCE:0 -PRIORITY:5 -CLASS: -CREATED:20030618T230326Z -LAST-MODIFIED:20030618T230335Z -STATUS:CONFIRMED -TRANSP:OPAQUE -X-MICROSOFT-CDO-BUSYSTATUS:BUSY -X-MICROSOFT-CDO-INSTTYPE:0 -X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY -X-MICROSOFT-CDO-ALLDAYEVENT:FALSE -X-MICROSOFT-CDO-IMPORTANCE:1 -X-MICROSOFT-CDO-OWNERAPPTID:1022519251 -BEGIN:VALARM -ACTION:DISPLAY -DESCRIPTION:REMINDER -TRIGGER;RELATED=START:-PT00H15M00S -END:VALARM -END:VEVENT -END:VCALENDAR" - nil - "&23/6/2003 17:00-18:00 Updated: Dress Rehearsal for ABC01-15 - Desc: Viele Zeichen standen hier früher - Location: 123 or TN 123-1234 ID abcd & SonstWo (see below) - Organizer: MAILTO:bbb@bbbbb.com - Status: CONFIRMED - UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E -" - "&6/23/2003 17:00-18:00 Updated: Dress Rehearsal for ABC01-15 - Desc: Viele Zeichen standen hier früher - Location: 123 or TN 123-1234 ID abcd & SonstWo (see below) - Organizer: MAILTO:bbb@bbbbb.com - Status: CONFIRMED - UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E -") + (icalendar-tests--test-import "import-real-world-2003-06-18b.ics" + nil + "import-real-world-2003-06-18b.diary-european" + "import-real-world-2003-06-18b.diary-american") ;; export 2004-10-28 block entries (icalendar-tests--test-export nil @@ -2078,169 +1531,10 @@ DTEND;VALUE=DATE-TIME:20041012T150000 SUMMARY:Tue: [2004-10-12] q1") ;; 2004-11-19 - (icalendar-tests--test-import - "BEGIN:VCALENDAR -VERSION - :2.0 -PRODID - :-//Mozilla.org/NONSGML Mozilla Calendar V1.0//EN -BEGIN:VEVENT -SUMMARY - :Jjjjj & Wwwww -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -DTSTART - :20041123T140000 -DTEND - :20041123T143000 -DTSTAMP - :20041118T013430Z -LAST-MODIFIED - :20041118T013640Z -END:VEVENT -BEGIN:VEVENT -SUMMARY - :BB Aaaaaaaa Bbbbb -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -DTSTART - :20041123T144500 -DTEND - :20041123T154500 -DTSTAMP - :20041118T013641Z -END:VEVENT -BEGIN:VEVENT -SUMMARY - :Hhhhhhhh -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -DTSTART - :20041123T110000 -DTEND - :20041123T120000 -DTSTAMP - :20041118T013831Z -END:VEVENT -BEGIN:VEVENT -SUMMARY - :MMM Aaaaaaaaa -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -X-MOZILLA-RECUR-DEFAULT-INTERVAL - :2 -RRULE - :FREQ=WEEKLY;INTERVAL=2;BYDAY=FR -DTSTART - :20041112T140000 -DTEND - :20041112T183000 -DTSTAMP - :20041118T014117Z -END:VEVENT -BEGIN:VEVENT -SUMMARY - :Rrrr/Cccccc ii Aaaaaaaa -DESCRIPTION - :Vvvvv Rrrr aaa Cccccc -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -DTSTART - ;VALUE=DATE - :20041119 -DTEND - ;VALUE=DATE - :20041120 -DTSTAMP - :20041118T013107Z -LAST-MODIFIED - :20041118T014203Z -END:VEVENT -BEGIN:VEVENT -SUMMARY - :Wwww aa hhhh -STATUS - :TENTATIVE -CLASS - :PRIVATE -X-MOZILLA-ALARM-DEFAULT-LENGTH - :0 -RRULE - :FREQ=WEEKLY;INTERVAL=1;BYDAY=MO -DTSTART - ;VALUE=DATE - :20041101 -DTEND - ;VALUE=DATE - :20041102 -DTSTAMP - :20041118T014045Z -LAST-MODIFIED - :20041118T023846Z -END:VEVENT -END:VCALENDAR -" - nil - "&23/11/2004 14:00-14:30 Jjjjj & Wwwww - Status: TENTATIVE - Class: PRIVATE -&23/11/2004 14:45-15:45 BB Aaaaaaaa Bbbbb - Status: TENTATIVE - Class: PRIVATE -&23/11/2004 11:00-12:00 Hhhhhhhh - Status: TENTATIVE - Class: PRIVATE -&%%(and (diary-cyclic 14 12 11 2004)) 14:00-18:30 MMM Aaaaaaaaa - Status: TENTATIVE - Class: PRIVATE -&%%(and (diary-block 19 11 2004 19 11 2004)) Rrrr/Cccccc ii Aaaaaaaa - Desc: Vvvvv Rrrr aaa Cccccc - Status: TENTATIVE - Class: PRIVATE -&%%(and (diary-cyclic 7 1 11 2004)) Wwww aa hhhh - Status: TENTATIVE - Class: PRIVATE -" - "&11/23/2004 14:00-14:30 Jjjjj & Wwwww - Status: TENTATIVE - Class: PRIVATE -&11/23/2004 14:45-15:45 BB Aaaaaaaa Bbbbb - Status: TENTATIVE - Class: PRIVATE -&11/23/2004 11:00-12:00 Hhhhhhhh - Status: TENTATIVE - Class: PRIVATE -&%%(and (diary-cyclic 14 11 12 2004)) 14:00-18:30 MMM Aaaaaaaaa - Status: TENTATIVE - Class: PRIVATE -&%%(and (diary-block 11 19 2004 11 19 2004)) Rrrr/Cccccc ii Aaaaaaaa - Desc: Vvvvv Rrrr aaa Cccccc - Status: TENTATIVE - Class: PRIVATE -&%%(and (diary-cyclic 7 11 1 2004)) Wwww aa hhhh - Status: TENTATIVE - Class: PRIVATE -") + (icalendar-tests--test-import "import-real-world-2004-11-19.ics" + nil + "import-real-world-2004-11-19.diary-european" + "import-real-world-2004-11-19.diary-american") ;; 2004-09-09 pg (icalendar-tests--test-export @@ -2270,53 +1564,16 @@ DTEND;VALUE=DATE-TIME:20041102T163000 SUMMARY:Zahnarzt") ;; 2005-02-07 lt - (icalendar-tests--test-import - "UID - :b60d398e-1dd1-11b2-a159-cf8cb05139f4 -SUMMARY - :Waitangi Day -DESCRIPTION - :abcdef -CATEGORIES - :Public Holiday -STATUS - :CONFIRMED -CLASS - :PRIVATE -DTSTART - ;VALUE=DATE - :20050206 -DTEND - ;VALUE=DATE - :20050207 -DTSTAMP - :20050128T011209Z" - nil - "&%%(and (diary-block 6 2 2005 6 2 2005)) Waitangi Day - Desc: abcdef - Status: CONFIRMED - Class: PRIVATE - UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4 -" - "&%%(and (diary-block 2 6 2005 2 6 2005)) Waitangi Day - Desc: abcdef - Status: CONFIRMED - Class: PRIVATE - UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4 -") + (icalendar-tests--test-import "import-real-world-2005-02-07.ics" + nil + "import-real-world-2005-02-07.diary-european" + "import-real-world-2005-02-07.diary-american") ;; 2005-03-01 lt - (icalendar-tests--test-import - "DTSTART;VALUE=DATE:20050217 -SUMMARY:Hhhhhh Aaaaa ii Aaaaaaaa -UID:6AFA7558-6994-11D9-8A3A-000A95A0E830-RID -DTSTAMP:20050118T210335Z -DURATION:P7D" - nil - "&%%(and (diary-block 17 2 2005 23 2 2005)) Hhhhhh Aaaaa ii Aaaaaaaa - UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID\n" - "&%%(and (diary-block 2 17 2005 2 23 2005)) Hhhhhh Aaaaa ii Aaaaaaaa - UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID\n") + (icalendar-tests--test-import "import-real-world-2005-03-01.ics" + nil + "import-real-world-2005-03-01.diary-european" + "import-real-world-2005-03-01.diary-american") ;; 2005-03-23 lt (icalendar-tests--test-export @@ -2343,132 +1600,24 @@ SUMMARY:NNN Wwwwwwww Wwwww - Aaaaaa Pppppppp rrrrrr ddd oo Nnnnnnnn 30 ") ;; bug#11473 - (icalendar-tests--test-import - "BEGIN:VCALENDAR -METHOD:REQUEST -PRODID:Microsoft Exchange Server 2007 -VERSION:2.0 -BEGIN:VTIMEZONE -TZID:(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna -BEGIN:STANDARD -DTSTART:16010101T030000 -TZOFFSETFROM:+0200 -TZOFFSETTO:+0100 -RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=10 -END:STANDARD -BEGIN:DAYLIGHT -DTSTART:16010101T020000 -TZOFFSETFROM:+0100 -TZOFFSETTO:+0200 -RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=3 -END:DAYLIGHT -END:VTIMEZONE -BEGIN:VEVENT -ORGANIZER;CN=\"A. Luser\":MAILTO:a.luser@foo.com -ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"Luser, Oth - er\":MAILTO:other.luser@foo.com -DESCRIPTION;LANGUAGE=en-US:\nWhassup?\n\n -SUMMARY;LANGUAGE=en-US:Query -DTSTART;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\" - :20120515T150000 -DTEND;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\":2 - 0120515T153000 -UID:040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000 - 010000000575268034ECDB649A15349B1BF240F15 -RECURRENCE-ID;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, V - ienna\":20120515T170000 -CLASS:PUBLIC -PRIORITY:5 -DTSTAMP:20120514T153645Z -TRANSP:OPAQUE -STATUS:CONFIRMED -SEQUENCE:15 -LOCATION;LANGUAGE=en-US:phone -X-MICROSOFT-CDO-APPT-SEQUENCE:15 -X-MICROSOFT-CDO-OWNERAPPTID:1907632092 -X-MICROSOFT-CDO-BUSYSTATUS:TENTATIVE -X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY -X-MICROSOFT-CDO-ALLDAYEVENT:FALSE -X-MICROSOFT-CDO-IMPORTANCE:1 -X-MICROSOFT-CDO-INSTTYPE:3 -BEGIN:VALARM -ACTION:DISPLAY -DESCRIPTION:REMINDER -TRIGGER;RELATED=START:-PT15M -END:VALARM -END:VEVENT -END:VCALENDAR" - nil - "&15/5/2012 15:00-15:30 Query - Location: phone - Organizer: MAILTO:a.luser@foo.com - Status: CONFIRMED - Class: PUBLIC - UID: 040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000010000000575268034ECDB649A15349B1BF240F15 -" nil) + (icalendar-tests--test-import "import-bug-11473.ics" + nil + "import-bug-11473.diary-european" + nil) ;; 2015-12-05, mixed line endings and empty lines, see Bug#22092. - (icalendar-tests--test-import - "BEGIN:VCALENDAR\r -PRODID:-//www.norwegian.no//iCalendar MIMEDIR//EN\r -VERSION:2.0\r -METHOD:REQUEST\r -BEGIN:VEVENT\r -UID:RFCALITEM1\r -SEQUENCE:1512040950\r -DTSTAMP:20141204T095043Z\r -ORGANIZER:noreply@norwegian.no\r -DTSTART:20141208T173000Z\r - -DTEND:20141208T215500Z\r - -LOCATION:Stavanger-Sola\r - -DESCRIPTION:Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390\r - -X-ALT-DESC;FMTTYPE=text/html:<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2//EN\"><html><head><META NAME=\"Generator\" CONTENT=\"MS Exchange Server version 08.00.0681.000\"><title></title></head><body><b><font face=\"Calibri\" size=\"3\">Reisereferanse</p></body></html> -SUMMARY:Norwegian til Tromsoe-Langnes -\r - -CATEGORIES:Appointment\r - - -PRIORITY:5\r - -CLASS:PUBLIC\r - -TRANSP:OPAQUE\r -END:VEVENT\r -END:VCALENDAR -" -"&2014/12/8 18:30-22:55 Norwegian til Tromsoe-Langnes - - Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 - Location: Stavanger-Sola - Organizer: noreply@norwegian.no - Class: PUBLIC - UID: RFCALITEM1 -" -"&8/12/2014 18:30-22:55 Norwegian til Tromsoe-Langnes - - Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 - Location: Stavanger-Sola - Organizer: noreply@norwegian.no - Class: PUBLIC - UID: RFCALITEM1 -" -"&12/8/2014 18:30-22:55 Norwegian til Tromsoe-Langnes - - Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 - Location: Stavanger-Sola - Organizer: noreply@norwegian.no - Class: PUBLIC - UID: RFCALITEM1 -" -) - ) + (icalendar-tests--test-import "import-bug-22092.ics" + "import-bug-22092.diary-iso" + "import-bug-22092.diary-european" + "import-bug-22092.diary-american")) (defun icalendar-test--format (string &optional day zone) + "Decode and format STRING with DAY and ZONE." (let ((time (icalendar--decode-isodatetime string day zone))) (format-time-string "%FT%T%z" (encode-time time) 0))) (defun icalendar-tests--decode-isodatetime (_ical-string) + "Test icalendar--decode-isodatetime." (should (equal (icalendar-test--format "20040917T050910-0200") "2004-09-17T03:09:10+0000")) (should (equal (icalendar-test--format "20040917T050910") diff --git a/test/lisp/calendar/solar-tests.el b/test/lisp/calendar/solar-tests.el new file mode 100644 index 00000000000..441beafe71c --- /dev/null +++ b/test/lisp/calendar/solar-tests.el @@ -0,0 +1,42 @@ +;;; solar-tests.el --- tests for solar.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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/>. + +(require 'ert) +(require 'solar) + +(ert-deftest solar-sunrise-sunset () + ;; Bug#44237: wrong sunrise time on Dec 30 and 31, 2020 for Jaipur. + (let ((calendar-latitude 26.9) + (calendar-longitude 75.8) + (calendar-time-zone +330) + (calendar-standard-time-zone-name "IST") + (calendar-daylight-time-zone-name "IST") + (epsilon (/ 60.0))) ; Minute accuracy is good enough. + (let* ((sunrise-sunset (solar-sunrise-sunset '(12 30 2020))) + (sunrise (car (nth 0 sunrise-sunset))) + (sunset (car (nth 1 sunrise-sunset)))) + (should (< (abs (- sunrise 7.27)) epsilon)) + (should (< (abs (- sunset 17.72)) epsilon))) + (let* ((sunrise-sunset (solar-sunrise-sunset '(12 31 2020))) + (sunrise (car (nth 0 sunrise-sunset))) + (sunset (car (nth 1 sunrise-sunset)))) + (should (< (abs (- sunrise 7.28)) epsilon)) + (should (< (abs (- sunset 17.72)) epsilon))))) + +(provide 'solar-tests) diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 233d43cd01a..76a5641f34d 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -22,19 +22,74 @@ (require 'ert) (require 'time-date) +(ert-deftest test-obsolete-with-decoded-time-value () + (with-suppressed-warnings ((obsolete with-decoded-time-value)) + (with-decoded-time-value ((high low micro pico type '(1 2 3 4 5 6 8 8))) + (should (equal (list high low micro pico type) '(1 2 3 4 3)))))) + +(ert-deftest test-obsolete-encode-time-value () + (should (equal (with-suppressed-warnings ((obsolete encode-time-value)) + (encode-time-value 1 2 3 4 0)) + '(1 . 2))) + (should (equal (with-suppressed-warnings ((obsolete encode-time-value)) + (encode-time-value 1 2 3 4 1)) + '(1 2))) + (should (equal (with-suppressed-warnings ((obsolete encode-time-value)) + (encode-time-value 1 2 3 4 2)) + '(1 2 3))) + (should (equal (with-suppressed-warnings ((obsolete encode-time-value)) + (encode-time-value 1 2 3 4 3)) + '(1 2 3 4)))) + (ert-deftest test-leap-year () (should-not (date-leap-year-p 1999)) (should-not (date-leap-year-p 1900)) (should (date-leap-year-p 2000)) (should (date-leap-year-p 2004))) +(ert-deftest test-days-to-time () + (should (equal (days-to-time 0) '(0 0))) + (should (equal (days-to-time 1) '(1 20864))) + (should (equal (days-to-time 999) '(1317 2688))) + (should (equal (days-to-time 0.0) '(0 0 0 0))) + (should (equal (days-to-time 0.5) '(0 43200 0 0))) + (should (equal (days-to-time 1.0) '(1 20864 0 0))) + (should (equal (days-to-time 999.0) '(1317 2688 0 0)))) + +(ert-deftest test-seconds-to-string () + (should (equal (seconds-to-string 0) "0s")) + (should (equal (seconds-to-string 9) "9.00s")) + (should (equal (seconds-to-string 99) "99.00s")) + (should (equal (seconds-to-string 999) "16.65m")) + (should (equal (seconds-to-string 9999) "2.78h")) + (should (equal (seconds-to-string 99999) "27.78h")) + (should (equal (seconds-to-string 999999) "11.57d")) + (should (equal (seconds-to-string 9999999) "115.74d")) + (should (equal (seconds-to-string 99999999) "3.17y")) + (should (equal (seconds-to-string 999999999) "31.69y"))) + (ert-deftest test-days-in-month () (should (= (date-days-in-month 2004 2) 29)) (should (= (date-days-in-month 2004 3) 31)) + (should (= (date-days-in-month 2019 2) 28)) + (should (= (date-days-in-month 2020 12) 31)) (should-not (= (date-days-in-month 1900 3) 28)) + (should-error (date-days-in-month 2020 0)) (should-error (date-days-in-month 2020 15)) (should-error (date-days-in-month 2020 'foo))) +(ert-deftest test-format-seconds () + (should (equal (format-seconds "%y %d %h %m %s %%" 0) "0 0 0 0 0 %")) + (should (equal (format-seconds "%y %d %h %m %s %%" 9999999) "0 115 17 46 39 %")) + (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) " 1 %")) + (should (equal (format-seconds "%mm %ss" 66) "1m 6s")) + (should (equal (format-seconds "%mm %5ss" 66) "1m 6s")) + (should (equal (format-seconds "%mm %.5ss" 66.4) "1m 00006s")) + + (should (equal (format-seconds "%mm %,1ss" 66.4) "1m 6.4s")) + (should (equal (format-seconds "%mm %5,1ss" 66.4) "1m 6.4s")) + (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s"))) + (ert-deftest test-ordinal () (should (equal (date-ordinal-to-time 2008 271) '(nil nil nil 27 9 2008 nil nil nil))) @@ -107,7 +162,8 @@ '(12 15 14 8 7 2019 1 t 7200))))) (ert-deftest test-time-since () - (should (time-equal-p 0 (time-since nil)))) + (should (time-equal-p 0 (time-since nil))) + (should (= (cadr (time-since (time-subtract (current-time) 1))) 1))) (ert-deftest test-time-decoded-period () (should (equal (decoded-time-period '(nil nil 1 nil nil nil nil nil nil)) @@ -119,6 +175,7 @@ (should (equal (decoded-time-period '(0 0 0 1 0 0 nil nil nil)) 86400)) (should (equal (decoded-time-period '(0 0 0 0 1 0 nil nil nil)) 2592000)) (should (equal (decoded-time-period '(0 0 0 0 0 1 nil nil nil)) 31536000)) + (should (equal (decoded-time-period '(1 2 3 4 5 6 nil nil nil)) 202532521)) (should (equal (decoded-time-period '((135 . 10) 0 0 0 0 0 nil nil nil)) 13.5))) diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 1fbd39478c5..6ed55121988 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -28,19 +28,10 @@ (require 'ert-x) (require 'todo-mode) -(defvar todo-test-data-dir - (file-truename - (expand-file-name "todo-mode-resources/" - (file-name-directory (or load-file-name - buffer-file-name)))) - "Base directory of todo-mode.el test data files.") - -(defvar todo-test-file-1 (expand-file-name "todo-test-1.todo" - todo-test-data-dir) +(defvar todo-test-file-1 (ert-resource-file "todo-test-1.todo") "Todo mode test file.") -(defvar todo-test-archive-1 (expand-file-name "todo-test-1.toda" - todo-test-data-dir) +(defvar todo-test-archive-1 (ert-resource-file "todo-test-1.toda") "Todo Archive mode test file.") (defmacro with-todo-test (&rest body) @@ -52,7 +43,7 @@ (abbreviated-home-dir nil) (process-environment (cons (format "HOME=%s" todo-test-home) process-environment)) - (todo-directory todo-test-data-dir) + (todo-directory (ert-resource-directory)) (todo-default-todo-file (todo-short-file-name (car (funcall todo-files-function))))) (unwind-protect @@ -815,7 +806,7 @@ buffer from which the editing command was invoked." "Add file FILE with category CAT to todo-files and show it. This provides a noninteractive API for todo-add-file for use in automatic testing." - (let ((file0 (file-truename (concat todo-test-data-dir file ".todo"))) + (let ((file0 (ert-resource-file (concat file ".todo"))) todo-add-item-if-new-category) ; Don't need an item in cat. (cl-letf (((symbol-function 'todo-read-file-name) (lambda (_prompt) file0)) diff --git a/test/lisp/cedet/semantic-utest-c.el b/test/lisp/cedet/semantic-utest-c.el index bdd6c050df6..c776a0fbaac 100644 --- a/test/lisp/cedet/semantic-utest-c.el +++ b/test/lisp/cedet/semantic-utest-c.el @@ -1,4 +1,4 @@ -;;; semantic-utest-c.el --- C based parsing tests. +;;; semantic-utest-c.el --- C based parsing tests. -*- lexical-binding:t -*- ;; Copyright (C) 2008-2020 Free Software Foundation, Inc. @@ -40,11 +40,13 @@ (defvar semantic-utest-c-test-directory (expand-file-name "tests" cedet-utest-directory) "Location of test files.") +(defvar semantic-lex-c-nested-namespace-ignore-second) + ;;; Code: ;;;###autoload (ert-deftest semantic-test-c-preprocessor-simulation () "Run parsing test for C from the test directory." - (interactive) + :tags '(:expensive-test) (semantic-mode 1) (dolist (fp semantic-utest-c-comparisons) (let* ((semantic-lex-c-nested-namespace-ignore-second nil) @@ -146,33 +148,32 @@ gcc version 2.95.2 19991024 (release)" (ert-deftest semantic-test-gcc-output-parser () "Test the output parser against some collected strings." - (let ((fail nil)) - (dolist (S semantic-gcc-test-strings) - (let* ((fields (semantic-gcc-fields S)) - (v (cdr (assoc 'version fields))) - (h (or (cdr (assoc 'target fields)) - (cdr (assoc '--target fields)) - (cdr (assoc '--host fields)))) - (p (cdr (assoc '--prefix fields))) - ) - ;; No longer test for prefixes. - (when (not (and v h)) - (let ((strs (split-string S "\n"))) - (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p) - )) - (should (and v h)) - )) - (dolist (S semantic-gcc-test-strings-fail) - (let* ((fields (semantic-gcc-fields S)) - (v (cdr (assoc 'version fields))) - (h (or (cdr (assoc '--host fields)) - (cdr (assoc 'target fields)))) - (p (cdr (assoc '--prefix fields))) - ) - ;; negative test - (should-not (and v h p)) - )) - )) + (dolist (S semantic-gcc-test-strings) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc 'target fields)) + (cdr (assoc '--target fields)) + (cdr (assoc '--host fields)))) + (p (cdr (assoc '--prefix fields))) + ) + ;; No longer test for prefixes. + (when (not (and v h)) + (let ((strs (split-string S "\n"))) + (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p) + )) + (should (and v h)) + )) + (dolist (S semantic-gcc-test-strings-fail) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc '--host fields)) + (cdr (assoc 'target fields)))) + (p (cdr (assoc '--prefix fields))) + ) + ;; negative test + (should-not (and v h p)) + )) + ) (provide 'semantic-utest-c) diff --git a/test/lisp/cedet/srecode-utest-getset.el b/test/lisp/cedet/srecode-utest-getset.el index 3419b18afb5..fc66ac4edf2 100644 --- a/test/lisp/cedet/srecode-utest-getset.el +++ b/test/lisp/cedet/srecode-utest-getset.el @@ -55,6 +55,7 @@ private: (defvar srecode-insert-getset-fully-automatic-flag) ; Silence byte-compiler. (ert-deftest srecode-utest-getset-output () "Test various template insertion options." + :tags '(:expensive-test) (save-excursion (let ((testbuff (find-file-noselect srecode-utest-getset-testfile)) (srecode-insert-getset-fully-automatic-flag t)) diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 132fe875f72..923f588e9e6 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -39,6 +39,7 @@ "Passphrase for key root@GNU.ORG: " ; plink "[sudo] password for user:" ; Ubuntu sudo "[sudo] user 的密码：" ; localized + "doas (user@host) password:" ; OpenBSD doas "PIN for user:" ; Bug#35523 "Password (again):" "Enter password:" @@ -52,73 +53,41 @@ (dolist (str comint-testsuite-password-strings) (should (string-match comint-password-prompt-regexp str)))) -(ert-deftest comint-test-no-password-function () - "Test that `comint-password-function' not being set does not -alter normal password flow." - (cl-letf - (((symbol-function 'read-passwd) - (lambda (_prompt &optional _confirm _default) - "PaSsWoRd123"))) - (let ((cat (executable-find "cat"))) - (when cat +(defun comint-tests/test-password-function (password-function) + "PASSWORD-FUNCTION can return nil or a string." + (when-let ((cat (executable-find "cat"))) + (let ((comint-password-function password-function)) + (cl-letf (((symbol-function 'read-passwd) + (lambda (&rest _args) "non-nil"))) (with-temp-buffer (make-comint-in-buffer "test-comint-password" (current-buffer) cat) (let ((proc (get-buffer-process (current-buffer)))) (set-process-query-on-exit-flag proc nil) - (comint-send-string proc "Password: ") - (comint-send-eof) - (while (accept-process-output proc 0.1 nil t)) - (should (string-equal (buffer-substring-no-properties (point-min) (point-max)) - "Password: PaSsWoRd123\n")) - (when (process-live-p proc) - (kill-process proc)) - (accept-process-output proc 0 1 t))))))) + (set-process-query-on-exit-flag proc nil) + (comint-send-invisible "Password: ") + (accept-process-output proc 0.1) + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + (concat (or (and password-function + (funcall password-function)) + "non-nil") + "\n"))))))))) + +(ert-deftest comint-test-no-password-function () + "Test that `comint-password-function' not being set does not +alter normal password flow." + (comint-tests/test-password-function nil)) (ert-deftest comint-test-password-function-with-value () "Test that `comint-password-function' alters normal password flow. Hook function returns alternative password." - (cl-letf - (((symbol-function 'read-passwd) - (lambda (_prompt &optional _confirm _default) - "PaSsWoRd123"))) - (let ((cat (executable-find "cat")) - (comint-password-function (lambda (_prompt) "MaGiC-PaSsWoRd789"))) - (when cat - (with-temp-buffer - (make-comint-in-buffer "test-comint-password" (current-buffer) cat) - (let ((proc (get-buffer-process (current-buffer)))) - (set-process-query-on-exit-flag proc nil) - (comint-send-string proc "Password: ") - (comint-send-eof) - (while (accept-process-output proc 0.1 nil t)) - (should (string-equal (buffer-substring-no-properties (point-min) (point-max)) - "Password: MaGiC-PaSsWoRd789\n")) - (when (process-live-p proc) - (kill-process proc)) - (accept-process-output proc 0 1 t))))))) + (comint-tests/test-password-function + (lambda (&rest _args) "MaGiC-PaSsWoRd789"))) (ert-deftest comint-test-password-function-with-nil () "Test that `comint-password-function' does not alter the normal password flow if it returns a nil value." - (cl-letf - (((symbol-function 'read-passwd) - (lambda (_prompt &optional _confirm _default) - "PaSsWoRd456"))) - (let ((cat (executable-find "cat")) - (comint-password-function (lambda (_prompt) nil))) - (when cat - (with-temp-buffer - (make-comint-in-buffer "test-comint-password" (current-buffer) cat) - (let ((proc (get-buffer-process (current-buffer)))) - (set-process-query-on-exit-flag proc nil) - (comint-send-string proc "Password: ") - (comint-send-eof) - (while (accept-process-output proc 0.1 nil t)) - (should (string-equal (buffer-substring-no-properties (point-min) (point-max)) - "Password: PaSsWoRd456\n")) - (when (process-live-p proc) - (kill-process proc)) - (accept-process-output proc 0 1 t))))))) + (comint-tests/test-password-function #'ignore)) ;; Local Variables: ;; no-byte-compile: t diff --git a/test/lisp/completion-tests.el b/test/lisp/completion-tests.el new file mode 100644 index 00000000000..7473bbbb0c5 --- /dev/null +++ b/test/lisp/completion-tests.el @@ -0,0 +1,170 @@ +;;; completion-tests.el --- Tests for completion.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'completion) + +(ert-deftest completion-test-cmpl-string-case-type () + (should (eq (cmpl-string-case-type "123ABCDEF456") :up)) + (should (eq (cmpl-string-case-type "123abcdef456") :down)) + (should (eq (cmpl-string-case-type "123aBcDeF456") :mixed)) + (should (eq (cmpl-string-case-type "123456") :neither)) + (should (eq (cmpl-string-case-type "Abcde123") :capitalized))) + +(ert-deftest completion-test-cmpl-merge-string-cases () + (should (equal (cmpl-merge-string-cases "AbCdEf456" "abc") "AbCdEf456")) + (should (equal (cmpl-merge-string-cases "abcdef456" "ABC") "ABCDEF456")) + (should (equal (cmpl-merge-string-cases "ABCDEF456" "Abc") "Abcdef456")) + (should (equal (cmpl-merge-string-cases "ABCDEF456" "abc") "abcdef456"))) + +(ert-deftest completion-test-add-find-delete-tail () + (unwind-protect + (progn + ;; - Add and Find - + (should (equal (add-completion-to-head "banana") '("banana" 0 nil 0))) + (should (equal (find-exact-completion "banana") '("banana" 0 nil 0))) + (should (equal (find-exact-completion "bana") nil)) + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0)))) + (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0)))) + + (should (equal (add-completion-to-head "banish") '("banish" 0 nil 0))) + (should (equal (find-exact-completion "banish") '("banish" 0 nil 0))) + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0) ("banana" 0 nil 0)))) + (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0)))) + + (should (equal (add-completion-to-head "banana") '("banana" 0 nil 0))) + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0) ("banish" 0 nil 0)))) + (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0)))) + + ;; - Deleting - + (should (equal (add-completion-to-head "banner") '("banner" 0 nil 0))) + (delete-completion "banner") + (should-not (find-exact-completion "banner")) + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0) ("banish" 0 nil 0)))) + (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0)))) + (should (equal (add-completion-to-head "banner") '("banner" 0 nil 0))) + (delete-completion "banana") + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banner" 0 nil 0) ("banish" 0 nil 0)))) + (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0)))) + (delete-completion "banner") + (delete-completion "banish") + (should-not (find-cmpl-prefix-entry "ban")) + (should-error (delete-completion "banner")) + + ;; - Tail - + (should (equal (add-completion-to-tail-if-new "banana") '("banana" 0 nil 0))) + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0)))) + (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0)))) + (add-completion-to-tail-if-new "banish") '("banish" 0 nil 0) + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 0 nil 0) ("banish" 0 nil 0)))) + (should (equal (cdr (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0))))) + (ignore-errors (kill-completion "banana")) + (ignore-errors (kill-completion "banner")) + (ignore-errors (kill-completion "banish")))) + +(ert-deftest completion-test-add-find-accept-delete () + (unwind-protect + (progn + ;; - Add and Find - + (add-completion "banana" 5 10) + (should (equal (find-exact-completion "banana") '("banana" 5 10 0))) + (add-completion "banana" 6) + (should (equal (find-exact-completion "banana") '("banana" 6 10 0))) + (add-completion "banish") + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banish" 0 nil 0) ("banana" 6 10 0)))) + + ;; - Accepting - + (setq completion-to-accept "banana") + (accept-completion) + (should (equal (find-exact-completion "banana") '("banana" 7 10 0))) + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banana" 7 10 0) ("banish" 0 nil 0)))) + (setq completion-to-accept "banish") + (add-completion "banner") + (should (equal (car (find-cmpl-prefix-entry "ban")) + '(("banner" 0 nil 0) ("banish" 1 nil 0) ("banana" 7 10 0)))) + + ;; - Deleting - + (kill-completion "banish") + (should (equal (car (find-cmpl-prefix-entry "ban")) '(("banner" 0 nil 0) ("banana" 7 10 0))))) + (ignore-errors (kill-completion "banish")) + (ignore-errors (kill-completion "banana")) + (ignore-errors (kill-completion "banner")))) + +(ert-deftest completion-test-search () + (unwind-protect + (progn + ;; - Add and Find - + (add-completion "banana") + (completion-search-reset "ban") + (should (equal (car (completion-search-next 0)) "banana")) + + ;; - Discrimination - + (add-completion "cumberland") + (add-completion "cumberbund") + ;; cumbering + (completion-search-reset "cumb") + (should (equal (car (completion-search-peek t)) "cumberbund")) + (should (equal (car (completion-search-next 0)) "cumberbund")) + (should (equal (car (completion-search-peek t)) "cumberland")) + (should (equal (car (completion-search-next 1)) "cumberland")) + (should-not (completion-search-peek nil)) + + ;; FIXME + ;; (should (equal (completion-search-next 2) "cumbering")) ; {cdabbrev} + ;;(completion-search-next 3) --> nil or "cumming" {depends on context} + + (should (equal (car (completion-search-next 1)) "cumberland")) + + ;; FIXME + ;; (should (equal (completion-search-peek t) "cumbering")) ; {cdabbrev} + + ;; - Accepting - + (should (equal (car (completion-search-next 1)) "cumberland")) + (setq completion-to-accept "cumberland") + (completion-search-reset "foo") + (completion-search-reset "cum") + (should (equal (car (completion-search-next 0)) "cumberland")) + + ;; - Deleting - + (kill-completion "cumberland") + (add-completion "cummings") + (completion-search-reset "cum") + (should (equal (car (completion-search-next 0)) "cummings")) + (should (equal (car (completion-search-next 1)) "cumberbund")) + + ;; - Ignoring Capitalization - + (completion-search-reset "CuMb") + (should (equal (car (completion-search-next 0)) "cumberbund"))) + (ignore-errors (kill-completion "banana")) + (ignore-errors (kill-completion "cumberland")) + (ignore-errors (kill-completion "cumberbund")) + (ignore-errors (kill-completion "cummings")))) + +(ert-deftest completion-test-lisp-def-regexp () + (should (= (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) 8)) + (should (= (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) 9)) + (should (= (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) 10)) + (should (= (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) 9))) + +(provide 'completion-tests) +;;; completion-tests.el ends here diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 7853c84bb69..a1451cf0ce6 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'wid-edit) (require 'cus-edit) @@ -100,8 +101,7 @@ (ert-deftest custom--test-theme-variables () "Test variables setting with enabling / disabling a custom theme." ;; We load custom-resources/custom--test-theme.el. - (let ((custom-theme-load-path - `(,(expand-file-name "custom-resources" (file-name-directory #$))))) + (let ((custom-theme-load-path `(,(ert-resource-directory)))) (load-theme 'custom--test 'no-confirm 'no-enable) ;; The variables have still their initial values. (should (equal custom--test-user-option 'foo)) @@ -145,4 +145,15 @@ (widget-apply field :value-to-internal origvalue) "bar")))))) +(defconst custom-test-admin-cus-test + (expand-file-name "admin/cus-test.el" source-directory)) + +(declare-function cus-test-opts custom-test-admin-cus-test) + +(ert-deftest check-for-wrong-custom-types () + :tags '(:expensive-test) + (skip-unless (file-readable-p custom-test-admin-cus-test)) + (load custom-test-admin-cus-test) + (should (null (cus-test-opts t)))) + ;;; custom-tests.el ends here diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 1fe155718d5..6bb8ced1f30 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -28,7 +28,7 @@ (let* ((foo (make-temp-file "foo")) (files (list foo))) (unwind-protect - (cl-letf (((symbol-function 'y-or-n-p) 'error)) + (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error)) (dired temporary-file-directory) (dired-goto-file foo) ;; `dired-do-shell-command' returns nil on success. @@ -40,7 +40,7 @@ (should-not (dired-do-shell-command "ls ? ./`?`" nil files))) (delete-file foo)))) -;; Auxiliar macro for `dired-test-bug28834': it binds +;; Auxiliary macro for `dired-test-bug28834': it binds ;; `dired-create-destination-dirs' to CREATE-DIRS and execute BODY. ;; If YES-OR-NO is non-nil, it binds `yes-or-no-p' to ;; to avoid the prompt. @@ -114,6 +114,49 @@ (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted." + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (markers " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + t)) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(15 29))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (markers " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "*") + command + t)) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(11 25))) + (let* ((command "sed 's/\\?/!/'") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + nil)) + (lines (split-string result "\n"))) + (should (= (length lines) 1)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (dired-test--check-highlighting (nth 0 lines) '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 5c6649cba46..cec533ddfaa 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -24,11 +24,11 @@ (ert-deftest dired-autoload () "Tests to see whether dired-x has been autoloaded" (should - (fboundp 'dired-jump)) + (fboundp 'dired-do-relsymlink)) (should (autoloadp (symbol-function - 'dired-jump)))) + 'dired-do-relsymlink)))) (ert-deftest dired-test-bug22694 () "Test for https://debbugs.gnu.org/22694 ." diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 8b9c1c5fcb5..5f63f6831b3 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -887,7 +887,8 @@ baz\"\"" (should (equal (buffer-string) "int main () {\n \n}")))) (ert-deftest electric-layout-control-reindentation () - "Same as `e-l-int-main-kernel-style', but checking Bug#35254." + "Same as `emacs-lisp-int-main-kernel-style', but checking +Bug#35254." (ert-with-test-buffer () (plainer-c-mode) (electric-layout-local-mode 1) diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index 12164b46ec3..fbc71e0ec86 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -41,7 +41,7 @@ (backtrace-mode) (setq backtrace-frames (backtrace-get-frames)) (let ((this-index)) - ;; Discard all past `backtrace-tests-make-backtrace'. + ;; Discard all past `backtrace-tests--make-backtrace'. (dotimes (index (length backtrace-frames)) (when (eq (backtrace-frame-fun (nth index backtrace-frames)) 'backtrace-tests--make-backtrace) diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index 14f95a8bf80..842ef10bc57 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -1,4 +1,4 @@ -;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; -*- +;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*- ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. @@ -94,7 +94,13 @@ (src-ip . [192 168 1 101]) (dest-ip . - [192 168 1 100])))))) + [192 168 1 100])))))) + +(ert-deftest bindat-test-pack/multibyte-string-fails () + (should-error (bindat-pack nil nil "ö"))) + +(ert-deftest bindat-test-unpack/multibyte-string-fails () + (should-error (bindat-unpack nil "ö"))) (ert-deftest bindat-test-format-vector () (should (equal (bindat-format-vector [1 2 3] "%d" "x" 2) "1x2")) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a9dcf152617..13cbedfe1f7 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -365,7 +365,12 @@ '(((a b)) a b (c) (d))) (mapcar (lambda (x) (cond ((memq '(a b) x) 1) ((equal x '(c)) 2))) - '(((a b)) a b (c) (d)))) + '(((a b)) a b (c) (d))) + + (assoc 'b '((a 1) (b 2) (c 3))) + (assoc "b" '(("a" 1) ("b" 2) ("c" 3))) + (let ((x '((a 1) (b 2) (c 3)))) (assoc 'c x)) + (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v))))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") @@ -444,8 +449,8 @@ Subtests signal errors if something goes wrong." (if compile (let ((byte-compile-dest-file-function (lambda (e) elcfile))) - (byte-compile-file elfile t)) - (load elfile nil 'nomessage))) + (byte-compile-file elfile))) + (load elfile nil 'nomessage)) (when elfile (delete-file elfile)) (when elcfile (delete-file elcfile))))) (put 'test-byte-comp-compile-and-load 'lisp-indent-function 1) @@ -646,7 +651,8 @@ literals (Bug#20852)." (setq bytecomp-tests--foobar (bytecomp-tests--foobar)))) (print form (current-buffer))) (write-region (point-min) (point-max) source nil 'silent) - (byte-compile-file source t) + (byte-compile-file source) + (load source) (should (equal bytecomp-tests--foobar (cons 1 2))))) (ert-deftest bytecomp-tests--test-no-warnings-with-advice () diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 5aa58782f36..9582907e511 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -240,7 +240,7 @@ (let ((retval (cl--generic-method-files 'cl-generic-tests--generic))) (should (equal (length retval) 2)) (mapc (lambda (x) - (should (equal (car x) cl-generic-tests--this-file)) + (should (equal (file-truename (car x)) cl-generic-tests--this-file)) (should (equal (cadr x) 'cl-generic-tests--generic))) retval) (should-not (equal (nth 0 retval) (nth 1 retval))))) diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index cddefbbdee8..7e0f5384542 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -294,6 +294,7 @@ Body are forms defining the test." (ert-deftest cl-seq-test-bug24264 () "Test for https://debbugs.gnu.org/24264 ." + :tags '(:expensive-test) (let ((list (append (make-list 8000005 1) '(8))) (list2 (make-list 8000005 2))) (should (cl-position 8 list)) diff --git a/test/lisp/emacs-lisp/copyright-tests.el b/test/lisp/emacs-lisp/copyright-tests.el new file mode 100644 index 00000000000..77b9e05da67 --- /dev/null +++ b/test/lisp/emacs-lisp/copyright-tests.el @@ -0,0 +1,50 @@ +;;; copyright-tests.el --- tests for copyright.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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 'cl-lib) +(require 'copyright) + +(defmacro with-copyright-test (orig result) + `(cl-letf (((symbol-function 'format-time-string) (lambda (&rest _) "2019"))) + (let ((copyright-query nil) + (copyright-current-year 2019)) + (with-temp-buffer + (insert ,orig) + (copyright-update) + (should (equal (buffer-string) ,result)))))) + +(defvar copyright-tests--data + '((";; Copyright (C) 2017 Free Software Foundation, Inc." + . ";; Copyright (C) 2017, 2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2017-2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2005-2006, 2015, 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2005-2006, 2015, 2017-2019 Free Software Foundation, Inc.") + (";; copyright '18 FSF" + . ";; copyright '18, '19 FSF"))) + +(ert-deftest test-copyright-update () + (dolist (test copyright-tests--data) + (with-copyright-test (car test) (cdr test)))) + +(provide 'copyright-tests) +;;; copyright-tests.el ends here diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el b/test/lisp/emacs-lisp/easy-mmode-tests.el new file mode 100644 index 00000000000..4a448200a2b --- /dev/null +++ b/test/lisp/emacs-lisp/easy-mmode-tests.el @@ -0,0 +1,70 @@ +;;; easy-mmode-tests.el --- tests for easy-mmode.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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 'easy-mmode) +(require 'message) + +(ert-deftest easy-mmode--globalized-predicate () + (with-temp-buffer + (emacs-lisp-mode) + (should (eq (easy-mmode--globalized-predicate-p nil) nil)) + (should (eq (easy-mmode--globalized-predicate-p t) t)) + (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t)) + (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t)) + (should (eq (easy-mmode--globalized-predicate-p '((not text-mode))) nil)) + (should (eq (easy-mmode--globalized-predicate-p '((not text-mode) t)) t)) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode emacs-lisp-mode)) + t)) + (mail-mode) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode (not message-mode mail-mode) text-mode)) + nil)) + (text-mode) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode (not message-mode mail-mode) text-mode)) + t)))) + +(ert-deftest easy-mmode--minor-mode () + (with-temp-buffer + (define-minor-mode test-mode "A test.") + (should (eq test-mode nil)) + (test-mode t) + (should (eq test-mode nil)) + (test-mode nil) + (should (eq test-mode t)) + (test-mode -33) + (should (eq test-mode nil)) + (test-mode 33) + (should (eq test-mode t)) + (test-mode 0) + (should (eq test-mode nil)) + (test-mode 'toggle) + (should (eq test-mode t)) + (test-mode 'toggle) + (should (eq test-mode nil)) + (test-mode "what") + (should (eq test-mode nil)))) + +(provide 'easy-mmode-tests) + +;;; easy-mmode-tests.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 04a7b2f5a0f..8aae26a1aca 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -36,17 +36,6 @@ (require 'edebug) (require 'kmacro) -;; Use `eval-and-compile' because this is used by the macro -;; `edebug-tests-deftest'. -(eval-and-compile - (defvar edebug-tests-sample-code-file - (expand-file-name - "edebug-resources/edebug-test-code.el" - (file-name-directory (or (bound-and-true-p byte-compile-current-file) - load-file-name - buffer-file-name))) - "Name of file containing code samples for Edebug tests.")) - (defvar edebug-tests-temp-file nil "Name of temp file containing sample code stripped of stop point symbols.") (defvar edebug-tests-stop-points nil @@ -116,7 +105,8 @@ back to the top level.") (declare (debug (body))) `(edebug-tests-with-default-config (let ((edebug-tests-failure-in-post-command nil) - (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el"))) + (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el")) + (find-file-suppress-same-file-warnings t)) (edebug-tests-setup-code-file edebug-tests-temp-file) (ert-with-message-capture edebug-tests-messages @@ -210,7 +200,7 @@ All other elements will be nil." (defvar edebug-tests-thunks nil "List containing thunks to run after each command in a keyboard macro.") (defvar edebug-tests-kbd-macro-index nil - "Index into `edebug-tests-run-unpacked-kbd-macro's current keyboard macro.") + "Index into `edebug-tests-run-kbd-macro's current keyboard macro.") (defun edebug-tests-run-macro (kbdmac &rest thunks) "Run a keyboard macro and execute a thunk after each command in it. @@ -221,6 +211,7 @@ be the same as every keystroke) execute the thunk at the same index." (let* ((edebug-tests-thunks thunks) (edebug-tests-kbd-macro-index 0) + (find-file-suppress-same-file-warnings t) saved-local-map) (with-current-buffer (find-file-noselect edebug-tests-temp-file) (setq saved-local-map overriding-local-map) @@ -344,7 +335,7 @@ evaluate to \"symbol\", \"symbol-1\", \"symbol-2\", etc." Write the loadable code to a buffer for TMPFILE, and set `edebug-tests-stop-points' to a map from defined symbols to stop point names to positions in the file." - (with-current-buffer (find-file-noselect edebug-tests-sample-code-file) + (with-current-buffer (find-file-noselect (ert-resource-file "edebug-test-code.el")) (let ((marked-up-code (buffer-string))) (with-temp-file tmpfile (insert marked-up-code)))) diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index b760f8c7869..f342bff0472 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -187,18 +187,15 @@ "Tests `ert-describe-test'." (save-window-excursion (ert-with-buffer-renamed ("*Help*") - (if (< emacs-major-version 24) - (should (equal (should-error (ert-describe-test 'ert-describe-test)) - '(error "Requires Emacs 24"))) - (ert-describe-test 'ert-test-describe-test) - (with-current-buffer "*Help*" - (let ((case-fold-search nil)) - (should (string-match (concat - "\\`ert-test-describe-test is a test" - " defined in" - " ['`‘]ert-x-tests.elc?['’]\\.\n\n" - "Tests ['`‘]ert-describe-test['’]\\.\n\\'") - (buffer-string))))))))) + (ert-describe-test 'ert-test-describe-test) + (with-current-buffer "*Help*" + (let ((case-fold-search nil)) + (should (string-match (concat + "\\`ert-test-describe-test is a test" + " defined in" + " ['`‘]ert-x-tests.elc?['’]\\.\n\n" + "Tests ['`‘]ert-describe-test['’]\\.\n\\'") + (buffer-string)))))))) (ert-deftest ert-test-message-log-truncation () :tags '(:causes-redisplay) diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el index 4bad36080a1..c77f2dc4990 100644 --- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el +++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el @@ -44,7 +44,7 @@ (0 (progn (add-text-properties (match-beginning 0) (match-end 0) - '(help-echo "Baloon tip: Fly smoothly!")) + '(help-echo "Balloon tip: Fly smoothly!")) font-lock-warning-face)))) "Highlight rules for `faceup-test-mode'.") diff --git a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup index 7d4938adf17..ec9e82148fd 100644 --- a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup +++ b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup @@ -1,7 +1,7 @@ This is a test of `faceup', a regression test system for font-lock keywords. It should use major mode `faceup-test-mode'. -«(help-echo):"Baloon tip: Fly smoothly!":«w:WARNING»»: The first word on this line should use +«(help-echo):"Balloon tip: Fly smoothly!":«w:WARNING»»: The first word on this line should use `font-lock-warning-face', and a tooltip should be displayed if the mouse pointer is moved over it. diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el new file mode 100644 index 00000000000..d77eb6757ff --- /dev/null +++ b/test/lisp/emacs-lisp/find-func-tests.el @@ -0,0 +1,47 @@ +;;; find-func-tests.el --- Unit tests for find-func.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Keywords: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert-x) ;For `ert-run-keys'. + +(ert-deftest find-func-tests--library-completion () ;bug#43393 + ;; FIXME: How can we make this work in batch (see also + ;; `mule-cmds--test-universal-coding-system-argument')? + ;; (skip-unless (not noninteractive)) + ;; Check that `partial-completion' works when completing library names. + (should (equal "org/org" + (ert-simulate-keys + (kbd "o / o r g TAB RET") + (read-library-name)))) + ;; Check that absolute file names also work. + (should (equal (expand-file-name "nxml/" data-directory) + (ert-simulate-keys + (concat data-directory (kbd "n x / TAB RET")) + (read-library-name))))) + +(provide 'find-func-tests) +;;; find-func-tests.el ends here diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el index 7a8402be074..29e4273b478 100644 --- a/test/lisp/emacs-lisp/gv-tests.el +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -135,8 +135,9 @@ "--eval" (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) (message "%d" (car gv-test-pair))))) - (should (equal (buffer-string) - "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) + (should (string-match + "\\`Symbol.s function definition is void: \\\\(setf\\\\ gv-test-foo\\\\)\n\\'" + (buffer-string)))))) (ert-deftest gv-setter-edebug () "Check that a setter can be defined and edebugged together with @@ -156,6 +157,46 @@ its getter (Bug#41853)." (eval-buffer))) (should (equal (get 'gv-setter-edebug 'gv-setter-edebug-prop) '(123)))) +(ert-deftest gv-plist-get () + (require 'cl-lib) + + ;; Simple setf usage for plist-get. + (should (equal (let ((target '(:a "a" :b "b" :c "c"))) + (setf (plist-get target :b) "modify") + target) + '(:a "a" :b "modify" :c "c"))) + + ;; Other function (cl-rotatef) usage for plist-get. + (should (equal (let ((target '(:a "a" :b "b" :c "c"))) + (cl-rotatef (plist-get target :b) (plist-get target :c)) + target) + '(:a "a" :b "c" :c "b"))) + + ;; Add new key value pair at top of list if setf for missing key. + (should (equal (let ((target '(:a "a" :b "b" :c "c"))) + (setf (plist-get target :d) "modify") + target) + '(:d "modify" :a "a" :b "b" :c "c"))) + + ;; Rotate with missing value. + ;; The value corresponding to the missing key is assumed to be nil. + (should (equal (let ((target '(:a "a" :b "b" :c "c"))) + (cl-rotatef (plist-get target :b) (plist-get target :d)) + target) + '(:d "b" :a "a" :b nil :c "c"))) + + ;; Simple setf usage for plist-get. (symbol plist) + (should (equal (let ((target '(a "a" b "b" c "c"))) + (setf (plist-get target 'b) "modify") + target) + '(a "a" b "modify" c "c"))) + + ;; Other function (cl-rotatef) usage for plist-get. (symbol plist) + (should (equal (let ((target '(a "a" b "b" c "c"))) + (cl-rotatef (plist-get target 'b) (plist-get target 'c)) + target) + '(a "a" b "c" c "b")))) + ;; `ert-deftest' messes up macroexpansion when the test file itself is ;; compiled (see Bug #24402). diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index febac8f4789..d1183d83f6a 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -153,7 +153,7 @@ noindent\" 3 (should (equal (buffer-string) str))))) (ert-deftest indent-sexp-stop-before-eol-non-lisp () - "`indent-sexp' shouldn't be too agressive in non-Lisp modes." + "`indent-sexp' shouldn't be too aggressive in non-Lisp modes." ;; See https://debbugs.gnu.org/35286#13. (with-temp-buffer (prolog-mode) @@ -294,6 +294,18 @@ Expected initialization file: `%s'\" (insert "\"\n") (lisp-indent-region (point-min) (point-max)))) +(ert-deftest lisp-indent-defun () + (with-temp-buffer + (lisp-mode) + (let ((orig "(defun x () + (print (quote ( thingy great + stuff))) + (print (quote (thingy great + stuff))))")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + ;;; Fontification diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index a2b8304c96a..437b907ba13 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -136,8 +136,7 @@ (text-mode) (insert "\"foo\"") (goto-char (point-min)) - (delete-pair) - (should (string-equal "fo\"" (buffer-string))))) + (should-error (delete-pair)))) (ert-deftest lisp-delete-pair-quotes-text-mode-syntax-table () "Test \\[delete-pair] with modified Text Mode syntax for #15014." @@ -296,7 +295,7 @@ (lambda () (up-list 1 t t)) (or "(1 '2 ( 2' 1 '2 ) 2' 1)") ;; abcdefghijklmnopqrstuvwxy - i k x scan-error) + i k x user-error) (define-lisp-up-list-test backward-up-list-basic (lambda () (backward-up-list)) diff --git a/test/lisp/emacs-lisp/package-resources/key.pub b/test/lisp/emacs-lisp/package-resources/key.pub index a326d34e54f..5e2ebc55d35 100644 --- a/test/lisp/emacs-lisp/package-resources/key.pub +++ b/test/lisp/emacs-lisp/package-resources/key.pub @@ -1,18 +1,20 @@ -----BEGIN PGP PUBLIC KEY BLOCK----- -Version: GnuPG v1.4.14 (GNU/Linux) -mQENBFJNB8gBCACfbtpvYrM8V1HM0KFlIwatcEJugHqwOHpr/Z9mrCW0fxyQAW/d -2L+3QVNsN9Tz/K9lLcBUgeR7rhVEzHNqhmhNj/HnikwGqXbIofhp+QbZmBKnAlCz -d77kg8K9lozHtfTkm1gX/7DdPzQKmgi7WOzzi2395wGubeqJLvYaEcqVbI0Eob+E -3CzRjNy/e/Tf3TJRW5etTcdZN6LVuIY7tNCHqlQZTwyycON/hfLTX6cLCnzDsqm/ -NxCuwn9aqP9aGRGfIu7Y+If3zTymvrXEPUN98OEID814bOKdx0uVTZRiSMbvuTGI -8uMa/kpGX/78rqI61gbZV51RFoU7pT2tzwY/ABEBAAG0HkouIFIuIEhhY2tlciA8 -anJoQGV4YW1wbGUuY29tPokBOAQTAQIAIgUCUk0HyAIbAwYLCQgHAwIGFQgCCQoL -BBYCAwECHgECF4AACgkQtpVAhgkYletuhQf+JAyHYhTZNxjq0UYlikuLX8EtYbXX -PB+03J0B73SMzEai5XsiTU2ADxqxwr7pveVK1INf+IGLiiXBlQq+4DSOvQY4xLfp -58jTOYRV1ECvlXK/JtvVOwufXREADaydf9l/MUxA5G2PPBWIuQknh3ysPSsx68OJ -SzNHFwklLn0DKc4WloE/GLDpTzimnCg7QGzuUo3Iilpjdy8EvTdI5d3jx/mGJIwI -goB+YZgyxSPM+GjDwh5DEwD7OexNqqa7RynnmU0epmlYyi9UufCHLwgiiEIzjpWi -6+iF+CQ45ZAKncovByenIUv73J3ImOudrsskeAHBmahljv1he6uV9Egj2Q== -=b5Kg +mI0EX48EbAEEANrsWXyZ4MRZRjVbLAh5jX/+1+31oB/aJ/q/5DkH1qUHJf0La9LC +sykUSM3H2u5VWLytX/ozrxIRYX13GR2xBxyJlUkDWB209AAVLFrjSp1yUX/Sb5SU +Kb7p421ZAeHiOxfnLRuErFZkTfzY19mUCyw4cdamw430V3mUC9uns/d9ABEBAAG0 +LUouIFJhbmRvbSBIYWNrZXIgKFRFU1QgS0VZKSA8anJoQGV4YW1wbGUub3JnPojO +BBMBCgA4FiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+PBGwCGwMFCwkIBwIGFQoJ +CAsCBBYCAwECHgECF4AACgkQMKdkJgeTYhq9MQP7BYkCk8r5G777Ilp8kWjsEIo3 +aDX9jORiNfMAGys/aLjjEajHFAlTQKfSLm/VXLDYtK28c8ACjThQagaDF46MRWqQ +rFFiH4IAZRgj2ELj+/j1ljQZjGjKR2Yx4BCDhbumz8zeMSPL6yFT5+8LOMUAtdv4 +lEPWXW0AycylbdbE7024jQRfjwRsAQQApjTw9kONmSVouCi8ZIQwwYiA9tLzbSZv +CYxbJ6KH0icRhBLfdb1hL/Kn8x3k+xll9A0c/ABVkMxRcbQkY98xsFck7E2GcvnC +sY+w/NdcUUZJYMB3l2MH5ojCbOk5jSAZzxzeFcJhNAhmLqomMHg2LI6KDVey6iYU +FxyIpIQ3SlkAEQEAAYi2BBgBCgAgFiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+P +BGwCGwwACgkQMKdkJgeTYhrtywQAhoCR/skBSQWWBI10N0qhtdlNxbpvK8ErSPKw +wS74Pq407Zv0VD9ual/HC3Uet2z8LeG9ZwU4Jd23g96fmJt7AM9CQWrOhC242JYr +YSqWxANyek8otsvppJNHtt2Stmknv7XbJFFB1JDC8WKo8lVo9/MkmzROxuEFEvOU +Yn923VI= +=NRtx -----END PGP PUBLIC KEY BLOCK----- diff --git a/test/lisp/emacs-lisp/package-resources/key.sec b/test/lisp/emacs-lisp/package-resources/key.sec index d21e6ae9a45..dbc80f43cb7 100644 --- a/test/lisp/emacs-lisp/package-resources/key.sec +++ b/test/lisp/emacs-lisp/package-resources/key.sec @@ -1,33 +1,35 @@ -----BEGIN PGP PRIVATE KEY BLOCK----- -Version: GnuPG v1.4.14 (GNU/Linux) -lQO+BFJNB8gBCACfbtpvYrM8V1HM0KFlIwatcEJugHqwOHpr/Z9mrCW0fxyQAW/d -2L+3QVNsN9Tz/K9lLcBUgeR7rhVEzHNqhmhNj/HnikwGqXbIofhp+QbZmBKnAlCz -d77kg8K9lozHtfTkm1gX/7DdPzQKmgi7WOzzi2395wGubeqJLvYaEcqVbI0Eob+E -3CzRjNy/e/Tf3TJRW5etTcdZN6LVuIY7tNCHqlQZTwyycON/hfLTX6cLCnzDsqm/ -NxCuwn9aqP9aGRGfIu7Y+If3zTymvrXEPUN98OEID814bOKdx0uVTZRiSMbvuTGI -8uMa/kpGX/78rqI61gbZV51RFoU7pT2tzwY/ABEBAAH+AwMCKCCpPNXkXuVgF7cz -eByuvgIO7wImDYGOdJqsASSzV4q0u1acnGtlxg7WphKDF9RnC5+1ZZ1ZcrBcv2uJ -xZm2jHdjqM3FmgQTN70GVzO1nKEur2wxlKotG4Q+8BtaRDwHdKpQFk+QW9aInH3C -BkNWTK97iFwZaoUGxKuRJb35qjMe3SsDE7kdbtOqO+tOeppRVeOOZCn7F33ir/6i -j2gmIME6LFDzvBi6YAyMBSh90Ak70HJINt0QfXlZf5MtX1NaxaEcnsRmwwcNqxh9 -JvcC9q4WrR92NhHCHI+lOsAe7hbwo/VkwRjSSx0HdKkx6kvdcNj/9LeX/jykzLvg -kEqvAqT4Jmk57W2seqvpNcAO+eUVrJ5D1OR6khsUtikPp2pQH5MDXJDGcie+ZAFb -w6BwoWBDBjooKtfuP0LKqrdtJG2JLe6yhBhWvfqHPBlUU1SsA7a5aTCLo8FiqgEI -Kyy60zMx/2Mi48oN1a/mAoV1MTWLhOVUWJlIHM7nVLj1OaX0316LcLX/uTLTq40p -apHKwERanzY7f8ROiv/Fa/J+9cCsfOLKfjFAjpBVUVoOb39HsyS/vvkGMY4kgaD6 -K6r9JPdsaoYvsLkxk5HyHF7Mk2uS1z1EIArD2/3lRiX6ag+IU1Nl3XDkgfZj06K3 -juS84dGF8CmN49uOEjzAJAQZH9jTs5OKzUuZhGJF+gt0L78vLOoKRr8bu1N1GPqU -wnS908HWruXzjJl1CAhnuCa8FnDaU+tmEKjYpWuelx85kolpMW7LT5gOFZr84MIj -Kq3Rt2hU6qQ7Cdy1ep531YKkmyh9Y4l/Tgir1OtnQQqtNuwHI497l7qAUnKZBBHZ -guApjS9BoHsRXkw2mgDssZ+khOwj/xJm876nFSiQeCD0aIbU/4zJ9e2HUOJAZI1r -d7QeSi4gUi4gSGFja2VyIDxqcmhAZXhhbXBsZS5jb20+iQE4BBMBAgAiBQJSTQfI -AhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRC2lUCGCRiV626FB/4kDIdi -FNk3GOrRRiWKS4tfwS1htdc8H7TcnQHvdIzMRqLleyJNTYAPGrHCvum95UrUg1/4 -gYuKJcGVCr7gNI69BjjEt+nnyNM5hFXUQK+Vcr8m29U7C59dEQANrJ1/2X8xTEDk -bY88FYi5CSeHfKw9KzHrw4lLM0cXCSUufQMpzhaWgT8YsOlPOKacKDtAbO5SjciK -WmN3LwS9N0jl3ePH+YYkjAiCgH5hmDLFI8z4aMPCHkMTAPs57E2qprtHKeeZTR6m -aVjKL1S58IcvCCKIQjOOlaLr6IX4JDjlkAqdyi8HJ6chS/vcnciY652uyyR4AcGZ -qGWO/WF7q5X0SCPZ -=5FZK +lQIGBF+PBGwBBADa7Fl8meDEWUY1WywIeY1//tft9aAf2if6v+Q5B9alByX9C2vS +wrMpFEjNx9ruVVi8rV/6M68SEWF9dxkdsQcciZVJA1gdtPQAFSxa40qdclF/0m+U +lCm+6eNtWQHh4jsX5y0bhKxWZE382NfZlAssOHHWpsON9Fd5lAvbp7P3fQARAQAB +/gcDAngNw4ppSPBe/w734cz++xNEv0TDgwxGBWp2wGSwWao04Nl1U4LkjiIy+dkc +uUPwEZMvxXwMcq10PPH26ifP8Xfi/zANXUoLJ0DsG6rtE3BcSC9MPFe3EJENtcIP +a0jFLsbi72aBzolNEDCZCv93znXFPekaXw/RAeeFLJz8GR2Sx6bHbTJKklXgWPHw +C5Dw6xr/kEZktgjlhjkx280STpLGaFO4jiiGZ4Obp5ePp7kyOzDUzaimdZgJwClT +VbZDNQMTzgQrBOP8doXlo9euW4Wo1IYBIOwgeYieM3ZA9YjJAmp4lFnk/KFYt0Ak +0H9IWzDU8VERcU4B04PSXahzvB1Ii7C7bbHxPyuu6sAfMK8DRkrGjwgAlrhuWNLX +M07acT/E9Pm+mBlDcdkyKB2LfwgaVb9F3C25sfcFSvc5p+sqgZp1Zx7Qg9pOhQjw +U7Ln+96c0bUl+iQKdm3TGjOXAFUHYXbRkx2cJ4gxnMVNj0D68xBtBSm0LUouIFJh +bmRvbSBIYWNrZXIgKFRFU1QgS0VZKSA8anJoQGV4YW1wbGUub3JnPojOBBMBCgA4 +FiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+PBGwCGwMFCwkIBwIGFQoJCAsCBBYC +AwECHgECF4AACgkQMKdkJgeTYhq9MQP7BYkCk8r5G777Ilp8kWjsEIo3aDX9jORi +NfMAGys/aLjjEajHFAlTQKfSLm/VXLDYtK28c8ACjThQagaDF46MRWqQrFFiH4IA +ZRgj2ELj+/j1ljQZjGjKR2Yx4BCDhbumz8zeMSPL6yFT5+8LOMUAtdv4lEPWXW0A +ycylbdbE702dAgYEX48EbAEEAKY08PZDjZklaLgovGSEMMGIgPbS820mbwmMWyei +h9InEYQS33W9YS/yp/Md5PsZZfQNHPwAVZDMUXG0JGPfMbBXJOxNhnL5wrGPsPzX +XFFGSWDAd5djB+aIwmzpOY0gGc8c3hXCYTQIZi6qJjB4NiyOig1XsuomFBcciKSE +N0pZABEBAAH+BwMCXeUOBwcOsxb/AY6rnHmgACNTGwIa5vgelw0qfET0ms/YzVrN +ufikyV9dEWVxJyuTKav978wanPu7VcCh0pTjL2nTm2nZWyRJN4gb3UIC0MA1xfB2 +yPLTCmsGeJhVOqi4Af/r06mk+NOQ96ivOA2CJuw1LSpcUtuYxB5t/grGyEojYjRP +s0Htvf2bfN9KbFJ26DGsfYzC8bCxm9szPFHBQjw4NboCigUSAHmkoTW01aWZU9Vq +brY4cWhdmCqHgfmsQgzP3LfaAQ6kJ/bkuKef7z57lz5XmlyjMQGWcZWp5xf2n81p +BV6unaIPyavzkKVAXizVfNiHNJgK9PoVoEOJkPLjRfMxVmFSGN/oF7lVTRWfOIwo +68rtNPhr6UzE4ArGHYv/pK3kijUp5daWmfrySWPcwoVAaR3mIIVs/1rhd9aZrwn6 +Q07Yo5u11rH9b8anZQF3BdTcrnU9pUzLYlFPnfhtyGqhikQILtPTf0iwr8hpG9b2 +Zoi2BBgBCgAgFiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+PBGwCGwwACgkQMKdk +JgeTYhrtywQAhoCR/skBSQWWBI10N0qhtdlNxbpvK8ErSPKwwS74Pq407Zv0VD9u +al/HC3Uet2z8LeG9ZwU4Jd23g96fmJt7AM9CQWrOhC242JYrYSqWxANyek8otsvp +pJNHtt2Stmknv7XbJFFB1JDC8WKo8lVo9/MkmzROxuEFEvOUYn923VI= +=2DW8 -----END PGP PRIVATE KEY BLOCK----- diff --git a/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig Binary files differindex 658edd3f60e..dac168b0e4c 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig +++ b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig diff --git a/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el index 3734823876e..ff070c6526f 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el @@ -1,4 +1,4 @@ -;;; signed-bad.el --- A single-file package with bad signature +;;; signed-bad.el --- A single-file package with bad signature -*- lexical-binding: t -*- ;; Author: J. R. Hacker <jrh@example.com> ;; Version: 1.0 diff --git a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el index 22718df2763..60b1b8663d9 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el @@ -1,4 +1,4 @@ -;;; signed-good.el --- A single-file package with good signature +;;; signed-good.el --- A single-file package with good signature -*- lexical-binding: t -*- ;; Author: J. R. Hacker <jrh@example.com> ;; Version: 1.0 diff --git a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig Binary files differindex 747918794ca..5b1c721e32a 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.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 new file mode 100755 index 00000000000..a48c9bb1aa2 --- /dev/null +++ b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh @@ -0,0 +1,32 @@ +#! /bin/sh + +# Generate a new key and update the signatures for tests. + +# Copyright (C) 2020 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/>. + +export GPG_AGENT="" +KEYRING="./key.ring" +TRUSTDB="./trust.db" +GPG="gpg --no-default-keyring --trustdb-name $TRUSTDB --keyring $KEYRING --yes" + +rm $KEYRING +$GPG --full-generate-key +$GPG --export --armor > "../key.pub" +$GPG --export-secret-keys -armor > "../key.sec" +$GPG --detach-sign --sign "./archive-contents" +$GPG --detach-sign --sign "./signed-good-1.0.el" diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index cb06dd4cce3..23267545f83 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -1,4 +1,4 @@ -;;; package-test.el --- Tests for the Emacs package system -*- lexical-binding:t -*- +;;; package-tests.el --- Tests for the Emacs package system -*- lexical-binding:t -*- ;; Copyright (C) 2013-2020 Free Software Foundation, Inc. @@ -39,6 +39,7 @@ (require 'package) (require 'ert) +(require 'ert-x) (require 'cl-lib) (setq package-menu-async nil) @@ -102,13 +103,9 @@ (multi-file (0 1)))) "`package-desc' used for testing dependencies.") -(defvar package-test-data-dir (expand-file-name "package-resources" package-test-file-dir) +(defvar package-test-data-dir (ert-resource-directory) "Base directory of package test files.") -(defvar package-test-fake-contents-file - (expand-file-name "archive-contents" package-test-data-dir) - "Path to a static copy of \"archive-contents\".") - (cl-defmacro with-package-test ((&optional &key file basedir install @@ -154,6 +151,15 @@ `(insert-file-contents ,file)) ,@body))) + (when ,upload-base + (dolist (f '("archive-contents" + "simple-single-1.3.el" + "simple-single-1.4.el" + "simple-single-readme.txt")) + (ignore-errors + (delete-file + (expand-file-name f package-test-archive-upload-base)))) + (delete-directory package-test-archive-upload-base)) (when (file-directory-p package-test-user-dir) (delete-directory package-test-user-dir t)) @@ -215,20 +221,20 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-desc-from-buffer () "Parse an elisp buffer to get a `package-desc' object." - (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el") + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el") (should (package-test--compatible-p (package-buffer-info) simple-single-desc 'kind))) - (with-package-test (:basedir "package-resources" :file "simple-depend-1.0.el") + (with-package-test (:basedir (ert-resource-directory) :file "simple-depend-1.0.el") (should (package-test--compatible-p (package-buffer-info) simple-depend-desc 'kind))) - (with-package-test (:basedir "package-resources" + (with-package-test (:basedir (ert-resource-directory) :file "multi-file-0.2.3.tar") (tar-mode) (should (equal (package-tar-file-info) multi-file-desc)))) (ert-deftest package-test-install-single () "Install a single file without using an archive." - (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el") + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el") (should (package-install-from-buffer)) (package-initialize) (should (package-installed-p 'simple-single)) @@ -271,7 +277,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-macro-compilation () "Install a package which includes a dependency." - (with-package-test (:basedir "package-resources") + (with-package-test (:basedir (ert-resource-directory)) (package-install-file (expand-file-name "macro-problem-package-1.0/")) (require 'macro-problem) ;; `macro-problem-func' uses a macro from `macro-aux'. @@ -310,8 +316,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-install-prioritized () "Install a lower version from a higher-prioritized archive." (with-package-test () - (let* ((newer-version (expand-file-name "package-resources/newer-versions" - package-test-file-dir)) + (let* ((newer-version (ert-resource-file "newer-versions")) (package-archives `(("older" . ,package-test-data-dir) ("newer" . ,newer-version))) (package-archive-priorities '(("older" . 100)))) @@ -326,7 +331,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-install-multifile () "Check properties of the installed multi-file package." - (with-package-test (:basedir "package-resources" :install '(multi-file)) + (with-package-test (:basedir (ert-resource-directory) :install '(multi-file)) (let ((autoload-file (expand-file-name "multi-file-autoloads.el" (expand-file-name @@ -472,8 +477,7 @@ Must called from within a `tar-mode' buffer." (package-menu-mark-install) (package-menu-execute) (should (package-installed-p 'simple-single)) - (let ((package-test-data-dir - (expand-file-name "package-resources/newer-versions" package-test-file-dir))) + (let ((package-test-data-dir (ert-resource-file "newer-versions"))) (setq package-archives `(("gnu" . ,package-test-data-dir))) (revert-buffer) @@ -492,6 +496,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-update-archives-async () "Test updating package archives asynchronously." + :tags '(:expensive-test) (skip-unless (executable-find "python2")) (let* ((package-menu-async t) (default-directory package-test-data-dir) @@ -511,7 +516,7 @@ Must called from within a `tar-mode' buffer." (when (re-search-forward "Server started, \\(.*\\)\n" nil t) (setq addr (match-string 1)))) addr))) - (with-package-test (:basedir package-test-data-dir :location addr) + (with-package-test (:basedir (ert-resource-directory) :location addr) (list-packages) (should package--downloads-in-progress) (should mode-line-process) @@ -531,8 +536,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-update-archives/ignore-nil-entry () "Ignore any packages that are nil. Test for Bug#28502." (with-package-test () - (let* ((with-nil-entry (expand-file-name "package-resources/with-nil-entry" - package-test-file-dir)) + (let* ((with-nil-entry (ert-resource-file "with-nil-entry")) (package-archives `(("with-nil-entry" . ,with-nil-entry)))) (package-initialize) (package-refresh-contents) @@ -633,8 +637,7 @@ Must called from within a `tar-mode' buffer." prog-alist))) (delete-directory homedir t)))) (let* ((keyring (expand-file-name "key.pub" package-test-data-dir)) - (package-test-data-dir - (expand-file-name "package-resources/signed" package-test-file-dir))) + (package-test-data-dir (ert-resource-file "signed"))) (with-package-test () (package-initialize) (package-import-keyring keyring) @@ -695,7 +698,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-x-test-upload-buffer () "Test creating an \"archive-contents\" file" - (with-package-test (:basedir "package-resources" + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) @@ -728,7 +731,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-x-test-upload-new-version () "Test uploading a new version of a package" - (with-package-test (:basedir "package-resources" + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) @@ -805,4 +808,4 @@ Must called from within a `tar-mode' buffer." (provide 'package-test) -;;; package-test.el ends here +;;; package-tests.el ends here diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 3b01d89dbab..59d8c600a20 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -539,6 +539,9 @@ (ert-deftest rx-compat () "Test old symbol retained for compatibility (bug#37517)." - (should (equal (rx-submatch-n '(group-n 3 (+ nonl) eol)) "\\(?3:.+$\\)"))) + (should (equal + (with-suppressed-warnings ((obsolete rx-submatch-n)) + (rx-submatch-n '(group-n 3 (+ nonl) eol))) + "\\(?3:.+$\\)"))) (provide 'rx-tests) diff --git a/test/lisp/emacs-lisp/shadow-tests.el b/test/lisp/emacs-lisp/shadow-tests.el index 219312a5578..5d6215ab6f3 100644 --- a/test/lisp/emacs-lisp/shadow-tests.el +++ b/test/lisp/emacs-lisp/shadow-tests.el @@ -20,30 +20,23 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'shadow) (eval-when-compile (require 'cl-lib)) -(defconst shadow-tests-data-directory - (expand-file-name "lisp/emacs-lisp/shadow-resources" - (or (getenv "EMACS_TEST_DIRECTORY") - (expand-file-name "../../.." - (or load-file-name - buffer-file-name)))) - "Directory for shadow test files.") - (ert-deftest shadow-case-insensitive () "Test shadowing for case insensitive filenames." ;; Override `file-name-case-insensitive-p' so we test the same thing ;; regardless of what file system we're running on. (cl-letf (((symbol-function 'file-name-case-insensitive-p) (lambda (_f) t))) - (should (equal (list (expand-file-name "p1/foo" shadow-tests-data-directory) - (expand-file-name "p2/FOO" shadow-tests-data-directory)) + (should (equal (list (ert-resource-file "p1/foo") + (ert-resource-file "p2/FOO")) (load-path-shadows-find - (list (expand-file-name "p1/" shadow-tests-data-directory) - (expand-file-name "p2/" shadow-tests-data-directory)))))) + (list (ert-resource-file "p1/") + (ert-resource-file "p2/")))))) (cl-letf (((symbol-function 'file-name-case-insensitive-p) (lambda (_f) nil))) (should-not (load-path-shadows-find - (list (expand-file-name "p1/" shadow-tests-data-directory) - (expand-file-name "p2/" shadow-tests-data-directory)))))) + (list (ert-resource-file "p1/") + (ert-resource-file "p2/")))))) ;;; shadow-tests.el ends here. diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el index 6870d49acb2..9e7a3bf31e3 100644 --- a/test/lisp/emacs-lisp/testcover-tests.el +++ b/test/lisp/emacs-lisp/testcover-tests.el @@ -31,26 +31,10 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'testcover) (require 'skeleton) -;; Use `eval-and-compile' around all these definitions because they're -;; used by the macro `testcover-tests-define-tests'. - -(eval-and-compile - (defvar testcover-tests-file-dir - (expand-file-name - "testcover-resources/" - (file-name-directory (or (bound-and-true-p byte-compile-current-file) - load-file-name - buffer-file-name))) - "Directory of the \"testcover-tests.el\" file.")) - -(eval-and-compile - (defvar testcover-tests-test-cases - (expand-file-name "testcases.el" testcover-tests-file-dir) - "File containing marked up code to instrument and check.")) - ;; Convert Testcover's overlays to plain text. (eval-and-compile @@ -62,6 +46,7 @@ is working correctly on a code sample. OPTARGS are optional arguments for `testcover-start'." (interactive "r") (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")) + (find-file-suppress-same-file-warnings t) (code (buffer-substring beg end)) (marked-up-code)) (unwind-protect @@ -114,7 +99,8 @@ arguments for `testcover-start'." (eval-and-compile (defun testcover-tests-run-test-case (marked-up-code) "Test the operation of Testcover on the string MARKED-UP-CODE." - (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))) + (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")) + (find-file-suppress-same-file-warnings t)) (unwind-protect (progn (with-temp-file tempfile @@ -149,7 +135,7 @@ Construct and return a list of `ert-deftest' forms. See testcases.el for documentation of the test definition format." (let (results) (with-temp-buffer - (insert-file-contents testcover-tests-test-cases) + (insert-file-contents (ert-resource-file "testcases.el")) (goto-char (point-min)) (while (re-search-forward (concat "^;; ==== \\([^ ]+?\\) ====\n" diff --git a/test/lisp/emacs-lisp/text-property-search-tests.el b/test/lisp/emacs-lisp/text-property-search-tests.el index 83d4b95b76b..f643e49aa5e 100644 --- a/test/lisp/emacs-lisp/text-property-search-tests.el +++ b/test/lisp/emacs-lisp/text-property-search-tests.el @@ -153,6 +153,24 @@ 46 57 nil (point-max))) + +;;;; Position after search. + +(defun text-property-search--pos-test (fun pos &optional reverse) + (with-temp-buffer + (insert (concat "foo " + (propertize "bar" 'x t) + " baz")) + (goto-char (if reverse (point-max) (point-min))) + (funcall fun 'x t) + (should (= (point) pos)))) + +(ert-deftest text-property-search-forward-point-at-beginning () + (text-property-search--pos-test #'text-property-search-forward 5)) + +(ert-deftest text-property-search-backward-point-at-end () + (text-property-search--pos-test #'text-property-search-backward 8 t)) + (provide 'text-property-search-tests) ;;; text-property-search-tests.el ends here diff --git a/test/lisp/emacs-lisp/unsafep-tests.el b/test/lisp/emacs-lisp/unsafep-tests.el index 2b920a00ca4..06c40d28ca9 100644 --- a/test/lisp/emacs-lisp/unsafep-tests.el +++ b/test/lisp/emacs-lisp/unsafep-tests.el @@ -27,7 +27,7 @@ (defvar safe-functions) ;;; These forms are all considered safe -(defconst testcover-unsafep-safe +(defconst unsafep-tests--safe '(((lambda (x) (* x 2)) 14) (apply 'cdr (mapcar (lambda (x) (car x)) y)) (cond ((= x 4) 5) (t 27)) @@ -47,7 +47,7 @@ "List of forms that `unsafep' should decide are safe.") ;;; These forms are considered unsafe -(defconst testcover-unsafep-unsafe +(defconst unsafep-tests--unsafe '(( (add-to-list x y) . (unquoted x)) ( (add-to-list y x) @@ -105,26 +105,36 @@ . (variable (x))) ( (let (1) 2) . (variable 1)) + ( (error "asdf") + . #'error) + ( (signal 'error "asdf") + . #'signal) + ( (throw 'asdf) + . #'throw) + ( (catch 'asdf 17) + . #'catch) + ( (play-sound-file "asdf") + . #'play-sound-file) + ( (replace-regexp-in-string "a" "b") + . #'replace-regexp-in-string) ) - "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.") + "A-list of (FORM . REASON)... that `unsafep' should decide are unsafe.") (ert-deftest test-unsafep/safe () - "Executes all unsafep tests and displays the coverage results." + "Check safe forms with safe-functions nil." (let (safe-functions) - (dolist (x testcover-unsafep-safe) + (dolist (x unsafep-tests--safe) (should-not (unsafep x))))) (ert-deftest test-unsafep/message () - ;; FIXME: This failed after converting these tests from testcover to - ;; ert. - :expected-result :failed - (should-not '(dolist (x y) (message "here: %s" x))) - (should-not '(dotimes (x 14 (* x 2)) (message "here: %d" x)))) + "Check that message is considered unsafe." + (should (unsafep '(dolist (x y) (message "here: %s" x)))) + (should (unsafep '(dotimes (x 14 (* x 2)) (message "here: %d" x))))) (ert-deftest test-unsafep/unsafe () - "Executes all unsafep tests and displays the coverage results." + "Check unsafe forms with safe-functions nil." (let (safe-functions) - (dolist (x testcover-unsafep-unsafe) + (dolist (x unsafep-tests--unsafe) (should (equal (unsafep (car x)) (cdr x)))))) (ert-deftest test-unsafep/safe-functions-t () diff --git a/test/data/epg/dummy-pinentry b/test/lisp/epg-resources/dummy-pinentry index 2228dfb0c6d..2228dfb0c6d 100755 --- a/test/data/epg/dummy-pinentry +++ b/test/lisp/epg-resources/dummy-pinentry diff --git a/test/data/epg/pubkey.asc b/test/lisp/epg-resources/pubkey.asc index c0bf28f6200..c0bf28f6200 100644 --- a/test/data/epg/pubkey.asc +++ b/test/lisp/epg-resources/pubkey.asc diff --git a/test/data/epg/seckey.asc b/test/lisp/epg-resources/seckey.asc index 4ac7ba4a502..4ac7ba4a502 100644 --- a/test/data/epg/seckey.asc +++ b/test/lisp/epg-resources/seckey.asc diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index 2a9c021c67b..c9c92f529be 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -22,14 +22,11 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'epg) (defvar epg-tests-context nil) -(defvar epg-tests-data-directory - (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY")) - "Directory containing epg test data.") - (defconst epg-tests--config-program-alist ;; The default `epg-config--program-alist' requires gpg2 2.1 or ;; greater due to some practical problems with pinentry. But most @@ -85,8 +82,7 @@ '(with-temp-file (expand-file-name "gpg-agent.conf" epg-tests-home-directory) (insert "pinentry-program " - (expand-file-name "dummy-pinentry" - epg-tests-data-directory) + (ert-resource-file "dummy-pinentry") "\n") (epg-context-set-passphrase-callback context @@ -94,11 +90,11 @@ ,(if require-public-key '(epg-import-keys-from-file context - (expand-file-name "pubkey.asc" epg-tests-data-directory))) + (ert-resource-file "pubkey.asc"))) ,(if require-secret-key '(epg-import-keys-from-file context - (expand-file-name "seckey.asc" epg-tests-data-directory))) + (ert-resource-file "seckey.asc"))) (with-temp-buffer (make-local-variable 'epg-tests-context) (setq epg-tests-context context) diff --git a/test/data/themes/faces-test-dark-theme.el b/test/lisp/faces-resources/faces-test-dark-theme.el index a5e2ca43627..a5e2ca43627 100644 --- a/test/data/themes/faces-test-dark-theme.el +++ b/test/lisp/faces-resources/faces-test-dark-theme.el diff --git a/test/data/themes/faces-test-light-theme.el b/test/lisp/faces-resources/faces-test-light-theme.el index b2f7ec69742..b2f7ec69742 100644 --- a/test/data/themes/faces-test-light-theme.el +++ b/test/lisp/faces-resources/faces-test-light-theme.el diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el index 32dc1eea856..b19cef5decd 100644 --- a/test/lisp/faces-tests.el +++ b/test/lisp/faces-tests.el @@ -23,13 +23,9 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'faces) -(defvar faces--test-data-dir - (expand-file-name "../data/" - (file-name-directory (or load-file-name - buffer-file-name)))) - (defgroup faces--test nil "" :group 'faces--test) @@ -122,7 +118,7 @@ (should (equal (face-attribute 'spiff-changed-face :extend) t)) (should (equal (face-attribute 'spiff-added :extend) 'unspecified)) (should (equal (face-attribute 'spiff-file-header-face :extend) nil)) - (add-to-list 'custom-theme-load-path (concat faces--test-data-dir "themes")) + (add-to-list 'custom-theme-load-path (ert-resource-directory)) (load-theme 'faces-test-dark t t) (load-theme 'faces-test-light t t) (should (equal (face-attribute 'faces--test-inherit-extend :extend) diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index e8c12669c1a..ca8c10831fd 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -117,6 +117,12 @@ left alone when opening a URL in an external browser." t "C:\\temp\\program.log on Windows or /var/log/program.log on Unix.") "\\temp\\program.log"))) +(ert-deftest ffap-test-no-newlines () + (should-not + (with-temp-buffer + (save-excursion (insert "type=")) + (ffap-guess-file-name-at-point)))) + (provide 'ffap-tests) ;;; ffap-tests.el ends here diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 42d86ee1538..268c3185bc6 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -611,6 +613,7 @@ delivered." (ert-deftest file-notify-test03-events () "Check file creation/change/removal notifications." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -888,6 +891,7 @@ delivered." (ert-deftest file-notify-test04-autorevert () "Check autorevert via file notification." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) ;; `auto-revert-buffers' runs every 5". And we must wait, until the @@ -983,6 +987,7 @@ delivered." (ert-deftest file-notify-test05-file-validity () "Check `file-notify-valid-p' for files." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -1235,6 +1240,7 @@ delivered." (ert-deftest file-notify-test08-backup () "Check that backup keeps file notification." + :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) (unwind-protect diff --git a/test/data/files-bug18141.el.gz b/test/lisp/files-resources/files-bug18141.el.gz Binary files differindex 53d463e85b5..53d463e85b5 100644 --- a/test/data/files-bug18141.el.gz +++ b/test/lisp/files-resources/files-bug18141.el.gz diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 5b2f5fd6f0f..8818099a223 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'nadvice) (eval-when-compile (require 'cl-lib)) (require 'bytecomp) ; `byte-compiler-base-file-name'. @@ -151,7 +152,7 @@ form.") (should (file-test--do-local-variables-test str subtest))))))) (defvar files-test-bug-18141-file - (expand-file-name "data/files-bug18141.el.gz" (getenv "EMACS_TEST_DIRECTORY")) + (ert-resource-file "files-bug18141.el.gz") "Test file for bug#18141.") (ert-deftest files-tests-bug-18141 () @@ -959,7 +960,7 @@ unquoted file names." (let ((linkname (expand-file-name "link" nospecial-dir))) (should-error (make-symbolic-link tmpfile linkname)))))))) -;; See `files-tests--file-name-non-special--subprocess'. +;; See `files-tests-file-name-non-special--subprocess'. ;; (ert-deftest files-tests-file-name-non-special-process-file ()) (ert-deftest files-tests-file-name-non-special-rename-file () @@ -1103,7 +1104,7 @@ unquoted file names." (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (vc-registered nospecial) (vc-registered tmpfile))))) -;; See test `files-tests--file-name-non-special--buffers'. +;; See test `files-tests-file-name-non-special--buffers'. ;; (ert-deftest files-tests-file-name-non-special-verify-visited-file-modtime ()) (ert-deftest files-tests-file-name-non-special-write-region () @@ -1365,5 +1366,71 @@ See <https://debbugs.gnu.org/36401>." (should (equal (parse-colon-path "/foo//bar/baz") '("/foo/bar/baz/")))) +(ert-deftest files-test-magic-mode-alist-doctype () + "Test that DOCTYPE and variants put files in mhtml-mode." + (with-temp-buffer + (goto-char (point-min)) + (insert "<!DOCTYPE html>") + (normal-mode) + (should (eq major-mode 'mhtml-mode)) + (erase-buffer) + (insert "<!doctype html>") + (normal-mode) + (should (eq major-mode 'mhtml-mode)))) + +(defvar files-tests-lao "The Way that can be told of is not the eternal Way; +The name that can be named is not the eternal name. +The Nameless is the origin of Heaven and Earth; +The Named is the mother of all things. +Therefore let there always be non-being, + so we may see their subtlety, +And let there always be being, + so we may see their outcome. +The two are the same, +But after they are produced, + they have different names. +") + +(defvar files-tests-tzu "The Nameless is the origin of Heaven and Earth; +The named is the mother of all things. + +Therefore let there always be non-being, + so we may see their subtlety, +And let there always be being, + so we may see their outcome. +The two are the same, +But after they are produced, + they have different names. +They both may be called deep and profound. +Deeper and more profound, +The door of all subtleties! +") + +(ert-deftest files-tests-revert-buffer () + "Test that revert-buffer is successful." + (files-tests--with-temp-file temp-file-name + (with-temp-buffer + (insert files-tests-lao) + (write-file temp-file-name) + (erase-buffer) + (insert files-tests-tzu) + (revert-buffer t t t) + (should (compare-strings files-tests-lao nil nil + (buffer-substring (point-min) (point-max)) + nil nil))))) + +(ert-deftest files-tests-revert-buffer-with-fine-grain () + "Test that revert-buffer-with-fine-grain is successful." + (files-tests--with-temp-file temp-file-name + (with-temp-buffer + (insert files-tests-lao) + (write-file temp-file-name) + (erase-buffer) + (insert files-tests-tzu) + (should (revert-buffer-with-fine-grain t t)) + (should (compare-strings files-tests-lao nil nil + (buffer-substring (point-min) (point-max)) + nil nil))))) + (provide 'files-tests) ;;; files-tests.el ends here diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index d3ed4b5312c..9db198384d0 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -1,4 +1,4 @@ -;;; files-x-tests.el --- tests for files-x.el. +;;; files-x-tests.el --- tests for files-x.el. -*- lexical-binding: t -*- ;; Copyright (C) 2016-2020 Free Software Foundation, Inc. @@ -35,6 +35,7 @@ '((remote-null-device . "/dev/null"))) (defconst files-x-test--variables4 '((remote-null-device . "null"))) +(defvar remote-null-device) (put 'remote-shell-file-name 'safe-local-variable #'identity) (put 'remote-shell-command-switch 'safe-local-variable #'identity) (put 'remote-shell-interactive-switch 'safe-local-variable #'identity) diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el index be23c90af37..dd265b4fa97 100644 --- a/test/lisp/gnus/gnus-icalendar-tests.el +++ b/test/lisp/gnus/gnus-icalendar-tests.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2020 Free Software Foundation, Inc. -;; Author: Jan Tatarik <jtatarik@liveintent.com> +;; Author: Jan Tatarik <jan.tatarik@gmail.com> ;; Keywords: ;; This file is part of GNU Emacs. @@ -69,7 +69,7 @@ BEGIN:VEVENT DTSTART;TZID=America/New_York:20201208T090000 DTEND;TZID=America/New_York:20201208T100000 DTSTAMP:20200728T182853Z -ORGANIZER;CN=Company Events:mailto:liveintent.com_3bm6fh805bme9uoeliqcle1sa +ORGANIZER;CN=Company Events:mailto:anoncompany.com_3bm6fh805bme9uoeliqcle1sa g@group.calendar.google.com UID:iipdt88slddpeu7hheuu09sfmd@google.com X-MICROSOFT-CDO-OWNERAPPTID:-362490173 @@ -96,7 +96,7 @@ END:VCALENDAR (should (not (gnus-icalendar-event:recurring-p event))) (should (string= (gnus-icalendar-event:start event) "2020-12-08 15:00")) (with-slots (organizer summary description location end-time uid rsvp participation-type) event - (should (string= organizer "liveintent.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com")) + (should (string= organizer "anoncompany.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com")) (should (string= summary "Townhall | All Company Meeting")) (should (string= description "In this meeting, we will cover topics from product and engineering presentations and demos to new hire announcements to watching the late")) (should (string= location "New York-22-Town Hall Space (250) [Chrome Box]")) @@ -182,55 +182,78 @@ END:VCALENDAR" (list "Mark Hershberger")))) <2020-07-30 15:00-15:30 +1w>"))) (setenv "TZ" tz)))) +(ert-deftest gnus-icalendary-weekly-byday () + "" + (let ((tz (getenv "TZ")) + (event (gnus-icalendar-tests--get-ical-event "\ +BEGIN:VCALENDAR +PRODID:-//Google Inc//Google Calendar 70.9054//EN +VERSION:2.0 +CALSCALE:GREGORIAN +METHOD:REQUEST +BEGIN:VTIMEZONE +TZID:Europe/Berlin +X-LIC-LOCATION:Europe/Berlin +BEGIN:DAYLIGHT +TZOFFSETFROM:+0100 +TZOFFSETTO:+0200 +TZNAME:CEST +DTSTART:19700329T020000 +RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU +END:DAYLIGHT +BEGIN:STANDARD +TZOFFSETFROM:+0200 +TZOFFSETTO:+0100 +TZNAME:CET +DTSTART:19701025T030000 +RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU +END:STANDARD +END:VTIMEZONE +BEGIN:VEVENT +DTSTART;TZID=Europe/Berlin:20200915T140000 +DTEND;TZID=Europe/Berlin:20200915T143000 +RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE +DTSTAMP:20200915T120627Z +ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com +UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com +ATTENDEE;CUTYPE=INDIVIDUAL;ROLE=REQ-PARTICIPANT;PARTSTAT=ACCEPTED;RSVP=TRUE + ;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com +CREATED:20200325T095723Z +DESCRIPTION:Coffee talk +LAST-MODIFIED:20200915T120623Z +LOCATION: +SEQUENCE:0 +STATUS:CONFIRMED +SUMMARY:Casual coffee talk +TRANSP:OPAQUE +END:VEVENT +END:VCALENDAR" (list "participant@anoncompany.com")))) -;; (VCALENDAR nil -;; ((PRODID nil "Zimbra-Calendar-Provider") -;; (VERSION nil "2.0") -;; (METHOD nil "REQUEST")) -;; ((VTIMEZONE nil -;; ((TZID nil "America/New_York")) -;; ((STANDARD nil -;; ((DTSTART nil "16010101T020000") -;; (TZOFFSETTO nil "-0500") -;; (TZOFFSETFROM nil "-0400") -;; (RRULE nil "FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU") -;; (TZNAME nil "EST")) -;; nil) -;; (DAYLIGHT nil -;; ((DTSTART nil "16010101T020000") -;; (TZOFFSETTO nil "-0400") -;; (TZOFFSETFROM nil "-0500") -;; (RRULE nil "FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU") -;; (TZNAME nil "EDT")) -;; nil))) -;; (VEVENT nil -;; ((UID nil "903a5415-9067-4f63-b499-1b6205f49c88") -;; (RRULE nil "FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR") -;; (SUMMARY nil "appointment every weekday, start jul 24, 2020, end aug 24, 2020") -;; (ATTENDEE -;; (CN "Mark Hershberger" ROLE "REQ-PARTICIPANT" PARTSTAT "NEEDS-ACTION" CN "Mark A. Hershberger") -;; "mailto:mah <at> nichework.com") -;; (DTSTART -;; (TZID "America/New_York") -;; "20200724T090000") -;; (DTEND -;; (TZID "America/New_York") -;; "20200724T093000") -;; (STATUS nil "CONFIRMED") -;; (CLASS nil "PUBLIC") -;; (X-MICROSOFT-CDO-INTENDEDSTATUS nil "BUSY") -;; (TRANSP nil "OPAQUE") -;; (LAST-MODIFIED nil "20200719T150815Z") -;; (DTSTAMP nil "20200719T150815Z") -;; (SEQUENCE nil "0") -;; (DESCRIPTION nil "The following is a new meeting request:")) -;; ((VALARM nil -;; ((ACTION nil "DISPLAY") -;; (TRIGGER -;; (RELATED "START") -;; "-PT5M") -;; (DESCRIPTION nil "Reminder")) -;; nil))))) + (unwind-protect + (progn + ;; Use this form so as not to rely on system tz database. + ;; Eg hydra.nixos.org. + (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") + (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) + (should (gnus-icalendar-event:recurring-p event)) + (should (string= (gnus-icalendar-event:recurring-interval event) "1")) + (should (string= (gnus-icalendar-event:start event) "2020-09-15 14:00")) + (with-slots (organizer summary description location end-time uid rsvp participation-type) event + (should (string= organizer "anon@anoncompany.com")) + (should (string= summary "Casual coffee talk")) + (should (string= description "Coffee talk")) + (should (string= location "")) + (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-09-15 14:30")) + (should (string= uid "7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com")) + (should rsvp) + (should (eq participation-type 'required))) + (should (equal (sort (gnus-icalendar-event:recurring-days event) #'<) '(1 2 3 4 5))) + (should (string= (gnus-icalendar-event:org-timestamp event) "<2020-09-15 14:00-14:30 +1w> +<2020-09-16 14:00-14:30 +1w> +<2020-09-17 14:00-14:30 +1w> +<2020-09-18 14:00-14:30 +1w> +<2020-09-21 14:00-14:30 +1w>"))) + (setenv "TZ" tz)))) (provide 'gnus-icalendar-tests) ;;; gnus-icalendar-tests.el ends here diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index 7eadb0de716..5a5e66594fa 100644 --- a/test/lisp/gnus/gnus-util-tests.el +++ b/test/lisp/gnus/gnus-util-tests.el @@ -16,7 +16,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -25,6 +25,65 @@ (require 'ert) (require 'gnus-util) +(ert-deftest gnus-string> () + ;; Failure paths + (should-error (gnus-string> "" 1) + :type 'wrong-type-argument) + (should-error (gnus-string> "") + :type 'wrong-number-of-arguments) + + ;; String tests + (should (gnus-string> "def" "abc")) + (should (gnus-string> 'def 'abc)) + (should (gnus-string> "abc" "DEF")) + (should (gnus-string> "abc" 'DEF)) + (should (gnus-string> "αβγ" "abc")) + (should (gnus-string> "אבג" "αβγ")) + (should (gnus-string> nil "")) + (should (gnus-string> "abc" "")) + (should (gnus-string> "abc" "ab")) + (should-not (gnus-string> "abc" "abc")) + (should-not (gnus-string> "abc" "def")) + (should-not (gnus-string> "DEF" "abc")) + (should-not (gnus-string> 'DEF "abc")) + (should-not (gnus-string> "123" "abc")) + (should-not (gnus-string> "" ""))) + +(ert-deftest gnus-string< () + ;; Failure paths + (should-error (gnus-string< "" 1) + :type 'wrong-type-argument) + (should-error (gnus-string< "") + :type 'wrong-number-of-arguments) + + ;; String tests + (setq case-fold-search nil) + (should (gnus-string< "abc" "def")) + (should (gnus-string< 'abc 'def)) + (should (gnus-string< "DEF" "abc")) + (should (gnus-string< "DEF" 'abc)) + (should (gnus-string< "abc" "αβγ")) + (should (gnus-string< "αβγ" "אבג")) + (should (gnus-string< "" nil)) + (should (gnus-string< "" "abc")) + (should (gnus-string< "ab" "abc")) + (should-not (gnus-string< "abc" "abc")) + (should-not (gnus-string< "def" "abc")) + (should-not (gnus-string< "abc" "DEF")) + (should-not (gnus-string< "abc" 'DEF)) + (should-not (gnus-string< "abc" "123")) + (should-not (gnus-string< "" "")) + + ;; gnus-string< checks case-fold-search + (setq case-fold-search t) + (should (gnus-string< "abc" "DEF")) + (should (gnus-string< "abc" 'GHI)) + (should (gnus-string< 'abc "DEF")) + (should (gnus-string< 'GHI 'JKL)) + (should (gnus-string< "abc" "ΑΒΓ")) + (should-not (gnus-string< "ABC" "abc")) + (should-not (gnus-string< "def" "ABC"))) + (ert-deftest gnus-subsetp () ;; False for non-lists. (should-not (gnus-subsetp "1" "1")) @@ -73,4 +132,41 @@ (should (equal '("1") (gnus-setdiff '(2 "1" 2) '(2)))) (should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2))))) +(ert-deftest gnus-base64-repad () + (should-error (gnus-base64-repad 1) + :type 'wrong-type-argument) + + ;; RFC4648 test vectors + (should (equal "" (gnus-base64-repad ""))) + (should (equal "Zg==" (gnus-base64-repad "Zg=="))) + (should (equal "Zm8=" (gnus-base64-repad "Zm8="))) + (should (equal "Zm9v" (gnus-base64-repad "Zm9v"))) + (should (equal "Zm9vYg==" (gnus-base64-repad "Zm9vYg=="))) + (should (equal "Zm9vYmE=" (gnus-base64-repad "Zm9vYmE="))) + (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy"))) + + (should (equal "Zm8=" (gnus-base64-repad "Zm8"))) + (should (equal "Zg==" (gnus-base64-repad "Zg"))) + (should (equal "Zg==" (gnus-base64-repad "Zg===="))) + + (should-error (gnus-base64-repad " ") + :type 'error) + (should-error (gnus-base64-repad "Zg== ") + :type 'error) + (should-error (gnus-base64-repad "Z?\x00g==") + :type 'error) + ;; line-length + (should-error (gnus-base64-repad "Zg====" nil 4) + :type 'error) + ;; reject-newlines + (should-error (gnus-base64-repad "Zm9v\r\nYmFy" t) + :type 'error) + (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy" t))) + (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy"))) + (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n"))) + (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\n YmFy\r\n"))) + (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v \r\n\tYmFy"))) + (should-error (gnus-base64-repad "Zm9v\r\nYmFy" nil 3) + :type 'error)) + ;;; gnustest-gnus-util.el ends here diff --git a/test/data/mml-sec/.gpg-v21-migrated b/test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated index e69de29bb2d..e69de29bb2d 100644 --- a/test/data/mml-sec/.gpg-v21-migrated +++ b/test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated diff --git a/test/data/mml-sec/gpg-agent.conf b/test/lisp/gnus/mml-sec-resources/gpg-agent.conf index 20192990caf..20192990caf 100644 --- a/test/data/mml-sec/gpg-agent.conf +++ b/test/lisp/gnus/mml-sec-resources/gpg-agent.conf diff --git a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key Binary files differindex 58fd0b5edbc..58fd0b5edbc 100644 --- a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key diff --git a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key Binary files differindex 62f4ab25a69..62f4ab25a69 100644 --- a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key diff --git a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key Binary files differindex 2a8ce135fb2..2a8ce135fb2 100644 --- a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key diff --git a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key Binary files differindex 9f8de71c5e2..9f8de71c5e2 100644 --- a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key diff --git a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key Binary files differindex 6e4a4e548fd..6e4a4e548fd 100644 --- a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key diff --git a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key Binary files differindex cff58edaa89..cff58edaa89 100644 --- a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key diff --git a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key Binary files differindex 14af8662f79..14af8662f79 100644 --- a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key diff --git a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key Binary files differindex 207a7237d3a..207a7237d3a 100644 --- a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key diff --git a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key Binary files differindex 85ca78da04d..85ca78da04d 100644 --- a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key diff --git a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key Binary files differindex 79f3cd2b841..79f3cd2b841 100644 --- a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key diff --git a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key Binary files differindex 776ddf7e9e2..776ddf7e9e2 100644 --- a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key diff --git a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key Binary files differindex 2b464f0ccbe..2b464f0ccbe 100644 --- a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key diff --git a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key Binary files differindex 28a07668b21..28a07668b21 100644 --- a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key diff --git a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key Binary files differindex 137659693bd..137659693bd 100644 --- a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key diff --git a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key Binary files differindex c99824ccd43..c99824ccd43 100644 --- a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key diff --git a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key Binary files differindex 49c2dc58bd8..49c2dc58bd8 100644 --- a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key diff --git a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key Binary files differindex ca128408952..ca128408952 100644 --- a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key diff --git a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key Binary files differindex 3f14b40927a..3f14b40927a 100644 --- a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key diff --git a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key Binary files differindex 06adc06c427..06adc06c427 100644 --- a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key diff --git a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key Binary files differindex cf9a60d233b..cf9a60d233b 100644 --- a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key diff --git a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key Binary files differindex 0ed35172fe0..0ed35172fe0 100644 --- a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key diff --git a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key Binary files differindex 090059d9e81..090059d9e81 100644 --- a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key diff --git a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key Binary files differindex 9061f675121..9061f675121 100644 --- a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key diff --git a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key Binary files differindex 89f6013100d..89f6013100d 100644 --- a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key diff --git a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key Binary files differindex 41dac37574e..41dac37574e 100644 --- a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key diff --git a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key Binary files differindex 5df7b4a5953..5df7b4a5953 100644 --- a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key diff --git a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key Binary files differindex 03daf80975b..03daf80975b 100644 --- a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key diff --git a/test/data/mml-sec/pubring.gpg b/test/lisp/gnus/mml-sec-resources/pubring.gpg Binary files differindex 6bd169963df..6bd169963df 100644 --- a/test/data/mml-sec/pubring.gpg +++ b/test/lisp/gnus/mml-sec-resources/pubring.gpg diff --git a/test/data/mml-sec/pubring.kbx b/test/lisp/gnus/mml-sec-resources/pubring.kbx Binary files differindex 399a0414fd2..399a0414fd2 100644 --- a/test/data/mml-sec/pubring.kbx +++ b/test/lisp/gnus/mml-sec-resources/pubring.kbx diff --git a/test/data/mml-sec/secring.gpg b/test/lisp/gnus/mml-sec-resources/secring.gpg Binary files differindex b323c072c04..b323c072c04 100644 --- a/test/data/mml-sec/secring.gpg +++ b/test/lisp/gnus/mml-sec-resources/secring.gpg diff --git a/test/data/mml-sec/trustdb.gpg b/test/lisp/gnus/mml-sec-resources/trustdb.gpg Binary files differindex 09ebd8db114..09ebd8db114 100644 --- a/test/data/mml-sec/trustdb.gpg +++ b/test/lisp/gnus/mml-sec-resources/trustdb.gpg diff --git a/test/data/mml-sec/trustlist.txt b/test/lisp/gnus/mml-sec-resources/trustlist.txt index f886572d283..f886572d283 100644 --- a/test/data/mml-sec/trustlist.txt +++ b/test/lisp/gnus/mml-sec-resources/trustlist.txt diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 673fa6984a1..a6002b4d51e 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -1,5 +1,5 @@ -;;; gnustest-mml-sec.el --- Tests mml-sec.el, see README-mml-secure.txt. -;; Copyright (C) 2015 Free Software Foundation, Inc. +;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*- +;; Copyright (C) 2015, 2020 Free Software Foundation, Inc. ;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org> @@ -16,13 +16,14 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;;; Code: (require 'ert) +(require 'ert-x) (require 'message) (require 'epa) @@ -37,7 +38,10 @@ Mostly, the empty passphrase is used. However, the keys for as S/MIME).") (defun test-conf () - (ignore-errors (epg-find-configuration 'OpenPGP))) + ;; Emacs doesn't have support for finding the name of the PGP agent + ;; on MacOS, so disable the checks. + (and (not (eq system-type 'darwin)) + (ignore-errors (epg-find-configuration 'OpenPGP)))) (defun enc-standards () (if with-smime '(enc-pgp enc-pgp-mime enc-smime) @@ -51,6 +55,8 @@ Mostly, the empty passphrase is used. However, the keys for '(sign-pgp sign-pgp-mime sign-smime) '(sign-pgp sign-pgp-mime))) +(defvar mml-smime-use) + (defun mml-secure-test-fixture (body &optional interactive) "Setup GnuPG home containing test keys and prepare environment for BODY. If optional INTERACTIVE is non-nil, allow questions to the user in case of @@ -63,9 +69,7 @@ instead of gpg-agent." (let ((agent-info (getenv "GPG_AGENT_INFO")) (gpghome (getenv "GNUPGHOME"))) (condition-case error - (let ((epg-gpg-home-directory - (expand-file-name "test/data/mml-sec" source-directory)) - (mml-secure-allow-signing-with-unknown-recipient t) + (let ((epg-gpg-home-directory (ert-resource-directory)) (mml-smime-use 'epg) ;; Create debug output in empty epg-debug-buffer. (epg-debug t) @@ -80,7 +84,9 @@ instead of gpg-agent." ;; not look in the proper places otherwise, see: ;; https://bugs.gnupg.org/gnupg/issue2126 (setenv "GNUPGHOME" epg-gpg-home-directory) - (funcall body)) + (unwind-protect + (funcall body) + (mml-sec-test--kill-gpg-agent))) (error (setenv "GPG_AGENT_INFO" agent-info) (setenv "GNUPGHOME" gpghome) @@ -120,9 +126,9 @@ Subject: Test Pass optional INTERACTIVE to mml-secure-test-fixture." (mml-secure-test-fixture (lambda () - (let ((context (if (memq method '(enc-smime enc-sign-smime sign-smime)) - (epg-make-context 'CMS) - (epg-make-context 'OpenPGP))) + (let ((_context (if (memq method '(enc-smime enc-sign-smime sign-smime)) + (epg-make-context 'CMS) + (epg-make-context 'OpenPGP))) ;; Verify and decrypt by default. (mm-verify-option 'known) (mm-decrypt-option 'known) @@ -546,6 +552,10 @@ Pass optional INTERACTIVE to mml-secure-test-mail-fixture." )))))) interactive)) +(defvar mml-smime-cache-passphrase) +(defvar mml2015-cache-passphrase) +(defvar mml1991-cache-passphrase) + (defun mml-secure-test-en-decrypt-with-passphrase (method to from checksig jl-passphrase do-cache &optional enc-keys expectfail) @@ -562,7 +572,7 @@ If optional EXPECTFAIL is non-nil, a decryption failure is expected." (mml-smime-cache-passphrase do-cache) ) (cl-letf (((symbol-function 'read-passwd) - (lambda (prompt &optional confirm default) jl-passphrase))) + (lambda (_prompt &optional _confirm _default) jl-passphrase))) (mml-secure-test-en-decrypt method to from checksig t enc-keys expectfail) ))) @@ -754,37 +764,6 @@ Use sign-with-sender and encrypt-to-self." method "no-exp@example.org" "sub@example.org" 2 nil)) ))))) -(ert-deftest mml-secure-sign-verify-2 () - "Sign message without sender; then verify and test for expected result." - (skip-unless (test-conf)) - (mml-secure-test-key-fixture - (lambda () - (dolist (method (sign-standards) nil) - (let ((mml-secure-openpgp-sign-with-sender nil) - (mml-secure-smime-sign-with-sender nil)) - ;; A single signing key for sender sub@example.org is customized - ;; in the fixture, but not used here. - ;; By default, gpg uses the first secret key in the keyring, which - ;; is 02372A42CA6D40FB (OpenPGP) or - ;; 0E58229B80EE33959FF718FEEF25402B479DC6E2 (S/MIME) here. - (mml-secure-test-en-decrypt - method "uid1@example.org" "sub@example.org" 0 nil) - - ;; From sub@example.org, sign with specified key: - (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB")) - (mml-secure-smime-signers - '("D06AA118653CC38E9D0CAF56ED7A2135E1582177"))) - (mml-secure-test-en-decrypt - method "no-exp@example.org" "sub@example.org" 1 nil)) - - ;; From sub@example.org, sign with different specified key: - (let ((mml-secure-openpgp-signers '("C3999CF1268DBEA2")) - (mml-secure-smime-signers - '("0E58229B80EE33959FF718FEEF25402B479DC6E2"))) - (mml-secure-test-en-decrypt - method "no-exp@example.org" "sub@example.org" 1 nil)) - ))))) - (ert-deftest mml-secure-sign-verify-3 () "Try to sign message with expired OpenPGP subkey, which raises an error. With Ma Gnus v0.14 and earlier a signature would be created with a wrong key." @@ -820,7 +799,7 @@ In the first decryption this passphrase is hardcoded, in the second one it method "uid1@example.org" "sub@example.org" nil ;; Beware! For passphrases copy-sequence is necessary, as they may ;; be erased, which actually changes the function's code and causes - ;; multiple invokations to fail. I was surprised... + ;; multiple invocations to fail. I was surprised... (copy-sequence "Passphrase") t) (mml-secure-test-en-decrypt-with-passphrase method "uid1@example.org" "sub@example.org" nil @@ -897,4 +876,15 @@ So the second decryption fails." (let ((with-smime nil)) (ert-run-tests-batch))) -;;; gnustest-mml-sec.el ends here +(defun mml-sec-test--kill-gpg-agent () + (dolist (pid (list-system-processes)) + (let ((atts (process-attributes pid))) + (when (and (equal (cdr (assq 'user atts)) (user-login-name)) + (equal (cdr (assq 'comm atts)) "gpg-agent") + (string-match + (concat "homedir.*" + (regexp-quote (ert-resource-directory))) + (cdr (assq 'args atts)))) + (call-process "kill" nil nil nil (format "%d" pid)))))) + +;;; mml-sec-tests.el ends here diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index da2b49e6b84..bdd488de3f2 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -56,28 +56,28 @@ Return first line of the output of (describe-function-1 FUNC)." (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-macro () - (let ((regexp "a Lisp macro in .subr\\.el") + (let ((regexp "a Lisp macro in .+subr\\.el") (result (help-fns-tests--describe-function 'when))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defun () - (let ((regexp "a compiled Lisp function in .subr\\.el") + (let ((regexp "a compiled Lisp function in .+subr\\.el") (result (help-fns-tests--describe-function 'last))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defsubst () - (let ((regexp "a compiled Lisp function in .subr\\.el") + (let ((regexp "a compiled Lisp function in .+subr\\.el") (result (help-fns-tests--describe-function 'posn-window))) (should (string-match regexp result)))) (ert-deftest help-fns-test-alias-to-defun () - (let ((regexp "an alias for .set-file-modes. in .subr\\.el") + (let ((regexp "an alias for .set-file-modes. in .+subr\\.el") (result (help-fns-tests--describe-function 'chmod))) (should (string-match regexp result)))) (ert-deftest help-fns-test-bug23887 () "Test for https://debbugs.gnu.org/23887 ." - (let ((regexp "an alias for .re-search-forward. in .subr\\.el") + (let ((regexp "an alias for .re-search-forward. in .+subr\\.el") (result (help-fns-tests--describe-function 'search-forward-regexp))) (should (string-match regexp result)))) @@ -123,6 +123,9 @@ Return first line of the output of (describe-function-1 FUNC)." (goto-char (point-min)) (should (looking-at "^font-lock-comment-face is ")))) +(defvar foo-test-map) +(defvar help-fns-test--describe-keymap-foo) + ;;; Tests for describe-keymap (ert-deftest help-fns-test-find-keymap-name () diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 0862d1264c7..b6dffb2a405 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -3,6 +3,8 @@ ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Author: Juanma Barranquero <lekktu@gmail.com> +;; Eli Zaretskii <eliz@gnu.org> +;; Stefan Kangas <stefankangas@gmail.com> ;; Keywords: help, internal ;; This file is part of GNU Emacs. @@ -23,6 +25,7 @@ ;;; Code: (require 'ert) +(eval-when-compile (require 'cl-lib)) (ert-deftest help-split-fundoc-SECTION () "Test new optional arg SECTION." @@ -51,6 +54,333 @@ (should (equal (help-split-fundoc nil t 'usage) nil)) (should (equal (help-split-fundoc nil t 'doc) nil)))) + +;;; substitute-command-keys + +(defmacro with-substitute-command-keys-test (&rest body) + `(cl-flet* ((test + (lambda (orig result) + (should (equal-including-properties + (substitute-command-keys orig) + result)))) + (test-re + (lambda (orig regexp) + (should (string-match (concat "^" regexp "$") + (substitute-command-keys orig)))))) + ,@body)) + +(ert-deftest help-tests-substitute-command-keys/no-change () + (with-substitute-command-keys-test + (test "foo" "foo") + (test "\\invalid-escape" "\\invalid-escape"))) + +(ert-deftest help-tests-substitute-command-keys/commands () + (with-substitute-command-keys-test + (test "foo \\[goto-char]" "foo M-g c") + (test "\\[next-line]" "C-n") + (test "\\[next-line]\n\\[next-line]" "C-n\nC-n") + (test "\\[next-line]\\[previous-line]" "C-nC-p") + (test "\\[next-line]\\=\\[previous-line]" "C-n\\[previous-line]") + ;; Allow any style of quotes, since the terminal might not support + ;; UTF-8. Same thing is done below. + (test-re "\\[next-line]`foo'" "C-n[`'‘]foo['’]") + (test "\\[emacs-version]" "M-x emacs-version") + (test "\\[emacs-version]\\[next-line]" "M-x emacs-versionC-n") + (test-re "\\[emacs-version]`foo'" "M-x emacs-version[`'‘]foo['’]"))) + +(ert-deftest help-tests-substitute-command-keys/keymaps () + (with-substitute-command-keys-test + (test "\\{minibuffer-local-must-match-map}" + "\ +key binding +--- ------- + +C-g abort-recursive-edit +TAB minibuffer-complete +C-j minibuffer-complete-and-exit +RET minibuffer-complete-and-exit +ESC Prefix Command +SPC minibuffer-complete-word +? minibuffer-completion-help +<C-tab> file-cache-minibuffer-complete +<XF86Back> previous-history-element +<XF86Forward> next-history-element +<down> next-line-or-history-element +<next> next-history-element +<prior> switch-to-completions +<up> previous-line-or-history-element + +M-v switch-to-completions + +M-< minibuffer-beginning-of-buffer +M-n next-history-element +M-p previous-history-element +M-r previous-matching-history-element +M-s next-matching-history-element + +"))) + +(ert-deftest help-tests-substitute-command-keys/keymap-change () + (with-substitute-command-keys-test + (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g") + (test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x"))) + +(ert-deftest help-tests-substitute-command-keys/undefined-map () + (with-substitute-command-keys-test + (test-re "\\{foobar-map}" + "\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n"))) + +(ert-deftest help-tests-substitute-command-keys/quotes () + (with-substitute-command-keys-test + (let ((text-quoting-style 'curve)) + (test "quotes ‘like this’" "quotes ‘like this’") + (test "`x'" "‘x’") + (test "`" "‘") + (test "'" "’") + (test "\\`" "\\‘")) + (let ((text-quoting-style 'straight)) + (test "quotes `like this'" "quotes 'like this'") + (test "`x'" "'x'") + (test "`" "'") + (test "'" "'") + (test "\\`" "\\'")) + (let ((text-quoting-style 'grave)) + (test "quotes `like this'" "quotes `like this'") + (test "`x'" "`x'") + (test "`" "`") + (test "'" "'") + (test "\\`" "\\`")))) + +(ert-deftest help-tests-substitute-command-keys/literals () + (with-substitute-command-keys-test + (test "foo \\=\\[goto-char]" "foo \\[goto-char]") + (test "foo \\=\\=" "foo \\=") + (test "\\=\\=" "\\=") + (test "\\=\\[" "\\[") + (let ((text-quoting-style 'curve)) + (test "\\=`x\\='" "`x'")) + (let ((text-quoting-style 'straight)) + (test "\\=`x\\='" "`x'")) + (let ((text-quoting-style 'grave)) + (test "\\=`x\\='" "`x'")))) + +(ert-deftest help-tests-substitute-command-keys/no-change () + (with-substitute-command-keys-test + (test "\\[foobar" "\\[foobar") + (test "\\=" "\\="))) + +(ert-deftest help-tests-substitute-command-keys/multibyte () + ;; Cannot use string= here, as that compares unibyte and multibyte + ;; strings not equal. + (should (compare-strings + (substitute-command-keys "\200 \\[goto-char]") nil nil + "\200 M-g c" nil nil))) + +(ert-deftest help-tests-substitute-command-keys/apropos () + (save-window-excursion + (apropos "foo") + (switch-to-buffer "*Apropos*") + (goto-char (point-min)) + (should (looking-at "Type RET on")))) + +(defvar help-tests-major-mode-map + (let ((map (make-keymap))) + (define-key map "x" 'foo-original) + (define-key map "1" 'foo-range) + (define-key map "2" 'foo-range) + (define-key map "3" 'foo-range) + (define-key map "4" 'foo-range) + (define-key map (kbd "C-e") 'foo-something) + (define-key map '[F1] 'foo-function-key1) + (define-key map "(" 'short-range) + (define-key map ")" 'short-range) + (define-key map "a" 'foo-other-range) + (define-key map "b" 'foo-other-range) + (define-key map "c" 'foo-other-range) + map)) + +(define-derived-mode help-tests-major-mode nil + "Major mode for testing shadowing.") + +(defvar help-tests-minor-mode-map + (let ((map (make-keymap))) + (define-key map "x" 'foo-shadow) + (define-key map (kbd "C-e") 'foo-shadow) + map)) + +(define-minor-mode help-tests-minor-mode + "Minor mode for testing shadowing.") + +(ert-deftest help-tests-substitute-command-keys/test-mode () + (with-substitute-command-keys-test + (with-temp-buffer + (help-tests-major-mode) + (test "\\{help-tests-major-mode-map}" + "\ +key binding +--- ------- + +( .. ) short-range +1 .. 4 foo-range +a .. c foo-other-range + +C-e foo-something +x foo-original +<F1> foo-function-key1 + +")))) + +(ert-deftest help-tests-substitute-command-keys/shadow () + (with-substitute-command-keys-test + (with-temp-buffer + (help-tests-major-mode) + (help-tests-minor-mode) + (test "\\{help-tests-major-mode-map}" + "\ +key binding +--- ------- + +( .. ) short-range +1 .. 4 foo-range +a .. c foo-other-range + +C-e foo-something + (this binding is currently shadowed) +x foo-original + (this binding is currently shadowed) +<F1> foo-function-key1 + +")))) + +(ert-deftest help-tests-substitute-command-keys/command-remap () + (with-substitute-command-keys-test + (let ((help-tests-major-mode-map (make-keymap))) ; Protect from changes. + (with-temp-buffer + (help-tests-major-mode) + (define-key help-tests-major-mode-map [remap foo] 'bar) + (test "\\{help-tests-major-mode-map}" + "\ +key binding +--- ------- + +<remap> Prefix Command + +<remap> <foo> bar + +"))))) + +(ert-deftest help-tests-describe-map-tree/no-menu-t () + (with-temp-buffer + (let ((standard-output (current-buffer)) + (map '(keymap . ((1 . foo) + (menu-bar keymap + (foo menu-item "Foo" foo + :enable mark-active + :help "Help text")))))) + (describe-map-tree map nil nil nil nil t nil nil nil) + (should (equal (buffer-string) "key binding +--- ------- + +C-a foo + +"))))) + +(ert-deftest help-tests-describe-map-tree/no-menu-nil () + (with-temp-buffer + (let ((standard-output (current-buffer)) + (map '(keymap . ((1 . foo) + (menu-bar keymap + (foo menu-item "Foo" foo + :enable mark-active + :help "Help text")))))) + (describe-map-tree map nil nil nil nil nil nil nil nil) + (should (equal (buffer-string) "key binding +--- ------- + +C-a foo +<menu-bar> Prefix Command + +<menu-bar> <foo> foo + +"))))) + +(ert-deftest help-tests-describe-map-tree/mention-shadow-t () + (with-temp-buffer + (let ((standard-output (current-buffer)) + (map '(keymap . ((1 . foo) + (2 . bar)))) + (shadow-maps '((keymap . ((1 . baz)))))) + (describe-map-tree map t shadow-maps nil nil t nil nil t) + (should (equal (buffer-string) "key binding +--- ------- + +C-a foo + (this binding is currently shadowed) +C-b bar + +"))))) + +(ert-deftest help-tests-describe-map-tree/mention-shadow-nil () + (with-temp-buffer + (let ((standard-output (current-buffer)) + (map '(keymap . ((1 . foo) + (2 . bar)))) + (shadow-maps '((keymap . ((1 . baz)))))) + (describe-map-tree map t shadow-maps nil nil t nil nil nil) + (should (equal (buffer-string) "key binding +--- ------- + +C-b bar + +"))))) + +(ert-deftest help-tests-describe-map-tree/partial-t () + (with-temp-buffer + (let ((standard-output (current-buffer)) + (map '(keymap . ((1 . foo) + (2 . undefined))))) + (describe-map-tree map t nil nil nil nil nil nil nil) + (should (equal (buffer-string) "key binding +--- ------- + +C-a foo + +"))))) + +(ert-deftest help-tests-describe-map-tree/partial-nil () + (with-temp-buffer + (let ((standard-output (current-buffer)) + (map '(keymap . ((1 . foo) + (2 . undefined))))) + (describe-map-tree map nil nil nil nil nil nil nil nil) + (should (equal (buffer-string) "key binding +--- ------- + +C-a foo +C-b undefined + +"))))) + +(defvar help-tests--was-in-buffer nil) + +(ert-deftest help-substitute-command-keys/menu-filter-in-correct-buffer () + "Evaluate menu-filter in the original buffer. See Bug#39149." + (unwind-protect + (progn + (define-key global-map (kbd "C-c C-l r") + `(menu-item "2" identity + :filter ,(lambda (cmd) + (setq help-tests--was-in-buffer + (current-buffer)) + cmd))) + (with-temp-buffer + (substitute-command-keys "\\[identity]") + (should (eq help-tests--was-in-buffer + (current-buffer))))) + (setq help-tests--was-in-buffer nil) + (define-key global-map (kbd "C-c C-l r") nil) + (define-key global-map (kbd "C-c C-l") nil))) + (provide 'help-tests) ;;; help-tests.el ends here diff --git a/test/lisp/hfy-cmap-resources/rgb.txt b/test/lisp/hfy-cmap-resources/rgb.txt new file mode 100644 index 00000000000..86a00539909 --- /dev/null +++ b/test/lisp/hfy-cmap-resources/rgb.txt @@ -0,0 +1,3 @@ +255 250 250 snow +248 248 255 ghost white +248 248 255 GhostWhite diff --git a/test/lisp/hfy-cmap-tests.el b/test/lisp/hfy-cmap-tests.el new file mode 100644 index 00000000000..4cdc6ffc827 --- /dev/null +++ b/test/lisp/hfy-cmap-tests.el @@ -0,0 +1,55 @@ +;;; hfy-cmap-tests.el --- tests for hfy-cmap.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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 'ert-x) +(require 'hfy-cmap) + +(defconst hfy-cmap-tests--data + (concat "255 250 250 snow\n" + "248 248 255 ghost white\n" + "248 248 255 GhostWhite\n")) + +(defconst hfy-cmap-tests--parsed + '(("GhostWhite" 248 248 255) + ("ghost white" 248 248 255) + ("snow" 255 250 250))) + +(ert-deftest test-hfy-cmap--parse-buffer () + (with-temp-buffer + (insert hfy-cmap-tests--data) + (should (equal (hfy-cmap--parse-buffer (current-buffer)) + hfy-cmap-tests--parsed)))) + +(ert-deftest test-htmlfontify-load-rgb-file () + :tags '(:expensive-test) + (let (hfy-rgb-txt-color-map) + (htmlfontify-load-rgb-file (ert-resource-file "rgb.txt")) + (should (equal hfy-rgb-txt-color-map + hfy-cmap-tests--parsed)))) + +(ert-deftest test-htmlfontify-load-rgb-file/non-existent-file () + (let (hfy-rgb-txt-color-map) + (htmlfontify-load-rgb-file "/non/existent/file") + (should-not hfy-rgb-txt-color-map))) + +(provide 'hfy-cmap-tests) +;;; hfy-cmap-tests.el ends here diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 5f8e653d7c2..9520d9d8633 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -23,6 +23,8 @@ ;;; Code: +(require 'ert-x) ;For `ert-run-keys'. + (ert-deftest find-auto-coding--bug27391 () "Check that Bug#27391 is fixed." (with-temp-buffer @@ -41,12 +43,11 @@ (should (not (multibyte-string-p (encode-coding-char ?a 'utf-8))))) (ert-deftest mule-cmds--test-universal-coding-system-argument () - (skip-unless (not noninteractive)) (should (equal "ccccccccccccccccab" - (let ((enable-recursive-minibuffers t) - (unread-command-events - (append (kbd "C-x RET c u t f - 8 RET C-u C-u c a b RET") nil))) - (read-string "prompt:"))))) + (let ((enable-recursive-minibuffers t)) + (ert-simulate-keys + (kbd "C-x RET c u t f - 8 RET C-u C-u c a b RET") + (read-string "prompt:")))))) (ert-deftest mule-utf-7 () ;; utf-7 and utf-7-imap are not ASCII-compatible. diff --git a/test/lisp/international/mule-util-tests.el b/test/lisp/international/mule-util-tests.el index cc199bd4972..0524dad88da 100644 --- a/test/lisp/international/mule-util-tests.el +++ b/test/lisp/international/mule-util-tests.el @@ -75,8 +75,9 @@ (eval `(ert-deftest ,testname () ,testdoc - (should (equal (apply 'truncate-string-to-width ',(car testdata)) - ,(cdr testdata))))))) + (let ((truncate-string-ellipsis "...")) + (should (equal (apply 'truncate-string-to-width ',(car testdata)) + ,(cdr testdata)))))))) (dotimes (i (length mule-util-test-truncate-data)) (mule-util-test-truncate-create i)) diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index 168a2c950cf..1ef83daed24 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -167,7 +167,7 @@ (ert-deftest deferred-action-toolate () :tags '(:expensive-test) - "Deferred request fails because noone clears the flag." + "Deferred request fails because no one clears the flag." (jsonrpc--with-emacsrpc-fixture (conn) (should-error (jsonrpc-request conn '+ [1 2] diff --git a/test/lisp/mail/rfc822-tests.el b/test/lisp/mail/rfc822-tests.el new file mode 100644 index 00000000000..d13966c59cc --- /dev/null +++ b/test/lisp/mail/rfc822-tests.el @@ -0,0 +1,83 @@ +;;; rfc822-tests.el --- Tests for rfc822.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'rfc822) + +(defmacro rfc822-tests-deftest (email desc &optional valid) + `(ert-deftest ,(intern (format "rfc822-email-%s-%s" + (if valid "valid" "invalid") + desc)) () + (if ,valid + (should (equal (rfc822-addresses ,email) (list ,email))) + (let ((addresses (rfc822-addresses ,email))) + ;; `rfc822-addresses' returns a string if parsing fails. + (while (and (consp addresses) + (not (eq (string-to-char (car addresses)) ?\())) + (setq addresses (cdr addresses))) + ;; Found saved error. + (should (= (length addresses) 1)))))) + +;;;; Valid emails + +(rfc822-tests-deftest "email@example.org" "email" t) +(rfc822-tests-deftest "firstname.lastname@example.org" "dot-in-address" t) +(rfc822-tests-deftest "email@subdomain.example.org" "dot-in-subdomain" t) +(rfc822-tests-deftest "firstname+lastname@example.org" "contains-plus-sign" t) +(rfc822-tests-deftest "email@123.123.123.123" "domain-valid-ip" t) +(rfc822-tests-deftest "email@[123.123.123.123]" "domain-valid-ip-square-bracket" t) +(rfc822-tests-deftest "\"email\"@example.org" "quotes-around-email" t) +(rfc822-tests-deftest "1234567890@example.org" "digits-in-address" t) +(rfc822-tests-deftest "email@example-one.com" "dash-in-domain-name" t) +(rfc822-tests-deftest "_______@example.org" "underscore-in-address" t) +(rfc822-tests-deftest "email@example.name" "dotname-tld" t) +(rfc822-tests-deftest "email@example.co.jp" "dot-in-tld" t) +(rfc822-tests-deftest "firstname-lastname@example.org" "dash-in-address" t) +(rfc822-tests-deftest "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghiklm@example.org" "address-long" t) + +;;;; Invalid emails + +(rfc822-tests-deftest "#@%^%#$@#$@#.com" "garbage") +(rfc822-tests-deftest "@example.org" "missing-username") +(rfc822-tests-deftest "email@example@example.org" "two-at-signs") +(rfc822-tests-deftest ".email@example.org" "address-leading-dot") +(rfc822-tests-deftest "email.@example.org" "address-trailing-dot") +(rfc822-tests-deftest "email..email@example.org" "address-multiple-dots") +(rfc822-tests-deftest "email@example..org" "domain-multiple-dots") +(rfc822-tests-deftest "email@example.org." "domain-trailing-dot") +(rfc822-tests-deftest "email@.example.org" "domain-leading-dot") +(rfc822-tests-deftest "test\\@test@example.org" "address-escaped-at-sign") + +;; FIXME: Should these fail? +;; (rfc822-tests-deftest "plainaddress" "missing-at-sign-and-domain") +;; (rfc822-tests-deftest "email@example.org (J. Random Hacker)" "text-following-email") +;; (rfc822-tests-deftest "email@-example.org" "leading-dash-in-domain-is-invalid") +;; (rfc822-tests-deftest "email@example-.org" "trailing-dash-in-domain-is-invalid") +;; (rfc822-tests-deftest "あいうえお@example.org" "address-unicode-chars") +;; (rfc822-tests-deftest "email.example.org" "missing-at") +;; (rfc822-tests-deftest "email@111.222.333.44444" "invalid-IP-format") +;; (rfc822-tests-deftest "email@domain" "missing-top-level-domain") +;; (rfc822-tests-deftest "email@domain.web" ".web-is-not-a-valid-top-level-domain") + +(provide 'rfc822-tests) +;;; rfc822-tests.el ends here diff --git a/test/lisp/mail/uudecode-tests.el b/test/lisp/mail/uudecode-tests.el index 61c20075633..17566250a92 100644 --- a/test/lisp/mail/uudecode-tests.el +++ b/test/lisp/mail/uudecode-tests.el @@ -24,15 +24,9 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'uudecode) -(defvar uudecode-tests-data-dir - (file-truename - (expand-file-name "uudecode-resources/" - (file-name-directory (or load-file-name - buffer-file-name)))) - "Base directory of uudecode-tests.el test data files.") - (defun uudecode-tests-read-file (file) "Read contents of FILE and return as string." (with-temp-buffer @@ -40,15 +34,13 @@ (buffer-string))) (defvar uudecode-tests-encoded-str - (uudecode-tests-read-file - (expand-file-name "uuencoded.txt" uudecode-tests-data-dir)) + (uudecode-tests-read-file (ert-resource-file "uuencoded.txt")) "Uuencoded data for bookmark-tests.el -Same as `bookmark-tests-decoded-str' but uuencoded.") +Same as `uudecode-tests-decoded-str' but uuencoded.") (defvar uudecode-tests-decoded-str - (uudecode-tests-read-file - (expand-file-name "uudecoded.txt" uudecode-tests-data-dir)) + (uudecode-tests-read-file (ert-resource-file "uudecoded.txt")) "Plain text data for bookmark-tests.el -Same as `bookmark-tests-encoded-str' but plain text.") +Same as `uudecode-tests-encoded-str' but plain text.") (ert-deftest uudecode-tests-decode-region-internal () ;; Write to buffer diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index 8267d8e4f6a..ddf22ecd404 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -44,7 +44,7 @@ sinl [sin] (3) - sine function" sin(3), sinf(3), sinl(3) - sine functions" . (#("sin(3)" 0 6 (help-echo "sine functions")) #("sinf(3)" 0 7 (help-echo "sine functions")) #("sinl(3)" 0 7 (help-echo "sine functions")))) ;; SunOS, Solaris - ;; http://docs.oracle.com/cd/E19455-01/805-6331/usradm-7/index.html + ;; https://docs.oracle.com/cd/E19455-01/805-6331/usradm-7/index.html ;; SunOS 4 ("\ tset, reset (1) - establish or restore terminal characteristics" @@ -61,7 +61,7 @@ cawf, nroff (1) - C version of the nroff-like, Amazingly Workable (text) Formatt whatis (5) - database of online manual pages" . (#("cawf(1)" 0 7 (help-echo "C version of the nroff-like, Amazingly Workable (text) Formatter")) #("nroff(1)" 0 8 (help-echo "C version of the nroff-like, Amazingly Workable (text) Formatter")) #("whatis(5)" 0 9 (help-echo "database of online manual pages")))) ;; HP-UX - ;; http://docstore.mik.ua/manuals/hp-ux/en/B2355-60130/man.1.html + ;; https://docstore.mik.ua/manuals/hp-ux/en/B2355-60130/man.1.html ;; Assuming that the line break in the zgrep description was ;; introduced by the man page formatting. ("\ diff --git a/test/data/minibuffer-test-cttq$tion b/test/lisp/minibuffer-resources/data/minibuffer-test-cttq$tion index e69de29bb2d..e69de29bb2d 100644 --- a/test/data/minibuffer-test-cttq$tion +++ b/test/lisp/minibuffer-resources/data/minibuffer-test-cttq$tion diff --git a/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest-c.test b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest-c.test new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest-c.test diff --git a/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest.test b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest.test new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest.test diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 5da86f36148..32734794413 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -26,6 +26,9 @@ ;;; Code: +(require 'ert) +(require 'ert-x) + (eval-when-compile (require 'cl-lib)) (ert-deftest completion-test1 () @@ -85,7 +88,7 @@ (ert-deftest completion-table-test-quoting () (let ((process-environment `("CTTQ1=ed" "CTTQ2=et/" ,@process-environment)) - (default-directory (expand-file-name "test" source-directory))) + (default-directory (ert-resource-directory))) (pcase-dolist (`(,input ,output) '( ;; Test that $ in files is properly $$ quoted. diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el index fd998fd4f0e..315f25edae8 100644 --- a/test/lisp/mwheel-tests.el +++ b/test/lisp/mwheel-tests.el @@ -24,9 +24,9 @@ (ert-deftest mwheel-test-enable/disable () (mouse-wheel-mode 1) - (should (eq (lookup-key (current-global-map) '[mouse-4]) 'mwheel-scroll)) + (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event]) 'mwheel-scroll)) (mouse-wheel-mode -1) - (should (eq (lookup-key (current-global-map) '[mouse-4]) nil))) + (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event]) nil))) (ert-deftest mwheel-test--create-scroll-keys () (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-4) diff --git a/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml new file mode 100644 index 00000000000..620f10510f2 --- /dev/null +++ b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml @@ -0,0 +1,49 @@ +<?xml version="1.0"?> +<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN" "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd"> +<node> + <interface name="org.freedesktop.DBus.Introspectable"> + <method name="Introspect"> + <arg name="xml" type="s" direction="out"/> + </method> + </interface> + <interface name="org.freedesktop.DBus.Properties"> + <method name="Get"> + <arg name="interface" type="s" direction="in"/> + <arg name="name" type="s" direction="in"/> + <arg name="value" type="v" direction="out"/> + </method> + <method name="Set"> + <arg name="interface" type="s" direction="in"/> + <arg name="name" type="s" direction="in"/> + <arg name="value" type="v" direction="in"/> + </method> + <method name="GetAll"> + <arg name="interface" type="s" direction="in"/> + <arg name="properties" type="a{sv}" direction="out"/> + </method> + <signal name="PropertiesChanged"> + <arg name="interface" type="s"/> + <arg name="changed_properties" type="a{sv}"/> + <arg name="invalidated_properties" type="as"/> + </signal> + </interface> + <interface name="org.gnu.Emacs.TestDBus.Interface"> + <method name="Connect"> + <arg name="uuid" type="s" direction="in"/> + <arg name="mode" type="y" direction="in"/> + <arg name="options" type="a{sv}" direction="in"/> + <arg name="interface" type="s" direction="out"/> + </method> + <method name="DeprecatedMethod0"> + <annotation name="org.freedesktop.DBus.Deprecated" value="true"/> + </method> + <method name="DeprecatedMethod1"> + <annotation name="org.freedesktop.DBus.Deprecated" value="true"/> + </method> + <property name="Connected" type="b" access="read"/> + <property name="Player" type="o" access="read"/> + <annotation name="org.freedesktop.DBus.Deprecated" value="true"/> + </interface> + <node name="node0"/> + <node name="node1"/> +</node> diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 45c98513653..3cfb4b7d9e7 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -4,37 +4,49 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: (require 'ert) +(require 'ert-x) (require 'dbus) (defvar dbus-debug nil) (declare-function dbus-get-unique-name "dbusbind.c" (bus)) -(defvar dbus--test-enabled-session-bus +(defconst dbus--test-enabled-session-bus (and (featurep 'dbusbind) (dbus-ignore-errors (dbus-get-unique-name :session))) "Check, whether we are registered at the session bus.") -(defvar dbus--test-enabled-system-bus +(defconst dbus--test-enabled-system-bus (and (featurep 'dbusbind) (dbus-ignore-errors (dbus-get-unique-name :system))) "Check, whether we are registered at the system bus.") +(defconst dbus--test-service "org.gnu.Emacs.TestDBus" + "Test service.") + +(defconst dbus--test-path "/org/gnu/Emacs/TestDBus" + "Test object path.") + +(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface" + "Test interface.") + (defun dbus--test-availability (bus) "Test availability of D-Bus BUS." (should (dbus-list-names bus)) @@ -54,6 +66,8 @@ (ert-deftest dbus-test01-type-conversion () "Check type conversion functions." + (skip-unless dbus--test-enabled-session-bus) + (let ((ustr "0123abc_xyz\x01\xff") (mstr "Grüß Göttin")) (should @@ -82,31 +96,391 @@ (string-equal (dbus-unescape-from-identifier (dbus-escape-as-identifier mstr)) mstr)))) +(ert-deftest dbus-test01-basic-types () + "Check basic D-Bus type arguments." + (skip-unless dbus--test-enabled-session-bus) + + ;; No argument or unknown keyword. + (should-error + (dbus-check-arguments :session dbus--test-service) + :type 'wrong-number-of-arguments) + (should-error + (dbus-check-arguments :session dbus--test-service :keyword) + :type 'wrong-type-argument) + + ;; `:string'. + (should (dbus-check-arguments :session dbus--test-service "string")) + (should (dbus-check-arguments :session dbus--test-service :string "string")) + (should-error + (dbus-check-arguments :session dbus--test-service :string) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :string 0.5) + :type 'wrong-type-argument) + + ;; `:object-path'. + (should + (dbus-check-arguments + :session dbus--test-service :object-path "/object/path")) + (should-error + (dbus-check-arguments :session dbus--test-service :object-path) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :object-path "string") + :type 'dbus-error) + (should-error + (dbus-check-arguments :session dbus--test-service :object-path 0.5) + :type 'wrong-type-argument) + + ;; `:signature'. + (should (dbus-check-arguments :session dbus--test-service :signature "as")) + (should-error + (dbus-check-arguments :session dbus--test-service :signature) + :type 'wrong-type-argument) + ;; Raises an error on stderr. + (should-error + (dbus-check-arguments :session dbus--test-service :signature "string") + :type 'dbus-error) + (should-error + (dbus-check-arguments :session dbus--test-service :signature 0.5) + :type 'wrong-type-argument) + + ;; `:boolean'. + (should (dbus-check-arguments :session dbus--test-service nil)) + (should (dbus-check-arguments :session dbus--test-service t)) + (should (dbus-check-arguments :session dbus--test-service :boolean nil)) + (should (dbus-check-arguments :session dbus--test-service :boolean t)) + (should (dbus-check-arguments :session dbus--test-service :boolean 'whatever)) + (should-error + (dbus-check-arguments :session dbus--test-service :boolean) + :type 'wrong-type-argument) + + ;; `:byte'. + (should (dbus-check-arguments :session dbus--test-service :byte 0)) + ;; Only the least significant byte is taken into account. + (should + (dbus-check-arguments :session dbus--test-service :byte most-positive-fixnum)) + (should-error + (dbus-check-arguments :session dbus--test-service :byte) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :byte -1) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :byte 0.5) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :byte "string") + :type 'wrong-type-argument) + + ;; `:int16'. + (should (dbus-check-arguments :session dbus--test-service :int16 0)) + (should (dbus-check-arguments :session dbus--test-service :int16 #x7fff)) + (should (dbus-check-arguments :session dbus--test-service :int16 #x-8000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int16) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 #x8000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 #x-8001) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 0.5) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 "string") + :type 'wrong-type-argument) + + ;; `:uint16'. + (should (dbus-check-arguments :session dbus--test-service :uint16 0)) + (should (dbus-check-arguments :session dbus--test-service :uint16 #xffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 #x10000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 -1) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 0.5) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 "string") + :type 'wrong-type-argument) + + ;; `:int32'. + (should (dbus-check-arguments :session dbus--test-service :int32 0)) + (should (dbus-check-arguments :session dbus--test-service :int32 #x7fffffff)) + (should (dbus-check-arguments :session dbus--test-service :int32 #x-80000000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int32) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 #x80000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 #x-80000001) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 "string") + :type 'wrong-type-argument) + + ;; `:uint32'. + (should (dbus-check-arguments :session dbus--test-service 0)) + (should (dbus-check-arguments :session dbus--test-service :uint32 0)) + (should (dbus-check-arguments :session dbus--test-service :uint32 #xffffffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 #x100000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 -1) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 "string") + :type 'wrong-type-argument) + + ;; `:int64'. + (should (dbus-check-arguments :session dbus--test-service :int64 0)) + (should + (dbus-check-arguments :session dbus--test-service :int64 #x7fffffffffffffff)) + (should + (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int64) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000001) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 "string") + :type 'wrong-type-argument) + + ;; `:uint64'. + (should (dbus-check-arguments :session dbus--test-service :uint64 0)) + (should + (dbus-check-arguments :session dbus--test-service :uint64 #xffffffffffffffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 #x10000000000000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 -1) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 "string") + :type 'wrong-type-argument) + + ;; `:double'. + (should (dbus-check-arguments :session dbus--test-service :double 0)) + (should (dbus-check-arguments :session dbus--test-service :double 0.5)) + (should (dbus-check-arguments :session dbus--test-service :double -0.5)) + (should (dbus-check-arguments :session dbus--test-service :double -1)) + ;; Shall both be supported? + (should (dbus-check-arguments :session dbus--test-service :double 1.0e+INF)) + (should (dbus-check-arguments :session dbus--test-service :double 0.0e+NaN)) + (should-error + (dbus-check-arguments :session dbus--test-service :double) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :double "string") + :type 'wrong-type-argument) + + ;; `:unix-fd'. UNIX file descriptors are transferred out-of-band. + ;; We do not support this, and so we cannot do much testing here for + ;; `:unix-fd' being an argument (which is an index to the file + ;; descriptor in the array of file descriptors that accompany the + ;; D-Bus message). Mainly testing, that values out of `:uint32' + ;; type range fail. + (should (dbus-check-arguments :session dbus--test-service :unix-fd 0)) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd -1) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd "string") + :type 'wrong-type-argument)) + +(ert-deftest dbus-test01-compound-types () + "Check basic D-Bus type arguments." + (skip-unless dbus--test-enabled-session-bus) + + ;; `:array'. It contains several elements of the same type. + (should (dbus-check-arguments :session dbus--test-service '("string"))) + (should (dbus-check-arguments :session dbus--test-service '(:array "string"))) + (should + (dbus-check-arguments :session dbus--test-service '(:array :string "string"))) + (should + (dbus-check-arguments + :session dbus--test-service '(:array :string "string1" "string2"))) + (should + (dbus-check-arguments + :session dbus--test-service '(:array :signature "s" :signature "ao"))) + ;; Empty array (of strings). + (should (dbus-check-arguments :session dbus--test-service '(:array))) + ;; Empty array (of object paths). + (should + (dbus-check-arguments :session dbus--test-service '(:array :signature "o"))) + ;; Different element types. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:array :string "string" :object-path "/object/path")) + :type 'wrong-type-argument) + ;; Different variant types in array don't matter. + (should + (dbus-check-arguments + :session dbus--test-service + '(:array + (:variant :string "string1") + (:variant (:struct :string "string2" :object-path "/object/path"))))) + + ;; `:variant'. It contains exactly one element. + (should + (dbus-check-arguments + :session dbus--test-service '(:variant :string "string"))) + (should + (dbus-check-arguments + :session dbus--test-service '(:variant (:array "string")))) + ;; Empty variant. + (should-error + (dbus-check-arguments :session dbus--test-service '(:variant)) + :type 'wrong-type-argument) + ;; More than one element. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:variant :string "string" :object-path "/object/path")) + :type 'wrong-type-argument) + + ;; `:dict-entry'. It must contain two elements; the first one must + ;; be of a basic type. It must be an element of an array. + (should + (dbus-check-arguments + :session dbus--test-service + '(:array (:dict-entry :string "string" :boolean nil)))) + ;; This is an alternative syntax. + (should + (dbus-check-arguments + :session dbus--test-service + '(:array :dict-entry (:string "string" :boolean t)))) + ;; Empty dict-entry. + (should-error + (dbus-check-arguments + :session dbus--test-service '(:array (:dict-entry))) + :type 'wrong-type-argument) + ;; One element. + (should-error + (dbus-check-arguments + :session dbus--test-service '(:array (:dict-entry :string "string"))) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments + :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. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:array (:dict-entry (:array :string "string") :boolean t))) + :type 'wrong-type-argument) + ;; It is not an element of an array. + (should-error + (dbus-check-arguments + :session dbus--test-service '(:dict-entry :string "string" :boolean t)) + :type 'wrong-type-argument) + ;; Different dict entry types in array. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:array + (:dict-entry :string "string1" :boolean t) + (:dict-entry :string "string2" :object-path "/object/path"))) + :type 'wrong-type-argument) + + ;; `:struct'. There is no restriction what could be an element of a struct. + (should + (dbus-check-arguments + :session dbus--test-service + '(:struct + :string "string" + :object-path "/object/path" + (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4))))) + ;; Empty struct. + (should-error + (dbus-check-arguments :session dbus--test-service '(:struct)) + :type 'wrong-type-argument) + ;; Different struct types in array. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:array + (:struct :string "string1" :boolean t) + (:struct :object-path "/object/path"))) + :type 'wrong-type-argument)) + (defun dbus--test-register-service (bus) "Check service registration at BUS." ;; Cleanup. - (dbus-ignore-errors (dbus-unregister-service bus dbus-service-emacs)) + (dbus-ignore-errors (dbus-unregister-service bus dbus--test-service)) ;; Register an own service. - (should (eq (dbus-register-service bus dbus-service-emacs) :primary-owner)) - (should (member dbus-service-emacs (dbus-list-known-names bus))) - (should (eq (dbus-register-service bus dbus-service-emacs) :already-owner)) - (should (member dbus-service-emacs (dbus-list-known-names bus))) + (should (eq (dbus-register-service bus dbus--test-service) :primary-owner)) + (should (member dbus--test-service (dbus-list-known-names bus))) + (should (eq (dbus-register-service bus dbus--test-service) :already-owner)) + (should (member dbus--test-service (dbus-list-known-names bus))) ;; Unregister the service. - (should (eq (dbus-unregister-service bus dbus-service-emacs) :released)) - (should-not (member dbus-service-emacs (dbus-list-known-names bus))) - (should (eq (dbus-unregister-service bus dbus-service-emacs) :non-existent)) - (should-not (member dbus-service-emacs (dbus-list-known-names bus))) + (should (eq (dbus-unregister-service bus dbus--test-service) :released)) + (should-not (member dbus--test-service (dbus-list-known-names bus))) + (should (eq (dbus-unregister-service bus dbus--test-service) :non-existent)) + (should-not (member dbus--test-service (dbus-list-known-names bus))) ;; `dbus-service-dbus' is reserved for the BUS itself. - (should-error (dbus-register-service bus dbus-service-dbus)) - (should-error (dbus-unregister-service bus dbus-service-dbus))) + (should + (equal + (butlast + (should-error (dbus-register-service bus dbus-service-dbus))) + `(dbus-error ,dbus-error-invalid-args))) + (should + (equal + (butlast + (should-error (dbus-unregister-service bus dbus-service-dbus))) + `(dbus-error ,dbus-error-invalid-args)))) (ert-deftest dbus-test02-register-service-session () "Check service registration at `:session' bus." (skip-unless (and dbus--test-enabled-session-bus - (dbus-register-service :session dbus-service-emacs))) + (dbus-register-service :session dbus--test-service))) (dbus--test-register-service :session) (let ((service "org.freedesktop.Notifications")) @@ -124,7 +498,7 @@ (ert-deftest dbus-test02-register-service-system () "Check service registration at `:system' bus." (skip-unless (and dbus--test-enabled-system-bus - (dbus-register-service :system dbus-service-emacs))) + (dbus-register-service :system dbus--test-service))) (dbus--test-register-service :system)) (ert-deftest dbus-test02-register-service-own-bus () @@ -148,7 +522,7 @@ This includes initialization and closing the bus." (featurep 'dbusbind) (dbus-init-bus bus) (dbus-get-unique-name bus) - (dbus-register-service bus dbus-service-emacs)))) + (dbus-register-service bus dbus--test-service)))) ;; Run the test. (dbus--test-register-service bus)) @@ -159,19 +533,1466 @@ This includes initialization and closing the bus." "Check `dbus-interface-peer' methods." (skip-unless (and dbus--test-enabled-session-bus - (dbus-register-service :session dbus-service-emacs) + (dbus-register-service :session dbus--test-service) ;; "GetMachineId" is not implemented (yet). When it returns a ;; value, another D-Bus client like dbus-monitor is reacting ;; on `dbus-interface-peer'. We cannot test then. (not (dbus-ignore-errors (dbus-call-method - :session dbus-service-emacs dbus-path-dbus + :session dbus--test-service dbus-path-dbus dbus-interface-peer "GetMachineId" :timeout 100))))) - (should (dbus-ping :session dbus-service-emacs 100)) - (dbus-unregister-service :session dbus-service-emacs) - (should-not (dbus-ping :session dbus-service-emacs 100))) + (should (dbus-ping :session dbus--test-service 100)) + (dbus-unregister-service :session dbus--test-service) + (should-not (dbus-ping :session dbus--test-service 100))) + +(defun dbus--test-method-handler (&rest args) + "Method handler for `dbus-test04-register-method'." + (cond + ;; No argument. + ((null args) + :ignore) + ;; One argument. + ((= 1 (length args)) + (car args)) + ;; Two arguments. + ((= 2 (length args)) + `(:error ,dbus-error-invalid-args + ,(format-message "Wrong arguments %s" args))) + ;; More than two arguments. + (t (signal 'dbus-error (cons "D-Bus signal" args))))) + +(ert-deftest dbus-test04-register-method () + "Check method registration for an own service." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((method1 "Method1") + (method2 "Method2") + (handler #'dbus--test-method-handler) + registered) + + ;; The service is not registered yet. + (should + (equal + (butlast + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1 :timeout 10 "foo"))) + `(dbus-error ,dbus-error-service-unknown))) + + ;; Register. + (should + (equal + (setq + registered + (dbus-register-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1 handler)) + `((:method :session ,dbus--test-interface ,method1) + (,dbus--test-service ,dbus--test-path ,handler)))) + (should + (equal + (dbus-register-method + :session dbus--test-service dbus--test-path + dbus--test-interface method2 handler) + `((:method :session ,dbus--test-interface ,method2) + (,dbus--test-service ,dbus--test-path ,handler)))) + + ;; No argument, returns nil. + (should-not + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1)) + ;; One argument, returns the argument. + (should + (string-equal + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1 "foo") + "foo")) + ;; Two arguments, D-Bus error activated as `(:error ...)' list. + (should + (equal + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1 "foo" "bar")) + `(dbus-error ,dbus-error-invalid-args "Wrong arguments (foo bar)"))) + ;; Three arguments, D-Bus error activated by `dbus-error' signal. + (should + (equal + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1 "foo" "bar" "baz")) + `(dbus-error + ,dbus-error-failed + "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\""))) + + ;; Unregister method. + (should (dbus-unregister-object registered)) + (should-not (dbus-unregister-object registered)) + (should + (equal + (butlast + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1 :timeout 10 "foo"))) + `(dbus-error ,dbus-error-no-reply)))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(defun dbus--test-method-reentry-handler (&rest _args) + "Method handler for `dbus-test04-method-reentry'." + (dbus-get-all-managed-objects :session dbus--test-service dbus--test-path) + 42) + +(ert-deftest dbus-test04-method-reentry () + "Check receiving method call while awaiting response. +Ensure that incoming method calls are handled when call to `dbus-call-method' +is in progress." + :tags '(:expensive-test) + ;; Simulate application registration. (Bug#43251) + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((method "Reentry")) + (should + (equal + (dbus-register-method + :session dbus--test-service dbus--test-path + dbus--test-interface method #'dbus--test-method-reentry-handler) + `((:method :session ,dbus--test-interface ,method) + (,dbus--test-service ,dbus--test-path + dbus--test-method-reentry-handler)))) + + (should + (= + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method) + 42))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test04-call-method-timeout () + "Verify `dbus-call-method' request timeout." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + (dbus-register-service :session dbus--test-service) + + (unwind-protect + (let ((start (current-time))) + ;; Test timeout override for method call. + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus-interface-introspectable "Introspect" :timeout 2500) + :type 'dbus-error) + + (should + (< 2.4 (float-time (time-since start)) 2.7))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(defvar dbus--test-signal-received nil + "Received signal value in `dbus--test-signal-handler'.") + +(defun dbus--test-signal-handler (&rest args) + "Signal handler for `dbus-test*-signal' and `dbus-test08-register-monitor'." + (setq dbus--test-signal-received args)) + +(defun dbus--test-timeout-handler (&rest _ignore) + "Timeout handler, reporting a failed test." + (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) + +(ert-deftest dbus-test05-register-signal () + "Check signal registration for an own service." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((member "Member") + (handler #'dbus--test-signal-handler) + registered) + + ;; Register signal handler. + (should + (equal + (setq + registered + (dbus-register-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member handler)) + `((:signal :session ,dbus--test-interface ,member) + (,dbus--test-service ,dbus--test-path ,handler)))) + + ;; Send one argument, basic type. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member "foo") + (with-timeout (1 (dbus--test-timeout-handler)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + (should (equal dbus--test-signal-received '("foo"))) + + ;; Send two arguments, compound types. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member + '(:array :byte 1 :byte 2 :byte 3) '(:variant :string "bar")) + (with-timeout (1 (dbus--test-timeout-handler)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + (should (equal dbus--test-signal-received '((1 2 3) ("bar")))) + + ;; Unregister signal. + (should (dbus-unregister-object registered)) + (should-not (dbus-unregister-object registered))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test06-register-property () + "Check property registration for an own service." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((property1 "Property1") + (property2 "Property2") + (property3 "Property3") + (property4 "Property4") + registered) + + ;; `:read' property. + (should + (equal + (setq + registered + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 :read "foo")) + `((:property :session ,dbus--test-interface ,property1) + (,dbus--test-service ,dbus--test-path)))) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1) + "foo")) + ;; Due to `:read' access type, we don't get a proper reply + ;; from `dbus-set-property'. + (should + (equal + (butlast + (should-error + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 "foofoo"))) + `(dbus-error ,dbus-error-property-read-only))) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1) + "foo")) + + ;; `:write' property. + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2 :write "bar") + `((:property :session ,dbus--test-interface ,property2) + (,dbus--test-service ,dbus--test-path)))) + ;; Due to `:write' access type, we don't get a proper reply + ;; from `dbus-get-property'. + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2))) + `(dbus-error ,dbus-error-access-denied))) + (should + (string-equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2 "barbar") + "barbar")) + ;; Still `:write' access type. + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2))) + `(dbus-error ,dbus-error-access-denied))) + + ;; `:readwrite' property, typed value (Bug#43252). + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3 :readwrite :object-path "/baz") + `((:property :session ,dbus--test-interface ,property3) + (,dbus--test-service ,dbus--test-path)))) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3) + "/baz")) + (should + (string-equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3 :object-path "/baz/baz") + "/baz/baz")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3) + "/baz/baz")) + + ;; Not registered property. + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4))) + `(dbus-error ,dbus-error-unknown-property))) + (should + (equal + (butlast + (should-error + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4 "foobarbaz"))) + `(dbus-error ,dbus-error-unknown-property))) + + ;; `dbus-get-all-properties'. We cannot retrieve a value for + ;; the property with `:write' access type. + (let ((result + (dbus-get-all-properties + :session dbus--test-service dbus--test-path + dbus--test-interface))) + (should (string-equal (cdr (assoc property1 result)) "foo")) + (should (string-equal (cdr (assoc property3 result)) "/baz/baz")) + (should-not (assoc property2 result))) + + ;; `dbus-get-all-managed-objects'. We cannot retrieve a value for + ;; the property with `:write' access type. + (let ((result + (dbus-get-all-managed-objects + :session dbus--test-service dbus--test-path))) + (should (setq result (cadr (assoc dbus--test-path result)))) + (should (setq result (cadr (assoc dbus--test-interface result)))) + (should (string-equal (cdr (assoc property1 result)) "foo")) + (should (string-equal (cdr (assoc property3 result)) "/baz/baz")) + (should-not (assoc property2 result))) + + ;; Unregister property. + (should (dbus-unregister-object registered)) + (should-not (dbus-unregister-object registered)) + (should + (equal + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1))) + `(dbus-error ,dbus-error-unknown-property)))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +;; The following test is inspired by Bug#43146. +(ert-deftest dbus-test06-register-property-several-paths () + "Check property registration for an own service at several paths." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((property1 "Property1") + (property2 "Property2") + (property3 "Property3")) + + ;; First path. + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 :readwrite "foo") + `((:property :session ,dbus--test-interface ,property1) + (,dbus--test-service ,dbus--test-path)))) + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2 :readwrite "bar") + `((:property :session ,dbus--test-interface ,property2) + (,dbus--test-service ,dbus--test-path)))) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1) + "foo")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2) + "bar")) + + (should + (string-equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 "foofoo") + "foofoo")) + (should + (string-equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2 "barbar") + "barbar")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1) + "foofoo")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2) + "barbar")) + + ;; Second path. + (should + (equal + (dbus-register-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property2 :readwrite "foo") + `((:property :session ,dbus--test-interface ,property2) + (,dbus--test-service ,(concat dbus--test-path dbus--test-path))))) + (should + (equal + (dbus-register-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property3 :readwrite "bar") + `((:property :session ,dbus--test-interface ,property3) + (,dbus--test-service ,(concat dbus--test-path dbus--test-path))))) + (should + (string-equal + (dbus-get-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property2) + "foo")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property3) + "bar")) + + (should + (string-equal + (dbus-set-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property2 "foofoo") + "foofoo")) + (should + (string-equal + (dbus-set-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property3 "barbar") + "barbar")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property2) + "foofoo")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service (concat dbus--test-path dbus--test-path) + dbus--test-interface property3) + "barbar")) + + ;; Everything is still fine, tested with `dbus-get-all-properties'. + (let ((result + (dbus-get-all-properties + :session dbus--test-service dbus--test-path + dbus--test-interface))) + (should (string-equal (cdr (assoc property1 result)) "foofoo")) + (should (string-equal (cdr (assoc property2 result)) "barbar")) + (should-not (assoc property3 result))) + + (let ((result + (dbus-get-all-properties + :session dbus--test-service + (concat dbus--test-path dbus--test-path) dbus--test-interface))) + (should (string-equal (cdr (assoc property2 result)) "foofoo")) + (should (string-equal (cdr (assoc property3 result)) "barbar")) + (should-not (assoc property1 result))) + + ;; Final check with `dbus-get-all-managed-objects'. + (let ((result + (dbus-get-all-managed-objects :session dbus--test-service "/")) + result1) + (should (setq result1 (cadr (assoc dbus--test-path result)))) + (should (setq result1 (cadr (assoc dbus--test-interface result1)))) + (should (string-equal (cdr (assoc property1 result1)) "foofoo")) + (should (string-equal (cdr (assoc property2 result1)) "barbar")) + (should-not (assoc property3 result1)) + + (should + (setq + result1 + (cadr (assoc (concat dbus--test-path dbus--test-path) result)))) + (should (setq result1 (cadr (assoc dbus--test-interface result1)))) + (should (string-equal (cdr (assoc property2 result1)) "foofoo")) + (should (string-equal (cdr (assoc property3 result1)) "barbar")) + (should-not (assoc property1 result1)))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test06-register-property-emits-signal () + "Check property registration for an own service, including signalling." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((property "Property") + (handler #'dbus--test-signal-handler)) + + ;; Register signal handler. + (should + (equal + (dbus-register-signal + :session dbus--test-service dbus--test-path + dbus-interface-properties "PropertiesChanged" handler) + `((:signal :session ,dbus-interface-properties "PropertiesChanged") + (,dbus--test-service ,dbus--test-path ,handler)))) + + ;; Register property. + (setq dbus--test-signal-received nil) + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property :readwrite "foo" 'emits-signal) + `((:property :session ,dbus--test-interface ,property) + (,dbus--test-service ,dbus--test-path)))) + (with-timeout (1 (dbus--test-timeout-handler)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + ;; It returns three arguments, "interface" (a string), + ;; "changed_properties" (an array of dict entries) and + ;; "invalidated_properties" (an array of strings). + (should + (equal dbus--test-signal-received + `(,dbus--test-interface ((,property ("foo"))) ()))) + + (should + (equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property) + "foo")) + + ;; Set property. The new value shall be signalled. + (setq dbus--test-signal-received nil) + (should + (equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property + '(:array :byte 1 :byte 2 :byte 3)) + '(1 2 3))) + (with-timeout (1 (dbus--test-timeout-handler)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + (should + (equal + dbus--test-signal-received + `(,dbus--test-interface ((,property ((1 2 3)))) ()))) + + (should + (equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property) + '(1 2 3)))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(defsubst dbus--test-run-property-test (selector name value expected) + "Generate a property test: register, set, get, getall sequence. +This is a helper function for the macro `dbus--test-property'. +The argument SELECTOR indicates whether the test should expand to +`dbus-register-property' (if SELECTOR is `register') or +`dbus-set-property' (if SELECTOR is `set'). +The argument NAME is the property name. +The argument VALUE is the value to register or set. +The argument EXPECTED is a transformed VALUE representing the +form `dbus-get-property' should return." + (cond + ((eq selector 'register) + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface name + :readwrite value) + `((:property :session ,dbus--test-interface ,name) + (,dbus--test-service ,dbus--test-path))))) + + ((eq selector 'set) + (should + (equal + (dbus-set-property + :session dbus--test-service dbus--test-path dbus--test-interface name + value) + expected))) + + (t (signal 'wrong-type-argument "Selector should be 'register or 'set."))) + + (should + (equal + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface name) + expected)) + + (let ((result + (dbus-get-all-properties + :session dbus--test-service dbus--test-path dbus--test-interface))) + (should (equal (cdr (assoc name result)) expected))) + + (let ((result + (dbus-get-all-managed-objects :session dbus--test-service "/")) + result1) + (should (setq result1 (cadr (assoc dbus--test-path result)))) + (should (setq result1 (cadr (assoc dbus--test-interface result1)))) + (should (equal (cdr (assoc name result1)) expected)))) + +(defsubst dbus--test-property (name &rest value-list) + "Test a D-Bus property named by string argument NAME. +The argument VALUE-LIST is a sequence of pairs, where each pair +represents a value form and an expected returned value form. The +first pair in VALUES is used for `dbus-register-property'. +Subsequent pairs of the list are tested with `dbus-set-property'." + (let ((values (car value-list))) + (dbus--test-run-property-test + 'register name (car values) (cdr values))) + (dolist (values (cdr value-list)) + (dbus--test-run-property-test + 'set name (car values) (cdr values)))) + +(ert-deftest dbus-test06-property-types () + "Check property access and mutation for an own service." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + (dbus-register-service :session dbus--test-service) + + (unwind-protect + (progn + (dbus--test-property + "ByteArray" + '((:array :byte 1 :byte 2 :byte 3) . (1 2 3)) + '((:array :byte 4 :byte 5 :byte 6) . (4 5 6))) + + (dbus--test-property + "StringArray" + '((:array "one" "two" :string "three") . ("one" "two" "three")) + '((:array :string "four" :string "five" "six") . ("four" "five" "six"))) + + (dbus--test-property + "ObjectArray" + '((:array + :object-path "/node00" + :object-path "/node01" + :object-path "/node0/node02") + . ("/node00" "/node01" "/node0/node02")) + '((:array + :object-path "/node10" + :object-path "/node11" + :object-path "/node0/node12") + . ("/node10" "/node11" "/node0/node12"))) + + (dbus--test-property + "Dictionary" + '((:array + :dict-entry (:string "four" (:variant :string "value of four")) + :dict-entry ("five" (:variant :object-path "/node0")) + :dict-entry ("six" (:variant (:array :byte 4 :byte 5 :byte 6)))) + . (("four" + ("value of four")) + ("five" + ("/node0")) + ("six" + ((4 5 6))))) + '((:array + :dict-entry + (:string "key0" (:variant (:array :byte 7 :byte 8 :byte 9))) + :dict-entry ("key1" (:variant :string "value")) + :dict-entry ("key2" (:variant :object-path "/node0/node1"))) + . (("key0" + ((7 8 9))) + ("key1" + ("value")) + ("key2" + ("/node0/node1"))))) + + (dbus--test-property ; Syntax emphasizing :dict compound type. + "Dictionary" + '((:array + (:dict-entry :string "seven" (:variant :string "value of seven")) + (:dict-entry "eight" (:variant :object-path "/node8")) + (:dict-entry "nine" (:variant (:array :byte 9 :byte 27 :byte 81)))) + . (("seven" + ("value of seven")) + ("eight" + ("/node8")) + ("nine" + ((9 27 81))))) + '((:array + (:dict-entry + :string "key4" (:variant (:array :byte 7 :byte 49 :byte 125))) + (:dict-entry "key5" (:variant :string "obsolete")) + (:dict-entry "key6" (:variant :object-path "/node6/node7"))) + . (("key4" + ((7 49 125))) + ("key5" + ("obsolete")) + ("key6" + ("/node6/node7"))))) + + (dbus--test-property + "ByteDictionary" + '((:array + (:dict-entry :byte 8 (:variant :string "byte-eight")) + (:dict-entry :byte 16 (:variant :object-path "/byte/sixteen")) + (:dict-entry :byte 48 (:variant (:array :byte 8 :byte 9 :byte 10)))) + . (( 8 ("byte-eight")) + (16 ("/byte/sixteen")) + (48 ((8 9 10)))))) + + (dbus--test-property + "Variant" + '((:variant "Variant string") . ("Variant string")) + '((:variant :byte 42) . (42)) + '((:variant :uint32 1000000) . (1000000)) + '((:variant :object-path "/variant/path") . ("/variant/path")) + '((:variant :signature "a{sa{sv}}") . ("a{sa{sv}}")) + '((:variant + (:struct + 42 "string" (:object-path "/structure/path") (:variant "last"))) + . ((42 "string" ("/structure/path") ("last"))))) + + ;; Test that :read prevents writes. + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "StringArray" :read '(:array "one" "two" :string "three")) + `((:property :session ,dbus--test-interface "StringArray") + (,dbus--test-service ,dbus--test-path)))) + + (should-error ; Cannot set property with :read access. + (dbus-set-property + :session dbus--test-service dbus--test-path dbus--test-interface + "StringArray" '(:array "seven" "eight" :string "nine")) + :type 'dbus-error) + + (should ; Property value preserved on error. + (equal + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "StringArray") + '("one" "two" "three"))) + + ;; Test mismatched types in array. + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "MixedArray" :readwrite + '(:array + :object-path "/node00" + :string "/node01" + :object-path "/node0/node02")) + :type 'wrong-type-argument) + + ;; Test in-range integer values. + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue" :readwrite :byte 255) + `((:property :session ,dbus--test-interface "ByteValue") + (,dbus--test-service ,dbus--test-path)))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue") + 255)) + + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ShortValue" :readwrite :int16 32767) + `((:property :session ,dbus--test-interface "ShortValue") + (,dbus--test-service ,dbus--test-path)))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ShortValue") + 32767)) + + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "UShortValue" :readwrite :uint16 65535) + `((:property :session ,dbus--test-interface "UShortValue") + (,dbus--test-service ,dbus--test-path)))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "UShortValue") + 65535)) + + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "IntValue" :readwrite :int32 2147483647) + `((:property :session ,dbus--test-interface "IntValue") + (,dbus--test-service ,dbus--test-path)))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "IntValue") + 2147483647)) + + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "UIntValue" :readwrite :uint32 4294967295) + `((:property :session ,dbus--test-interface "UIntValue") + (,dbus--test-service ,dbus--test-path)))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "UIntValue") + 4294967295)) + + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "LongValue" :readwrite :int64 9223372036854775807) + `((:property :session ,dbus--test-interface "LongValue") + (,dbus--test-service ,dbus--test-path)))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "LongValue") + 9223372036854775807)) + + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ULongValue" :readwrite :uint64 18446744073709551615) + `((:property :session ,dbus--test-interface "ULongValue") + (,dbus--test-service ,dbus--test-path)))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ULongValue") + 18446744073709551615)) + + ;; Test integer overflow. + (should + (= + (dbus-set-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue" :byte 520) + 8)) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue") + 8)) + + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ShortValue" :readwrite :int16 32800) + :type 'args-out-of-range) + + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "UShortValue" :readwrite :uint16 65600) + :type 'args-out-of-range) + + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "IntValue" :readwrite :int32 2147483700) + :type 'args-out-of-range) + + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "UIntValue" :readwrite :uint32 4294967300) + :type 'args-out-of-range) + + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "LongValue" :readwrite :int64 9223372036854775900) + :type 'args-out-of-range) + + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ULongValue" :readwrite :uint64 18446744073709551700) + :type 'args-out-of-range) + + ;; dbus-set-property may change property type. + (should + (= + (dbus-set-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue" 1024) + 1024)) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue") + 1024)) + + (should ; Another change property type test. + (equal + (dbus-set-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue" :boolean t) + t)) + + (should + (eq + (dbus-get-property + :session dbus--test-service dbus--test-path dbus--test-interface + "ByteValue") + t)) + + ;; Test invalid type specification. + (should-error + (dbus-register-property + :session dbus--test-service dbus--test-path dbus--test-interface + "InvalidType" :readwrite :keyword 128) + :type 'wrong-type-argument)) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(defun dbus--test-introspect () + "Return test introspection string." + (when (string-equal dbus--test-path (dbus-event-path-name last-input-event)) + (with-temp-buffer + (insert-file-contents-literally + (ert-resource-file "org.gnu.Emacs.TestDBus.xml")) + (buffer-string)))) + +(defsubst dbus--test-validate-interface + (iface-name expected-properties expected-methods expected-signals + expected-annotations) + "Validate an interface definition for `dbus-test07-introspection'. +The argument IFACE-NAME is a string naming the interface to validate. +The arguments EXPECTED-PROPERTIES, EXPECTED-METHODS, EXPECTED-SIGNALS, and +EXPECTED-ANNOTATIONS represent the names of the interface's properties, +methods, signals, and annotations, respectively." + + (let ((interface + (dbus-introspect-get-interface + :session dbus--test-service dbus--test-path iface-name))) + (pcase-let ((`(interface ((name . ,name)) . ,rest) interface)) + (should + (string-equal name iface-name)) + (should + (string-equal name (dbus-introspect-get-attribute interface "name"))) + + (let (properties methods signals annotations) + (mapc (lambda (x) + (let ((name (dbus-introspect-get-attribute x "name"))) + (cond + ((eq 'property (car x)) (push name properties)) + ((eq 'method (car x)) (push name methods)) + ((eq 'signal (car x)) (push name signals)) + ((eq 'annotation (car x)) (push name annotations))))) + rest) + + (should + (equal + (nreverse properties) + expected-properties)) + (should + (equal + (nreverse methods) + expected-methods)) + (should + (equal + (nreverse signals) + expected-signals)) + (should + (equal + (nreverse annotations) + expected-annotations)))))) + +(defsubst dbus--test-validate-annotations (annotations expected-annotations) + "Validate a list of D-Bus ANNOTATIONS. +Ensure each string in EXPECTED-ANNOTATIONS names an element of ANNOTATIONS. +And ensure each ANNOTATIONS has a value attribute marked \"true\"." + (mapc + (lambda (annotation) + (let ((name (dbus-introspect-get-attribute annotation "name")) + (value (dbus-introspect-get-attribute annotation "value"))) + (should + (member name expected-annotations)) + (should + (equal value "true")))) + annotations)) + +(defsubst dbus--test-validate-property + (interface property-name _expected-annotations &rest expected-args) + "Validate a property definition for `dbus-test07-introspection'. + +The argument INTERFACE is a string naming the interface owning PROPERTY-NAME. +The argument PROPERTY-NAME is a string naming the property to validate. +The arguments EXPECTED-ANNOTATIONS is a list of strings matching +the annotation names defined for the method or signal. +The argument EXPECTED-ARGS is a list of expected arguments for the property." + (let* ((property + (dbus-introspect-get-property + :session dbus--test-service dbus--test-path interface property-name)) + (name (dbus-introspect-get-attribute property "name")) + (type (dbus-introspect-get-attribute property "type")) + (access (dbus-introspect-get-attribute property "access")) + (expected (assoc-string name expected-args))) + (should expected) + + (should + (string-equal name property-name)) + + (should + (string-equal + (nth 0 expected) + name)) + + (should + (string-equal + (nth 1 expected) + type)) + + (should + (string-equal + (nth 2 expected) + access)))) + +(defsubst dbus--test-validate-m-or-s (tree expected-annotations expected-args) + "Validate a method or signal definition for `dbus-test07-introspection'. +The argument TREE is an sexp returned from either `dbus-introspect-get-method' +or `dbus-introspect-get-signal' +The arguments EXPECTED-ANNOTATIONS is a list of strings matching +the annotation names defined for the method or signal. +The argument EXPECTED-ARGS is a list of expected arguments for +the method or signal." + (let (args annotations) + (mapc (lambda (elem) + (cond + ((eq 'arg (car elem)) (push elem args)) + ((eq 'annotation (car elem)) (push elem annotations)))) + tree) + (should + (equal + (nreverse args) + expected-args)) + (dbus--test-validate-annotations annotations expected-annotations))) + +(defsubst dbus--test-validate-signal + (interface signal-name expected-annotations &rest expected-args) + "Validate a signal definition for `dbus-test07-introspection'. + +The argument INTERFACE is a string naming the interface owning SIGNAL-NAME. +The argument SIGNAL-NAME is a string naming the signal to validate. +The arguments EXPECTED-ANNOTATIONS is a list of strings matching +the annotation names defined for the signal. +The argument EXPECTED-ARGS is a list of expected arguments for the signal." + (let ((signal + (dbus-introspect-get-signal + :session dbus--test-service dbus--test-path interface signal-name))) + (pcase-let ((`(signal ((name . ,name)) . ,rest) signal)) + (should + (string-equal name signal-name)) + (should + (string-equal name (dbus-introspect-get-attribute signal "name"))) + (dbus--test-validate-m-or-s rest expected-annotations expected-args)))) + +(defsubst dbus--test-validate-method + (interface method-name expected-annotations &rest expected-args) + "Validate a method definition for `dbus-test07-introspection'. + +The argument INTERFACE is a string naming the interface owning METHOD-NAME. +The argument METHOD-NAME is a string naming the method to validate. +The arguments EXPECTED-ANNOTATIONS is a list of strings matching +the annotation names defined for the method. +The argument EXPECTED-ARGS is a list of expected arguments for the method." + (let ((method + (dbus-introspect-get-method + :session dbus--test-service dbus--test-path interface method-name))) + (pcase-let ((`(method ((name . ,name)) . ,rest) method)) + (should + (string-equal name method-name)) + (should + (string-equal name (dbus-introspect-get-attribute method "name"))) + (dbus--test-validate-m-or-s rest expected-annotations expected-args)))) + +(ert-deftest dbus-test07-introspection () + "Register an Introspection interface then query it." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + (dbus-register-service :session dbus--test-service) + + ;; Prepare introspection response. + (dbus-register-method + :session dbus--test-service dbus--test-path dbus-interface-introspectable + "Introspect" 'dbus--test-introspect) + (dbus-register-method + :session dbus--test-service (concat dbus--test-path "/node0") + dbus-interface-introspectable + "Introspect" 'dbus--test-introspect) + (dbus-register-method + :session dbus--test-service (concat dbus--test-path "/node1") + dbus-interface-introspectable + "Introspect" 'dbus--test-introspect) + (unwind-protect + (let ((start (current-time))) + ;; dbus-introspect-get-node-names + (should + (equal + (dbus-introspect-get-node-names + :session dbus--test-service dbus--test-path) + '("node0" "node1"))) + + ;; dbus-introspect-get-all-nodes + (should + (equal + (dbus-introspect-get-all-nodes + :session dbus--test-service dbus--test-path) + (list dbus--test-path + (concat dbus--test-path "/node0") + (concat dbus--test-path "/node1")))) + + ;; dbus-introspect-get-interface-names + (let ((interfaces + (dbus-introspect-get-interface-names + :session dbus--test-service dbus--test-path))) + + (should + (equal + interfaces + `(,dbus-interface-introspectable + ,dbus-interface-properties + ,dbus--test-interface))) + + (dbus--test-validate-interface + dbus-interface-introspectable nil '("Introspect") nil nil) + + ;; dbus-introspect-get-interface via `dbus--test-validate-interface'. + (dbus--test-validate-interface + dbus-interface-properties nil + '("Get" "Set" "GetAll") '("PropertiesChanged") nil) + + (dbus--test-validate-interface + dbus--test-interface '("Connected" "Player") + '("Connect" "DeprecatedMethod0" "DeprecatedMethod1") nil + `(,dbus-annotation-deprecated))) + + ;; dbus-introspect-get-method-names + (let ((methods + (dbus-introspect-get-method-names + :session dbus--test-service dbus--test-path + dbus--test-interface))) + (should + (equal + methods + '("Connect" "DeprecatedMethod0" "DeprecatedMethod1"))) + + ;; dbus-introspect-get-method via `dbus--test-validate-method'. + (dbus--test-validate-method + dbus--test-interface "Connect" nil + '(arg ((name . "uuid") (type . "s") (direction . "in"))) + '(arg ((name . "mode") (type . "y") (direction . "in"))) + '(arg ((name . "options") (type . "a{sv}") (direction . "in"))) + '(arg ((name . "interface") (type . "s") (direction . "out")))) + + (dbus--test-validate-method + dbus--test-interface "DeprecatedMethod0" + `(,dbus-annotation-deprecated)) + + (dbus--test-validate-method + dbus--test-interface "DeprecatedMethod1" + `(,dbus-annotation-deprecated))) + + ;; dbus-introspect-get-signal-names + (let ((signals + (dbus-introspect-get-signal-names + :session dbus--test-service dbus--test-path + dbus-interface-properties))) + (should + (equal + signals + '("PropertiesChanged"))) + + ;; dbus-introspect-get-signal via `dbus--test-validate-signal'. + (dbus--test-validate-signal + dbus-interface-properties "PropertiesChanged" nil + '(arg ((name . "interface") (type . "s"))) + '(arg ((name . "changed_properties") (type . "a{sv}"))) + '(arg ((name . "invalidated_properties") (type . "as"))))) + + ;; dbus-intropct-get-property-names + (let ((properties + (dbus-introspect-get-property-names + :session dbus--test-service dbus--test-path + dbus--test-interface))) + (should + (equal + properties + '("Connected" "Player"))) + + ;; dbus-introspect-get-property via `dbus--test-validate-property'. + (dbus--test-validate-property + dbus--test-interface "Connected" nil + '("Connected" "b" "read") + '("Player" "o" "read"))) + + ;; Elapsed time over a second suggests timeouts. + (should + (< 0.0 (float-time (time-since start)) 1.0))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test07-introspection-timeout () + "Verify introspection request timeouts." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + (dbus-register-service :session dbus--test-service) + + (unwind-protect + (let ((start (current-time))) + (dbus-introspect-xml :session dbus--test-service dbus--test-path) + ;; Introspection internal timeout is one second. + (should + (< 1.0 (float-time (time-since start))))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test08-register-monitor () + "Check monitor registration." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + + (unwind-protect + (let (registered) + (should + (equal + (setq registered + (dbus-register-monitor :session #'dbus--test-signal-handler)) + '((:monitor :session-private) + (nil nil dbus--test-signal-handler)))) + + ;; Send a signal, shall be traced. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface "Foo" "foo") + (with-timeout (1 (dbus--test-timeout-handler)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + + ;; Unregister monitor. + (should (dbus-unregister-object registered)) + (should-not (dbus-unregister-object registered)) + + ;; Send a signal, shall not be traced. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface "Foo" "foo") + (with-timeout (1 (ignore)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + (should-not dbus--test-signal-received)) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test09-get-managed-objects () + "Check `dbus-get-all-managed-objects'." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + (dbus-register-service :session dbus--test-service) + + (unwind-protect + (let ((interfaces + `((,(concat dbus--test-interface ".I0") + ((,(concat dbus--test-path "/obj1") + (("I0Property1" . "Zero one one") + ("I0Property2" . "Zero one two") + ("I0Property3" . "Zero one three"))) + (,(concat dbus--test-path "/obj0/obj2") + (("I0Property1" . "Zero two one") + ("I0Property2" . "Zero two two") + ("I0Property3" . "Zero two three"))) + (,(concat dbus--test-path "/obj0/obj3") + (("I0Property1" . "Zero three one") + ("I0Property2" . "Zero three two") + ("I0Property3" . "Zero three three"))))) + (,(concat dbus--test-interface ".I1") + ((,(concat dbus--test-path "/obj0/obj2") + (("I1Property1" . "One one one") + ("I1Property2" . "One one two"))) + (,(concat dbus--test-path "/obj0/obj3") + (("I1Property1" . "One two one") + ("I1Property2" . "One two two")))))))) + + (should-not + (dbus-get-all-managed-objects + :session dbus--test-service dbus--test-path)) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (dolist (prop props) + (should + (equal + (dbus-register-property + :session dbus--test-service path iname + (car prop) :readwrite (cdr prop)) + `((:property :session ,iname ,(car prop)) + (,dbus--test-service ,path))))))))) + + (let ((result (dbus-get-all-managed-objects + :session dbus--test-service dbus--test-path))) + (should + (= 3 (length result))) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (let* ((object (cadr (assoc-string path result))) + (iface (cadr (assoc-string iname object)))) + (should object) + (should iface) + (dolist (prop props) + (should (equal (cdr (assoc-string (car prop) iface)) + (cdr prop)))))))))) + + (let ((result (dbus-get-all-managed-objects + :session dbus--test-service + (concat dbus--test-path "/obj0")))) + (should + (= 2 (length result))) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (when (string-prefix-p (concat dbus--test-path "/obj0/") path) + (let* ((object (cadr (assoc-string path result))) + (iface (cadr (assoc-string iname object)))) + (should object) + (should iface) + (dolist (prop props) + (should (equal (cdr (assoc-string (car prop) iface)) + (cdr prop))))))))))) + + (let ((result (dbus-get-all-managed-objects + :session dbus--test-service + (concat dbus--test-path "/obj0/obj2")))) + (should + (= 1 (length result))) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (when (string-prefix-p + (concat dbus--test-path "/obj0/obj2") path) + (let* ((object (cadr (assoc-string path result))) + (iface (cadr (assoc-string iname object)))) + (should object) + (should iface) + (dolist (prop props) + (should (equal (cdr (assoc-string (car prop) iface)) + (cdr prop)))))))))))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) (defun dbus-test-all (&optional interactive) "Run all tests for \\[dbus]." diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el index 07e30b64642..5205f0b851f 100644 --- a/test/lisp/net/gnutls-tests.el +++ b/test/lisp/net/gnutls-tests.el @@ -241,6 +241,7 @@ (ert-deftest test-gnutls-005-aead-ciphers () "Test the GnuTLS AEAD ciphers" + :tags '(:expensive-test) (skip-unless (memq 'AEAD-ciphers (gnutls-available-p))) (setq gnutls-tests-message-prefix "AEAD verification: ") (let ((keys '("mykey" "mykey2")) diff --git a/test/data/mailcap/mime.types b/test/lisp/net/mailcap-resources/mime.types index 4bedfaf9702..4bedfaf9702 100644 --- a/test/data/mailcap/mime.types +++ b/test/lisp/net/mailcap-resources/mime.types diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el index 8354d8e5e23..0ebbec61159 100644 --- a/test/lisp/net/mailcap-tests.el +++ b/test/lisp/net/mailcap-tests.el @@ -24,13 +24,10 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'mailcap) -(defconst mailcap-tests-data-dir - (expand-file-name "test/data/mailcap" source-directory)) - -(defconst mailcap-tests-path - (expand-file-name "mime.types" mailcap-tests-data-dir) +(defconst mailcap-tests-path (ert-resource-file "mime.types") "String used as PATH argument of `mailcap-parse-mimetypes'.") (defconst mailcap-tests-mime-extensions (copy-alist mailcap-mime-extensions)) diff --git a/test/lisp/net/netrc-resources/authinfo b/test/lisp/net/netrc-resources/authinfo new file mode 100644 index 00000000000..88aa1712e9d --- /dev/null +++ b/test/lisp/net/netrc-resources/authinfo @@ -0,0 +1,2 @@ +machine imap.example.org login jrh@example.org password "*foobar*" +machine ftp.example.org login jrh password "*baz*" diff --git a/test/lisp/net/netrc-resources/services b/test/lisp/net/netrc-resources/services new file mode 100644 index 00000000000..fd8a0348df2 --- /dev/null +++ b/test/lisp/net/netrc-resources/services @@ -0,0 +1,6 @@ +tcpmux 1/tcp # TCP port service multiplexer +smtp 25/tcp mail +http 80/tcp www # WorldWideWeb HTTP +kerberos 88/tcp kerberos5 krb5 kerberos-sec # Kerberos v5 +kerberos 88/udp kerberos5 krb5 kerberos-sec # Kerberos v5 +rtmp 1/ddp # Routing Table Maintenance Protocol diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el new file mode 100644 index 00000000000..291943990ad --- /dev/null +++ b/test/lisp/net/netrc-tests.el @@ -0,0 +1,53 @@ +;;; netrc-tests.el --- Tests for netrc.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Stefan Kangas <stefankangas@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'netrc) + +(ert-deftest test-netrc-parse-services () + (let ((netrc-services-file (ert-resource-file "services"))) + (should (equal (netrc-parse-services) + '(("tcpmux" 1 tcp) + ("smtp" 25 tcp) + ("http" 80 tcp) + ("kerberos" 88 tcp) + ("kerberos" 88 udp) + ("rtmp" 1 ddp)))))) + +(ert-deftest test-netrc-find-service-name () + (let ((netrc-services-file (ert-resource-file "services"))) + (should (equal (netrc-find-service-name 25) "smtp")) + (should (equal (netrc-find-service-name 88 'udp) "kerberos")) + (should-not (netrc-find-service-name 12345)))) + +(ert-deftest test-netrc-credentials () + (let ((netrc-file (ert-resource-file "authinfo"))) + (should (equal (netrc-credentials "imap.example.org") + '("jrh@example.org" "*foobar*"))) + (should (equal (netrc-credentials "ftp.example.org") + '("jrh" "*baz*"))))) + +(provide 'netrc-tests) + +;;; netrc-tests.el ends here diff --git a/test/data/net/cert.pem b/test/lisp/net/network-stream-resources/cert.pem index 4df4e92e0bf..4df4e92e0bf 100644 --- a/test/data/net/cert.pem +++ b/test/lisp/net/network-stream-resources/cert.pem diff --git a/test/data/net/key.pem b/test/lisp/net/network-stream-resources/key.pem index 5db58f573ca..5db58f573ca 100644 --- a/test/data/net/key.pem +++ b/test/lisp/net/network-stream-resources/key.pem diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index cf416155e50..07eb2823282 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'ert) +(require 'ert-x) (require 'gnutls) (require 'network-stream) ;; The require above is needed for 'open-network-stream' to work, but @@ -239,16 +241,13 @@ (should (equal (buffer-string) "foo\n"))) (delete-process server))) -(defconst network-stream-tests--datadir - (expand-file-name "test/data/net" source-directory)) - (defun make-tls-server (port) (start-process "gnutls" (generate-new-buffer "*tls*") "gnutls-serv" "--http" "--x509keyfile" - (concat network-stream-tests--datadir "/key.pem") + (ert-resource-file "key.pem") "--x509certfile" - (concat network-stream-tests--datadir "/cert.pem") + (ert-resource-file "cert.pem") "--port" (format "%s" port))) (ert-deftest connect-to-tls-ipv4-wait () diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el new file mode 100644 index 00000000000..e515ebe2635 --- /dev/null +++ b/test/lisp/net/ntlm-tests.el @@ -0,0 +1,52 @@ +;;; ntlm-tests.el --- tests for ntlm.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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/>. + +(require 'ert) +(require 'ntlm) + +;; This is the Lisp bignum implementation of `ntlm--time-to-timestamp', +;; for reference. +(defun ntlm-tests--time-to-timestamp (time) + "Convert TIME to an NTLMv2 timestamp. +Return a unibyte string representing the number of tenths of a +microsecond since January 1, 1601 as a 64-bit little-endian +signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." + (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time))) + (us (nth 2 time)) + (ps (nth 3 time)) + (tenths-of-us-since-jan-1-1601 + (+ (* s 10000000) (* us 10) (/ ps 100000) + ;; tenths of microseconds between 1601-01-01 and 1970-01-01 + 116444736000000000))) + (apply #'unibyte-string + (mapcar (lambda (i) + (logand (ash tenths-of-us-since-jan-1-1601 (* i -8)) + #xff)) + (number-sequence 0 7))))) + +(ert-deftest ntlm-time-to-timestamp () + ;; Verify poor man's bignums in implementation that can run on Emacs < 27.1. + (let ((time '(24471 63910 412962 0))) + (should (equal (ntlm--time-to-timestamp time) + (ntlm-tests--time-to-timestamp time)))) + (let ((time '(397431 65535 999999 999999))) + (should (equal (ntlm--time-to-timestamp time) + (ntlm-tests--time-to-timestamp time))))) + +(provide 'ntlm-tests) diff --git a/test/lisp/net/rcirc-tests.el b/test/lisp/net/rcirc-tests.el index 8d14378b4ff..285926af9d2 100644 --- a/test/lisp/net/rcirc-tests.el +++ b/test/lisp/net/rcirc-tests.el @@ -2,18 +2,20 @@ ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/lisp/net/rfc2104-tests.el b/test/lisp/net/rfc2104-tests.el index 90535898382..e7d5a7f30e5 100644 --- a/test/lisp/net/rfc2104-tests.el +++ b/test/lisp/net/rfc2104-tests.el @@ -4,18 +4,20 @@ ;; Author: Lars Ingebrigtsen <larsi@gnus.org> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 6d420c4cb17..1e2cf3aef66 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/data/shr/div-div.html b/test/lisp/net/shr-resources/div-div.html index 1c191ae44d8..1c191ae44d8 100644 --- a/test/data/shr/div-div.html +++ b/test/lisp/net/shr-resources/div-div.html diff --git a/test/data/shr/div-div.txt b/test/lisp/net/shr-resources/div-div.txt index 62715e12513..62715e12513 100644 --- a/test/data/shr/div-div.txt +++ b/test/lisp/net/shr-resources/div-div.txt diff --git a/test/data/shr/div-p.html b/test/lisp/net/shr-resources/div-p.html index fcbdfc43293..fcbdfc43293 100644 --- a/test/data/shr/div-p.html +++ b/test/lisp/net/shr-resources/div-p.html diff --git a/test/data/shr/div-p.txt b/test/lisp/net/shr-resources/div-p.txt index 859d731da89..859d731da89 100644 --- a/test/data/shr/div-p.txt +++ b/test/lisp/net/shr-resources/div-p.txt diff --git a/test/data/shr/li-div.html b/test/lisp/net/shr-resources/li-div.html index eca3c511bd9..eca3c511bd9 100644 --- a/test/data/shr/li-div.html +++ b/test/lisp/net/shr-resources/li-div.html diff --git a/test/data/shr/li-div.txt b/test/lisp/net/shr-resources/li-div.txt index 9fc54f2bdc6..9fc54f2bdc6 100644 --- a/test/data/shr/li-div.txt +++ b/test/lisp/net/shr-resources/li-div.txt diff --git a/test/data/shr/li-empty.html b/test/lisp/net/shr-resources/li-empty.html index 05cfee7bdd4..05cfee7bdd4 100644 --- a/test/data/shr/li-empty.html +++ b/test/lisp/net/shr-resources/li-empty.html diff --git a/test/data/shr/li-empty.txt b/test/lisp/net/shr-resources/li-empty.txt index 906fd8df8b3..906fd8df8b3 100644 --- a/test/data/shr/li-empty.txt +++ b/test/lisp/net/shr-resources/li-empty.txt diff --git a/test/data/shr/nonbr.html b/test/lisp/net/shr-resources/nonbr.html index 56282cf4ca5..56282cf4ca5 100644 --- a/test/data/shr/nonbr.html +++ b/test/lisp/net/shr-resources/nonbr.html diff --git a/test/data/shr/nonbr.txt b/test/lisp/net/shr-resources/nonbr.txt index 0c3cffa93f9..0c3cffa93f9 100644 --- a/test/data/shr/nonbr.txt +++ b/test/lisp/net/shr-resources/nonbr.txt diff --git a/test/data/shr/ol.html b/test/lisp/net/shr-resources/ol.html index f9a15f26409..f9a15f26409 100644 --- a/test/data/shr/ol.html +++ b/test/lisp/net/shr-resources/ol.html diff --git a/test/data/shr/ol.txt b/test/lisp/net/shr-resources/ol.txt index 0d46e2a8ddb..0d46e2a8ddb 100644 --- a/test/data/shr/ol.txt +++ b/test/lisp/net/shr-resources/ol.txt diff --git a/test/data/shr/ul-empty.html b/test/lisp/net/shr-resources/ul-empty.html index e5a75ab9216..e5a75ab9216 100644 --- a/test/data/shr/ul-empty.html +++ b/test/lisp/net/shr-resources/ul-empty.html diff --git a/test/data/shr/ul-empty.txt b/test/lisp/net/shr-resources/ul-empty.txt index 8993555425b..8993555425b 100644 --- a/test/data/shr/ul-empty.txt +++ b/test/lisp/net/shr-resources/ul-empty.txt diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 88a31bcf645..abc4f6a656b 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -23,14 +23,13 @@ ;;; Code: +(require 'ert) +(require 'ert-x) (require 'shr) -(defconst shr-tests--datadir - (expand-file-name "test/data/shr" source-directory)) - (defun shr-test (name) (with-temp-buffer - (insert-file-contents (format (concat shr-tests--datadir "/%s.html") name)) + (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") name)) (let ((dom (libxml-parse-html-region (point-min) (point-max))) (shr-width 80) (shr-use-fonts nil)) @@ -39,7 +38,7 @@ (cons (buffer-substring-no-properties (point-min) (point-max)) (with-temp-buffer (insert-file-contents - (format (concat shr-tests--datadir "/%s.txt") name)) + (format (concat (ert-resource-directory) "/%s.txt") name)) (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) (replace-match (string (string-to-number (match-string 1) 16)) t t)) @@ -47,7 +46,7 @@ (ert-deftest rendering () (skip-unless (fboundp 'libxml-parse-html-region)) - (dolist (file (directory-files shr-tests--datadir nil "\\.html\\'")) + (dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'")) (let* ((name (replace-regexp-in-string "\\.html\\'" "" file)) (result (shr-test name))) (unless (equal (car result) (cdr result)) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 8c75d91bb58..97c22fd2feb 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -27,34 +29,69 @@ ;; tests in tramp-tests.el. (require 'ert) +(require 'ert-x) (require 'tramp-archive) (defvar tramp-copy-size-limit) (defvar tramp-persistency-file-name) -(defconst tramp-archive-test-resource-directory - (let ((default-directory - (if load-in-progress - (file-name-directory load-file-name) - default-directory))) - (cond - ((file-accessible-directory-p (expand-file-name "resources")) - (expand-file-name "resources")) - ((file-accessible-directory-p (expand-file-name "tramp-archive-resources")) - (expand-file-name "tramp-archive-resources")))) - "The resources directory test files are located in.") - -(defconst tramp-archive-test-file-archive - (file-truename - (expand-file-name "foo.tar.gz" tramp-archive-test-resource-directory)) +;; `ert-resource-file' was introduced in Emacs 28.1. +(unless (macrop 'ert-resource-file) + (eval-and-compile + (defvar ert-resource-directory-format "%s-resources/" + "Format for `ert-resource-directory'.") + (defvar ert-resource-directory-trim-left-regexp "" + "Regexp for `string-trim' (left) used by `ert-resource-directory'.") + (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el" + "Regexp for `string-trim' (right) used by `ert-resource-directory'.") + + (defmacro ert-resource-directory () + "Return absolute file name of the resource directory for this file. + +The path to the resource directory is the \"resources\" directory +in the same directory as the test file. + +If that directory doesn't exist, use the directory named like the +test file but formatted by `ert-resource-directory-format' and trimmed +using `string-trim' with arguments +`ert-resource-directory-trim-left-regexp' and +`ert-resource-directory-trim-right-regexp'. The default values mean +that if called from a test file named \"foo-tests.el\", return +the absolute file name for \"foo-resources\"." + `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file) + (and load-in-progress load-file-name) + buffer-file-name)) + (default-directory (file-name-directory testfile))) + (file-truename + (if (file-accessible-directory-p "resources/") + (expand-file-name "resources/") + (expand-file-name + (format + ert-resource-directory-format + (string-trim testfile + ert-resource-directory-trim-left-regexp + ert-resource-directory-trim-right-regexp))))))) + + (defmacro ert-resource-file (file) + "Return file name of resource file named FILE. +A resource file is in the resource directory as per +`ert-resource-directory'." + `(expand-file-name ,file (ert-resource-directory))))) + +(defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") "The test file archive.") +(defun tramp-archive-test-file-archive-hexlified () + "Return hexlified `tramp-archive-test-file-archive'. +Do not hexlify \"/\". This hexlified string is used in `file:///' URLs." + (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars))) + (url-hexify-string tramp-archive-test-file-archive))) + (defconst tramp-archive-test-archive (file-name-as-directory tramp-archive-test-file-archive) "The test archive.") (defconst tramp-archive-test-directory - (file-truename - (expand-file-name "foo.iso" tramp-archive-test-resource-directory)) + (file-truename (ert-resource-file "foo.iso")) "A directory file name, which looks like an archive.") (setq password-cache-expiry nil @@ -174,7 +211,8 @@ variables, so we check the Emacs version directly." (should (string-equal host - (url-hexify-string (concat "file://" tramp-archive-test-file-archive)))) + (url-hexify-string + (concat "file://" (tramp-archive-test-file-archive-hexlified))))) (should-not port) (should (string-equal localname "/")) (should (string-equal archive tramp-archive-test-file-archive))) @@ -193,7 +231,8 @@ variables, so we check the Emacs version directly." (should (string-equal host - (url-hexify-string (concat "file://" tramp-archive-test-file-archive)))) + (url-hexify-string + (concat "file://" (tramp-archive-test-file-archive-hexlified))))) (should-not port) (should (string-equal localname "/foo")) (should (string-equal archive tramp-archive-test-file-archive))) @@ -237,7 +276,8 @@ variables, so we check the Emacs version directly." ;; archive boundaries. So we must cut the ;; trailing slash ourselves. (substring - (file-name-directory tramp-archive-test-file-archive) + (file-name-directory + (tramp-archive-test-file-archive-hexlified)) 0 -1))) nil "/")) (file-name-nondirectory tramp-archive-test-file-archive))))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3914f9ae44e..50db55ebb4f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -2264,7 +2266,24 @@ This checks also `file-name-as-directory', `file-name-directory', (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) (delete-file tmp-name) - (should-not (file-exists-p tmp-name))))) + (should-not (file-exists-p tmp-name)) + + ;; Trashing files doesn't work for crypted remote files. + (unless (tramp--test-crypt-p) + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (delete-by-moving-to-trash t)) + (make-directory trash-directory) + (should-not (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (delete-file tmp-name 'trash) + (should-not (file-exists-p tmp-name)) + (should + (file-exists-p + (expand-file-name + (file-name-nondirectory tmp-name) trash-directory))) + (delete-directory trash-directory 'recursive) + (should-not (file-exists-p trash-directory))))))) (ert-deftest tramp-test08-file-local-copy () "Check `file-local-copy'." @@ -2429,7 +2448,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-error (cl-letf (((symbol-function #'y-or-n-p) #'ignore) ;; Ange-FTP. - ((symbol-function 'yes-or-no-p) 'ignore)) + ((symbol-function #'yes-or-no-p) #'ignore)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) :type 'file-already-exists) (should-error @@ -2761,7 +2780,52 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (delete-directory tmp-name1) :type 'file-error) (delete-directory tmp-name1 'recursive) - (should-not (file-directory-p tmp-name1))))) + (should-not (file-directory-p tmp-name1)) + + ;; Trashing directories works only since Emacs 27.1. It doesn't + ;; work for crypted remote directories. + (when (and (not (tramp--test-crypt-p)) (tramp--test-emacs27-p)) + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (delete-by-moving-to-trash t)) + (make-directory trash-directory) + ;; Delete empty directory. + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (delete-directory tmp-name1 nil 'trash) + (should-not (file-directory-p tmp-name1)) + (should + (file-exists-p + (expand-file-name + (file-name-nondirectory tmp-name1) trash-directory))) + (delete-directory trash-directory 'recursive) + (should-not (file-exists-p trash-directory)) + ;; Delete non-empty directory. + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (write-region "foo" nil (expand-file-name "bla" tmp-name1)) + (should (file-exists-p (expand-file-name "bla" tmp-name1))) + (make-directory tmp-name2) + (should (file-directory-p tmp-name2)) + (write-region "foo" nil (expand-file-name "bla" tmp-name2)) + (should (file-exists-p (expand-file-name "bla" tmp-name2))) + (should-error + (delete-directory tmp-name1 nil 'trash) + ;; tramp-rclone.el calls the local `delete-directory'. + ;; This raises another error. + :type (if (tramp--test-rclone-p) 'error 'file-error)) + (delete-directory tmp-name1 'recursive 'trash) + (should-not (file-directory-p tmp-name1)) + (should + (file-exists-p + (format + "%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1)))) + (should + (file-exists-p + (format + "%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1) + (file-name-nondirectory tmp-name2)))) + (delete-directory trash-directory 'recursive) + (should-not (file-exists-p trash-directory))))))) (ert-deftest tramp-test15-copy-directory () "Check `copy-directory'." @@ -4367,6 +4431,22 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-match "foo" (buffer-string)))) ;; Cleanup. + (ignore-errors (delete-process proc))) + + ;; PTY. + (unwind-protect + (with-temp-buffer + ;; It works only for tramp-sh.el, and not direct async processes. + (if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p)) + (should-error + (start-file-process "test4" (current-buffer) nil) + :type 'wrong-type-argument) + (setq proc (start-file-process "test4" (current-buffer) nil)) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (should (stringp (process-tty-name proc))))) + + ;; Cleanup. (ignore-errors (delete-process proc)))))) (defmacro tramp--test--deftest-direct-async-process @@ -4713,215 +4793,128 @@ INPUT, if non-nil, is a string sent to the process." ;; This test is inspired by Bug#39067. (ert-deftest tramp-test32-shell-command-dont-erase-buffer () "Check `shell-command-dont-erase-buffer'." - :tags '(:expensive-test) + ;; As long as Bug#40896 is not solved both in simple.el and Tramp, + ;; this test cannot run properly. + :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (skip-unless (not (tramp--test-crypt-p))) ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. (skip-unless (tramp--test-emacs27-p)) - ;; We check both the local and remote case, in order to guarantee - ;; that they behave similar. - (dolist (default-directory - `(,temporary-file-directory ,tramp-test-temporary-file-directory)) - (let ((buffer (generate-new-buffer "foo")) - ;; Suppress nasty messages. - (inhibit-message t) - point kill-buffer-query-functions) - (unwind-protect - (progn - ;; Don't erase if buffer is the current one. Point is not moved. - (let (shell-command-dont-erase-buffer) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - (should (= point (point))) - (should-not (= (point) (point-max))))) - - ;; Erase if the buffer is not current one. Point is not moved. - (let (shell-command-dont-erase-buffer) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "baz\n" (buffer-string))) - (should (= point (point))) - (should-not (= (point) (point-max))))) - - ;; Erase if buffer is the current one, but - ;; `shell-command-dont-erase-buffer' is set to `erase'. - ;; There is no point to check point. - (let ((shell-command-dont-erase-buffer 'erase)) - (with-temp-buffer - (insert "bar") - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "baz\n" (buffer-string))) - ;; In the local case, point is not moved after the - ;; inserted text. - (should (= (point) - (if (file-remote-p default-directory) - (point-max) (point-min)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `beg-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'beg-last-out)) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `beg-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'beg-last-out)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `end-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'end-last-out)) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; This does not work as expected in the local case. - ;; Therefore, we negate the test for the time being. - (should-not - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= point (point)))) - (should - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `end-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'end-last-out)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should-not (= point (point))) - (should (= (point) (point-max)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `save-point'. Check point. - (let ((shell-command-dont-erase-buffer 'save-point)) - (with-temp-buffer - (insert "bar") - (goto-char (1- (point-max))) - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (1- (point-max)))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "babaz\nr" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `save-point'. Check point. - (let ((shell-command-dont-erase-buffer 'save-point)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (goto-char (1- (point-max))) - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (1- (point-max)))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - ;; This does not work as expected. Therefore, we - ;; use the "wrong" string. - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to a random - ;; value. Check point. - (let ((shell-command-dont-erase-buffer 'random)) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; This does not work as expected in the local case. - ;; Therefore, we negate the test for the time being. - (should-not - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= point (point)))) - (should - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to a random - ;; value. Check point. - (let ((shell-command-dont-erase-buffer 'random)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should-not (= point (point))) - (should (= (point) (point-max))))))) - - ;; Cleanup. - (ignore-errors (kill-buffer buffer)))))) + ;; (message " s-c-d-e-b current-buffer buffer-string point") + ;; (message "===============================================") + + ;; s-c-d-e-b current-buffer buffer-string point + ;; =============================================== + ;; nil t foobazzbar 4 x + ;; nil nil bazz 5 + ;; ----------------------------------------------- + ;; erase t bazz 1 x + ;; erase nil bazz 5 + ;; ----------------------------------------------- + ;; beg-last-out t foobazzbar 4 x + ;; beg-last-out nil foobarbazz 7 + ;; ----------------------------------------------- + ;; end-last-out t foobazzbar 4 + ;; end-last-out nil foobazzbar 11 + ;; ----------------------------------------------- + ;; save-point t foobazzbar 4 x + ;; save-point nil foobarbazz 4 x + ;; ----------------------------------------------- + ;; random t foobazzbar 4 + ;; random nil foobazzbar 11 + ;; ----------------------------------------------- + + (let (;; Suppress nasty messages. + (inhibit-message t) + buffer kill-buffer-query-functions) + ;; We check both the local and remote case, in order to guarantee + ;; that they behave similar. + (dolist (default-directory + `(,temporary-file-directory ,tramp-test-temporary-file-directory)) + ;; These are the possible values of `shell-command-dont-erase-buffer'. + ;; `random' is taken as non-nil value without special meaning. + (dolist (shell-command-dont-erase-buffer + '(nil erase beg-last-out end-last-out save-point random)) + ;; `shell-command' might work over the current buffer, or not. + (dolist (current '(t nil)) + (with-temp-buffer + ;; We insert the string "foobar" into an empty buffer. + ;; Point is set between "foo" and "bar". + (setq buffer (current-buffer)) + (insert "foobar") + (goto-char (- (point) 3)) + (should (string-equal "foobar" (buffer-string))) + (should (string-equal "foo" (buffer-substring (point-min) (point)))) + (should (string-equal "bar" (buffer-substring (point) (point-max)))) + + ;; Apply `shell-command'. It shall output the string + ;; "bazz". Messages in the *Messages* buffer are + ;; suppressed. + (let (message-log-max) + (if current + (shell-command "echo -n bazz" (current-buffer)) + (with-temp-buffer (shell-command "echo -n bazz" buffer)))) + + ;; (message + ;; "%12s %14s %13s %5d" + ;; shell-command-dont-erase-buffer current (buffer-string) (point)))) + ;; (message "-----------------------------------------------"))))) + + ;; Check result. + (cond + (current + ;; String is inserted at point, and point is preserved + ;; unless dictated otherwise. + (cond + ((null shell-command-dont-erase-buffer) + (should (string-equal "foobazzbar" (buffer-string))) + (should (= 4 (point)))) + ((eq shell-command-dont-erase-buffer 'erase) + (should (string-equal "bazz" (buffer-string))) + (should (= 1 (point)))) + ((eq shell-command-dont-erase-buffer 'beg-last-out) + (should (string-equal "foobazzbar" (buffer-string))) + (should (= 4 (point)))) + ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'end-last-out) + ;; (should (string-equal "foobazzbar" (buffer-string))) + ;; (should (= 7 (point)))) + ((eq shell-command-dont-erase-buffer 'save-point) + (should (string-equal "foobazzbar" (buffer-string))) + (should (= 4 (point)))) + ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'random) + ;; (should (string-equal "foobazzbar" (buffer-string))) + ;; (should (= 7 (point)))))) + )) + + (t ;; not current buffer + ;; String is appended, and point is at point-max unless + ;; dictated otherwise. + (cond + ((null shell-command-dont-erase-buffer) + (should (string-equal "bazz" (buffer-string))) + (should (= 5 (point)))) + ((eq shell-command-dont-erase-buffer 'erase) + (should (string-equal "bazz" (buffer-string))) + (should (= 5 (point)))) + ((eq shell-command-dont-erase-buffer 'beg-last-out) + (should (string-equal "foobarbazz" (buffer-string))) + (should (= 7 (point)))) + ;; ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'end-last-out) + ;; (should (string-equal "foobarbazz" (buffer-string))) + ;; (should (= 11 (point)))) + ((eq shell-command-dont-erase-buffer 'save-point) + (should (string-equal "foobarbazz" (buffer-string))) + (should (= 4 (point)))) + ;; ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'random) + ;; (should (string-equal "foobarbazz" (buffer-string))) + ;; (should (= 11 (point))))))))))))) + ))))))))) ;; This test is inspired by Bug#23952. (ert-deftest tramp-test33-environment-variables () diff --git a/test/lisp/nxml/nxml-mode-tests.el b/test/lisp/nxml/nxml-mode-tests.el index 624e5c8866d..54d3bd8d132 100644 --- a/test/lisp/nxml/nxml-mode-tests.el +++ b/test/lisp/nxml/nxml-mode-tests.el @@ -132,5 +132,26 @@ <sub/> </t>")))) +(ert-deftest nxml-mode-test-comment-bug-17264 () + "Test for Bug#17264." + (with-temp-buffer + (nxml-mode) + (let ((data "<?xml version=\"1.0\" encoding=\"UTF-8\"?> +<spocosy version=\"1.0\" responsetime=\"2011-03-15 13:53:12\" exec=\"0.171\"> + <!-- + <query-response requestid=\"\" service=\"objectquery\"> + <sport name=\"Soccer\" enetSportCode=\"s\" del=\"no\" n=\"1\" ut=\"2009-12-29 + 15:36:24\" id=\"1\"> + </sport> + </query-response> + --> +</spocosy> +")) + (insert data) + (goto-char (point-min)) + (search-forward "<query-response") + ;; Inside comment + (should (eq (nth 4 (syntax-ppss)) t))))) + (provide 'nxml-mode-tests) ;;; nxml-mode-tests.el ends here diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el index 37061df0a7a..3f3fda3638e 100644 --- a/test/lisp/obsolete/cl-tests.el +++ b/test/lisp/obsolete/cl-tests.el @@ -21,7 +21,8 @@ ;;; Code: -(require 'cl) +(with-no-warnings + (require 'cl)) (require 'ert) diff --git a/test/lisp/org/org-tests.el b/test/lisp/org/org-tests.el index 918d79b8dcd..6e91dd28649 100644 --- a/test/lisp/org/org-tests.el +++ b/test/lisp/org/org-tests.el @@ -1,4 +1,4 @@ -;;; org-tests.el --- tests for org/org.el +;;; org-tests.el --- tests for org/org.el -*- lexical-binding:t -*- ;; Copyright (C) 2018-2020 Free Software Foundation, Inc. diff --git a/test/lisp/pcmpl-linux-tests.el b/test/lisp/pcmpl-linux-tests.el index cf7e6288fdb..91a9965483a 100644 --- a/test/lisp/pcmpl-linux-tests.el +++ b/test/lisp/pcmpl-linux-tests.el @@ -22,25 +22,17 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'pcmpl-linux) -(defvar pcmpl-linux-tests-data-dir - (file-truename - (expand-file-name "pcmpl-linux-resources/" - (file-name-directory (or load-file-name - buffer-file-name)))) - "Base directory of pcmpl-linux-tests.el data files.") - (ert-deftest pcmpl-linux-test-fs-types () - (let ((pcmpl-linux-fs-modules-path-format (expand-file-name "fs" - pcmpl-linux-tests-data-dir))) + (let ((pcmpl-linux-fs-modules-path-format (ert-resource-file "fs"))) ;; FIXME: Shouldn't return "." and ".." (should (equal (pcmpl-linux-fs-types) '("." ".." "ext4"))))) (ert-deftest pcmpl-linux-test-mounted-directories () - (let ((pcmpl-linux-mtab-file (expand-file-name "mtab" - pcmpl-linux-tests-data-dir))) + (let ((pcmpl-linux-mtab-file (ert-resource-file "mtab"))) (should (equal (pcmpl-linux-mounted-directories) '("/" "/dev" "/dev/pts" "/dev/shm" "/home/alice/.gvfs" "/lib/modules/2.6.24-16-generic/volatile" "/proc" "/sys" diff --git a/test/lisp/play/animate-tests.el b/test/lisp/play/animate-tests.el index 8af1517ffa4..7c41d3b7761 100644 --- a/test/lisp/play/animate-tests.el +++ b/test/lisp/play/animate-tests.el @@ -36,8 +36,8 @@ -Happy Birthday, - Foo + Happy Birthday, + Foo You are my sunshine, diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 819f2e78c2a..b8ed6e0e76b 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -35,316 +35,358 @@ ;; what's reported in the string. The end column numbers are for ;; the character after, so it matches what's reported in the string. '(;; absoft - ("Error on line 3 of t.f: Execution error unclassifiable statement" + (absoft + "Error on line 3 of t.f: Execution error unclassifiable statement" 1 nil 3 "t.f") - ("Line 45 of \"foo.c\": bloofle undefined" + (absoft "Line 45 of \"foo.c\": bloofle undefined" 1 nil 45 "foo.c") - ("error on line 19 of fplot.f: spelling error?" + (absoft "error on line 19 of fplot.f: spelling error?" 1 nil 19 "fplot.f") - ("warning on line 17 of fplot.f: data type is undefined for variable d" + (absoft + "warning on line 17 of fplot.f: data type is undefined for variable d" 1 nil 17 "fplot.f") ;; Ada & Mpatrol - ("foo.adb:61:11: [...] in call to size declared at foo.ads:11" + (gnu "foo.adb:61:11: [...] in call to size declared at foo.ads:11" 1 11 61 "foo.adb") - ("foo.adb:61:11: [...] in call to size declared at foo.ads:11" + (ada "foo.adb:61:11: [...] in call to size declared at foo.ads:11" 52 nil 11 "foo.ads") - (" 0x8008621 main+16 at error.c:17" + (ada " 0x8008621 main+16 at error.c:17" 23 nil 17 "error.c") ;; aix - ("****** Error number 140 in line 8 of file errors.c ******" + (aix "****** Error number 140 in line 8 of file errors.c ******" 25 nil 8 "errors.c") ;; ant - ("[javac] /src/DataBaseTestCase.java:27: unreported exception ..." + (ant "[javac] /src/DataBaseTestCase.java:27: unreported exception ..." 13 nil 27 "/src/DataBaseTestCase.java" 2) - ("[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" + (ant "[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" 13 nil 49 "/src/DataBaseTestCase.java" 1) - ("[jikes] foo.java:3:5:7:9: blah blah" + (ant "[jikes] foo.java:3:5:7:9: blah blah" 14 (5 . 10) (3 . 7) "foo.java" 2) - ("[javac] c:/cygwin/Test.java:12: error: foo: bar" + (ant "[javac] c:/cygwin/Test.java:12: error: foo: bar" 9 nil 12 "c:/cygwin/Test.java" 2) - ("[javac] c:\\cygwin\\Test.java:87: error: foo: bar" + (ant "[javac] c:\\cygwin\\Test.java:87: error: foo: bar" 9 nil 87 "c:\\cygwin\\Test.java" 2) ;; Checkstyle error, but ant reports a warning (note additional ;; severity level after task name) - ("[checkstyle] [ERROR] /src/Test.java:38: warning: foo" + (ant "[checkstyle] [ERROR] /src/Test.java:38: warning: foo" 22 nil 38 "/src/Test.java" 1) ;; bash - ("a.sh: line 1: ls-l: command not found" + (bash "a.sh: line 1: ls-l: command not found" 1 nil 1 "a.sh") ;; borland - ("Error ping.c 15: Unable to open include file 'sys/types.h'" + (borland "Error ping.c 15: Unable to open include file 'sys/types.h'" 1 nil 15 "ping.c") - ("Warning pong.c 68: Call to function 'func' with no prototype" + (borland "Warning pong.c 68: Call to function 'func' with no prototype" 1 nil 68 "pong.c") - ("Error E2010 ping.c 15: Unable to open include file 'sys/types.h'" + (borland "Error E2010 ping.c 15: Unable to open include file 'sys/types.h'" 1 nil 15 "ping.c") - ("Warning W1022 pong.c 68: Call to function 'func' with no prototype" + (borland + "Warning W1022 pong.c 68: Call to function 'func' with no prototype" 1 nil 68 "pong.c") ;; caml - ("File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" + (python-tracebacks-and-caml + "File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" 1 (20 . 156) (5 . 8) "foobar.ml") - ("File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." + (python-tracebacks-and-caml + "File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." 1 (2 . 146) 65 "F:\\ocaml\\sorting.ml") - ("File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" + (python-tracebacks-and-caml + "File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" 1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py") - ("File \\lib\\python\\Products\\PythonScripts\\PythonScript.py, line 302, in _exec" + (python-tracebacks-and-caml + "File \\lib\\python\\Products\\PythonScripts\\PythonScript.py, line 302, in _exec" 1 nil 302 "\\lib\\python\\Products\\PythonScripts\\PythonScript.py") - ("File \"/tmp/foo.py\", line 10" + (python-tracebacks-and-caml + "File \"/tmp/foo.py\", line 10" 1 nil 10 "/tmp/foo.py") ;; clang-include - ("In file included from foo.cpp:2:" + (clang-include "In file included from foo.cpp:2:" 1 nil 2 "foo.cpp" 0) ;; cmake cmake-info - ("CMake Error at CMakeLists.txt:23 (hurz):" + (cmake "CMake Error at CMakeLists.txt:23 (hurz):" 1 nil 23 "CMakeLists.txt") - ("CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" + (cmake "CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" 1 nil 73 "cmake/modules/UseUG.cmake") - (" cmake/modules/DuneGridMacros.cmake:19 (include)" + (cmake-info " cmake/modules/DuneGridMacros.cmake:19 (include)" 1 nil 19 "cmake/modules/DuneGridMacros.cmake") ;; comma - ("\"foo.f\", line 3: Error: syntax error near end of statement" + (comma "\"foo.f\", line 3: Error: syntax error near end of statement" 1 nil 3 "foo.f") - ("\"vvouch.c\", line 19.5: 1506-046 (S) Syntax error." + (comma "\"vvouch.c\", line 19.5: 1506-046 (S) Syntax error." 1 5 19 "vvouch.c") - ("\"foo.c\", line 32 pos 1; (E) syntax error; unexpected symbol: \"lossage\"" + (comma "\"foo.c\", line 32 pos 1; (E) syntax error; unexpected symbol: \"lossage\"" 1 1 32 "foo.c") - ("\"foo.adb\", line 2(11): warning: file name does not match ..." + (comma "\"foo.adb\", line 2(11): warning: file name does not match ..." 1 11 2 "foo.adb") - ("\"src/swapping.c\", line 30.34: 1506-342 (W) \"/*\" detected in comment." + (comma + "\"src/swapping.c\", line 30.34: 1506-342 (W) \"/*\" detected in comment." 1 34 30 "src/swapping.c") ;; cucumber - ("Scenario: undefined step # features/cucumber.feature:3" + (cucumber "Scenario: undefined step # features/cucumber.feature:3" 29 nil 3 "features/cucumber.feature") - (" /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" + (gnu " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" 1 nil 500 "/home/gusev/.rvm/foo/bar.rb") ;; edg-1 edg-2 - ("build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" + (edg-1 "build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" 1 nil 42 "build/intel/debug/../../../struct.cpp") - ("build/intel/debug/struct.cpp(44): warning #1011: missing return statement at end of" + (edg-1 "build/intel/debug/struct.cpp(44): warning #1011: missing return statement at end of" 1 nil 44 "build/intel/debug/struct.cpp") - ("build/intel/debug/iptr.h(302): remark #981: operands are evaluated in unspecified order" + (edg-1 "build/intel/debug/iptr.h(302): remark #981: operands are evaluated in unspecified order" 1 nil 302 "build/intel/debug/iptr.h") - (" detected during ... at line 62 of \"build/intel/debug/../../../trace.h\"" + (edg-2 " detected during ... at line 62 of \"build/intel/debug/../../../trace.h\"" 31 nil 62 "build/intel/debug/../../../trace.h") ;; epc - ("Error 24 at (2:progran.f90) : syntax error" + (epc "Error 24 at (2:progran.f90) : syntax error" 1 nil 2 "progran.f90") ;; ftnchek - (" Dummy arg W in module SUBA line 8 file arrayclash.f is array" + (ftnchek " Dummy arg W in module SUBA line 8 file arrayclash.f is array" 32 nil 8 "arrayclash.f") - (" L4 used at line 55 file test/assign.f; never set" + (ftnchek " L4 used at line 55 file test/assign.f; never set" 16 nil 55 "test/assign.f") - ("Warning near line 10 file arrayclash.f: Module contains no executable" + (ftnchek + "Warning near line 10 file arrayclash.f: Module contains no executable" 1 nil 10 "arrayclash.f") - ("Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit" + (ftnchek "Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit" 24 9 31 "assign.f") ;; iar - ("\"foo.c\",3 Error[32]: Error message" + (iar "\"foo.c\",3 Error[32]: Error message" 1 nil 3 "foo.c") - ("\"foo.c\",3 Warning[32]: Error message" + (iar "\"foo.c\",3 Warning[32]: Error message" 1 nil 3 "foo.c") ;; ibm - ("foo.c(2:0) : informational EDC0804: Function foo is not referenced." + (ibm "foo.c(2:0) : informational EDC0804: Function foo is not referenced." 1 0 2 "foo.c") - ("foo.c(3:8) : warning EDC0833: Implicit return statement encountered." + (ibm "foo.c(3:8) : warning EDC0833: Implicit return statement encountered." 1 8 3 "foo.c") - ("foo.c(5:5) : error EDC0350: Syntax error." + (ibm "foo.c(5:5) : error EDC0350: Syntax error." 1 5 5 "foo.c") ;; irix - ("ccom: Error: foo.c, line 2: syntax error" + (irix "ccom: Error: foo.c, line 2: syntax error" 1 nil 2 "foo.c") - ("cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file <panel.h> ..." + (irix "cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file <panel.h> ..." 1 nil 17 "/src/Python-2.3.3/Modules/_curses_panel.c") - ("cc: Info: foo.c, line 27: ..." + (irix "cc: Info: foo.c, line 27: ..." 1 nil 27 "foo.c") - ("cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ..." + (irix + "cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ..." 1 nil 2 "foo.c") - ("cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ..." + (irix + "cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ..." 1 nil 170 "xfe.c") - ("/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah" + (irix "/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah" 1 nil 1 "foo.c") - ("/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah" + (irix "/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah" 1 nil 1 "foo.c") - ("foo bar: baz.f, line 27: ..." + (irix "foo bar: baz.f, line 27: ..." 1 nil 27 "baz.f") ;; java - ("\tat org.foo.ComponentGateway.doGet(ComponentGateway.java:172)" + (java "\tat org.foo.ComponentGateway.doGet(ComponentGateway.java:172)" 5 nil 172 "ComponentGateway.java") - ("\tat javax.servlet.http.HttpServlet.service(HttpServlet.java:740)" + (java "\tat javax.servlet.http.HttpServlet.service(HttpServlet.java:740)" 5 nil 740 "HttpServlet.java") - ("==1332== at 0x4040743C: System::getErrorString() (../src/Lib/System.cpp:217)" + (java "==1332== at 0x4040743C: System::getErrorString() (../src/Lib/System.cpp:217)" 13 nil 217 "../src/Lib/System.cpp") - ("==1332== by 0x8008621: main (vtest.c:180)" + (java "==1332== by 0x8008621: main (vtest.c:180)" 13 nil 180 "vtest.c") ;; javac - ("/src/Test.java:5: ';' expected\n foo foo\n ^\n" 1 15 5 "/src/Test.java" 2) - ("e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n" 1 10 7 "e:\\src\\Test.java" 1) + (javac + "/src/Test.java:5: ';' expected\n foo foo\n ^\n" + 1 15 5 "/src/Test.java" 2) + (javac + "e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n" + 1 10 7 "e:\\src\\Test.java" 1) ;; jikes-file jikes-line - ("Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":" + (jikes-file + "Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":" 1 nil nil "../javax/swing/BorderFactory.java") - ("Issued 1 semantic warning compiling \"java/awt/Toolkit.java\":" + (jikes-file "Issued 1 semantic warning compiling \"java/awt/Toolkit.java\":" 1 nil nil "java/awt/Toolkit.java") ;; gcc-include - ("In file included from /usr/include/c++/3.3/backward/warn.h:4," + (gcc-include "In file included from /usr/include/c++/3.3/backward/warn.h:4," 1 nil 4 "/usr/include/c++/3.3/backward/warn.h") - (" from /usr/include/c++/3.3/backward/iostream.h:31:0," + (gcc-include + " from /usr/include/c++/3.3/backward/iostream.h:31:0," 1 0 31 "/usr/include/c++/3.3/backward/iostream.h") - (" from test_clt.cc:1:" + (gcc-include " from test_clt.cc:1:" 1 nil 1 "test_clt.cc") ;; gmake - ("make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) - ("make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 "sub/make.mk" 0) - ("gmake[4]: *** [sub/make.mk:19: all] Error 2" 16 nil 19 "sub/make.mk" 0) - ("gmake-4.3[4]: *** [make.mk:1119: all] Error 2" 20 nil 1119 "make.mk" 0) - ("Make-4.3: *** [make.INC:1119: dir/all] Error 2" 16 nil 1119 "make.INC" 0) + (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) + (gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 + "sub/make.mk" 0) + (gmake "gmake[4]: *** [sub/make.mk:19: all] Error 2" 16 nil 19 + "sub/make.mk" 0) + (gmake "gmake-4.3[4]: *** [make.mk:1119: all] Error 2" 20 nil 1119 + "make.mk" 0) + (gmake "Make-4.3: *** [make.INC:1119: dir/all] Error 2" 16 nil 1119 + "make.INC" 0) ;; gnu - ("foo.c:8: message" 1 nil 8 "foo.c") - ("../foo.c:8: W: message" 1 nil 8 "../foo.c") - ("/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c") - ("foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py") - ("foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py") - ("foo.c:8:I: message" 1 nil 8 "foo.c") - ("foo.c:8.23: note: message" 1 23 8 "foo.c") - ("foo.c:8.23: info: message" 1 23 8 "foo.c") - ("foo.c:8:23:information: message" 1 23 8 "foo.c") - ("foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c") - ("foo.c:8-23: message" 1 nil (8 . 23) "foo.c") + (gnu "foo.c:8: message" 1 nil 8 "foo.c") + (gnu "../foo.c:8: W: message" 1 nil 8 "../foo.c") + (gnu "/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c") + (gnu "foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py") + (gnu "foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py") + (gnu "foo.c:8:I: message" 1 nil 8 "foo.c") + (gnu "foo.c:8.23: note: message" 1 23 8 "foo.c") + (gnu "foo.c:8.23: info: message" 1 23 8 "foo.c") + (gnu "foo.c:8:23:information: message" 1 23 8 "foo.c") + (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c") + (gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c") ;; The next one is not in the GNU standards AFAICS. ;; Here we seem to interpret it as LINE1-LINE2.COL2. - ("foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c") - ("foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c") - ("jade:dbcommon.dsl:133:17:E: missing argument for function call" + (gnu "foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c") + (gnu "foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c") + (gnu "jade:dbcommon.dsl:133:17:E: missing argument for function call" 1 17 133 "dbcommon.dsl") - ("G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." + (gnu "G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." 1 nil 54 "G:/cygwin/dev/build-myproj.xml") - ("file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." + (gnu "file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." 1 nil 54 "G:/cygwin/dev/build-myproj.xml") - ("{standard input}:27041: Warning: end of file not at end of a line; newline inserted" + (gnu "{standard input}:27041: Warning: end of file not at end of a line; newline inserted" 1 nil 27041 "{standard input}") - ("boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ]" + (gnu "boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ]" 1 25 589 "boost/container/detail/flat_tree.hpp" 0) ;; gradle-kotlin - ("e: /src/Test.kt: (34, 15): foo: bar" 4 15 34 "/src/Test.kt" 2) - ("w: /src/Test.kt: (11, 98): foo: bar" 4 98 11 "/src/Test.kt" 1) - ("e: e:/cygwin/src/Test.kt: (34, 15): foo: bar" 4 15 34 "e:/cygwin/src/Test.kt" 2) - ("w: e:/cygwin/src/Test.kt: (11, 98): foo: bar" 4 98 11 "e:/cygwin/src/Test.kt" 1) - ("e: e:\\src\\Test.kt: (34, 15): foo: bar" 4 15 34 "e:\\src\\Test.kt" 2) - ("w: e:\\src\\Test.kt: (11, 98): foo: bar" 4 98 11 "e:\\src\\Test.kt" 1) + (gradle-kotlin + "e: /src/Test.kt: (34, 15): foo: bar" 4 15 34 "/src/Test.kt" 2) + (gradle-kotlin + "w: /src/Test.kt: (11, 98): foo: bar" 4 98 11 "/src/Test.kt" 1) + (gradle-kotlin + "e: e:/cygwin/src/Test.kt: (34, 15): foo: bar" + 4 15 34 "e:/cygwin/src/Test.kt" 2) + (gradle-kotlin + "w: e:/cygwin/src/Test.kt: (11, 98): foo: bar" + 4 98 11 "e:/cygwin/src/Test.kt" 1) + (gradle-kotlin + "e: e:\\src\\Test.kt: (34, 15): foo: bar" 4 15 34 "e:\\src\\Test.kt" 2) + (gradle-kotlin + "w: e:\\src\\Test.kt: (11, 98): foo: bar" 4 98 11 "e:\\src\\Test.kt" 1) ;; Guile - ("In foo.scm:\n" 1 nil nil "foo.scm") - (" 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) - ("1038: 1 [main (\"gud-break.scm\")]" 1 1 1038 nil) + (guile-file "In foo.scm:\n" 1 nil nil "foo.scm") + (guile-line " 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) + (guile-line "1038: 1 [main (\"gud-break.scm\")]" 1 1 1038 nil) ;; lcc - ("E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc") - ("W, file.cc(36,52) blah blah" 1 52 36 "file.cc") + (lcc "E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc") + (lcc "W, file.cc(36,52) blah blah" 1 52 36 "file.cc") ;; makepp - ("makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c") - ("makepp: warning: bla bla `/foo/bar.c' and `/foo/bar.h'" 27 nil nil "/foo/bar.c") - ("makepp: bla bla `/foo/Makeppfile:12' bla" 18 nil 12 "/foo/Makeppfile") - ("makepp: bla bla `/foo/bar.c' and `/foo/bar.h'" 35 nil nil "/foo/bar.h") + (makepp "makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c") + (makepp "makepp: warning: bla bla `/foo/bar.c' and `/foo/bar.h'" + 27 nil nil "/foo/bar.c") + (makepp "makepp: bla bla `/foo/Makeppfile:12' bla" + 18 nil 12 "/foo/Makeppfile") + (nil "makepp: bla bla `/foo/bar.c' and `/foo/bar.h'" + 35 nil nil "/foo/bar.h") ;; maven - ("FooBar.java:[111,53] no interface expected here" + (maven "FooBar.java:[111,53] no interface expected here" 1 53 111 "FooBar.java" 2) - ("[ERROR] /Users/cinsk/hello.java:[651,96] ';' expected" + (maven "[ERROR] /Users/cinsk/hello.java:[651,96] ';' expected" 15 96 651 "/Users/cinsk/hello.java" 2) ;Bug#11517. - ("[WARNING] /foo/bar/Test.java:[27,43] unchecked conversion" + (maven "[WARNING] /foo/bar/Test.java:[27,43] unchecked conversion" 11 43 27 "/foo/bar/Test.java" 1) ;Bug#20556 ;; mips-1 mips-2 - ("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" + (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" 11 nil 255 "solomon.c") - ("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" + (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" 70 nil 93 "solomo.c") - ("name defined but never used: LinInt in cmap_calc.c(199)" + (mips-2 "name defined but never used: LinInt in cmap_calc.c(199)" 40 nil 199 "cmap_calc.c") ;; msft - ("keyboard handler.c(537) : warning C4005: 'min' : macro redefinition" + (msft "keyboard handler.c(537) : warning C4005: 'min' : macro redefinition" 1 nil 537 "keyboard handler.c") - ("d:\\tmp\\test.c(23) : error C2143: syntax error : missing ';' before 'if'" + (msft + "d:\\tmp\\test.c(23) : error C2143: syntax error : missing ';' before 'if'" 1 nil 23 "d:\\tmp\\test.c") - ("d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'" + (msft "d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'" 1 nil 1145 "d:\\tmp\\test.c") - ("1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'" + (msft "1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'" 3 nil 29 "test_main.cpp") - ("1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int" + (msft "1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int" 3 nil 29 "test_main.cpp") - ("C:\\tmp\\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [C:\\tmp\\project.vcxproj]" + (msft "C:\\tmp\\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [C:\\tmp\\project.vcxproj]" 1 11 101 "C:\\tmp\\test.cpp") ;; watcom - ("..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'" + (watcom + "..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'" 1 nil 109 "..\\src\\ctrl\\lister.c") - ("..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" + (watcom "..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" 1 nil 120 "..\\src\\ctrl\\lister.c") ;; omake - (" alpha.c:5:15: error: expected ';' after expression" + ;; FIXME: This doesn't actually test the omake rule. + (gnu " alpha.c:5:15: error: expected ';' after expression" 1 15 5 "alpha.c") ;; oracle - ("Semantic error at line 528, column 5, file erosacqdb.pc:" + (oracle "Semantic error at line 528, column 5, file erosacqdb.pc:" 1 5 528 "erosacqdb.pc") - ("Error at line 41, column 10 in file /usr/src/sb/ODBI_BHP.hpp" + (oracle "Error at line 41, column 10 in file /usr/src/sb/ODBI_BHP.hpp" 1 10 41 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-02150: error at line 49, column 27 in file /usr/src/sb/ODBI_dxfgh.pc" + (oracle + "PCC-02150: error at line 49, column 27 in file /usr/src/sb/ODBI_dxfgh.pc" 1 27 49 "/usr/src/sb/ODBI_dxfgh.pc") - ("PCC-00003: invalid SQL Identifier at column name in line 12 of file /usr/src/sb/ODBI_BHP.hpp" + (oracle "PCC-00003: invalid SQL Identifier at column name in line 12 of file /usr/src/sb/ODBI_BHP.hpp" 1 nil 12 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-00004: mismatched IF/ELSE/ENDIF block at line 27 in file /usr/src/sb/ODBI_BHP.hpp" + (oracle "PCC-00004: mismatched IF/ELSE/ENDIF block at line 27 in file /usr/src/sb/ODBI_BHP.hpp" 1 nil 27 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-02151: line 21 column 40 file /usr/src/sb/ODBI_BHP.hpp:" + (oracle "PCC-02151: line 21 column 40 file /usr/src/sb/ODBI_BHP.hpp:" 1 40 21 "/usr/src/sb/ODBI_BHP.hpp") ;; perl - ("syntax error at automake line 922, near \"':'\"" + (perl "syntax error at automake line 922, near \"':'\"" 14 nil 922 "automake") - ("Died at test.pl line 27." + (perl "Died at test.pl line 27." 6 nil 27 "test.pl") - ("store::odrecall('File_A', 'x2') called at store.pm line 90" + (perl "store::odrecall('File_A', 'x2') called at store.pm line 90" 40 nil 90 "store.pm") - ("\t(in cleanup) something bad at foo.pl line 3 during global destruction." + (perl + "\t(in cleanup) something bad at foo.pl line 3 during global destruction." 29 nil 3 "foo.pl") - ("GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." + (perl "GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." 130 nil 3 "t-compilation-perl-gtk.pl") ;; php - ("Parse error: parse error, unexpected $ in main.php on line 59" + (php "Parse error: parse error, unexpected $ in main.php on line 59" 1 nil 59 "main.php") - ("Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66" + (php "Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66" 1 nil 66 "db.inc") - ;; ruby - ("plain-exception.rb:7:in `fun': unhandled exception" + ;; ruby (uses gnu) + (gnu "plain-exception.rb:7:in `fun': unhandled exception" 1 nil 7 "plain-exception.rb") - ("\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb") - ("\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb") + (gcc-include + "\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb") + (gcc-include "\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb") ;; ruby-Test::Unit ;; FIXME - (" [examples/test-unit.rb:28:in `here_is_a_deep_assert'" + (ruby-Test::Unit " [examples/test-unit.rb:28:in `here_is_a_deep_assert'" 5 nil 28 "examples/test-unit.rb") - (" examples/test-unit.rb:19:in `test_a_deep_assert']:" + (ruby-Test::Unit " examples/test-unit.rb:19:in `test_a_deep_assert']:" 6 nil 19 "examples/test-unit.rb") - ("examples/test-unit.rb:10:in `test_assert_raise'" + (gnu "examples/test-unit.rb:10:in `test_assert_raise'" 1 nil 10 "examples/test-unit.rb") ;; rxp - ("Error: Mismatched end tag: expected </geroup>, got </group>\nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" + (rxp "Error: Mismatched end tag: expected </geroup>, got </group>\nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" 1 8 71 "/home/reto/test/group.xml") - ("Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" + (rxp "Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" 1 8 4 "/home/reto/test/group.xml") + ;; shellcheck + (shellcheck "In autogen.sh line 48:" + 1 nil 48 "autogen.sh") ;; sparc-pascal-file sparc-pascal-line sparc-pascal-example - ("Thu May 14 10:46:12 1992 mom3.p:" + (sparc-pascal-file "Thu May 14 10:46:12 1992 mom3.p:" 1 nil nil "mom3.p") ;; sun - ("cc-1020 CC: REMARK File = CUI_App.h, Line = 735" + (sun "cc-1020 CC: REMARK File = CUI_App.h, Line = 735" 13 nil 735 "CUI_App.h") - ("cc-1070 cc: WARNING File = linkl.c, Line = 38" + (sun "cc-1070 cc: WARNING File = linkl.c, Line = 38" 13 nil 38 "linkl.c") - ("cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3" + (sun "cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3" 18 3 16 "Hoved.f90") ;; sun-ada - ("/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: \",\" inserted" + (sun-ada "/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: \",\" inserted" 1 6 361 "/home3/xdhar/rcds_rc/main.a") ;; 4bsd - ("/usr/src/foo/foo.c(8): warning: w may be used before set" + (edg-1 "/usr/src/foo/foo.c(8): warning: w may be used before set" 1 nil 8 "/usr/src/foo/foo.c") - ("/usr/src/foo/foo.c(9): error: w is used before set" + (edg-1 "/usr/src/foo/foo.c(9): error: w is used before set" 1 nil 9 "/usr/src/foo/foo.c") - ("strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)" + (4bsd "strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)" 44 nil 8 "/usr/src/foo/foo.c") - ("bloofle defined( /users/wolfgang/foo.c(4) ), but never used" + (4bsd "bloofle defined( /users/wolfgang/foo.c(4) ), but never used" 18 nil 4 "/users/wolfgang/foo.c") ;; perl--Pod::Checker ;; FIXME @@ -352,21 +394,21 @@ ;; *** ERROR: =over on line 37 without closing =back at line EOF in file bar.pm ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod ;; perl--Test - ("# Failed test 1 in foo.t at line 6" + (perl--Test "# Failed test 1 in foo.t at line 6" 1 nil 6 "foo.t") ;; perl--Test::Harness - ("NOK 1# Test 1 got: \"1234\" (t/foo.t at line 46)" + (perl--Test2 "NOK 1# Test 1 got: \"1234\" (t/foo.t at line 46)" 1 nil 46 "t/foo.t") ;; weblint - ("index.html (13:1) Unknown element <fdjsk>" + (weblint "index.html (13:1) Unknown element <fdjsk>" 1 1 13 "index.html")) "List of tests for `compilation-error-regexp-alist'. -Each element has the form (STR POS COLUMN LINE FILENAME [TYPE]), -where STR is an error string, POS is the position of the error in -STR, COLUMN and LINE are the reported column and line numbers (or -nil) for that error, FILENAME is the reported filename, and TYPE -is 0 for an information message, 1 for a warning, and 2 for an -error. +Each element has the form (RULE STR POS COLUMN LINE FILENAME +[TYPE]), where RULE is the rule (as a symbol), STR is an error +string, POS is the position of the error in STR, COLUMN and LINE +are the reported column and line numbers (or nil) for that error, +FILENAME is the reported filename, and TYPE is 0 for an +information message, 1 for a warning, and 2 for an error. LINE can also be of the form (LINE . END-LINE) meaning a range of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) @@ -376,11 +418,14 @@ any message type is accepted.") (defconst compile-tests--grep-regexp-testcases ;; Bug#32051. - '(("c:/Users/my.name/src/project\\src\\kbhit.hpp\0\ 29:#include <termios.h>" + '((nil + "c:/Users/my.name/src/project\\src\\kbhit.hpp\0\ 29:#include <termios.h>" 1 nil 29 "c:/Users/my.name/src/project\\src\\kbhit.hpp") - ("d:/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + (nil + "d:/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" 1 nil 214 "d:/gnu/emacs/branch/src/callproc.c") - ("/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + (nil + "/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" 1 nil 214 "/gnu/emacs/branch/src/callproc.c")) "List of tests for `grep-regexp-list'. The format is the same as `compile-tests--test-regexps-data', but @@ -389,43 +434,51 @@ with colon.") (defconst compile-tests--grep-regexp-tricky-testcases ;; Bug#7378. - '(("./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0\0\ 42:some text" + '((nil + "./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0\0\ 42:some text" 1 nil 42 "./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0") - ("2011-08-31_11:57:03_1\0\ 7:Date: Wed, 31 Aug 2011 11:57:03 +0000" + (nil + "2011-08-31_11:57:03_1\0\ 7:Date: Wed, 31 Aug 2011 11:57:03 +0000" 1 nil 7 "2011-08-31_11:57:03_1")) "List of tricky tests for `grep-regexp-list'. Same as `compile-tests--grep-regexp-testcases', but these cases can only work with the NUL byte to disambiguate colons.") (defun compile--test-error-line (test) - (erase-buffer) - (setq compilation-locs (make-hash-table)) - (insert (car test)) - (compilation-parse-errors (point-min) (point-max)) - (let ((msg (get-text-property (nth 1 test) 'compilation-message))) - (should msg) - (let ((loc (compilation--message->loc msg)) - (col (nth 2 test)) - (line (nth 3 test)) - (file (nth 4 test)) - (type (nth 5 test)) - end-col end-line) - (if (consp col) - (setq end-col (cdr col) col (car col))) - (if (consp line) - (setq end-line (cdr line) line (car line))) - (should (equal (compilation--loc->col loc) col)) - (should (equal (compilation--loc->line loc) line)) - (when file - (should (equal (caar (compilation--loc->file-struct loc)) file))) - (when end-col - (should (equal (car (cadr (nth 2 (compilation--loc->file-struct loc)))) - end-col))) - (should (equal (car (nth 2 (compilation--loc->file-struct loc))) - (or end-line line))) - (when type - (should (equal type (compilation--message->type msg))))) - msg)) + (ert-info ((format "%S" test) :prefix "testcase: ") + (erase-buffer) + (setq compilation-locs (make-hash-table)) + (let ((rule (nth 0 test)) + (str (nth 1 test)) + (pos (nth 2 test)) + (col (nth 3 test)) + (line (nth 4 test)) + (file (nth 5 test)) + (type (nth 6 test))) + (insert str) + (compilation-parse-errors (point-min) (point-max)) + (let ((msg (get-text-property pos 'compilation-message))) + (should msg) + (let ((loc (compilation--message->loc msg)) + end-col end-line) + (if (consp col) + (setq end-col (cdr col) col (car col))) + (if (consp line) + (setq end-line (cdr line) line (car line))) + (should (equal (compilation--loc->col loc) col)) + (should (equal (compilation--loc->line loc) line)) + (when file + (should (equal (caar (compilation--loc->file-struct loc)) file))) + (when end-col + (should (equal + (car (cadr (nth 2 (compilation--loc->file-struct loc)))) + end-col))) + (should (equal (car (nth 2 (compilation--loc->file-struct loc))) + (or end-line line))) + (when type + (should (equal type (compilation--message->type msg)))) + (should (equal rule (compilation--message->rule msg)))) + msg)))) (ert-deftest compile-test-error-regexps () "Test the `compilation-error-regexp-alist' regexps. @@ -436,7 +489,7 @@ The test data is in `compile-tests--test-regexps-data'." (compilation-num-warnings-found 0) (compilation-num-infos-found 0)) (mapc #'compile--test-error-line compile-tests--test-regexps-data) - (should (eq compilation-num-errors-found 95)) + (should (eq compilation-num-errors-found 96)) (should (eq compilation-num-warnings-found 35)) (should (eq compilation-num-infos-found 28))))) @@ -449,16 +502,15 @@ The test data is in `compile-tests--grep-regexp-testcases'." (font-lock-mode -1) (dolist (testcase compile-tests--grep-regexp-testcases) (let (msg1 msg2) - (setq msg1 (ert-info ((format "%S" testcase) :prefix "testcase: ") - (compile--test-error-line testcase))) + (setq msg1 (compile--test-error-line testcase)) ;; Make sure replacing the NUL character with a colon still matches. - (setf (car testcase) (replace-regexp-in-string "\0" ":" (car testcase))) - (setq msg2 (ert-info ((format "%S" testcase) :prefix "testcase: ") - (compile--test-error-line testcase))) + (let ((testcase2 (copy-sequence testcase))) + (setf (nth 1 testcase2) + (string-replace "\0" ":" (nth 1 testcase2))) + (setq msg2 (compile--test-error-line testcase2))) (should (equal msg1 msg2)))) (dolist (testcase compile-tests--grep-regexp-tricky-testcases) - (ert-info ((format "%S" testcase) :prefix "testcase: ") - (compile--test-error-line testcase))) + (compile--test-error-line testcase)) (should (eq compilation-num-errors-found 8)))) ;;; compile-tests.el ends here diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl index 4a9842ffa56..8c1883a10f1 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl @@ -26,7 +26,7 @@ say "boring loop"; } continue { -last; # no endless loop, though +last; } } # -------- while loop: expected output -------- @@ -34,7 +34,7 @@ last; # no endless loop, though while (1) { say "boring loop"; } continue { - last; # no endless loop, though + last; } } # -------- while loop: end -------- diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl new file mode 100644 index 00000000000..0832f868288 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl @@ -0,0 +1,44 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.020; + +# This file contains test input and expected output for the tests in +# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is +# syntactically valid, but doesn't make much sense. + +# -------- PBP indent: input -------- +for my $foo (@ARGV) +{ +...; +} +# -------- PBP indent: expected output -------- +for my $foo (@ARGV) { + ...; +} +# -------- PBP indent: end -------- + +# -------- PBP uncuddle else: input -------- +{ +if (1 < 2) +{ +say "Seems ok"; +} elsif (1 == 2) { +say "Strange things are happening"; +} else { +die "This world is backwards"; +} +} +# -------- PBP uncuddle else: expected output -------- +{ + if (1 < 2) { + say "Seems ok"; + } + elsif (1 == 2) { + say "Strange things are happening"; + } + else { + die "This world is backwards"; + } +} +# -------- PBP uncuddle else: end -------- diff --git a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl new file mode 100644 index 00000000000..fa328438cb1 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl @@ -0,0 +1,20 @@ +# The following Perl punctiation variables contain characters which +# are classified as string delimiters in the syntax table. The mode +# should not be confused by these. +# The corresponding tests check that two consecutive '#' characters +# are seen as comments, not as strings. +my $pre = $`; ## $PREMATCH, use another ` # to balance out +my $pos = $'; ## $POSTMATCH, use another ' # to balance out +my $lsp = $"; ## $LIST_SEPARATOR use another " # to balance out + +# In the second level, we use the reference constructor \ on these +# variables. The backslash is an escape character *only* in strings. +my $ref = \$`; ## \$PREMATCH, use another ` # to balance out +my $rif = \$'; ## \$POSTMATCH, use another ' # to balance out +my $raf = \$"; ## \$LIST_SEPARATOR use another " # to balance out + +my $opt::s = 0; ## s is no substitution here +my $opt_s = 0; ## s is no substitution here +my %opt = (s => 0); ## s is no substitution here +$opt{s} = 0; ## s is no substitution here +$opt_s =~ /\s+.../ ## s is no substitution here diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index b549b924042..9a7b5e4d6dd 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -31,14 +31,8 @@ (defvar cperl-test-mode #'cperl-mode) (require 'cperl-mode) - -(defvar cperl-mode-tests-data-directory - (expand-file-name "lisp/progmodes/cperl-mode-resources" - (or (getenv "EMACS_TEST_DIRECTORY") - (expand-file-name "../../../" - (or load-file-name - buffer-file-name)))) - "Directory containing cperl-mode test data.") +(require 'ert) +(require 'ert-x) (defun cperl-test-ppss (text regexp) "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT." @@ -109,11 +103,15 @@ indentation actually takes place.." (message "%s" (buffer-string))))) (ert-deftest cperl-mode-test-bug-10483 () - "Verifies that a piece of code which ends in a paren without a -statement terminato ron tne same line does not loop forever. The -test starts an asynchronous Emacs batch process under timeout -control." + "Check that indenting certain perl code does not loop forever. +This verifies that indenting a piece of code that ends in a paren +without a statement terminator on the same line does not loop +forever. The test starts an asynchronous Emacs batch process +under timeout control." + :tags '(:expensive-test) (interactive) + (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out + (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen (let* ((emacs (concat invocation-directory invocation-name)) (test-function 'cperl-mode-test--run-bug-10483) (test-function-name (symbol-name test-function)) @@ -122,7 +120,7 @@ control." (process-connection-type nil) runner) (with-temp-buffer - (with-timeout (1 + (with-timeout (2 (delete-process runner) (setq ran-out-of-time t)) (setq runner (start-process "speedy" @@ -145,8 +143,8 @@ control." These exercise some standard blocks and also the special treatment for Perl expressions where a closing paren isn't the end of the statement." - (let ((file (expand-file-name "cperl-indent-exp.pl" - cperl-mode-tests-data-directory))) + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((file (ert-resource-file "cperl-indent-exp.pl"))) (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) @@ -163,10 +161,99 @@ end of the statement." got) (with-temp-buffer (insert code) + (cperl-mode) (goto-char (point-min)) (cperl-indent-exp) ; here we go! (setq expected (concat "test case " name ":\n" expected)) (setq got (concat "test case " name ":\n" (buffer-string))) (should (equal got expected)))))))) +(ert-deftest cperl-mode-test-indent-styles () + "Verify correct indentation by style \"PBP\". +Perl Best Practices sets some indentation values different from + the defaults, and also wants an \"else\" or \"elsif\" keyword + to align with the \"if\"." + (let ((file (ert-resource-file "cperl-indent-styles.pl"))) + (with-temp-buffer + (cperl-set-style "PBP") + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward + (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n" + "\\(?2:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: expected output ?-+\n" + "\\(?3:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: end ?-+") + nil t) + (let ((name (match-string 1)) + (code (match-string 2)) + (expected (match-string 3)) + got) + (with-temp-buffer + (insert code) + (cperl-mode) + (indent-region (point-min) (point-max)) ; here we go! + (setq expected (concat "test case " name ":\n" expected)) + (setq got (concat "test case " name ":\n" (buffer-string))) + (should (equal got expected))))) + (cperl-set-style "CPerl")))) + +(ert-deftest cperl-mode-fontify-punct-vars () + "Test fontification of Perl's punctiation variables. +Perl has variable names containing unbalanced quotes for the list +separator $\" and pre- and postmatch $` and $'. A reference to +these variables, for example \\$\", should not cause the dollar +to be escaped, which would then start a string beginning with the +quote character. This used to be broken in cperl-mode at some +point in the distant past, and is still broken in perl-mode. " + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((file (ert-resource-file "fontify-punctuation-vars.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (while (search-forward "##" nil t) + ;; The third element of syntax-ppss is true if in a string, + ;; which would indicate bad interpretation of the quote. The + ;; fourth element is true if in a comment, which should be the + ;; case. + (should (equal (nth 3 (syntax-ppss)) nil)) + (should (equal (nth 4 (syntax-ppss)) t)))))) + +(ert-deftest cperl-bug37127 () + "Verify that closing a paren in a regex goes without a message. +Also check that the message is issued if the regex terminator is +missing." + ;; Part one: Regex is ok, no messages + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "$_ =~ /(./;") + (funcall cperl-test-mode) + (goto-char (point-min)) + (search-forward ".") + (let ((last-command-event ?\)) + ;; Don't emit "Matches ..." even if not visible (e.g. in batch). + (blink-matching-paren 'jump-offscreen)) + (self-insert-command 1) + ;; `self-insert-command' doesn't call `blink-matching-open' in + ;; batch mode, so we need to call it explicitly. + (blink-matching-open)) + (syntax-propertize (point-max))) + (should (string-equal collected-messages ""))) + ;; part two: Regex terminator missing -> message + (when (eq cperl-test-mode #'cperl-mode) + ;; This test is only run in `cperl-mode' because only cperl-mode + ;; emits a message to warn about such unclosed REs. + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "$_ =~ /(..;") + (goto-char (point-min)) + (funcall cperl-test-mode) + (search-forward ".") + (let ((last-command-event ?\))) + (self-insert-command 1)) + (syntax-propertize (point-max))) + (should (string-match "^End of .* string/RE" + collected-messages))))) + ;;; cperl-mode-tests.el ends here diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 2de533e5eb9..6c30e4f664b 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -810,5 +810,17 @@ to (xref-elisp-test-descr-to-target xref)." (insert "?\\N{HEAVY CHECK MARK}") (should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK})))) +(ert-deftest elisp-indent-basic () + (with-temp-buffer + (emacs-lisp-mode) + (let ((orig "(defun x () + (print (quote ( thingy great + stuff))) + (print (quote (thingy great + stuff))))")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + (provide 'elisp-mode-tests) ;;; elisp-mode-tests.el ends here diff --git a/test/lisp/progmodes/gdb-mi-tests.el b/test/lisp/progmodes/gdb-mi-tests.el new file mode 100644 index 00000000000..79493a571b6 --- /dev/null +++ b/test/lisp/progmodes/gdb-mi-tests.el @@ -0,0 +1,44 @@ +;;; gdb-mi-tests.el --- tests for gdb-mi.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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/>. + +(require 'ert) +(require 'gdb-mi) + +(ert-deftest gdb-mi-parse-value () + ;; Test the GDB/MI result/value parser. + (should (equal + (gdb-mi--from-string + "alpha=\"ab\\ncd\",beta=[\"x\",{gamma=\"y\",delta=[]}]") + '((alpha . "ab\ncd") + (beta . ("x" ((gamma . "y") (delta . ()))))))) + (should (equal + (gdb-mi--from-string + "alpha=\"ab\\ncd\",beta=[\"x\",{gamma=\"y\",delta=[]}]" + 'gamma) + '((alpha . "ab\ncd") + (beta . ("x" ("y" (delta . ()))))))) + + (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"") + `((alpha . ,(string-to-multibyte "a\303\245b"))))) + (let ((gdb-mi-decode-strings 'utf-8)) + (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"") + '((alpha . "aåb"))))) + ) + +(provide 'gdb-mi-tests) diff --git a/test/manual/indent/js-chain.js b/test/lisp/progmodes/js-resources/js-chain.js index 2a290294026..2a290294026 100644 --- a/test/manual/indent/js-chain.js +++ b/test/lisp/progmodes/js-resources/js-chain.js diff --git a/test/manual/indent/js-indent-align-list-continuation-nil.js b/test/lisp/progmodes/js-resources/js-indent-align-list-continuation-nil.js index 383b2539a26..383b2539a26 100644 --- a/test/manual/indent/js-indent-align-list-continuation-nil.js +++ b/test/lisp/progmodes/js-resources/js-indent-align-list-continuation-nil.js diff --git a/test/manual/indent/js-indent-init-dynamic.js b/test/lisp/progmodes/js-resources/js-indent-init-dynamic.js index 536a976e86e..536a976e86e 100644 --- a/test/manual/indent/js-indent-init-dynamic.js +++ b/test/lisp/progmodes/js-resources/js-indent-init-dynamic.js diff --git a/test/manual/indent/js-indent-init-t.js b/test/lisp/progmodes/js-resources/js-indent-init-t.js index bb755420ba7..bb755420ba7 100644 --- a/test/manual/indent/js-indent-init-t.js +++ b/test/lisp/progmodes/js-resources/js-indent-init-t.js diff --git a/test/manual/indent/js.js b/test/lisp/progmodes/js-resources/js.js index 9658c95701c..9658c95701c 100644 --- a/test/manual/indent/js.js +++ b/test/lisp/progmodes/js-resources/js.js diff --git a/test/manual/indent/jsx-align-gt-with-lt.jsx b/test/lisp/progmodes/js-resources/jsx-align-gt-with-lt.jsx index 8eb1d6d718c..8eb1d6d718c 100644 --- a/test/manual/indent/jsx-align-gt-with-lt.jsx +++ b/test/lisp/progmodes/js-resources/jsx-align-gt-with-lt.jsx diff --git a/test/manual/indent/jsx-comment-string.jsx b/test/lisp/progmodes/js-resources/jsx-comment-string.jsx index cae023e7288..cae023e7288 100644 --- a/test/manual/indent/jsx-comment-string.jsx +++ b/test/lisp/progmodes/js-resources/jsx-comment-string.jsx diff --git a/test/manual/indent/jsx-indent-level.jsx b/test/lisp/progmodes/js-resources/jsx-indent-level.jsx index 0a84b9eb77a..0a84b9eb77a 100644 --- a/test/manual/indent/jsx-indent-level.jsx +++ b/test/lisp/progmodes/js-resources/jsx-indent-level.jsx diff --git a/test/manual/indent/jsx-quote.jsx b/test/lisp/progmodes/js-resources/jsx-quote.jsx index 1b2c6528734..1b2c6528734 100644 --- a/test/manual/indent/jsx-quote.jsx +++ b/test/lisp/progmodes/js-resources/jsx-quote.jsx diff --git a/test/manual/indent/jsx-self-closing.jsx b/test/lisp/progmodes/js-resources/jsx-self-closing.jsx index f8ea7a138ad..f8ea7a138ad 100644 --- a/test/manual/indent/jsx-self-closing.jsx +++ b/test/lisp/progmodes/js-resources/jsx-self-closing.jsx diff --git a/test/manual/indent/jsx-unclosed-1.jsx b/test/lisp/progmodes/js-resources/jsx-unclosed-1.jsx index 1f5c3fba8da..1f5c3fba8da 100644 --- a/test/manual/indent/jsx-unclosed-1.jsx +++ b/test/lisp/progmodes/js-resources/jsx-unclosed-1.jsx diff --git a/test/manual/indent/jsx-unclosed-2.jsx b/test/lisp/progmodes/js-resources/jsx-unclosed-2.jsx index fb665b96a43..fb665b96a43 100644 --- a/test/manual/indent/jsx-unclosed-2.jsx +++ b/test/lisp/progmodes/js-resources/jsx-unclosed-2.jsx diff --git a/test/manual/indent/jsx.jsx b/test/lisp/progmodes/js-resources/jsx.jsx index c200979df8c..c200979df8c 100644 --- a/test/manual/indent/jsx.jsx +++ b/test/lisp/progmodes/js-resources/jsx.jsx diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el index 681e51de0ed..6c3a618b949 100644 --- a/test/lisp/progmodes/js-tests.el +++ b/test/lisp/progmodes/js-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'js) (require 'syntax) @@ -196,6 +197,46 @@ if (!/[ (:,='\"]/.test(value)) { ;; The bug was a hang. (should t))) +;;;; Indentation tests. + +(defun js-tests--remove-indentation () + "Remove all indentation in the current buffer." + (goto-char (point-min)) + (while (re-search-forward (rx bol (+ (in " \t"))) nil t) + (let ((syntax (save-match-data (syntax-ppss)))) + (unless (nth 3 syntax) ; Avoid multiline string literals. + (replace-match ""))))) + +(defmacro js-deftest-indent (file) + `(ert-deftest ,(intern (format "js-indent-test/%s" file)) () + :tags '(:expensive-test) + (let ((buf (find-file-noselect (ert-resource-file ,file)))) + (unwind-protect + (with-current-buffer buf + (let ((orig (buffer-string))) + (js-tests--remove-indentation) + ;; Indent and check that we get the original text. + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig)) + ;; Verify idempotency. + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig)))) + (kill-buffer buf))))) + +(js-deftest-indent "js-chain.js") +(js-deftest-indent "js-indent-align-list-continuation-nil.js") +(js-deftest-indent "js-indent-init-dynamic.js") +(js-deftest-indent "js-indent-init-t.js") +(js-deftest-indent "js.js") +(js-deftest-indent "jsx-align-gt-with-lt.jsx") +(js-deftest-indent "jsx-comment-string.jsx") +(js-deftest-indent "jsx-indent-level.jsx") +(js-deftest-indent "jsx-quote.jsx") +(js-deftest-indent "jsx-self-closing.jsx") +(js-deftest-indent "jsx-unclosed-1.jsx") +(js-deftest-indent "jsx-unclosed-2.jsx") +(js-deftest-indent "jsx.jsx") + (provide 'js-tests) ;;; js-tests.el ends here diff --git a/test/lisp/progmodes/opascal-tests.el b/test/lisp/progmodes/opascal-tests.el new file mode 100644 index 00000000000..70a4ebfa70d --- /dev/null +++ b/test/lisp/progmodes/opascal-tests.el @@ -0,0 +1,45 @@ +;;; opascal-tests.el --- tests for opascal.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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/>. + +(require 'ert) +(require 'opascal) + +(ert-deftest opascal-indent-bug-36348 () + (with-temp-buffer + (opascal-mode) + (let ((orig "{ -*- opascal -*- } + +procedure Toto (); +begin + for i := 0 to 1 do + Write (str.Chars[i]); + + // bug#36348 + for var i := 0 to 1 do + Write (str.Chars[i]); + +end; +")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + +(provide 'opascal-tests) + +;;; opascal-tests.el ends here diff --git a/test/lisp/progmodes/perl-mode-tests.el b/test/lisp/progmodes/perl-mode-tests.el new file mode 100644 index 00000000000..a2ea972c103 --- /dev/null +++ b/test/lisp/progmodes/perl-mode-tests.el @@ -0,0 +1,33 @@ +;;; perl-mode-tests --- Test for perl-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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 'perl-mode) + +;;;; Re-use cperl-mode tests + +(defvar cperl-test-mode) +(setq cperl-test-mode #'perl-mode) +(load-file (expand-file-name "cperl-mode-tests.el" + (file-truename + (file-name-directory (or load-file-name + buffer-file-name))))) + +;;; perl-mode-tests.el ends here diff --git a/test/lisp/progmodes/ps-mode-tests.el b/test/lisp/progmodes/ps-mode-tests.el index d565b321fdd..61cf4c62511 100644 --- a/test/lisp/progmodes/ps-mode-tests.el +++ b/test/lisp/progmodes/ps-mode-tests.el @@ -43,6 +43,30 @@ (should (equal (buffer-string) "foo\\220\\221\\222bar")))) +(ert-deftest ps-mode-test-indent () + ;; Converted from manual test. + (with-temp-buffer + (ps-mode) + ;; TODO: Should some of these be fontification tests as well? + (let ((orig "%!PS-2.0 + +<< 23 45 >> %dictionary +< 23 > %hex string +<~a>a%a~> %base85 string +(%)s +(sf\\(g>a)sdg) + +/foo { + << + hello 2 + 3 + >> +} def +")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + (provide 'ps-mode-tests) ;;; ps-mode-tests.el ends here diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 6b3e63653be..64626333c44 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -204,7 +204,7 @@ aliqua." ;;; Indentation -;; See: http://www.python.org/dev/peps/pep-0008/#indentation +;; See: https://www.python.org/dev/peps/pep-0008/#indentation (ert-deftest python-indent-pep8-1 () "First pep8 case." @@ -339,7 +339,7 @@ def func(arg): # I don't do much return arg # This comment is badly indented because the user forced so. - # At this line python.el wont dedent, user is always right. + # At this line python.el won't dedent, user is always right. comment_wins_over_ender = True @@ -358,7 +358,7 @@ comment_wins_over_ender = True ;; The return keyword do make indentation lose a level... (should (= (python-indent-calculate-indentation) 0)) ;; ...but the current indentation was forced by the user. - (python-tests-look-at "# At this line python.el wont dedent") + (python-tests-look-at "# At this line python.el won't dedent") (should (eq (car (python-indent-context)) :after-comment)) (should (= (python-indent-calculate-indentation) 4)) ;; Should behave the same for blank lines: potentially a comment. diff --git a/test/manual/indent/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb index b038512b114..95928030396 100644 --- a/test/manual/indent/ruby.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -34,7 +34,7 @@ x = # "tot %q/to"; = # Regexp after whitelisted method. "abc".sub /b/, 'd' -# Don't mis-match "sub" at the end of words. +# Don't mismatch "sub" at the end of words. a = asub / aslb + bsub / bslb; # Highlight the regexp after "if". @@ -343,7 +343,7 @@ abc(foo tee .qux) -# http://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation +# https://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation tee = if foo bar else diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index 9d677a2c27a..97ac1e1ecd9 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'ruby-mode) (defmacro ruby-with-temp-buffer (contents &rest body) @@ -711,7 +712,7 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby-with-temp-buffer ruby-sexp-test-example (goto-char (point-min)) (forward-line 1) - (ruby-forward-sexp) + (forward-sexp) (should (= 8 (line-number-at-pos))))) (ert-deftest ruby-backward-sexp-skips-method-calls-with-keyword-names () @@ -719,7 +720,7 @@ VALUES-PLIST is a list with alternating index and value elements." (goto-char (point-min)) (forward-line 7) (end-of-line) - (ruby-backward-sexp) + (backward-sexp) (should (= 2 (line-number-at-pos))))) (ert-deftest ruby-forward-sexp-jumps-do-end-block-with-no-args () @@ -728,7 +729,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |end") (search-backward "do\n") - (ruby-forward-sexp) + (forward-sexp) (should (eobp)))) (ert-deftest ruby-backward-sexp-jumps-do-end-block-with-no-args () @@ -737,7 +738,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |end") (goto-char (point-max)) - (ruby-backward-sexp) + (backward-sexp) (should (looking-at "do$")))) (ert-deftest ruby-forward-sexp-jumps-do-end-block-with-empty-args () @@ -746,7 +747,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do || |end") (search-backward "do ") - (ruby-forward-sexp) + (forward-sexp) (should (eobp)))) (ert-deftest ruby-backward-sexp-jumps-do-end-block-with-empty-args () @@ -755,7 +756,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do || |end") (goto-char (point-max)) - (ruby-backward-sexp) + (backward-sexp) (should (looking-at "do ")))) (ert-deftest ruby-forward-sexp-jumps-do-end-block-with-args () @@ -764,7 +765,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |a,b| |end") (search-backward "do ") - (ruby-forward-sexp) + (forward-sexp) (should (eobp)))) (ert-deftest ruby-backward-sexp-jumps-do-end-block-with-args () @@ -773,7 +774,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |a,b| |end") (goto-char (point-max)) - (ruby-backward-sexp) + (backward-sexp) (should (looking-at "do ")))) (ert-deftest ruby-forward-sexp-jumps-do-end-block-with-any-args () @@ -782,7 +783,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |*| |end") (search-backward "do ") - (ruby-forward-sexp) + (forward-sexp) (should (eobp)))) (ert-deftest ruby-forward-sexp-jumps-do-end-block-with-expanded-one-arg () @@ -791,7 +792,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |a,| |end") (search-backward "do ") - (ruby-forward-sexp) + (forward-sexp) (should (eobp)))) (ert-deftest ruby-forward-sexp-jumps-do-end-block-with-one-and-any-args () @@ -800,7 +801,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |a,*| |end") (search-backward "do ") - (ruby-forward-sexp) + (forward-sexp) (should (eobp)))) (ert-deftest ruby-backward-sexp-jumps-do-end-block-with-one-and-any-args () @@ -809,7 +810,7 @@ VALUES-PLIST is a list with alternating index and value elements." "proc do |a,*| |end") (goto-char (point-max)) - (ruby-backward-sexp) + (backward-sexp) (should (looking-at "do ")))) (ert-deftest ruby-toggle-string-quotes-quotes-correctly () @@ -842,6 +843,16 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby--insert-coding-comment "utf-8") (should (string= "# encoding: utf-8\n\n" (buffer-string)))))) +(ert-deftest ruby--indent/converted-from-manual-test () + :tags '(:expensive-test) + ;; Converted from manual test. + (let ((buf (find-file-noselect (ert-resource-file "ruby.rb")))) + (unwind-protect + (with-current-buffer buf + (let ((orig (buffer-string))) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig)))) + (kill-buffer buf)))) (provide 'ruby-mode-tests) diff --git a/test/lisp/progmodes/scheme-tests.el b/test/lisp/progmodes/scheme-tests.el new file mode 100644 index 00000000000..e3736bd411e --- /dev/null +++ b/test/lisp/progmodes/scheme-tests.el @@ -0,0 +1,50 @@ +;;; scheme-tests.el --- Test suite for scheme.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'scheme) + +(ert-deftest scheme-test-indent () + ;; FIXME: Look into what is the expected indent here and fix it. + :expected-result :failed + ;; Converted from manual test. + (with-temp-buffer + (scheme-mode) + ;; TODO: Should some of these be fontification tests as well? + (let ((orig "#!/usr/bin/scheme is this a comment? + +;; This one is a comment +(a) +#| and this one as #|well|# as this! |# +(b) +(cons #;(this is a + comment) + head tail) +")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + +(provide 'scheme-tests) + +;;; scheme-tests.el ends here diff --git a/test/data/xref/file1.txt b/test/lisp/progmodes/xref-resources/file1.txt index 5d7cc544443..5d7cc544443 100644 --- a/test/data/xref/file1.txt +++ b/test/lisp/progmodes/xref-resources/file1.txt diff --git a/test/data/xref/file2.txt b/test/lisp/progmodes/xref-resources/file2.txt index 9f075f26004..9f075f26004 100644 --- a/test/data/xref/file2.txt +++ b/test/lisp/progmodes/xref-resources/file2.txt diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index a4980b2acb1..038f9d0e304 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -23,13 +23,14 @@ ;;; Code: +(require 'ert) (require 'xref) (require 'cl-lib) (defvar xref-tests-data-dir - (expand-file-name "../../../data/xref/" - (or load-file-name - buffer-file-name))) + (expand-file-name "xref-resources/" + (file-name-directory + (or load-file-name buffer-file-name)))) (ert-deftest xref-matches-in-directory-finds-none-for-some-regexp () (should (null (xref-matches-in-directory "zzz" "*" xref-tests-data-dir nil)))) diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el index ae7749fe930..8d31e282180 100644 --- a/test/lisp/saveplace-tests.el +++ b/test/lisp/saveplace-tests.el @@ -22,29 +22,25 @@ ;;; Commentary: (require 'ert) +(require 'ert-x) (require 'saveplace) -(defvar saveplace-tests-dir - (file-truename - (expand-file-name "saveplace-resources" - (file-name-directory (or load-file-name - buffer-file-name))))) - (ert-deftest saveplace-test-save-place-to-alist/dir () (save-place-mode) (let* ((save-place-alist nil) (save-place-loaded t) - (loc saveplace-tests-dir)) + (loc (ert-resource-directory))) (save-window-excursion (dired loc) (save-place-to-alist) (should (equal save-place-alist - `((,(concat loc "/") - (dired-filename . ,(concat loc "/saveplace"))))))))) + `((,loc + (dired-filename . ,(concat loc "saveplace"))))))))) (ert-deftest saveplace-test-save-place-to-alist/file () (save-place-mode) (let* ((tmpfile (make-temp-file "emacs-test-saveplace-")) + (tmpfile (file-truename tmpfile)) (save-place-alist nil) (save-place-loaded t) (loc tmpfile) @@ -91,7 +87,7 @@ (save-place-mode) (let ((save-place-loaded nil) (save-place-file - (expand-file-name "saveplace" saveplace-tests-dir)) + (ert-resource-file "saveplace")) (save-place-alist nil)) (load-save-place-alist-from-file) (should (equal save-place-alist diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 03c62de1fd6..eed9cb534b1 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -125,6 +127,7 @@ Per definition, all files are identical on the different hosts of a cluster (or site). This is not tested here; it must be guaranteed by the originator of a cluster definition." + :tags '(:expensive-test) (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) @@ -865,6 +868,7 @@ guaranteed by the originator of a cluster definition." (ert-deftest shadow-test09-shadow-copy-files () "Check that needed shadow files are copied." + :tags '(:expensive-test) (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 457de91c149..786dd1647aa 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -44,7 +44,7 @@ ;;; `count-words' (ert-deftest simple-test-count-words-bug-41761 () (with-temp-buffer - (dotimes (i 10) (insert (propertize "test " 'field (cons nil nil)))) + (dotimes (_i 10) (insert (propertize "test " 'field (cons nil nil)))) (should (= (count-words (point-min) (point-max)) 10)))) @@ -811,11 +811,12 @@ See Bug#21722." (let* ((str "foo\\n") (expected-point `((beg-last-out . ,(1+ (length str))) (end-last-out . ,(1+ (* 2 (length str)))) - (save-point . 1)))) + (save-point . 1) + (erase . ,(1+ (length str))) + (nil . ,(1+ (length str)))))) (dolist (output-buffer-is-current '(nil)) (with-shell-command-dont-erase-buffer str output-buffer-is-current - (when (memq shell-command-dont-erase-buffer '(beg-last-out end-last-out save-point)) - (should (= (point) (alist-get shell-command-dont-erase-buffer expected-point)))))))) + (should (= (point) (alist-get shell-command-dont-erase-buffer expected-point))))))) (provide 'simple-test) diff --git a/test/lisp/so-long-tests/so-long-tests.el b/test/lisp/so-long-tests/so-long-tests.el index ffffe070ba6..b72ee2fd612 100644 --- a/test/lisp/so-long-tests/so-long-tests.el +++ b/test/lisp/so-long-tests/so-long-tests.el @@ -181,7 +181,7 @@ ;; The various 'window change functions' are now invoked by the ;; redisplay, and redisplay does nothing at all in batch mode, ;; so we cannot test under this revised behavior. Refer to: - ;; https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg00971.html + ;; https://lists.gnu.org/r/emacs-devel/2019-10/msg00971.html ;; For interactive (non-batch) test runs, calling `redisplay' ;; does do the trick; so do that first. (redisplay) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index e2761a96f86..035c064d75c 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -172,27 +172,28 @@ (should (equal (version-to-list "6.9.30Beta") '(6 9 30 -2))) (should (equal (version-to-list "6.9.30_Beta") '(6 9 30 -2))) - (should (equal - (error-message-string (should-error (version-to-list "OTP-18.1.5"))) - "Invalid version syntax: `OTP-18.1.5' (must start with a number)")) - (should (equal - (error-message-string (should-error (version-to-list ""))) - "Invalid version syntax: `' (must start with a number)")) - (should (equal - (error-message-string (should-error (version-to-list "1.0..7.5"))) - "Invalid version syntax: `1.0..7.5'")) - (should (equal - (error-message-string (should-error (version-to-list "1.0prepre2"))) - "Invalid version syntax: `1.0prepre2'")) - (should (equal - (error-message-string (should-error (version-to-list "22.8X3"))) - "Invalid version syntax: `22.8X3'")) - (should (equal - (error-message-string (should-error (version-to-list "beta22.8alpha3"))) - "Invalid version syntax: `beta22.8alpha3' (must start with a number)")) - (should (equal - (error-message-string (should-error (version-to-list "honk"))) - "Invalid version syntax: `honk' (must start with a number)")) + (let ((text-quoting-style 'grave)) + (should (equal + (error-message-string (should-error (version-to-list "OTP-18.1.5"))) + "Invalid version syntax: `OTP-18.1.5' (must start with a number)")) + (should (equal + (error-message-string (should-error (version-to-list ""))) + "Invalid version syntax: `' (must start with a number)")) + (should (equal + (error-message-string (should-error (version-to-list "1.0..7.5"))) + "Invalid version syntax: `1.0..7.5'")) + (should (equal + (error-message-string (should-error (version-to-list "1.0prepre2"))) + "Invalid version syntax: `1.0prepre2'")) + (should (equal + (error-message-string (should-error (version-to-list "22.8X3"))) + "Invalid version syntax: `22.8X3'")) + (should (equal + (error-message-string (should-error (version-to-list "beta22.8alpha3"))) + "Invalid version syntax: `beta22.8alpha3' (must start with a number)")) + (should (equal + (error-message-string (should-error (version-to-list "honk"))) + "Invalid version syntax: `honk' (must start with a number)"))) (should (equal (error-message-string (should-error (version-to-list 9))) "Version must be a string")) @@ -231,18 +232,19 @@ (should (equal (version-to-list "6_9_30.Beta") '(6 9 30 -2))) (should (equal (version-to-list "6_9_30Beta") '(6 9 30 -2))) - (should (equal - (error-message-string (should-error (version-to-list "1_0__7_5"))) - "Invalid version syntax: `1_0__7_5'")) - (should (equal - (error-message-string (should-error (version-to-list "1_0prepre2"))) - "Invalid version syntax: `1_0prepre2'")) - (should (equal - (error-message-string (should-error (version-to-list "22.8X3"))) - "Invalid version syntax: `22.8X3'")) - (should (equal - (error-message-string (should-error (version-to-list "beta22_8alpha3"))) - "Invalid version syntax: `beta22_8alpha3' (must start with a number)")))) + (let ((text-quoting-style 'grave)) + (should (equal + (error-message-string (should-error (version-to-list "1_0__7_5"))) + "Invalid version syntax: `1_0__7_5'")) + (should (equal + (error-message-string (should-error (version-to-list "1_0prepre2"))) + "Invalid version syntax: `1_0prepre2'")) + (should (equal + (error-message-string (should-error (version-to-list "22.8X3"))) + "Invalid version syntax: `22.8X3'")) + (should (equal + (error-message-string (should-error (version-to-list "beta22_8alpha3"))) + "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))) (ert-deftest subr-test-version-list-< () (should (version-list-< '(0) '(1))) @@ -438,5 +440,49 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (should-error (ignore-error foo (read "")))) +(ert-deftest string-replace () + (should (equal (string-replace "foo" "bar" "zot") + "zot")) + (should (equal (string-replace "foo" "bar" "foozot") + "barzot")) + (should (equal (string-replace "foo" "bar" "barfoozot") + "barbarzot")) + (should (equal (string-replace "zot" "bar" "barfoozot") + "barfoobar")) + (should (equal (string-replace "z" "bar" "barfoozot") + "barfoobarot")) + (should (equal (string-replace "zot" "bar" "zat") + "zat")) + (should (equal (string-replace "azot" "bar" "zat") + "zat")) + (should (equal (string-replace "azot" "bar" "azot") + "bar")) + + (should (equal (string-replace "azot" "bar" "foozotbar") + "foozotbar")) + + (should (equal (string-replace "fo" "bar" "lafofofozot") + "labarbarbarzot")) + + (should (equal (string-replace "\377" "x" "a\377b") + "axb")) + (should (equal (string-replace "\377" "x" "a\377ø") + "axø")) + (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377b") + "axb")) + (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377ø") + "axø")) + + (should (equal (string-replace "ana" "ANA" "ananas") "ANAnas")) + + (should (equal (string-replace "a" "" "") "")) + (should (equal (string-replace "a" "" "aaaaa") "")) + (should (equal (string-replace "ab" "" "ababab") "")) + (should (equal (string-replace "ab" "" "abcabcabc") "ccc")) + (should (equal (string-replace "a" "aa" "aaa") "aaaaaa")) + (should (equal (string-replace "abc" "defg" "abc") "defg")) + + (should-error (string-replace "" "x" "abc"))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/lisp/textmodes/bibtex-tests.el b/test/lisp/textmodes/bibtex-tests.el index c12722fca13..56bd54efb74 100644 --- a/test/lisp/textmodes/bibtex-tests.el +++ b/test/lisp/textmodes/bibtex-tests.el @@ -17,7 +17,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/manual/indent/css-mode.css b/test/lisp/textmodes/css-mode-resources/test-indent.css index 041aeec1b15..041aeec1b15 100644 --- a/test/manual/indent/css-mode.css +++ b/test/lisp/textmodes/css-mode-resources/test-indent.css diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index 38cb73b3557..476fd326e66 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -28,6 +28,7 @@ (require 'css-mode) (require 'ert) +(require 'ert-x) (require 'seq) (ert-deftest css-test-property-values () @@ -411,5 +412,12 @@ (point)) "black"))))) +(ert-deftest css-mode-test-indent () + (with-current-buffer + (find-file-noselect (ert-resource-file "test-indent.css")) + (let ((orig (buffer-string))) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + (provide 'css-mode-tests) ;;; css-mode-tests.el ends here diff --git a/test/lisp/time-resources/non-empty b/test/lisp/time-resources/non-empty new file mode 100644 index 00000000000..86f5704d8ee --- /dev/null +++ b/test/lisp/time-resources/non-empty @@ -0,0 +1 @@ +This file should be non-empty. diff --git a/test/lisp/time-tests.el b/test/lisp/time-tests.el new file mode 100644 index 00000000000..2d327b959cc --- /dev/null +++ b/test/lisp/time-tests.el @@ -0,0 +1,79 @@ +;;; time-tests.el --- Tests for time.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Stefan Kangas <stefankangas@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +(require 'ert) +(require 'ert-x) +(require 'time) + +(ert-deftest time-tests-display-time-mail-check-directory () + (let ((display-time-mail-directory (ert-resource-directory))) + (should (display-time-mail-check-directory)))) + +(ert-deftest time-tests-display-time-update--load () + (let ((display-time-load-average 1) + (display-time-load-average-threshold 0)) + (display-time-next-load-average) + (should (string-match (rx string-start " " + (+ (| digit ".")) + string-end) + (display-time-update--load)))) + (let (display-time-load-average) + (should (equal (display-time-update--load) "")))) + +(ert-deftest time-tests-display-time-update () + (let ((display-time-load-average 1) + (display-time-load-average-threshold 0) + display-time-string) + (display-time-update) + (should (string-match (rx string-start + (? digit) digit ":" digit digit + (? (| "AM" "PM")) + " " (+ (| digit ".")) + (? " Mail") + string-end) + display-time-string)))) + +(ert-deftest time-tests-display-time-file-nonempty-p () + (should (display-time-file-nonempty-p (ert-resource-file "non-empty"))) + (should-not (display-time-file-nonempty-p "/non/existent"))) + +(ert-deftest time-tests-world-clock () + (save-window-excursion + (world-clock) + (should (equal (buffer-name) world-clock-buffer-name)) + (should (string-match "New York" (buffer-string))))) + +(ert-deftest time-tests-world-clock/revert-buffer-works () + (save-window-excursion + (world-clock) + (revert-buffer) + (should (string-match "New York" (buffer-string))))) + +(ert-deftest time-tests-emacs-uptime () + (should (string-match "^[0-9.]+ seconds?$" (emacs-uptime "%S")))) + +(ert-deftest time-tests-emacs-init-time () + (should (string-match "^[0-9.]+ seconds?$" (emacs-init-time)))) + +(provide 'time-tests) +;;; time-tests.el ends here diff --git a/test/lisp/url/url-domsuf-tests.el b/test/lisp/url/url-domsuf-tests.el new file mode 100644 index 00000000000..a4fffb06311 --- /dev/null +++ b/test/lisp/url/url-domsuf-tests.el @@ -0,0 +1,51 @@ +;;; url-domsuf-tests.el --- Tests for url-domsuf.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'url-domsuf) +(require 'ert) + +(defun url-domsuf-tests--run () + (should-not (url-domsuf-cookie-allowed-p "com")) + (should (url-domsuf-cookie-allowed-p "foo.bar.bd")) + (should-not (url-domsuf-cookie-allowed-p "bar.bd")) + (should-not (url-domsuf-cookie-allowed-p "co.uk")) + (should (url-domsuf-cookie-allowed-p "foo.bar.hokkaido.jo")) + (should-not (url-domsuf-cookie-allowed-p "bar.yokohama.jp")) + (should (url-domsuf-cookie-allowed-p "city.yokohama.jp"))) + +(ert-deftest url-domsuf-test-cookie-allowed-p () + "Run the domsuf tests without need for parsing a file." + (let ((url-domsuf-domains '(("com") + ("bar.bd") + ("co.uk") + ("bar.yokohama.jp")))) + (url-domsuf-tests--run))) + +(ert-deftest url-domsuf-test-cookie-allowed-p/and-parse () + "Run the domsuf tests, but also parse the file." + :tags '(:expensive-test) + (url-domsuf-tests--run)) + +(provide 'url-domsuf-tests) + +;;; url-domsuf-tests.el ends here diff --git a/test/lisp/url/url-file-tests.el b/test/lisp/url/url-file-tests.el index e4a45fb9c82..810504faf2c 100644 --- a/test/lisp/url/url-file-tests.el +++ b/test/lisp/url/url-file-tests.el @@ -23,18 +23,11 @@ (require 'url-file) (require 'ert) - -(defconst url-file-tests-data-directory - (expand-file-name "lisp/url/url-file-resources" - (or (getenv "EMACS_TEST_DIRECTORY") - (expand-file-name "../../.." - (or load-file-name - buffer-file-name)))) - "Directory for url-file test files.") +(require 'ert-x) (ert-deftest url-file () "Test reading file via file:/// URL." - (let* ((file (expand-file-name "file.txt" url-file-tests-data-directory)) + (let* ((file (ert-resource-file "file.txt")) (uri-prefix (if (eq (aref file 0) ?/) "file://" "file:///"))) (should (equal (with-current-buffer diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el index 2c5d45d62b2..a07730a2be6 100644 --- a/test/lisp/url/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el @@ -1,4 +1,4 @@ -;;; url-future-tests.el --- Test suite for url-future. +;;; url-future-tests.el --- Test suite for url-future. -*- lexical-binding:t -*- ;; Copyright (C) 2011-2020 Free Software Foundation, Inc. @@ -25,31 +25,33 @@ (require 'ert) (require 'url-future) +(defvar url-future-tests--saver) + (ert-deftest url-future-tests () - (let* (saver + (let* (url-future-tests--saver (text "running future") (good (make-url-future :value (lambda () (format text)) - :callback (lambda (f) (set 'saver f)))) + :callback (lambda (f) (set 'url-future-tests--saver f)))) (bad (make-url-future :value (lambda () (/ 1 0)) - :errorback (lambda (&rest d) (set 'saver d)))) + :errorback (lambda (&rest d) (set 'url-future-tests--saver d)))) (tocancel (make-url-future :value (lambda () (/ 1 0)) - :callback (lambda (f) (set 'saver f)) + :callback (lambda (f) (set 'url-future-tests--saver f)) :errorback (lambda (&rest d) - (set 'saver d))))) + (set 'url-future-tests--saver d))))) (should (equal good (url-future-call good))) - (should (equal good saver)) + (should (equal good url-future-tests--saver)) (should (equal text (url-future-value good))) (should (url-future-completed-p good)) (should-error (url-future-call good)) - (setq saver nil) + (setq url-future-tests--saver nil) (should (equal bad (url-future-call bad))) (should-error (url-future-call bad)) - (should (equal saver (list bad '(arith-error)))) + (should (equal url-future-tests--saver (list bad '(arith-error)))) (should (url-future-errored-p bad)) - (setq saver nil) + (setq url-future-tests--saver nil) (should (equal (url-future-cancel tocancel) tocancel)) (should-error (url-future-call tocancel)) - (should (null saver)) + (should (null url-future-tests--saver)) (should (url-future-cancelled-p tocancel)))) (provide 'url-future-tests) diff --git a/test/data/vc/diff-mode/hello_emacs.c b/test/lisp/vc/diff-mode-resources/hello_emacs.c index c7ed7538c3a..c7ed7538c3a 100644 --- a/test/data/vc/diff-mode/hello_emacs.c +++ b/test/lisp/vc/diff-mode-resources/hello_emacs.c diff --git a/test/data/vc/diff-mode/hello_emacs_1.c b/test/lisp/vc/diff-mode-resources/hello_emacs_1.c index 62145a6b44a..62145a6b44a 100644 --- a/test/data/vc/diff-mode/hello_emacs_1.c +++ b/test/lisp/vc/diff-mode-resources/hello_emacs_1.c diff --git a/test/data/vc/diff-mode/hello_world.c b/test/lisp/vc/diff-mode-resources/hello_world.c index dcbe06c6012..dcbe06c6012 100644 --- a/test/data/vc/diff-mode/hello_world.c +++ b/test/lisp/vc/diff-mode-resources/hello_world.c diff --git a/test/data/vc/diff-mode/hello_world_1.c b/test/lisp/vc/diff-mode-resources/hello_world_1.c index 606afb371cb..606afb371cb 100644 --- a/test/data/vc/diff-mode/hello_world_1.c +++ b/test/lisp/vc/diff-mode-resources/hello_world_1.c diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index e497ed204df..b25836405cc 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -22,12 +22,11 @@ ;;; Code: +(require 'ert) +(require 'ert-x) (require 'diff-mode) (require 'diff) -(defconst diff-mode-tests--datadir - (expand-file-name "test/data/vc/diff-mode" source-directory)) - (ert-deftest diff-mode-test-ignore-trailing-dashes () "Check to make sure we successfully ignore trailing -- made by 'git format-patch'. This is bug #9597" @@ -206,9 +205,14 @@ youthfulness (ert-deftest diff-mode-test-font-lock () "Check font-locking of diff hunks." + ;; See comments in diff-hunk-file-names about nonascii. + ;; In such cases, the diff-font-lock-syntax portion of this fails. + :expected-result (if (string-match-p "[[:nonascii:]]" + (ert-resource-directory)) + :failed :passed) (skip-unless (executable-find shell-file-name)) (skip-unless (executable-find diff-command)) - (let ((default-directory diff-mode-tests--datadir) + (let ((default-directory (ert-resource-directory)) (old "hello_world.c") (new "hello_emacs.c") (diff-buffer (get-buffer-create "*Diff*")) @@ -244,6 +248,7 @@ youthfulness 111 124 (face diff-context) 124 127 (face diff-context)))) + ;; Test diff-font-lock-syntax. (should (equal (mapcar (lambda (o) (list (- (overlay-start o) diff-beg) (- (overlay-end o) diff-beg) @@ -267,9 +272,12 @@ youthfulness (ert-deftest diff-mode-test-font-lock-syntax-one-line () "Check diff syntax highlighting for one line with no newline at end." + :expected-result (if (string-match-p "[[:nonascii:]]" + (ert-resource-directory)) + :failed :passed) (skip-unless (executable-find shell-file-name)) (skip-unless (executable-find diff-command)) - (let ((default-directory diff-mode-tests--datadir) + (let ((default-directory (ert-resource-directory)) (old "hello_world_1.c") (new "hello_emacs_1.c") (diff-buffer (get-buffer-create "*Diff*")) diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el index a3a592bb623..15270d68cb5 100644 --- a/test/lisp/vc/ediff-ptch-tests.el +++ b/test/lisp/vc/ediff-ptch-tests.el @@ -4,18 +4,20 @@ ;; Author: Tino Calancha <tino.calancha@gmail.com> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el index f738da7f41f..bd26f7979dc 100644 --- a/test/lisp/vc/vc-bzr-tests.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -1,4 +1,4 @@ -;;; vc-bzr.el --- tests for vc/vc-bzr.el +;;; vc-bzr.el --- tests for vc/vc-bzr.el -*- lexical-binding: t -*- ;; Copyright (C) 2011-2020 Free Software Foundation, Inc. @@ -37,14 +37,27 @@ ;; commands (eg `bzr status') want to access ~/.bazaar, and will ;; abort if they cannot. I could not figure out how to stop bzr ;; doing that, so just give it a temporary homedir for the duration. - ;; http://bugs.launchpad.net/bzr/+bug/137407 ? + ;; https://bugs.launchpad.net/bzr/+bug/137407 ? + ;; + ;; Note that with bzr 2.x, this works: + ;; mkdir /tmp/bzr + ;; HOME=/nonexistent BZR_HOME=/tmp/bzr bzr status + ;; but with brz 3.1, it complains: + ;; "failed to open trace file: [Errno 13] Permission denied: '/nonexistent'" + ;; which confuses vc-dir. + ;; We can quieten brz by adding either BRZ_LOG=/dev/null, or + ;; XDG_CACHE_HOME=/tmp/bzr (log defaults to XDG_CACHE_HOME/breezy/brz.log), + ;; but it seems simpler to just set HOME to a newly created + ;; temporary directory. + ;; TODO does this means tests should be setting XDG_ variables (not + ;; just HOME) to temporary values too? (let* ((homedir (make-temp-file "vc-bzr-test" t)) (bzrdir (expand-file-name "bzr" homedir)) (ignored-dir (progn (make-directory bzrdir) (expand-file-name "ignored-dir" bzrdir))) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "BZR_HOME=%s" homedir) + (process-environment (cons (format "HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -81,7 +94,7 @@ (expand-file-name "subdir" bzrdir))) (file (expand-file-name "file" bzrdir)) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "BZR_HOME=%s" homedir) + (process-environment (cons (format "HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -118,8 +131,7 @@ (make-directory bzrdir) (expand-file-name "foo.el" bzrdir))) (default-directory (file-name-as-directory bzrdir)) - (generated-autoload-file (expand-file-name "loaddefs.el" bzrdir)) - (process-environment (cons (format "BZR_HOME=%s" homedir) + (process-environment (cons (format "HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -135,7 +147,9 @@ ;; causes bzr status to fail. This simulates a broken bzr ;; installation. (delete-file ".bzr/checkout/dirstate") - (should (progn (update-directory-autoloads default-directory) + (should (progn (make-directory-autoloads + default-directory + (expand-file-name "loaddefs.el" bzrdir)) t))) (delete-directory homedir t)))) diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 01d196565dd..7b88b8d531a 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index 96e88f62fec..f876967bf98 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el @@ -106,7 +106,6 @@ only the name before the link arrow." "Test editing a file name without saving the change. Finding the new name should be possible while still in wdired-mode." - :expected-result (if (< emacs-major-version 27) :failed :passed) (let* ((test-dir (make-temp-file "test-dir-" t)) (test-file (concat (file-name-as-directory test-dir) "foo.c")) (replace "bar") @@ -179,6 +178,22 @@ wdired-get-filename before and after editing." (server-force-delete) (delete-directory test-dir t)))) +(ert-deftest wdired-test-bug39280 () + "Test for https://debbugs.gnu.org/39280." + (let* ((test-dir (make-temp-file "test-dir" 'dir)) + (fname "foo") + (full-fname (expand-file-name fname test-dir))) + (make-empty-file full-fname) + (let ((buf (find-file-noselect test-dir))) + (unwind-protect + (with-current-buffer buf + (dired-toggle-read-only) + (dolist (old '(t nil)) + (should (equal fname (wdired-get-filename 'nodir old))) + (should (equal full-fname (wdired-get-filename nil old)))) + (wdired-finish-edit)) + (if buf (kill-buffer buf)) + (delete-directory test-dir t))))) (provide 'wdired-tests) ;;; wdired-tests.el ends here diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el index 2ddb656fa9e..4508b680232 100644 --- a/test/lisp/wid-edit-tests.el +++ b/test/lisp/wid-edit-tests.el @@ -113,4 +113,39 @@ (should (eq (current-column) (widget-get grandchild :indent))))))) +(ert-deftest widget-test-character-widget-value () + "Check that we get the character widget's value correctly." + (with-temp-buffer + (let ((wid (widget-create '(character :value ?\n)))) + (goto-char (widget-get wid :from)) + (should (string= (widget-apply wid :value-get) "\n")) + (should (char-equal (widget-value wid) ?\n)) + (should-not (widget-apply wid :validate))))) + +(ert-deftest widget-test-editable-field-widget-value () + "Test that we get the editable field widget's value correctly." + (with-temp-buffer + (let ((wid (widget-create '(editable-field :value "")))) + (widget-insert "And some non-widget text.") + (should (string= (widget-apply wid :value-get) ""))))) + +(ert-deftest widget-test-moving-editable-list-item () + "Check that we can move an editable list item up or down, via delete+insert." + (with-temp-buffer + (widget-insert "Testing editable-list.\n\n") + (let ((lst (widget-create 'editable-list + :value '("beg" "end" "middle") + '(editable-field :value "unknown")))) + (use-local-map widget-keymap) + (widget-setup) + ;; Go to the DEL button for the 2nd element and action it. + (goto-char (widget-get (nth 2 (widget-get lst :buttons)) :from)) + (widget-apply-action (widget-at)) + ;; Go to the INS button and action it. + (goto-char (widget-get lst :to)) + (widget-backward 1) + (widget-apply-action (widget-at)) + ;; Check that we effectively moved the item to the last position. + (should (equal (widget-value lst) '("beg" "middle" "end")))))) + ;;; wid-edit-tests.el ends here diff --git a/test/data/xdg/l10n.desktop b/test/lisp/xdg-resources/l10n.desktop index 42da83910da..42da83910da 100644 --- a/test/data/xdg/l10n.desktop +++ b/test/lisp/xdg-resources/l10n.desktop diff --git a/test/data/xdg/malformed.desktop b/test/lisp/xdg-resources/malformed.desktop index 144a3f719d5..144a3f719d5 100644 --- a/test/data/xdg/malformed.desktop +++ b/test/lisp/xdg-resources/malformed.desktop diff --git a/test/data/xdg/mimeapps.list b/test/lisp/xdg-resources/mimeapps.list index 27fbd94b16b..27fbd94b16b 100644 --- a/test/data/xdg/mimeapps.list +++ b/test/lisp/xdg-resources/mimeapps.list diff --git a/test/data/xdg/mimeinfo.cache b/test/lisp/xdg-resources/mimeinfo.cache index 6e54f604fa0..6e54f604fa0 100644 --- a/test/data/xdg/mimeinfo.cache +++ b/test/lisp/xdg-resources/mimeinfo.cache diff --git a/test/data/xdg/test.desktop b/test/lisp/xdg-resources/test.desktop index b848cef5b0f..b848cef5b0f 100644 --- a/test/data/xdg/test.desktop +++ b/test/lisp/xdg-resources/test.desktop diff --git a/test/data/xdg/wrong.desktop b/test/lisp/xdg-resources/wrong.desktop index e0b4c221cf9..e0b4c221cf9 100644 --- a/test/data/xdg/wrong.desktop +++ b/test/lisp/xdg-resources/wrong.desktop diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index 294996af5f8..c2a16006c35 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -25,26 +25,20 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'xdg) -(defconst xdg-tests-data-dir - (expand-file-name "test/data/xdg" source-directory)) - (ert-deftest xdg-desktop-parsing () "Test `xdg-desktop-read-file' parsing of .desktop files." - (let ((tab1 (xdg-desktop-read-file - (expand-file-name "test.desktop" xdg-tests-data-dir))) - (tab2 (xdg-desktop-read-file - (expand-file-name "test.desktop" xdg-tests-data-dir) + (let ((tab1 (xdg-desktop-read-file (ert-resource-file "test.desktop"))) + (tab2 (xdg-desktop-read-file (ert-resource-file "test.desktop") "Another Section"))) (should (equal (gethash "Name" tab1) "Test")) (should (eq 'default (gethash "Exec" tab1 'default))) (should (equal "frobnicate" (gethash "Exec" tab2)))) (should-error - (xdg-desktop-read-file - (expand-file-name "malformed.desktop" xdg-tests-data-dir))) - (let ((tab (xdg-desktop-read-file - (expand-file-name "l10n.desktop" xdg-tests-data-dir))) + (xdg-desktop-read-file (ert-resource-file "malformed.desktop"))) + (let ((tab (xdg-desktop-read-file (ert-resource-file "l10n.desktop"))) (env (getenv "LC_MESSAGES"))) (unwind-protect (progn @@ -67,8 +61,8 @@ (ert-deftest xdg-mime-associations () "Test reading MIME associations from files." - (let* ((apps (expand-file-name "mimeapps.list" xdg-tests-data-dir)) - (cache (expand-file-name "mimeinfo.cache" xdg-tests-data-dir)) + (let* ((apps (ert-resource-file "mimeapps.list")) + (cache (ert-resource-file "mimeinfo.cache")) (fs (list apps cache))) (should (equal (xdg-mime-collect-associations "x-test/foo" fs) '("a.desktop" "b.desktop"))) diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el index 72c78d00e3e..d09336c0080 100644 --- a/test/lisp/xml-tests.el +++ b/test/lisp/xml-tests.el @@ -174,6 +174,27 @@ Parser is called with and without 'symbol-qnames argument.") :type 'xml-invalid-character) '(xml-invalid-character #x3FFFFF 3))))) +(defvar xml-tests--data-with-comments + `(;; simple case + ("<?xml version=\"1.0\"?><foo baz=\"true\">bar</foo>" + . ((foo ((baz . "true")) "bar"))) + ;; toplevel comments -- first document child must not get lost + (,(concat "<?xml version=\"1.0\"?><foo>bar</foo><!--comment-1-->" + "<!--comment-2-->") + . ((foo nil "bar"))) + (,(concat "<?xml version=\"1.0\"?><!--comment-a--><foo a=\"b\">" + "<bar>blub</bar></foo><!--comment-b--><!--comment-c-->") + . ((foo ((a . "b")) (bar nil "blub"))))) + "Alist of XML strings and their expected parse trees for discarded comments.") + +(ert-deftest xml-remove-comments () + (dolist (test xml-tests--data-with-comments) + (erase-buffer) + (insert (car test)) + (xml-remove-comments (point-min) (point-max)) + (should (equal (cdr test) + (xml-parse-region (point-min) (point-max)))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el index 61bd7590183..12840df13fe 100644 --- a/test/lisp/xt-mouse-tests.el +++ b/test/lisp/xt-mouse-tests.el @@ -53,9 +53,9 @@ (ert-deftest xt-mouse-tracking-basic () (should (equal (xterm-mouse-tracking-enable-sequence) - "\e[?1000h\e[?1002h\e[?1006h")) + "\e[?1000h\e[?1003h\e[?1006h")) (should (equal (xterm-mouse-tracking-disable-sequence) - "\e[?1006l\e[?1002l\e[?1000l")) + "\e[?1006l\e[?1003l\e[?1000l")) (with-xterm-mouse-mode (should xterm-mouse-mode) (should (terminal-parameter nil 'xterm-mouse-mode)) @@ -73,9 +73,9 @@ (ert-deftest xt-mouse-tracking-utf-8 () (let ((xterm-mouse-utf-8 t)) (should (equal (xterm-mouse-tracking-enable-sequence) - "\e[?1000h\e[?1002h\e[?1005h\e[?1006h")) + "\e[?1000h\e[?1003h\e[?1005h\e[?1006h")) (should (equal (xterm-mouse-tracking-disable-sequence) - "\e[?1006l\e[?1005l\e[?1002l\e[?1000l")) + "\e[?1006l\e[?1005l\e[?1003l\e[?1000l")) (with-xterm-mouse-mode (should xterm-mouse-mode) (should (terminal-parameter nil 'xterm-mouse-mode)) diff --git a/test/manual/biditest.el b/test/manual/biditest.el index 71a44ae429a..c4ee96a79c6 100644 --- a/test/manual/biditest.el +++ b/test/manual/biditest.el @@ -6,12 +6,14 @@ ;; Maintainer: emacs-devel@gnu.org ;; Package: emacs -;; This program is free software: you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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. diff --git a/test/manual/cedet/tests/testnsp.cpp b/test/manual/cedet/tests/testnsp.cpp index fce707bf20b..b72a44c8ca8 100644 --- a/test/manual/cedet/tests/testnsp.cpp +++ b/test/manual/cedet/tests/testnsp.cpp @@ -93,7 +93,7 @@ void foo(void) { ; // #4# ( "Mumble" "get" ) } -// What happens if a type your looking for is scoped withing a type, +// What happens if a type your looking for is scoped within a type, // but you are one level into the completion so the originating scope // excludes the type of the variable you are completing through? // Thanks Martin Stein for this nice example. diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good index 519315c6fdd..5e582434a62 100644 --- a/test/manual/etags/CTAGS.good +++ b/test/manual/etags/CTAGS.good @@ -1835,7 +1835,7 @@ Z c-src/h.h 100 \Ealphaenumerate tex-src/texinfo.tex /^\\def\\Ealphaenumerate{\\Eenumerate}$/ \Ecapsenumerate tex-src/texinfo.tex /^\\def\\Ecapsenumerate{\\Eenumerate}$/ \Ecartouche tex-src/texinfo.tex /^\\def\\Ecartouche{%$/ -\Edescription tex-src/texinfo.tex /^\\def\\Edescription{\\Etable}% Neccessary kludge.$/ +\Edescription tex-src/texinfo.tex /^\\def\\Edescription{\\Etable}% Necessary kludge.$/ \Edisplay tex-src/texinfo.tex /^\\def\\Edisplay{\\endgroup\\afterenvbreak}%$/ \Eexample tex-src/texinfo.tex /^\\def\\Eexample{\\Elisp}$/ \Eflushleft tex-src/texinfo.tex /^\\def\\Eflushleft{\\endgroup\\afterenvbreak}%$/ diff --git a/test/manual/etags/c-src/emacs/src/keyboard.c b/test/manual/etags/c-src/emacs/src/keyboard.c index d4e3848afcc..e869363152b 100644 --- a/test/manual/etags/c-src/emacs/src/keyboard.c +++ b/test/manual/etags/c-src/emacs/src/keyboard.c @@ -5754,7 +5754,7 @@ make_lispy_event (struct input_event *event) ignore_mouse_drag_p = 0; } - /* Now we're releasing a button - check the co-ordinates to + /* Now we're releasing a button - check the coordinates to see if this was a click or a drag. */ else if (event->modifiers & up_modifier) { diff --git a/test/manual/etags/cp-src/functions.cpp b/test/manual/etags/cp-src/functions.cpp index 7c353d161a1..ddd78f14d9b 100644 --- a/test/manual/etags/cp-src/functions.cpp +++ b/test/manual/etags/cp-src/functions.cpp @@ -223,7 +223,7 @@ int WorkingDays(Date a, Date b){ return(wdays); } -Date StartDay(Date a,int days){//Function to calculate the apropriate start day to finish in days working days +Date StartDay(Date a,int days){//Function to calculate the appropriate start day to finish in days working days Date tmp; int wdays=0; if ( ! a.set() ) diff --git a/test/manual/etags/prol-src/ordsets.prolog b/test/manual/etags/prol-src/ordsets.prolog index 7192129fdce..0fa70f903f0 100644 --- a/test/manual/etags/prol-src/ordsets.prolog +++ b/test/manual/etags/prol-src/ordsets.prolog @@ -120,7 +120,7 @@ ord_intersect(>, Head1, Tail1, _, [Head2|Tail2]) :- % ord_intersection(+Set1, +Set2, ?Intersection) -% is true when Intersection is the intersecton of Set1 +% is true when Intersection is the intersection of Set1 % and Set2, provided that Set1 and Set2 are ordered sets. ord_intersection([], _, []). @@ -144,7 +144,7 @@ ord_intersection3([Head2|Tail2], Head1, Tail1, Intersection) :- % ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) % is true when Intersection is the intersection of Set1 and Set2, -% and Differens is Set2 \ Set1 (like in ord_union/4), +% and Difference is Set2 \ Set1 (like in ord_union/4), % provided that Set1 and Set2 are ordered sets. ord_intersection([], Set2, [], Set2). diff --git a/test/manual/etags/tex-src/texinfo.tex b/test/manual/etags/tex-src/texinfo.tex index cece96fac56..8d84f513ba5 100644 --- a/test/manual/etags/tex-src/texinfo.tex +++ b/test/manual/etags/tex-src/texinfo.tex @@ -1074,7 +1074,7 @@ July\or August\or September\or October\or November\or December\fi \def\tablez #1#2#3#4#5#6{% \aboveenvbreak % \begingroup % -\def\Edescription{\Etable}% Neccessary kludge. +\def\Edescription{\Etable}% Necessary kludge. \let\itemindex=#1% \ifnum 0#3>0 \advance \leftskip by #3\mil \fi % \ifnum 0#4>0 \tableindent=#4\mil \fi % @@ -2937,7 +2937,7 @@ July\or August\or September\or October\or November\or December\fi \setbox0=\hbox{\printednodename}% \ifdim \wd0=0pt% \def\printednodename{\ignorespaces #1}% -%%% Uncommment the following line to make the actual chapter or section title +%%% Uncomment the following line to make the actual chapter or section title %%% appear inside the square brackets. %\def\printednodename{#1-title}% \fi% diff --git a/test/manual/etags/y-src/parse.c b/test/manual/etags/y-src/parse.c index e35d862ca5f..0415c4a1180 100644 --- a/test/manual/etags/y-src/parse.c +++ b/test/manual/etags/y-src/parse.c @@ -1917,7 +1917,7 @@ yylex FUN0() } #ifdef TEST if(nn==n_usr_funs) { - io_error_msg("Couln't turn fp into a ##"); + io_error_msg("Couldn't turn fp into a ##"); parse_error=BAD_FUNC; return ERROR; } diff --git a/test/manual/etags/y-src/parse.y b/test/manual/etags/y-src/parse.y index 075add2c822..eeef44cc6eb 100644 --- a/test/manual/etags/y-src/parse.y +++ b/test/manual/etags/y-src/parse.y @@ -556,7 +556,7 @@ yylex FUN0() } #ifdef TEST if(nn==n_usr_funs) { - io_error_msg("Couln't turn fp into a ##"); + io_error_msg("Couldn't turn fp into a ##"); parse_error=BAD_FUNC; return ERROR; } diff --git a/test/manual/image-transforms-tests.el b/test/manual/image-transforms-tests.el index 02607e63676..13d74a7c4b5 100644 --- a/test/manual/image-transforms-tests.el +++ b/test/manual/image-transforms-tests.el @@ -1,4 +1,4 @@ -;;; image-transform-tests.el --- Test suite for image transforms. +;;; image-transform-tests.el --- Test suite for image transforms. -*- lexical-binding: t -*- ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. diff --git a/test/manual/indent/elisp.el b/test/manual/indent/elisp.el deleted file mode 100644 index f3874b5c3e0..00000000000 --- a/test/manual/indent/elisp.el +++ /dev/null @@ -1,5 +0,0 @@ -(defun x () - (print (quote ( thingy great - stuff))) - (print (quote (thingy great - stuff)))) diff --git a/test/manual/indent/lisp.lisp b/test/manual/indent/lisp.lisp deleted file mode 100644 index f3874b5c3e0..00000000000 --- a/test/manual/indent/lisp.lisp +++ /dev/null @@ -1,5 +0,0 @@ -(defun x () - (print (quote ( thingy great - stuff))) - (print (quote (thingy great - stuff)))) diff --git a/test/manual/indent/nxml.xml b/test/manual/indent/nxml.xml deleted file mode 100644 index 61b84f270b0..00000000000 --- a/test/manual/indent/nxml.xml +++ /dev/null @@ -1,10 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<spocosy version="1.0" responsetime="2011-03-15 13:53:12" exec="0.171"> - <!-- - <query-response requestid="" service="objectquery"> - <sport name="Soccer" enetSportCode="s" del="no" n="1" ut="2009-12-29 - 15:36:24" id="1"> - </sport> - </query-response> - --> -</spocosy> diff --git a/test/manual/indent/opascal.pas b/test/manual/indent/opascal.pas deleted file mode 100644 index ac4beb3f840..00000000000 --- a/test/manual/indent/opascal.pas +++ /dev/null @@ -1,12 +0,0 @@ -{ -*- opascal -*- } - -procedure Toto (); -begin - for i := 0 to 1 do - Write (str.Chars[i]); - - // bug#36348 - for var i := 0 to 1 do - Write (str.Chars[i]); - -end; diff --git a/test/manual/indent/ps-mode.ps b/test/manual/indent/ps-mode.ps deleted file mode 100644 index 4b4ee0f10cb..00000000000 --- a/test/manual/indent/ps-mode.ps +++ /dev/null @@ -1,14 +0,0 @@ -%!PS-2.0 - -<< 23 45 >> %dictionary -< 23 > %hex string -<~a>a%a~> %base85 string -(%)s -(sf\(g>a)sdg) - -/foo { - << - hello 2 - 3 - >> -} def diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm deleted file mode 100644 index 84d0f6d8786..00000000000 --- a/test/manual/indent/scheme.scm +++ /dev/null @@ -1,9 +0,0 @@ -#!/usr/bin/scheme is this a comment? - -;; This one is a comment -(a) -#| and this one as #|well|# as this! |# -(b) -(cons #;(this is a - comment) - head tail) diff --git a/test/manual/indent/tcl.tcl b/test/manual/indent/tcl.tcl new file mode 100644 index 00000000000..c3781533ca4 --- /dev/null +++ b/test/manual/indent/tcl.tcl @@ -0,0 +1,22 @@ +# Some sample code that tries to exercise the font-lock +# of various forms of writing strings. + +puts "hello}"; # Top-level strings can contain unescaped closing braces! + +puts a"b; # Non-delimited strings can contain quotes! +puts a""b; # Even several of them! + +proc foo1 {} { + puts "hello"; # Normal case! + puts "hello\}; # This will signal an error when `foo1` is called! +} + +proc foo2 {} { + puts "hello; # This will also signal an error when `foo2` is called! +} + +proc foo3 {} { + puts a"b; # This will not signal an error! + puts a""b"; # And that won't either! + puts "a""b"; # But this will! +} diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el index c2010ae31d3..42dae424476 100644 --- a/test/src/callint-tests.el +++ b/test/src/callint-tests.el @@ -29,7 +29,8 @@ (ert-deftest call-interactively/incomplete-multibyte-sequence () "Check that Bug#30004 is fixed." - (let ((data (should-error (call-interactively (lambda () (interactive "\xFF")))))) + (let* ((text-quoting-style 'grave) + (data (should-error (call-interactively (lambda () (interactive "\xFF")))))) (should (equal (cdr data) diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el index c438ae22ce3..82883a045c8 100644 --- a/test/src/coding-tests.el +++ b/test/src/coding-tests.el @@ -143,7 +143,7 @@ ;; Optional 5th arg TRANSLATOR is a function to translate the original ;; file contents to match with the expected result of decoding. For ;; instance, when a file of dos eol-type is read by unix eol-type, -;; `decode-test-lf-to-crlf' must be specified. +;; `coding-tests-lf-to-crlf' must be specified. (defun coding-tests (content-type write-coding read-coding detected-coding &optional translator) diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el deleted file mode 100644 index 797b9ba5480..00000000000 --- a/test/src/doc-tests.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; doc-tests.el --- Tests for doc.c -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. - -;; Author: Eli Zaretskii <eliz@gnu.org> - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Code: - -(require 'ert) - -(ert-deftest doc-test-substitute-command-keys () - ;; Bindings. - (should (string= (substitute-command-keys "foo \\[goto-char]") "foo M-g c")) - ;; Cannot use string= here, as that compares unibyte and multibyte - ;; strings not equal. - (should (compare-strings - (substitute-command-keys "\200 \\[goto-char]") nil nil - "\200 M-g c" nil nil)) - ;; Literals. - (should (string= (substitute-command-keys "foo \\=\\[goto-char]") - "foo \\[goto-char]")) - (should (string= (substitute-command-keys "foo \\=\\=") - "foo \\=")) - ;; Keymaps. - ;; I don't see that this is testing anything useful. - ;; AFAICS all it does it fail whenever someone modifies the - ;; minibuffer map. -;;; (should (string= (substitute-command-keys -;;; "\\{minibuffer-local-must-match-map}") -;;; "\ -;;; key binding -;;; --- ------- -;;; -;;; C-g abort-recursive-edit -;;; TAB minibuffer-complete -;;; C-j minibuffer-complete-and-exit -;;; RET minibuffer-complete-and-exit -;;; ESC Prefix Command -;;; SPC minibuffer-complete-word -;;; ? minibuffer-completion-help -;;; <C-tab> file-cache-minibuffer-complete -;;; <XF86Back> previous-history-element -;;; <XF86Forward> next-history-element -;;; <down> next-line-or-history-element -;;; <next> next-history-element -;;; <prior> switch-to-completions -;;; <up> previous-line-or-history-element -;;; -;;; M-v switch-to-completions -;;; -;;; M-< minibuffer-beginning-of-buffer -;;; M-n next-history-element -;;; M-p previous-history-element -;;; M-r previous-matching-history-element -;;; M-s next-matching-history-element -;;; -;;; ")) - (should (string= - (substitute-command-keys - "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]") - "C-g")) - ;; Allow any style of quotes, since the terminal might not support - ;; UTF-8. - (should (string-match - "\nUses keymap [`‘']foobar-map['’], which is not currently defined.\n" - (substitute-command-keys "\\{foobar-map}"))) - ;; Quotes. - (should (let ((text-quoting-style 'grave)) - (string= (substitute-command-keys "quotes `like this'") - "quotes `like this'"))) - (should (let ((text-quoting-style 'grave)) - (string= (substitute-command-keys "quotes ‘like this’") - "quotes ‘like this’"))) - (should (let ((text-quoting-style 'straight)) - (string= (substitute-command-keys "quotes `like this'") - "quotes 'like this'"))) - ;; Bugs. - (should (string= (substitute-command-keys "\\[foobar") "\\[foobar")) - (should (string= (substitute-command-keys "\\=") "\\=")) - ) - -(provide 'doc-tests) -;;; doc-tests.el ends here diff --git a/test/data/emacs-module/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 37186fcc4d1..258a679b207 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -268,6 +268,16 @@ Fmod_test_string_a_to_b (emacs_env *env, ptrdiff_t nargs, emacs_value args[], } +/* Return a unibyte string. */ +static emacs_value +Fmod_test_return_unibyte (emacs_env *env, ptrdiff_t nargs, emacs_value args[], + void *data) +{ + const char *string = "foo\x00zot"; + return env->make_unibyte_string (env, string, 7); +} + + /* Embedded pointers in lisp objects. */ /* C struct (pointer to) that will be embedded. */ @@ -673,6 +683,14 @@ Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return env->intern (env, "nil"); } +static emacs_value +Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 1); + return args[0]; +} + /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -742,6 +760,7 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-globref-reordered", Fmod_test_globref_reordered, 0, 0, NULL, NULL); DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL); + DEFUN ("mod-test-return-unibyte", Fmod_test_return_unibyte, 0, 0, NULL, NULL); DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL); DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL); DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL); @@ -764,6 +783,19 @@ emacs_module_init (struct emacs_runtime *ert) #undef DEFUN + emacs_value constant_fn + = env->make_function (env, 0, 0, Fmod_test_return_t, NULL, NULL); + env->make_interactive (env, constant_fn, env->intern (env, "nil")); + bind_function (env, "mod-test-return-t-int", constant_fn); + + emacs_value identity_fn + = env->make_function (env, 1, 1, Fmod_test_identity, NULL, NULL); + const char *interactive_spec = "i"; + env->make_interactive (env, identity_fn, + env->make_string (env, interactive_spec, + strlen (interactive_spec))); + bind_function (env, "mod-test-identity", identity_fn); + provide (env, "mod-test"); return 0; } diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 0fd8e1db49e..fb4ed4a6842 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -21,13 +21,14 @@ ;; Unit tests for the dynamic module facility. See Info node `(elisp) ;; Writing Dynamic Modules'. These tests make use of a small test -;; module in test/data/emacs-module. +;; module in the "emacs-module-resources" directory. ;;; Code: ;;; Prelude (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'help-fns) (defconst mod-test-emacs @@ -35,8 +36,7 @@ "File name of the Emacs binary currently running.") (eval-and-compile - (defconst mod-test-file - (expand-file-name "../test/data/emacs-module/mod-test" invocation-directory) + (defconst mod-test-file (ert-resource-file "mod-test") "File name of the module test file.")) (require 'mod-test mod-test-file) @@ -309,14 +309,15 @@ local reference." (ert-deftest module/describe-function-1 () "Check that Bug#30163 is fixed." (with-temp-buffer - (let ((standard-output (current-buffer))) + (let ((standard-output (current-buffer)) + (text-quoting-style 'grave)) (describe-function-1 #'mod-test-sum) (goto-char (point-min)) - (while (re-search-forward "`[^']*/data/emacs-module/" nil t) - (replace-match "`data/emacs-module/")) + (while (re-search-forward "`[^']*/src/emacs-module-resources/" nil t) + (replace-match "`src/emacs-module-resources/")) (should (equal (buffer-substring-no-properties 1 (point-max)) - (format "a module function in `data/emacs-module/mod-test%s'. + (format "a module function in `src/emacs-module-resources/mod-test%s'. (mod-test-sum a b) @@ -467,4 +468,42 @@ See Bug#36226." (should (equal (buffer-string) "data from thread"))) (delete-process process))))) +(ert-deftest module/interactive/return-t () + (should (functionp (symbol-function #'mod-test-return-t))) + (should (module-function-p (symbol-function #'mod-test-return-t))) + (should-not (commandp #'mod-test-return-t)) + (should-not (commandp (symbol-function #'mod-test-return-t))) + (should-not (interactive-form #'mod-test-return-t)) + (should-not (interactive-form (symbol-function #'mod-test-return-t))) + (should-error (call-interactively #'mod-test-return-t) + :type 'wrong-type-argument)) + +(ert-deftest module/interactive/return-t-int () + (should (functionp (symbol-function #'mod-test-return-t-int))) + (should (module-function-p (symbol-function #'mod-test-return-t-int))) + (should (commandp #'mod-test-return-t-int)) + (should (commandp (symbol-function #'mod-test-return-t-int))) + (should (equal (interactive-form #'mod-test-return-t-int) '(interactive))) + (should (equal (interactive-form (symbol-function #'mod-test-return-t-int)) + '(interactive))) + (should (eq (mod-test-return-t-int) t)) + (should (eq (call-interactively #'mod-test-return-t-int) t))) + +(ert-deftest module/interactive/identity () + (should (functionp (symbol-function #'mod-test-identity))) + (should (module-function-p (symbol-function #'mod-test-identity))) + (should (commandp #'mod-test-identity)) + (should (commandp (symbol-function #'mod-test-identity))) + (should (equal (interactive-form #'mod-test-identity) '(interactive "i"))) + (should (equal (interactive-form (symbol-function #'mod-test-identity)) + '(interactive "i"))) + (should (eq (mod-test-identity 123) 123)) + (should-not (call-interactively #'mod-test-identity))) + +(ert-deftest module/unibyte () + (let ((result (mod-test-return-unibyte))) + (should (stringp result)) + (should (not (multibyte-string-p (mod-test-return-unibyte)))) + (should (equal result "foo\x00zot")))) + ;;; emacs-module-tests.el ends here diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index b9a7d29895a..d3c22f966e6 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -166,6 +166,8 @@ (should (equal (should-error (sort "cba" #'<) :type 'wrong-type-argument) '(wrong-type-argument list-or-vector-p "cba")))) +(defvar w32-collate-ignore-punctuation) + (ert-deftest fns-tests-collate-sort () (skip-unless (fns-tests--collate-enabled-p)) @@ -228,9 +230,9 @@ (should (equal (func-arity 'format) '(1 . many))) (require 'info) (should (equal (func-arity 'Info-goto-node) '(1 . 3))) - (should (equal (func-arity (lambda (&rest x))) '(0 . many))) - (should (equal (func-arity (eval '(lambda (x &optional y)) nil)) '(1 . 2))) - (should (equal (func-arity (eval '(lambda (x &optional y)) t)) '(1 . 2))) + (should (equal (func-arity (lambda (&rest _x))) '(0 . many))) + (should (equal (func-arity (eval '(lambda (_x &optional y)) nil)) '(1 . 2))) + (should (equal (func-arity (eval '(lambda (_x &optional y)) t)) '(1 . 2))) (should (equal (func-arity 'let) '(1 . unevalled)))) (defun fns-tests--string-repeat (s o) @@ -901,3 +903,76 @@ (should (equal (delete t [nil t]) [nil])) (should (equal (delete 1 v1) (vector))) (should (equal (delete 2 v1) v1)))) + +(ert-deftest string-search () + (should (equal (string-search "zot" "foobarzot") 6)) + (should (equal (string-search "foo" "foobarzot") 0)) + (should (not (string-search "fooz" "foobarzot"))) + (should (not (string-search "zot" "foobarzo"))) + (should (equal (string-search "ab" "ab") 0)) + (should (equal (string-search "ab\0" "ab") nil)) + (should (equal (string-search "ab" "abababab" 3) 4)) + (should (equal (string-search "ab" "ababac" 3) nil)) + (should (equal (string-search "aaa" "aa") nil)) + (let ((case-fold-search t)) + (should (equal (string-search "ab" "AB") nil))) + + (should (equal + (string-search (make-string 2 130) + (concat "helló" (make-string 5 130 t) "bár")) + 5)) + (should (equal + (string-search (make-string 2 127) + (concat "helló" (make-string 5 127 t) "bár")) + 5)) + + (should (equal (string-search "\377" "a\377ø") 1)) + (should (equal (string-search "\377" "a\377a") 1)) + + (should (not (string-search (make-string 1 255) "a\377ø"))) + (should (not (string-search (make-string 1 255) "a\377a"))) + + (should (equal (string-search "fóo" "zotfóo") 3)) + + (should (equal (string-search (string-to-multibyte "\377") "ab\377c") 2)) + (should (equal (string-search "\303" "aøb") nil)) + (should (equal (string-search "\270" "aøb") nil)) + (should (equal (string-search "ø" "\303\270") nil)) + + (should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2)) + + (should-error (string-search "a" "abc" -1)) + (should-error (string-search "a" "abc" 4)) + (should-error (string-search "a" "abc" 100000000000)) + + (should (equal (string-search "a" "aaa" 3) nil)) + (should (equal (string-search "aa" "aa" 1) nil)) + (should (equal (string-search "\0" "") nil)) + + (should (equal (string-search "" "") 0)) + (should-error (string-search "" "" 1)) + (should (equal (string-search "" "abc") 0)) + (should (equal (string-search "" "abc" 2) 2)) + (should (equal (string-search "" "abc" 3) 3)) + (should-error (string-search "" "abc" 4)) + (should-error (string-search "" "abc" -1)) + + (should-not (string-search "ø" "foo\303\270")) + (should-not (string-search "\303\270" "ø")) + (should-not (string-search "\370" "ø")) + (should-not (string-search (string-to-multibyte "\370") "ø")) + (should-not (string-search "ø" "\370")) + (should-not (string-search "ø" (string-to-multibyte "\370"))) + (should-not (string-search "\303\270" "\370")) + (should-not (string-search (string-to-multibyte "\303\270") "\370")) + (should-not (string-search "\303\270" (string-to-multibyte "\370"))) + (should-not (string-search (string-to-multibyte "\303\270") + (string-to-multibyte "\370"))) + (should-not (string-search "\370" "\303\270")) + (should-not (string-search (string-to-multibyte "\370") "\303\270")) + (should-not (string-search "\370" (string-to-multibyte "\303\270"))) + (should-not (string-search (string-to-multibyte "\370") + (string-to-multibyte "\303\270"))) + (should (equal (string-search (string-to-multibyte "o\303\270") "foo\303\270") + 2)) + (should (equal (string-search "\303\270" "foo\303\270") 3))) diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el new file mode 100644 index 00000000000..7d1a6ce6dc3 --- /dev/null +++ b/test/src/indent-tests.el @@ -0,0 +1,59 @@ +;;; indent-tests.el --- tests for src/indent.c -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `https://www.gnu.org/licenses/'. + +;;; Commentary: + +;;; Code: + +(ert-deftest indent-tests-move-to-column-invis-1tab () + "Test `move-to-column' when a TAB is followed by invisible text." + (should + (string= + (with-temp-buffer + (insert "\tLine starting with INVISIBLE text after TAB\n") + (add-text-properties 2 21 '(invisible t)) + (goto-char (point-min)) + (move-to-column 7 t) + (buffer-substring-no-properties 1 8)) + " "))) + +(ert-deftest indent-tests-move-to-column-invis-2tabs () + "Test `move-to-column' when 2 TABs are followed by invisible text." + (should + (string= + (with-temp-buffer + (insert "\t\tLine starting with INVISIBLE text after TAB\n") + (add-text-properties 3 22 '(invisible t)) + (goto-char (point-min)) + (move-to-column 12 t) + (buffer-substring-no-properties 1 11)) + "\t \tLine"))) + +(ert-deftest indent-tests-move-to-column-invis-between-tabs () + "Test `move-to-column' when 2 TABs are mixed with invisible text." + (should + (string= + (with-temp-buffer + (insert "\txxx\tLine starting with INVISIBLE text after TAB\n") + (add-text-properties 6 25 '(invisible t)) + (add-text-properties 2 5 '(invisible t)) + (goto-char (point-min)) + (move-to-column 12 t) + (buffer-substring-no-properties 1 14)) + "\txxx \tLine"))) diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el index 1988ba51a76..970a53555f9 100644 --- a/test/src/keyboard-tests.el +++ b/test/src/keyboard-tests.el @@ -32,5 +32,20 @@ (read-event nil nil 2)) ?\C-b))) +(ert-deftest keyboard-lossage-size () + "Test `lossage-size'." + (let ((min-value 100) + (lossage-orig (lossage-size))) + (dolist (factor (list 1 3 4 5 10 7 3)) + (let ((new-lossage (* factor min-value))) + (should (= new-lossage (lossage-size new-lossage))))) + ;; Wrong type + (should-error (lossage-size -5)) + (should-error (lossage-size "200")) + ;; Less that minimum value + (should-error (lossage-size (1- min-value))) + (should (= lossage-orig (lossage-size lossage-orig))))) + + (provide 'keyboard-tests) ;;; keyboard-tests.el ends here diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 75f8c0f092e..1a30a7d3a0b 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -23,6 +23,19 @@ (require 'ert) +(ert-deftest describe-buffer-bindings/header-in-current-buffer () + "Header should be inserted into the current buffer. +https://debbugs.gnu.org/39149#31" + (with-temp-buffer + (describe-buffer-bindings (current-buffer)) + (should (string-match (rx bol "key" (+ space) "binding" eol) + (buffer-string))))) + +(ert-deftest describe-buffer-bindings/returns-nil () + "Should return nil." + (with-temp-buffer + (should (eq (describe-buffer-bindings (current-buffer)) nil)))) + (ert-deftest keymap-store_in_keymap-XFASTINT-on-non-characters () "Check for bug fixed in \"Fix assertion violation in define-key\", commit 86c19714b097aa477d339ed99ffb5136c755a046." diff --git a/test/data/somelib.el b/test/src/lread-resources/somelib.el index 7b8d4037396..7b8d4037396 100644 --- a/test/data/somelib.el +++ b/test/src/lread-resources/somelib.el diff --git a/test/data/somelib2.el b/test/src/lread-resources/somelib2.el index 05156145a22..05156145a22 100644 --- a/test/data/somelib2.el +++ b/test/src/lread-resources/somelib2.el diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 26fd6aa22a1..825b74e6234 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -25,6 +25,9 @@ ;;; Code: +(require 'ert) +(require 'ert-x) + (ert-deftest lread-char-number () (should (equal (read "?\\N{U+A817}") #xA817))) @@ -146,10 +149,7 @@ literals (Bug#20852)." (ert-deftest lread-test-bug26837 () "Test for https://debbugs.gnu.org/26837 ." - (let ((load-path (cons - (file-name-as-directory - (expand-file-name "data" (getenv "EMACS_TEST_DIRECTORY"))) - load-path))) + (let ((load-path (cons (ert-resource-directory) load-path))) (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))) (load "somelib2" nil t) diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 42e5962137c..7b026b6b21f 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -355,5 +355,53 @@ otherwise, use a different charset." (setcdr err err) (should-error (error-message-string err) :type 'circular-list))) +(print-tests--deftest print-hash-table-test () + (should + (string-match + "data (2 3)" + (let ((h (make-hash-table))) + (puthash 1 2 h) + (puthash 2 3 h) + (remhash 1 h) + (format "%S" h)))) + + (should + (string-match + "data ()" + (let ((h (make-hash-table))) + (let ((print-length 0)) + (format "%S" h))))) + + (should + (string-match + "data (99 99)" + (let ((h (make-hash-table))) + (dotimes (i 100) + (puthash i i h)) + (dotimes (i 99) + (remhash i h)) + (let ((print-length 1)) + (format "%S" h)))))) + +(print-tests--deftest print-integer-output-format () + ;; Bug#44155. + (let ((integer-output-format t) + (syms (list ?? ?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\ ?Á))) + (should (equal (read (print-tests--prin1-to-string syms)) syms)) + (should (equal (print-tests--prin1-to-string syms) + (concat "(" (mapconcat #'prin1-char syms " ") ")")))) + (let ((integer-output-format t) + (syms (list -1 0 1 ?\120 4194175 4194176 (max-char) (1+ (max-char))))) + (should (equal (read (print-tests--prin1-to-string syms)) syms))) + (let ((integer-output-format 16) + (syms (list -1 0 1 most-positive-fixnum (1+ most-positive-fixnum)))) + (should (equal (read (print-tests--prin1-to-string syms)) syms)) + (should (equal (print-tests--prin1-to-string syms) + (concat "(" (mapconcat + (lambda (i) + (if (and (>= i 0) (<= i most-positive-fixnum)) + (format "#x%x" i) (format "%d" i))) + syms " ") ")"))))) + (provide 'print-tests) ;;; print-tests.el ends here diff --git a/test/src/regex-resources/BOOST.tests b/test/src/regex-resources/BOOST.tests index 98fd3b6abf3..756fa00486b 100644 --- a/test/src/regex-resources/BOOST.tests +++ b/test/src/regex-resources/BOOST.tests @@ -93,7 +93,7 @@ aa\) ! . \0 0 1 ; -; now move on to the repetion ops, +; now move on to the repetition ops, ; starting with operator * - match_default normal REG_EXTENDED a* b 0 0 @@ -275,7 +275,7 @@ a(b*)c\1d abbcbbbd -1 -1 ^(.)\1 abc -1 -1 a([bc])\1d abcdabbd 4 8 5 6 ; strictly speaking this is at best ambiguous, at worst wrong, this is what most -; re implimentations will match though. +; re implementations will match though. a(([bc])\2)*d abbccd 0 6 3 5 3 4 a(([bc])\2)*d abbcbd -1 -1 diff --git a/test/src/syntax-resources/syntax-comments.txt b/test/src/syntax-resources/syntax-comments.txt new file mode 100644 index 00000000000..6f595e4d8dc --- /dev/null +++ b/test/src/syntax-resources/syntax-comments.txt @@ -0,0 +1,68 @@ +/* This file is a test file for tests of the comment handling in src/syntax.c. + This includes the testing of comments which figure in parse-partial-sexp + and scan-lists. */ + +/* Straight C comments */ +1/* comment */1 +2/**/2 +3// comment +3 +4// +4 +5/*/5 +6*/6 +7/* \*/7 +8*/8 +9/* \\*/9 +10*/10 +11// \ +12 +11 +13// \\ +14 +13 +15/* /*/15 + +/* C Comments within lists */ +59}59 +50{ /*70 comment */71 }50 +51{ /**/ }51 +52{ //72 comment +73}52 +53{ // +}53 +54{ //74 \ +}54 +55{/* */}55 +56{ /*76 \*/ }56 +57*/77 +58}58 +60{ /*78 \\*/79}60 + + +/* Straight Pascal comments (not nested) */ +20}20 +21{ Comment }21 +22{}22 +23{ +}23 +24{ +25{25 +}24 +26{ \}26 + + +/* Straight Lisp comments (not nested) */ +30 +30 +31; Comment +31 +32;;;;;;;;; +32 +33; \ +33 + +Local Variables: +mode: fundamental +eval: (set-syntax-table (make-syntax-table)) +End: diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el index 65c56b3b29d..4b9c3f277aa 100644 --- a/test/src/syntax-tests.el +++ b/test/src/syntax-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (ert-deftest parse-partial-sexp-continue-over-comment-marker () "Continue a parse that stopped in the middle of a comment marker." @@ -82,4 +83,350 @@ also has open paren syntax (see Bug#24870)." (should (equal (parse-partial-sexp pointC pointX nil nil ppsC) ppsX))))) + +;;; Commentary: +;; The next bit tests the handling of comments in syntax.c, in +;; particular the functions `forward-comment' and `scan-lists' and +;; `parse-partial-sexp' (in so far as they relate to comments). + +;; It is intended to enhance this bit to test nested comments +;; (2020-10-01). + +;; This bit uses the data file syntax-resources/syntax-comments.txt. + +(defun syntax-comments-point (n forw) + "Return the buffer offset corresponding to the \"label\" N. +N is a decimal number which appears in the data file, usually +twice, as \"labels\". It can also be a negative number or zero. +FORW is t when we're using the label at BOL, nil for the one at EOL. + +If the label N doesn't exist in the current buffer, an exception +is thrown. + +When FORW is t and N positive, we return the position after the +first occurrence of label N at BOL in the data file. With FORW +nil, we return the position before the last occurrence of the +label at EOL in the data file. + +When N is negative, we return instead the position of the end of +line that the -N label is on. When it is zero, we return POINT." + (if (zerop n) + (point) + (let ((str (format "%d" (abs n)))) + (save-excursion + (if forw + (progn + (goto-char (point-min)) + (re-search-forward + (concat "^\\(" str "\\)\\([^0-9\n]\\|$\\)")) + (if (< n 0) + (progn (end-of-line) (point)) + (match-end 1))) + (goto-char (point-max)) + (re-search-backward + (concat "\\(^\\|[^0-9]\\)\\(" str "\\)$")) + (if (< n 0) + (progn (end-of-line) (point)) + (match-beginning 2))))))) + +(defun syntax-comments-midpoint (n) + "Return the buffer offset corresponding to the \"label\" N. +N is a positive decimal number which should appear in the buffer +exactly once. The label need not be at the beginning or end of a +line. + +The return value is the position just before the label. + +If the label N doesn't exist in the current buffer, an exception +is thrown." + (let ((str (format "%d" n))) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "\\(^\\|[^0-9]\\)\\(" str "\\)\\([^0-9\n]\\|$\\)")) + (match-beginning 2)))) + +(eval-and-compile + (defvar syntax-comments-section)) + +(defmacro syntax-comments (-type- -dir- res start &optional stop) + "Create an ERT test to test (forward-comment 1/-1). +The test uses a fixed name data file, which it visits. It calls +entry and exit functions to set up and tear down syntax entries +for comment characters. The test is given a name based on the +global variable `syntax-comments-section', the direction of +movement and the value of START. + +-TYPE- (unquoted) is a symbol from whose name the entry and exit +function names are derived by appending \"-in\" and \"-out\". + +-DIR- (unquoted) is `forward' or `backward', the direction +`forward-comment' is attempted. + +RES, t or nil, is the expected result from `forward-comment'. + +START and STOP are decimal numbers corresponding to labels in the +data file marking the start and expected stop positions. See +`syntax-comments-point' for a precise specification. If STOP is +missing or nil, the value of START is assumed for it." + (declare (debug t)) + (let ((forw + (cond + ((eq -dir- 'forward) t) + ((eq -dir- 'backward) nil) + (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-)))) + (start-str (format "%d" (abs start))) + (type -type-)) + `(ert-deftest ,(intern (concat "syntax-comments-" + syntax-comments-section + (if forw "-f" "-b") start-str)) + () + (with-current-buffer + (find-file + ,(ert-resource-file "syntax-comments.txt")) + (,(intern (concat (symbol-name type) "-in"))) + (goto-char (syntax-comments-point ,start ,forw)) + (let ((stop (syntax-comments-point ,(or stop start) ,(not forw)))) + (should (eq (forward-comment ,(if forw 1 -1)) ,res)) + (should (eq (point) stop))) + (,(intern (concat (symbol-name type) "-out"))))))) + +(defmacro syntax-br-comments (-type- -dir- res -start- &optional stop) + "Create an ERT test to test (scan-lists <position> 1/-1 0). +This is to test the interface between scan-lists and the internal +comment routines in syntax.c. + +The test uses a fixed name data file, which it visits. It calls +entry and exit functions to set up and tear down syntax entries +for comment and paren characters. The test is given a name based +on the global variable `syntax-comments-section', the direction +of movement and the value of -START-. + +-TYPE- (unquoted) is a symbol from whose name the entry and exit +function names are derived by appending \"-in\" and \"-out\". + +-DIR- (unquoted) is `forward' or `backward', the direction +`scan-lists' is attempted. + +RES is t if `scan-lists' is expected to return, nil if it is +expected to raise a `scan-error' exception. + +-START- and STOP are decimal numbers corresponding to labels in the +data file marking the start and expected stop positions. See +`syntax-comments-point' for a precise specification. If STOP is +missing or nil, the value of -START- is assumed for it." + (declare (debug t)) + (let* ((forw + (cond + ((eq -dir- 'forward) t) + ((eq -dir- 'backward) nil) + (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-)))) + (start -start-) + (start-str (format "%d" (abs start))) + (type -type-)) + `(ert-deftest ,(intern (concat "syntax-br-comments-" + syntax-comments-section + (if forw "-f" "-b") start-str)) + () + (with-current-buffer + (find-file + ,(ert-resource-file "syntax-comments.txt")) + (,(intern (concat (symbol-name type) "-in"))) + (let ((start-pos (syntax-comments-point ,start ,forw)) + ,@(if res + `((stop-pos (syntax-comments-point + ,(or stop start) ,(not forw)))))) + ,(if res + `(should + (eq (scan-lists start-pos ,(if forw 1 -1) 0) + stop-pos)) + `(should-error (scan-lists start-pos ,(if forw 1 -1) 0) + :type 'scan-error))) + (,(intern (concat (symbol-name type) "-out"))))))) + +(defmacro syntax-pps-comments (-type- -start- open close &optional -stop-) + "Create an ERT test to test `parse-partial-sexp' with comments. +This is to test the interface between `parse-partial-sexp' and +the internal comment routines in syntax.c. + +The test uses a fixed name data file, which it visits. It calls +entry and exit functions to set up and tear down syntax entries +for comment and paren characters. The test is given a name based +on the global variable `syntax-comments-section', and the value +of -START-. + +The generated test calls `parse-partial-sexp' three times, the +first two with COMMENTSTOP set to `syntax-table' so as to stop +after the start and end of the comment. The third call is +expected to stop at the brace/paren matching the one where the +test started. + +-TYPE- (unquoted) is a symbol from whose name the entry and exit +function names are derived by appending \"-in\" and \"-out\". + +-START- and -STOP- are decimal numbers corresponding to labels in +the data file marking the start and expected stop positions. See +`syntax-comments-point' for a precise specification. If -STOP- +is missing or nil, the value of -START- is assumed for it. + +OPEN and CLOSE are decimal numbers corresponding to labels in the +data file marking just after the comment opener and closer where +the `parse-partial-sexp's are expected to stop. See +`syntax-comments-midpoint' for a precise specification." + (declare (debug t)) + (let* ((type -type-) + (start -start-) + (start-str (format "%d" start)) + (stop (or -stop- start))) + `(ert-deftest ,(intern (concat "syntax-pps-comments-" + syntax-comments-section + "-" start-str)) + () + (with-current-buffer + (find-file + ,(ert-resource-file "syntax-comments.txt")) + (,(intern (concat (symbol-name type) "-in"))) + (let ((start-pos (syntax-comments-point ,start t)) + (open-pos (syntax-comments-midpoint ,open)) + (close-pos (syntax-comments-midpoint ,close)) + (stop-pos (syntax-comments-point ,stop nil)) + s) + (setq s (parse-partial-sexp + start-pos (point-max) 0 nil nil 'syntax-table)) + (should (eq (point) open-pos)) + (setq s (parse-partial-sexp + (point) (point-max) 0 nil s 'syntax-table)) + (should (eq (point) close-pos)) + (setq s (parse-partial-sexp (point) (point-max) 0 nil s)) + (should (eq (point) stop-pos))) + (,(intern (concat (symbol-name type) "-out"))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; "Pascal" style comments - single character delimiters, the closing +;; delimiter not being newline. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun {-in () + (setq parse-sexp-ignore-comments t) + (setq comment-end-can-be-escaped nil) + (modify-syntax-entry ?{ "<") + (modify-syntax-entry ?} ">")) +(defun {-out () + (modify-syntax-entry ?{ "(}") + (modify-syntax-entry ?} "){")) +(eval-and-compile + (setq syntax-comments-section "pascal")) + +(syntax-comments { forward nil 20 0) +(syntax-comments { backward nil 20 0) +(syntax-comments { forward t 21) +(syntax-comments { backward t 21) +(syntax-comments { forward t 22) +(syntax-comments { backward t 22) + +(syntax-comments { forward t 23) +(syntax-comments { backward t 23) +(syntax-comments { forward t 24) +(syntax-comments { backward t 24) +(syntax-comments { forward t 26) +(syntax-comments { backward t 26) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; "Lisp" style comments - single character opening delimiters on line +;; comments. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun \;-in () + (setq parse-sexp-ignore-comments t) + (setq comment-end-can-be-escaped nil) + (modify-syntax-entry ?\n ">") + (modify-syntax-entry ?\; "<")) +(defun \;-out () + (modify-syntax-entry ?\n " ") + (modify-syntax-entry ?\; ".")) +(eval-and-compile + (setq syntax-comments-section "lisp")) + +(syntax-comments \; backward nil 30 30) +(syntax-comments \; forward t 31) +(syntax-comments \; backward t 31) +(syntax-comments \; forward t 32) +(syntax-comments \; backward t 32) +(syntax-comments \; forward t 33) +(syntax-comments \; backward t 33) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun /*-in () + (setq parse-sexp-ignore-comments t) + (setq comment-end-can-be-escaped t) + (modify-syntax-entry ?/ ". 124b") + (modify-syntax-entry ?* ". 23") + (modify-syntax-entry ?\n "> b")) +(defun /*-out () + (setq comment-end-can-be-escaped nil) + (modify-syntax-entry ?/ ".") + (modify-syntax-entry ?* ".") + (modify-syntax-entry ?\n " ")) +(eval-and-compile + (setq syntax-comments-section "c")) + +(syntax-comments /* forward t 1) +(syntax-comments /* backward t 1) +(syntax-comments /* forward t 2) +(syntax-comments /* backward t 2) +(syntax-comments /* forward t 3) +(syntax-comments /* backward t 3) + +(syntax-comments /* forward t 4) +(syntax-comments /* backward t 4) +(syntax-comments /* forward t 5 6) +(syntax-comments /* backward nil 5 0) +(syntax-comments /* forward nil 6 0) +(syntax-comments /* backward t 6 5) + +(syntax-comments /* forward t 7 8) +(syntax-comments /* backward nil 7 0) +(syntax-comments /* forward nil 8 0) +(syntax-comments /* backward t 8 7) +(syntax-comments /* forward t 9) +(syntax-comments /* backward t 9) + +(syntax-comments /* forward nil 10 0) +(syntax-comments /* backward nil 10 0) +(syntax-comments /* forward t 11) +(syntax-comments /* backward t 11) + +(syntax-comments /* forward t 13 14) +(syntax-comments /* backward nil 13 -14) +(syntax-comments /* forward t 15) +(syntax-comments /* backward t 15) + +;; Emacs 27 "C" style comments inside brace lists. +(syntax-br-comments /* forward t 50) +(syntax-br-comments /* backward t 50) +(syntax-br-comments /* forward t 51) +(syntax-br-comments /* backward t 51) +(syntax-br-comments /* forward t 52) +(syntax-br-comments /* backward t 52) + +(syntax-br-comments /* forward t 53) +(syntax-br-comments /* backward t 53) +(syntax-br-comments /* forward t 54 20) +(syntax-br-comments /* backward t 54) +(syntax-br-comments /* forward t 55) +(syntax-br-comments /* backward t 55) + +(syntax-br-comments /* forward t 56 58) +(syntax-br-comments /* backward t 58 56) +(syntax-br-comments /* backward nil 59) +(syntax-br-comments /* forward t 60) +(syntax-br-comments /* backward t 60) + +;; Emacs 27 "C" style comments parsed by `parse-partial-sexp'. +(syntax-pps-comments /* 50 70 71) +(syntax-pps-comments /* 52 72 73) +(syntax-pps-comments /* 54 74 55 20) +(syntax-pps-comments /* 56 76 77 58) +(syntax-pps-comments /* 60 78 79) + ;;; syntax-tests.el ends here diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el index b26a276c61b..182e2df93bc 100644 --- a/test/src/undo-tests.el +++ b/test/src/undo-tests.el @@ -4,18 +4,20 @@ ;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el new file mode 100644 index 00000000000..fad90fad531 --- /dev/null +++ b/test/src/xdisp-tests.el @@ -0,0 +1,75 @@ +;;; xdisp-tests.el --- tests for xdisp.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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) + +(defmacro xdisp-tests--in-minibuffer (&rest body) + (declare (debug t) (indent 0)) + `(catch 'result + (minibuffer-with-setup-hook + (lambda () + (let ((redisplay-skip-initial-frame nil) + (executing-kbd-macro nil)) ;Don't skip redisplay + (throw 'result (progn . ,body)))) + (let ((executing-kbd-macro t)) ;Force real minibuffer in `read-string'. + (read-string "toto: "))))) + +(ert-deftest xdisp-tests--minibuffer-resizing () ;; bug#43519 + (should + (equal + t + (xdisp-tests--in-minibuffer + (insert "hello") + (let ((ol (make-overlay (point) (point))) + (max-mini-window-height 1) + (text "askdjfhaklsjdfhlkasjdfhklasdhflkasdhflkajsdhflkashdfkljahsdlfkjahsdlfkjhasldkfhalskdjfhalskdfhlaksdhfklasdhflkasdhflkasdhflkajsdhklajsdgh")) + ;; (save-excursion (insert text)) + ;; (sit-for 2) + ;; (delete-region (point) (point-max)) + (put-text-property 0 1 'cursor t text) + (overlay-put ol 'after-string text) + (redisplay 'force) + ;; Make sure we do the see "hello" text. + (prog1 (equal (window-start) (point-min)) + ;; (list (window-start) (window-end) (window-width)) + (delete-overlay ol))))))) + +(ert-deftest xdisp-tests--minibuffer-scroll () ;; bug#44070 + (let ((posns + (xdisp-tests--in-minibuffer + (let ((max-mini-window-height 4)) + (dotimes (_ 80) (insert "\nhello")) + (beginning-of-buffer) + (redisplay 'force) + (end-of-buffer) + ;; A simple edit like removing the last `o' shouldn't cause + ;; the rest of the minibuffer's text to move. + (list + (progn (redisplay 'force) (window-start)) + (progn (delete-char -1) + (redisplay 'force) (window-start)) + (progn (goto-char (point-min)) (redisplay 'force) + (goto-char (point-max)) (redisplay 'force) + (window-start))))))) + (should (equal (nth 0 posns) (nth 1 posns))) + (should (equal (nth 1 posns) (nth 2 posns))))) + +;;; xdisp-tests.el ends here diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el index d758c8868cf..800f400b3ca 100644 --- a/test/src/xml-tests.el +++ b/test/src/xml-tests.el @@ -42,20 +42,6 @@ (comment nil "comment-b") (comment nil "comment-c")))) "Alist of XML strings and their expected parse trees for preserved comments.") -(defvar libxml-tests--data-comments-discarded - `(;; simple case - ("<?xml version=\"1.0\"?><foo baz=\"true\">bar</foo>" - . (foo ((baz . "true")) "bar")) - ;; toplevel comments -- first document child must not get lost - (,(concat "<?xml version=\"1.0\"?><foo>bar</foo><!--comment-1-->" - "<!--comment-2-->") - . (foo nil "bar")) - (,(concat "<?xml version=\"1.0\"?><!--comment-a--><foo a=\"b\">" - "<bar>blub</bar></foo><!--comment-b--><!--comment-c-->") - . (foo ((a . "b")) (bar nil "blub")))) - "Alist of XML strings and their expected parse trees for discarded comments.") - - (ert-deftest libxml-tests () "Test libxml." (when (fboundp 'libxml-parse-xml-region) @@ -64,11 +50,6 @@ (erase-buffer) (insert (car test)) (should (equal (cdr test) - (libxml-parse-xml-region (point-min) (point-max))))) - (dolist (test libxml-tests--data-comments-discarded) - (erase-buffer) - (insert (car test)) - (should (equal (cdr test) - (libxml-parse-xml-region (point-min) (point-max) nil t))))))) + (libxml-parse-xml-region (point-min) (point-max)))))))) ;;; libxml-tests.el ends here |