diff options
423 files changed, 19049 insertions, 13293 deletions
@@ -187,6 +187,7 @@ X11 is being used. X libtiff for TIFF: http://www.simplesystems.org/libtiff/ X libgif for GIF: http://giflib.sourceforge.net/ librsvg2 for SVG: https://wiki.gnome.org/Projects/LibRsvg + libwebp for WebP: https://developers.google.com/speed/webp/ If you supply the appropriate --without-LIB option, 'configure' will omit the corresponding library from Emacs, even if that makes for a @@ -313,6 +314,7 @@ or more of these options: --without-gif for GIF image support --without-png for PNG image support --without-rsvg for SVG image support + --without-webp for WebP image support Although ImageMagick support is disabled by default due to security and stability concerns, you can enable it with --with-imagemagick. diff --git a/Makefile.in b/Makefile.in index 5fc1edc7a39..ccb5d93f2f0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -313,6 +313,7 @@ TRANSFORM = @program_transform_name@ EMACS_NAME = `echo emacs | sed '$(TRANSFORM)'` EMACS = ${EMACS_NAME}${EXEEXT} EMACSFULL = `echo emacs-${version} | sed '$(TRANSFORM)'`${EXEEXT} +EMACS_PDMP = `./src/emacs${EXEEXT} --fingerprint`.pdmp # Subdirectories to make recursively. SUBDIR = $(NTDIR) lib lib-src src lisp @@ -521,7 +522,7 @@ install-arch-dep: src install-arch-indep install-etcdoc install-$(NTDIR) ifeq (${ns_self_contained},no) ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} "$(DESTDIR)${bindir}/$(EMACSFULL)" ifeq (${DUMPING},pdumper) - ${INSTALL_DATA} src/emacs.pdmp "$(DESTDIR)${libexecdir}/emacs/${version}/${configuration}"/emacs.pdmp + ${INSTALL_DATA} src/emacs.pdmp "$(DESTDIR)${libexecdir}/emacs/${version}/${configuration}"/emacs-${EMACS_PDMP} endif -chmod 755 "$(DESTDIR)${bindir}/$(EMACSFULL)" ifndef NO_BIN_LINK @@ -1164,7 +1165,7 @@ ChangeLog: ./$(emacslog) -o $(CHANGELOG) -n $(CHANGELOG_HISTORY_INDEX_MAX) # Check that we are in a good state for changing history. -PREFERRED_BRANCH = emacs-27 +PREFERRED_BRANCH = emacs-28 preferred-branch-is-current: git branch | grep -q '^\* $(PREFERRED_BRANCH)$$' unchanged-history-files: @@ -2,7 +2,7 @@ Copyright (C) 2001-2021 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 28.0.60 of GNU Emacs, the extensible, +This directory tree holds version 29.0.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 68c12438f5a..634d6f3f3bb 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -287,6 +287,7 @@ HAVE_UTIMENSAT HAVE_UTMP_H HAVE_VFORK HAVE_VFORK_H +HAVE_WEBP HAVE_WCHAR_H HAVE_WCHAR_T HAVE_WINDOW_SYSTEM diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 851212c7bb1..adb13fc4e2e 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -122,7 +122,8 @@ If nil, the function `gitmerge-default-branch' guesses.") (with-temp-buffer (if (not branch) (insert-file-contents "configure.ac") - (call-process "git" nil t nil "show" (format "%s:configure.ac" branch)) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (call-process "git" nil t nil "show" (format "%s:configure.ac" branch))) (goto-char (point-min))) (re-search-forward "^AC_INIT([^,]+, \\([0-9]+\\)\\.") (string-to-number (match-string 1)))) @@ -148,7 +149,8 @@ If nil, the function `gitmerge-default-branch' guesses.") (pop-to-buffer (get-buffer-create gitmerge-output-buffer)) (fundamental-mode) (erase-buffer) - (call-process "git" nil t nil "log" "-1" commit) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (call-process "git" nil t nil "log" "-1" commit)) (goto-char (point-min)) (gitmerge-highlight-skip-regexp))))) @@ -160,7 +162,8 @@ If nil, the function `gitmerge-default-branch' guesses.") (when commit (pop-to-buffer (get-buffer-create gitmerge-output-buffer)) (erase-buffer) - (call-process "git" nil t nil "diff-tree" "-p" commit) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (call-process "git" nil t nil "diff-tree" "-p" commit)) (goto-char (point-min)) (diff-mode))))) @@ -173,7 +176,9 @@ If nil, the function `gitmerge-default-branch' guesses.") (pop-to-buffer (get-buffer-create gitmerge-output-buffer)) (erase-buffer) (fundamental-mode) - (call-process "git" nil t nil "diff" "--name-only" (concat commit "^!")) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (call-process "git" nil t nil "diff" "--name-only" + (concat commit "^!"))) (goto-char (point-min)))))) (defun gitmerge-toggle-skip () @@ -216,9 +221,10 @@ if and why this commit should be skipped." ;; Go through the log and remember all commits that match ;; `gitmerge-skip-regexp' or are marked by --cherry-mark. (with-temp-buffer - (call-process "git" nil t nil "log" "--cherry-mark" "--left-only" - "--no-decorate" - (concat from "..." (car (vc-git-branches)))) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (call-process "git" nil t nil "log" "--cherry-mark" "--left-only" + "--no-decorate" + (concat from "..." (car (vc-git-branches))))) (goto-char (point-max)) (while (re-search-backward "^commit \\(.+\\) \\([0-9a-f]+\\).*" nil t) (let ((cherrymark (match-string 1)) @@ -241,9 +247,10 @@ if and why this commit should be skipped." "Create the buffer for choosing commits." (with-current-buffer (get-buffer-create gitmerge-buffer) (erase-buffer) - (call-process "git" nil t nil "log" "--left-only" - "--pretty=format:%h %<(20,trunc) %an: %<(100,trunc) %s" - (concat from "..." (car (vc-git-branches)))) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (call-process "git" nil t nil "log" "--left-only" + "--pretty=format:%h %<(20,trunc) %an: %<(100,trunc) %s" + (concat from "..." (car (vc-git-branches))))) (goto-char (point-min)) (while (looking-at "^\\([a-f0-9]+\\)") (let ((skipreason (gitmerge-skip-commit-p (match-string 1) commits))) @@ -326,7 +333,8 @@ Returns non-nil if conflicts remain." ;; (pop-to-buffer (current-buffer)) (debug 'before-resolve) )) ;; Try to resolve the conflicts. - (let (temp) + (let ((coding-system-for-read vc-git-log-output-coding-system) + temp) (cond ;; FIXME when merging release branch to master, we still ;; need to detect and handle the case where NEWS was modified @@ -392,9 +400,10 @@ is nil, only the single commit BEG is merged." (if end "s were " " was ") "skipped:\n\n") "")) - (apply #'call-process "git" nil t nil "log" "--oneline" - (if end (list (concat beg "~.." end)) - `("-1" ,beg))) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (apply #'call-process "git" nil t nil "log" "--oneline" + (if end (list (concat beg "~.." end)) + `("-1" ,beg)))) (insert "\n") ;; Truncate to 72 chars so that the resulting ChangeLog line fits in 80. (goto-char (point-min)) @@ -408,8 +417,9 @@ MISSING must be a list of SHA1 strings." (with-current-buffer (get-buffer-create gitmerge-output-buffer) (erase-buffer) (let* ((skip (cdar missing)) + (coding-system-for-read vc-git-log-output-coding-system) (beg (car (pop missing))) - end commitmessage) + end commitmessage commitmessage1 commitmessage-file status) ;; Determine last revision with same boolean skip status. (while (and missing (eq (null (cdar missing)) @@ -423,12 +433,32 @@ MISSING must be a list of SHA1 strings." (if end (concat ".." (substring end 0 6)) "")) (unless end (setq end beg)) - (unless (zerop - (apply #'call-process "git" nil t nil "merge" "--no-ff" - (append (when skip '("-s" "ours")) - `("-m" ,commitmessage ,end)))) + (when (eq system-type 'windows-nt) + ;; Command lines on MS-Windows cannot include newlines. + ;; Since "git merge" doesn't accept a -F FILE option, we + ;; commit the merge with a shortened single-line log message, + ;; and then invoke "git commit --amend" with the full log + ;; message from a temporary file. + (setq commitmessage1 + ;; Make sure the commit message is at most a single line. + (car (split-string commitmessage "[\f\n\r\v]+"))) + (setq commitmessage-file (make-nearby-temp-file "gitmerge-msg")) + (let ((coding-system-for-write vc-git-commits-coding-system)) + (write-region commitmessage nil commitmessage-file nil 'silent))) + (unless (setq status + (zerop + (apply #'call-process "git" nil t nil "merge" "--no-ff" + (append (when skip '("-s" "ours")) + (if commitmessage-file + `("-m" ,commitmessage1 ,end) + `("-m" ,commitmessage ,end)))))) (gitmerge-write-missing missing from) - (gitmerge-resolve-unmerged))) + (gitmerge-resolve-unmerged)) + (when (and commitmessage-file (file-exists-p commitmessage-file)) + (if status + (call-process "git" nil t nil + "commit" "--amend" "-F" commitmessage-file)) + (delete-file commitmessage-file))) missing)) (defun gitmerge-resolve-unmerged () @@ -436,7 +466,8 @@ MISSING must be a list of SHA1 strings." Throw an user-error if we cannot resolve automatically." (with-current-buffer (get-buffer-create gitmerge-output-buffer) (erase-buffer) - (let (files conflicted) + (let ((coding-system-for-read vc-git-log-output-coding-system) + files conflicted) ;; List unmerged files (if (not (zerop (call-process "git" nil t nil @@ -479,17 +510,19 @@ Throw an user-error if we cannot resolve automatically." (defun gitmerge-repo-clean () "Return non-nil if repository is clean." (with-temp-buffer + (let ((coding-system-for-read vc-git-log-output-coding-system)) (call-process "git" nil t nil "diff" "--staged" "--name-only") (call-process "git" nil t nil "diff" "--name-only") - (zerop (buffer-size)))) + (zerop (buffer-size))))) (defun gitmerge-commit () "Commit, and return non-nil if it succeeds." (with-current-buffer (get-buffer-create gitmerge-output-buffer) - (erase-buffer) - (eq 0 (call-process "git" nil t nil "commit" "--no-edit")))) + (let ((coding-system-for-read vc-git-log-output-coding-system)) + (erase-buffer) + (eq 0 (call-process "git" nil t nil "commit" "--no-edit"))))) (defun gitmerge-maybe-resume () "Check if we have to resume a merge. @@ -603,7 +636,7 @@ Branch FROM will be prepended to the list." "(s) Toggle skip, (l) Show log, (d) Show diff, " "(f) Show files, (m) Start merge\n" (propertize "Flags: " 'font-lock-face 'bold) - "(C) Detected backport (cherry-mark), (R) Log matches " + "(C) Detected backport (cherry-mark), (R) Matches skip " "regexp, (M) Manually picked\n\n") (gitmerge-mode) (pop-to-buffer (current-buffer)) diff --git a/admin/notes/emba b/admin/notes/emba index 36b126e7735..4e500bc92cf 100644 --- a/admin/notes/emba +++ b/admin/notes/emba @@ -31,20 +31,26 @@ The Emacs jobset is defined in the Emacs source tree, file '.gitlab-ci.yml'. It could be adapted for every Emacs branch, see <https://emba.gnu.org/help/ci/yaml/README.md>. +A jobset on Gitlab is called pipeline. Emacs pipelines run through +the stages 'build-images', 'platform-images' and 'native-comp-images' +(create an Emacs instance by 'make bootstrap' with different +configuration parameters) as well as 'normal', 'slow', 'platforms' and +'native-comp' (run respective test jobs based on the produced images). + Every job runs in a Debian docker container. It uses the local clone of the Emacs git repository to perform a bootstrap and test of Emacs. This could happen for several jobs with changed configuration, compile and test parameters. -There are different types of jobs: 'prep-image-base' is responsible to -prepare the environment for the following jobs. 'build-image-*' jobs -are responsible to compile Emacs in different configuration. The -corresponding 'test-*' jobs run the ert tests. +The 'build-image-*' jobs of the different '*-images' stages run only +if there are severe changes in the Emacs sources, like in Makefiles +etc. Otherwise they are skipped, and the corresponding 'test-*' jobs +run just 'make -C test ...' in the respective Docker image from a +previous build run. -A special job is 'test-all-inotify', which runs 'make check-expensive'. -While most of the jobs run as soon as a respective file has been -committed into the Emacs git repository, this test job runs scheduled, -every 8 hours. +Jobs in the 'build-images' and 'normal' stages are triggered by +changes of respective files in the Emacs git repository. All other +jobs run scheduled in a pipeline every 8 hours. The log files for every test job are kept on the server for a week. They can be downloaded from the server, visiting the URL diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow index d109cdaa354..265a106bad5 100644 --- a/admin/notes/git-workflow +++ b/admin/notes/git-workflow @@ -16,14 +16,14 @@ Initial setup Then we want to clone the repository. We normally want to have both the current master and (if there is one) the active release branch -(eg emacs-27). +(eg emacs-28). mkdir ~/emacs cd ~/emacs git clone <membername>@git.sv.gnu.org:/srv/git/emacs.git master cd master git config push.default current -git worktree add ../emacs-27 emacs-27 +git worktree add ../emacs-28 emacs-28 You now have both branches conveniently accessible, and you can do "git pull" in them once in a while to keep updated. @@ -67,7 +67,7 @@ which will look like commit 958b768a6534ae6e77a8547a56fc31b46b63710b -cd ~/emacs/emacs-27 +cd ~/emacs/emacs-28 git cherry-pick -xe 958b768a6534ae6e77a8547a56fc31b46b63710b and add "Backport:" to the commit string. Then @@ -109,7 +109,7 @@ up-to-date by doing a pull. Then start Emacs with emacs -l admin/gitmerge.el -f gitmerge You'll be asked for the branch to merge, which will default to -(eg) 'origin/emacs-27', which you should accept. Merging a local tracking +(eg) 'origin/emacs-28', which you should accept. Merging a local tracking branch is discouraged, since it might not be up-to-date, or worse, contain commits from you which are not yet pushed upstream. diff --git a/configure.ac b/configure.ac index 6bc194d792f..33e7037afe2 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 28.0.60, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) +AC_INIT(GNU Emacs, 29.0.50, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. @@ -447,6 +447,7 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support]) OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) +OPTION_DEFAULT_ON([webp],[don't compile with WebP image support]) OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support]) OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support]) OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing]) @@ -2589,6 +2590,28 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${opsys}" = fi fi +### Use -lwebp if available, unless '--with-webp=no' +HAVE_WEBP=no +if test "${with_webp}" != "no"; then + if test "${HAVE_X11}" = "yes" || test "${opsys}" = "mingw32" \ + || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes"; then + WEBP_REQUIRED=0.6.0 + WEBP_MODULE="libwebp >= $WEBP_REQUIRED" + + EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE]) + AC_SUBST(WEBP_CFLAGS) + AC_SUBST(WEBP_LIBS) + fi + if test $HAVE_WEBP = yes; then + AC_DEFINE(HAVE_WEBP, 1, [Define to 1 if using libwebp.]) + CFLAGS="$CFLAGS $WEBP_CFLAGS" + # Windows loads libwebp dynamically + if test "${opsys}" = "mingw32"; then + WEBP_LIBS= + fi + fi +fi + HAVE_IMAGEMAGICK=no if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" = "yes"; then if test "${with_imagemagick}" != "no"; then @@ -3739,10 +3762,12 @@ AC_SUBST_FILE([module_env_snippet_25]) AC_SUBST_FILE([module_env_snippet_26]) AC_SUBST_FILE([module_env_snippet_27]) AC_SUBST_FILE([module_env_snippet_28]) +AC_SUBST_FILE([module_env_snippet_29]) module_env_snippet_25="$srcdir/src/module-env-25.h" module_env_snippet_26="$srcdir/src/module-env-26.h" module_env_snippet_27="$srcdir/src/module-env-27.h" module_env_snippet_28="$srcdir/src/module-env-28.h" +module_env_snippet_29="$srcdir/src/module-env-29.h" emacs_major_version="${PACKAGE_VERSION%%.*}" AC_SUBST(emacs_major_version) @@ -5682,6 +5707,7 @@ CFLAGS=$pre_PKG_CONFIG_CFLAGS LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS" gl_ASSERT_NO_GNULIB_POSIXCHECK gl_ASSERT_NO_GNULIB_TESTS +gl_EEMALLOC gl_INIT CFLAGS=$SAVE_CFLAGS LIBS=$SAVE_LIBS @@ -5890,8 +5916,8 @@ emacs_config_features= for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \ - SOUND THREADS TIFF \ - TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ + SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \ + UNEXEC WEBP X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ ZLIB; do case $opt in @@ -5936,6 +5962,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use a gif library? ${HAVE_GIF} $LIBGIF Does Emacs use a png library? ${HAVE_PNG} $LIBPNG Does Emacs use -lrsvg-2? ${HAVE_RSVG} + Does Emacs use -lwebp? ${HAVE_WEBP} Does Emacs use cairo? ${HAVE_CAIRO} Does Emacs use -llcms2? ${HAVE_LCMS2} Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK} diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 687a5caf712..86c04c84a2a 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -185,6 +185,11 @@ successfully. @item --version @opindex --version Print Emacs version, then exit successfully. + +@item --fingerprint +@opindex --fingerprint +Print the Emacs ``fingerprint'', which is used to uniquely identify +the compiled version of Emacs. @end table @node Initial Options diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 60e2d0aa874..d9d6a680057 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -195,7 +195,7 @@ the customization buffer: The first line shows that the variable is named @code{kill-ring-max}, formatted as @samp{Kill Ring Max} for easier -viewing. Its value is @samp{60}. The button labeled @samp{[Hide]}, +viewing. Its value is @samp{120}. The button labeled @samp{[Hide]}, if activated, hides the variable's value and state; this is useful to avoid cluttering up the customization buffer with very long values (for this reason, variables that have very long values may start out @@ -1474,9 +1474,10 @@ as Dired buffers (@pxref{Dired}). Most of the variables reflect the situation on the local machine. Often, they must use a different value when you operate in buffers -with a remote default directory. Think about the shell to be applied -when calling @code{shell} -- it might be @file{/bin/bash} on your -local machine, and @file{/bin/ksh} on a remote machine. +with a remote default directory. Think about the behavior when +calling @code{shell} -- on your local machine, you might use +@file{/bin/bash} and rely on termcap, but on a remote machine, it may +be @file{/bin/ksh} and terminfo. This can be accomplished with @dfn{connection-local variables}. Directory and file local variables override connection-local @@ -1492,6 +1493,10 @@ variables/value pairs in a @dfn{profile}, using the criteria, identifying a remote machine: @example +(connection-local-set-profile-variables 'remote-terminfo + '((system-uses-terminfo . t) + (comint-terminfo-terminal . "dumb-emacs-ansi"))) + (connection-local-set-profile-variables 'remote-ksh '((shell-file-name . "/bin/ksh") (shell-command-switch . "-c"))) @@ -1501,11 +1506,13 @@ criteria, identifying a remote machine: (shell-command-switch . "-c"))) (connection-local-set-profiles - '(:application tramp :machine "remotemachine") 'remote-ksh) + '(:application tramp :machine "remotemachine") + 'remote-terminfo 'remote-ksh) @end example - This code declares two different profiles, @code{remote-ksh} and -@code{remote-bash}. The profile @code{remote-ksh} is applied to all + This code declares three different profiles, @code{remote-terminfo}, +@code{remote-ksh}, and @code{remote-bash}. The profiles +@code{remote-terminfo} and @code{remote-ksh} are applied to all buffers which have a remote default directory matching the regexp @code{"remotemachine"} as host name. Such a criteria can also discriminate for the properties @code{:protocol} (this is the Tramp diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 9cdd4b805e6..704850e584c 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1509,14 +1509,12 @@ image-dired}. This prompts for a directory; specify one that has image files. This creates thumbnails for all the images in that directory, and displays them all in the thumbnail buffer. The thumbnails are generated in the background and are loaded as they -become available. This command asks for confirmation if the number of -image files exceeds @code{image-dired-show-all-from-dir-max-files}. +become available. With point in the thumbnail buffer, you can type @key{RET} -(@code{image-dired-display-thumbnail-original-image}) to display a -sized version of it in another window. This sizes the image to fit -the window. Use the arrow keys to move around in the buffer. For -easy browsing, use @key{SPC} +(@code{image-dired-display-thumbnail-original-image}) to display the +image in another window. Use the arrow keys to move around in the +thumbnail buffer. For easy browsing, use @key{SPC} (@code{image-dired-display-next-thumbnail-original}) to advance and display the next image. Typing @key{DEL} (@code{image-dired-display-previous-thumbnail-original}) backs up to diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 7d6c3085cb6..20a9d8be13b 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -461,15 +461,18 @@ Move point back to the previous hyperlink (@code{backward-button}). @item mouse-1 @itemx mouse-2 Follow a hyperlink that you click on. +@item n +@itemx p +Move forward and back between pages in the Help buffer. @item C-c C-c Show all documentation about the symbol at point (@code{help-follow-symbol}). @item C-c C-f @itemx r -Go forward to the next help topic (@code{help-go-forward}). +Go forward in history of help commands (@code{help-go-forward}). @item C-c C-b @itemx l -Go back to the previous help topic (@code{help-go-back}). +Go back in history of help commands (@code{help-go-back}). @item s View the source of the current help topic (if any) (@code{help-view-source}). @@ -498,6 +501,30 @@ C-b} or @kbd{l} (@code{help-go-back}). While retracing your steps, you can go forward by using @kbd{C-c C-f} or @kbd{r} (@code{help-go-forward}). +@kindex TAB @r{(Help mode)} +@findex forward-button +@kindex S-TAB @r{(Help mode)} +@findex backward-button + To move between hyperlinks in a help buffer, use @key{TAB} +(@code{forward-button}) to move forward to the next hyperlink and +@kbd{S-@key{TAB}} (@code{backward-button}) to move back to the +previous hyperlink. These commands act cyclically; for instance, +typing @key{TAB} at the last hyperlink moves back to the first +hyperlink. + +@kindex n @r{(Help mode)} +@kindex p @r{(Help mode)} +@findex help-goto-next-page +@findex help-goto-previous-page + Help buffers produced by some Help commands (like @kbd{C-h b}, which +shows a long list of key bindings) are divided into pages by the +@samp{^L} character. In such buffers, the @kbd{n} +(@code{help-goto-next-page}) command will take you to the next start +of page, and the @kbd{p} (@code{help-goto-previous-page}) command will +take you to the previous start of page. This way you can quickly +navigate between the different kinds of documentation in a help +buffer. + @cindex URL, viewing in help @cindex help, viewing web pages @cindex viewing web pages in help @@ -507,16 +534,6 @@ code definitions, and URLs (web pages). The first two are opened in Emacs, and the third using a web browser via the @code{browse-url} command (@pxref{Browse-URL}). -@kindex TAB @r{(Help mode)} -@findex forward-button -@kindex S-TAB @r{(Help mode)} -@findex backward-button - In a help buffer, @key{TAB} (@code{forward-button}) moves point -forward to the next hyperlink, while @kbd{S-@key{TAB}} -(@code{backward-button}) moves point back to the previous hyperlink. -These commands act cyclically; for instance, typing @key{TAB} at the -last hyperlink moves back to the first hyperlink. - To view all documentation about any symbol in the text, move point to the symbol and type @kbd{C-c C-c} (@code{help-follow-symbol}). This shows the documentation for all the meanings of the symbol---as a diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 6e4fd77e8b9..76fccdbdfec 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -353,7 +353,7 @@ other ways to move text around.) @vindex kill-ring-max The maximum number of entries in the kill ring is controlled by the -variable @code{kill-ring-max}. The default is 60. If you make a new +variable @code{kill-ring-max}. The default is 120. If you make a new kill when this limit has been reached, Emacs makes room by deleting the oldest entry in the kill ring. diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index d35a8351541..7b9b40388c2 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -45,10 +45,11 @@ from running the command by name. @cindex obsolete command When @kbd{M-x} completes on commands, it ignores the commands that -are declared @dfn{obsolete}; for these, you will have to type their -full name. (Obsolete commands are those for which newer, better -alternatives exist, and which are slated for removal in some future -Emacs release.) +were declared @dfn{obsolete} in any previous major version of Emacs; +for these, you will have to type their full name. Commands that were +marked obsolete in the current version of Emacs are listed. (Obsolete +commands are those for which newer, better alternatives exist, and +which are slated for removal in some future Emacs release.) @vindex read-extended-command-predicate In addition, @kbd{M-x} completion can exclude commands that are not diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5b66031b8a6..9a90a0054d4 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2139,7 +2139,10 @@ Find definition of identifier, and display it in a new frame Find definition of identifier at mouse click. @item M-, Go back to where you previously invoked @kbd{M-.} and friends -(@code{xref-pop-marker-stack}). +(@code{xref-go-back}). +@item C-M-, +Go forward to where you previously invoked @kbd{M-,} +(@code{xref-go-forward}). @item M-x xref-etags-mode Switch @code{xref} to use the @code{etags} backend. @end table @@ -2204,15 +2207,17 @@ selects the window showing the first candidate. The default value is buffer, but doesn't select any of them. @kindex M-, -@findex xref-pop-marker-stack -@vindex xref-marker-ring-length +@findex xref-go-back To go back to places @emph{from where} you've displayed the definition, -use @kbd{M-,} (@code{xref-pop-marker-stack}). It jumps back to the +use @kbd{M-,} (@code{xref-go-back}). It jumps back to the point of the last invocation of @kbd{M-.}. Thus you can find and examine the definition of something with @kbd{M-.} and then return to -where you were with @kbd{M-,}. @kbd{M-,} allows you to retrace your -steps to a depth determined by the variable -@code{xref-marker-ring-length}, which defaults to 16. +where you were with @kbd{M-,}. + +@kindex C-M-, +@findex xref-go-forward + Go forward to a place from where you previously went back using @kbd{M-,}. +This is useful if you find that you went back too far. @findex xref-etags-mode Some major modes install @code{xref} support facilities that might diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 5123a716dcb..7f91e1c188e 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1497,14 +1497,20 @@ directory stack if they are not already on it underlying shell, of course. @vindex comint-terminfo-terminal +@vindex system-uses-terminfo @vindex TERM@r{, environment variable, in sub-shell} Comint mode sets the @env{TERM} environment variable to a safe default value, but this value disables some useful features. For example, color is disabled in applications that use @env{TERM} to determine if color is supported. Therefore, Emacs provides an option -@code{comint-terminfo-terminal}, which you can set to a terminal that -is present in your system's terminfo database, in order to take -advantage of advanced features of that terminal. +@code{comint-terminfo-terminal} to let you choose a terminal with more +advanced features, as defined in your system's terminfo database. +Emacs will use this option as the value for @env{TERM} so long as +@code{system-uses-terminfo} is non-nil. + +Both @code{comint-terminfo-terminal} and @code{system-uses-terminfo} +can be declared as connection-local variables to adjust these options +to match what a remote system expects (@pxref{Connection Variables}). @node Terminal emulator @subsection Emacs Terminal Emulator @@ -1986,6 +1992,11 @@ the new frame displays the @file{*scratch*} buffer by default. You can customize this behavior with the variable @code{initial-buffer-choice} (@pxref{Entering Emacs}). +@item -r +@itemx --reuse-frame +Create a new graphical client frame if none exists, otherwise use an +existing Emacs frame. + @item -F @var{alist} @itemx --frame-parameters=@var{alist} Set the parameters for a newly-created graphical frame diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index 0f8f429b3f8..20eaa0bcb6f 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -1181,6 +1181,14 @@ The default is @code{t}, which fits well with the Windows default click-to-focus policy. @end ifnottex + On Windows 10 (version 1809 and higher) and Windows 11, Emacs title +bars and scroll bars will follow the system's Light or Dark mode, +similar to other programs such as Explorer and Command Prompt. To +change the color mode, select @code{Personalization} from +@w{@code{Windows Settings}}, then +@w{@code{Colors->Choose your color}} (or @w{@code{Choose your default +app mode}}); then restart Emacs. + @ifnottex @include msdos-xtra.texi @end ifnottex diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 51a48df2e27..0056906e1f7 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -868,6 +868,15 @@ highlighting also when point is in whitespace at the beginning of a line and there is a paren at the first or last non-whitespace position on the line, or when point is at the end of a line and there is a paren at the last non-whitespace position on the line. + +@item +@vindex show-paren-context-when-offscreen +@code{show-paren-context-when-offscreen}, when non-@code{nil}, shows +some context in the echo area when point is in a closing delimiter and +the opening delimiter is offscreen. The context is usually the line +that contains the opening delimiter, except if the opening delimiter +is on its own line, in which case the context includes the previous +nonblank line. @end itemize @cindex Electric Pair mode diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index dc8ca903b72..53291332d36 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -996,6 +996,13 @@ specific file (@pxref{File Variables}). major mode's special commands. (The variable @code{outline-minor-mode-prefix} controls the prefix used.) +@vindex outline-minor-mode-use-buttons + If @code{outline-minor-mode-use-buttons} is non-@code{nil}, Outline +minor mode will use buttons (at the start of the header lines) in +addition to ellipsis to show that a section is hidden. Using +@kbd{RET} (or clicking on the button with a mouse) will toggle +displaying the section. + @vindex outline-minor-mode-cycle If the @code{outline-minor-mode-cycle} user option is non-@code{nil}, the @kbd{TAB} and @kbd{S-TAB} keys are enabled on the diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 308153f9231..f5f79a543cb 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -4897,6 +4897,23 @@ region. @c FIXME: the definition of append-to-buffer has been changed (in @c 2010-03-30). +@c In Bug#8275, Stefan Monner <monnier@iro.umontreal.ca> writes: +@c >> Do you want to fix this, or shall I try? The problem is that +@c >> append-to-buffer now uses let* and with-current-buffer, so this might +@c >> break the flow of the text. At this point in the book, let* and +@c >> with-current-buffer are not yet introduced. +@c > +@c > Here are some thoughts: +@c > - I don't think it's of any importance that the example code be +@c > identical to the currently used code. +@c > - append-to-buffer might not be the best example since AFAICT copying +@c > text from one buffer to another is not a common operation and in most +@c > cases this is done via buffer-substring + insert (often with some +@c > processing on the string between the two) rather than with +@c > insert-buffer-substring which is a rarely used function. +@c > - yes, I think the text would benefit from some rethink to try and present +@c > with-current-buffer in preference to set-buffer, but it's not +@c > a simple fix. @node append-to-buffer @section The Definition of @code{append-to-buffer} @findex append-to-buffer @@ -8771,7 +8788,7 @@ keeps the kill ring from growing too long. It looks like this: The code checks whether the length of the kill ring is greater than the maximum permitted length. This is the value of -@code{kill-ring-max} (which is 60, by default). If the length of the +@code{kill-ring-max} (which is 120, by default). If the length of the kill ring is too long, then this code sets the last element of the kill ring to @code{nil}. It does this by using two functions, @code{nthcdr} and @code{setcdr}. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6e1d09ebb4d..b38a83b4fe0 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2616,10 +2616,14 @@ returns the key sequence as a vector, never as a string. @cindex upper case key sequence @cindex downcasing in @code{lookup-key} @cindex shift-translation +@vindex translate-upper-case-key-bindings If an input character is upper-case (or has the shift modifier) and has no key binding, but its lower-case equivalent has one, then -@code{read-key-sequence} converts the character to lower case. Note -that @code{lookup-key} does not perform case conversion in this way. +@code{read-key-sequence} converts the character to lower case. (This +behaviour can be disabled by setting the +@code{translate-upper-case-key-bindings} user option to @code{nil}.) +Note that @code{lookup-key} does not perform case conversion in this +way. @vindex this-command-keys-shift-translated When reading input results in such a @dfn{shift-translation}, Emacs diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 386d51a91a5..22528a1b0fd 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -561,6 +561,26 @@ You can rewrite the previous example with this macro as follows: @end example @end defmac +@defmac with-delayed-message (timeout message) body@dots{} +Sometimes it's unclear whether an operation will take a long time to +execute or not, or it can be inconvenient to implement a progress +reporter. This macro can be used in those situations. + +@lisp +(with-delayed-message (2 (format "Gathering data for %s" entry)) + (setq data (gather-data entry))) +@end lisp + +In this example, if the body takes more than two seconds to execute, +the message will be displayed. If it takes a shorter time than that, +the message won't be displayed. In either case, the body is evaluated +as normally, and the return value of the final element in the body is +the return value of the macro. + +The @var{message} element is evaluated before @var{body}, and is +always evaluated, whether the message is displayed or not. +@end defmac + @node Logging Messages @subsection Logging Messages in @file{*Messages*} @cindex logging echo-area messages @@ -1334,6 +1354,11 @@ are not resized. By default, this mode uses @code{fit-window-to-buffer} (@pxref{Resizing Windows}) for resizing. You can specify a different function by customizing the options @code{temp-buffer-max-height} and @code{temp-buffer-max-width} below. + +The effect of this option can be overridden by providing a suitable +@code{window-height}, @code{window-width} or @code{window-size} action +alist entry for @code{display-buffer} (@pxref{Buffer Display Action +Alists}). @end defopt @defopt temp-buffer-max-height @@ -1983,7 +2008,8 @@ The return value is an approximation: it only considers the values returned by @code{char-width} for the constituent characters, always takes a tab character as taking @code{tab-width} columns, ignores display properties and fonts, etc. For these reasons, we recommend -using @code{window-text-pixel-size}, described below, instead. +using @code{window-text-pixel-size} or @code{string-pixel-width}, +described below, instead. @end defun @defun truncate-string-to-width string width &optional start-column padding ellipsis ellipsis-text-property @@ -2175,12 +2201,42 @@ though when this function is run from an idle timer with a delay of zero seconds. @end defun +@defun string-pixel-width string +This is a convenience function that uses @code{window-text-pixel-size} +to compute the width of @var{string} (in pixels). +@end defun + @defun line-pixel-height This function returns the height in pixels of the line at point in the selected window. The value includes the line spacing of the line (@pxref{Line Height}). @end defun +@cindex grapheme cluster +@defun string-glyph-split string +When character compositions are in effect, sequence of characters can +be composed for display to form @dfn{grapheme clusters}, for example +to display accented characters, or ligatures, or Emoji, or when +complex text shaping requires that for some scripts. When that +happens, characters no longer map in a simple way to display columns, +and display layout decisions with such strings, such as truncating too +wide strings, can be a complex job. This function helps in performing +suvh jobs: it splits up its argument @var{string} into a list of +substrings, where each substring produces a single grapheme cluster +that should be displayed as a unit. Lisp programs can then use this +list to construct visually-valid substrings of @var{string} which will +look correctly on display, or compute the width of any substring of +@var{string} by adding the width of its constituents in the returned +list, etc. + +For instance, if you want to display a string without the first glyph, +you can say: + +@example +(apply #'insert (cdr (string-glyph-split string)))) +@end example +@end defun + When a buffer is displayed with line numbers (@pxref{Display Custom,,, emacs, The GNU Emacs Manual}), it is sometimes useful to know the width taken for displaying the line numbers. The following function @@ -2372,8 +2428,10 @@ value @code{unspecified}. This special value means that the face doesn't specify that attribute directly. An @code{unspecified} attribute tells Emacs to refer instead to a parent face (see the description @code{:inherit} attribute below); or, failing that, to an -underlying face (@pxref{Displaying Faces}). The @code{default} face -must specify all attributes. +underlying face (@pxref{Displaying Faces}). (However, +@code{unspecified} is not a valid value in @code{defface}.) + + The @code{default} face must specify all attributes. Some of these attributes are meaningful only on certain kinds of displays. If your display cannot handle a certain attribute, the @@ -5283,13 +5341,13 @@ to modify the set of known names for these dynamic libraries. Supported image formats (and the required support libraries) include PBM and XBM (which do not depend on support libraries and are always available), XPM (@code{libXpm}), GIF (@code{libgif} or -@code{libungif}), JPEG (@code{libjpeg}), TIFF -(@code{libtiff}), PNG (@code{libpng}), and SVG (@code{librsvg}). +@code{libungif}), JPEG (@code{libjpeg}), TIFF (@code{libtiff}), PNG +(@code{libpng}), SVG (@code{librsvg}), and WebP (@code{libwebp}). Each of these image formats is associated with an @dfn{image type symbol}. The symbols for the above formats are, respectively, -@code{pbm}, @code{xbm}, @code{xpm}, @code{gif}, -@code{jpeg}, @code{tiff}, @code{png}, and @code{svg}. +@code{pbm}, @code{xbm}, @code{xpm}, @code{gif}, @code{jpeg}, +@code{tiff}, @code{png}, @code{svg}, and @code{webp}. Furthermore, if you build Emacs with ImageMagick (@code{libMagickWand}) support, Emacs can display any image format @@ -6293,6 +6351,9 @@ Image type @code{png}. @item TIFF Image type @code{tiff}. Supports the @code{:index} property. @xref{Multi-Frame Images}. + +@item WebP +Image type @code{webp}. @end table @node Defining Images @@ -6444,7 +6505,7 @@ will compute a scaling factor based on the font pixel size. property yourself, but it is easier to use the functions in this section. -@defun insert-image image &optional string area slice +@defun insert-image image &optional string area slice inhibit-isearch This function inserts @var{image} in the current buffer at point. The value @var{image} should be an image descriptor; it could be a value returned by @code{create-image}, or the value of a symbol defined with @@ -6469,7 +6530,9 @@ image. Internally, this function inserts @var{string} in the buffer, and gives it a @code{display} property which specifies @var{image}. @xref{Display -Property}. +Property}. By default, doing interactive searches in the buffer will +consider @var{string} when searching. If @var{inhibit-isearch} is +non-@code{nil}, this is inhibited. @end defun @cindex slice, image @@ -6545,6 +6608,11 @@ cache, it can always be displayed, even if the value of @code{max-image-size} is subsequently changed (@pxref{Image Cache}). @end defvar +@defun image-at-point-p +This function returns @code{t} if point is on an image, and @code{nil} +otherwise. +@end defun + Images inserted with the insertion functions above also get a local keymap installed in the text properties (or overlays) that span the displayed image. This keymap defines the following commands: @@ -7003,7 +7071,7 @@ This inserts a button with the label @var{label} at point, using text properties. @end defun -@defun button-buttonize string callback &optional data +@defun buttonize string callback &optional data Sometimes it's more convenient to make a string into a button without inserting it into a buffer immediately, for instance when creating data structures that may then, later, be inserted into a buffer. This diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 1e05153f3c0..ddc1d05c1ca 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1314,6 +1314,20 @@ on the 19th, @file{aug-20} was written on the 20th, and the file @end example @end defun +@defun file-has-changed-p filename tag +This function returns non-@code{nil} if the time stamp of +@var{filename} has changed since the last call. When called for the +first time for some @var{filename}, it records the last modification +time and size of the file, and returns non-@code{nil} when +@var{filename} exists. Thereafter, when called for the same +@var{filename}, it compares the current time stamp and size with the +recorded ones, and returns non-@code{nil} only if either the time +stamp or the size (or both) are different. This is useful when a Lisp +program wants to re-read a file whenever it changes. With an optional +argument @var{tag}, which must be a symbol, the size and modification +time comparisons are limited to calls with the same tag. +@end defun + @defun file-attributes filename &optional id-format @anchor{Definition of file-attributes} This function returns a list of attributes of file @var{filename}. If @@ -2083,6 +2097,9 @@ directory. Therefore, Emacs considers a file name as having two main parts: the @dfn{directory name} part, and the @dfn{nondirectory} part (or @dfn{file name within the directory}). Either part may be empty. Concatenating these two parts reproduces the original file name. +@footnote{Emacs follows the GNU convention to use the term @emph{file name} +instead of the term @emph{pathname}. We use the term @emph{path} only for +search paths, which are lists of directory names.} On most systems, the directory part is everything up to and including the last slash (backslash is also allowed in input on MS-DOS or diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index cb14d02d449..8f98ac935c9 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -969,14 +969,14 @@ side-effects only---the values it returns are ignored, not collected into a list. @code{mapc} always returns @var{sequence}. @end defun -@defun mapconcat function sequence separator +@defun mapconcat function sequence &optional separator @code{mapconcat} applies @var{function} to each element of @var{sequence}; the results, which must be sequences of characters (strings, vectors, or lists), are concatenated into a single string return value. Between each pair of result sequences, @code{mapconcat} inserts the characters from @var{separator}, which also must be a -string, or a vector or list of characters. @xref{Sequences Arrays -Vectors}. +string, or a vector or list of characters; a @code{nil} value is +treated as the empty string. @xref{Sequences Arrays Vectors}. The argument @var{function} must be a function that can take one argument and returns a sequence of characters: a string, a vector, or @@ -994,8 +994,7 @@ string. @group (mapconcat (lambda (x) (format "%c" (1+ x))) - "HAL-8000" - "") + "HAL-8000") @result{} "IBM.9111" @end group @end example diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index d3edd633171..7718712b9b8 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -218,6 +218,14 @@ the Emacs executable that dumped them. If you want to use this function in an Emacs that was already dumped, you must run Emacs with the @samp{-batch} option. + +@vindex after-pdump-load-hook +If you're including @samp{.el} files in the dumped Emacs and that +@samp{.el} file has code that is normally run at load time, that code +won't be run when Emacs starts after dumping. To help work around +that problem, you can put functions on the +@code{after-pdump-load-hook} hook. This hook is run when starting +Emacs. @end defun @defun dump-emacs to-file from-file diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 4097c86f074..899499ed46e 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -94,8 +94,25 @@ Manual}. (kbd "<f1> SPC") @result{} [f1 32] (kbd "C-M-<down>") @result{} [C-M-down] @end example + +@findex kbd-valid-p +The @code{kbd} function is very permissive, and will try to return +something sensible even if the syntax used isn't completely +conforming. To check whether the syntax is actually valid, use the +@code{kbd-valid-p} function. + +@code{define-key} also supports using the shorthand syntax +@samp{["..."]} syntax to define a key. The string has to be a +strictly valid @code{kbd} sequence, and if it's not valid, an error +will be signalled. For instance, to bind @key{C-c f}, you can say: + +@lisp +(define-key global-map ["C-c f"] #'find-file-literally) +@end lisp + @end defun + @node Keymap Basics @section Keymap Basics @cindex key binding @@ -1278,24 +1295,46 @@ Binding Conventions}). @cindex meta character key constants @cindex control character key constants - In writing the key sequence to rebind, it is good to use the special -escape sequences for control and meta characters (@pxref{String Type}). -The syntax @samp{\C-} means that the following character is a control -character and @samp{\M-} means that the following character is a meta -character. Thus, the string @code{"\M-x"} is read as containing a -single @kbd{M-x}, @code{"\C-f"} is read as containing a single -@kbd{C-f}, and @code{"\M-\C-x"} and @code{"\C-\M-x"} are both read as -containing a single @kbd{C-M-x}. You can also use this escape syntax in -vectors, as well as others that aren't allowed in strings; one example -is @samp{[?\C-\H-x home]}. @xref{Character Type}. - - The key definition and lookup functions accept an alternate syntax for -event types in a key sequence that is a vector: you can use a list -containing modifier names plus one base event (a character or function -key name). For example, @code{(control ?a)} is equivalent to -@code{?\C-a} and @code{(hyper control left)} is equivalent to -@code{C-H-left}. One advantage of such lists is that the precise -numeric codes for the modifier bits don't appear in compiled files. + @code{define-key} (and other functions that are used to rebind keys) +understand a number of different syntaxes for the keys. + +@table @asis +@item A vector containing a single string. +This is the preferred way to represent a key sequence. Here's a +couple of examples: + +@example +["C-c M-f"] +["S-<home>"] +@end example + +The syntax is the same as the one used by Emacs when displaying key +bindings, for instance in @samp{*Help*} buffers and help texts. + +If the syntax isn't valid, an error will be raised when running +@code{define-key}, or when byte-compiling code that has these calls. + +@item A vector containing lists of keys. +You can use a list containing modifier names plus one base event (a +character or function key name). For example, @code{[(control ?a) +(meta b)]} is equivalent to @kbd{C-a M-b} and @code{[(hyper control +left)]} is equivalent to @kbd{C-H-left}. + +@item A string with control and meta characters. +Internally, key sequences are often represented as strings using the +special escape sequences for control and meta characters +(@pxref{String Type}), but this representation can also be used by +users when rebinding keys. A string like @code{"\M-x"} is read as +containing a single @kbd{M-x}, @code{"\C-f"} is read as containing a +single @kbd{C-f}, and @code{"\M-\C-x"} and @code{"\C-\M-x"} are both +read as containing a single @kbd{C-M-x}. + +@item a vector of characters. +This is the other internal representation of key sequences, and +supports a fuller range of modifiers than the string representation. +One example is @samp{[?\C-\H-x home]}, which represents the @kbd{C-H-x +home} key sequence. @xref{Character Type}. +@end table The functions below signal an error if @var{keymap} is not a keymap, or if @var{key} is not a string or vector representing a key sequence. @@ -1337,7 +1376,7 @@ bindings in it: @result{} (keymap) @end group @group -(define-key map "\C-f" 'forward-char) +(define-key map ["C-f"] 'forward-char) @result{} forward-char @end group @group @@ -1347,7 +1386,7 @@ map @group ;; @r{Build sparse submap for @kbd{C-x} and bind @kbd{f} in that.} -(define-key map (kbd "C-x f") 'forward-word) +(define-key map ["C-x f"] 'forward-word) @result{} forward-word @end group @group @@ -1360,14 +1399,14 @@ map @group ;; @r{Bind @kbd{C-p} to the @code{ctl-x-map}.} -(define-key map (kbd "C-p") ctl-x-map) +(define-key map ["C-p"] ctl-x-map) ;; @code{ctl-x-map} @result{} [nil @dots{} find-file @dots{} backward-kill-sentence] @end group @group ;; @r{Bind @kbd{C-f} to @code{foo} in the @code{ctl-x-map}.} -(define-key map (kbd "C-p C-f") 'foo) +(define-key map ["C-p C-f"] 'foo) @result{} 'foo @end group @group @@ -1386,6 +1425,99 @@ changing an entry in @code{ctl-x-map}, and this has the effect of changing the bindings of both @kbd{C-p C-f} and @kbd{C-x C-f} in the default global map. +@defun define-keymap &key options... &rest pairs... +@code{define-key} is the general work horse for defining a key in a +keymap. When writing modes, however, you frequently have to bind a +large number of keys at once, and using @code{define-key} on them all +can be tedious and error-prone. Instead you can use +@code{define-keymap}, which creates a keymaps and binds a number of +keys. Here's a very basic example: + +@lisp +(define-keymap + "n" #'forward-line + "f" #'previous-line + ["C-c C-c"] #'quit-window) +@end lisp + +This function creates a new sparse keymap, defines the two keystrokes +in @var{pairs}, and returns the new keymap. + +@var{pairs} is a list of alternating key bindings and key definitions, +as accepted by @code{define-key}. In addition the key can be the +special symbol @code{:menu}, in which case the definition should be a +menu definition as accepted by @code{easy-menu-define} (@pxref{Easy +Menu}). Here's a brief example: + +@lisp +(define-keymap :full t + "g" #'eww-reload + :menu '("Eww" + ["Exit" quit-window t] + ["Reload" eww-reload t])) +@end lisp + +A number of keywords can be used before the key/definition pairs to +changes features of the new keymap. If the keyword is missing, the +default value for the feature is @code{nil}. Here's a list of the +available keywords: + +@table @code +@item :full +If non-@code{nil}, create a chartable keymap (as from +@code{make-keymap}) instead of a sparse keymap (as from +@code{make-sparse-keymap} (@pxref{Creating Keymaps}). A sparse keymap +is the default. + +@item :parent +If non-@code{nil}, this should be a keymap to use as the parent +(@pxref{Inheritance and Keymaps}). + +@item :keymap +If non-@code{nil}, this should be a keymap. Instead of creating a new +keymap, this keymap is modified instead. + +@item :suppress +If non-@code{nil}, the keymap will be suppressed with +@code{suppress-keymap} (@pxref{Changing Key Bindings}). If +@code{nodigits}, treat digits like other chars. + +@item :name +If non-@code{nil}, this should be a string to use as the menu for the +keymap if you use it as a menu with @code{x-popup-menu} (@pxref{Pop-Up +Menus}). + +@item :prefix +If non-@code{nil}, this should be a symbol to be used as a prefix +command (@pxref{Prefix Keys}). If this is the case, this symbol is +returned by @code{define-keymap} instead of the map itself. +@end table + +@end defun + +@defmac defvar-keymap name &key options... &rest pairs... +By far, the most common thing to do with a keymap is to bind it to a +variable. This is what virtually all modes do---a mode called +@code{foo} almost always has a variable called @code{foo-mode-map}. + +This macro defines @var{name} as a variable, and passes @var{options} +and @var{pars} to @code{define-keymap}, and uses the result as the +default value for the variable. + +@var{options} is like the keywords in @code{define-keymap}, but adds a +@code{:doc} keyword that says what the doc string for the @var{name} +variable should be. + +Here's an example: + +@lisp +(defvar-keymap eww-textarea-map + :parent text-mode-map + "\r" #'forward-line + [?\t] #'shr-next-link) +@end lisp +@end defmac + The function @code{substitute-key-definition} scans a keymap for keys that have a certain binding and rebinds them with a different binding. Another feature which is cleaner and can often produce the @@ -2227,6 +2359,12 @@ This property specifies that @var{string} is the string to display as the keyboard equivalent for this menu item. You can use the @samp{\\[...]} documentation construct in @var{string}. +This property can also be a function (which will be called with no +arguments). This function should return a string. This function will +be called every time the menu is computed, so using a function that +takes a lot of time to compute is not a good idea, and it should +expect to be called from any context. + @item :filter @var{filter-fn} This property provides a way to compute the menu item dynamically. The property value @var{filter-fn} should be a function of one argument; diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 5df3a74e780..bc5c08c687c 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -269,6 +269,18 @@ normal-mode}), but tries to force it not to choose any modes in @var{avoided-modes}, if that argument is non-@code{nil}. @end defun +@defun clean-mode +Changing the major mode clears out most local variables, but it +doesn't remove all artefacts in the buffer (like text properties and +overlays). It's rare to change a buffer from one major mode to +another (except from @code{fundamental-mode} to everything else), so +this is usually not a concern. It can sometimes be convenient (mostly +when debugging a problem in a buffer) to do a ``full reset'' of the +buffer, and that's what the @code{clean-mode} major mode offers. It +will kill all local variables (even the permanently local ones), and +also removes all overlays and text properties. +@end defun + The easiest way to write a major mode is to use the macro @code{define-derived-mode}, which sets up the new mode as a variant of an existing major mode. @xref{Derived Modes}. We recommend using @@ -1138,10 +1150,11 @@ re-sorting entries. Comparison is done with @code{equal}. @item @var{contents} is a vector with the same number of elements as @code{tabulated-list-format}. Each vector element is either a string, -which is inserted into the buffer as-is, or a list @code{(@var{label} -. @var{properties})}, which means to insert a text button by calling -@code{insert-text-button} with @var{label} and @var{properties} as -arguments (@pxref{Making Buttons}). +which is inserted into the buffer as-is; an image descriptor, which is +used to insert an image (@pxref{Image Descriptors}); or a list +@w{@code{(@var{label} . @var{properties})}}, which means to insert a +text button by calling @code{insert-text-button} with @var{label} and +@var{properties} as arguments (@pxref{Making Buttons}). There should be no newlines in any of these strings. @end itemize diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index db986178dd8..1fbd66458a4 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3231,6 +3231,14 @@ Removes an existing file watch specified by its @var{descriptor}. @code{file-notify-add-watch}. @end defun +@deffn Command file-notify-rm-all-watches +Removes all existing file notification watches from Emacs. + +Use this command with caution, because it could have unexpected side +effects on packages relying on file watches. It is intended mainly +for debugging purposes, or when Emacs has been stalled. +@end deffn + @defun file-notify-valid-p descriptor Checks a watch specified by its @var{descriptor} for validity. @var{descriptor} should be an object returned by diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index ce79765b733..296ce20169c 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -2045,7 +2045,7 @@ feature for matching regular expressions from end to beginning. It's not worth the trouble of implementing that. @end deffn -@defun string-match regexp string &optional start +@defun string-match regexp string &optional start inhibit-modify This function returns the index of the start of the first match for the regular expression @var{regexp} in @var{string}, or @code{nil} if there is no match. If @var{start} is non-@code{nil}, the search starts @@ -2070,8 +2070,10 @@ For example, The index of the first character of the string is 0, the index of the second character is 1, and so on. -If this function finds a match, the index of the first character beyond -the match is available as @code{(match-end 0)}. @xref{Match Data}. +By default, if this function finds a match, the index of the first +character beyond the match is available as @code{(match-end 0)}. +@xref{Match Data}. If @var{inhibit-modify} is non-@code{nil}, the +match data isn't modified. @example @group @@ -2092,16 +2094,18 @@ This predicate function does what @code{string-match} does, but it avoids modifying the match data. @end defun -@defun looking-at regexp +@defun looking-at regexp &optional inhibit-modify This function determines whether the text in the current buffer directly following point matches the regular expression @var{regexp}. ``Directly following'' means precisely that: the search is ``anchored'' and it can succeed only starting with the first character following point. The result is @code{t} if so, @code{nil} otherwise. -This function does not move point, but it does update the match data. -@xref{Match Data}. If you need to test for a match without modifying -the match data, use @code{looking-at-p}, described below. +This function does not move point, but it does update the match data +(if @var{inhibit-modify} is @code{nil} or missing, which is the +default). @xref{Match Data}. As a convenience, instead of using the +@var{inhibit-modify} argument, you can use @code{looking-at-p}, +described below. In this example, point is located directly before the @samp{T}. If it were anywhere else, the result would be @code{nil}. @@ -2208,13 +2212,13 @@ backtracking specified by the POSIX standard for regular expression matching. @end deffn -@defun posix-looking-at regexp +@defun posix-looking-at regexp &optional inhibit-modify This is like @code{looking-at} except that it performs the full backtracking specified by the POSIX standard for regular expression matching. @end defun -@defun posix-string-match regexp string &optional start +@defun posix-string-match regexp string &optional start inhibit-modify This is like @code{string-match} except that it performs the full backtracking specified by the POSIX standard for regular expression matching. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 7212677d832..0914f204113 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -430,8 +430,8 @@ middle of a character representation. This function measures the string length in characters or bytes, and thus is generally inappropriate if you need to shorten strings for display purposes; use @code{truncate-string-to-width} or -@code{window-text-pixel-size} instead (@pxref{Size of Displayed -Text}). +@code{window-text-pixel-size} or @code{string-glyph-split} instead +(@pxref{Size of Displayed Text}). @end defun @defun string-lines string &optional omit-nulls diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 41b3138a0dd..fa1135b8026 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -599,6 +599,19 @@ This command indents to the left margin if that is not zero. The value returned is @code{nil}. @end deffn +@deffn Command ensure-empty-lines &optional number-of-empty-lines +This command can be used to ensure that you have a specific number of +empty lines before point. (An ``empty line'' is here defined as a +line with no characters on it---a line with space characters isn't an +empty line.) It defaults to ensuring that there's a single empty line +before point. + +If point isn't at the beginning of a line, a newline character is +inserted first. If there's more empty lines before point than +specified, the number of empty lines is reduced. Otherwise it's +increased to the specified number. +@end deffn + @defvar overwrite-mode This variable controls whether overwrite mode is in effect. The value should be @code{overwrite-mode-textual}, @code{overwrite-mode-binary}, @@ -1329,7 +1342,7 @@ that @kbd{C-y} should yank. @defopt kill-ring-max The value of this variable is the maximum length to which the kill ring can grow, before elements are thrown away at the end. The default -value for @code{kill-ring-max} is 60. +value for @code{kill-ring-max} is 120. @end defopt @node Undo @@ -3602,6 +3615,11 @@ edited even in read-only buffers. @xref{Read Only Buffers}. A non-@code{nil} @code{invisible} property can make a character invisible on the screen. @xref{Invisible Text}, for details. +@kindex inhibit-isearch @r{(text property)} +@item inhibit-isearch +A non-@code{nil} @code{inhibit-isearch} property will make isearch +skip the text. + @item intangible @kindex intangible @r{(text property)} If a group of consecutive characters have equal and non-@code{nil} diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index a1d1919b4bf..d2247004bcb 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1695,12 +1695,14 @@ buffer-local variables interactively. @end deffn @cindex local variables, killed by major mode -@defun kill-all-local-variables +@defun kill-all-local-variables &optional kill-permanent This function eliminates all the buffer-local variable bindings of the -current buffer except for variables marked as permanent and local -hook functions that have a non-@code{nil} @code{permanent-local-hook} -property (@pxref{Setting Hooks}). As a result, the buffer will see -the default values of most variables. +current buffer. As a result, the buffer will see the default values +of most variables. By default, for variables marked as permanent and +local hook functions that have a non-@code{nil} +@code{permanent-local-hook} property (@pxref{Setting Hooks}) won't be +killed, but if the optional @var{kill-permanent} argument is +non-@code{nil}, even these variables will be killed. This function also resets certain other information pertaining to the buffer: it sets the local keymap to @code{nil}, the syntax table to the diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 57cd2274d4b..d718ac59be6 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3038,6 +3038,11 @@ desired total height with respect to the total height of its frame's root window. @item +A cons cell whose @sc{car} is @code{body-lines} and whose @sc{cdr} is an +integer that specifies the height of the chosen window's body in frame +lines. + +@item If the value specifies a function, that function is called with one argument---the chosen window. The function is supposed to adjust the height of the window; its return value is ignored. Suitable functions @@ -3071,16 +3076,47 @@ desired total width with respect to the total width of the frame's root window. @item +A cons cell whose @sc{car} is @code{body-columns} and whose @sc{cdr} is +an integer that specifies the width of the chosen window's body in frame +columns. + +@item If the value specifies a function, that function is called with one argument---the chosen window. The function is supposed to adjust the width of the window; its return value is ignored. @end itemize -By convention, the width of the chosen window is adjusted only if the -window is part of a horizontal combination (@pxref{Windows and -Frames}) to avoid changing the width of other, unrelated windows. -Also, this entry should be processed under only certain conditions -which are specified right below this list. +@vindex window-size@r{, a buffer display action alist entry} +@item window-size +This entry is a combination of the two preceding ones and can be used to +adjust the chosen window's height @emph{and} width. Since windows can +be resized in one direction only without affecting other windows, +@code{window-size} is effective only to set up the size of a window +appearing alone on a frame. The value can be one of the following: + +@itemize @bullet +@item +@code{nil} means to leave the size of the chosen window alone. + +@item +A cons cell of two integers specifies the desired total width and height +of the chosen window in lines and columns. It's effect is to adjust the +size of the frame accordingly. + +@item +A cons cell whose @sc{car} equals @code{body-chars} and whose @sc{cdr} +is a cons cell of two integers---the desired body width and height of +the chosen window in frame columns and lines. It's effect is to adjust +the size of the frame accordingly. + +@item +If the value specifies a function, that function is called with one +argument---the chosen window. The function is supposed to adjust the +size of the window's frame; its return value is ignored. +@end itemize + +This entry should be processed under only certain conditions which are +specified right below this list. @vindex dedicated@r{, a buffer display action alist entry} @item dedicated @@ -3181,6 +3217,14 @@ the window was created earlier by @code{display-buffer} to show the buffer and never was used to show another buffer until it was reused by the current invocation of @code{display-buffer}. +If no @code{window-height}, @code{window-width} or @code{window-size} +entry was specified, the window may still be resized automatically when +the buffer is temporary and @code{temp-buffer-resize-mode} has been +enabled, @ref{Temporary Displays}. In that case, the @sc{cdr} of a +@code{window-height}, @code{window-width} or @code{window-size} entry +can be used to inhibit or override the default behavior of +@code{temp-buffer-resize-mode} for specific buffers or invocations of +@code{display-buffer}. @node Choosing Window Options @subsection Additional Options for Displaying Buffers diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index ba64efa282c..e5d1bbe09ae 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 "2020-10-18" "GNU Emacs" "GNU" +.TH EMACSCLIENT 1 "2021-11-05" "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 @@ -69,6 +69,9 @@ start Emacs in daemon mode, and try to connect to it. .B -c, \-\-create-frame Create a new frame instead of trying to use the current Emacs frame. .TP +.B -r \-\-reuse-frame +Reuse an existing frame if one exists, otherwise create a new frame. +.TP .B \-F, \-\-frame-parameters=ALIST Set the parameters of a newly-created frame. .TP diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 98ded68e713..a2ff572a3f4 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -283,6 +283,8 @@ Font Locking * Font Locking Preliminaries:: * Faces:: * Doc Comments:: +* Wrong Comment Style:: +* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @@ -1855,6 +1857,7 @@ sections apply to the other languages. * Faces:: * Doc Comments:: * Wrong Comment Style:: +* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @end menu @@ -2162,6 +2165,60 @@ which aren't of the default style will be fontified with @end defvar @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +@node Found Types +@comment node-name, next, previous, up +@section ``Found Type'' handling. +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +In most languages handled by CC Mode, @dfn{found types} are recognized +as types by their context in the source code. These contrast with +types which are basic to a language or are declared as types (e.g. by +@code{typedef} in C). + +In earlier versions of @ccmode{}, when @code{jit-lock-mode} was +enabled in Emacs (which it is by default), found types would +frequently fail to get fontified properly. This happened when the +fontification functions scanned a use of the found type before +scanning the code which caused it to be recognized. + +From @ccmode{} version 5.36, a timer mechanism scans the entire buffer +for found types in the seconds immediately after starting the major +mode. When a found type gets recognized, all its occurrences in the +buffer get marked for (re)fontification. This scanning happens in +short time slices interleaved with other processing, such as keyboard +handling, so that the responsiveness of Emacs should be barely +affected. This mechanism can be disabled (see below). It is only +active when @code{jit-lock-mode} is also active. + +@defvar c-type-finder-time-slot +@vindex type-finder-time-slot (c-) +The approximate time in seconds that CC Mode spends in scanning source +code before relinquishing control to other Emacs activities. The +default value is 0.05. To disable the scanning mechanism, set this +variable to @code{nil}. +@end defvar + +@defvar c-type-finder-repeat-time +@vindex type-finder-repeat-time (c-) +The approximate frequency (in seconds) with which the scanning +mechanism is triggered. This time must be greater than +@code{c-type-finder-time-slot}. Its default value is 0.1. If a less +powerful machine becomes sluggish due to the scanning, increase the +value of @code{c-type-finder-repeat-time} to compensate. +@end defvar + +@defvar c-type-finder-chunk-size +@vindex type-finder-chunk-size (c-) +The approximate size (in characters) of the buffer chunk processed as +a unit before the scanning mechanism checks whether +@code{c-type-finder-time-slot} seconds have passed. The default value +is 1000. A too small value here will cause inefficiencies due to the +initialization which happens for each chunk, whereas a too large value +will cause the processing to consume an excessive proportion of the +@code{c-type-finder-repeat-time}. +@end defvar + +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Misc Font Locking @comment node-name, next, previous, up @section Miscellaneous Font Locking diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 0ec02495d5e..55b112cb24a 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1245,6 +1245,12 @@ blocks for other macros like @code{cl-incf}, and @code{cl-pushnew}. The @code{cl-letf} and @code{cl-letf*} macros are used in the processing of symbol macros; @pxref{Macro Bindings}. +@defmac with-memoization @var{place} @var{code}@dots{} +This macro provides a simple way to do memoization. @var{code} is +evaluated and then stashed in @var{place}. If @var{place}'s value is +non-@code{nil}, return that value instead of evaluating @var{code}. +@end defmac + @node Variable Bindings @section Variable Bindings @@ -5028,7 +5034,7 @@ The above @code{incf} example could be written using @ignore (defmacro concatf (place &rest args) (gv-letplace (getter setter) place - (macroexp-let2 nil v (mapconcat 'identity args "") + (macroexp-let2 nil v (mapconcat 'identity args) (funcall setter `(concat ,getter ,v))))) @end ignore @end defmac diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 63b42827311..2b0b1f7fd67 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -700,18 +700,19 @@ slot values, and use the previously mentioned set/ref routines. @defun slot-value object slot @anchor{slot-value} This function retrieves the value of @var{slot} from @var{object}. +It can also be used on objects defined by @code{cl-defstruct}. This is a generalized variable that can be used with @code{setf} to -modify the value stored in @var{slot}. @xref{Generalized -Variables,,,elisp,GNU Emacs Lisp Reference Manual}. +modify the value stored in @var{slot}, tho not for objects defined by +@code{cl-defstruct}. +@xref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}. @end defun @defun set-slot-value object slot value @anchor{set-slot-value} This function sets the value of @var{slot} from @var{object}. -This is not a CLOS function, but is the obsolete setter for -@code{slot-value} used by the @code{setf} macro. It is therefore +This is not a CLOS function. It is therefore recommended to use @w{@code{(setf (slot-value @var{object} @var{slot}) @var{value})}} instead. @end defun diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 10ced678e1d..3b8e231d3a1 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -2,13 +2,15 @@ @c %**start of header @setfilename ../../info/erc.info @settitle ERC Manual +@set ERCVER 5.4.1 +@set ERCDIST as distributed with Emacs @value{EMACSVER} @include docstyle.texi @syncodeindex fn cp @include emacsver.texi @c %**end of header @copying -This manual is for ERC as distributed with Emacs @value{EMACSVER}. +This manual is for ERC @value{ERCVER} @value{ERCDIST}. Copyright @copyright{} 2005--2021 Free Software Foundation, Inc. diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 5153829e2da..440c61add8e 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -486,6 +486,7 @@ to find where a test was defined if the test was loaded from a file. * Expected Failures:: Tests for known bugs. * Tests and Their Environment:: Don't depend on customizations; no side effects. * Useful Techniques:: Some examples. +* erts files:: Files containing many buffer tests. @end menu @node The @code{should} Macro @@ -767,6 +768,119 @@ code is to restructure the code slightly to provide better interfaces for testing. Usually, this makes the interfaces easier to use as well. +@node erts files +@section erts files + +@findex ert-test-erts-file +Many relevant Emacs tests depend on comparing the contents of a buffer +before and after executing a particular function. These tests can be +written the normal way---making a temporary buffer, inserting the +``before'' text, running the function, and then comparing with the +expected ``after'' text. However, this often leads to test code +that's pretty difficult to read and write, especially when the text in +question is multi-line. + +So ert provides a function called @code{ert-test-erts-file} that takes +two parameters: The name of a specially-formatted @dfn{erts} file, and +(optionally) a function that performs the transform. + +@findex erts-mode +These erts files can be edited with the @code{erts-mode} major mode. + +An erts file is divided into sections by the (@samp{=-=}) separator. + +Here's an example file containing two tests: + +@example +Name: flet + +=-= +(cl-flet ((bla (x) +(* x x))) +(bla 42)) +=-= +(cl-flet ((bla (x) + (* x x))) + (bla 42)) +=-=-= + +Name: defun + +=-= +(defun x () + (print (quote ( thingy great + stuff)))) +=-=-= +@end example + +A test starts with a line containing just @samp{=-=} and ends with a +line containing just @samp{=-=-=}. The test may be preceded by +freeform text (for instance, comments), and also name/value pairs (see +below for a list of them). + +If there is a line with @samp{=-=} inside the test, that designates +the start of the ``after'' text. Otherwise, the ``before'' and +``after'' texts are assumed to be identical, which you typically see +when writing indentation tests. + +@code{ert-test-erts-file} puts the ``before'' section into a temporary +buffer, calls the transform function, and then compares with the +``after'' section. + +Here's an example usage: + +@lisp +(ert-test-erts-file "elisp.erts" + (lambda () + (emacs-lisp-mode) + (indent-region (point-min) (point-max)))) +@end lisp + +A list of the name/value specifications that can appear before a test +follows. The general syntax is @samp{Name: Value}, but continuation +lines can be used (along the same lines as in mail---subsequent lines +that start with a space are part of the value). + +@example +Name: foo +Code: (indent-region + (point-min) (point-max)) +@end example + +@table @samp +@item Name +All tests should have a name. This name will appear in ERT output if +the test fails, and helps to identify the failing test. + +@item Code +This is the code that will be run to do the transform. This can also +be passed in via the @code{ert-test-erts-file} call, but @samp{Code} +overrides that. It's used not only in the following test, but in all +subsequent tests in the file (until overridden by another @samp{Code} +specification). + +@item No-Before-Newline +@itemx No-After-Newline +These specifications say whether the ``before'' or ``after'' portions +have a newline at the end. (This would otherwise be impossible to +specify.) + +@item Point-Char +Sometimes it's useful to be able to put point at a specific place +before executing the transform function. @samp{Point-Char: |} will +make @code{ert-test-erts-file} place point where @samp{|} is in the +``before'' form (and remove that character), and will check that it's +where the @samp{|} character is in the ``after'' form (and issue a +test failure if that isn't the case). (This is used in all subsequent +tests, unless overridden by a new @samp{Point-Char} spec.) + +@item Skip +If this is present and value is a form that evaluates to a +non-@code{nil} value, the test will be skipped. +@end table + +If you need to use the literal line single line @samp{=-=} in a test +section, you can quote it with a @samp{\} character. @node How to Debug Tests @chapter How to Debug Tests diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 2543dc2ff5a..7635685e56f 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -380,6 +380,14 @@ thus allowing for the use of the usual substitutions, such as @code{\[eww-reload]} for the current key binding of the @code{eww-reload} command. +@vindex eww-auto-rename-buffer + If the @code{eww-auto-rename-buffer} user option is non-@code{nil}, +EWW buffers will be renamed after rendering a document. If this is +@code{title}, rename based on the title of the document. If this is +@code{url}, rename based on the @acronym{URL} of the document. This +can also be a user-defined function, which is called with no +parameters in the EWW buffer, and should return a string. + @node Command Line @chapter Command Line Usage diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6c892bc80a9..796bb3bac84 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -9843,6 +9843,13 @@ Gravatarify the @code{From} header (@code{gnus-treat-from-gravatar}). Gravatarify all mail headers (i.e., @code{Cc}, @code{To}) (@code{gnus-treat-from-gravatar}). +@item W D e +@kindex W D e @r{(Summary)} +@findex gnus-article-emojize-symbols +Some symbols have both a non-emoji presentation and an emoji +presentation. This command will make Gnus choose the emoji presentation +(@code{gnus-article-emojize-symbols}). + @item W D D @kindex W D D @r{(Summary)} @findex gnus-article-remove-images @@ -12185,6 +12192,7 @@ controlling variable is a predicate list, as described above. @vindex gnus-treat-capitalize-sentences @vindex gnus-treat-overstrike @vindex gnus-treat-strip-cr +@vindex gnus-treat-emojize-symbols @vindex gnus-treat-strip-headers-in-body @vindex gnus-treat-strip-leading-blank-lines @vindex gnus-treat-strip-multiple-blank-lines @@ -12237,6 +12245,7 @@ possible but those listed are probably sufficient for most people. @item gnus-treat-capitalize-sentences (t, integer) @item gnus-treat-overstrike (t, integer) @item gnus-treat-strip-cr (t, integer) +@item gnus-treat-emojize-symbols (t, integer) @item gnus-treat-strip-headers-in-body (t, integer) @item gnus-treat-strip-leading-blank-lines (t, first, integer) @item gnus-treat-strip-multiple-blank-lines (t, integer) diff --git a/doc/misc/mairix-el.texi b/doc/misc/mairix-el.texi index d0ec552145e..e57b5ed5422 100644 --- a/doc/misc/mairix-el.texi +++ b/doc/misc/mairix-el.texi @@ -60,6 +60,8 @@ database. * Using:: List of interactive functions * Extending:: Support your favorite mail reader! * GNU Free Documentation License:: The license for this documentation. +* Function Index: Function Index. +* Variable Index: Variable Index. @end menu @node About @@ -339,4 +341,14 @@ And that's it! @appendix GNU Free Documentation License @include doclicense.texi +@node Function Index +@unnumbered Function Index + +@printindex fn + +@node Variable Index +@unnumbered Variable Index + +@printindex vr + @bye diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f533c58aa41..31ea3de620d 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -12,6 +12,14 @@ extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. +* Changes in ERC 5.4.1 + +** No user-visible changes since ERC 5.4, but a few tweaks in some ERC +file headers and the ERC manual in order to successfully build ERC for +GNU ELPA. (See below for the news item of ERC now being distributed +on GNU ELPA in addition to its continued inclusion in GNU Emacs core.) + + * Changes in ERC 5.4 ** Starting with Emacs 28.1 and ERC 5.4, ERC NEWS are added here again. @@ -1,15 +1,15 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2019-2021 Free Software Foundation, Inc. +Copyright (C) 2021 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. If possible, use 'M-x report-emacs-bug'. -This file is about changes in Emacs version 28. +This file is about changes in Emacs version 29. See file HISTORY for a list of GNU Emacs versions and release dates. -See files NEWS.27, NEWS.26, ..., NEWS.18, and NEWS.1-17 for changes +See files NEWS.28, NEWS.27, ..., NEWS.18, and NEWS.1-17 for changes in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' @@ -22,466 +22,180 @@ When you add a new item, use the appropriate mark if you are sure it applies, and please also update docstrings as needed. -* Installation Changes in Emacs 28.1 - -** Emacs now optionally supports native compilation of Lisp files. -To enable this, configure Emacs with the '--with-native-compilation' option. -This requires the libgccjit library to be installed and functional, -and also requires GCC and Binutils to be available when Lisp code is -natively compiled. See the Info node "(elisp) Native Compilation" for -more details. - -If you build Emacs with native compilation, but without zlib, be sure -to configure with the '--without-compress-install' option, so that the -installed *.el files are not compressed; otherwise, you will not be -able to use JIT native compilation of the installed *.el files. - -Note that JIT native compilation is done in a fresh session of Emacs -that is run in a subprocess, so it can legitimately report some -warnings and errors that aren't uncovered by byte-compilation. We -recommend examining any such warnings before you decide they are -false. - -** The Cairo graphics library is now used by default if present. -'--with-cairo' is now the default, if the appropriate development files -are found by 'configure'. Note that building with Cairo means using -Pango instead of libXFT for font support. Since Pango 1.44 has -removed support for bitmapped fonts, this may require you to adjust -your font settings. - -Note also that 'FontBackend' settings in ".Xdefaults" or -".Xresources", or 'font-backend' frame parameter settings in your init -files, may need to be adjusted, as 'xft' is no longer a valid backend -when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz -text shaping support, and 'ftcr' otherwise. You can determine this by -checking 'system-configuration-features'. The 'ftcr' backend will -still be available when HarfBuzz is supported, but will not be used by -default. We strongly recommend building with HarfBuzz support. 'x' is -still a valid backend. +* Installation Changes in Emacs 29.1 ---- -** 'configure' now warns about building with libXft support. -libXft is unmaintained, and causes a number of problems with modern -fonts including but not limited to crashes; support for it may be -removed in a future version of Emacs. Please consider using -Cairo + HarfBuzz instead. - ---- -** 'configure' now warns about not using HarfBuzz if using Cairo. -We want to encourage people to use the most modern font features -available, and this is the Cairo graphics library + HarfBuzz for font -shaping, so 'configure' now recommends that combination. - ---- -** Building without double buffering support. -'configure --with-xdbe=no' can now be used to disable double buffering -at build time. - ---- -** Support for building with Motif has been removed. - ---- -** The configure option '--without-makeinfo' has been removed. -This was only ever relevant when building from a repository checkout. -This now requires makeinfo, which is part of the texinfo package. - ---- -** New configure option '--disable-year2038'. -This causes Emacs to use only 32-bit time_t on platforms that have -both 32- and 64-bit time_t. This may help when linking Emacs with a -library with an ABI requiring traditional 32-bit time_t. This option -currently affects only 32-bit ARM and x86 running GNU/Linux with glibc -2.34 and later. Emacs now defaults to 64-bit time_t on these -platforms. - ---- -** Support for building with '-fcheck-pointer-bounds' has been removed. -GCC has withdrawn the '-fcheck-pointer-bounds' option and support for -its implementation has been removed from the Linux kernel. - ---- -** The ftx font backend driver has been removed. -It was declared obsolete in Emacs 27.1. - ---- -** Emacs no longer supports old OpenBSD systems. -OpenBSD 5.3 and older releases are no longer supported, as they lack -proper pty support that Emacs needs. - - -* Startup Changes in Emacs 28.1 - ---- -** In GTK builds, Emacs now supports startup notification. -This means that Emacs won't steal keyboard focus upon startup -(when started via the Desktop) if the user is typing into another -application. - ---- -** Errors in 'kill-emacs-hook' no longer prevent Emacs from shutting down. -If a function in that hook signals an error in an interactive Emacs, -the user will be prompted on whether to continue. If the user doesn't -answer within five seconds, Emacs will continue shutting down anyway. - -** Emacs now supports loading a Secure Computing filter. -This is supported only on capable GNU/Linux systems. To activate, -invoke Emacs with the '--seccomp=FILE' command-line option. FILE must -name a binary file containing an array of 'struct sock_filter' -structures. Emacs will then install that list of Secure Computing -filters into its own process early during the startup process. You -can use this functionality to put an Emacs process in a sandbox to -avoid security issues when executing untrusted code. See the manual -page for 'seccomp' system call, for details about Secure Computing -filters. - -** Emacs can support 24-bit color TTY without terminfo database. -If your text-mode terminal supports 24-bit true color, but your system -lacks the terminfo database, you can instruct Emacs to support 24-bit -true color by setting 'COLORTERM=truecolor' in the environment. This is -useful on systems such as FreeBSD which ships only with "etc/termcap". - ---- -** File names given on the command line are now be pushed onto history. -The file names will be pushed onto 'file-name-history', like the names -of files visited via 'C-x C-f' and other commands. +** Emacs now installs the ".pdmp" file using a unique fingerprint in the name. +The file is typically installed using a file name akin to +"...dir/libexec/emacs/29.1/x86_64-pc-linux-gnu/emacs-<fingerprint>.pdmp". +If a constant file name is required, the file can be renamed to +"emacs.pdmp", and Emacs will find it during startup anyway. -* Changes in Emacs 28.1 - ---- -** Emacs now supports Unicode Standard version 14.0. +* Startup Changes in Emacs 29.1 +++ -** Improved support for Emoji. -On capable systems, Emacs now correctly displays Emoji and Emoji -sequences by default, provided that a suitable font is available to -Emacs. With a few exceptions, all of the Emoji sequences specified by -Unicode 14.0 are automatically composed and displayed as a single -colorful glyph. This is achieved by changes in the Emacs font -configuration, and by additional character-composition rules for the -Emoji codepoints that follow from the Unicode-defined sequences. - -If your system lacks a suitable font, we recommend to install "Noto -Color Emoji"; Emacs will use it automatically if it's installed. If -you prefer to use another font for Emoji, customize your fontset like -this: - - (set-fontset-font t 'emoji - '("My New Emoji Font" . "iso10646-1") nil 'prepend) - -The Emoji characters are now assigned to a special script, 'emoji', so -as to make it easier to customize fontsets for Emoji display, as in -the above example. (Previously, the Emoji characters were assigned to -the 'symbol' script, together with other symbol and punctuation -characters.) +** Emacs now has a '--fingerprint' option. +This will output a string identifying the current Emacs build. +++ -** 'glyphless-char-display-control' now applies to Variation Selectors. -VS-1 through VS-16 are now displayed as 'thin-space' by default when -not composed with previous characters (typically, as part of Emoji -sequences). +** New hook 'after-pdump-load-hook'. +This is run at the end of the Emacs startup process, and it meant to +be used to reinitialize structures that would normally be done at load +time. -+++ -** New command 'execute-extended-command-for-buffer'. -This new command, bound to 'M-S-x', works like -'execute-extended-command', but limits the set of commands to the -commands that have been determined to be particularly useful with the -current mode. - -+++ -** New user option 'read-extended-command-predicate'. -This user option controls how 'M-x' performs completion of commands when -you type 'TAB'. By default, any command that matches what you have -typed is considered a completion candidate, but you can customize this -option to exclude commands that are not applicable to the current -buffer's major and minor modes, and respect the command's completion -predicate (if any). - -+++ -** Completion on 'M-x' shows key bindings for commands. -When 'suggest-key-bindings' is non-nil (as it is by default), the -completion list popped up by 'M-x' shows the key bindings for all the -commands shown in the list of candidate completions that have a key -binding. + +* Changes in Emacs 29.1 -+++ -** New user option 'completions-detailed'. -When non-nil, some commands like 'describe-symbol' show more detailed -completions with more information in completion prefix and suffix. -The default is nil. +** Help --- -** 'C-s' in 'M-x' now once again searches over completions. -In Emacs 23, typing 'M-x' ('read-extended-command') and then 'C-s' (to -do an interactive search) would search over possible completions. -This was lost in Emacs 24, but is now back again. - -+++ -** User option 'completions-format' supports a new value 'one-column'. +*** 'C-h b' uses outlining by default. +Set 'describe-bindings-outline' to nil to get the old behaviour. -+++ -** 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. +--- +*** Jumping to function/variable source now saves mark before moving point. +Jumping to source from "*Help*" buffer moves the point when the source +buffer is already open. Now, the old point is pushed to mark ring. +++ -** New minor mode 'context-menu-mode' for context menus popped by 'mouse-3'. -When this mode is enabled, clicking 'down-mouse-3' (usually, the -right mouse button) anywhere in the buffer pops up a menu whose -contents depends on surrounding context near the mouse click. -You can change the order of the default sub-menus in the context menu -by customizing the user option 'context-menu-functions'. You can also -invoke the context menu by pressing 'S-<F10>' or, on macOS, by -clicking 'C-down-mouse-1'. +*** New key bindings in *Help* buffers: 'n' and 'p'. +These will take you (respectively) to the next and previous "page". -+++ -** A new keymap for buffer actions has been added. -The 'C-x x' keymap now holds keystrokes for various buffer-oriented -commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'), -'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n' -('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t' -('toggle-truncate-lines') and 'C-x x f' ('font-lock-update'). +** Outline Minor Mode +++ -** Modifiers now go outside angle brackets in pretty-printed key bindings. -For example, 'RET' with Control and Meta modifiers is now shown as -'C-M-<return>' instead of '<C-M-return>'. Either variant can be used -as input; functions such as 'kbd' and 'read-kbd-macro' accept both -styles as equivalent (they have done so for a long time). +*** New user option 'outline-minor-mode-use-buttons'. +If non-nil, Outline Minor Mode will use buttons to hide/show outlines +in addition to the ellipsis. --- -** 'eval-expression' no longer signals an error on incomplete expressions. -Previously, typing 'M-: ( RET' would result in Emacs saying "End of -file during parsing" and dropping out of the minibuffer. The user -would have to type 'M-: M-p' to edit and redo the expression. Now -Emacs will echo the message and allow the user to continue editing. +*** New user option 'outline-minor-mode-buttons'. +This is a list of pairs of open/close strings used to display buttons. -+++ -** '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. +** Fonts --- -** New user option 'use-short-answers'. -When non-nil, the function 'y-or-n-p' is used instead of -'yes-or-no-p'. This eliminates the need to define an alias that maps -one to another in the init file. The same user option also controls -whether the function 'read-answer' accepts short answers. +*** Emacs now supports "medium" fonts. +Emacs previously didn't distinguish between the "regular" weight and +the "medium" weight, but it now also supports the (heavier) "medium" +weight. +++ -** New user option 'kill-buffer-delete-auto-save-files'. -If non-nil, killing a buffer that has an auto-save file will prompt -the user for whether that auto-save file should be deleted. (Note -that 'delete-auto-save-files', if non-nil, was previously documented -to result in deletion of auto-save files when killing a buffer without -unsaved changes, but this has apparently not worked for several -decades, so the documented semantics of this variable has been changed -to match the behavior.) +** Support for the WebP image format. +This support is built by default when the libwebp library is +available. To disable it, use the '--without-webp' configure flag. +Image specifiers can now use ':type webp'. -+++ -** New user option 'next-error-message-highlight'. -In addition to a fringe arrow, 'next-error' error may now optionally -highlight the current error message in the 'next-error' buffer. -This user option can be also customized to keep highlighting on all -visited errors, so you can have an overview what errors were already visited. - ---- -** New choice 'next-error-quit-window' for 'next-error-found-function'. -When 'next-error-found-function' is customized to 'next-error-quit-window', -then typing the numeric prefix argument 0 before the command 'next-error' -will quit the source window after visiting the next occurrence. +** Windows +++ -** New user option 'file-preserve-symlinks-on-save'. -This controls what Emacs does when saving buffers that visit files via -symbolic links, and 'file-precious-flag' is non-nil. +*** 'display-buffer' now can set up the body size of the chosen window. +For example, an alist entry as '(window-width . (body-columns . 40))' +will make the body of the chosen window 40 columns wide. -+++ -** New user option 'copy-directory-create-symlink'. -If non-nil, will make 'copy-directory' (when used on a symbolic -link) copy the link instead of following the link. The default is -nil, so the default behavior is unchanged. +** Better detection of text suspiciously reordered on display. +The function 'bidi-find-overridden-directionality' has been extended +to detect reordering effects produced by embeddings and isolates +(started by directional formatting control characters such as RLO and +LRI). The new command 'highlight-confusing-reorderings' finds and +highlights segments of buffer text whose reordering for display is +suspicious and could be malicious. -+++ -** New user option 'ignored-local-variable-values'. -This is the opposite of 'safe-local-variable-values' -- it's an alist -of variable-value pairs that are to be ignored when reading a -local-variables section of a file. + ---- -** Specific warnings can now be disabled from the warning buffer. -When a warning is displayed to the user, the resulting buffer now has -buttons which allow making permanent changes to the treatment of that -warning. Automatic showing of the warning can be disabled (although -it is still logged to the "*Messages*" buffer), or the warning can be -disabled entirely. +** Emacs server and client changes +++ -** ".dir-locals.el" now supports setting 'auto-mode-alist'. -The new 'auto-mode-alist' specification in ".dir-locals.el" files can -now be used to override the global 'auto-mode-alist' in the current -directory tree. +*** New command-line option '-r' for emacsclient. +With this command-line option, Emacs reuses an existing graphical client +frame if one exists; otherwise it creates a new frame. ---- -** 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. +* Editing Changes in Emacs 29.1 --- -** 'remove-hook' is now an interactive command. +** Indentation of 'cl-flet' and 'cl-labels' has changed. +These forms now indent like this: ---- -** 'expand-file-name' now checks for null bytes in filenames. -The function will now check for null bytes in both NAME and -DEFAULT-DIRECTORY arguments, as well as in the 'default-directory' -buffer-local variable, when its value is used. If null bytes are -found, 'expand-file-name' will signal an error. -This means that practically all file-related operations will now check -file names for null bytes, thus avoiding subtle bugs with silently -using only the part of file name up to the first null byte. + (cl-flet ((bla (x) + (* x x))) + (bla 42)) ---- -** Frames +This change also affects 'cl-macrolet', 'cl-flet*' and +'cl-symbol-macrolet'. +++ -*** The key prefix 'C-x 5 5' displays next command buffer in a new frame. -It's bound to the command 'other-frame-prefix' that requests the buffer -of the next command to be displayed in a new frame. +** New user option 'translate-upper-case-key-bindings'. +This can be set to nil to inhibit translating upper case keys to lower +case keys. +++ -*** New command 'clone-frame' (bound to 'C-x 5 c'). -This is like 'C-x 5 2', but uses the window configuration and frame -parameters of the current frame instead of 'default-frame-alist'. -When called interactively with a prefix arg, the window configuration -is not cloned. +** New command 'ensure-empty-lines'. +This command increases (or decreases) the number of empty lines before +point. --- -*** Default values of 'frame-title-format' and 'icon-title-format' have changed. -These variables are used to display the title bar of visible frames -and the title bar of an iconified frame. They now show the name of -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))) +*** Improved mouse behavior with auto-scrolling modes. +When clicking inside the 'scroll-margin' or 'hscroll-margin' region +the point is now moved only when releasing the mouse button. This no +longer results in a bogus selection, unless the mouse has been +effectively dragged. +++ -*** New frame parameter 'drag-with-tab-line'. -This parameter, similar to 'drag-with-header-line', allows moving frames -by dragging the tab lines of their topmost windows with the mouse. - -+++ -*** New optional behavior of 'delete-other-frames'. -When invoked with a prefix argument, 'delete-other-frames' now -iconifies frames, rather than deleting them. +** 'kill-ring-max' now defaults to 120. --- -*** Commands 'set-frame-width' and 'set-frame-height' now prompt for values. -These commands now prompt for the value via the minibuffer, instead of -requiring the user to specify the value via the prefix argument. - -** Windows - -+++ -*** The key prefix 'C-x 4 1' displays next command buffer in the same window. -It's bound to the command 'same-window-prefix' that requests the buffer -of the next command to be displayed in the same window. +** New user option 'yank-menu-max-items'. +Customize this option to limit the amount of entries in the menu +"Edit->Paste from Kill Menu". The default is 60. -+++ -*** The key prefix 'C-x 4 4' displays next command buffer in a new window. -It's bound to the command 'other-window-prefix' that requests the buffer -of the next command to be displayed in a new window. +** show-paren-mode +++ -*** New command 'recenter-other-window', bound to 'S-M-C-l'. -Like 'recenter-top-bottom', but acting on the other window. +*** New user option 'show-paren-context-when-offscreen'. +When non-nil, if the point is in a closing delimiter and the opening +delimiter is offscreen, shows some context around the opening +delimiter in the echo area. -+++ -*** New user option 'delete-window-choose-selected'. -This allows specifying how Emacs chooses which window will be the -frame's selected window after the currently selected window is -deleted. - -+++ -*** New argument NO-OTHER for some window functions. -'get-lru-window', 'get-mru-window' and 'get-largest-window' now accept a -new optional argument NO-OTHER which, if non-nil, avoids returning a -window whose 'no-other-window' parameter is non-nil. - -+++ -*** New 'display-buffer' function 'display-buffer-use-least-recent-window'. -This is like 'display-buffer-use-some-window', but won't reuse the -current window, and when called repeatedly will try not to reuse a -previously selected window. +** Comint +++ -*** New function 'window-bump-use-time'. -This updates the use time of a window. +*** 'comint-term-environment' is now aware of connection-local variables. +The user option 'comint-terminfo-terminal' and variable +'system-uses-terminfo' can now be set as connection-local variables to +change the terminal used on a remote host. -** Minibuffer + +* Changes in Specialized Modes and Packages in Emacs 29.1 -+++ -*** Minibuffer scrolling is now conservative by default. -This is controlled by the new variable 'scroll-minibuffer-conservatively'. -It is t by default; setting it to nil will cause scrolling in the -minibuffer obey the value of 'scroll-conservatively'. +** vc -+++ -*** Improved handling of minibuffers on switching frames. -By default, when you switch to another frame, an active minibuffer now -moves to the newly selected frame. Nevertheless, the effect of what -you type in the minibuffer happens in the frame where the minibuffer -was first activated. An alternative behavior is available by -customizing 'minibuffer-follows-selected-frame' to nil. Here, the -minibuffer stays in the frame where you first opened it, and you must -switch back to this frame to continue or abort its command. The old -behavior, which mixed these two, can be approximated by customizing -'minibuffer-follows-selected-frame' to a value which is neither nil -nor t. +--- +*** 'C-x v v' on an unregistered file will now use the most specific backend. +Previously, if you had an SVN-covered ~/ directory, and a Git-covered +directory in ~/foo/bar, using 'C-x v v' on a new, unregistered file +~/foo/bar/zot would register it in the SVN repository in ~/ instead of +in the Git repository in ~/foo/bar. This makes this command +consistent with 'vc-responsible-backend'. -+++ -*** New user option 'read-minibuffer-restore-windows'. -When customized to nil, it uses 'minibuffer-restore-windows' in -'minibuffer-exit-hook' to remove only the window showing the -"*Completions*" buffer, but keeps all other windows created -while the minibuffer was active. +** Message --- -*** New variable 'redisplay-adhoc-scroll-in-resize-mini-windows'. -Customizing it to nil will disable the ad-hoc auto-scrolling of -minibuffer text shown in mini-windows when resizing those windows. -The default heuristics of that scrolling can be counter productive in -some corner cases, though the cure might be worse than the disease. -This said, the effect should be negligible in the vast majority of -cases anyway. +*** New user option 'mml-attach-file-at-the-end'. +If non-nil, 'C-c C-a' will put attached files at the end of the message. -** Mode Line +** Gnus +++ -*** New user option 'mode-line-compact'. -If non-nil, repeating spaces are compressed into a single space. If -'long', this is only done when the mode line is longer than the -current window width (in columns). +*** New user option 'gnus-treat-emojize-symbols'. +If non-nil, symbols that have an emoji representation will be +displayed as emojis. +++ -*** New user options to control format of line/column numbers in the mode line. -'mode-line-position-line-format' is the line number format (when -'line-number-mode' is on), 'mode-line-position-column-format' is -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 'gnus-article-emojize-symbols'. +This is bound to 'W D e' and will display symbols that have emoji +representation as emojis. -** Tab Bars and Tab Lines - -+++ -*** The prefix key 'C-x t t' can be used to display a buffer in a new tab. -Typing 'C-x t t' before a command will cause the buffer shown by that -command to be displayed in a new tab. 'C-x t t' is bound to the -command 'other-tab-prefix'. +** EIEIO +++ *** New command 'C-x t C-r' to open file read-only in the other tab. @@ -552,4015 +266,396 @@ move it closer to other tabs in the same group. --- *** New user option 'tab-line-tab-name-format-function'. ---- -*** The tabs in the tab line can now be scrolled using horizontal scroll. -If your mouse or trackpad supports it, you can now scroll tabs when -the mouse pointer is in the tab line by scrolling left or right. - ---- -*** New tab-line faces and user options. -The face 'tab-line-tab-special' is used for tabs whose buffers are -special, i.e. buffers that don't visit a file. The face -'tab-line-tab-modified' is used to display modified, file-backed -buffers. The face 'tab-line-tab-inactive-alternate' is used to -display inactive tabs with an alternating background color, making -them easier to distinguish, especially if the face 'tab-line-tab' is -configured to not display with a box; this alternate face is only -applied when the user option 'tab-line-tab-face-functions' is so -configured. That option may also be used to customize tab-line faces -in other ways. - -** Mouse wheel +** align --- -*** Mouse wheel scrolling now defaults to one line at a time. +*** Alignment in 'text-mode' has changed. +Previously, 'M-x align' didn't do anything, and you had to say 'C-u +M-x align' for it to work. This has now been changed. The default +regexp for 'C-u M-x align-regexp' has also been changed to be easier +for inexperienced users to use. ---- -*** Mouse wheel scrolling now works on more parts of frame's display. -When using 'mouse-wheel-mode', the mouse wheel will now scroll also when -the mouse cursor is on the scroll bars, fringes, margins, header line, -and mode line. ('mouse-wheel-mode' is enabled by default on most graphical -displays.) +** eww +++ -*** Mouse wheel scrolling with Shift modifier now scrolls horizontally. -This works in text buffers and over images. Typing a numeric prefix arg -(e.g. 'M-5') before starting horizontal scrolling changes its step value. -The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'. - -** Customize - ---- -*** Customize buffers can now be reverted with 'C-x x g'. - ---- -*** Most customize commands now hide obsolete user options. -Obsolete user options are no longer shown in the listings produced by -the commands 'customize', 'customize-group', 'customize-apropos' and -'customize-changed'. - -To customize obsolete user options, use 'customize-option' or -'customize-saved'. - ---- -*** New SVG icons for checkboxes and arrows. -They will be used automatically instead of the old icons. If Emacs is -built without SVG support, the old icons will be used instead. +*** New user option to automatically rename EWW buffers. +The 'eww-auto-rename-buffer' user option can be configured to rename +rendered web pages by using their title, URL, or a user-defined +function which returns a string. For the first two cases, the length +of the resulting name is controlled by 'eww-buffer-name-length'. By +default, no automatic renaming is performed. ** Help ---- -*** The order of things displayed in the "*Help*" buffer has been changed. -The indented "administrative" block (containing the "probably -introduced" and "other relevant functions" (and similar things) has -been moved to after the doc string. - -+++ -*** New command 'describe-command' shows help for a command. -This can be used instead of 'describe-function' for interactive -commands and is globally bound to 'C-h x'. - -+++ -*** New command 'describe-keymap' describes keybindings in a keymap. - ---- -*** New command 'apropos-function'. -This works like 'C-u M-x apropos-command' but is more discoverable. - ---- -*** New keybinding 'C-h R' prompts for an Info manual and displays it. - ---- -*** Keybindings in 'help-mode' use the new 'help-key-binding' face. -This face is added by 'substitute-command-keys' to any "\[command]" -substitution. The return value of that function should consequently -be assumed to be a propertized string. - -Note that the new face will also be used in tooltips. When using the -GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t. - -+++ -*** New user option 'help-enable-symbol-autoload'. -If non-nil, displaying help for an autoloaded function whose -'autoload' form provides no documentation string will try to load the -file it's from. This will give more extensive help for such -functions. - ---- -*** The 'help-for-help' ('C-h C-h') screen has been redesigned. - -+++ -*** New convenience commands with short keys in the Help buffer. -New command 'help-view-source' ('s') will view the source file (if -any) of the current help topic. New command 'help-goto-info' ('i') -will look up the current symbol (if any) in Info. New command -'help-customize' ('c') will customize the user option or the face -(if any) whose doc string is being shown in the Help buffer. - ---- -*** New user option 'describe-bindings-outline'. -It enables outlines in the output buffer of 'describe-bindings' that -can provide a better overview in a long list of available bindings. - -+++ -*** New commands to describe buttons and widgets. -'widget-describe' (on a widget) will pop up a help buffer and give a -description of the properties. Likewise 'button-describe' does the -same for a button. - ---- -*** Improved "find definition" feature of "*Help*" buffers. -Now clicking on the link to find the definition of functions generated -by 'cl-defstruct', or variables generated by 'define-derived-mode', -for example, will go to the exact place where they are defined. - ---- -*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'. -These new navigation commands are bound to 'n' and 'p' in -'apropos-mode'. - ---- -*** The command 'view-lossage' can now be invoked from the menu bar. -The menu bar "Help" menu now has a "Show Recent Inputs" item under the -"Describe" sub-menu. - -+++ -*** New command 'lossage-size'. -It allows users to change the maximum number of keystrokes and -commands recorded for the purpose of 'view-lossage'. - ---- -*** Closing the "*Help*" buffer from the toolbar now buries the buffer. -In previous Emacs versions, the "*Help*" buffer was killed instead when -clicking the "X" icon in the tool bar. - ---- -*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation. - -** File Locks - -+++ -*** New user option 'lock-file-name-transforms'. -This option allows controlling where lock files are written. It uses -the same syntax as 'auto-save-file-name-transforms'. - -+++ -*** New user option 'remote-file-name-inhibit-locks'. -When non-nil, this option suppresses lock files for remote files. -Default is nil. - -+++ -*** New minor mode 'lock-file-mode'. -This command, called interactively, toggles the local value of -'create-lockfiles' in the current buffer. - -** Emacs Server - -+++ -*** New user option 'server-client-instructions'. -When emacsclient connects, Emacs will (by default) output a message -about how to exit the client frame. If 'server-client-instructions' -is set to nil, this message is inhibited. - -+++ -*** New command 'server-edit-abort'. -This command (not bound to any key by default) can be used to abort -an edit instead of marking it as "Done" (which the 'C-x #' command -does). The 'emacsclient' program exits with an abnormal status as -result of this command. - -+++ -*** New desktop integration for connecting to the server. -If your operating system’s desktop environment is -freedesktop.org-compatible (which is true of most GNU/Linux and other -recent Unix-like desktops), you may use the new "Emacs (Client)" -desktop menu entry to open files in an existing Emacs instance rather -than starting a new one. The daemon starts if it is not already -running. - -** Miscellaneous - -+++ -*** New command 'font-lock-update', bound to 'C-x x f'. -This command updates the syntax highlighting in this buffer. - -+++ -*** New command 'memory-report'. -This command opens a new buffer called "*Memory Report*" and gives a -summary of where Emacs is using memory currently. - -+++ -*** New command 'submit-emacs-patch'. -This works like 'report-emacs-bug', but is more geared towards sending -patches to the Emacs issue tracker. - ---- -*** New face 'apropos-button'. -Applies to buttons that indicate a face. - -+++ -*** New face 'font-lock-doc-markup-face'. -Intended for documentation mark-up syntax and tags inside text that -uses 'font-lock-doc-face', which it should appropriately stand out -against and harmonize with. It would typically be used in structured -documentation comments in program source code by language-specific -modes, for mark-up conventions like Haddock, Javadoc or Doxygen. By -default this face inherits from 'font-lock-constant-face'. - -+++ -*** New face box style 'flat-button'. -This is a plain 2D button, but uses the background color instead of -the foreground color. - ---- -*** New faces 'shortdoc-heading' and 'shortdoc-section'. -Applied to shortdoc headings and sections. - ---- -*** New face 'separator-line'. -This is used by 'make-separator-line' (see below). - -+++ -*** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input. -This is another attempt to solve the problem of handling high key repeat rate -and other "slow scrolling" situations. It is hoped it behaves better -than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'. -It is not enabled by default. - ---- -*** Obsolete aliases are no longer hidden from command completion. -Completion of command names now considers obsolete aliases as -candidates, if they were marked obsolete in the current major version -of Emacs. Invoking a command via an obsolete alias now mentions the -obsolescence fact and shows the new name of the command. - -+++ -*** Support for '(box . SIZE)' 'cursor-type'. -By default, 'box' cursor always has a filled box shape. But if you -specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow -box if the point is on an image larger than SIZE pixels in any -dimension. - -+++ -*** The user can now customize how "default" values are prompted for. -The new utility function 'format-prompt' has been added which uses the -new 'minibuffer-default-prompt-format' user option to format "default" -prompts. This means that prompts that look like "Enter a number -(default 10)" can be customized to look like, for instance, "Enter a -number [10]", or not have the default displayed at all, like "Enter a -number". (This only affects callers that were altered to use -'format-prompt'.) - ---- -*** New help window when Emacs prompts before opening a large file. -Commands like 'find-file' or 'visit-tags-table' ask to visit a file -normally or literally when the file is larger than a certain size (by -default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more -about the different options to visit a file, how you can disable the -prompt, and how you can tweak the file size threshold. - -+++ -*** Emacs now defaults to UTF-8 instead of ISO-8859-1. -This is only for the default, where the user has set no 'LANG' (or -similar) variable or environment. This change should lead to no -user-visible changes for normal usage. - ---- -*** 'global-display-fill-column-indicator-mode' skips some buffers. -By default, turning on 'global-display-fill-column-indicator-mode' -doesn't turn on 'display-fill-column-indicator-mode' in special-mode -buffers. This can be controlled by customizing the user option -'global-display-fill-column-indicator-modes'. - -+++ -*** 'nobreak-char-display' now also affects all non-ASCII space characters. -Previously, this was limited only to 'NO-BREAK SPACE' and hyphen -characters. Now it also covers the rest of the non-ASCII Unicode -space characters. Also, unlike in previous versions of Emacs, the -non-ASCII characters are displayed as themselves when -'nobreak-char-display' is t, i.e. they are not replaced on display -with the ASCII space and hyphen characters. +*** New user option 'help-link-key-to-documentation'. +When this option is non-nil, key bindings displayed in the "*Help*" +buffer will be linked to the documentation for the command they are +bound to. This does not affect listings of key bindings and +functions (such as 'C-h b'). ---- -*** New backward compatibility variable 'nobreak-char-ascii-display'. -This variable is nil by default, and non-ASCII space and hyphen -characters are displayed as themselves, even if 'nobreak-char-display' -is non-nil. If 'nobreak-char-ascii-display' is set to a non-nil -value, the non-ASCII space and hyphen characters are instead displayed -as their ASCII counterparts: spaces and ASCII hyphen (a.k.a. "dash") -characters. This provides backward compatibility feature for the -change described above, where the non-ASCII characters are no longer -replaced with their ASCII counterparts when 'nobreak-char-display' is -t. You may need this on text-mode terminals that produce messed up -display when non-ASCII spaces and hyphens are written to the display. -(This variable is only effective when 'nobreak-char-display' is t.) - -+++ -*** Improved support for terminal emulators that encode the Meta flag. -Some terminal emulators set the 8th bit of Meta characters, and then -encode the resulting character code as if it were non-ASCII character -above codepoint 127. Previously, the only way of using these in Emacs -was to set up the terminal emulator to use the 'ESC' characters to send -Meta characters to Emacs, e.g., send "ESC x" when the user types -'M-x'. You can now avoid the need for this setup of such terminal -emulators by using the new input-meta-mode with the special value -'encoded' with these terminal emulators. +** info-look --- -*** 'auto-composition-mode' can now be selectively disabled on some TTYs. -Some text-mode terminals produce display glitches trying to compose -characters. The 'auto-composition-mode' can now have a string value -that names a terminal type; if the value returned by the 'tty-type' -function compares equal with that string, automatic composition will -be disabled in windows shown on that terminal. The Linux terminal -sets this up by default. +*** info-look specs can now be expanded at run time instead of a load time. +The new ':doc-spec-function' element can be used to compute the +':doc-spec' element when the user asks for info on that particular +mode (instead of at load time). ---- -*** Support for the 'strike-through' face attribute on TTY frames. -If your terminal's termcap or terminfo database entry has the 'smxx' -capability defined, Emacs will now emit the prescribed escape -sequences necessary to render faces with the 'strike-through' -attribute on TTY frames. - ---- -*** TTY menu navigation is now supported in 'xterm-mouse-mode'. -TTY menus support mouse navigation and selection when 'xterm-mouse-mode' -is active. When run on a terminal, clicking on the menu bar with the -mouse now pops up a TTY menu by default instead of running the command -'tmm-menubar'. To restore the old behavior, set the user option -'tty-menu-open-use-tmm' to non-nil. - ---- -*** 'M-x report-emacs-bug' will no longer include "Recent messages" section. -These were taken from the "*Messages*" buffer, and may inadvertently -leak information from the reporting user. - ---- -*** 'C-u M-x dig' will now prompt for a query type to use. - ---- -*** Rudimentary support for the 'st' terminal emulator. -Emacs now supports 256 color display on the 'st' terminal emulator. +** subr-x +++ -*** Update IRC-related references to point to Libera.Chat. -The Free Software Foundation and the GNU Project have moved their -official IRC channels from the Freenode network to Libera.Chat. For the -original announcement and the follow-up update, including more details, -see: - -https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html -https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html - -Given the relocation of GNU and FSF's official IRC channels, as well -as #emacs and various other Emacs-themed channels (see the link below) -to Libera.Chat, IRC-related references in the Emacs repository have -now been updated to point to Libera.Chat. - -https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html - - -* Incompatible Editing Changes in Emacs 28.1 - ---- -** 'toggle-truncate-lines' now disables 'visual-line-mode'. -This is for symmetry with 'visual-line-mode', which disables -'truncate-lines'. - ---- -** 'electric-indent-mode' now also indents inside strings and comments. -(This only happens when indentation function also supports this.) - -To recover the previous behavior you can use: - - (add-hook 'electric-indent-functions - (lambda (_) (if (nth 8 (syntax-ppss)) 'no-indent))) - ---- -** The 'M-o' ('facemenu-keymap') global binding has been removed. -To restore the old binding, say something like: - - (require 'facemenu) - (define-key global-map "\M-o" 'facemenu-keymap) - (define-key facemenu-keymap "\es" 'center-line) - (define-key facemenu-keymap "\eS" 'center-paragraph) - -The last two lines are not strictly necessary if you don't care about -having those two commands on the 'M-o' keymap; see the next section. - ---- -** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. -Use 'M-x center-line' and 'M-x center-paragraph' instead. See the -previous section for how to get back the old bindings. Alternatively, -if you only want these two commands to have the global bindings they -had before, you can add the following to your init file: +*** New macro 'with-memoization' provides a very primitive form of memoization. - (define-key global-map "\M-o\M-s" 'center-line) - (define-key global-map "\M-o\M-S" 'center-paragraph) - ---- -** The 'M-o M-o' global binding has been removed. -Use 'M-x font-lock-fontify-block' instead, or the new 'C-x x f' -command, which updates the syntax highlighting in the current buffer. - ---- -** The escape sequence '\e[29~' in Xterm is now mapped to 'menu'. -Xterm sends this sequence for both 'F16' and 'Menu' keys -It used to be mapped to 'print' but we couldn't find a terminal -that uses this sequence for any kind of 'Print' key. -This makes the Menu key (see https://en.wikipedia.org/wiki/Menu_key) -work for 'context-menu-mode' in Xterm. - ---- -** New user option 'xterm-store-paste-on-kill-ring'. -If non-nil (the default), Emacs pushes pasted text onto the kill ring -(if using an xterm-like terminal that supports bracketed paste). -Setting this to nil inhibits that. - ---- -** 'vc-print-branch-log' shows the change log from its root directory. -It previously used to use the default directory. - ---- -** 'project-shell' and 'shell' now use 'pop-to-buffer-same-window'. -This is to keep the same behavior as Eshell. +** ansi-color --- -** In 'nroff-mode', 'center-line' is no longer bound to a key. -The original key binding was 'M-s', which interfered with I-search, -since the latter uses 'M-s' as a prefix key of the search prefix map. - ---- -** In 'f90-mode', the backslash character ('\') no longer escapes. -For about a decade, the backslash character has no longer had a -special escape syntax in Fortran F90. To get the old behavior back, -say something like: - - (modify-syntax-entry ?\\ "\\" f90-mode-syntax-table) - -+++ -** Setting 'fill-column' to nil is obsolete. -This undocumented use of 'fill-column' is now obsolete. To disable -auto filling, turn off 'auto-fill-mode' instead. - -For instance, you could add something like the following to your init -file: - - (add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1)) - -** Xref migrated from EIEIO to cl-defstruct for its core objects. -This means that 'oref' and 'with-slots' no longer works on them, and -'make-instance' can no longer be used to create those instances (which -wasn't recommended anyway). Packages should restrict themselves to -using functions like 'xref-make', 'xref-make-match', -'xref-make-*-location', as well as accessor functions -'xref-item-summary' and 'xref-item-location'. - -Among the benefits are better performance (noticeable when there are a -lot of matches) and improved flexibility: 'xref-match-item' instances -do not require that 'location' inherits from 'xref-location' anymore -(that class was removed), so packages can create new location types to -use with "match items" without adding EIEIO as a dependency. - - -* Editing Changes in Emacs 28.1 - -** Input methods - -+++ -*** Emacs now supports "transient" input methods. -A transient input method is enabled for inserting a single character, -and is then automatically disabled. 'C-x \' temporarily enables the -selected transient input method. Use 'C-u C-x \' to select a -transient input method (which can be different from the input method -enabled by 'C-\'). For example, 'C-u C-x \ compose RET' selects the -'compose' input method; then typing 'C-x \ 1 2' will insert the -character '½', and disable the 'compose' input method afterwards. -You can use 'C-x \' in incremental search to insert a single character -to the search string. - ---- -*** New input method 'compose' based on X Multi_key sequences. - ---- -*** New input method 'iso-transl' with the same keys as 'C-x 8'. -After selecting it as a transient input method with 'C-u C-x \ -iso-transl RET', it supports the same key sequences as 'C-x 8', -so e.g. like 'C-x 8 [' inserts a left single quotation mark, -'C-x \ [' does the same. - ---- -*** New user option 'read-char-by-name-sort'. -It defines the sorting order of characters for completion of 'C-x 8 RET TAB' -and can be customized to sort them by codepoints instead of character names. -Additionally, you can group characters by Unicode blocks after customizing -'completions-group' and 'completions-group-sort'. - ---- -*** Improved language transliteration in Malayalam input methods. -Added a new Mozhi scheme. The inapplicable ITRANS scheme is now -deprecated. Errors in the Inscript method were corrected. - ---- -*** New input method 'cham'. -There's also a Cham greeting in "etc/HELLO". - ---- -*** New input methods for Lakota language orthographies. -Two orthographies are represented here, the Suggested Lakota -Orthography and what is known as the White Hat Orthography. Input -methods 'lakota-slo-prefix', 'lakota-slo-postfix', and -'lakota-white-hat-postfix' have been added. There is also a Lakota -greeting in "etc/HELLO". - -+++ -** Standalone 'M-y' allows interactive selection from previous kills. -'M-y' can now be typed after a command that is not a yank command. -When invoked like that, it prompts in the minibuffer for one of the -previous kills, offering completion and minibuffer-history navigation -through previous kills recorded in the kill ring. A similar feature -in Isearch can be invoked if you bind 'C-s M-y' to the command -'isearch-yank-pop'. When the user option 'yank-from-kill-ring-rotate' -is nil the kill ring is not rotated after 'yank-from-kill-ring'. - -+++ -** New user option 'word-wrap-by-category'. -When word-wrap is enabled, and this option is non-nil, that allows -Emacs to break lines after more characters than just whitespace -characters. In particular, this significantly improves word-wrapping -for CJK text mixed with Latin text. - -+++ -** New command 'undo-redo'. -It undoes previous undo commands, but doesn't record itself as an -undoable command. It is bound to 'C-?' and 'C-M-_', the first binding -works well in graphical mode, and the second one is easy to hit on tty. - -For full conventional undo/redo behavior, you can also customize the -user option 'undo-no-redo' to t. - -+++ -** New commands 'copy-matching-lines' and 'kill-matching-lines'. -These commands are similar to the command 'flush-lines', -but add the matching lines to the kill ring as a single string, -including the newlines that separate the lines. - -+++ -** New user option 'kill-transform-function'. -This can be used to transform (and suppress) strings from entering the -kill ring. - -+++ -** 'save-interprogram-paste-before-kill' can now be a number. -In that case, it's interpreted as a limit on the size of the clipboard -data that will be saved to the 'kill-ring' prior to killing text: if -the size of the clipboard data is greater than or equal to the limit, -it will not be saved. - -+++ -** New user option 'tab-first-completion'. -If 'tab-always-indent' is 'complete', this new user option can be used to -further tweak whether to complete or indent. - ---- -** 'indent-tabs-mode' is now a global minor mode instead of just a variable. - -+++ -** New choice 'permanent' for 'shift-select-mode'. -When the mark was activated by shifted motion keys, non-shifted motion -keys don't deactivate the mark after customizing 'shift-select-mode' -to 'permanent'. Similarly, the active mark will not be deactivated by -typing shifted motion keys. - -+++ -** The "Edit => Clear" menu item now obeys a rectangular region. - -+++ -** New command 'revert-buffer-with-fine-grain'. -Revert a buffer trying to be as non-destructive as possible, -preserving markers, properties and overlays. The new variable -'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, with a default value of 2 seconds. - -+++ -** New command 'revert-buffer-quick'. -This is bound to 'C-x x g' and is like 'revert-buffer', but prompts -less. - -+++ -** New user option 'revert-buffer-quick-short-answers'. -This controls how the new 'revert-buffer-quick' ('C-x x g') command -prompts. A non-nil value will make it use 'y-or-n-p' rather than -'yes-or-no-p'. Defaults to nil. - -+++ -** New user option 'query-about-changed-file'. -If non-nil (the default), Emacs prompts as before when re-visiting a -file that has changed externally after it was visited the first time. -If nil, Emacs does not prompt, but instead shows the buffer with its -contents before the change, and provides instructions how to revert -the buffer. - ---- -** New value 'save-some-buffers-root' of 'save-some-buffers-default-predicate'. -When using this predicate, only buffers under the current project root -will be considered when saving buffers with 'save-some-buffers'. - ---- -** New user option 'save-place-abbreviate-file-names'. -This can simplify sharing the 'save-place-file' file across -different hosts. - ---- -** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'. -'copy-region-blink-delay' specifies a delay to indicate the region -copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies -a delay to show the paired character to delete. - ---- -** 'zap-up-to-char' now uses 'read-char-from-minibuffer'. -This allows navigating through the history of characters that have -been input. This is mostly useful for characters that have complex -input methods where inputting the character again may involve many -keystrokes. - -+++ -** Input history for 'goto-line' can now be made local to every buffer. -In any event, line numbers used with 'goto-line' are kept in their own -history list. This should help make faster the process of finding -line numbers that were previously jumped to. By default, all buffers -share a single history list. To make every buffer have its own -history list, customize the user option 'goto-line-history-local'. - -+++ -** New command 'goto-line-relative' for use in a narrowed buffer. -It moves point to the line relative to the accessible portion of the -narrowed buffer. 'M-g M-g' in Info is rebound to this command. -When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed -buffer to be able to move point to the inaccessible portion. -'goto-line-relative' is bound to 'C-x n g'. - -+++ -** 'goto-char' prompts for the character position. -When called interactively, 'goto-char' now offers the position at -point as the default. - -** Auto-saving via 'auto-save-visited-mode' can now be inhibited. -Set the variable 'auto-save-visited-mode' buffer-locally to nil to -achieve that. - -+++ -** New command 'kdb-macro-redisplay' to force redisplay in keyboard macros. -This command is bound to 'C-x C-k d'. - ---- -** 'blink-cursor-mode' is now enabled by default regardless of the UI. -It used to be enabled when Emacs is started in GUI mode but not when started -in text mode. The cursor still only actually blinks in GUI frames. - -** 'show-paren-mode' is now enabled by default. -To go back to the previous behavior, customize the user option of the -same name to nil. - -+++ -** New minor mode 'show-paren-local-mode'. -It serves as a local counterpart for 'show-paren-mode', allowing you -to toggle it separately in different buffers. To use it only in -programming modes, for example, add the following to your init file: - - (add-hook 'prog-mode-hook #'show-paren-local-mode) - - -* Changes in Specialized Modes and Packages in Emacs 28.1 - -** Isearch and Replace - -+++ -*** Interactive regular expression search now uses faces for sub-groups. -E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face -on the part of the regexp that matches the sub-expression "[0-9]+". -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 'isearch-wrap-pause' defines how to wrap the search. -There are choices to disable wrapping completely and to wrap immediately. -When wrapping immediately, it consistently handles the numeric arguments -of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'), -continuing with the remaining count after wrapping. - -+++ -*** New user option 'isearch-repeat-on-direction-change'. -When this option is set, direction changes in Isearch move to another -search match, if there is one, instead of moving point to the other -end of the current match. - -*** New key 'M-s M-.' starts isearch looking for the thing at point. -This key is bound to the new command 'isearch-forward-thing-at-point'. -The new user option 'isearch-forward-thing-at-point' defines -a list of symbols to try to get the "thing" at point. By default, -the first element of the list is 'region' that tries to yank -the currently active region to the search string. - -+++ -*** New user option 'lazy-highlight-no-delay-length'. -Lazy highlighting of matches in Isearch now starts immediately if the -search string is at least this long. 'lazy-highlight-initial-delay' -still applies for shorter search strings, which avoids flicker in the -search buffer due to too many matches being highlighted. - -+++ -*** The default 'search-whitespace-regexp' value has changed. -This used to be "\\s-+", which meant that it was mode-dependent whether -newlines were included in the whitespace set. This has now been -changed to only match spaces and tab characters. - -** Dired - -+++ -*** New user option 'dired-kill-when-opening-new-dired-buffer'. -If non-nil, Dired will kill the current buffer when selecting a new -directory to display. - -+++ -*** Behavior change on 'dired-do-chmod'. -As a security precaution, Dired's M command no longer follows symbolic -links. Instead, it changes the symbolic link's own mode; this always -fails on platforms where such modes are immutable. - ---- -*** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'. -Previously, if 'dired-clean-up-buffers-too' was non-nil, and -'dired-clean-confirm-killing-deleted-buffers' was nil, the buffers -wouldn't be killed. This combination will now kill the buffers. - -+++ -*** New user option 'dired-switches-in-mode-line'. -This user option controls how 'ls' switches are displayed in the mode -line, and allows truncating them (to preserve space on the mode line) -or showing them literally, either instead of, or in addition to, -displaying "by name" or "by date" sort order. - -+++ -*** New user option 'dired-compress-directory-default-suffix'. -This user option controls the default suffix for compressing a -directory. If it's nil, ".tar.gz" will be used. Refer to -'dired-compress-files-alist' for a list of supported suffixes. - -+++ -*** New user option 'dired-compress-file-default-suffix'. -This user option controls the default suffix for compressing files. -If it's nil, ".gz" will be used. Refer to 'dired-compress-file-alist' -for a list of supported suffixes. - ---- -*** Broken and circular links are shown with the 'dired-broken-symlink' face. - ---- -*** '=' ('dired-diff') will now put all backup files into the 'M-n' history. -When using '=' on a file with backup files, the default file to use -for diffing is the newest backup file. You can now use 'M-n' to quickly -select a different backup file instead. - -+++ -*** New user option 'dired-maybe-use-globstar'. -If set, enables globstar (recursive globbing) in shells that support -this feature, but have it turned off by default. This allows producing -directory listings with files matching a wildcard in all the -subdirectories of a given directory. The new variable -'dired-enable-globstar-in-shell' lists which shells can have globstar -enabled, and how to enable it. - -+++ -*** New user option 'dired-copy-dereference'. -If set to non-nil, Dired will dereference symbolic links when copying. -This can be switched off on a per-usage basis by providing -'dired-do-copy' with a 'C-u' prefix. - ---- -*** New user option 'dired-do-revert-buffer'. -Non-nil reverts the destination Dired buffer after performing one -of these operations: 'dired-do-copy', 'dired-do-rename', -'dired-do-symlink', 'dired-do-hardlink'. - -*** New user option 'dired-mark-region'. -This option affects all Dired commands that mark files. When non-nil -and the region is active in Transient Mark mode, then Dired commands -operate only on files in the active region. The values 'file' and -'line' of this user option define the details of marking the file at -the end of the region. - -*** State changing VC operations are supported in Dired. -These operations are supported on files and directories via the new -command 'dired-vc-next-action'. - -+++ -*** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'. -The 'dired-jump' and 'dired-jump-other-window' commands have been -moved from the 'dired-x' package to 'dired'. The user option -'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) - ---- -*** 'dired-query' now uses 'read-char-from-minibuffer'. -Using it instead of 'read-char-choice' allows using 'C-x o' -to switch to the help window displayed after typing 'C-h'. - -+++ -** New user option 'isearch-allow-motion'. -When 'isearch-allow-motion' is set, the commands 'beginning-of-buffer', -'end-of-buffer', 'scroll-up-command' and 'scroll-down-command', when -invoked during I-search, move respectively to the first occurrence of -the current search string in the buffer, the last one, the first one -after the current window, and the last one before the current window. -Additionally, users can change the meaning of other motion commands -during I-search by using their 'isearch-motion' property. The user -option 'isearch-motion-changes-direction' controls whether the -direction of the search changes after a motion command. - -+++ -** Emacs 28.1 comes with Org v9.5. -See the file ORG-NEWS for user-visible changes in Org. - -** Outline - -+++ -*** New commands to cycle heading visibility. -Typing 'TAB' on a heading line cycles the current section between -"hide all", "subheadings", and "show all" states. Typing 'S-TAB' -anywhere in the buffer cycles the whole buffer between "only top-level -headings", "all headings and subheadings", and "show all" states. - -+++ -*** New user option 'outline-minor-mode-cycle'. -This user option customizes 'outline-minor-mode', with the difference -that 'TAB' and 'S-TAB' on heading lines cycle heading visibility. -Typing 'TAB' on a heading line cycles the current section between -"hide all", "subheadings", and "show all" states. Typing 'S-TAB' on a -heading line cycles the whole buffer between "only top-level -headings", "all headings and subheadings", and "show all" states. - ---- -*** New user option 'outline-minor-mode-highlight'. -This user option customizes 'outline-minor-mode'. It puts -highlighting on heading lines using standard outline faces. This -works well only when there are no conflicts with faces used by the -major mode. - -** Ispell - -+++ -*** 'ispell-comments-and-strings' now accepts START and END arguments. -These arguments default to the active region when used interactively. - -+++ -*** New command 'ispell-comment-or-string-at-point'. - ---- -*** New user option 'ispell-help-timeout'. -This controls how long the ispell help (on the '?' key) is displayed. - -** Flyspell mode - -+++ -*** Corrections and actions menu can be optionally bound to 'mouse-3'. -When Flyspell mode highlights a word as misspelled, you can click on -it to display a menu of possible corrections and actions. You can now -easily bind this menu to 'down-mouse-3' (usually the right mouse button) -instead of 'mouse-2' (the default) by enabling 'context-menu-mode'. - ---- -*** The current dictionary is now displayed in the minor mode lighter. -Clicking the dictionary name changes the current dictionary. - -** Package - -*** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA. -Thus, packages on NonGNU ELPA will appear by default in the list shown -by 'list-packages'. - ---- -*** '/ s' ('package-menu-filter-by-status') changed parameter handling. -The command was documented to take a comma-separated list of statuses -to filter by, but instead it used the parameter as a regexp. The -command has been changed so that it now works as documented, and -checks statuses not as a regexp, but instead an exact match from the -comma-separated list. - -+++ -*** New command 'package-browse-url' and keystroke 'w'. - -+++ -*** New commands to filter the package list. -The filter commands are bound to the following keys: - -key binding ---- ------- -/ a package-menu-filter-by-archive -/ d package-menu-filter-by-description -/ k package-menu-filter-by-keyword -/ N package-menu-filter-by-name-or-description -/ n package-menu-filter-by-name -/ 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 - -*** Option to automatically native-compile packages upon installation. -Customize the user option 'package-native-compile' to enable automatic -native compilation of packages when they are installed. That option -is nil by default; if set non-nil, and if your Emacs was built with -native-compilation support, each package will be natively compiled -when it is installed, by invoking an asynchronous Emacs subprocess to -run the native-compilation of the package files. (Be sure to leave -Emacs running until these asynchronous subprocesses exit, or else the -native-compilation will be aborted when you exit Emacs.) - ---- -*** Column widths in 'list-packages' display can now be customized. -See the new user options 'package-name-column-width', -'package-version-column-width', 'package-status-column-width', and -'package-archive-column-width'. - -** Info - ---- -*** New user option 'Info-warn-on-index-alternatives-wrap'. -This option affects what happens when using the ',' command after -looking up an entry with 'i' in info buffers. If non-nil (the -default), the ',' command will now display a warning when proceeding -beyond the final index match, and tapping ',' once more will then take -you to the first match. - -** Abbrev mode - -+++ -*** Emacs can now suggest to use an abbrev based on text you type. -A new user option, 'abbrev-suggest', enables the new abbrev suggestion -feature. When enabled, if a user manually types a piece of text that -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. - -** Bookmarks - -*** Bookmarks can now be targets for new tabs. -When the bookmark.el library is loaded, a customize choice is added -to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. - ---- -*** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'. -The interactive bookmark list will now benefit from features in -'tabulated-list-mode' like sorting columns or changing column width. - -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. - ---- -*** New user option 'bookmark-set-fringe-mark'. -If non-nil, setting a bookmark will set a fringe mark on the current -line, and jumping to a bookmark will also set this mark. - ---- -*** New user option 'bookmark-menu-confirm-deletion'. -In Bookmark Menu mode, Emacs by default does not prompt for -confirmation when you type 'x' to execute the deletion of bookmarks -that have been marked for deletion. However, if this new option is -non-nil then Emacs will require confirmation with 'yes-or-no-p' before -deleting. - -** Recentf - ---- -*** The recentf files are no longer backed up. - ---- -*** 'recentf-auto-cleanup' now repeats daily when set to a time string. -When 'recentf-auto-cleanup' is set to a time string, it now repeats -every day, rather than only running once after the mode is turned on. - -** Calc - ---- -*** The behavior when doing forward-delete has been changed. -Previously, using the 'C-d' command would delete the final number in -the input field, no matter where point was. This has been changed to -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 '-'. - ---- -*** Calc now marks its windows dedicated. -The new user option 'calc-make-windows-dedicated' controls this. It -is t by default; set to nil to get back the old behavior. - -** Calendar - -+++ -*** New user option 'calendar-time-zone-style'. -If 'numeric', calendar functions (eg 'calendar-sunrise-sunset') that display -time zones will use a form like "+0100" instead of "CET". - -** Imenu - -+++ -*** New user option 'imenu-max-index-time'. -If creating the imenu index takes longer than specified by this -option (default 5 seconds), imenu indexing is stopped. - -** ido - ---- -*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'. - ---- -*** Killing virtual ido buffers interactively will make them go away. -Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't -do anything. This has now been changed, and killing virtual buffers -with that command will remove the buffer from recentf. - -** So Long - ---- -*** New 'so-long-predicate' function 'so-long-statistics-excessive-p'. -It efficiently detects the presence of a long line anywhere in the -buffer using 'buffer-line-statistics' (see above). This is now the -default predicate (replacing 'so-long-detected-long-line-p'). - ---- -*** Default values 'so-long-threshold' and 'so-long-max-lines' increased. -The values of these user options have been raised to 10000 bytes and 500 -lines respectively, to reduce the likelihood of false-positives when -'global-so-long-mode' is enabled. The latter value is now only used -by the old predicate, as the new predicate knows the longest line in -the entire buffer. - ---- -*** 'so-long-target-modes' now includes 'fundamental-mode' by default. -This means that 'global-so-long-mode' will also process files which were -not recognised. (This only has an effect if 'set-auto-mode' chooses -'fundamental-mode'; buffers which are simply in 'fundamental-mode' by -default are unaffected.) - ---- -*** New user options to preserve modes and variables. -The new options 'so-long-mode-preserved-minor-modes' and -'so-long-mode-preserved-variables' allow specified mode and variable -states to be maintained if 'so-long-mode' replaces the original major -mode. By default, these new options support 'view-mode'. - -** Grep - -+++ -*** New user option 'grep-match-regexp' matches grep markers to highlight. -Grep emits SGR ANSI escape sequences to color its output. The new -user option 'grep-match-regexp' holds the regular expression to match -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. - -*** Commands that use 'grep-find' now follow symlinks for command-line args. -This is because the default value of 'grep-find-template' now includes -the 'find' option '-H'. Commands that use that variable, including -indirectly via a call to 'xref-matches-in-directory', might be -affected. In particular, there should be no need anymore to ensure -any directory names on the 'find' command lines end in a slash. -This change is for better compatibility with old versions of non-GNU -'find', such as the one used on macOS. - ---- -*** New utility function 'grep-file-at-point'. -This returns the name of the file at point (if any) in 'grep-mode' -buffers. - -** Shell - ---- -*** New command in 'shell-mode': 'narrow-to-prompt'. -This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the -command line under point (and any following output). - ---- -*** New user option 'shell-has-auto-cd'. -If non-nil, 'shell-mode' handles implicit "cd" commands, changing the -directory if the command is a directory. Useful for shells like "zsh" -that has this feature. +*** Support for ANSI 256-color and 24-bit colors. +256-color and 24-bit color codes are now handled by ANSI color +filters and displayed with the specified color. ** term-mode --- -*** New user option 'term-scroll-snap-to-bottom'. -By default, 'term' and 'ansi-term' will now recenter the buffer so -that the prompt is on the final line in the window. Setting this new -user option to nil inhibits this behavior. - ---- -*** New user option 'term-set-terminal-size' -If non-nil, the 'LINES' and 'COLUMNS' environment variables will be set -based on the current window size. In previous versions of Emacs, this -was always done (and that could lead to odd displays when resizing the -window after starting). This variable defaults to nil. - ---- -*** 'term-mode' now supports "bright" color codes. -"Bright" ANSI color codes are now displayed using the color values -defined in 'term-color-bright-*'. In addition, bold text with regular -ANSI colors can be displayed as "bright" if 'ansi-color-bold-is-bright' -is non-nil. - -** Eshell - ---- -*** 'eshell-hist-ignoredups' can now also be used to mimic "erasedups" in bash. - ---- -*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses. -Its value contains the result of evaluating '(format "%s,eshell" -emacs-version)'. Other package names, like "tramp", could also be included. - ---- -*** Eshell no longer re-initializes its keymap every call. -This allows users to use (define-key eshell-mode-map ...) as usual. -Some modules have their own minor mode now to account for these -changes. - -*** Support for bookmark.el. -The command 'bookmark-set' (bound to 'C-x r m') is now supported, and -will create a bookmark that opens the current directory in Eshell. - -** Archive mode - ---- -*** Archive Mode can now parse ".squashfs" files. - -*** Can now modify members of 'ar' archives. - -*** Display of summaries is unified between backends. - -*** New user option and command to control displayed columns. -New user option 'archive-hidden-columns' and new command -'archive-hideshow-column' let you control which columns are displayed -and which are kept hidden. - ---- -*** New command bound to 'C': 'archive-copy-file'. -This command extracts the file at point and writes its data to a -file. - -** browse-url - -*** Added support for custom URL handlers. -There is a new variable 'browse-url-default-handlers' and a user -option 'browse-url-handlers' being alists with '(REGEXP-OR-PREDICATE -. FUNCTION)' entries allowing to define different browsing FUNCTIONs -depending on the URL to be browsed. The variable is for default -handlers provided by Emacs itself or external packages, the user -option is for the user (and allows for overriding the default -handlers). - -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 commands into 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 commands. With a new command -'browse-url-with-browser-kind', an URL can explicitly be browsed with -either an internal or external browser. - ---- -*** Support for browsing of remote files. -If a remote file is specified, a local temporary copy of that file is -passed to the browser. - ---- -*** Support for the conkeror browser is now obsolete. - ---- -*** Support for the Mosaic browser has been removed. -This support has been obsolete since 25.1. - -** Completion List Mode - -*** Improved navigation in the "*Completions*" buffer. -New key bindings have been added to 'completion-list-mode': 'n' and -'p' now navigate completions, and 'M-g M-c' switches to the -minibuffer and back to the completion list buffer. - -+++ -** profiler.el -The results displayed by 'profiler-report' now have the usage figures -at the left hand side followed by the function name. This is intended -to make better use of the horizontal space, in particular eliminating -the truncation of function names. There is no way to get the former -layout back. - -** Icomplete - ---- -*** New user option 'icomplete-matches-format'. -This allows controlling the current/total number of matches for the -prompt prefix. - -+++ -*** New minor modes 'icomplete-vertical-mode' and 'fido-vertical-mode'. -These modes modify Icomplete ('M-x icomplete-mode') and Fido ('M-x -fido-mode'), to display completion candidates vertically instead of -horizontally. In Icomplete, completions are rotated and selection -kept at the top. In Fido, completions scroll like a typical dropdown -widget. Both these new minor modes will turn on their non-vertical -counterparts first, if they are not on already. - ---- -*** Default value of 'icomplete-compute-delay' has been changed to 0.15 s. - ---- -*** Default value of 'icomplete-max-delay-chars' has been changed to 2. - ---- -*** Reduced blinking while completing the next completions set. -Icomplete doesn't hide the hint with the previously computed -completions anymore when compute delay is in effect, or the previous -computation has been aborted by input. Instead it shows the previous -completions until the new ones are ready. - ---- -*** Change in meaning of 'icomplete-show-matches-on-no-input'. -Previously, choosing a different completion with commands like 'C-.' -and then hitting 'RET' would choose the default completion. Doing this -will now choose the completion under point instead. Also when this option -is nil, completions are not shown when the minibuffer reads a file name -with initial input as the default directory. - -** Windmove - -+++ -*** New user options to customize windmove keybindings. -These options include 'windmove-default-keybindings', -'windmove-display-default-keybindings', -'windmove-delete-default-keybindings', -'windmove-swap-states-default-keybindings'. - -** Occur mode - -*** New bindings in occur-mode. -The command 'next-error-no-select' is now bound to 'n' and -'previous-error-no-select' is bound to 'p'. - -*** The new command 'recenter-current-error'. -It is bound to 'l' in Occur or compilation buffers, and recenters the -current displayed occurrence/error. - -*** Matches in target buffers are now highlighted as in 'compilation-mode'. -The method of highlighting is specified by the user options -'next-error-highlight' and 'next-error-highlight-no-select'. - ---- -*** A fringe arrow in the "*Occur*" buffer indicates the selected match. - ---- -*** Occur mode may use a different type for 'occur-target' property values. -The value was previously always a marker set to the start of the first -match on the line but can now also be a list of '(BEGIN . END)' pairs -of markers delimiting each match on the line. -This is a fully compatible change to the internal occur-mode -implementation, and code creating their own occur-mode buffers will -work as before. - -** Emacs Lisp mode - ---- -*** The mode-line now indicates whether we're using lexical or dynamic scoping. - -+++ -*** A space between an open paren and a symbol changes the indentation rule. -The presence of a space between an open paren and a symbol now is -taken as a statement by the programmer that this should be indented -as a data list rather than as a piece of code. - -** Lisp Mode - -*** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'. -The mode provides refined highlighting of built-in functions, types, -and variables. - ---- -*** Lisp mode now uses 'common-lisp-indent-function'. -To revert to the previous behavior, -'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. - -** Change Logs and VC - -+++ -*** 'vc-revert-show-diff' now has a third possible value: 'kill'. -If this user option is 'kill', then the diff buffer will be killed -after the 'vc-revert' action instead of buried. - -*** More VC commands can be used from non-file buffers. -The relevant commands are those that don't change the VC state. -The non-file buffers which can use VC commands are those that have -their 'default-directory' under VC. - -*** New command 'vc-dir-root' uses the root directory without asking. - ---- -*** New face 'log-view-commit-body'. -This is used when expanding commit messages from 'vc-print-root-log' -and similar commands. - ---- -*** New faces for 'vc-dir' buffers. -Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory', -'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning', -'vc-dir-status-edited', 'vc-dir-status-up-to-date', -'vc-dir-status-ignored'. - ---- -*** The responsible VC backend is now the most specific one. -'vc-responsible-backend' loops over the backends in -'vc-handled-backends' to determine which backend is responsible for a -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'. - -*** Support for bookmark.el. -Bookmark locations can refer to VC directory buffers. - ---- -*** New user option 'vc-hg-create-bookmark'. -It controls whether a bookmark or branch will be created when you -invoke 'C-u C-x v s' ('vc-create-tag'). - ---- -*** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers. - ---- -*** New user option 'vc-git-revision-complete-only-branches'. -If non-nil, only branches and remotes are considered when doing -completion over Git branch names. The default is nil, which causes -tags to be considered as well. - ---- -*** New user option 'vc-git-log-switches'. -String or list of strings specifying switches for Git log under VC. - -*** Command 'vc-switch-backend' is now obsolete. -If you are still using it with any regularity, please file a bug -report with some details. - -** Gnus - -+++ -*** New user option 'gnus-topic-display-predicate'. -This can be used to inhibit the display of some topics completely. - -+++ -*** nnimap now supports the oauth2.el library. - -+++ -*** New Summary buffer sort options for extra headers. -The extra header sort option ('C-c C-s C-x') prompts for a header -and fails if no sort function has been defined. Sorting by -Newsgroups ('C-c C-s C-u') has been pre-defined. - -+++ -*** The '#' command in the Group and Summary buffer now toggles, -instead of sets, the process mark. - -+++ -*** New user option 'gnus-process-mark-toggle'. -If non-nil (the default), the '#' command in the Group and Summary -buffers will toggle, instead of set, the process mark. - - -+++ -*** New user option 'gnus-registry-register-all'. -If non-nil (the default), create registry entries for all messages. -If nil, don't automatically create entries, they must be created -manually. - -+++ -*** New user options to customise the summary line specs "%[" and "%]". -Four new options introduced in customisation group -'gnus-summary-format'. These are 'gnus-sum-opening-bracket', -'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and -'gnus-sum-closing-bracket-adopted'. Their default values are "[", "]", -"<", ">" respectively. These options control the appearance of "%[" -and "%]" specs in the summary line format. "%[" will normally display -the value of 'gnus-sum-opening-bracket', but can also be -'gnus-sum-opening-bracket-adopted' for the adopted articles. "%]" will -normally display the value of 'gnus-sum-closing-bracket', but can also -be 'gnus-sum-closing-bracket-adopted' for the adopted articles. - -+++ -*** New user option 'gnus-paging-select-next'. -This controls what happens when using commands like 'SPC' and 'DEL' to -page the current article. If non-nil (the default), go to the -next/prev article, but if nil, do nothing at the end/start of the article. - -+++ -*** New gnus-search library. -A new unified search syntax which can be used across multiple -supported search engines. Set 'gnus-search-use-parsed-queries' to -non-nil to enable. - -+++ -*** New value for user option 'smiley-style'. -Smileys can now be rendered with emojis instead of small images when -using the new 'emoji' value in 'smiley-style'. - -+++ -*** New user option 'gnus-agent-eagerly-store-articles'. -If non-nil (which is the default), the Gnus Agent will store all read -articles in the Agent cache. - -+++ -*** New user option 'gnus-global-groups'. -Gnus handles private groups differently from public (i.e., NNTP-like) -groups. Most importantly, Gnus doesn't download external images from -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 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 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'. - -+++ -*** New user option 'gnus-dbus-close-on-sleep'. -On systems with D-Bus support, it is now possible to register a signal -to close all Gnus servers before the system sleeps. - -+++ -*** The key binding of 'gnus-summary-search-article-forward' has changed. -This command was previously on 'M-s' and shadowed the global 'M-s' -search prefix. The command has now been moved to 'M-s M-s'. (For -consistency, the 'M-s M-r' key binding has been added for the -'gnus-summary-search-article-backward' command.) - ---- -*** The value for "all" in the 'large-newsgroup-initial' group parameter has changed. -It was previously nil, which didn't work, because nil is -indistinguishable from not being present. The new value for "all" is -the symbol 'all'. - -+++ -*** The name of dependent Gnus sessions has changed from "slave" to "child". -The names of the commands 'gnus-slave', 'gnus-slave-no-server' and -'gnus-slave-unplugged' have changed to 'gnus-child', -'gnus-child-no-server' and 'gnus-child-unplugged' respectively. - -+++ -*** The 'W Q' summary mode command now takes a numerical prefix to -allow adjusting the fill width. - -+++ -*** New variable 'mm-inline-font-lock'. -This variable is supposed to be bound by callers to determine whether -inline MIME parts (that support it) are supposed to be font-locked or -not. - -** Message - ---- -*** Respect 'message-forward-ignored-headers' more. -Previously, this user option would not be consulted if -'message-forward-show-mml' was nil and forwarding as MIME. - -+++ -*** New user option 'message-forward-included-mime-headers'. -This is used when forwarding messages as MIME, but not using MML. - -+++ -*** Message now supports the OpenPGP header. -To generate these headers, add the new function -'message-add-openpgp-header' to 'message-send-hook'. The header will -be generated according to the new 'message-openpgp-header' user -option. - ---- -*** A change to how "Mail-Copies-To: never" is handled. -If a user has specified "Mail-Copies-To: never", and Message was asked -to do a "wide reply", some other arbitrary recipient would end up in -the resulting "To" header, while the remaining recipients would be put -in the "Cc" header. This is somewhat misleading, as it looks like -you're responding to a specific person in particular. This has been -changed so that all the recipients are put in the "To" header in these -instances. - -+++ -*** New command to start Emacs in Message mode to send an email. -Emacs can be defined as a handler for the "x-scheme-handler/mailto" -MIME type with the following command: "emacs -f message-mailto %u". -An "emacs-mail.desktop" file has been included, suitable for -installing in desktop directories like "/usr/share/applications" or -"~/.local/share/applications". -Clicking on a 'mailto:' link in other applications will then open -Emacs with headers filled out according to the link, e.g. -"mailto:larsi@gnus.org?subject=This+is+a+test". If you prefer -emacsclient, use "emacsclient -e '(message-mailto "%u")'" -or "emacsclient-mail.desktop". - ---- -*** Change to default value of 'message-draft-headers' user option. -The 'Date' symbol has been removed from the default value, meaning that -draft or delayed messages will get a date reflecting when the message -was sent. To restore the original behavior of dating a message -from when it is first saved or delayed, add the symbol 'Date' back to -this user option. - -+++ -*** New command to take screenshots. -In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot') -command has been added. It depends on using an external program to -take the actual screenshot, and defaults to "ImageMagick import". - -** Smtpmail - -+++ -*** smtpmail now supports using the oauth2.el library. - -+++ -*** New user option 'smtpmail-store-queue-variables'. -If non-nil, SMTP variables will be stored together with the queued -messages, and will then be used when sending with -'M-x smtpmail-send-queued-mail'. - -+++ -*** Allow direct selection of smtp authentication mechanism. -A server entry retrieved by auth-source can request a desired smtp -authentication mechanism by setting a value for the key 'smtp-auth'. - -** ElDoc - -+++ -*** New user option 'eldoc-echo-area-display-truncation-message'. -If non-nil (the default), eldoc will display a message saying -something like "(Documentation truncated. Use `M-x eldoc-doc-buffer' -to see rest)" when a message has been truncated. If nil, truncated -messages will be marked with just "..." at the end. - -+++ -*** New hook 'eldoc-documentation-functions'. -This hook is intended to be used for registering doc string functions. -These functions don't need to produce the doc string right away, they -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 -if some of those functions are synchronous and some asynchronous. -The user option replaces 'eldoc-documentation-function', which is now -obsolete. - -*** 'eldoc-echo-area-use-multiline-p' is now handled by ElDoc. -The user option 'eldoc-echo-area-use-multiline-p' is now handled -by the ElDoc library itself. Functions in -'eldoc-documentation-functions' don't need to worry about consulting -it when producing a doc string. - -** Tramp - -+++ -*** New connection method "mtp". -It allows accessing media devices like cell phones, tablets or -cameras. - -+++ -*** New connection method "sshfs". -It allows accessing remote files via a file system mounted with -'sshfs'. - -+++ -*** Tramp supports SSH authentication via a hardware security key now. -This requires at least OpenSSH 8.2, and a FIDO U2F compatible -security key, like yubikey, solokey, or nitrokey. - -+++ -*** Trashed remote files are moved to the local trash directory. -All remote files that are trashed are moved to the local trash -directory, except remote encrypted files, which are always deleted. - -+++ -*** New command 'tramp-crypt-add-directory'. -This command marks a remote directory to contain only encrypted files. -See the "(tramp) Keeping files encrypted" node of the Tramp manual for -details. This feature is experimental. - -+++ -*** Support of direct asynchronous process invocation. -When Tramp connection property "direct-async-process" is set to -non-nil for a given connection, 'make-process' and 'start-file-process' -calls are performed directly as in "ssh ... <command>". This avoids -initialization performance penalties. See the "(tramp) Improving -performance of asynchronous remote processes" node of the Tramp manual -for details, and also for a discussion or restrictions. This feature -is experimental. - -+++ -*** New user option 'tramp-debug-to-file'. -When non-nil, this user option instructs Tramp to mirror the debug -buffer to a file under the "/tmp/" directory. This is useful, if (in -rare cases) Tramp blocks Emacs, and we need further debug information. - -+++ -*** Tramp supports lock files now. -In order to deactivate this, set user option -'remote-file-name-inhibit-locks' to t. - -+++ -*** Writing sensitive data locally requires confirmation. -Writing auto-save, backup or lock files to the local temporary -directory must be confirmed. In order to suppress this confirmation, -set user option 'tramp-allow-unsafe-temporary-files' to t. - -+++ -*** 'make-directory' of a remote directory honors the default file modes. - -** gdb-mi - -*** New user option 'gdb-registers-enable-filter'. -If non-nil, apply a register filter based on -'gdb-registers-filter-pattern-list'. - -+++ -*** gdb-mi can now save and restore window configurations. -Use 'gdb-save-window-configuration' to save window configuration to a -file and 'gdb-load-window-configuration' to load from a file. These -commands can also be accessed through the menu bar under "Gud => -GDB-Windows". 'gdb-default-window-configuration-file', when non-nil, -is loaded when GDB starts up. - -+++ -*** gdb-mi can now restore window configuration after quitting. -Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs -will remember the window configuration before GDB started and restore -it after GDB quits. A toggle button is also provided under "Gud => -GDB-Windows" menu item. - -+++ -*** gdb-mi now has a better logic for displaying source buffers. -Now GDB only uses one source window to display source file by default. -Customize 'gdb-max-source-window-count' to use more than one window. -Control source file display by 'gdb-display-source-buffer-action'. - -+++ -*** The default value of 'gdb-mi-decode-strings' is now t. -This means that the default coding-system is now used to decode strings -and source file names from GDB. - -** Compilation mode - ---- -*** New function 'ansi-color-compilation-filter'. -This function is meant to be used in 'compilation-filter-hook'. - ---- -*** New user option 'ansi-color-for-compilation-mode'. -This controls what 'ansi-color-compilation-filter' does. - -*** Regexp matching of messages is now case-sensitive by default. -The variable 'compilation-error-case-fold-search' can be set for -case-insensitive matching of messages when the old behavior is -required, but the recommended solution is to use a correctly matching -regexp instead. - ---- -*** New user option 'compilation-search-all-directories'. -When doing parallel builds, directories and compilation errors may -arrive in the "*compilation*" buffer out-of-order. If this option is -non-nil (the default), Emacs will now search backwards in the buffer -for any directory the file with errors may be in. If nil, this won't -be done (and this restores how this previously worked). - ---- -*** Messages from ShellCheck are now recognized. - ---- -*** Messages from Visual Studio that mention column numbers are now recognized. - -** Hi Lock mode - ---- -*** Matching in 'hi-lock-mode' can be case-sensitive. -The matching is case-sensitive when a regexp contains upper case -characters and 'search-upper-case' is non-nil. 'highlight-phrase' -also uses 'search-whitespace-regexp' to substitute spaces in regexp -search. - ---- -*** The default value of 'hi-lock-highlight-range' was enlarged. -The new default value is 2000000 (2 megabytes). - -** Whitespace mode - -+++ -*** New style 'missing-newline-at-eof'. -If present in 'whitespace-style' (as it is by default), the final -character in the buffer will be highlighted if the buffer doesn't end -with a newline. - ---- -*** The default 'whitespace-enable-predicate' predicate has changed. -It used to check elements in the list version of -'whitespace-global-modes' with 'eq', but now uses 'derived-mode-p'. - -** Texinfo - ---- -*** New user option 'texinfo-texi2dvi-options'. -This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'. - ---- -*** New commands for moving in and between environments. -An "environment" is something that ends with '@end'. The commands are -'C-c C-c C-f' (next end), 'C-c C-c C-b' (previous end), -'C-c C-c C-n' (next start) and 'C-c C-c C-p' (previous start), as well -as 'C-c .', which will alternate between the start and the end of the -current environment. - -** Rmail - ---- -*** New user option 'rmail-re-abbrevs'. -Its default value matches localized abbreviations of the "reply" -prefix on the Subject line in various languages. - ---- -*** New user option 'rmail-show-message-set-modified'. -If set non-nil, showing an unseen message will set the Rmail buffer's -modified flag. The default is nil, to preserve the old behavior. - -** CC Mode - -+++ -*** Added support for Doxygen documentation style. -'doxygen' is now a valid 'c-doc-comment-style' which recognises all -comment styles supported by Doxygen (namely '///', '//!', '/** … */' -and '/*! … */'. 'gtkdoc' remains the default for C and C++ modes; to -use 'doxygen' by default one might evaluate: - - (setq-default c-doc-comment-style - '((java-mode . javadoc) - (pike-mode . autodoc) - (c-mode . doxygen) - (c++-mode . doxygen))) - -or use it in a custom 'c-style'. - -+++ -*** Added support to line up '?' and ':' of a ternary operator. -The new 'c-lineup-ternary-bodies' function can be used as a lineup -function to align question mark and colon which are part of a ternary -operator ('?:'). For example: - - return arg % 2 == 0 ? arg / 2 - : (3 * arg + 1); - -To enable, add it to appropriate entries in 'c-offsets-alist', e.g.: - - (c-set-offset 'arglist-cont '(c-lineup-ternary-bodies - c-lineup-gcc-asm-reg)) - (c-set-offset 'arglist-cont-nonempty '(c-lineup-ternary-bodies - c-lineup-gcc-asm-reg - c-lineup-arglist)) - (c-set-offset 'statement-cont '(c-lineup-ternary-bodies +)) - -** Images - ---- -*** You can explicitly specify base_uri for svg images. -':base-uri' image property can be used to explicitly specify base_uri -for embedded images into svg. ':base-uri' is supported for both file -and data svg images. - -+++ -*** 'svg-embed-base-uri-image' added to embed images. -'svg-embed-base-uri-image' can be used to embed images located -relatively to 'file-name-directory' of the ':base-uri' svg image property. -This works much faster then 'svg-embed'. - -+++ -*** New function 'image-cache-size'. -This function returns the size of the current image cache, in bytes. - ---- -*** Animated images stop automatically under high CPU pressure sooner. -Previously, an animated image would stop animating if any single image -took more than two seconds to display. The new algorithm maintains a -decaying average of delays, and if this number gets too high, the -animation is stopped. - -+++ -*** The 'n' and 'p' commands (next/previous image) now respect Dired order. -These commands would previously display the next/previous image in -lexicographic order, but will now find the "parent" Dired buffer and -select the next/previous image file according to how the files are -sorted there. The commands have also been extended to work when the -"parent" buffer is an archive mode (i.e., zip file or the like) or tar -mode buffer. - ---- -*** 'image-converter' is now restricted to formats in 'auto-mode-alist'. -When using external image converters, the external program is queried -for what formats it supports. This list may contain formats that are -problematic in some contexts (like PDFs), so this list is now filtered -based on 'auto-mode-alist'. Only file names that map to 'image-mode' -are now supported. - ---- -*** The background and foreground of images now default to face colors. -When an image doesn't specify a foreground or background color, Emacs -now uses colors from the face used to draw the surrounding text -instead of the frame's default colors. - -To load images with the default frame colors use the ':foreground' and -':background' image attributes, for example: - - (create-image "filename" nil nil - :foreground (face-attribute 'default :foreground) - :background (face-attribute 'default :background)) - -This change only affects image types that support foreground and -background colors or transparency, such as xbm, pbm, svg, png and gif. - -+++ -*** Image smoothing can now be explicitly enabled or disabled. -Smoothing applies a bilinear filter while scaling or rotating an image -to prevent aliasing and other unwanted effects. The new image -property ':transform-smoothing' can be set to t to force smoothing -and nil to disable smoothing. - -The default behavior of smoothing on down-scaling and not smoothing -on up-scaling remains unchanged. - -+++ -*** New user option 'image-transform-smoothing'. -This controls whether to use smoothing or not for an image. Values -include nil (no smoothing), t (do smoothing) or a predicate function -that's called with the image object and should return nil/t. - -+++ -*** SVG images now support user stylesheets. -The ':css' image attribute can be used to override the default CSS -stylesheet for an image. The default sets 'font-family' and -'font-size' to match the current face, so an image with 'height="1em"' -will match the font size in use where it is embedded. - -This feature relies on librsvg 2.48 or above being available. - -+++ -*** Image properties support 'em' sizes. -Size image properties, for example ':height', ':max-height', etc., can -be given a cons of the form '(SIZE . em)', where SIZE is an integer or -float which is multiplied by the font size to calculate the image -size, and 'em' is a symbol. - -** EWW - -+++ -*** New user option 'eww-use-browse-url'. -This is a regexp that can be set to alter how links are followed in eww. - -+++ -*** New user option 'eww-retrieve-command'. -This can be used to download data via an external command. If nil -(the default), then 'url-retrieve' is used. When 'sync', then -'url-retrieve-synchronously' is used. - -+++ -*** New Emacs command line convenience command. -The 'eww-browse' command has been added, which allows you to register -Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the -supplied URL. Usage example: "emacs -f eww-browse https://gnu.org". - -+++ -*** 'eww-download-directory' will now use the XDG location, if defined. -However, if "~/Downloads/" already exists, that will continue to be -used. - ---- -*** The command 'eww-follow-link' now supports custom mailto: handlers. -The function that is invoked when clicking on or otherwise following a -'mailto:' link in an EWW buffer can now be customized. For more -information, see the related entry about 'shr-browse-url' below. - ---- -*** Support for bookmark.el. -The command 'bookmark-set' (bound to 'C-x r m') is now supported, and -will create a bookmark that opens the current URL in EWW. - -** SHR - ---- -*** The command 'shr-browse-url' now supports custom mailto handlers. -Clicking on or otherwise following a 'mailto:' link in an HTML buffer -rendered by SHR previously invoked the command 'browse-url-mailto'. -This is still the case by default, but if you customize -'browse-url-mailto-function' or 'browse-url-handlers' to call some -other function, it will now be called instead of the default. - ---- -*** New user option 'shr-offer-extend-specpdl'. -If this is nil, rendering of HTML that requires enlarging -'max-specpdl-size', the number of Lisp variable bindings, will be -aborted, and Emacs will not ask you whether to enlarge -'max-specpdl-size' to complete the rendering. The default is t, which -preserves the original behavior. - -+++ -*** New user option 'shr-max-width'. -If this user option is non-nil, and 'shr-width' is nil, then SHR will -use the value of 'shr-max-width' to limit the width of the rendered -HTML. The default is 120 characters, so even if you have very wide -frames, HTML text will be rendered more narrowly, which usually leads -to a more readable text. Customize it to nil to get the previous -behavior of rendering as wide as the 'window-width' allows. If -'shr-width' is non-nil, it overrides this option. - ---- -*** New faces for heading elements. -Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'. - -** Project - ---- -*** New user option 'project-vc-merge-submodules'. - ---- -*** Project commands now have their own history. -Previously used project directories are now suggested by all commands -that prompt for a project directory. - -+++ -*** New prefix keymap 'project-prefix-map'. -Key sequences that invoke project-related commands start with the -prefix 'C-x p'. Type 'C-x p C-h' to show the full list. - -+++ -*** New commands 'project-dired', 'project-vc-dir', 'project-shell', -'project-eshell'. These commands run Dired/VC-Dir and Shell/Eshell in -a project's root directory, respectively. - -+++ -*** New command 'project-compile'. -This command runs compilation in the current project's root directory. - -+++ -*** New command 'project-switch-project'. -This command lets you "switch" to another project and run a project -command chosen from a dispatch menu. - -+++ -*** New commands 'project-shell-command' and 'project-async-shell-command'. -These commands run 'shell-command' and 'async-shell-command' in a -project's root directory, respectively. - -+++ -*** New user option 'project-list-file'. -This specifies the file in which to save the list of known projects. - -+++ -*** New command 'project-remember-projects-under'. -This command can automatically locate and index projects in a -directory and optionally also its subdirectories, storing them in -'project-list-file'. - -+++ -*** New commands 'project-forget-project' and 'project-forget-projects-under'. -These commands let you interactively remove entries from the list of projects -in 'project-list-file'. - -+++ -*** New command 'project-forget-zombie-projects'. -This command detects indexed projects that have since been deleted, -and removes them from the list of known projects in 'project-list-file'. - ---- -*** 'project-find-file' now accepts non-existent file names. -This is to allow easy creation of files inside some nested -sub-directory. - -+++ -*** 'project-find-file' doesn't use the string at point as default input. -Now it's only suggested as part of the "future history", accessible -via 'M-n'. - -+++ -*** New command 'project-find-dir' runs Dired in a directory inside project. +*** Support for ANSI 256-color and 24-bit colors, italic and other fonts. +Term-mode can now display 256-color and 24-bit color codes. It can +also handle ANSI codes for faint, italic and blinking text, displaying +it with new 'term-{faint,italic,slow-blink,fast-blink}' faces. ** Xref ---- -*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer. -So typing 'C-u RET' in the "*xref*" buffer quits its window -before navigating to the selected location. +*** 'project-find-file' and 'project-or-external-find-file' now accept +a prefix argument which is interpreted to mean "include all files". +++ -*** New user options to automatically show the first Xref match. -The new user option 'xref-auto-jump-to-first-definition' controls the -behavior of 'xref-find-definitions' and its variants, like -'xref-find-definitions-other-window': if it's t or 'show', the first -match is automatically displayed; if it's 'move', point in the -"*xref*" buffer is automatically moved to the first match without -displaying it. -The new user option 'xref-auto-jump-to-first-xref' changes the -behavior of Xref commands such as 'xref-find-references', -'xref-find-apropos', and 'project-find-regexp', which are expected to -display many matches that the user would like to -visit. 'xref-auto-jump-to-first-xref' changes their behavior much in -the same way as 'xref-auto-jump-to-first-definition' affects the -"find-definitions" commands. +*** New command 'xref-go-forward'. +It is bound to 'C-M-,' and jumps to the location where 'xref-go-back' +('M-,', also known as 'xref-pop-marker-stack') was invoked previously. ---- -*** New user options 'xref-search-program' and 'xref-search-program-alist'. -So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better -performance in certain cases, in particular for case-insensitive -searches. - -+++ -*** New commands 'xref-prev-group' and 'xref-next-group'. -These commands are bound respectively to 'P' and 'N', and navigate to -the first item of the previous or next group in the "*xref*" buffer. - ---- -*** New alternative value for 'xref-show-definitions-function': -'xref-show-definitions-completing-read'. - ---- -*** The two existing alternatives for 'xref-show-definitions-function' -have been renamed to have "proper" public names and documented -('xref-show-definitions-buffer' and -'xref-show-definitions-buffer-at-bottom'). - -+++ -*** New command 'xref-quit-and-pop-marker-stack'. -This command is bound to 'M-,' in "*xref*" buffers. This combination -is easy to press semi-accidentally if the user wants to go back in the -middle of choosing the exact definition to go to, and this should do -TRT. - ---- -*** New value 'project-relative' for 'xref-file-name-display'. -If chosen, file names in "*xref*" buffers will be displayed relative -to the 'project-root' of the current project, when available. - -+++ -*** The 'TAB' key binding in "*xref*" buffers is obsolete. -Use 'C-u RET' instead. The 'TAB' binding in "*xref*" buffers is still -supported, but we plan on removing it in a future version; at that -time, the command 'xref-quit-and-goto-xref' will no longer have a key -binding in 'xref--xref-buffer-mode-map'. - ---- -*** New user option 'etags-xref-prefer-current-file'. -When non-nil, matches for identifiers in the file visited by the -current buffer will be shown first in the "*xref*" buffer. - -+++ -*** The etags Xref backend now honors 'tags-apropos-additional-actions'. -You can customize it to augment the output of 'xref-find-apropos', -like it affected the output of 'tags-apropos', which is obsolete since -Emacs 25.1. - -** Battery - ---- -*** UPower is now the default battery status backend when available. -UPower support via the function 'battery-upower' was added in Emacs -26.1, but was disabled by default. It is now the default value of -'battery-status-function' when the system provides a UPower D-Bus -service. The user options 'battery-upower-device' and -'battery-upower-subscribe' control which power sources to query and -whether to respond to status change notifications in addition to -polling, respectively. - ---- -*** A richer syntax can be used to format battery status information. -The user options 'battery-mode-line-format' and -'battery-echo-area-format' now support the full formatting syntax of -the function 'format-spec' documented under node "(elisp) Custom Format -Strings". The new syntax includes specifiers for padding and -truncation, amongst other things. - -** bug-reference.el - ---- -*** Bug reference mode uses auto-setup. -If 'bug-reference-mode' or 'bug-reference-prog-mode' have been -activated, their respective hook has been run, and both -'bug-reference-bug-regexp' and 'bug-reference-url-format' are still -not set, it tries to guess appropriate values for those two variables. -There are three guessing mechanisms so far: based on version control -information of the current buffer's file, based on -newsgroup/mail-folder name and several news and mail message headers -in Gnus buffers, and based on IRC channel and network in rcirc and ERC -buffers. All the mechanisms are extensible with custom rules, see the -variables 'bug-reference-setup-from-vc-alist', -'bug-reference-setup-from-mail-alist', and -'bug-reference-setup-from-irc-alist'. - -** HTML Mode - ---- -*** A new skeleton for adding relative URLs has been added. -It's bound to the 'C-c C-c f' keystroke, and prompts for a local file -name. - -** Widget - -+++ -*** 'widget-choose' now supports menus in extended format. - ---- -*** The 'editable-list' widget now supports moving items up and down. -You can now move items up and down by deleting and then reinserting -them, using the 'DEL' and 'INS' buttons respectively. This is useful -in Custom buffers, for example, to change the order of the elements in -a list. - -** Diff - ---- -*** New face 'diff-changed-unspecified'. -This is used to highlight "changed" lines (those marked with '!') in -context diffs, when 'diff-use-changed-face' is non-nil. - ---- -*** New 'diff-mode' font locking face 'diff-error'. -This face is used for error messages from 'diff'. - -+++ -*** New command 'diff-refresh-hunk'. -This new command (bound to 'C-c C-l') regenerates the current hunk. - -** thing-at-point - -+++ -*** New 'thing-at-point' target: 'existing-filename'. -This is like 'filename', but is a full path, and is nil if the file -doesn't exist. - -+++ -*** New 'thing-at-point' target: 'string'. -If point is inside a string, it returns that string. +** File notifications +++ -*** New variable 'thing-at-point-provider-alist'. -This allows mode-specific alterations to how 'thing-at-point' works. +*** The new command 'file-notify-rm-all-watches' removes all file notifications. ---- -*** thing-at-point now respects fields. -'thing-at-point' (and all functions that use it, like -'symbol-at-point') will narrow to the current field (if any) before -trying to identify the thing at point. +** Sql --- -*** New function 'thing-at-mouse'. -This is like 'thing-at-point', but uses the mouse event position instead. +*** Sql now supports sending of passwords in-process. +To improve security, if an sql product has ':password-in-comint' set +to t, a password supplied via the minibuffer will be sent in-process, +as opposed to via the command-line. ** Image-Dired +++ -*** New user option 'image-dired-thumb-visible-marks'. -If non-nil (the default), use the new face 'image-dired-thumb-mark' -for marked images. - ---- -*** New command 'image-dired-delete-marked'. - ---- -*** 'image-dired-mouse-toggle-mark' is now sensitive to the active region. -If the region is active, this command now toggles Dired marks of all -the thumbnails in the region. - -** Flymake mode - -+++ -*** New command 'flymake-show-project-diagnostics'. -This lists all diagnostics for buffers in the currently active -project. The listing is similar to the one obtained by -'flymake-show-buffer-diagnostics', but adds a column for the -project-relative file name. For backends which support it, -'flymake-show-project-diagnostics' also lists diagnostics for files -that have not yet been visited. - -+++ -*** New user options to customize Flymake's mode-line. -The new user option 'flymake-mode-line-format' is a mix of strings and -symbols like 'flymake-mode-line-title', 'flymake-mode-line-exception' -and 'flymake-mode-line-counters'. The new user option -'flymake-mode-line-counter-format' is a mix of strings and symbols -like 'flymake-mode-line-error-counter', -'flymake-mode-line-warning-counter' and 'flymake-mode-line-note-counter'. - -** Time - ---- -*** 'display-time-world' has been renamed to 'world-clock'. -'world-clock' creates a buffer with an updating time display using -several time zones. It is hoped that the new names are more -discoverable. - -The following commands have been renamed: - - 'display-time-world' to 'world-clock' - 'display-time-world-mode' to 'world-clock-mode' - 'display-time-world-display' to 'world-clock-display' - 'display-time-world-timer' to 'world-clock-update' - -The following user options have been renamed: - - 'display-time-world-list' to 'world-clock-list' - 'display-time-world-time-format' to 'world-clock-time-format' - 'display-time-world-buffer-name' to 'world-clock-buffer-name' - 'display-time-world-timer-enable' to 'world-clock-timer-enable' - 'display-time-world-timer-second' to 'world-clock-timer-second' - -The old names are now obsolete. - ---- -*** 'world-clock-mode' can no longer be turned on interactively. -Use 'world-clock' to turn on that mode. - -** Python mode - ---- -*** New user option 'python-forward-sexp-function'. -This allows the user easier customization of whether to use block-based -navigation or not. - ---- -*** 'python-shell-interpreter' now defaults to python3 on systems with python3. - ---- -*** 'C-c C-r' can now be used on arbitrary regions. -The command previously extended the start of the region to the start -of the line, but will now actually send the marked region, as -documented. - -** Ruby Mode - ---- -*** 'ruby-use-smie' is declared obsolete. -SMIE is now always enabled and 'ruby-use-smie' only controls whether -indentation is done using SMIE or with the old ad-hoc code. - ---- -*** Indentation has changed when 'ruby-align-chained-calls' is non-nil. -This previously used to align subsequent lines with the last sibling, -but it now aligns with the first sibling (which is the preferred style -in Ruby). - -** CPerl Mode - ---- -*** New face 'perl-heredoc', used for heredoc elements. - ---- -*** The command 'cperl-set-style' offers the new value "PBP". -This value customizes Emacs to use the style recommended in Damian -Conway's book "Perl Best Practices" for indentation and formatting -of conditionals. - -** Perl mode - ---- -*** New face 'perl-non-scalar-variable'. -This is used to fontify non-scalar variables. - -** Octave Mode - -+++ -*** Line continuations in double-quoted strings now use a backslash. -Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows -the behavior introduced in Octave 3.8 of using a backslash as a line -continuation marker within double-quoted strings, and an ellipsis -everywhere else. - -+++ -** EasyPG -GPG key servers can now be queried for keys with the -'M-x epa-search-keys' command. Keys can then be added to your -personal key ring. - -** Etags - -+++ -*** Etags now supports the Mercury programming language. -See https://mercurylang.org. - -+++ -*** Etags command line option '--declarations' now has Mercury-specific behavior. -All Mercury declarations are tagged by default. However, for -compatibility with 'etags' support for Prolog, predicates and -functions appearing first in clauses will also be tagged if 'etags' is -invoked with the '--declarations' command-line option. - -** Comint - -+++ -*** Support for OSC escape sequences. -Adding the new 'comint-osc-process-output' to -'comint-output-filter-functions' enables the interpretation of OSC -("Operating System Command") escape sequences in comint buffers. By -default, only OSC 8, for hyperlinks, and OSC 7, for directory -tracking, are acted upon. Adding more entries to -'comint-osc-handlers' allows a customized treatment of further escape -sequences. - -+++ -*** 'comint-delete-output' can now save deleted text in the kill-ring. -Interactively, 'C-u C-c C-o' triggers this new optional behavior. - -** ansi-color.el - ---- -*** Colors are now defined by faces. -ANSI SGR codes now have corresponding faces to describe their -appearance, e.g. 'ansi-color-bold'. +*** 'image-dired-display-image-mode' is now based on 'image-mode'. +This avoids converting images in the background, and makes Image-Dired +noticeably faster. New keybindings from 'image-mode' are now +available in the "*image-dired-display-image*" buffer; press '?' or +'h' in that buffer to see the full list. Finally, some commands and +user options that are no longer needed are now obsolete: +'image-dired-cmd-create-temp-image-options', +'image-dired-cmd-create-temp-image-program', +'image-dired-display-current-image-full', +'image-dired-display-current-image-sized', +'image-dired-display-window-height-correction', +'image-dired-display-window-width-correction', +'image-dired-temp-image-file'. --- -*** Support for "bright" color codes. -"Bright" ANSI color codes are now displayed when applying ANSI color -filters using the color values defined by the faces -'ansi-color-bright-COLOR'. In addition, bold text with regular ANSI -colors can be displayed as "bright" if 'ansi-color-bold-is-bright' is -non-nil. - -** ERC - -*** Starting with Emacs 28.1 and ERC 5.4, see the ERC-NEWS file for -user-visible changes in ERC. - -** xwidget-webkit mode - ---- -*** New xwidget commands. -'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title' -(return the current title), and 'xwidget-webkit-goto-history' (goto a -point in history). - ---- -*** Downloading files from xwidget-webkit is now supported. -The new user option 'xwidget-webkit-download-dir' says where to download to. - ---- -*** New command 'xwidget-webkit-clone-and-split-below'. -Open a new window below displaying the current URL. - ---- -*** New command 'xwidget-webkit-clone-and-split-right'. -Open a new window to the right displaying the current URL. +*** Reduce dependency on external "exiftool" command. +The 'image-dired-copy-with-exif-file-name' no longer requires an +external "exiftool" command to be available. The user options +'image-dired-cmd-read-exif-data-program' and +'image-dired-cmd-read-exif-data-options' are now obsolete. --- -*** Pixel-based scrolling. -The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands -now supports scrolling arbitrary pixel values. It now treats the -optional 2nd argument as the pixel values to scroll. +*** New command for the thumbnail buffer. +The new command 'image-dired-unmark-all-marks' has been added. It is +bound to "U" in the thumbnail buffer. --- -*** New commands for scrolling. -The new commands 'xwidget-webkit-scroll-up-line', -'xwidget-webkit-scroll-down-line', 'xwidget-webkit-scroll-forward', -'xwidget-webkit-scroll-backward' can be used to scroll webkit by the -height of lines or width of chars. +*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020). +This standard allows sharing generated thumbnails across different +programs. Version 0.9.0 adds two larger thumbnail sizes: 512x512 and +1024x1024 pixels. See the user option `image-dired-thumbnail-storage' +to use it; it is not enabled by default. --- -*** New user option 'xwidget-webkit-bookmark-jump-new-session'. -When non-nil, use a new xwidget webkit session after bookmark jump. -Otherwise, it will use 'xwidget-webkit-last-session'. - -** Checkdoc - ---- -*** No longer warns about command substitutions by default. -Checkdoc used to warn about "too many command substitutions" (as in -"\\[foo-command]"), even if you only used ten of them in a docstring. -On modern machines, you can have hundreds or thousands of command -substitutions before it becomes a performance issue, so this warning -is now disabled by default. To re-enable this warning, customize the -user option 'checkdoc-max-keyref-before-warn'. - ---- -*** New user option 'checkdoc-column-zero-backslash-before-paren'. -Checkdoc warns if there is a left parenthesis in column zero of a -documentation string. That warning can now be disabled by customizing -this new user option to nil. This is useful if you don't expect -your code to be edited with an Emacs older than version 27.1. - ---- -*** Now checks the prompt format for 'yes-or-no-p'. -In addition to verifying the format of the prompt for 'y-or-n-p', -checkdoc will now check the format of 'yes-or-no-p'. - ---- -*** New command 'checkdoc-dired'. -This can be used to run checkdoc on files from a Dired buffer. - ---- -*** No longer checks for 'A-' modifiers. -Checkdoc recommends usage of command substitutions ("\\[foo-command]") -in favor of writing keybindings like 'C-c f'. It now no longer warns -about the 'A-' modifier as it is not used very much in practice, and -this warning therefore mostly led to false positives. - -** Enriched mode - ---- -*** 'C-a' is by default no longer bound to 'beginning-of-line-text'. -This is so 'C-a' works as in other modes, and in particular holding -Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. - -** Gravatar - ---- -*** New user option 'gravatar-service' for host to query for gravatars. -Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. - -** MH-E mail handler for Emacs - -Functions and variables related to handling junk mail have been -renamed to not associate color with sender quality. - -+++ -*** New names for mh-junk interactive functions. -Function 'mh-junk-whitelist' is renamed 'mh-junk-allowlist'. -Function 'mh-junk-blacklist' is renamed 'mh-junk-blocklist'. - -+++ -*** New binding for 'mh-junk-allowlist'. -The key binding for 'mh-junk-allowlist' is changed from 'J w' to 'J a'. -The old binding is supported but warns that it is obsolete. - -+++ -*** New names for some hooks. -'mh-whitelist-msg-hook' is renamed 'mh-allowlist-msg-hook'. -'mh-blacklist-msg-hook' is renamed 'mh-blocklist-msg-hook'. - -+++ -*** New names for some user options. -User option 'mh-whitelist-preserves-sequences-flag' is renamed -'mh-allowlist-preserves-sequences-flag'. - -+++ -*** New names for some faces. -Face 'mh-folder-blacklisted' is renamed 'mh-folder-blocklisted'. -Face 'mh-folder-whitelisted' is renamed 'mh-folder-allowlisted'. - -** Rcirc - -+++ -*** rcirc now supports SASL authentication. - ---- -*** #emacs on Libera.chat has been added to 'rcirc-server-alist'. - ---- -*** rcirc connects asynchronously. - ---- -*** Integrate formatting into 'rcirc-send-string'. -The function now accepts a variable number of arguments. - -+++ -*** Deprecate 'rcirc-command' in favor of 'rcirc-define-command'. -The new macro handles multiple and optional arguments. - ---- -*** Add basic IRCv3 support. -This includes support for the capabilities: 'server-time', 'batch', -'message-ids', 'invite-notify', 'multi-prefix' and 'standard-replies'. - ---- -*** Add mouse property support to 'rcirc-track-minor-mode'. - ---- -*** Improve support for IRC markup codes. - ---- -*** Check 'auth-sources' for server passwords. - -+++ -*** Implement repeated reconnection strategy. -See 'rcirc-reconnect-attempts'. - -** MPC +*** Support GraphicsMagick command line tools. +Support for the GraphicsMagick command line tool ("gm") has been +added, and is used instead of ImageMagick when it is available. --- -*** New command 'mpc-goto-playing-song'. -This command, bound to 'o' in any 'mpc-mode' buffer, moves point to -the currently playing song in the "*MPC-Songs*" buffer. +*** New face 'image-dired-thumb-flagged'. +If 'image-dired-thumb-mark' is non-nil (the default), this face is +used for images that are flagged for deletion in the Dired buffer +associated with Image-Dired. --- -*** New user option 'mpc-cover-image-re'. -If non-nil, it is a regexp that should match a valid cover image. - -** Miscellaneous - ---- -*** 'shell-script-mode' now supports 'outline-minor-mode'. -The outline headings have lines that start with "###". - ---- -*** fileloop will now skip missing files instead of signalling an error. - ---- -*** 'tabulated-list-mode' can now restore original display order. -Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', -and that mode allows the user to sort on any column. There was -previously no easy way to get back to the original displayed order -after sorting, but giving a -1 numerical prefix to the sorting command -will now restore the original order. - ---- -*** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'. - ---- -*** New variable 'hl-line-overlay-priority'. -This can be used to change the priority of the hl-line overlays. +*** Support for bookmark.el. +The command 'bookmark-set' (bound to 'C-x r m') is now supported in +the thumbnail view, and will create a bookmark that opens the current +directory in Image-Dired. +++ -*** New command 'mailcap-view-file'. -This command will open a viewer based on the file type, as determined -by "~/.mailcap" and related files and variables. - ---- -*** New user option 'remember-diary-regexp'. - ---- -*** New user option 'remember-text-format-function'. +*** 'image-dired-show-all-from-dir-max-files' has been increased to 500. +This option controls asking for confirmation when starting Image-Dired +in a directory with many files. However, Image-Dired creates +thumbnails in the background these days, so this is not as important +as it used to be, back when entering a large directory could lock up +Emacs for tens of seconds. In addition, you can now customize this +option to nil to disable this confirmation completely. --- -*** New user option 'authinfo-hide-elements'. -This can be set to nil to inhibit hiding passwords in ".authinfo" files. +*** Make 'image-dired-rotate-thumbnail-(left|right)' obsolete. +Instead, use 'M-x image-dired-refresh-thumb' to generate a new +thumbnail, or 'M-x image-rotate' to rotate the thumbnail without +updating the thumbnail file. ---- -*** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'. -Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll -up/down an entire window, but they now work more like the standard -scrolling commands. - ---- -*** New user option 'bibtex-unify-case-function'. -This new option allows the user to customize how case is converted -when unifying entries. - ---- -*** The user option 'bibtex-maintain-sorted-entries' now permits -user-defined sorting schemes. - ---- -*** New user option 'reveal-auto-hide'. -If non-nil (the default), revealed text is automatically hidden when -point leaves the text. If nil, the text is not hidden again. Instead -'M-x reveal-hide-revealed' can be used to hide all the revealed text. - ---- -*** New user option 'ffap-file-name-with-spaces'. -If non-nil, 'find-file-at-point' and friends will try to guess more -expansively to identify a file name with spaces. Default value is -nil. - ---- -*** Two new commands for centering in 'doc-view-mode'. -The new commands 'doc-view-center-page-horizontally' (bound to 'c h') -and 'doc-view-center-page-vertically' (bound to 'c v') center the page -horizontally and vertically, respectively. - ---- -*** 'tempo-define-template' can now re-assign templates to tags. -Previously, assigning a new template to an already defined tag had no -effect. +** Dired --- -*** The width of the buffer-name column in 'list-buffers' is now dynamic. -The width now depends on the width of the window, but will never be -wider than the length of the longest buffer name, except that it will -never be narrower than 19 characters. - -+++ -*** New diary sexp 'diary-offset'. -It offsets another diary sexp by a number of days. This is useful -when for example your organization has a committee meeting two days -after every monthly meeting which takes place on the third Thursday, -or if you would like to attend a virtual meeting scheduled in a -different timezone causing a difference in the date. +*** New user option 'dired-make-directory-clickable'. +If non-nil (which is the default), hitting 'RET' or 'mouse-1' on +the directory components at the directory displayed at the start of +the buffer will take you to that directory. ---- -*** The old non-SMIE indentation of 'sh-mode' has been removed. ---- -*** 'mspools-show' is now autoloaded. +** Exif ---- -*** Loading dunnet.el in batch mode doesn't start the game any more. -Instead you need to do "emacs -f dun-batch" to start the game in -batch mode. +*** New function 'exif-field'. +This is a convenience function to extract the field data from +'exif-parse-file' and 'exif-parse-buffer'. -* New Modes and Packages in Emacs 28.1 - -+++ -** New mode 'repeat-mode' to allow shorter key sequences. -Type 'M-x repeat-mode' to enable this mode. You can then type -'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' -instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to -resize the selected window interactively, 'M-g n n p p' to navigate -next-error matches. Any other key exits this temporarily enabled -transient mode that supports shorter keys, and then after exiting from -this mode, the last typed key uses the default key binding. - -The user option 'repeat-exit-key' defines an additional key usable to -exit the mode like 'isearch-exit' ('RET'). - -The user option 'repeat-exit-timeout' (default nil, which means -forever) specifies the number of seconds of idle time after which to -break the repetition chain automatically. - -When user option 'repeat-keep-prefix' is non-nil (the default), the -prefix arg of the previous command is kept. This can be used to -e.g. reverse the window navigation direction with 'C-x o M-- o o' or -to set a new step with 'C-x { C-5 { { {', which will set the window -resizing step to 5 columns. - -'M-x describe-repeat-maps' will display a buffer showing -which commands are repeatable in 'repeat-mode'. - ---- -** New themes 'modus-vivendi' and 'modus-operandi'. -These themes are designed to conform with the highest standard for -color-contrast accessibility (WCAG AAA). You can load either of them -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. - -** Dictionary mode -This is a mode for searching a RFC 2229 dictionary server. -'dictionary' opens a buffer for starting operations. -'dictionary-search' performs a lookup for a word. It also supports a -'dictionary-tooltip-mode' which performs a lookup of the word under -the mouse in 'dictionary-tooltip-dictionary' (which must be customized -first). - ---- -** Lisp Data mode -The new command 'lisp-data-mode' enables a major mode for buffers -composed of Lisp symbolic expressions that do not form a computer -program. The ".dir-locals.el" file is automatically set to use this -mode, as are other data files produced by Emacs. +* New Modes and Packages in Emacs 29.1 +++ -** New global mode 'global-goto-address-mode'. -This will enable 'goto-address-mode' in all buffers. - -** transient.el -This library implements support for powerful keyboard-driven menus. -Such menus can be used as simple visual command dispatchers. More -complex menus take advantage of infix arguments, which are somewhat -similar to prefix arguments, but are more flexible and discoverable. - -** hierarchy.el -This library can create, query, navigate and display hierarchical -structures. - ---- -** New major mode for displaying the "etc/AUTHORS" file. -This new 'etc-authors-mode' provides font-locking for displaying the -"etc/AUTHORS" file from the Emacs distribution, and not much else. +** New mode 'erts-mode'. +This mode is used to edit files geared towards testing actions in +Emacs buffers, like indentation and the like. The new ert function +'ert-test-erts-file' is used to parse these files. -* Incompatible Lisp Changes in Emacs 28.1 +* Incompatible Lisp Changes in Emacs 29.1 -+++ -** Emacs now prints a backtrace when signaling an error in batch mode. -This makes debugging Emacs Lisp scripts run in batch mode easier. To -get back the old behavior, set the new variable -'backtrace-on-error-noninteractive' to a nil value. +** Keymap descriptions have changed. +'help--describe-command', 'C-h b' and associated functions that output +keymap descriptions have changed. In particular, prefix commands are +not output at all, and instead of "??" for closures/functions, +"[closure]"/"[lambda]" is output. --- -** Some floating-point numbers are now handled differently by the Lisp reader. -In previous versions of Emacs, numbers with a trailing dot and an exponent -were read as integers and the exponent ignored: 2.e6 was interpreted as the -integer 2. Such numerals are now read as floats with the exponent included: -2.e6 is now read as the floating-point value 2000000.0. -That is, '(read-from-string "1.e3")' => '(1000.0 . 4)' now. +** 'downcase' details have changed slightly. +In certain locales, changing the case of an ASCII-range character may +turn it into a multibyte character, most notably with "I" in Turkish +(the lowercase is "ı", 0x0131). Previously, 'downcase' on a unibyte +string was buggy, and would mistakenly just return the lower byte of +this, 0x31 (the digit "1"). 'downcase' on a unibyte string has now +been changed to downcase such characters as if they were ASCII. To +get proper locale-dependent downcasing, the string has to be converted +to multibyte first. (This goes for the other case-changing functions, +too.) --- -** 'equal' no longer examines some contents of window configurations. -Instead, it considers window configurations to be equal only if they -are 'eq'. To compare contents, use 'compare-window-configurations' -instead. This change helps fix a bug in 'sxhash-equal', which returned -incorrect hashes for window configurations and some other objects. +** 'def' indentation changes. +In 'emacs-lisp-mode', forms with a symbol with a name that start with +"def" have been automatically indented as if they were 'defun'-like +forms, for instance: -+++ -** The 'lexical-binding' local variable is always enabled. -Previously, if 'enable-local-variables' was nil, a 'lexical-binding' -local variable would not be heeded. This has now changed, and a file -with a 'lexical-binding' cookie is always heeded. To revert to the -old behavior, set 'permanently-enabled-local-variables' to nil. + (defzot 1 + 2 3) -+++ -** '&rest' in argument lists must always be followed by a variable name. -Omitting the variable name after '&rest' was previously tolerated in -some cases but not consistently so; it could lead to crashes or -outright wrong results. Since the utility was marginal at best, it is -now an error to omit the variable. +This heuristic has now been removed, and all functions/macros that +want to be indented this way have to be marked with ---- -** 'kill-all-local-variables' has changed how it handles non-symbol hooks. -The function is documented to eliminate all buffer-local bindings -except variables with a 'permanent-local' property, or hooks that -have elements with a 'permanent-local-hook' property. In addition, it -would also keep lambda expressions in hooks sometimes. The latter has -now been changed: The function will now also remove these. + (declare (indent defun)) -+++ -** Temporary buffers no longer run certain buffer hooks. -The macros 'with-temp-buffer' and 'with-temp-file' no longer run the -hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and -'buffer-list-update-hook' for the temporary buffers they create. This -avoids slowing them down when a lot of these hooks are defined. +or the like. If the function/macro definition itself can't be +changed, the indentation can also be adjusted by saying something +like: -+++ -** New face 'child-frame-border' and frame parameter 'child-frame-border-width'. -The face and width of child frames borders can now be determined -separately from those of normal frames. To minimize backward -incompatibility, child frames without a 'child-frame-border-width' -parameter will fall back to using 'internal-border-width'. However, -the new 'child-frame-border' face does constitute a breaking change -since child frames' borders no longer use the 'internal-border' face. + (put 'defzot 'lisp-indent-function 'defun) --- -** 'run-at-time' now tries harder to implement the t TIME parameter. -If TIME is t, the timer runs at an integral multiple of REPEAT. -(I.e., if given a REPEAT of 60, it'll run at 08:11:00, 08:12:00, -08:13:00.) However, when a machine goes to sleep (or otherwise didn't -get a time slot to run when the timer was scheduled), the timer would -then fire every 60 seconds after the time the timer was fired. This -has now changed, and the timer code now recomputes the integral -multiple every time it runs, which means that if the laptop wakes at -08:16:43, it'll fire at that time, but then at 08:17:00, 08:18:00... +** The 'inhibit-changing-match-data' variable is now obsolete. +Instead, functions like 'string-match' and 'looking-at' now take an +optional 'inhibit-modify' argument. --- -** 'parse-partial-sexp' now signals an error if TO is smaller than FROM. -Previously, this would lead to the function interpreting FROM as TO and -vice versa, which would be confusing when passing in OLDSTATE, which -refers to the old state at FROM. - -+++ -** 'global-mode-string' constructs should end with a space. -This was previously not formalized, which led to combinations of modes -displaying data "smushed together" on the mode line. - -+++ -** 'overlays-in' now handles zero-length overlays slightly differently. -Previously, zero-length overlays at the end of the buffer were included -in the result (if the region queried for stopped at that position). -The same was not the case if the buffer had been narrowed to exclude -the real end of the buffer. This has now been changed, and -zero-length overlays at 'point-max' are always included in the results. - ---- -** 'replace-match' now runs modification hooks slightly later. -The function is documented to leave point after the replacement text, -but this was not always the case if a modification hook inserted text -in front of the replaced text -- 'replace-match' would instead leave -point where the end of the inserted text would have been before the -hook ran. 'replace-match' now always leaves point after the -replacement text. - -+++ -** 'completing-read-default' sets completion variables buffer-locally. -'minibuffer-completion-table' and related variables are now set buffer-locally -in the minibuffer instead of being set via a global let-binding. +** 'gnus-define-keys' is now obsolete. +Use 'define-keymap' instead. --- -** XML serialization functions now reject invalid characters. -Previously, 'xml-print' would produce invalid XML when given a string -with characters that are not valid in XML (see -https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. - ---- -** JSON - ---- -*** JSON number parsing is now stricter. -Numbers with a leading plus sign, leading zeros, or a missing integer -component are now rejected by 'json-read' and friends. This makes -them more compliant with the JSON specification and consistent with -the native JSON parsing functions. - ---- -*** JSON functions support the semantics of RFC 8259. -The JSON functions 'json-serialize', 'json-insert', -'json-parse-string', and 'json-parse-buffer' now implement some of the -semantics of RFC 8259 instead of the earlier RFC 4627. In particular, -these functions now accept top-level JSON values that are neither -arrays nor objects. - ---- -*** Some JSON encoding functions are now obsolete. -The functions 'json-encode-number', 'json-encode-hash-table', -'json-encode-key', and 'json-encode-list' are now obsolete. - -The first two are kept as aliases of 'json-encode', which should be -used instead. Uses of 'json-encode-list' should be changed to call -one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or -'json-encode-array' instead. - -+++ -*** Native JSON functions now signal an error if libjansson is unavailable. -This affects 'json-serialize', 'json-insert', 'json-parse-string', -and 'json-parse-buffer'. This can happen if Emacs was compiled with -libjansson, but the DLL cannot be found and/or loaded by Emacs at run -time. Previously, Emacs would display a message and return nil in -these cases. - -+++ -** The use of positional arguments in 'define-minor-mode' is obsolete. -These were actually rendered obsolete in Emacs 21 but were never -marked as such. - ---- -** 'pcomplete-ignore-case' is now an obsolete alias of 'completion-ignore-case'. - -+++ -** 'completions-annotations' face is not used when the caller puts own face. -This affects the suffix specified by completion 'annotation-function'. - -+++ -** An active minibuffer now has major mode 'minibuffer-mode'. -This is instead of the erroneous 'minibuffer-inactive-mode' it -formerly had. - ---- -** 'make-text-button' no longer modifies text properties of its first argument. -When its first argument is a string, 'make-text-button' no longer -modifies the string's text properties; instead, it uses and returns -a copy of the string. This helps avoid trouble when strings are -shared or constants. - -+++ -** Some properties from completion tables are now preserved. -If 'minibuffer-allow-text-properties' is non-nil, doing completion -over a table of strings with properties will no longer remove all the -properties before returning. This affects things like 'completing-read'. +** MozRepl has been removed from js.el. +MozRepl was removed from Firefox in 2017, so this code doesn't work +with recent versions of Firefox. --- -** 'dns-query' now consistently uses Lisp integers to represent integers. -Formerly it made an exception for integer components of SOA records, -because SOA serial numbers can exceed fixnum ranges on 32-bit platforms. -Emacs now supports bignums so this old glitch is no longer needed. - -+++ -** The '&define' keyword in an Edebug specification now disables backtracking. -The implementation was buggy, and multiple '&define' forms in an '&or' -form should be exceedingly rare. See the Info node "(elisp) Backtracking" in -the Emacs Lisp reference manual for background. - -+++ -** The error 'ftp-error' belongs also to category 'remote-file-error'. - -+++ -** The WHEN argument of 'make-obsolete' and related functions is mandatory. -The use of those functions without a WHEN argument was marked obsolete -back in Emacs 23.1. The affected functions are: 'make-obsolete', -'define-obsolete-function-alias', 'make-obsolete-variable', -'define-obsolete-variable-alias'. - -+++ -** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'. - ---- -** Some functions are no longer considered safe by 'unsafep': -'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal' -and 'play-sound-file'. - ---- -** 'sql-*-statement-starters' are no longer user options. -These variables describe facts about the SQL standard and -product-specific additions. There should be no need for users to -customize them. - ---- -** Some locale-related variables have been removed. -The Lisp variables 'previous-system-messages-locale' and -'previous-system-time-locale' have been removed, as they were created -by mistake and were not useful to Lisp code. - ---- -** Function 'lm-maintainer' is replaced with 'lm-maintainers'. -The former is now declared obsolete. - -+++ -** facemenu.el is no longer preloaded. -To use functions/variables from the package, you now have to say -'(require 'facemenu)' or similar. - ---- -** 'facemenu-color-alist' is now obsolete, and is not used. - ---- -** The variable 'keyboard-type' is obsolete and not dynamically scoped any more. - -+++ -** The 'values' variable is now obsolete. -Using it just contributes to the growth of the Emacs memory -footprint. - ---- -** The 'load-dangerous-libraries' variable is now obsolete. -It was used to allow loading Lisp libraries compiled by XEmacs, a -modified version of Emacs which is no longer actively maintained. -This is no longer supported, and setting this variable has no effect. - -+++ -** The macro 'with-displayed-buffer-window' is now obsolete. -Use macro 'with-current-buffer-window' with action alist entry 'body-function'. - ---- -** The rfc2368.el library is now obsolete. -Use rfc6068.el instead. The main difference is that -'rfc2368-parse-mailto-url' and 'rfc2368-unhexify-string' assumed that -the strings were all-ASCII, while 'rfc6068-parse-mailto-url' and -'rfc6068-unhexify-string' parse UTF-8 strings. - ---- -** The inversion.el library is now obsolete. - ---- -** The metamail.el library is now obsolete. - -** Edebug changes - ---- -*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. - -+++ -*** The spec operator ':name NAME' is obsolete, use '&name' instead. - -+++ -*** The spec element 'function-form' is obsolete, use 'form' instead. - -+++ -*** New function 'def-edebug-elem-spec' to define Edebug spec elements. -These used to be defined with 'def-edebug-spec' thus conflating the -two name spaces, which lead to name collisions. -The use of 'def-edebug-spec' to define Edebug spec elements is -declared obsolete. - ---- -** The sb-image.el library is now obsolete. -This was a compatibility kludge which is no longer needed. - ---- -** Some libraries obsolete since Emacs 23 have been removed: -ledit.el, lmenu.el, lucid.el and old-whitespace.el. - ---- -** Some functions and variables obsolete since Emacs 23 have been removed: -'GOLD-map', 'advertised-xscheme-send-previous-expression', -'allout-init', 'bookmark-jump-noselect', -'bookmark-read-annotation-text-func', 'buffer-menu-mode-hook', -'c-forward-into-nomenclature', 'char-coding-system-table', -'char-valid-p', 'charset-bytes', 'charset-id', 'charset-list', -'choose-completion-delete-max-match', 'complete-in-turn', -'completion-base-size', 'completion-common-substring', -'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit', -'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook', -'define-key-rebound-commands', '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', -'erc-announced-server-name', 'erc-default-coding-system', -'erc-process', 'erc-send-command', 'eshell-report-bug', -'eval-next-after-load', 'exchange-dot-and-mark', 'ffap-bug', -'ffap-submit-bug', 'ffap-version', 'file-cache-mouse-choose-completion', -'forward-point', 'generic-char-p', 'global-highlight-changes', -'hi-lock-face-history', 'hi-lock-regexp-history', -'highlight-changes-active-string', 'highlight-changes-initial-state', -'highlight-changes-passive-string', -'icalendar--datetime-to-noneuropean-date', 'image-mode-maybe', -'imenu-example--name-and-position', 'ispell-aspell-supports-utf8', -'lisp-mode-auto-fill', 'locate-file-completion', 'make-coding-system', -'menu-bar-files-menu', 'minibuffer-local-must-match-filename-map', -'mouse-choose-completion', 'mouse-major-mode-menu', -'mouse-popup-menubar', 'mouse-popup-menubar-stuff', -'newsticker-groups-filename', 'nnir-swish-e-index-file', -'nnmail-fix-eudora-headers', 'non-iso-charset-alist', -'nonascii-insert-offset', 'nonascii-translation-table', -'password-read-and-add', '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', -'speedbar-navigating-speed', 'speedbar-update-speed', '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', -'wisent-lex-make-token-table'. - ---- -** Some functions and variables obsolete since Emacs 22 have been removed: -'erc-current-network', 'gnus-article-hide-pgp-hook', -'gnus-inews-mark-gcc-as-read', 'gnus-treat-display-xface', -'gnus-treat-strip-pgp', 'nnmail-spool-file'. - ---- -** The obsolete function 'thread-alive-p' has been removed. - ---- -** The variable 'force-new-style-backquotes' has been removed. -This removes the final remaining trace of old-style backquotes. - ---- -** Some obsolete variable and function aliases in dbus.el have been removed. -In Emacs 24.3, the variable 'dbus-event-error-hooks' was renamed to -'dbus-event-error-functions' and the function -'dbus-call-method-non-blocking' was renamed to 'dbus-call-method'. -The old names, which were kept as obsolete aliases of the new names, -have now been removed. - ---- -** 'find-function-source-path' renamed and re-documented. -The 'find-function' command (and various related commands) were -documented to respect 'find-function-source-path', and to search for -objects in files specified by that variable. It's unclear when this -actually changed, but at some point (perhaps decades ago) these -commands started using 'load-history' to determine where symbols had -been defined (which is much faster). The doc strings of all the -affected function have been updated. 'find-function-source-path' was -still being used by 'find-library' and related commands, so the -user option has been renamed to 'find-library-source-path', and -'find-function-source-path' is now an obsolete variable alias. - ---- -** The macro 'vc-call' no longer evaluates its second argument twice. +** The function 'image-dired-get-exif-data' is now obsolete. +Use 'exif-parse-file' and 'exif-field' instead. -* Lisp Changes in Emacs 28.1 +* Lisp Changes in Emacs 29.1 +++ -** The 'interactive' syntax has been extended to allow listing applicable modes. -Forms like '(interactive "p" dired-mode)' can be used to annotate the -commands as being applicable for modes derived from 'dired-mode', -or if the mode is a minor mode, when the current buffer has that -minor mode activated. Note that using this form will create byte code -that is not compatible with byte code in previous Emacs versions. +*** New text property 'inhibit-isearch'. +If set, 'isearch' will skip these areas, which can be useful (for +instance) when covering huge amounts of data (that has no meaningful +searchable data, like image data) with a 'display' text property. -+++ -** New forms to declare how completion should happen has been added. -'(declare (completion PREDICATE))' can be used as a general predicate -to say whether the command should be present when completing with -'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand -way of saying that the command should be present when completing from -buffers in major modes derived from MODE..., or, if it's a minor mode, -when that minor mode is enabled in the current buffer. - -+++ -** 'define-minor-mode' now takes an ':interactive' argument. -This can be used for specifying which modes this minor mode is meant -for, or to make the new minor mode non-interactive. The default value -is t. - -+++ -** 'define-derived-mode' now takes an ':interactive' argument. -This can be used to control whether the defined mode is a command -or not, and is useful when defining commands that aren't meant to be -used by users directly. - -+++ -** 'define-globalized-minor-mode' now takes a ':predicate' parameter. -This can be used to control which major modes the minor mode should be -used in. - -+++ -** 'condition-case' now allows for a success handler. -It is written as '(:success BODY...)' where BODY is executed -whenever the protected form terminates without error, with the -specified variable bound to the value of the protected form. - -+++ -** New function 'benchmark-call' to measure the execution time of a function. -Additionally, the number of repetitions can be expressed as a minimal duration -in seconds. - -+++ -** The value thrown to the 'exit' label can now be a function. -This is in addition to values t or nil. If the value is a function, -the command loop will call it with zero arguments before returning. - -+++ -** The behavior of 'format-spec' is now closer to that of 'format'. -In order for the two functions to behave more consistently, -'format-spec' now pads and truncates based on string width rather than -length, and also supports format specifications that include a -truncating precision field, such as "%.2a". - ---- -** 'defvar' detects the error of defining a variable currently lexically bound. -Such mixes are always signs that the outer lexical binding was an -error and should have used dynamic binding instead. +*** 'insert-image' now takes an INHIBIT-ISEARCH optional parameter. +It marks the image with the 'inhibit-isearch' text parameter, which +inhibits 'isearch' matching the STRING parameter. --- -** New variable 'inhibit-mouse-event-check'. -If bound to non-nil, a command with '(interactive "e")' doesn't signal -an error when invoked by input event that is not a mouse click (e.g., -a key sequence). +*** New user option 'pp-use-max-width'. +If non-nil, 'pp' will attempt to limit the line length when formatting +long lists and vectors. --- -** 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. +*** New function 'pp-emacs-lisp-code'. +'pp' formats general Lisp sexps. This function does much the same, +but applies formatting rules appropriate for Emacs Lisp code. +++ -** Doc strings can now link to customization groups. -Text like "customization group `whitespace'" will be made into a -button. When clicked, it will open a Custom buffer displaying that -customization group. - -+++ -** Doc strings can now link to man pages. -Text like "man page `chmod(1)'" will be made into a button. When -clicked, it will open a Man mode buffer displaying that man page. - -+++ -** Buffers can now be created with certain hooks disabled. -The functions 'get-buffer-create' and 'generate-new-buffer' accept a -new optional argument INHIBIT-BUFFER-HOOKS. If non-nil, the new -buffer does not run the hooks 'kill-buffer-hook', -'kill-buffer-query-functions', and 'buffer-list-update-hook'. This -avoids slowing down internal or temporary buffers that are never -presented to users or passed on to other applications. - -+++ -** New command 'make-directory-autoloads'. -This does the same as the old command 'update-directory-autoloads', -but has different semantics: Instead of passing in the output file via -the dynamically bound 'generated-autoload-file' variable, the output -file is now a explicit parameter. - ---- -** Dragging a file into Emacs pushes the file name onto 'file-name-history'. +*** New function 'file-has-changed-p'. +This convenience function is useful when writing code that parses +files at run-time, and allows Lisp programs to re-parse files only +when they have changed. --- -** The 'easymenu' library is now preloaded. +*** New function 'font-has-char-p'. +This can be used to check whether a specific font has a glyph for a +character. ---- -** The 'iso-transl' library is now preloaded. -This means that keystrokes like 'Alt-[' are defined by default, -instead of only becoming available after doing (for instance) -'C-x 8 <letter>'. +** XDG support ---- -** ':safe' settings in 'defcustom' are now propagated to the loaddefs files. +*** New function 'xdg-state-home' returns $XDG_STATE_HOME. +This new location, introduced in the XDG Base Directory Specification +version 0.8 (8th May 2021), "contains state data that should persist +between (application) restarts, but that is not important or portable +enough to the user that it should be stored in $XDG_DATA_HOME". +++ -** New ':type' for 'defcustom' for nonnegative integers. -The new 'natnum' type can be used for options that should be -nonnegative integers. - -+++ -** ERT can now output more verbose test failure reports. -If the 'EMACS_TEST_VERBOSE' environment variable is set, failure -summaries will include the failing condition. - -** Byte compiler changes - -+++ -*** New byte-compiler check for missing dynamic variable declarations. -It is meant as an (experimental) aid for converting Emacs Lisp code -to lexical binding, where dynamic (special) variables bound in one -file can affect code in another. For details, see the manual section -"(elisp) Converting to Lexical Binding". - -+++ -*** 'byte-recompile-directory' can now compile symlinked ".el" files. -This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter. - ---- -*** The byte-compiler now warns about too wide documentation strings. -By default, it will warn if a documentation string is wider than the -largest of 'byte-compile-docstring-max-column' or 'fill-column' -characters. - -+++ -*** 'byte-compile-file' optional argument LOAD is now obsolete. -To load the file after byte-compiling, add a call to 'load' from Lisp -or use 'M-x emacs-lisp-byte-compile-and-load' interactively. - -** Macroexp +** New macro 'with-delayed-message'. +This macro is like 'progn', but will output the specified message if +the body takes longer to execute than the specified timeout. --- -*** New function 'macroexp-file-name' to know the name of the current file. +** New function 'funcall-with-delayed-message'. +This function is like 'funcall', but will output the specified message +is the function take longer to execute that the specified timeout. ---- -*** New function 'macroexp-compiling-p' to know if we're compiling. +** Locale --- -*** New function 'macroexp-warn-and-return' to help emit warnings. -This used to be named 'macroexp--warn-and-return' and has proved useful -and well-behaved enough to lose the "internal" marker. - -** map.el +*** New variable 'current-locale-environment'. +This holds the value of the previous call to 'set-locale-environment'. --- -*** Alist keys are now consistently compared with 'equal' by default. -Until now, 'map-elt' and 'map-delete' compared alist keys with 'eq' by -default. They now use 'equal' instead, for consistency with -'map-put!' and 'map-contains-key'. - -*** Pcase 'map' pattern added keyword symbols abbreviation. -A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', -equivalent to '(map (:sym sym))'. - ---- -*** The function 'map-copy' now uses 'copy-alist' on alists. -This is a slightly deeper copy than the previous 'copy-sequence'. - ---- -*** The function 'map-contains-key' now supports plists. - ---- -*** More consistent duplicate key handling in 'map-merge-with'. -Until now, 'map-merge-with' promised to call its function argument -whenever multiple maps contained 'eql' keys. However, this did not -always coincide with the keys that were actually merged, which could -be 'equal' instead. The function argument is now called whenever keys -are merged, for greater consistency with 'map-merge' and 'map-elt'. - -** pcase - -+++ -*** The 'or' pattern now binds the union of the vars of its sub-patterns. -If a variable is not bound by the subpattern that matched, it gets bound -to nil. This was already sometimes the case, but it is now guaranteed. - -+++ -*** The 'pred' pattern can now take the form '(pred (not FUN))'. -This is like '(pred (lambda (x) (not (FUN x))))' but results -in better code. - ---- -*** New function 'pcase-compile-patterns' to write other macros. - -+++ -*** Added 'cl-type' pattern. -The new 'cl-type' pattern compares types using 'cl-typep', which allows -comparing simple types like '(cl-type integer)', as well as forms like -'(cl-type (integer 0 10))'. - -+++ -*** New macro 'pcase-setq'. -This macro is the 'setq' equivalent of 'pcase-let', which allows for -destructuring patterns in a 'setq' form. - -** Edebug - -*** Edebug specification lists can use some new keywords: - -+++ -**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC. -More specifically, FUN is called with 'HEAD PF ARGS..' where -PF is a parsing function that expects a single argument (the specs to -use) and HEAD is the code that matched SPEC. +*** New macro 'with-locale-environment'. +This macro can be used to change the locale temporarily while +executing code. -+++ -**** '&error MSG' unconditionally aborts the current edebug instrumentation. - -+++ -**** '&name SPEC FUN' extracts the current name from the code matching SPEC. - -** Dynamic modules changes - -+++ -*** Type aliases for module functions and finalizers. -The module header 'emacs-module.h' now contains type aliases -'emacs_function' and 'emacs_finalizer' for module functions and -finalizers, respectively. +** Tabulated List Mode +++ -*** Module functions can now be made interactive. -Use 'make_interactive' to give a module function an interactive -specification. +*** A column can now be set to an image descriptor. +The `tabulated-list-entries' variable now supports using an image +descriptor, which means to insert an image in that column instead of +text. See the documentation string of that variable for details. +++ -*** Module functions can now install an optional finalizer. -The finalizer is called when the function object is garbage-collected. -Use 'set_function_finalizer' to set the finalizer and -'get_function_finalizer' to retrieve it. +** 'define-key' now understands a new strict 'kbd' representation for keys. +The '(define-key map ["C-c M-f"] #'some-command)' syntax is now +supported, and is like the 'kbd' representation, but is stricter. If +the string doesn't represent a valid key sequence, an error is +signalled (both when evaluating and byte compiling). +++ -*** Modules can now open a channel to an existing pipe process. -Modules can use the new module function 'open_channel' to do that. -On capable systems, modules can use this functionality to -asynchronously send data back to Emacs. +** :keys in 'menu-item' can now be a function. +If so, it is called whenever the menu is computed, and can be used to +calculate the keys dynamically. +++ -*** A new module API 'make_unibyte_string'. -It can be used to create Lisp strings with arbitrary byte sequences -(a.k.a. "raw bytes"). +** New major mode 'clean-mode'. +This is a new major mode meant for debugging. It kills absolutely all +local variables and removes overlays and text properties. +++ -** Shorthands for Lisp symbols. -Shorthands are a general purpose namespacing system to make Emacs -Lisp's symbol-naming etiquette easier to use. A shorthand is any -symbolic form found in Lisp source that "abbreviates" a symbol's print -name. Among other applications, this feature can be used to avoid -name clashes and namespace pollution by renaming an entire file's -worth of symbols with proper and longer prefixes, without actually -touching the Lisp source. For details, see the manual section -"(elisp) Shorthands". +** 'kill-all-local-variables' can now kill all local variables. +If given the new optional KILL-PERMANENT argument, also kill permanent +local variables. +++ -** New function 'string-search'. -This function takes two string parameters and returns the position of -the first instance of the former string in the latter. - -+++ -** New function 'string-replace'. -This function works along the line of 'replace-regexp-in-string', but -it matches on fixed strings instead of regexps, and does not change -the global match state. - -+++ -** New function 'ensure-list'. -This function makes a list of its object if it's not a list already. -If it's already a list, the list is returned as is. - -+++ -** New function 'split-string-shell-command'. -This splits a shell command string into separate components, -respecting quoting with single ('like this') and double ("like this") -quotes, as well as backslash quoting (like\ this). - -+++ -** New function 'string-clean-whitespace'. -This removes whitespace from a string. - -+++ -** New function 'string-fill'. -Word-wrap a string so that no lines are longer that a specific length. - -+++ -** New function 'string-limit'. -Return (up to) a specific substring length. - -+++ -** New function 'string-lines'. -Return a list of strings representing the individual lines in a -string. - -+++ -** New function 'string-pad'. -Pad a string to a specific length. - -+++ -** New function 'string-chop-newline'. -Remove a trailing newline from a string. - -+++ -** New function 'replace-regexp-in-region'. - -+++ -** New function 'replace-string-in-region'. - -+++ -** New function 'file-name-with-extension'. -This function allows a canonical way to set/replace the extension of a -file name. - -+++ -** New function 'file-modes-number-to-symbolic' to convert a numeric -file mode specification into symbolic form. - -+++ -** New function 'file-name-concat'. -This appends file name components to a directory name and returns the -result. - -+++ -** New function 'file-backup-file-names'. -This function returns the list of file names of all the backup files -for the specified file. - -+++ -** New function 'directory-empty-p'. -This predicate tests whether a given file name is an accessible -directory and whether it contains no other directories or files. - -+++ -** New function 'buffer-local-boundp'. -This predicate says whether a symbol is bound in a specific buffer. - -+++ -** New function 'always'. -This is identical to 'ignore', but returns t instead. - -+++ -** New function 'sxhash-equal-including-properties'. -This is identical to 'sxhash-equal' but also accounts for string -properties. - ---- -** New function 'buffer-line-statistics'. -This function returns some statistics about the line lengths in a buffer. - ---- -** New function 'color-values-from-color-spec'. -This can be used to parse RGB color specs in several formats and -convert them to a list '(R G B)' of primary color values. - ---- -** New function 'custom-add-choice'. -This function can be used by modes to add elements to the -'choice' customization type of a variable. - ---- -** New function 'decoded-time-period'. -It interprets a decoded time structure as a period and returns the -equivalent period in seconds. - -+++ -** New function 'dom-print'. - -+++ -** New function 'dom-remove-attribute'. - ---- -** New function 'dns-query-asynchronous'. -It takes the same parameters as 'dns-query', but adds a callback -parameter. - -** New function 'garbage-collect-maybe' to trigger GC early. - ---- -** New function 'get-locale-names'. -This utility function returns a list of names of locales available on -the current system. - -+++ -** New function 'insert-into-buffer'. -This inserts the contents of the current buffer into another buffer. - -+++ -** New function 'json-available-p'. -This predicate returns non-nil if Emacs is built with libjansson -support, and it is available on the current system. - ---- -** New function 'mail-header-parse-addresses-lax'. -This takes a comma-separated string and returns a list of mail/name -pairs. - ---- -** New function 'mail-header-parse-address-lax'. -Parse a string as a mail address-like string. - ---- -** New function 'make-separator-line'. -Make a string appropriate for usage as a visual separator line. - -+++ -** New function 'num-processors'. -Return the number of processors on the system. - -+++ -** New function 'object-intervals'. -This function returns a copy of the list of intervals (i.e., text -properties) in the object in question (which must either be a string -or a buffer). - -+++ -** New function 'process-lines-ignore-status'. -This is like 'process-lines', but does not signal an error if the -return status is non-zero. 'process-lines-handling-status' has also -been added, and takes a callback to handle the return status. - -+++ -** New function 'require-theme'. -This function is like 'require', but searches 'custom-theme-load-path' -instead of 'load-path'. It can be used by Custom themes to load -supporting Lisp files when 'require' is unsuitable. - -+++ -** New function 'seq-union'. -This function takes two sequences and returns a list of all elements -that appear in either of them, with no two elements that compare equal -appearing in the result. - -+++ -** New function 'syntax-class-to-char'. -This does almost the opposite of 'string-to-syntax' -- it returns the -syntax descriptor (a character) given a raw syntax descriptor (an -integer). - -+++ -** New functions 'null-device' and 'path-separator'. -These functions return the connection local value of the respective -variables. This can be used for remote hosts. - -+++ -** New predicate functions 'length<', 'length>' and 'length='. -Using these functions may be more efficient than using 'length' (if -the length of a (long) list is being computed just to compare this -length to a number). - -+++ -** New macro 'dlet' to dynamically bind variables. - -+++ -** New macro 'with-existing-directory'. -This macro binds 'default-directory' to some other existing directory -if 'default-directory' doesn't exist, and then executes the body forms. - -+++ -** New variable 'current-minibuffer-command'. -This is like 'this-command', but it is bound recursively when entering -the minibuffer. - -+++ -** New variable 'inhibit-interaction' to make user prompts signal an error. -If this is bound to something non-nil, functions like -'read-from-minibuffer', 'read-char' (and related) will signal an -'inhibited-interaction' error. - ---- -** New variable 'indent-line-ignored-functions'. -This allows modes to cycle through a set of indentation functions -appropriate for those modes. - -+++ -** New variable 'print-integers-as-characters' modifies integer printing. -If this variable is non-nil, character syntax is used for printing -numbers when this makes sense, such as '?A' for 65. - -+++ -** New variable 'tty-menu-calls-mouse-position-function'. -This controls whether 'mouse-position-function' is called by functions -that retrieve the mouse position when that happens during TTY menu -handling. Lisp programs that set 'mouse-position-function' should -also set this variable non-nil if they are compatible with the tty -menu handling. - -+++ -** New variables that hold default buffer names for shell output. -The new constants 'shell-command-buffer-name' and -'shell-command-buffer-name-async' store the default buffer names -for the output of, respectively, synchronous and async shell -commands. +** Third 'mapconcat' argument SEPARATOR is now optional. +An explicit nil always meant the empty string, now it can be left out. --- -** New variables 'read-char-choice-use-read-key' and 'y-or-n-p-use-read-key'. -When non-nil, then functions 'read-char-choice' and 'y-or-n-p' -(respectively) use the function 'read-key' to read a character instead -of using the minibuffer. - -+++ -** New variable 'global-minor-modes'. -This variable holds a list of currently enabled global minor modes (as -a list of symbols). - -+++ -** New buffer-local variable 'local-minor-modes'. -This permanently buffer-local variable holds a list of currently -enabled non-global minor modes in the current buffer (as a list of -symbols). - -+++ -** New completion function 'affixation-function' to add prefix/suffix. -It accepts a list of completions and should return a list where -each element is a list with three elements: a completion, -a prefix string, and a suffix string. - -+++ -** New completion function 'group-function' for grouping candidates. -It takes two arguments: a completion candidate and a 'transform' flag. - -+++ -** New error symbol 'minibuffer-quit'. -Signaling it has almost the same effect as 'quit' except that it -doesn't cause keyboard macro termination. - -+++ -** New error 'remote-file-error', a subcategory of 'file-error'. -It is signaled if a remote file operation fails due to internal -reasons, and could block Emacs. It does not replace 'file-error' -signals for the usual cases. Timers, process filters and process -functions, which run remote file operations, shall protect themselves -against this error. - -If such an error occurs, please report this as bug via 'M-x report-emacs-bug'. -Until it is solved you could ignore such errors by performing - - (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) - -+++ -** New macro 'named-let' added to subr-x.el. -It provides Scheme's "named let" looping construct. - ---- -** Emacs now attempts to test for high-rate subprocess output more fairly. -When several subprocesses produce output simultaneously at high rate, -Emacs will now by default attempt to service them all in a round-robin -fashion. Set the new variable 'process-prioritize-lower-fds' to a -non-nil value to get back the old behavior, whereby after reading -from a subprocess, Emacs would check for output of other subprocesses -in a way that is likely to read from the same process again. - -+++ -** 'set-process-buffer' now updates the process mark. -The mark will be set to point to the end of the new buffer. +** Themes can now be made obsolete. +Using 'make-obsolete' on a theme is now supported. This will make +'load-theme' issue a warning when loading the theme. +++ -** 'unlock-buffer' displays warnings instead of signaling. -Instead of signaling 'file-error' conditions for file system level -errors, the function now calls 'display-warning' and continues as if -the error did not occur. +** New function 'define-keymap'. +This function allows defining a number of keystrokes with one form. +++ -** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'. -If you bind 'help-form' to a non-nil value while calling these functions, -then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form' -and display the result. - -+++ -** 'read-number' now has its own history variable. -Additionally, the function now accepts a HIST argument which can be -used to specify a custom history variable. - -+++ -** 'set-window-configuration' now takes two optional parameters, -'dont-set-frame' and 'dont-set-miniwindow'. The first of these, when -non-nil, instructs the function not to select the frame recorded in -the configuration. The second prevents the current minibuffer being -replaced by the one stored in the configuration. +** New macro 'defvar-keymap'. +This macro allows defining keymap variables more conveniently. --- -** 'count-windows' now takes an optional parameter ALL-FRAMES. -The semantics are as with 'walk-windows'. +** 'kbd' can now be used in built-in, preloaded libraries. +It no longer depends on edmacro.el and cl-lib.el. +++ -** '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 function 'kbd-valid-p'. +The 'kbd' function is quite permissive, and will try to return +something usable even if the syntax of the argument isn't completely +correct. The 'kbd-valid-p' predicate does a stricter check of the +syntax. +++ -** 'string-width' now accepts two optional arguments FROM and TO. -This allows calculating the width of a substring without consing a -new string. +** New function 'image-at-point-p'. +This function returns t if point is on a valid image, and nil +otherwise. +++ -** 'directory-files' now takes an additional COUNT parameter. -The parameter makes 'directory-files' return COUNT first file names -from a directory. If MATCH is also given, the function will return -first COUNT file names that match the expression. The same COUNT -parameter has been added to 'directory-files-and-attributes'. +** New function 'string-pixel-width'. +This returns the width of a string in pixels. This can be useful when +dealing with variable pitch fonts and glyphs that have widths that +aren't integer multiples of the default font. +++ -** 'count-lines' can now ignore invisible lines. -This is controlled by the optional parameter IGNORE-INVISIBLE-LINES. - ---- -** 'count-words' now crosses field boundaries. -Originally, 'count-words' would stop counting at the first field -boundary it encountered; now it keeps counting all the way to the -region's (or buffer's) end. - -+++ -** File-related APIs can optionally follow symlinks. -The functions 'file-modes', 'set-file-modes', and 'set-file-times' now -have an optional argument specifying whether to follow symbolic links. - -+++ -** 'format-seconds' can now be used for sub-second times. -The new optional "," parameter has been added, and -'(format-seconds "%mm %,1ss" 66.4)' will now result in "1m 6.4s". - -+++ -** 'parse-time-string' can now parse ISO 8601 format strings. -These have a format like "2020-01-15T16:12:21-08:00". +** New function 'string-glyph-split'. +This function splits a string into a list of strings representing +separate glyphs. This takes into account combining characters and +grapheme clusters. --- ** 'lookup-key' is more allowing when searching for extended menu items. -When looking for a menu item '[menu-bar Foo-Bar]', first try to find -an exact match, then look for the lowercased '[menu-bar foo-bar]'. -It will only try to downcase ASCII characters in the range "A-Z". -This improves backwards-compatibility when converting menus to use -'easy-menu-define'. - ---- -** 'make-network-process', 'make-serial-process' ':coding' behavior change. -Previously, passing ':coding nil' to either of these functions would -override any non-nil binding for 'coding-system-for-read' and -'coding-system-for-write'. For consistency with 'make-process' and -'make-pipe-process', passing ':coding nil' is now ignored. No code in -Emacs depended on the previous behavior; if you really want the -process' coding-system to be nil, use 'set-process-coding-system' -after the process has been created, or pass in ':coding '(nil nil)'. - -+++ -** 'open-network-stream' now accepts a ':coding' argument. -This allows specifying the coding systems used by a network process -for encoding and decoding without having to bind -'coding-system-for-{read,write}' or call 'set-process-coding-system'. - -+++ -** 'open-network-stream' can now take a ':capability-command' that's a function. -The function is called with the greeting from the server as its only -parameter, and allows sending different TLS capability commands to the -server based on that greeting. - -+++ -** 'open-gnutls-stream' now also accepts a ':coding' argument. - ---- -** 'process-attributes' now works under OpenBSD, too. - -+++ -** 'format-spec' now takes an optional SPLIT parameter. -If non-nil, 'format-spec' will split the resulting string into a list -of strings, based on where the format specs (and expansions) were. - ---- -** 'unload-feature' now also tries to undo additions to buffer-local hooks. - ---- -** 'while-no-input-ignore-events' accepts more special events. -The special events 'dbus-event' and 'file-notify' are now ignored in -'while-no-input' when added to this variable. - ---- -** 'start-process-shell-command' and 'start-file-process-shell-command' -do not support the old calling conventions any longer. - -+++ -** 'yes-or-no-p' and 'y-or-n-p' PROMPT parameter no longer needs trailing space. -In other words, the prompt can now end with "?" instead of "? ". This -has been the case since Emacs 24.4 but was not announced or documented -until now. (Checkdoc has also been updated to accept this convention.) - -+++ -** The 'uniquify' argument in 'auto-save-file-name-transforms' can be a symbol. -If this symbol is one of the members of 'secure-hash-algorithms', -Emacs constructs the nondirectory part of the auto-save file name by -applying that 'secure-hash' to the buffer file name. This avoids any -risk of excessively long file names. - -+++ -** New user option 'process-file-return-signal-string'. -It controls, whether 'process-file' returns a string when a remote -process is interrupted by a signal. - -** EIEIO Changes - -+++ -*** The macro 'oref-default' can now be used with 'setf'. -It is now defined as a generalized variable that can be used with -'setf' to modify the value stored in a given class slot. - ---- -*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated. -This corresponds to the behavior of defmethod in Common Lisp Object System. -For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now. +In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking +for a menu item '[menu-bar Foo-Bar]', first try to find an exact +match, then look for the lowercased '[menu-bar foo-bar]'. -** D-Bus - -+++ -*** Property values can be typed explicitly. -'dbus-register-property' and 'dbus-set-property' accept now optional -type symbols. Both functions propagate D-Bus errors. - -+++ -*** Registered properties can have the new access type ':write'. - -+++ -*** In case of problems, handlers can emit proper D-Bus error messages now. - -+++ -*** D-Bus errors, which have been converted from incoming D-Bus error -messages, contain the error name of that message now. - -+++ -*** D-Bus messages can be monitored with the new command 'dbus-monitor'. - -+++ -*** D-Bus events have changed their internal structure. -They carry now the destination and the error-name of an event. They -also keep the type information of their arguments. Use the -'dbus-event-*' accessor functions. - -** Buttons - -+++ -*** New minor mode 'button-mode'. -This minor mode does nothing except install 'button-buffer-map' as -a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate -to buttons), and can be used in any view-mode-like buffer that has -buttons in it. - -+++ -*** New utility function 'button-buttonize'. -This function takes a string and returns a string propertized in a way -that makes it a valid button. - ---- -** 'text-scale-mode' can now adjust font size of the header line. -When the new buffer local variable 'text-scale-remap-header-line' -is non-nil, 'text-scale-adjust' will also scale the text in the header -line when displaying that buffer. - -This is useful for major modes that arrange their display in a tabular -form below the header line. It is enabled by default in -'tabulated-list-mode' and its derived modes, and disabled by default -elsewhere. - ---- -** 'ascii' is now a coding system alias for 'us-ascii'. - ---- -** New coding-systems for EBCDIC variants. -New coding-systems 'ibm256', 'ibm273', 'ibm274', 'ibm277', 'ibm278', -'ibm280', 'ibm281', 'ibm284', 'ibm285', 'ibm290', 'ibm297'. These are -variants of the EBCDIC encoding tailored to some European and Japanese -locales. They are also available as aliases 'ebcdic-cp-*' (e.g., -'ebcdic-cp-fi' for the Finnish variant 'ibm278'), and 'cp2xx' (e.g., -'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to -support these coding-systems. - -+++ -** New 'Bindat type expression' description language. -This new system is provided by the new macro 'bindat-type' and -obsoletes the old data layout specifications. It supports -arbitrary-size integers, recursive types, and more. See the Info node -"(elisp) Byte Packing" in the ELisp manual for more details. - -+++ -** New macro 'with-environment-variables'. -This macro allows setting environment variables temporarily when -executing a form. +This has been extended, so that when looking for a menu item with a +symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for +an exact match, then the lowercased '[menu-bar foo\ bar]' and finally +'[menu-bar foo-bar]'. This further improves backwards-compatibility +when converting menus to use 'easy-menu-define'. -* Changes in Emacs 28.1 on Non-Free Operating Systems - -+++ -** On MS-Windows, Emacs can now use the native image API to display images. -Emacs can now use the MS-Windows GDI+ library to load and display -images in JPEG, PNG, GIF and TIFF formats. This support is available -unless Emacs was configured '--without-native-image-api'. - -This feature is experimental, and needs to be turned on to be used. -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'. +* Changes in Emacs 29.1 on Non-Free Operating Systems -+++ -** On MS-Windows, Emacs can now toggle the IME. -A new function 'w32-set-ime-open-status' can now be used to disable -and enable the MS-Windows native Input Method Editor (IME) at run -time. A companion function 'w32-get-ime-open-status' returns the -current IME activation status. - --- -** On macOS, 's-<left>' and 's-<right>' are now bound to -'move-beginning-of-line' and 'move-end-of-line' respectively. The commands -to select previous/next frame are still bound to 's-~' and 's-`'. - -+++ -** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix. -'module-file-suffix' now has the value ".dylib" on macOS, but the -".so" suffix is supported as well. - ---- -** On macOS, the user option 'make-pointer-invisible' is now honored. - ---- -** On macOS, Xwidget is now supported. -If Emacs was built with xwidget support, you can access the embedded -webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two -instances of xwidget webkit is not supported. - ---- -*** New user option 'xwidget-webkit-enable-plugins'. -If non-nil, enable plugins in xwidget. (This is only available on -macOS.) +** MS-Windows +++ -** New macOS Contacts back-end for EUDC. -This backend works on newer versions of macOS and is generally -preferred over the eudcb-mab.el backend. +*** Emacs now supports system dark mode. +On Windows 10 (version 1809 and higher) and Windows 11, Emacs will now +follow the system's dark mode: GUI frames use the appropriate light or +dark title bar and scroll bars, based on the user's Windows-wide color +settings. ---------------------------------------------------------------------- diff --git a/etc/NEWS.28 b/etc/NEWS.28 new file mode 100644 index 00000000000..9ed340ae6a7 --- /dev/null +++ b/etc/NEWS.28 @@ -0,0 +1,4587 @@ +GNU Emacs NEWS -- history of user-visible changes. + +Copyright (C) 2019-2021 Free Software Foundation, Inc. +See the end of the file for license conditions. + +Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. +If possible, use 'M-x report-emacs-bug'. + +This file is about changes in Emacs version 28. + +See file HISTORY for a list of GNU Emacs versions and release dates. +See files NEWS.27, NEWS.26, ..., NEWS.18, and NEWS.1-17 for changes +in older Emacs versions. + +You can narrow news to a specific version by calling 'view-emacs-news' +with a prefix argument or by typing 'C-u C-h C-n'. + +Temporary note: ++++ indicates that all relevant manuals in doc/ have been updated. +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it +applies, and please also update docstrings as needed. + + +* Installation Changes in Emacs 28.1 + +** Emacs now optionally supports native compilation of Lisp files. +To enable this, configure Emacs with the '--with-native-compilation' option. +This requires the libgccjit library to be installed and functional, +and also requires GCC and Binutils to be available when Lisp code is +natively compiled. See the Info node "(elisp) Native Compilation" for +more details. + +If you build Emacs with native compilation, but without zlib, be sure +to configure with the '--without-compress-install' option, so that the +installed *.el files are not compressed; otherwise, you will not be +able to use JIT native compilation of the installed *.el files. + +Note that JIT native compilation is done in a fresh session of Emacs +that is run in a subprocess, so it can legitimately report some +warnings and errors that aren't uncovered by byte-compilation. We +recommend examining any such warnings before you decide they are +false. + +** The Cairo graphics library is now used by default if present. +'--with-cairo' is now the default, if the appropriate development files +are found by 'configure'. Note that building with Cairo means using +Pango instead of libXFT for font support. Since Pango 1.44 has +removed support for bitmapped fonts, this may require you to adjust +your font settings. + +Note also that 'FontBackend' settings in ".Xdefaults" or +".Xresources", or 'font-backend' frame parameter settings in your init +files, may need to be adjusted, as 'xft' is no longer a valid backend +when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz +text shaping support, and 'ftcr' otherwise. You can determine this by +checking 'system-configuration-features'. The 'ftcr' backend will +still be available when HarfBuzz is supported, but will not be used by +default. We strongly recommend building with HarfBuzz support. 'x' is +still a valid backend. + +--- +** 'configure' now warns about building with libXft support. +libXft is unmaintained, and causes a number of problems with modern +fonts including but not limited to crashes; support for it may be +removed in a future version of Emacs. Please consider using +Cairo + HarfBuzz instead. + +--- +** 'configure' now warns about not using HarfBuzz if using Cairo. +We want to encourage people to use the most modern font features +available, and this is the Cairo graphics library + HarfBuzz for font +shaping, so 'configure' now recommends that combination. + +--- +** Building without double buffering support. +'configure --with-xdbe=no' can now be used to disable double buffering +at build time. + +--- +** Support for building with Motif has been removed. + +--- +** The configure option '--without-makeinfo' has been removed. +This was only ever relevant when building from a repository checkout. +This now requires makeinfo, which is part of the texinfo package. + +--- +** New configure option '--disable-year2038'. +This causes Emacs to use only 32-bit time_t on platforms that have +both 32- and 64-bit time_t. This may help when linking Emacs with a +library with an ABI requiring traditional 32-bit time_t. This option +currently affects only 32-bit ARM and x86 running GNU/Linux with glibc +2.34 and later. Emacs now defaults to 64-bit time_t on these +platforms. + +--- +** Support for building with '-fcheck-pointer-bounds' has been removed. +GCC has withdrawn the '-fcheck-pointer-bounds' option and support for +its implementation has been removed from the Linux kernel. + +--- +** The ftx font backend driver has been removed. +It was declared obsolete in Emacs 27.1. + +--- +** Emacs no longer supports old OpenBSD systems. +OpenBSD 5.3 and older releases are no longer supported, as they lack +proper pty support that Emacs needs. + + +* Startup Changes in Emacs 28.1 + +--- +** In GTK builds, Emacs now supports startup notification. +This means that Emacs won't steal keyboard focus upon startup +(when started via the Desktop) if the user is typing into another +application. + +--- +** Errors in 'kill-emacs-hook' no longer prevent Emacs from shutting down. +If a function in that hook signals an error in an interactive Emacs, +the user will be prompted on whether to continue. If the user doesn't +answer within five seconds, Emacs will continue shutting down anyway. + +** Emacs now supports loading a Secure Computing filter. +This is supported only on capable GNU/Linux systems. To activate, +invoke Emacs with the '--seccomp=FILE' command-line option. FILE must +name a binary file containing an array of 'struct sock_filter' +structures. Emacs will then install that list of Secure Computing +filters into its own process early during the startup process. You +can use this functionality to put an Emacs process in a sandbox to +avoid security issues when executing untrusted code. See the manual +page for 'seccomp' system call, for details about Secure Computing +filters. + +** Emacs can support 24-bit color TTY without terminfo database. +If your text-mode terminal supports 24-bit true color, but your system +lacks the terminfo database, you can instruct Emacs to support 24-bit +true color by setting 'COLORTERM=truecolor' in the environment. This is +useful on systems such as FreeBSD which ships only with "etc/termcap". + +--- +** File names given on the command line are now be pushed onto history. +The file names will be pushed onto 'file-name-history', like the names +of files visited via 'C-x C-f' and other commands. + + +* Changes in Emacs 28.1 + +--- +** Emacs now supports Unicode Standard version 14.0. + ++++ +** Improved support for Emoji. +On capable systems, Emacs now correctly displays Emoji and Emoji +sequences by default, provided that a suitable font is available to +Emacs. With a few exceptions, all of the Emoji sequences specified by +Unicode 14.0 are automatically composed and displayed as a single +colorful glyph. This is achieved by changes in the Emacs font +configuration, and by additional character-composition rules for the +Emoji codepoints that follow from the Unicode-defined sequences. + +If your system lacks a suitable font, we recommend to install "Noto +Color Emoji"; Emacs will use it automatically if it's installed. If +you prefer to use another font for Emoji, customize your fontset like +this: + + (set-fontset-font t 'emoji + '("My New Emoji Font" . "iso10646-1") nil 'prepend) + +The Emoji characters are now assigned to a special script, 'emoji', so +as to make it easier to customize fontsets for Emoji display, as in +the above example. (Previously, the Emoji characters were assigned to +the 'symbol' script, together with other symbol and punctuation +characters.) + ++++ +** 'glyphless-char-display-control' now applies to Variation Selectors. +VS-1 through VS-16 are now displayed as 'thin-space' by default when +not composed with previous characters (typically, as part of Emoji +sequences). + ++++ +** New command 'execute-extended-command-for-buffer'. +This new command, bound to 'M-S-x', works like +'execute-extended-command', but limits the set of commands to the +commands that have been determined to be particularly useful with the +current mode. + ++++ +** New user option 'read-extended-command-predicate'. +This user option controls how 'M-x' performs completion of commands when +you type 'TAB'. By default, any command that matches what you have +typed is considered a completion candidate, but you can customize this +option to exclude commands that are not applicable to the current +buffer's major and minor modes, and respect the command's completion +predicate (if any). + ++++ +** Completion on 'M-x' shows key bindings for commands. +When 'suggest-key-bindings' is non-nil (as it is by default), the +completion list popped up by 'M-x' shows the key bindings for all the +commands shown in the list of candidate completions that have a key +binding. + ++++ +** New user option 'completions-detailed'. +When non-nil, some commands like 'describe-symbol' show more detailed +completions with more information in completion prefix and suffix. +The default is nil. + +--- +** 'C-s' in 'M-x' now once again searches over completions. +In Emacs 23, typing 'M-x' ('read-extended-command') and then 'C-s' (to +do an interactive search) would search over possible completions. +This was lost in Emacs 24, but is now back again. + ++++ +** User option 'completions-format' supports a new value 'one-column'. + ++++ +** New system for displaying documentation for groups of functions. +This can either be used by saying 'M-x shortdoc-display-group' and +choosing a group, or clicking a button in the "*Help*" buffers when +looking at the doc string of a function that belongs to one of these +groups. + ++++ +** New minor mode 'context-menu-mode' for context menus popped by 'mouse-3'. +When this mode is enabled, clicking 'down-mouse-3' (usually, the +right mouse button) anywhere in the buffer pops up a menu whose +contents depends on surrounding context near the mouse click. +You can change the order of the default sub-menus in the context menu +by customizing the user option 'context-menu-functions'. You can also +invoke the context menu by pressing 'S-<F10>' or, on macOS, by +clicking 'C-down-mouse-1'. + ++++ +** A new keymap for buffer actions has been added. +The 'C-x x' keymap now holds keystrokes for various buffer-oriented +commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'), +'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n' +('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t' +('toggle-truncate-lines') and 'C-x x f' ('font-lock-update'). + ++++ +** Modifiers now go outside angle brackets in pretty-printed key bindings. +For example, 'RET' with Control and Meta modifiers is now shown as +'C-M-<return>' instead of '<C-M-return>'. Either variant can be used +as input; functions such as 'kbd' and 'read-kbd-macro' accept both +styles as equivalent (they have done so for a long time). + +--- +** 'eval-expression' no longer signals an error on incomplete expressions. +Previously, typing 'M-: ( RET' would result in Emacs saying "End of +file during parsing" and dropping out of the minibuffer. The user +would have to type 'M-: M-p' to edit and redo the expression. Now +Emacs will echo the message and allow the user to continue editing. + ++++ +** 'eval-last-sexp' now handles 'defvar'/'defcustom'/'defface' specially. +This command would previously not redefine values defined by these +forms, but this command has now been changed to work more like +'eval-defun', and reset the values as specified. + +--- +** New user option 'use-short-answers'. +When non-nil, the function 'y-or-n-p' is used instead of +'yes-or-no-p'. This eliminates the need to define an alias that maps +one to another in the init file. The same user option also controls +whether the function 'read-answer' accepts short answers. + ++++ +** New user option 'kill-buffer-delete-auto-save-files'. +If non-nil, killing a buffer that has an auto-save file will prompt +the user for whether that auto-save file should be deleted. (Note +that 'delete-auto-save-files', if non-nil, was previously documented +to result in deletion of auto-save files when killing a buffer without +unsaved changes, but this has apparently not worked for several +decades, so the documented semantics of this variable has been changed +to match the behavior.) + ++++ +** New user option 'next-error-message-highlight'. +In addition to a fringe arrow, 'next-error' error may now optionally +highlight the current error message in the 'next-error' buffer. +This user option can be also customized to keep highlighting on all +visited errors, so you can have an overview what errors were already visited. + +--- +** New choice 'next-error-quit-window' for 'next-error-found-function'. +When 'next-error-found-function' is customized to 'next-error-quit-window', +then typing the numeric prefix argument 0 before the command 'next-error' +will quit the source window after visiting the next occurrence. + ++++ +** New user option 'file-preserve-symlinks-on-save'. +This controls what Emacs does when saving buffers that visit files via +symbolic links, and 'file-precious-flag' is non-nil. + ++++ +** New user option 'copy-directory-create-symlink'. +If non-nil, will make 'copy-directory' (when used on a symbolic +link) copy the link instead of following the link. The default is +nil, so the default behavior is unchanged. + ++++ +** New user option 'ignored-local-variable-values'. +This is the opposite of 'safe-local-variable-values' -- it's an alist +of variable-value pairs that are to be ignored when reading a +local-variables section of a file. + +--- +** Specific warnings can now be disabled from the warning buffer. +When a warning is displayed to the user, the resulting buffer now has +buttons which allow making permanent changes to the treatment of that +warning. Automatic showing of the warning can be disabled (although +it is still logged to the "*Messages*" buffer), or the warning can be +disabled entirely. + ++++ +** ".dir-locals.el" now supports setting 'auto-mode-alist'. +The new 'auto-mode-alist' specification in ".dir-locals.el" files can +now be used to override the global 'auto-mode-alist' in the current +directory tree. + +--- +** User option 'uniquify-buffer-name-style' can now be a function. +This user option can be one of the predefined styles or a function to +personalize the uniquified buffer name. + +--- +** 'remove-hook' is now an interactive command. + +--- +** 'expand-file-name' now checks for null bytes in filenames. +The function will now check for null bytes in both NAME and +DEFAULT-DIRECTORY arguments, as well as in the 'default-directory' +buffer-local variable, when its value is used. If null bytes are +found, 'expand-file-name' will signal an error. +This means that practically all file-related operations will now check +file names for null bytes, thus avoiding subtle bugs with silently +using only the part of file name up to the first null byte. + +--- +** Frames + ++++ +*** The key prefix 'C-x 5 5' displays next command buffer in a new frame. +It's bound to the command 'other-frame-prefix' that requests the buffer +of the next command to be displayed in a new frame. + ++++ +*** New command 'clone-frame' (bound to 'C-x 5 c'). +This is like 'C-x 5 2', but uses the window configuration and frame +parameters of the current frame instead of 'default-frame-alist'. +When called interactively with a prefix arg, the window configuration +is not cloned. + +--- +*** Default values of 'frame-title-format' and 'icon-title-format' have changed. +These variables are used to display the title bar of visible frames +and the title bar of an iconified frame. They now show the name of +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))) + ++++ +*** New frame parameter 'drag-with-tab-line'. +This parameter, similar to 'drag-with-header-line', allows moving frames +by dragging the tab lines of their topmost windows with the mouse. + ++++ +*** New optional behavior of 'delete-other-frames'. +When invoked with a prefix argument, 'delete-other-frames' now +iconifies frames, rather than deleting them. + +--- +*** Commands 'set-frame-width' and 'set-frame-height' now prompt for values. +These commands now prompt for the value via the minibuffer, instead of +requiring the user to specify the value via the prefix argument. + +** Windows + ++++ +*** The key prefix 'C-x 4 1' displays next command buffer in the same window. +It's bound to the command 'same-window-prefix' that requests the buffer +of the next command to be displayed in the same window. + ++++ +*** The key prefix 'C-x 4 4' displays next command buffer in a new window. +It's bound to the command 'other-window-prefix' that requests the buffer +of the next command to be displayed in a new window. + ++++ +*** New command 'recenter-other-window', bound to 'S-M-C-l'. +Like 'recenter-top-bottom', but acting on the other window. + ++++ +*** New user option 'delete-window-choose-selected'. +This allows specifying how Emacs chooses which window will be the +frame's selected window after the currently selected window is +deleted. + ++++ +*** New argument NO-OTHER for some window functions. +'get-lru-window', 'get-mru-window' and 'get-largest-window' now accept a +new optional argument NO-OTHER which, if non-nil, avoids returning a +window whose 'no-other-window' parameter is non-nil. + ++++ +*** New 'display-buffer' function 'display-buffer-use-least-recent-window'. +This is like 'display-buffer-use-some-window', but won't reuse the +current window, and when called repeatedly will try not to reuse a +previously selected window. + ++++ +*** New function 'window-bump-use-time'. +This updates the use time of a window. + +** Minibuffer + ++++ +*** Minibuffer scrolling is now conservative by default. +This is controlled by the new variable 'scroll-minibuffer-conservatively'. +It is t by default; setting it to nil will cause scrolling in the +minibuffer obey the value of 'scroll-conservatively'. + ++++ +*** Improved handling of minibuffers on switching frames. +By default, when you switch to another frame, an active minibuffer now +moves to the newly selected frame. Nevertheless, the effect of what +you type in the minibuffer happens in the frame where the minibuffer +was first activated. An alternative behavior is available by +customizing 'minibuffer-follows-selected-frame' to nil. Here, the +minibuffer stays in the frame where you first opened it, and you must +switch back to this frame to continue or abort its command. The old +behavior, which mixed these two, can be approximated by customizing +'minibuffer-follows-selected-frame' to a value which is neither nil +nor t. + ++++ +*** New user option 'read-minibuffer-restore-windows'. +When customized to nil, it uses 'minibuffer-restore-windows' in +'minibuffer-exit-hook' to remove only the window showing the +"*Completions*" buffer, but keeps all other windows created +while the minibuffer was active. + +--- +*** New variable 'redisplay-adhoc-scroll-in-resize-mini-windows'. +Customizing it to nil will disable the ad-hoc auto-scrolling of +minibuffer text shown in mini-windows when resizing those windows. +The default heuristics of that scrolling can be counter productive in +some corner cases, though the cure might be worse than the disease. +This said, the effect should be negligible in the vast majority of +cases anyway. + +** Mode Line + ++++ +*** New user option 'mode-line-compact'. +If non-nil, repeating spaces are compressed into a single space. If +'long', this is only done when the mode line is longer than the +current window width (in columns). + ++++ +*** New user options to control format of line/column numbers in the mode line. +'mode-line-position-line-format' is the line number format (when +'line-number-mode' is on), 'mode-line-position-column-format' is +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). + +** Tab Bars and Tab Lines + ++++ +*** The prefix key 'C-x t t' can be used to display a buffer in a new tab. +Typing 'C-x t t' before a command will cause the buffer shown by that +command to be displayed in a new tab. 'C-x t t' is bound to the +command 'other-tab-prefix'. + ++++ +*** New command 'C-x t C-r' to open file read-only in the other tab. + +*** The tab bar now supports more mouse commands. +Clicking 'mouse-2' closes the tab, 'mouse-3' displays the context menu +with items that operate on the clicked tab. Dragging the tab with +'mouse-1' moves it to another position on the tab bar. Mouse wheel +scrolling switches to the previous/next tab, and holding the Shift key +during scrolling moves the tab to the left/right. + ++++ +*** Frame-specific appearance of the tab bar when 'tab-bar-show' is a number. +When 'tab-bar-show' is a number, the tab bar on different frames can +be shown or hidden independently, as determined by the number of tabs +on each frame compared to the numerical value of 'tab-bar-show'. + ++++ +*** New command 'toggle-frame-tab-bar'. +It can be used to enable/disable the tab bar on the currently selected +frame regardless of the values of 'tab-bar-mode' and 'tab-bar-show'. +This allows enabling/disabling the tab bar independently on different +frames. + +--- +*** New user option 'tab-bar-format' defines a list of tab bar items. +When it contains 'tab-bar-format-global' (possibly appended after +'tab-bar-format-align-right'), then after enabling 'display-time-mode' +(or any other mode that uses 'global-mode-string') it displays time +aligned to the right on the tab bar instead of on the mode line. +When 'tab-bar-format-tabs' is replaced with 'tab-bar-format-tabs-groups', +the tab bar displays tab groups. + +--- +*** New optional key binding for 'tab-last'. +If you customize the user option 'tab-bar-select-tab-modifiers' to +allow selecting tabs using their index numbers, the '<MODIFIER>-9' key +is bound to 'tab-last', and switches to the last tab. Here <MODIFIER> +is any of the modifiers in the list that is the value of +'tab-bar-select-tab-modifiers'. You can also use negative indices, +which count from the last tab: -1 is the last tab, -2 the one before +that, etc. + +--- +*** New command 'tab-duplicate' bound to 'C-x t n'. + +--- +*** 'C-x t N' creates a new tab at the specified absolute position. +The position is provided as prefix arg, and specifies an index that +starts at 1. Negative values count from the end of the tab bar. + +--- +*** 'C-x t M' moves the current tab to the specified absolute position. +The position is provided as prefix arg, whose interpretation is as in +'C-x t N'. + +--- +*** 'C-x t G' assigns a tab to a named group of tabs. +'tab-close-group' closes all tabs that belong to the selected group. +The user option 'tab-bar-new-tab-group' defines the default group of +new tabs. After customizing 'tab-bar-tab-post-change-group-functions' +to 'tab-bar-move-tab-to-group', changing the group of a tab will also +move it closer to other tabs in the same group. + +--- +*** New user option 'tab-bar-tab-name-format-function'. + +--- +*** New user option 'tab-line-tab-name-format-function'. + +--- +*** The tabs in the tab line can now be scrolled using horizontal scroll. +If your mouse or trackpad supports it, you can now scroll tabs when +the mouse pointer is in the tab line by scrolling left or right. + +--- +*** New tab-line faces and user options. +The face 'tab-line-tab-special' is used for tabs whose buffers are +special, i.e. buffers that don't visit a file. The face +'tab-line-tab-modified' is used to display modified, file-backed +buffers. The face 'tab-line-tab-inactive-alternate' is used to +display inactive tabs with an alternating background color, making +them easier to distinguish, especially if the face 'tab-line-tab' is +configured to not display with a box; this alternate face is only +applied when the user option 'tab-line-tab-face-functions' is so +configured. That option may also be used to customize tab-line faces +in other ways. + +** Mouse wheel + +--- +*** Mouse wheel scrolling now defaults to one line at a time. + +--- +*** Mouse wheel scrolling now works on more parts of frame's display. +When using 'mouse-wheel-mode', the mouse wheel will now scroll also when +the mouse cursor is on the scroll bars, fringes, margins, header line, +and mode line. ('mouse-wheel-mode' is enabled by default on most graphical +displays.) + ++++ +*** Mouse wheel scrolling with Shift modifier now scrolls horizontally. +This works in text buffers and over images. Typing a numeric prefix arg +(e.g. 'M-5') before starting horizontal scrolling changes its step value. +The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'. + +** Customize + +--- +*** Customize buffers can now be reverted with 'C-x x g'. + +--- +*** Most customize commands now hide obsolete user options. +Obsolete user options are no longer shown in the listings produced by +the commands 'customize', 'customize-group', 'customize-apropos' and +'customize-changed'. + +To customize obsolete user options, use 'customize-option' or +'customize-saved'. + +--- +*** New SVG icons for checkboxes and arrows. +They will be used automatically instead of the old icons. If Emacs is +built without SVG support, the old icons will be used instead. + +** Help + +--- +*** The order of things displayed in the "*Help*" buffer has been changed. +The indented "administrative" block (containing the "probably +introduced" and "other relevant functions" (and similar things) has +been moved to after the doc string. + ++++ +*** New command 'describe-command' shows help for a command. +This can be used instead of 'describe-function' for interactive +commands and is globally bound to 'C-h x'. + ++++ +*** New command 'describe-keymap' describes keybindings in a keymap. + +--- +*** New command 'apropos-function'. +This works like 'C-u M-x apropos-command' but is more discoverable. + +--- +*** New keybinding 'C-h R' prompts for an Info manual and displays it. + +--- +*** Keybindings in 'help-mode' use the new 'help-key-binding' face. +This face is added by 'substitute-command-keys' to any "\[command]" +substitution. The return value of that function should consequently +be assumed to be a propertized string. + +Note that the new face will also be used in tooltips. When using the +GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t. + ++++ +*** New user option 'help-enable-symbol-autoload'. +If non-nil, displaying help for an autoloaded function whose +'autoload' form provides no documentation string will try to load the +file it's from. This will give more extensive help for such +functions. + +--- +*** The 'help-for-help' ('C-h C-h') screen has been redesigned. + ++++ +*** New convenience commands with short keys in the Help buffer. +New command 'help-view-source' ('s') will view the source file (if +any) of the current help topic. New command 'help-goto-info' ('i') +will look up the current symbol (if any) in Info. New command +'help-customize' ('c') will customize the user option or the face +(if any) whose doc string is being shown in the Help buffer. + +--- +*** New user option 'describe-bindings-outline'. +It enables outlines in the output buffer of 'describe-bindings' that +can provide a better overview in a long list of available bindings. + ++++ +*** New commands to describe buttons and widgets. +'widget-describe' (on a widget) will pop up a help buffer and give a +description of the properties. Likewise 'button-describe' does the +same for a button. + +--- +*** Improved "find definition" feature of "*Help*" buffers. +Now clicking on the link to find the definition of functions generated +by 'cl-defstruct', or variables generated by 'define-derived-mode', +for example, will go to the exact place where they are defined. + +--- +*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'. +These new navigation commands are bound to 'n' and 'p' in +'apropos-mode'. + +--- +*** The command 'view-lossage' can now be invoked from the menu bar. +The menu bar "Help" menu now has a "Show Recent Inputs" item under the +"Describe" sub-menu. + ++++ +*** New command 'lossage-size'. +It allows users to change the maximum number of keystrokes and +commands recorded for the purpose of 'view-lossage'. + +--- +*** Closing the "*Help*" buffer from the toolbar now buries the buffer. +In previous Emacs versions, the "*Help*" buffer was killed instead when +clicking the "X" icon in the tool bar. + +--- +*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation. + +** File Locks + ++++ +*** New user option 'lock-file-name-transforms'. +This option allows controlling where lock files are written. It uses +the same syntax as 'auto-save-file-name-transforms'. + ++++ +*** New user option 'remote-file-name-inhibit-locks'. +When non-nil, this option suppresses lock files for remote files. +Default is nil. + ++++ +*** New minor mode 'lock-file-mode'. +This command, called interactively, toggles the local value of +'create-lockfiles' in the current buffer. + +** Emacs Server + ++++ +*** New user option 'server-client-instructions'. +When emacsclient connects, Emacs will (by default) output a message +about how to exit the client frame. If 'server-client-instructions' +is set to nil, this message is inhibited. + ++++ +*** New command 'server-edit-abort'. +This command (not bound to any key by default) can be used to abort +an edit instead of marking it as "Done" (which the 'C-x #' command +does). The 'emacsclient' program exits with an abnormal status as +result of this command. + ++++ +*** New desktop integration for connecting to the server. +If your operating system’s desktop environment is +freedesktop.org-compatible (which is true of most GNU/Linux and other +recent Unix-like desktops), you may use the new "Emacs (Client)" +desktop menu entry to open files in an existing Emacs instance rather +than starting a new one. The daemon starts if it is not already +running. + +** Miscellaneous + ++++ +*** New command 'font-lock-update', bound to 'C-x x f'. +This command updates the syntax highlighting in this buffer. + ++++ +*** New command 'memory-report'. +This command opens a new buffer called "*Memory Report*" and gives a +summary of where Emacs is using memory currently. + ++++ +*** New command 'submit-emacs-patch'. +This works like 'report-emacs-bug', but is more geared towards sending +patches to the Emacs issue tracker. + +--- +*** New face 'apropos-button'. +Applies to buttons that indicate a face. + ++++ +*** New face 'font-lock-doc-markup-face'. +Intended for documentation mark-up syntax and tags inside text that +uses 'font-lock-doc-face', which it should appropriately stand out +against and harmonize with. It would typically be used in structured +documentation comments in program source code by language-specific +modes, for mark-up conventions like Haddock, Javadoc or Doxygen. By +default this face inherits from 'font-lock-constant-face'. + ++++ +*** New face box style 'flat-button'. +This is a plain 2D button, but uses the background color instead of +the foreground color. + +--- +*** New faces 'shortdoc-heading' and 'shortdoc-section'. +Applied to shortdoc headings and sections. + +--- +*** New face 'separator-line'. +This is used by 'make-separator-line' (see below). + ++++ +*** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input. +This is another attempt to solve the problem of handling high key repeat rate +and other "slow scrolling" situations. It is hoped it behaves better +than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'. +It is not enabled by default. + +--- +*** Obsolete aliases are no longer hidden from command completion. +Completion of command names now considers obsolete aliases as +candidates, if they were marked obsolete in the current major version +of Emacs. Invoking a command via an obsolete alias now mentions the +obsolescence fact and shows the new name of the command. + ++++ +*** Support for '(box . SIZE)' 'cursor-type'. +By default, 'box' cursor always has a filled box shape. But if you +specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow +box if the point is on an image larger than SIZE pixels in any +dimension. + ++++ +*** The user can now customize how "default" values are prompted for. +The new utility function 'format-prompt' has been added which uses the +new 'minibuffer-default-prompt-format' user option to format "default" +prompts. This means that prompts that look like "Enter a number +(default 10)" can be customized to look like, for instance, "Enter a +number [10]", or not have the default displayed at all, like "Enter a +number". (This only affects callers that were altered to use +'format-prompt'.) + +--- +*** New help window when Emacs prompts before opening a large file. +Commands like 'find-file' or 'visit-tags-table' ask to visit a file +normally or literally when the file is larger than a certain size (by +default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more +about the different options to visit a file, how you can disable the +prompt, and how you can tweak the file size threshold. + ++++ +*** Emacs now defaults to UTF-8 instead of ISO-8859-1. +This is only for the default, where the user has set no 'LANG' (or +similar) variable or environment. This change should lead to no +user-visible changes for normal usage. + +--- +*** 'global-display-fill-column-indicator-mode' skips some buffers. +By default, turning on 'global-display-fill-column-indicator-mode' +doesn't turn on 'display-fill-column-indicator-mode' in special-mode +buffers. This can be controlled by customizing the user option +'global-display-fill-column-indicator-modes'. + ++++ +*** 'nobreak-char-display' now also affects all non-ASCII space characters. +Previously, this was limited only to 'NO-BREAK SPACE' and hyphen +characters. Now it also covers the rest of the non-ASCII Unicode +space characters. Also, unlike in previous versions of Emacs, the +non-ASCII characters are displayed as themselves when +'nobreak-char-display' is t, i.e. they are not replaced on display +with the ASCII space and hyphen characters. + +--- +*** New backward compatibility variable 'nobreak-char-ascii-display'. +This variable is nil by default, and non-ASCII space and hyphen +characters are displayed as themselves, even if 'nobreak-char-display' +is non-nil. If 'nobreak-char-ascii-display' is set to a non-nil +value, the non-ASCII space and hyphen characters are instead displayed +as their ASCII counterparts: spaces and ASCII hyphen (a.k.a. "dash") +characters. This provides backward compatibility feature for the +change described above, where the non-ASCII characters are no longer +replaced with their ASCII counterparts when 'nobreak-char-display' is +t. You may need this on text-mode terminals that produce messed up +display when non-ASCII spaces and hyphens are written to the display. +(This variable is only effective when 'nobreak-char-display' is t.) + ++++ +*** Improved support for terminal emulators that encode the Meta flag. +Some terminal emulators set the 8th bit of Meta characters, and then +encode the resulting character code as if it were non-ASCII character +above codepoint 127. Previously, the only way of using these in Emacs +was to set up the terminal emulator to use the 'ESC' characters to send +Meta characters to Emacs, e.g., send "ESC x" when the user types +'M-x'. You can now avoid the need for this setup of such terminal +emulators by using the new input-meta-mode with the special value +'encoded' with these terminal emulators. + +--- +*** 'auto-composition-mode' can now be selectively disabled on some TTYs. +Some text-mode terminals produce display glitches trying to compose +characters. The 'auto-composition-mode' can now have a string value +that names a terminal type; if the value returned by the 'tty-type' +function compares equal with that string, automatic composition will +be disabled in windows shown on that terminal. The Linux terminal +sets this up by default. + +--- +*** Support for the 'strike-through' face attribute on TTY frames. +If your terminal's termcap or terminfo database entry has the 'smxx' +capability defined, Emacs will now emit the prescribed escape +sequences necessary to render faces with the 'strike-through' +attribute on TTY frames. + +--- +*** TTY menu navigation is now supported in 'xterm-mouse-mode'. +TTY menus support mouse navigation and selection when 'xterm-mouse-mode' +is active. When run on a terminal, clicking on the menu bar with the +mouse now pops up a TTY menu by default instead of running the command +'tmm-menubar'. To restore the old behavior, set the user option +'tty-menu-open-use-tmm' to non-nil. + +--- +*** 'M-x report-emacs-bug' will no longer include "Recent messages" section. +These were taken from the "*Messages*" buffer, and may inadvertently +leak information from the reporting user. + +--- +*** 'C-u M-x dig' will now prompt for a query type to use. + +--- +*** Rudimentary support for the 'st' terminal emulator. +Emacs now supports 256 color display on the 'st' terminal emulator. + ++++ +*** Update IRC-related references to point to Libera.Chat. +The Free Software Foundation and the GNU Project have moved their +official IRC channels from the Freenode network to Libera.Chat. For the +original announcement and the follow-up update, including more details, +see: + +https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html +https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html + +Given the relocation of GNU and FSF's official IRC channels, as well +as #emacs and various other Emacs-themed channels (see the link below) +to Libera.Chat, IRC-related references in the Emacs repository have +now been updated to point to Libera.Chat. + +https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html + + +* Incompatible Editing Changes in Emacs 28.1 + +--- +** 'toggle-truncate-lines' now disables 'visual-line-mode'. +This is for symmetry with 'visual-line-mode', which disables +'truncate-lines'. + +--- +** 'electric-indent-mode' now also indents inside strings and comments. +(This only happens when indentation function also supports this.) + +To recover the previous behavior you can use: + + (add-hook 'electric-indent-functions + (lambda (_) (if (nth 8 (syntax-ppss)) 'no-indent))) + +--- +** The 'M-o' ('facemenu-keymap') global binding has been removed. +To restore the old binding, say something like: + + (require 'facemenu) + (define-key global-map "\M-o" 'facemenu-keymap) + (define-key facemenu-keymap "\es" 'center-line) + (define-key facemenu-keymap "\eS" 'center-paragraph) + +The last two lines are not strictly necessary if you don't care about +having those two commands on the 'M-o' keymap; see the next section. + +--- +** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. +Use 'M-x center-line' and 'M-x center-paragraph' instead. See the +previous section for how to get back the old bindings. Alternatively, +if you only want these two commands to have the global bindings they +had before, you can add the following to your init file: + + (define-key global-map "\M-o\M-s" 'center-line) + (define-key global-map "\M-o\M-S" 'center-paragraph) + +--- +** The 'M-o M-o' global binding has been removed. +Use 'M-x font-lock-fontify-block' instead, or the new 'C-x x f' +command, which updates the syntax highlighting in the current buffer. + +--- +** The escape sequence '\e[29~' in Xterm is now mapped to 'menu'. +Xterm sends this sequence for both 'F16' and 'Menu' keys +It used to be mapped to 'print' but we couldn't find a terminal +that uses this sequence for any kind of 'Print' key. +This makes the Menu key (see https://en.wikipedia.org/wiki/Menu_key) +work for 'context-menu-mode' in Xterm. + +--- +** New user option 'xterm-store-paste-on-kill-ring'. +If non-nil (the default), Emacs pushes pasted text onto the kill ring +(if using an xterm-like terminal that supports bracketed paste). +Setting this to nil inhibits that. + +--- +** 'vc-print-branch-log' shows the change log from its root directory. +It previously used to use the default directory. + +--- +** 'project-shell' and 'shell' now use 'pop-to-buffer-same-window'. +This is to keep the same behavior as Eshell. + +--- +** In 'nroff-mode', 'center-line' is no longer bound to a key. +The original key binding was 'M-s', which interfered with I-search, +since the latter uses 'M-s' as a prefix key of the search prefix map. + +--- +** In 'f90-mode', the backslash character ('\') no longer escapes. +For about a decade, the backslash character has no longer had a +special escape syntax in Fortran F90. To get the old behavior back, +say something like: + + (modify-syntax-entry ?\\ "\\" f90-mode-syntax-table) + ++++ +** Setting 'fill-column' to nil is obsolete. +This undocumented use of 'fill-column' is now obsolete. To disable +auto filling, turn off 'auto-fill-mode' instead. + +For instance, you could add something like the following to your init +file: + + (add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1)) + +** Xref migrated from EIEIO to cl-defstruct for its core objects. +This means that 'oref' and 'with-slots' no longer works on them, and +'make-instance' can no longer be used to create those instances (which +wasn't recommended anyway). Packages should restrict themselves to +using functions like 'xref-make', 'xref-make-match', +'xref-make-*-location', as well as accessor functions +'xref-item-summary' and 'xref-item-location'. + +Among the benefits are better performance (noticeable when there are a +lot of matches) and improved flexibility: 'xref-match-item' instances +do not require that 'location' inherits from 'xref-location' anymore +(that class was removed), so packages can create new location types to +use with "match items" without adding EIEIO as a dependency. + + +* Editing Changes in Emacs 28.1 + +** Input methods + ++++ +*** Emacs now supports "transient" input methods. +A transient input method is enabled for inserting a single character, +and is then automatically disabled. 'C-x \' temporarily enables the +selected transient input method. Use 'C-u C-x \' to select a +transient input method (which can be different from the input method +enabled by 'C-\'). For example, 'C-u C-x \ compose RET' selects the +'compose' input method; then typing 'C-x \ 1 2' will insert the +character '½', and disable the 'compose' input method afterwards. +You can use 'C-x \' in incremental search to insert a single character +to the search string. + +--- +*** New input method 'compose' based on X Multi_key sequences. + +--- +*** New input method 'iso-transl' with the same keys as 'C-x 8'. +After selecting it as a transient input method with 'C-u C-x \ +iso-transl RET', it supports the same key sequences as 'C-x 8', +so e.g. like 'C-x 8 [' inserts a left single quotation mark, +'C-x \ [' does the same. + +--- +*** New user option 'read-char-by-name-sort'. +It defines the sorting order of characters for completion of 'C-x 8 RET TAB' +and can be customized to sort them by codepoints instead of character names. +Additionally, you can group characters by Unicode blocks after customizing +'completions-group' and 'completions-group-sort'. + +--- +*** Improved language transliteration in Malayalam input methods. +Added a new Mozhi scheme. The inapplicable ITRANS scheme is now +deprecated. Errors in the Inscript method were corrected. + +--- +*** New input method 'cham'. +There's also a Cham greeting in "etc/HELLO". + +--- +*** New input methods for Lakota language orthographies. +Two orthographies are represented here, the Suggested Lakota +Orthography and what is known as the White Hat Orthography. Input +methods 'lakota-slo-prefix', 'lakota-slo-postfix', and +'lakota-white-hat-postfix' have been added. There is also a Lakota +greeting in "etc/HELLO". + ++++ +** Standalone 'M-y' allows interactive selection from previous kills. +'M-y' can now be typed after a command that is not a yank command. +When invoked like that, it prompts in the minibuffer for one of the +previous kills, offering completion and minibuffer-history navigation +through previous kills recorded in the kill ring. A similar feature +in Isearch can be invoked if you bind 'C-s M-y' to the command +'isearch-yank-pop'. When the user option 'yank-from-kill-ring-rotate' +is nil the kill ring is not rotated after 'yank-from-kill-ring'. + ++++ +** New user option 'word-wrap-by-category'. +When word-wrap is enabled, and this option is non-nil, that allows +Emacs to break lines after more characters than just whitespace +characters. In particular, this significantly improves word-wrapping +for CJK text mixed with Latin text. + ++++ +** New command 'undo-redo'. +It undoes previous undo commands, but doesn't record itself as an +undoable command. It is bound to 'C-?' and 'C-M-_', the first binding +works well in graphical mode, and the second one is easy to hit on tty. + +For full conventional undo/redo behavior, you can also customize the +user option 'undo-no-redo' to t. + ++++ +** New commands 'copy-matching-lines' and 'kill-matching-lines'. +These commands are similar to the command 'flush-lines', +but add the matching lines to the kill ring as a single string, +including the newlines that separate the lines. + ++++ +** New user option 'kill-transform-function'. +This can be used to transform (and suppress) strings from entering the +kill ring. + ++++ +** 'save-interprogram-paste-before-kill' can now be a number. +In that case, it's interpreted as a limit on the size of the clipboard +data that will be saved to the 'kill-ring' prior to killing text: if +the size of the clipboard data is greater than or equal to the limit, +it will not be saved. + ++++ +** New user option 'tab-first-completion'. +If 'tab-always-indent' is 'complete', this new user option can be used to +further tweak whether to complete or indent. + +--- +** 'indent-tabs-mode' is now a global minor mode instead of just a variable. + ++++ +** New choice 'permanent' for 'shift-select-mode'. +When the mark was activated by shifted motion keys, non-shifted motion +keys don't deactivate the mark after customizing 'shift-select-mode' +to 'permanent'. Similarly, the active mark will not be deactivated by +typing shifted motion keys. + ++++ +** The "Edit => Clear" menu item now obeys a rectangular region. + ++++ +** New command 'revert-buffer-with-fine-grain'. +Revert a buffer trying to be as non-destructive as possible, +preserving markers, properties and overlays. The new variable +'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, with a default value of 2 seconds. + ++++ +** New command 'revert-buffer-quick'. +This is bound to 'C-x x g' and is like 'revert-buffer', but prompts +less. + ++++ +** New user option 'revert-buffer-quick-short-answers'. +This controls how the new 'revert-buffer-quick' ('C-x x g') command +prompts. A non-nil value will make it use 'y-or-n-p' rather than +'yes-or-no-p'. Defaults to nil. + ++++ +** New user option 'query-about-changed-file'. +If non-nil (the default), Emacs prompts as before when re-visiting a +file that has changed externally after it was visited the first time. +If nil, Emacs does not prompt, but instead shows the buffer with its +contents before the change, and provides instructions how to revert +the buffer. + +--- +** New value 'save-some-buffers-root' of 'save-some-buffers-default-predicate'. +When using this predicate, only buffers under the current project root +will be considered when saving buffers with 'save-some-buffers'. + +--- +** New user option 'save-place-abbreviate-file-names'. +This can simplify sharing the 'save-place-file' file across +different hosts. + +--- +** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'. +'copy-region-blink-delay' specifies a delay to indicate the region +copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies +a delay to show the paired character to delete. + +--- +** 'zap-up-to-char' now uses 'read-char-from-minibuffer'. +This allows navigating through the history of characters that have +been input. This is mostly useful for characters that have complex +input methods where inputting the character again may involve many +keystrokes. + ++++ +** Input history for 'goto-line' can now be made local to every buffer. +In any event, line numbers used with 'goto-line' are kept in their own +history list. This should help make faster the process of finding +line numbers that were previously jumped to. By default, all buffers +share a single history list. To make every buffer have its own +history list, customize the user option 'goto-line-history-local'. + ++++ +** New command 'goto-line-relative' for use in a narrowed buffer. +It moves point to the line relative to the accessible portion of the +narrowed buffer. 'M-g M-g' in Info is rebound to this command. +When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed +buffer to be able to move point to the inaccessible portion. +'goto-line-relative' is bound to 'C-x n g'. + ++++ +** 'goto-char' prompts for the character position. +When called interactively, 'goto-char' now offers the position at +point as the default. + +** Auto-saving via 'auto-save-visited-mode' can now be inhibited. +Set the variable 'auto-save-visited-mode' buffer-locally to nil to +achieve that. + ++++ +** New command 'kdb-macro-redisplay' to force redisplay in keyboard macros. +This command is bound to 'C-x C-k d'. + +--- +** 'blink-cursor-mode' is now enabled by default regardless of the UI. +It used to be enabled when Emacs is started in GUI mode but not when started +in text mode. The cursor still only actually blinks in GUI frames. + +** 'show-paren-mode' is now enabled by default. +To go back to the previous behavior, customize the user option of the +same name to nil. + ++++ +** New minor mode 'show-paren-local-mode'. +It serves as a local counterpart for 'show-paren-mode', allowing you +to toggle it separately in different buffers. To use it only in +programming modes, for example, add the following to your init file: + + (add-hook 'prog-mode-hook #'show-paren-local-mode) + + +* Changes in Specialized Modes and Packages in Emacs 28.1 + +** Isearch and Replace + ++++ +*** Interactive regular expression search now uses faces for sub-groups. +E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face +on the part of the regexp that matches the sub-expression "[0-9]+". +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 'isearch-wrap-pause' defines how to wrap the search. +There are choices to disable wrapping completely and to wrap immediately. +When wrapping immediately, it consistently handles the numeric arguments +of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'), +continuing with the remaining count after wrapping. + ++++ +*** New user option 'isearch-repeat-on-direction-change'. +When this option is set, direction changes in Isearch move to another +search match, if there is one, instead of moving point to the other +end of the current match. + +*** New key 'M-s M-.' starts isearch looking for the thing at point. +This key is bound to the new command 'isearch-forward-thing-at-point'. +The new user option 'isearch-forward-thing-at-point' defines +a list of symbols to try to get the "thing" at point. By default, +the first element of the list is 'region' that tries to yank +the currently active region to the search string. + ++++ +*** New user option 'lazy-highlight-no-delay-length'. +Lazy highlighting of matches in Isearch now starts immediately if the +search string is at least this long. 'lazy-highlight-initial-delay' +still applies for shorter search strings, which avoids flicker in the +search buffer due to too many matches being highlighted. + ++++ +*** The default 'search-whitespace-regexp' value has changed. +This used to be "\\s-+", which meant that it was mode-dependent whether +newlines were included in the whitespace set. This has now been +changed to only match spaces and tab characters. + +** Dired + ++++ +*** New user option 'dired-kill-when-opening-new-dired-buffer'. +If non-nil, Dired will kill the current buffer when selecting a new +directory to display. + ++++ +*** Behavior change on 'dired-do-chmod'. +As a security precaution, Dired's M command no longer follows symbolic +links. Instead, it changes the symbolic link's own mode; this always +fails on platforms where such modes are immutable. + +--- +*** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'. +Previously, if 'dired-clean-up-buffers-too' was non-nil, and +'dired-clean-confirm-killing-deleted-buffers' was nil, the buffers +wouldn't be killed. This combination will now kill the buffers. + ++++ +*** New user option 'dired-switches-in-mode-line'. +This user option controls how 'ls' switches are displayed in the mode +line, and allows truncating them (to preserve space on the mode line) +or showing them literally, either instead of, or in addition to, +displaying "by name" or "by date" sort order. + ++++ +*** New user option 'dired-compress-directory-default-suffix'. +This user option controls the default suffix for compressing a +directory. If it's nil, ".tar.gz" will be used. Refer to +'dired-compress-files-alist' for a list of supported suffixes. + ++++ +*** New user option 'dired-compress-file-default-suffix'. +This user option controls the default suffix for compressing files. +If it's nil, ".gz" will be used. Refer to 'dired-compress-file-alist' +for a list of supported suffixes. + +--- +*** Broken and circular links are shown with the 'dired-broken-symlink' face. + +--- +*** '=' ('dired-diff') will now put all backup files into the 'M-n' history. +When using '=' on a file with backup files, the default file to use +for diffing is the newest backup file. You can now use 'M-n' to quickly +select a different backup file instead. + ++++ +*** New user option 'dired-maybe-use-globstar'. +If set, enables globstar (recursive globbing) in shells that support +this feature, but have it turned off by default. This allows producing +directory listings with files matching a wildcard in all the +subdirectories of a given directory. The new variable +'dired-enable-globstar-in-shell' lists which shells can have globstar +enabled, and how to enable it. + ++++ +*** New user option 'dired-copy-dereference'. +If set to non-nil, Dired will dereference symbolic links when copying. +This can be switched off on a per-usage basis by providing +'dired-do-copy' with a 'C-u' prefix. + +--- +*** New user option 'dired-do-revert-buffer'. +Non-nil reverts the destination Dired buffer after performing one +of these operations: 'dired-do-copy', 'dired-do-rename', +'dired-do-symlink', 'dired-do-hardlink'. + +*** New user option 'dired-mark-region'. +This option affects all Dired commands that mark files. When non-nil +and the region is active in Transient Mark mode, then Dired commands +operate only on files in the active region. The values 'file' and +'line' of this user option define the details of marking the file at +the end of the region. + +*** State changing VC operations are supported in Dired. +These operations are supported on files and directories via the new +command 'dired-vc-next-action'. + ++++ +*** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'. +The 'dired-jump' and 'dired-jump-other-window' commands have been +moved from the 'dired-x' package to 'dired'. The user option +'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) + +--- +*** 'dired-query' now uses 'read-char-from-minibuffer'. +Using it instead of 'read-char-choice' allows using 'C-x o' +to switch to the help window displayed after typing 'C-h'. + ++++ +** New user option 'isearch-allow-motion'. +When 'isearch-allow-motion' is set, the commands 'beginning-of-buffer', +'end-of-buffer', 'scroll-up-command' and 'scroll-down-command', when +invoked during I-search, move respectively to the first occurrence of +the current search string in the buffer, the last one, the first one +after the current window, and the last one before the current window. +Additionally, users can change the meaning of other motion commands +during I-search by using their 'isearch-motion' property. The user +option 'isearch-motion-changes-direction' controls whether the +direction of the search changes after a motion command. + ++++ +** Emacs 28.1 comes with Org v9.5. +See the file ORG-NEWS for user-visible changes in Org. + +** Outline + ++++ +*** New commands to cycle heading visibility. +Typing 'TAB' on a heading line cycles the current section between +"hide all", "subheadings", and "show all" states. Typing 'S-TAB' +anywhere in the buffer cycles the whole buffer between "only top-level +headings", "all headings and subheadings", and "show all" states. + ++++ +*** New user option 'outline-minor-mode-cycle'. +This user option customizes 'outline-minor-mode', with the difference +that 'TAB' and 'S-TAB' on heading lines cycle heading visibility. +Typing 'TAB' on a heading line cycles the current section between +"hide all", "subheadings", and "show all" states. Typing 'S-TAB' on a +heading line cycles the whole buffer between "only top-level +headings", "all headings and subheadings", and "show all" states. + +--- +*** New user option 'outline-minor-mode-highlight'. +This user option customizes 'outline-minor-mode'. It puts +highlighting on heading lines using standard outline faces. This +works well only when there are no conflicts with faces used by the +major mode. + +** Ispell + ++++ +*** 'ispell-comments-and-strings' now accepts START and END arguments. +These arguments default to the active region when used interactively. + ++++ +*** New command 'ispell-comment-or-string-at-point'. + +--- +*** New user option 'ispell-help-timeout'. +This controls how long the ispell help (on the '?' key) is displayed. + +** Flyspell mode + ++++ +*** Corrections and actions menu can be optionally bound to 'mouse-3'. +When Flyspell mode highlights a word as misspelled, you can click on +it to display a menu of possible corrections and actions. You can now +easily bind this menu to 'down-mouse-3' (usually the right mouse button) +instead of 'mouse-2' (the default) by enabling 'context-menu-mode'. + +--- +*** The current dictionary is now displayed in the minor mode lighter. +Clicking the dictionary name changes the current dictionary. + +** Package + +*** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA. +Thus, packages on NonGNU ELPA will appear by default in the list shown +by 'list-packages'. + +--- +*** '/ s' ('package-menu-filter-by-status') changed parameter handling. +The command was documented to take a comma-separated list of statuses +to filter by, but instead it used the parameter as a regexp. The +command has been changed so that it now works as documented, and +checks statuses not as a regexp, but instead an exact match from the +comma-separated list. + ++++ +*** New command 'package-browse-url' and keystroke 'w'. + ++++ +*** New commands to filter the package list. +The filter commands are bound to the following keys: + +key binding +--- ------- +/ a package-menu-filter-by-archive +/ d package-menu-filter-by-description +/ k package-menu-filter-by-keyword +/ N package-menu-filter-by-name-or-description +/ n package-menu-filter-by-name +/ 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 + +*** Option to automatically native-compile packages upon installation. +Customize the user option 'package-native-compile' to enable automatic +native compilation of packages when they are installed. That option +is nil by default; if set non-nil, and if your Emacs was built with +native-compilation support, each package will be natively compiled +when it is installed, by invoking an asynchronous Emacs subprocess to +run the native-compilation of the package files. (Be sure to leave +Emacs running until these asynchronous subprocesses exit, or else the +native-compilation will be aborted when you exit Emacs.) + +--- +*** Column widths in 'list-packages' display can now be customized. +See the new user options 'package-name-column-width', +'package-version-column-width', 'package-status-column-width', and +'package-archive-column-width'. + +** Info + +--- +*** New user option 'Info-warn-on-index-alternatives-wrap'. +This option affects what happens when using the ',' command after +looking up an entry with 'i' in info buffers. If non-nil (the +default), the ',' command will now display a warning when proceeding +beyond the final index match, and tapping ',' once more will then take +you to the first match. + +** Abbrev mode + ++++ +*** Emacs can now suggest to use an abbrev based on text you type. +A new user option, 'abbrev-suggest', enables the new abbrev suggestion +feature. When enabled, if a user manually types a piece of text that +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. + +** Bookmarks + +*** Bookmarks can now be targets for new tabs. +When the bookmark.el library is loaded, a customize choice is added +to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. + +--- +*** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'. +The interactive bookmark list will now benefit from features in +'tabulated-list-mode' like sorting columns or changing column width. + +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. + +--- +*** New user option 'bookmark-set-fringe-mark'. +If non-nil, setting a bookmark will set a fringe mark on the current +line, and jumping to a bookmark will also set this mark. + +--- +*** New user option 'bookmark-menu-confirm-deletion'. +In Bookmark Menu mode, Emacs by default does not prompt for +confirmation when you type 'x' to execute the deletion of bookmarks +that have been marked for deletion. However, if this new option is +non-nil then Emacs will require confirmation with 'yes-or-no-p' before +deleting. + +** Recentf + +--- +*** The recentf files are no longer backed up. + +--- +*** 'recentf-auto-cleanup' now repeats daily when set to a time string. +When 'recentf-auto-cleanup' is set to a time string, it now repeats +every day, rather than only running once after the mode is turned on. + +** Calc + +--- +*** The behavior when doing forward-delete has been changed. +Previously, using the 'C-d' command would delete the final number in +the input field, no matter where point was. This has been changed to +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 '-'. + +--- +*** Calc now marks its windows dedicated. +The new user option 'calc-make-windows-dedicated' controls this. It +is t by default; set to nil to get back the old behavior. + +** Calendar + ++++ +*** New user option 'calendar-time-zone-style'. +If 'numeric', calendar functions (eg 'calendar-sunrise-sunset') that display +time zones will use a form like "+0100" instead of "CET". + +** Imenu + ++++ +*** New user option 'imenu-max-index-time'. +If creating the imenu index takes longer than specified by this +option (default 5 seconds), imenu indexing is stopped. + +** ido + +--- +*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'. + +--- +*** Killing virtual ido buffers interactively will make them go away. +Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't +do anything. This has now been changed, and killing virtual buffers +with that command will remove the buffer from recentf. + +** So Long + +--- +*** New 'so-long-predicate' function 'so-long-statistics-excessive-p'. +It efficiently detects the presence of a long line anywhere in the +buffer using 'buffer-line-statistics' (see above). This is now the +default predicate (replacing 'so-long-detected-long-line-p'). + +--- +*** Default values 'so-long-threshold' and 'so-long-max-lines' increased. +The values of these user options have been raised to 10000 bytes and 500 +lines respectively, to reduce the likelihood of false-positives when +'global-so-long-mode' is enabled. The latter value is now only used +by the old predicate, as the new predicate knows the longest line in +the entire buffer. + +--- +*** 'so-long-target-modes' now includes 'fundamental-mode' by default. +This means that 'global-so-long-mode' will also process files which were +not recognised. (This only has an effect if 'set-auto-mode' chooses +'fundamental-mode'; buffers which are simply in 'fundamental-mode' by +default are unaffected.) + +--- +*** New user options to preserve modes and variables. +The new options 'so-long-mode-preserved-minor-modes' and +'so-long-mode-preserved-variables' allow specified mode and variable +states to be maintained if 'so-long-mode' replaces the original major +mode. By default, these new options support 'view-mode'. + +** Grep + ++++ +*** New user option 'grep-match-regexp' matches grep markers to highlight. +Grep emits SGR ANSI escape sequences to color its output. The new +user option 'grep-match-regexp' holds the regular expression to match +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. + +*** Commands that use 'grep-find' now follow symlinks for command-line args. +This is because the default value of 'grep-find-template' now includes +the 'find' option '-H'. Commands that use that variable, including +indirectly via a call to 'xref-matches-in-directory', might be +affected. In particular, there should be no need anymore to ensure +any directory names on the 'find' command lines end in a slash. +This change is for better compatibility with old versions of non-GNU +'find', such as the one used on macOS. + +--- +*** New utility function 'grep-file-at-point'. +This returns the name of the file at point (if any) in 'grep-mode' +buffers. + +** Shell + +--- +*** New command in 'shell-mode': 'narrow-to-prompt'. +This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the +command line under point (and any following output). + +--- +*** New user option 'shell-has-auto-cd'. +If non-nil, 'shell-mode' handles implicit "cd" commands, changing the +directory if the command is a directory. Useful for shells like "zsh" +that has this feature. + +** term-mode + +--- +*** New user option 'term-scroll-snap-to-bottom'. +By default, 'term' and 'ansi-term' will now recenter the buffer so +that the prompt is on the final line in the window. Setting this new +user option to nil inhibits this behavior. + +--- +*** New user option 'term-set-terminal-size' +If non-nil, the 'LINES' and 'COLUMNS' environment variables will be set +based on the current window size. In previous versions of Emacs, this +was always done (and that could lead to odd displays when resizing the +window after starting). This variable defaults to nil. + +--- +*** 'term-mode' now supports "bright" color codes. +"Bright" ANSI color codes are now displayed using the color values +defined in 'term-color-bright-*'. In addition, bold text with regular +ANSI colors can be displayed as "bright" if 'ansi-color-bold-is-bright' +is non-nil. + +** Eshell + +--- +*** 'eshell-hist-ignoredups' can now also be used to mimic "erasedups" in bash. + +--- +*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses. +Its value contains the result of evaluating '(format "%s,eshell" +emacs-version)'. Other package names, like "tramp", could also be included. + +--- +*** Eshell no longer re-initializes its keymap every call. +This allows users to use (define-key eshell-mode-map ...) as usual. +Some modules have their own minor mode now to account for these +changes. + +*** Support for bookmark.el. +The command 'bookmark-set' (bound to 'C-x r m') is now supported, and +will create a bookmark that opens the current directory in Eshell. + +** Archive mode + +--- +*** Archive Mode can now parse ".squashfs" files. + +*** Can now modify members of 'ar' archives. + +*** Display of summaries is unified between backends. + +*** New user option and command to control displayed columns. +New user option 'archive-hidden-columns' and new command +'archive-hideshow-column' let you control which columns are displayed +and which are kept hidden. + +--- +*** New command bound to 'C': 'archive-copy-file'. +This command extracts the file at point and writes its data to a +file. + +** browse-url + +*** Added support for custom URL handlers. +There is a new variable 'browse-url-default-handlers' and a user +option 'browse-url-handlers' being alists with '(REGEXP-OR-PREDICATE +. FUNCTION)' entries allowing to define different browsing FUNCTIONs +depending on the URL to be browsed. The variable is for default +handlers provided by Emacs itself or external packages, the user +option is for the user (and allows for overriding the default +handlers). + +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 commands into 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 commands. With a new command +'browse-url-with-browser-kind', an URL can explicitly be browsed with +either an internal or external browser. + +--- +*** Support for browsing of remote files. +If a remote file is specified, a local temporary copy of that file is +passed to the browser. + +--- +*** Support for the conkeror browser is now obsolete. + +--- +*** Support for the Mosaic browser has been removed. +This support has been obsolete since 25.1. + +** Completion List Mode + +*** Improved navigation in the "*Completions*" buffer. +New key bindings have been added to 'completion-list-mode': 'n' and +'p' now navigate completions, and 'M-g M-c' switches to the +minibuffer and back to the completion list buffer. + ++++ +** profiler.el +The results displayed by 'profiler-report' now have the usage figures +at the left hand side followed by the function name. This is intended +to make better use of the horizontal space, in particular eliminating +the truncation of function names. There is no way to get the former +layout back. + +** Icomplete + +--- +*** New user option 'icomplete-matches-format'. +This allows controlling the current/total number of matches for the +prompt prefix. + ++++ +*** New minor modes 'icomplete-vertical-mode' and 'fido-vertical-mode'. +These modes modify Icomplete ('M-x icomplete-mode') and Fido ('M-x +fido-mode'), to display completion candidates vertically instead of +horizontally. In Icomplete, completions are rotated and selection +kept at the top. In Fido, completions scroll like a typical dropdown +widget. Both these new minor modes will turn on their non-vertical +counterparts first, if they are not on already. + +--- +*** Default value of 'icomplete-compute-delay' has been changed to 0.15 s. + +--- +*** Default value of 'icomplete-max-delay-chars' has been changed to 2. + +--- +*** Reduced blinking while completing the next completions set. +Icomplete doesn't hide the hint with the previously computed +completions anymore when compute delay is in effect, or the previous +computation has been aborted by input. Instead it shows the previous +completions until the new ones are ready. + +--- +*** Change in meaning of 'icomplete-show-matches-on-no-input'. +Previously, choosing a different completion with commands like 'C-.' +and then hitting 'RET' would choose the default completion. Doing this +will now choose the completion under point instead. Also when this option +is nil, completions are not shown when the minibuffer reads a file name +with initial input as the default directory. + +** Windmove + ++++ +*** New user options to customize windmove keybindings. +These options include 'windmove-default-keybindings', +'windmove-display-default-keybindings', +'windmove-delete-default-keybindings', +'windmove-swap-states-default-keybindings'. + +** Occur mode + +*** New bindings in occur-mode. +The command 'next-error-no-select' is now bound to 'n' and +'previous-error-no-select' is bound to 'p'. + +*** The new command 'recenter-current-error'. +It is bound to 'l' in Occur or compilation buffers, and recenters the +current displayed occurrence/error. + +*** Matches in target buffers are now highlighted as in 'compilation-mode'. +The method of highlighting is specified by the user options +'next-error-highlight' and 'next-error-highlight-no-select'. + +--- +*** A fringe arrow in the "*Occur*" buffer indicates the selected match. + +--- +*** Occur mode may use a different type for 'occur-target' property values. +The value was previously always a marker set to the start of the first +match on the line but can now also be a list of '(BEGIN . END)' pairs +of markers delimiting each match on the line. +This is a fully compatible change to the internal occur-mode +implementation, and code creating their own occur-mode buffers will +work as before. + +** Emacs Lisp mode + +--- +*** The mode-line now indicates whether we're using lexical or dynamic scoping. + ++++ +*** A space between an open paren and a symbol changes the indentation rule. +The presence of a space between an open paren and a symbol now is +taken as a statement by the programmer that this should be indented +as a data list rather than as a piece of code. + +** Lisp Mode + +*** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'. +The mode provides refined highlighting of built-in functions, types, +and variables. + +--- +*** Lisp mode now uses 'common-lisp-indent-function'. +To revert to the previous behavior, +'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. + +** Change Logs and VC + ++++ +*** 'vc-revert-show-diff' now has a third possible value: 'kill'. +If this user option is 'kill', then the diff buffer will be killed +after the 'vc-revert' action instead of buried. + +*** More VC commands can be used from non-file buffers. +The relevant commands are those that don't change the VC state. +The non-file buffers which can use VC commands are those that have +their 'default-directory' under VC. + +*** New command 'vc-dir-root' uses the root directory without asking. + +--- +*** New face 'log-view-commit-body'. +This is used when expanding commit messages from 'vc-print-root-log' +and similar commands. + +--- +*** New faces for 'vc-dir' buffers. +Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory', +'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning', +'vc-dir-status-edited', 'vc-dir-status-up-to-date', +'vc-dir-status-ignored'. + +--- +*** The responsible VC backend is now the most specific one. +'vc-responsible-backend' loops over the backends in +'vc-handled-backends' to determine which backend is responsible for a +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'. + +*** Support for bookmark.el. +Bookmark locations can refer to VC directory buffers. + +--- +*** New user option 'vc-hg-create-bookmark'. +It controls whether a bookmark or branch will be created when you +invoke 'C-u C-x v s' ('vc-create-tag'). + +--- +*** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers. + +--- +*** New user option 'vc-git-revision-complete-only-branches'. +If non-nil, only branches and remotes are considered when doing +completion over Git branch names. The default is nil, which causes +tags to be considered as well. + +--- +*** New user option 'vc-git-log-switches'. +String or list of strings specifying switches for Git log under VC. + +*** Command 'vc-switch-backend' is now obsolete. +If you are still using it with any regularity, please file a bug +report with some details. + +** Gnus + ++++ +*** New user option 'gnus-topic-display-predicate'. +This can be used to inhibit the display of some topics completely. + ++++ +*** nnimap now supports the oauth2.el library. + ++++ +*** New Summary buffer sort options for extra headers. +The extra header sort option ('C-c C-s C-x') prompts for a header +and fails if no sort function has been defined. Sorting by +Newsgroups ('C-c C-s C-u') has been pre-defined. + ++++ +*** The '#' command in the Group and Summary buffer now toggles, +instead of sets, the process mark. + ++++ +*** New user option 'gnus-process-mark-toggle'. +If non-nil (the default), the '#' command in the Group and Summary +buffers will toggle, instead of set, the process mark. + + ++++ +*** New user option 'gnus-registry-register-all'. +If non-nil (the default), create registry entries for all messages. +If nil, don't automatically create entries, they must be created +manually. + ++++ +*** New user options to customise the summary line specs "%[" and "%]". +Four new options introduced in customisation group +'gnus-summary-format'. These are 'gnus-sum-opening-bracket', +'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and +'gnus-sum-closing-bracket-adopted'. Their default values are "[", "]", +"<", ">" respectively. These options control the appearance of "%[" +and "%]" specs in the summary line format. "%[" will normally display +the value of 'gnus-sum-opening-bracket', but can also be +'gnus-sum-opening-bracket-adopted' for the adopted articles. "%]" will +normally display the value of 'gnus-sum-closing-bracket', but can also +be 'gnus-sum-closing-bracket-adopted' for the adopted articles. + ++++ +*** New user option 'gnus-paging-select-next'. +This controls what happens when using commands like 'SPC' and 'DEL' to +page the current article. If non-nil (the default), go to the +next/prev article, but if nil, do nothing at the end/start of the article. + ++++ +*** New gnus-search library. +A new unified search syntax which can be used across multiple +supported search engines. Set 'gnus-search-use-parsed-queries' to +non-nil to enable. + ++++ +*** New value for user option 'smiley-style'. +Smileys can now be rendered with emojis instead of small images when +using the new 'emoji' value in 'smiley-style'. + ++++ +*** New user option 'gnus-agent-eagerly-store-articles'. +If non-nil (which is the default), the Gnus Agent will store all read +articles in the Agent cache. + ++++ +*** New user option 'gnus-global-groups'. +Gnus handles private groups differently from public (i.e., NNTP-like) +groups. Most importantly, Gnus doesn't download external images from +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 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 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'. + ++++ +*** New user option 'gnus-dbus-close-on-sleep'. +On systems with D-Bus support, it is now possible to register a signal +to close all Gnus servers before the system sleeps. + ++++ +*** The key binding of 'gnus-summary-search-article-forward' has changed. +This command was previously on 'M-s' and shadowed the global 'M-s' +search prefix. The command has now been moved to 'M-s M-s'. (For +consistency, the 'M-s M-r' key binding has been added for the +'gnus-summary-search-article-backward' command.) + +--- +*** The value for "all" in the 'large-newsgroup-initial' group parameter has changed. +It was previously nil, which didn't work, because nil is +indistinguishable from not being present. The new value for "all" is +the symbol 'all'. + ++++ +*** The name of dependent Gnus sessions has changed from "slave" to "child". +The names of the commands 'gnus-slave', 'gnus-slave-no-server' and +'gnus-slave-unplugged' have changed to 'gnus-child', +'gnus-child-no-server' and 'gnus-child-unplugged' respectively. + ++++ +*** The 'W Q' summary mode command now takes a numerical prefix to +allow adjusting the fill width. + ++++ +*** New variable 'mm-inline-font-lock'. +This variable is supposed to be bound by callers to determine whether +inline MIME parts (that support it) are supposed to be font-locked or +not. + +** Message + +--- +*** Respect 'message-forward-ignored-headers' more. +Previously, this user option would not be consulted if +'message-forward-show-mml' was nil and forwarding as MIME. + ++++ +*** New user option 'message-forward-included-mime-headers'. +This is used when forwarding messages as MIME, but not using MML. + ++++ +*** Message now supports the OpenPGP header. +To generate these headers, add the new function +'message-add-openpgp-header' to 'message-send-hook'. The header will +be generated according to the new 'message-openpgp-header' user +option. + +--- +*** A change to how "Mail-Copies-To: never" is handled. +If a user has specified "Mail-Copies-To: never", and Message was asked +to do a "wide reply", some other arbitrary recipient would end up in +the resulting "To" header, while the remaining recipients would be put +in the "Cc" header. This is somewhat misleading, as it looks like +you're responding to a specific person in particular. This has been +changed so that all the recipients are put in the "To" header in these +instances. + ++++ +*** New command to start Emacs in Message mode to send an email. +Emacs can be defined as a handler for the "x-scheme-handler/mailto" +MIME type with the following command: "emacs -f message-mailto %u". +An "emacs-mail.desktop" file has been included, suitable for +installing in desktop directories like "/usr/share/applications" or +"~/.local/share/applications". +Clicking on a 'mailto:' link in other applications will then open +Emacs with headers filled out according to the link, e.g. +"mailto:larsi@gnus.org?subject=This+is+a+test". If you prefer +emacsclient, use "emacsclient -e '(message-mailto "%u")'" +or "emacsclient-mail.desktop". + +--- +*** Change to default value of 'message-draft-headers' user option. +The 'Date' symbol has been removed from the default value, meaning that +draft or delayed messages will get a date reflecting when the message +was sent. To restore the original behavior of dating a message +from when it is first saved or delayed, add the symbol 'Date' back to +this user option. + ++++ +*** New command to take screenshots. +In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot') +command has been added. It depends on using an external program to +take the actual screenshot, and defaults to "ImageMagick import". + +** Smtpmail + ++++ +*** smtpmail now supports using the oauth2.el library. + ++++ +*** New user option 'smtpmail-store-queue-variables'. +If non-nil, SMTP variables will be stored together with the queued +messages, and will then be used when sending with +'M-x smtpmail-send-queued-mail'. + ++++ +*** Allow direct selection of smtp authentication mechanism. +A server entry retrieved by auth-source can request a desired smtp +authentication mechanism by setting a value for the key 'smtp-auth'. + +** ElDoc + ++++ +*** New user option 'eldoc-echo-area-display-truncation-message'. +If non-nil (the default), eldoc will display a message saying +something like "(Documentation truncated. Use `M-x eldoc-doc-buffer' +to see rest)" when a message has been truncated. If nil, truncated +messages will be marked with just "..." at the end. + ++++ +*** New hook 'eldoc-documentation-functions'. +This hook is intended to be used for registering doc string functions. +These functions don't need to produce the doc string right away, they +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 +if some of those functions are synchronous and some asynchronous. +The user option replaces 'eldoc-documentation-function', which is now +obsolete. + +*** 'eldoc-echo-area-use-multiline-p' is now handled by ElDoc. +The user option 'eldoc-echo-area-use-multiline-p' is now handled +by the ElDoc library itself. Functions in +'eldoc-documentation-functions' don't need to worry about consulting +it when producing a doc string. + +** Tramp + ++++ +*** New connection method "mtp". +It allows accessing media devices like cell phones, tablets or +cameras. + ++++ +*** New connection method "sshfs". +It allows accessing remote files via a file system mounted with +'sshfs'. + ++++ +*** Tramp supports SSH authentication via a hardware security key now. +This requires at least OpenSSH 8.2, and a FIDO U2F compatible +security key, like yubikey, solokey, or nitrokey. + ++++ +*** Trashed remote files are moved to the local trash directory. +All remote files that are trashed are moved to the local trash +directory, except remote encrypted files, which are always deleted. + ++++ +*** New command 'tramp-crypt-add-directory'. +This command marks a remote directory to contain only encrypted files. +See the "(tramp) Keeping files encrypted" node of the Tramp manual for +details. This feature is experimental. + ++++ +*** Support of direct asynchronous process invocation. +When Tramp connection property "direct-async-process" is set to +non-nil for a given connection, 'make-process' and 'start-file-process' +calls are performed directly as in "ssh ... <command>". This avoids +initialization performance penalties. See the "(tramp) Improving +performance of asynchronous remote processes" node of the Tramp manual +for details, and also for a discussion or restrictions. This feature +is experimental. + ++++ +*** New user option 'tramp-debug-to-file'. +When non-nil, this user option instructs Tramp to mirror the debug +buffer to a file under the "/tmp/" directory. This is useful, if (in +rare cases) Tramp blocks Emacs, and we need further debug information. + ++++ +*** Tramp supports lock files now. +In order to deactivate this, set user option +'remote-file-name-inhibit-locks' to t. + ++++ +*** Writing sensitive data locally requires confirmation. +Writing auto-save, backup or lock files to the local temporary +directory must be confirmed. In order to suppress this confirmation, +set user option 'tramp-allow-unsafe-temporary-files' to t. + ++++ +*** 'make-directory' of a remote directory honors the default file modes. + +** gdb-mi + +*** New user option 'gdb-registers-enable-filter'. +If non-nil, apply a register filter based on +'gdb-registers-filter-pattern-list'. + ++++ +*** gdb-mi can now save and restore window configurations. +Use 'gdb-save-window-configuration' to save window configuration to a +file and 'gdb-load-window-configuration' to load from a file. These +commands can also be accessed through the menu bar under "Gud => +GDB-Windows". 'gdb-default-window-configuration-file', when non-nil, +is loaded when GDB starts up. + ++++ +*** gdb-mi can now restore window configuration after quitting. +Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs +will remember the window configuration before GDB started and restore +it after GDB quits. A toggle button is also provided under "Gud => +GDB-Windows" menu item. + ++++ +*** gdb-mi now has a better logic for displaying source buffers. +Now GDB only uses one source window to display source file by default. +Customize 'gdb-max-source-window-count' to use more than one window. +Control source file display by 'gdb-display-source-buffer-action'. + ++++ +*** The default value of 'gdb-mi-decode-strings' is now t. +This means that the default coding-system is now used to decode strings +and source file names from GDB. + +** Compilation mode + +--- +*** New function 'ansi-color-compilation-filter'. +This function is meant to be used in 'compilation-filter-hook'. + +--- +*** New user option 'ansi-color-for-compilation-mode'. +This controls what 'ansi-color-compilation-filter' does. + +*** Regexp matching of messages is now case-sensitive by default. +The variable 'compilation-error-case-fold-search' can be set for +case-insensitive matching of messages when the old behavior is +required, but the recommended solution is to use a correctly matching +regexp instead. + +--- +*** New user option 'compilation-search-all-directories'. +When doing parallel builds, directories and compilation errors may +arrive in the "*compilation*" buffer out-of-order. If this option is +non-nil (the default), Emacs will now search backwards in the buffer +for any directory the file with errors may be in. If nil, this won't +be done (and this restores how this previously worked). + +--- +*** Messages from ShellCheck are now recognized. + +--- +*** Messages from Visual Studio that mention column numbers are now recognized. + +** Hi Lock mode + +--- +*** Matching in 'hi-lock-mode' can be case-sensitive. +The matching is case-sensitive when a regexp contains upper case +characters and 'search-upper-case' is non-nil. 'highlight-phrase' +also uses 'search-whitespace-regexp' to substitute spaces in regexp +search. + +--- +*** The default value of 'hi-lock-highlight-range' was enlarged. +The new default value is 2000000 (2 megabytes). + +** Whitespace mode + ++++ +*** New style 'missing-newline-at-eof'. +If present in 'whitespace-style' (as it is by default), the final +character in the buffer will be highlighted if the buffer doesn't end +with a newline. + +--- +*** The default 'whitespace-enable-predicate' predicate has changed. +It used to check elements in the list version of +'whitespace-global-modes' with 'eq', but now uses 'derived-mode-p'. + +** Texinfo + +--- +*** New user option 'texinfo-texi2dvi-options'. +This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'. + +--- +*** New commands for moving in and between environments. +An "environment" is something that ends with '@end'. The commands are +'C-c C-c C-f' (next end), 'C-c C-c C-b' (previous end), +'C-c C-c C-n' (next start) and 'C-c C-c C-p' (previous start), as well +as 'C-c .', which will alternate between the start and the end of the +current environment. + +** Rmail + +--- +*** New user option 'rmail-re-abbrevs'. +Its default value matches localized abbreviations of the "reply" +prefix on the Subject line in various languages. + +--- +*** New user option 'rmail-show-message-set-modified'. +If set non-nil, showing an unseen message will set the Rmail buffer's +modified flag. The default is nil, to preserve the old behavior. + +** CC Mode + ++++ +*** Added support for Doxygen documentation style. +'doxygen' is now a valid 'c-doc-comment-style' which recognises all +comment styles supported by Doxygen (namely '///', '//!', '/** … */' +and '/*! … */'. 'gtkdoc' remains the default for C and C++ modes; to +use 'doxygen' by default one might evaluate: + + (setq-default c-doc-comment-style + '((java-mode . javadoc) + (pike-mode . autodoc) + (c-mode . doxygen) + (c++-mode . doxygen))) + +or use it in a custom 'c-style'. + ++++ +*** Added support to line up '?' and ':' of a ternary operator. +The new 'c-lineup-ternary-bodies' function can be used as a lineup +function to align question mark and colon which are part of a ternary +operator ('?:'). For example: + + return arg % 2 == 0 ? arg / 2 + : (3 * arg + 1); + +To enable, add it to appropriate entries in 'c-offsets-alist', e.g.: + + (c-set-offset 'arglist-cont '(c-lineup-ternary-bodies + c-lineup-gcc-asm-reg)) + (c-set-offset 'arglist-cont-nonempty '(c-lineup-ternary-bodies + c-lineup-gcc-asm-reg + c-lineup-arglist)) + (c-set-offset 'statement-cont '(c-lineup-ternary-bodies +)) + +** Images + +--- +*** You can explicitly specify base_uri for svg images. +':base-uri' image property can be used to explicitly specify base_uri +for embedded images into svg. ':base-uri' is supported for both file +and data svg images. + ++++ +*** 'svg-embed-base-uri-image' added to embed images. +'svg-embed-base-uri-image' can be used to embed images located +relatively to 'file-name-directory' of the ':base-uri' svg image property. +This works much faster then 'svg-embed'. + ++++ +*** New function 'image-cache-size'. +This function returns the size of the current image cache, in bytes. + +--- +*** Animated images stop automatically under high CPU pressure sooner. +Previously, an animated image would stop animating if any single image +took more than two seconds to display. The new algorithm maintains a +decaying average of delays, and if this number gets too high, the +animation is stopped. + ++++ +*** The 'n' and 'p' commands (next/previous image) now respect Dired order. +These commands would previously display the next/previous image in +lexicographic order, but will now find the "parent" Dired buffer and +select the next/previous image file according to how the files are +sorted there. The commands have also been extended to work when the +"parent" buffer is an archive mode (i.e., zip file or the like) or tar +mode buffer. + +--- +*** 'image-converter' is now restricted to formats in 'auto-mode-alist'. +When using external image converters, the external program is queried +for what formats it supports. This list may contain formats that are +problematic in some contexts (like PDFs), so this list is now filtered +based on 'auto-mode-alist'. Only file names that map to 'image-mode' +are now supported. + +--- +*** The background and foreground of images now default to face colors. +When an image doesn't specify a foreground or background color, Emacs +now uses colors from the face used to draw the surrounding text +instead of the frame's default colors. + +To load images with the default frame colors use the ':foreground' and +':background' image attributes, for example: + + (create-image "filename" nil nil + :foreground (face-attribute 'default :foreground) + :background (face-attribute 'default :background)) + +This change only affects image types that support foreground and +background colors or transparency, such as xbm, pbm, svg, png and gif. + ++++ +*** Image smoothing can now be explicitly enabled or disabled. +Smoothing applies a bilinear filter while scaling or rotating an image +to prevent aliasing and other unwanted effects. The new image +property ':transform-smoothing' can be set to t to force smoothing +and nil to disable smoothing. + +The default behavior of smoothing on down-scaling and not smoothing +on up-scaling remains unchanged. + ++++ +*** New user option 'image-transform-smoothing'. +This controls whether to use smoothing or not for an image. Values +include nil (no smoothing), t (do smoothing) or a predicate function +that's called with the image object and should return nil/t. + ++++ +*** SVG images now support user stylesheets. +The ':css' image attribute can be used to override the default CSS +stylesheet for an image. The default sets 'font-family' and +'font-size' to match the current face, so an image with 'height="1em"' +will match the font size in use where it is embedded. + +This feature relies on librsvg 2.48 or above being available. + ++++ +*** Image properties support 'em' sizes. +Size image properties, for example ':height', ':max-height', etc., can +be given a cons of the form '(SIZE . em)', where SIZE is an integer or +float which is multiplied by the font size to calculate the image +size, and 'em' is a symbol. + +** EWW + ++++ +*** New user option 'eww-use-browse-url'. +This is a regexp that can be set to alter how links are followed in eww. + ++++ +*** New user option 'eww-retrieve-command'. +This can be used to download data via an external command. If nil +(the default), then 'url-retrieve' is used. When 'sync', then +'url-retrieve-synchronously' is used. + ++++ +*** New Emacs command line convenience command. +The 'eww-browse' command has been added, which allows you to register +Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the +supplied URL. Usage example: "emacs -f eww-browse https://gnu.org". + ++++ +*** 'eww-download-directory' will now use the XDG location, if defined. +However, if "~/Downloads/" already exists, that will continue to be +used. + +--- +*** The command 'eww-follow-link' now supports custom mailto: handlers. +The function that is invoked when clicking on or otherwise following a +'mailto:' link in an EWW buffer can now be customized. For more +information, see the related entry about 'shr-browse-url' below. + +--- +*** Support for bookmark.el. +The command 'bookmark-set' (bound to 'C-x r m') is now supported, and +will create a bookmark that opens the current URL in EWW. + +** SHR + +--- +*** The command 'shr-browse-url' now supports custom mailto handlers. +Clicking on or otherwise following a 'mailto:' link in an HTML buffer +rendered by SHR previously invoked the command 'browse-url-mailto'. +This is still the case by default, but if you customize +'browse-url-mailto-function' or 'browse-url-handlers' to call some +other function, it will now be called instead of the default. + +--- +*** New user option 'shr-offer-extend-specpdl'. +If this is nil, rendering of HTML that requires enlarging +'max-specpdl-size', the number of Lisp variable bindings, will be +aborted, and Emacs will not ask you whether to enlarge +'max-specpdl-size' to complete the rendering. The default is t, which +preserves the original behavior. + ++++ +*** New user option 'shr-max-width'. +If this user option is non-nil, and 'shr-width' is nil, then SHR will +use the value of 'shr-max-width' to limit the width of the rendered +HTML. The default is 120 characters, so even if you have very wide +frames, HTML text will be rendered more narrowly, which usually leads +to a more readable text. Customize it to nil to get the previous +behavior of rendering as wide as the 'window-width' allows. If +'shr-width' is non-nil, it overrides this option. + +--- +*** New faces for heading elements. +Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'. + +** Project + +--- +*** New user option 'project-vc-merge-submodules'. + +--- +*** Project commands now have their own history. +Previously used project directories are now suggested by all commands +that prompt for a project directory. + ++++ +*** New prefix keymap 'project-prefix-map'. +Key sequences that invoke project-related commands start with the +prefix 'C-x p'. Type 'C-x p C-h' to show the full list. + ++++ +*** New commands 'project-dired', 'project-vc-dir', 'project-shell', +'project-eshell'. These commands run Dired/VC-Dir and Shell/Eshell in +a project's root directory, respectively. + ++++ +*** New command 'project-compile'. +This command runs compilation in the current project's root directory. + ++++ +*** New command 'project-switch-project'. +This command lets you "switch" to another project and run a project +command chosen from a dispatch menu. + ++++ +*** New commands 'project-shell-command' and 'project-async-shell-command'. +These commands run 'shell-command' and 'async-shell-command' in a +project's root directory, respectively. + ++++ +*** New user option 'project-list-file'. +This specifies the file in which to save the list of known projects. + ++++ +*** New command 'project-remember-projects-under'. +This command can automatically locate and index projects in a +directory and optionally also its subdirectories, storing them in +'project-list-file'. + ++++ +*** New commands 'project-forget-project' and 'project-forget-projects-under'. +These commands let you interactively remove entries from the list of projects +in 'project-list-file'. + ++++ +*** New command 'project-forget-zombie-projects'. +This command detects indexed projects that have since been deleted, +and removes them from the list of known projects in 'project-list-file'. + +--- +*** 'project-find-file' now accepts non-existent file names. +This is to allow easy creation of files inside some nested +sub-directory. + ++++ +*** 'project-find-file' doesn't use the string at point as default input. +Now it's only suggested as part of the "future history", accessible +via 'M-n'. + ++++ +*** New command 'project-find-dir' runs Dired in a directory inside project. + +** Xref + +--- +*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer. +So typing 'C-u RET' in the "*xref*" buffer quits its window +before navigating to the selected location. + ++++ +*** New user options to automatically show the first Xref match. +The new user option 'xref-auto-jump-to-first-definition' controls the +behavior of 'xref-find-definitions' and its variants, like +'xref-find-definitions-other-window': if it's t or 'show', the first +match is automatically displayed; if it's 'move', point in the +"*xref*" buffer is automatically moved to the first match without +displaying it. +The new user option 'xref-auto-jump-to-first-xref' changes the +behavior of Xref commands such as 'xref-find-references', +'xref-find-apropos', and 'project-find-regexp', which are expected to +display many matches that the user would like to +visit. 'xref-auto-jump-to-first-xref' changes their behavior much in +the same way as 'xref-auto-jump-to-first-definition' affects the +"find-definitions" commands. + +--- +*** New user options 'xref-search-program' and 'xref-search-program-alist'. +So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better +performance in certain cases, in particular for case-insensitive +searches. + ++++ +*** New commands 'xref-prev-group' and 'xref-next-group'. +These commands are bound respectively to 'P' and 'N', and navigate to +the first item of the previous or next group in the "*xref*" buffer. + +--- +*** New alternative value for 'xref-show-definitions-function': +'xref-show-definitions-completing-read'. + +--- +*** The two existing alternatives for 'xref-show-definitions-function' +have been renamed to have "proper" public names and documented +('xref-show-definitions-buffer' and +'xref-show-definitions-buffer-at-bottom'). + ++++ +*** New command 'xref-quit-and-pop-marker-stack'. +This command is bound to 'M-,' in "*xref*" buffers. This combination +is easy to press semi-accidentally if the user wants to go back in the +middle of choosing the exact definition to go to, and this should do +TRT. + +--- +*** New value 'project-relative' for 'xref-file-name-display'. +If chosen, file names in "*xref*" buffers will be displayed relative +to the 'project-root' of the current project, when available. + ++++ +*** The 'TAB' key binding in "*xref*" buffers is obsolete. +Use 'C-u RET' instead. The 'TAB' binding in "*xref*" buffers is still +supported, but we plan on removing it in a future version; at that +time, the command 'xref-quit-and-goto-xref' will no longer have a key +binding in 'xref--xref-buffer-mode-map'. + +--- +*** New user option 'etags-xref-prefer-current-file'. +When non-nil, matches for identifiers in the file visited by the +current buffer will be shown first in the "*xref*" buffer. + ++++ +*** The etags Xref backend now honors 'tags-apropos-additional-actions'. +You can customize it to augment the output of 'xref-find-apropos', +like it affected the output of 'tags-apropos', which is obsolete since +Emacs 25.1. + +** Battery + +--- +*** UPower is now the default battery status backend when available. +UPower support via the function 'battery-upower' was added in Emacs +26.1, but was disabled by default. It is now the default value of +'battery-status-function' when the system provides a UPower D-Bus +service. The user options 'battery-upower-device' and +'battery-upower-subscribe' control which power sources to query and +whether to respond to status change notifications in addition to +polling, respectively. + +--- +*** A richer syntax can be used to format battery status information. +The user options 'battery-mode-line-format' and +'battery-echo-area-format' now support the full formatting syntax of +the function 'format-spec' documented under node "(elisp) Custom Format +Strings". The new syntax includes specifiers for padding and +truncation, amongst other things. + +** bug-reference.el + +--- +*** Bug reference mode uses auto-setup. +If 'bug-reference-mode' or 'bug-reference-prog-mode' have been +activated, their respective hook has been run, and both +'bug-reference-bug-regexp' and 'bug-reference-url-format' are still +not set, it tries to guess appropriate values for those two variables. +There are three guessing mechanisms so far: based on version control +information of the current buffer's file, based on +newsgroup/mail-folder name and several news and mail message headers +in Gnus buffers, and based on IRC channel and network in rcirc and ERC +buffers. All the mechanisms are extensible with custom rules, see the +variables 'bug-reference-setup-from-vc-alist', +'bug-reference-setup-from-mail-alist', and +'bug-reference-setup-from-irc-alist'. + +** HTML Mode + +--- +*** A new skeleton for adding relative URLs has been added. +It's bound to the 'C-c C-c f' keystroke, and prompts for a local file +name. + +** Widget + ++++ +*** 'widget-choose' now supports menus in extended format. + +--- +*** The 'editable-list' widget now supports moving items up and down. +You can now move items up and down by deleting and then reinserting +them, using the 'DEL' and 'INS' buttons respectively. This is useful +in Custom buffers, for example, to change the order of the elements in +a list. + +** Diff + +--- +*** New face 'diff-changed-unspecified'. +This is used to highlight "changed" lines (those marked with '!') in +context diffs, when 'diff-use-changed-face' is non-nil. + +--- +*** New 'diff-mode' font locking face 'diff-error'. +This face is used for error messages from 'diff'. + ++++ +*** New command 'diff-refresh-hunk'. +This new command (bound to 'C-c C-l') regenerates the current hunk. + +** thing-at-point + ++++ +*** New 'thing-at-point' target: 'existing-filename'. +This is like 'filename', but is a full path, and is nil if the file +doesn't exist. + ++++ +*** New 'thing-at-point' target: 'string'. +If point is inside a string, it returns that string. + ++++ +*** New variable 'thing-at-point-provider-alist'. +This allows mode-specific alterations to how 'thing-at-point' works. + +--- +*** thing-at-point now respects fields. +'thing-at-point' (and all functions that use it, like +'symbol-at-point') will narrow to the current field (if any) before +trying to identify the thing at point. + +--- +*** New function 'thing-at-mouse'. +This is like 'thing-at-point', but uses the mouse event position instead. + +** Image-Dired + ++++ +*** New user option 'image-dired-thumb-visible-marks'. +If non-nil (the default), use the new face 'image-dired-thumb-mark' +for marked images. + +--- +*** New command 'image-dired-delete-marked'. + +--- +*** 'image-dired-mouse-toggle-mark' is now sensitive to the active region. +If the region is active, this command now toggles Dired marks of all +the thumbnails in the region. + +** Flymake mode + ++++ +*** New command 'flymake-show-project-diagnostics'. +This lists all diagnostics for buffers in the currently active +project. The listing is similar to the one obtained by +'flymake-show-buffer-diagnostics', but adds a column for the +project-relative file name. For backends which support it, +'flymake-show-project-diagnostics' also lists diagnostics for files +that have not yet been visited. + ++++ +*** New user options to customize Flymake's mode-line. +The new user option 'flymake-mode-line-format' is a mix of strings and +symbols like 'flymake-mode-line-title', 'flymake-mode-line-exception' +and 'flymake-mode-line-counters'. The new user option +'flymake-mode-line-counter-format' is a mix of strings and symbols +like 'flymake-mode-line-error-counter', +'flymake-mode-line-warning-counter' and 'flymake-mode-line-note-counter'. + +** Time + +--- +*** 'display-time-world' has been renamed to 'world-clock'. +'world-clock' creates a buffer with an updating time display using +several time zones. It is hoped that the new names are more +discoverable. + +The following commands have been renamed: + + 'display-time-world' to 'world-clock' + 'display-time-world-mode' to 'world-clock-mode' + 'display-time-world-display' to 'world-clock-display' + 'display-time-world-timer' to 'world-clock-update' + +The following user options have been renamed: + + 'display-time-world-list' to 'world-clock-list' + 'display-time-world-time-format' to 'world-clock-time-format' + 'display-time-world-buffer-name' to 'world-clock-buffer-name' + 'display-time-world-timer-enable' to 'world-clock-timer-enable' + 'display-time-world-timer-second' to 'world-clock-timer-second' + +The old names are now obsolete. + +--- +*** 'world-clock-mode' can no longer be turned on interactively. +Use 'world-clock' to turn on that mode. + +** Python mode + +--- +*** New user option 'python-forward-sexp-function'. +This allows the user easier customization of whether to use block-based +navigation or not. + +--- +*** 'python-shell-interpreter' now defaults to python3 on systems with python3. + +--- +*** 'C-c C-r' can now be used on arbitrary regions. +The command previously extended the start of the region to the start +of the line, but will now actually send the marked region, as +documented. + +** Ruby Mode + +--- +*** 'ruby-use-smie' is declared obsolete. +SMIE is now always enabled and 'ruby-use-smie' only controls whether +indentation is done using SMIE or with the old ad-hoc code. + +--- +*** Indentation has changed when 'ruby-align-chained-calls' is non-nil. +This previously used to align subsequent lines with the last sibling, +but it now aligns with the first sibling (which is the preferred style +in Ruby). + +** CPerl Mode + +--- +*** New face 'perl-heredoc', used for heredoc elements. + +--- +*** The command 'cperl-set-style' offers the new value "PBP". +This value customizes Emacs to use the style recommended in Damian +Conway's book "Perl Best Practices" for indentation and formatting +of conditionals. + +** Perl mode + +--- +*** New face 'perl-non-scalar-variable'. +This is used to fontify non-scalar variables. + +** Octave Mode + ++++ +*** Line continuations in double-quoted strings now use a backslash. +Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows +the behavior introduced in Octave 3.8 of using a backslash as a line +continuation marker within double-quoted strings, and an ellipsis +everywhere else. + ++++ +** EasyPG +GPG key servers can now be queried for keys with the +'M-x epa-search-keys' command. Keys can then be added to your +personal key ring. + +** Etags + ++++ +*** Etags now supports the Mercury programming language. +See https://mercurylang.org. + ++++ +*** Etags command line option '--declarations' now has Mercury-specific behavior. +All Mercury declarations are tagged by default. However, for +compatibility with 'etags' support for Prolog, predicates and +functions appearing first in clauses will also be tagged if 'etags' is +invoked with the '--declarations' command-line option. + +** Comint + ++++ +*** Support for OSC escape sequences. +Adding the new 'comint-osc-process-output' to +'comint-output-filter-functions' enables the interpretation of OSC +("Operating System Command") escape sequences in comint buffers. By +default, only OSC 8, for hyperlinks, and OSC 7, for directory +tracking, are acted upon. Adding more entries to +'comint-osc-handlers' allows a customized treatment of further escape +sequences. + ++++ +*** 'comint-delete-output' can now save deleted text in the kill-ring. +Interactively, 'C-u C-c C-o' triggers this new optional behavior. + +** ansi-color.el + +--- +*** Colors are now defined by faces. +ANSI SGR codes now have corresponding faces to describe their +appearance, e.g. 'ansi-color-bold'. + +--- +*** Support for "bright" color codes. +"Bright" ANSI color codes are now displayed when applying ANSI color +filters using the color values defined by the faces +'ansi-color-bright-COLOR'. In addition, bold text with regular ANSI +colors can be displayed as "bright" if 'ansi-color-bold-is-bright' is +non-nil. + +** ERC + +*** Starting with Emacs 28.1 and ERC 5.4, see the ERC-NEWS file for +user-visible changes in ERC. + +** xwidget-webkit mode + +--- +*** New xwidget commands. +'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title' +(return the current title), and 'xwidget-webkit-goto-history' (goto a +point in history). + +--- +*** Downloading files from xwidget-webkit is now supported. +The new user option 'xwidget-webkit-download-dir' says where to download to. + +--- +*** New command 'xwidget-webkit-clone-and-split-below'. +Open a new window below displaying the current URL. + +--- +*** New command 'xwidget-webkit-clone-and-split-right'. +Open a new window to the right displaying the current URL. + +--- +*** Pixel-based scrolling. +The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands +now supports scrolling arbitrary pixel values. It now treats the +optional 2nd argument as the pixel values to scroll. + +--- +*** New commands for scrolling. +The new commands 'xwidget-webkit-scroll-up-line', +'xwidget-webkit-scroll-down-line', 'xwidget-webkit-scroll-forward', +'xwidget-webkit-scroll-backward' can be used to scroll webkit by the +height of lines or width of chars. + +--- +*** New user option 'xwidget-webkit-bookmark-jump-new-session'. +When non-nil, use a new xwidget webkit session after bookmark jump. +Otherwise, it will use 'xwidget-webkit-last-session'. + +** Checkdoc + +--- +*** No longer warns about command substitutions by default. +Checkdoc used to warn about "too many command substitutions" (as in +"\\[foo-command]"), even if you only used ten of them in a docstring. +On modern machines, you can have hundreds or thousands of command +substitutions before it becomes a performance issue, so this warning +is now disabled by default. To re-enable this warning, customize the +user option 'checkdoc-max-keyref-before-warn'. + +--- +*** New user option 'checkdoc-column-zero-backslash-before-paren'. +Checkdoc warns if there is a left parenthesis in column zero of a +documentation string. That warning can now be disabled by customizing +this new user option to nil. This is useful if you don't expect +your code to be edited with an Emacs older than version 27.1. + +--- +*** Now checks the prompt format for 'yes-or-no-p'. +In addition to verifying the format of the prompt for 'y-or-n-p', +checkdoc will now check the format of 'yes-or-no-p'. + +--- +*** New command 'checkdoc-dired'. +This can be used to run checkdoc on files from a Dired buffer. + +--- +*** No longer checks for 'A-' modifiers. +Checkdoc recommends usage of command substitutions ("\\[foo-command]") +in favor of writing keybindings like 'C-c f'. It now no longer warns +about the 'A-' modifier as it is not used very much in practice, and +this warning therefore mostly led to false positives. + +** Enriched mode + +--- +*** 'C-a' is by default no longer bound to 'beginning-of-line-text'. +This is so 'C-a' works as in other modes, and in particular holding +Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. + +** Gravatar + +--- +*** New user option 'gravatar-service' for host to query for gravatars. +Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. + +** MH-E mail handler for Emacs + +Functions and variables related to handling junk mail have been +renamed to not associate color with sender quality. + ++++ +*** New names for mh-junk interactive functions. +Function 'mh-junk-whitelist' is renamed 'mh-junk-allowlist'. +Function 'mh-junk-blacklist' is renamed 'mh-junk-blocklist'. + ++++ +*** New binding for 'mh-junk-allowlist'. +The key binding for 'mh-junk-allowlist' is changed from 'J w' to 'J a'. +The old binding is supported but warns that it is obsolete. + ++++ +*** New names for some hooks. +'mh-whitelist-msg-hook' is renamed 'mh-allowlist-msg-hook'. +'mh-blacklist-msg-hook' is renamed 'mh-blocklist-msg-hook'. + ++++ +*** New names for some user options. +User option 'mh-whitelist-preserves-sequences-flag' is renamed +'mh-allowlist-preserves-sequences-flag'. + ++++ +*** New names for some faces. +Face 'mh-folder-blacklisted' is renamed 'mh-folder-blocklisted'. +Face 'mh-folder-whitelisted' is renamed 'mh-folder-allowlisted'. + +** Rcirc + ++++ +*** rcirc now supports SASL authentication. + +--- +*** #emacs on Libera.chat has been added to 'rcirc-server-alist'. + +--- +*** rcirc connects asynchronously. + +--- +*** Integrate formatting into 'rcirc-send-string'. +The function now accepts a variable number of arguments. + ++++ +*** Deprecate 'rcirc-command' in favor of 'rcirc-define-command'. +The new macro handles multiple and optional arguments. + +--- +*** Add basic IRCv3 support. +This includes support for the capabilities: 'server-time', 'batch', +'message-ids', 'invite-notify', 'multi-prefix' and 'standard-replies'. + +--- +*** Add mouse property support to 'rcirc-track-minor-mode'. + +--- +*** Improve support for IRC markup codes. + +--- +*** Check 'auth-sources' for server passwords. + ++++ +*** Implement repeated reconnection strategy. +See 'rcirc-reconnect-attempts'. + +** MPC + +--- +*** New command 'mpc-goto-playing-song'. +This command, bound to 'o' in any 'mpc-mode' buffer, moves point to +the currently playing song in the "*MPC-Songs*" buffer. + +--- +*** New user option 'mpc-cover-image-re'. +If non-nil, it is a regexp that should match a valid cover image. + +** Miscellaneous + +--- +*** 'shell-script-mode' now supports 'outline-minor-mode'. +The outline headings have lines that start with "###". + +--- +*** fileloop will now skip missing files instead of signalling an error. + +--- +*** 'tabulated-list-mode' can now restore original display order. +Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', +and that mode allows the user to sort on any column. There was +previously no easy way to get back to the original displayed order +after sorting, but giving a -1 numerical prefix to the sorting command +will now restore the original order. + +--- +*** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'. + +--- +*** New variable 'hl-line-overlay-priority'. +This can be used to change the priority of the hl-line overlays. + ++++ +*** New command 'mailcap-view-file'. +This command will open a viewer based on the file type, as determined +by "~/.mailcap" and related files and variables. + +--- +*** New user option 'remember-diary-regexp'. + +--- +*** New user option 'remember-text-format-function'. + +--- +*** New user option 'authinfo-hide-elements'. +This can be set to nil to inhibit hiding passwords in ".authinfo" files. + +--- +*** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'. +Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll +up/down an entire window, but they now work more like the standard +scrolling commands. + +--- +*** New user option 'bibtex-unify-case-function'. +This new option allows the user to customize how case is converted +when unifying entries. + +--- +*** The user option 'bibtex-maintain-sorted-entries' now permits +user-defined sorting schemes. + +--- +*** New user option 'reveal-auto-hide'. +If non-nil (the default), revealed text is automatically hidden when +point leaves the text. If nil, the text is not hidden again. Instead +'M-x reveal-hide-revealed' can be used to hide all the revealed text. + +--- +*** New user option 'ffap-file-name-with-spaces'. +If non-nil, 'find-file-at-point' and friends will try to guess more +expansively to identify a file name with spaces. Default value is +nil. + +--- +*** Two new commands for centering in 'doc-view-mode'. +The new commands 'doc-view-center-page-horizontally' (bound to 'c h') +and 'doc-view-center-page-vertically' (bound to 'c v') center the page +horizontally and vertically, respectively. + +--- +*** 'tempo-define-template' can now re-assign templates to tags. +Previously, assigning a new template to an already defined tag had no +effect. + +--- +*** The width of the buffer-name column in 'list-buffers' is now dynamic. +The width now depends on the width of the window, but will never be +wider than the length of the longest buffer name, except that it will +never be narrower than 19 characters. + ++++ +*** New diary sexp 'diary-offset'. +It offsets another diary sexp by a number of days. This is useful +when for example your organization has a committee meeting two days +after every monthly meeting which takes place on the third Thursday, +or if you would like to attend a virtual meeting scheduled in a +different timezone causing a difference in the date. + +--- +*** The old non-SMIE indentation of 'sh-mode' has been removed. + +--- +*** 'mspools-show' is now autoloaded. + +--- +*** Loading dunnet.el in batch mode doesn't start the game any more. +Instead you need to do "emacs -f dun-batch" to start the game in +batch mode. + + +* New Modes and Packages in Emacs 28.1 + ++++ +** New mode 'repeat-mode' to allow shorter key sequences. +Type 'M-x repeat-mode' to enable this mode. You can then type +'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' +instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to +resize the selected window interactively, 'M-g n n p p' to navigate +next-error matches. Any other key exits this temporarily enabled +transient mode that supports shorter keys, and then after exiting from +this mode, the last typed key uses the default key binding. + +The user option 'repeat-exit-key' defines an additional key usable to +exit the mode like 'isearch-exit' ('RET'). + +The user option 'repeat-exit-timeout' (default nil, which means +forever) specifies the number of seconds of idle time after which to +break the repetition chain automatically. + +When user option 'repeat-keep-prefix' is non-nil (the default), the +prefix arg of the previous command is kept. This can be used to +e.g. reverse the window navigation direction with 'C-x o M-- o o' or +to set a new step with 'C-x { C-5 { { {', which will set the window +resizing step to 5 columns. + +'M-x describe-repeat-maps' will display a buffer showing +which commands are repeatable in 'repeat-mode'. + +--- +** New themes 'modus-vivendi' and 'modus-operandi'. +These themes are designed to conform with the highest standard for +color-contrast accessibility (WCAG AAA). You can load either of them +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. + +** Dictionary mode +This is a mode for searching a RFC 2229 dictionary server. +'dictionary' opens a buffer for starting operations. +'dictionary-search' performs a lookup for a word. It also supports a +'dictionary-tooltip-mode' which performs a lookup of the word under +the mouse in 'dictionary-tooltip-dictionary' (which must be customized +first). + +--- +** Lisp Data mode +The new command 'lisp-data-mode' enables a major mode for buffers +composed of Lisp symbolic expressions that do not form a computer +program. The ".dir-locals.el" file is automatically set to use this +mode, as are other data files produced by Emacs. + ++++ +** New global mode 'global-goto-address-mode'. +This will enable 'goto-address-mode' in all buffers. + +** transient.el +This library implements support for powerful keyboard-driven menus. +Such menus can be used as simple visual command dispatchers. More +complex menus take advantage of infix arguments, which are somewhat +similar to prefix arguments, but are more flexible and discoverable. + +** hierarchy.el +This library can create, query, navigate and display hierarchical +structures. + +--- +** New major mode for displaying the "etc/AUTHORS" file. +This new 'etc-authors-mode' provides font-locking for displaying the +"etc/AUTHORS" file from the Emacs distribution, and not much else. + + +* Incompatible Lisp Changes in Emacs 28.1 + ++++ +** Emacs now prints a backtrace when signaling an error in batch mode. +This makes debugging Emacs Lisp scripts run in batch mode easier. To +get back the old behavior, set the new variable +'backtrace-on-error-noninteractive' to a nil value. + +--- +** Some floating-point numbers are now handled differently by the Lisp reader. +In previous versions of Emacs, numbers with a trailing dot and an exponent +were read as integers and the exponent ignored: 2.e6 was interpreted as the +integer 2. Such numerals are now read as floats with the exponent included: +2.e6 is now read as the floating-point value 2000000.0. +That is, '(read-from-string "1.e3")' => '(1000.0 . 4)' now. + +--- +** 'equal' no longer examines some contents of window configurations. +Instead, it considers window configurations to be equal only if they +are 'eq'. To compare contents, use 'compare-window-configurations' +instead. This change helps fix a bug in 'sxhash-equal', which returned +incorrect hashes for window configurations and some other objects. + ++++ +** The 'lexical-binding' local variable is always enabled. +Previously, if 'enable-local-variables' was nil, a 'lexical-binding' +local variable would not be heeded. This has now changed, and a file +with a 'lexical-binding' cookie is always heeded. To revert to the +old behavior, set 'permanently-enabled-local-variables' to nil. + ++++ +** '&rest' in argument lists must always be followed by a variable name. +Omitting the variable name after '&rest' was previously tolerated in +some cases but not consistently so; it could lead to crashes or +outright wrong results. Since the utility was marginal at best, it is +now an error to omit the variable. + +--- +** 'kill-all-local-variables' has changed how it handles non-symbol hooks. +The function is documented to eliminate all buffer-local bindings +except variables with a 'permanent-local' property, or hooks that +have elements with a 'permanent-local-hook' property. In addition, it +would also keep lambda expressions in hooks sometimes. The latter has +now been changed: The function will now also remove these. + ++++ +** Temporary buffers no longer run certain buffer hooks. +The macros 'with-temp-buffer' and 'with-temp-file' no longer run the +hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and +'buffer-list-update-hook' for the temporary buffers they create. This +avoids slowing them down when a lot of these hooks are defined. + ++++ +** New face 'child-frame-border' and frame parameter 'child-frame-border-width'. +The face and width of child frames borders can now be determined +separately from those of normal frames. To minimize backward +incompatibility, child frames without a 'child-frame-border-width' +parameter will fall back to using 'internal-border-width'. However, +the new 'child-frame-border' face does constitute a breaking change +since child frames' borders no longer use the 'internal-border' face. + +--- +** 'run-at-time' now tries harder to implement the t TIME parameter. +If TIME is t, the timer runs at an integral multiple of REPEAT. +(I.e., if given a REPEAT of 60, it'll run at 08:11:00, 08:12:00, +08:13:00.) However, when a machine goes to sleep (or otherwise didn't +get a time slot to run when the timer was scheduled), the timer would +then fire every 60 seconds after the time the timer was fired. This +has now changed, and the timer code now recomputes the integral +multiple every time it runs, which means that if the laptop wakes at +08:16:43, it'll fire at that time, but then at 08:17:00, 08:18:00... + +--- +** 'parse-partial-sexp' now signals an error if TO is smaller than FROM. +Previously, this would lead to the function interpreting FROM as TO and +vice versa, which would be confusing when passing in OLDSTATE, which +refers to the old state at FROM. + ++++ +** 'global-mode-string' constructs should end with a space. +This was previously not formalized, which led to combinations of modes +displaying data "smushed together" on the mode line. + ++++ +** 'overlays-in' now handles zero-length overlays slightly differently. +Previously, zero-length overlays at the end of the buffer were included +in the result (if the region queried for stopped at that position). +The same was not the case if the buffer had been narrowed to exclude +the real end of the buffer. This has now been changed, and +zero-length overlays at 'point-max' are always included in the results. + +--- +** 'replace-match' now runs modification hooks slightly later. +The function is documented to leave point after the replacement text, +but this was not always the case if a modification hook inserted text +in front of the replaced text -- 'replace-match' would instead leave +point where the end of the inserted text would have been before the +hook ran. 'replace-match' now always leaves point after the +replacement text. + ++++ +** 'completing-read-default' sets completion variables buffer-locally. +'minibuffer-completion-table' and related variables are now set buffer-locally +in the minibuffer instead of being set via a global let-binding. + +--- +** XML serialization functions now reject invalid characters. +Previously, 'xml-print' would produce invalid XML when given a string +with characters that are not valid in XML (see +https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. + +--- +** JSON + +--- +*** JSON number parsing is now stricter. +Numbers with a leading plus sign, leading zeros, or a missing integer +component are now rejected by 'json-read' and friends. This makes +them more compliant with the JSON specification and consistent with +the native JSON parsing functions. + +--- +*** JSON functions support the semantics of RFC 8259. +The JSON functions 'json-serialize', 'json-insert', +'json-parse-string', and 'json-parse-buffer' now implement some of the +semantics of RFC 8259 instead of the earlier RFC 4627. In particular, +these functions now accept top-level JSON values that are neither +arrays nor objects. + +--- +*** Some JSON encoding functions are now obsolete. +The functions 'json-encode-number', 'json-encode-hash-table', +'json-encode-key', and 'json-encode-list' are now obsolete. + +The first two are kept as aliases of 'json-encode', which should be +used instead. Uses of 'json-encode-list' should be changed to call +one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or +'json-encode-array' instead. + ++++ +*** Native JSON functions now signal an error if libjansson is unavailable. +This affects 'json-serialize', 'json-insert', 'json-parse-string', +and 'json-parse-buffer'. This can happen if Emacs was compiled with +libjansson, but the DLL cannot be found and/or loaded by Emacs at run +time. Previously, Emacs would display a message and return nil in +these cases. + ++++ +** The use of positional arguments in 'define-minor-mode' is obsolete. +These were actually rendered obsolete in Emacs 21 but were never +marked as such. + +--- +** 'pcomplete-ignore-case' is now an obsolete alias of 'completion-ignore-case'. + ++++ +** 'completions-annotations' face is not used when the caller puts own face. +This affects the suffix specified by completion 'annotation-function'. + ++++ +** An active minibuffer now has major mode 'minibuffer-mode'. +This is instead of the erroneous 'minibuffer-inactive-mode' it +formerly had. + +--- +** 'make-text-button' no longer modifies text properties of its first argument. +When its first argument is a string, 'make-text-button' no longer +modifies the string's text properties; instead, it uses and returns +a copy of the string. This helps avoid trouble when strings are +shared or constants. + ++++ +** Some properties from completion tables are now preserved. +If 'minibuffer-allow-text-properties' is non-nil, doing completion +over a table of strings with properties will no longer remove all the +properties before returning. This affects things like 'completing-read'. + +--- +** 'dns-query' now consistently uses Lisp integers to represent integers. +Formerly it made an exception for integer components of SOA records, +because SOA serial numbers can exceed fixnum ranges on 32-bit platforms. +Emacs now supports bignums so this old glitch is no longer needed. + ++++ +** The '&define' keyword in an Edebug specification now disables backtracking. +The implementation was buggy, and multiple '&define' forms in an '&or' +form should be exceedingly rare. See the Info node "(elisp) Backtracking" in +the Emacs Lisp reference manual for background. + ++++ +** The error 'ftp-error' belongs also to category 'remote-file-error'. + ++++ +** The WHEN argument of 'make-obsolete' and related functions is mandatory. +The use of those functions without a WHEN argument was marked obsolete +back in Emacs 23.1. The affected functions are: 'make-obsolete', +'define-obsolete-function-alias', 'make-obsolete-variable', +'define-obsolete-variable-alias'. + ++++ +** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'. + +--- +** Some functions are no longer considered safe by 'unsafep': +'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal' +and 'play-sound-file'. + +--- +** 'sql-*-statement-starters' are no longer user options. +These variables describe facts about the SQL standard and +product-specific additions. There should be no need for users to +customize them. + +--- +** Some locale-related variables have been removed. +The Lisp variables 'previous-system-messages-locale' and +'previous-system-time-locale' have been removed, as they were created +by mistake and were not useful to Lisp code. + +--- +** Function 'lm-maintainer' is replaced with 'lm-maintainers'. +The former is now declared obsolete. + ++++ +** facemenu.el is no longer preloaded. +To use functions/variables from the package, you now have to say +'(require 'facemenu)' or similar. + +--- +** 'facemenu-color-alist' is now obsolete, and is not used. + +--- +** The variable 'keyboard-type' is obsolete and not dynamically scoped any more. + ++++ +** The 'values' variable is now obsolete. +Using it just contributes to the growth of the Emacs memory +footprint. + +--- +** The 'load-dangerous-libraries' variable is now obsolete. +It was used to allow loading Lisp libraries compiled by XEmacs, a +modified version of Emacs which is no longer actively maintained. +This is no longer supported, and setting this variable has no effect. + ++++ +** The macro 'with-displayed-buffer-window' is now obsolete. +Use macro 'with-current-buffer-window' with action alist entry 'body-function'. + +--- +** The rfc2368.el library is now obsolete. +Use rfc6068.el instead. The main difference is that +'rfc2368-parse-mailto-url' and 'rfc2368-unhexify-string' assumed that +the strings were all-ASCII, while 'rfc6068-parse-mailto-url' and +'rfc6068-unhexify-string' parse UTF-8 strings. + +--- +** The inversion.el library is now obsolete. + +--- +** The metamail.el library is now obsolete. + +** Edebug changes + +--- +*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. + ++++ +*** The spec operator ':name NAME' is obsolete, use '&name' instead. + ++++ +*** The spec element 'function-form' is obsolete, use 'form' instead. + ++++ +*** New function 'def-edebug-elem-spec' to define Edebug spec elements. +These used to be defined with 'def-edebug-spec' thus conflating the +two name spaces, which lead to name collisions. +The use of 'def-edebug-spec' to define Edebug spec elements is +declared obsolete. + +--- +** The sb-image.el library is now obsolete. +This was a compatibility kludge which is no longer needed. + +--- +** Some libraries obsolete since Emacs 23 have been removed: +ledit.el, lmenu.el, lucid.el and old-whitespace.el. + +--- +** Some functions and variables obsolete since Emacs 23 have been removed: +'GOLD-map', 'advertised-xscheme-send-previous-expression', +'allout-init', 'bookmark-jump-noselect', +'bookmark-read-annotation-text-func', 'buffer-menu-mode-hook', +'c-forward-into-nomenclature', 'char-coding-system-table', +'char-valid-p', 'charset-bytes', 'charset-id', 'charset-list', +'choose-completion-delete-max-match', 'complete-in-turn', +'completion-base-size', 'completion-common-substring', +'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit', +'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook', +'define-key-rebound-commands', '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', +'erc-announced-server-name', 'erc-default-coding-system', +'erc-process', 'erc-send-command', 'eshell-report-bug', +'eval-next-after-load', 'exchange-dot-and-mark', 'ffap-bug', +'ffap-submit-bug', 'ffap-version', 'file-cache-mouse-choose-completion', +'forward-point', 'generic-char-p', 'global-highlight-changes', +'hi-lock-face-history', 'hi-lock-regexp-history', +'highlight-changes-active-string', 'highlight-changes-initial-state', +'highlight-changes-passive-string', +'icalendar--datetime-to-noneuropean-date', 'image-mode-maybe', +'imenu-example--name-and-position', 'ispell-aspell-supports-utf8', +'lisp-mode-auto-fill', 'locate-file-completion', 'make-coding-system', +'menu-bar-files-menu', 'minibuffer-local-must-match-filename-map', +'mouse-choose-completion', 'mouse-major-mode-menu', +'mouse-popup-menubar', 'mouse-popup-menubar-stuff', +'newsticker-groups-filename', 'nnir-swish-e-index-file', +'nnmail-fix-eudora-headers', 'non-iso-charset-alist', +'nonascii-insert-offset', 'nonascii-translation-table', +'password-read-and-add', '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', +'speedbar-navigating-speed', 'speedbar-update-speed', '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', +'wisent-lex-make-token-table'. + +--- +** Some functions and variables obsolete since Emacs 22 have been removed: +'erc-current-network', 'gnus-article-hide-pgp-hook', +'gnus-inews-mark-gcc-as-read', 'gnus-treat-display-xface', +'gnus-treat-strip-pgp', 'nnmail-spool-file'. + +--- +** The obsolete function 'thread-alive-p' has been removed. + +--- +** The variable 'force-new-style-backquotes' has been removed. +This removes the final remaining trace of old-style backquotes. + +--- +** Some obsolete variable and function aliases in dbus.el have been removed. +In Emacs 24.3, the variable 'dbus-event-error-hooks' was renamed to +'dbus-event-error-functions' and the function +'dbus-call-method-non-blocking' was renamed to 'dbus-call-method'. +The old names, which were kept as obsolete aliases of the new names, +have now been removed. + +--- +** 'find-function-source-path' renamed and re-documented. +The 'find-function' command (and various related commands) were +documented to respect 'find-function-source-path', and to search for +objects in files specified by that variable. It's unclear when this +actually changed, but at some point (perhaps decades ago) these +commands started using 'load-history' to determine where symbols had +been defined (which is much faster). The doc strings of all the +affected function have been updated. 'find-function-source-path' was +still being used by 'find-library' and related commands, so the +user option has been renamed to 'find-library-source-path', and +'find-function-source-path' is now an obsolete variable alias. + +--- +** The macro 'vc-call' no longer evaluates its second argument twice. + + +* Lisp Changes in Emacs 28.1 + ++++ +** The 'interactive' syntax has been extended to allow listing applicable modes. +Forms like '(interactive "p" dired-mode)' can be used to annotate the +commands as being applicable for modes derived from 'dired-mode', +or if the mode is a minor mode, when the current buffer has that +minor mode activated. Note that using this form will create byte code +that is not compatible with byte code in previous Emacs versions. + ++++ +** New forms to declare how completion should happen has been added. +'(declare (completion PREDICATE))' can be used as a general predicate +to say whether the command should be present when completing with +'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand +way of saying that the command should be present when completing from +buffers in major modes derived from MODE..., or, if it's a minor mode, +when that minor mode is enabled in the current buffer. + ++++ +** 'define-minor-mode' now takes an ':interactive' argument. +This can be used for specifying which modes this minor mode is meant +for, or to make the new minor mode non-interactive. The default value +is t. + ++++ +** 'define-derived-mode' now takes an ':interactive' argument. +This can be used to control whether the defined mode is a command +or not, and is useful when defining commands that aren't meant to be +used by users directly. + ++++ +** 'define-globalized-minor-mode' now takes a ':predicate' parameter. +This can be used to control which major modes the minor mode should be +used in. + ++++ +** 'condition-case' now allows for a success handler. +It is written as '(:success BODY...)' where BODY is executed +whenever the protected form terminates without error, with the +specified variable bound to the value of the protected form. + ++++ +** New function 'benchmark-call' to measure the execution time of a function. +Additionally, the number of repetitions can be expressed as a minimal duration +in seconds. + ++++ +** The value thrown to the 'exit' label can now be a function. +This is in addition to values t or nil. If the value is a function, +the command loop will call it with zero arguments before returning. + ++++ +** The behavior of 'format-spec' is now closer to that of 'format'. +In order for the two functions to behave more consistently, +'format-spec' now pads and truncates based on string width rather than +length, and also supports format specifications that include a +truncating precision field, such as "%.2a". + +--- +** 'defvar' detects the error of defining a variable currently lexically bound. +Such mixes are always signs that the outer lexical binding was an +error and should have used dynamic binding instead. + +--- +** New variable 'inhibit-mouse-event-check'. +If bound to non-nil, a command with '(interactive "e")' doesn't signal +an error when invoked by input event that is not a mouse click (e.g., +a key sequence). + +--- +** New variable 'redisplay-skip-initial-frame' to enable batch redisplay tests. +Setting it to nil forces the redisplay to do its job even in the +initial frame used in batch mode. + ++++ +** Doc strings can now link to customization groups. +Text like "customization group `whitespace'" will be made into a +button. When clicked, it will open a Custom buffer displaying that +customization group. + ++++ +** Doc strings can now link to man pages. +Text like "man page `chmod(1)'" will be made into a button. When +clicked, it will open a Man mode buffer displaying that man page. + ++++ +** Buffers can now be created with certain hooks disabled. +The functions 'get-buffer-create' and 'generate-new-buffer' accept a +new optional argument INHIBIT-BUFFER-HOOKS. If non-nil, the new +buffer does not run the hooks 'kill-buffer-hook', +'kill-buffer-query-functions', and 'buffer-list-update-hook'. This +avoids slowing down internal or temporary buffers that are never +presented to users or passed on to other applications. + ++++ +** New command 'make-directory-autoloads'. +This does the same as the old command 'update-directory-autoloads', +but has different semantics: Instead of passing in the output file via +the dynamically bound 'generated-autoload-file' variable, the output +file is now a explicit parameter. + +--- +** Dragging a file into Emacs pushes the file name onto 'file-name-history'. + +--- +** The 'easymenu' library is now preloaded. + +--- +** The 'iso-transl' library is now preloaded. +This means that keystrokes like 'Alt-[' are defined by default, +instead of only becoming available after doing (for instance) +'C-x 8 <letter>'. + +--- +** ':safe' settings in 'defcustom' are now propagated to the loaddefs files. + ++++ +** New ':type' for 'defcustom' for nonnegative integers. +The new 'natnum' type can be used for options that should be +nonnegative integers. + ++++ +** ERT can now output more verbose test failure reports. +If the 'EMACS_TEST_VERBOSE' environment variable is set, failure +summaries will include the failing condition. + +** Byte compiler changes + ++++ +*** New byte-compiler check for missing dynamic variable declarations. +It is meant as an (experimental) aid for converting Emacs Lisp code +to lexical binding, where dynamic (special) variables bound in one +file can affect code in another. For details, see the manual section +"(elisp) Converting to Lexical Binding". + ++++ +*** 'byte-recompile-directory' can now compile symlinked ".el" files. +This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter. + +--- +*** The byte-compiler now warns about too wide documentation strings. +By default, it will warn if a documentation string is wider than the +largest of 'byte-compile-docstring-max-column' or 'fill-column' +characters. + ++++ +*** 'byte-compile-file' optional argument LOAD is now obsolete. +To load the file after byte-compiling, add a call to 'load' from Lisp +or use 'M-x emacs-lisp-byte-compile-and-load' interactively. + +** Macroexp + +--- +*** New function 'macroexp-file-name' to know the name of the current file. + +--- +*** New function 'macroexp-compiling-p' to know if we're compiling. + +--- +*** New function 'macroexp-warn-and-return' to help emit warnings. +This used to be named 'macroexp--warn-and-return' and has proved useful +and well-behaved enough to lose the "internal" marker. + +** map.el + +--- +*** Alist keys are now consistently compared with 'equal' by default. +Until now, 'map-elt' and 'map-delete' compared alist keys with 'eq' by +default. They now use 'equal' instead, for consistency with +'map-put!' and 'map-contains-key'. + +*** Pcase 'map' pattern added keyword symbols abbreviation. +A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', +equivalent to '(map (:sym sym))'. + +--- +*** The function 'map-copy' now uses 'copy-alist' on alists. +This is a slightly deeper copy than the previous 'copy-sequence'. + +--- +*** The function 'map-contains-key' now supports plists. + +--- +*** More consistent duplicate key handling in 'map-merge-with'. +Until now, 'map-merge-with' promised to call its function argument +whenever multiple maps contained 'eql' keys. However, this did not +always coincide with the keys that were actually merged, which could +be 'equal' instead. The function argument is now called whenever keys +are merged, for greater consistency with 'map-merge' and 'map-elt'. + +** pcase + ++++ +*** The 'or' pattern now binds the union of the vars of its sub-patterns. +If a variable is not bound by the subpattern that matched, it gets bound +to nil. This was already sometimes the case, but it is now guaranteed. + ++++ +*** The 'pred' pattern can now take the form '(pred (not FUN))'. +This is like '(pred (lambda (x) (not (FUN x))))' but results +in better code. + +--- +*** New function 'pcase-compile-patterns' to write other macros. + ++++ +*** Added 'cl-type' pattern. +The new 'cl-type' pattern compares types using 'cl-typep', which allows +comparing simple types like '(cl-type integer)', as well as forms like +'(cl-type (integer 0 10))'. + ++++ +*** New macro 'pcase-setq'. +This macro is the 'setq' equivalent of 'pcase-let', which allows for +destructuring patterns in a 'setq' form. + +** Edebug + +*** Edebug specification lists can use some new keywords: + ++++ +**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC. +More specifically, FUN is called with 'HEAD PF ARGS..' where +PF is a parsing function that expects a single argument (the specs to +use) and HEAD is the code that matched SPEC. + ++++ +**** '&error MSG' unconditionally aborts the current edebug instrumentation. + ++++ +**** '&name SPEC FUN' extracts the current name from the code matching SPEC. + +** Dynamic modules changes + ++++ +*** Type aliases for module functions and finalizers. +The module header 'emacs-module.h' now contains type aliases +'emacs_function' and 'emacs_finalizer' for module functions and +finalizers, respectively. + ++++ +*** Module functions can now be made interactive. +Use 'make_interactive' to give a module function an interactive +specification. + ++++ +*** Module functions can now install an optional finalizer. +The finalizer is called when the function object is garbage-collected. +Use 'set_function_finalizer' to set the finalizer and +'get_function_finalizer' to retrieve it. + ++++ +*** Modules can now open a channel to an existing pipe process. +Modules can use the new module function 'open_channel' to do that. +On capable systems, modules can use this functionality to +asynchronously send data back to Emacs. + ++++ +*** A new module API 'make_unibyte_string'. +It can be used to create Lisp strings with arbitrary byte sequences +(a.k.a. "raw bytes"). + ++++ +** Shorthands for Lisp symbols. +Shorthands are a general purpose namespacing system to make Emacs +Lisp's symbol-naming etiquette easier to use. A shorthand is any +symbolic form found in Lisp source that "abbreviates" a symbol's print +name. Among other applications, this feature can be used to avoid +name clashes and namespace pollution by renaming an entire file's +worth of symbols with proper and longer prefixes, without actually +touching the Lisp source. For details, see the manual section +"(elisp) Shorthands". + ++++ +** New function 'string-search'. +This function takes two string parameters and returns the position of +the first instance of the former string in the latter. + ++++ +** New function 'string-replace'. +This function works along the line of 'replace-regexp-in-string', but +it matches on fixed strings instead of regexps, and does not change +the global match state. + ++++ +** New function 'ensure-list'. +This function makes a list of its object if it's not a list already. +If it's already a list, the list is returned as is. + ++++ +** New function 'split-string-shell-command'. +This splits a shell command string into separate components, +respecting quoting with single ('like this') and double ("like this") +quotes, as well as backslash quoting (like\ this). + ++++ +** New function 'string-clean-whitespace'. +This removes whitespace from a string. + ++++ +** New function 'string-fill'. +Word-wrap a string so that no lines are longer that a specific length. + ++++ +** New function 'string-limit'. +Return (up to) a specific substring length. + ++++ +** New function 'string-lines'. +Return a list of strings representing the individual lines in a +string. + ++++ +** New function 'string-pad'. +Pad a string to a specific length. + ++++ +** New function 'string-chop-newline'. +Remove a trailing newline from a string. + ++++ +** New function 'replace-regexp-in-region'. + ++++ +** New function 'replace-string-in-region'. + ++++ +** New function 'file-name-with-extension'. +This function allows a canonical way to set/replace the extension of a +file name. + ++++ +** New function 'file-modes-number-to-symbolic' to convert a numeric +file mode specification into symbolic form. + ++++ +** New function 'file-name-concat'. +This appends file name components to a directory name and returns the +result. + ++++ +** New function 'file-backup-file-names'. +This function returns the list of file names of all the backup files +for the specified file. + ++++ +** New function 'directory-empty-p'. +This predicate tests whether a given file name is an accessible +directory and whether it contains no other directories or files. + ++++ +** New function 'buffer-local-boundp'. +This predicate says whether a symbol is bound in a specific buffer. + ++++ +** New function 'always'. +This is identical to 'ignore', but returns t instead. + ++++ +** New function 'sxhash-equal-including-properties'. +This is identical to 'sxhash-equal' but also accounts for string +properties. + +--- +** New function 'buffer-line-statistics'. +This function returns some statistics about the line lengths in a buffer. + +--- +** New function 'color-values-from-color-spec'. +This can be used to parse RGB color specs in several formats and +convert them to a list '(R G B)' of primary color values. + +--- +** New function 'custom-add-choice'. +This function can be used by modes to add elements to the +'choice' customization type of a variable. + +--- +** New function 'decoded-time-period'. +It interprets a decoded time structure as a period and returns the +equivalent period in seconds. + ++++ +** New function 'dom-print'. + ++++ +** New function 'dom-remove-attribute'. + +--- +** New function 'dns-query-asynchronous'. +It takes the same parameters as 'dns-query', but adds a callback +parameter. + +** New function 'garbage-collect-maybe' to trigger GC early. + +--- +** New function 'get-locale-names'. +This utility function returns a list of names of locales available on +the current system. + ++++ +** New function 'insert-into-buffer'. +This inserts the contents of the current buffer into another buffer. + ++++ +** New function 'json-available-p'. +This predicate returns non-nil if Emacs is built with libjansson +support, and it is available on the current system. + +--- +** New function 'mail-header-parse-addresses-lax'. +This takes a comma-separated string and returns a list of mail/name +pairs. + +--- +** New function 'mail-header-parse-address-lax'. +Parse a string as a mail address-like string. + +--- +** New function 'make-separator-line'. +Make a string appropriate for usage as a visual separator line. + ++++ +** New function 'num-processors'. +Return the number of processors on the system. + ++++ +** New function 'object-intervals'. +This function returns a copy of the list of intervals (i.e., text +properties) in the object in question (which must either be a string +or a buffer). + ++++ +** New function 'process-lines-ignore-status'. +This is like 'process-lines', but does not signal an error if the +return status is non-zero. 'process-lines-handling-status' has also +been added, and takes a callback to handle the return status. + ++++ +** New function 'require-theme'. +This function is like 'require', but searches 'custom-theme-load-path' +instead of 'load-path'. It can be used by Custom themes to load +supporting Lisp files when 'require' is unsuitable. + ++++ +** New function 'seq-union'. +This function takes two sequences and returns a list of all elements +that appear in either of them, with no two elements that compare equal +appearing in the result. + ++++ +** New function 'syntax-class-to-char'. +This does almost the opposite of 'string-to-syntax' -- it returns the +syntax descriptor (a character) given a raw syntax descriptor (an +integer). + ++++ +** New functions 'null-device' and 'path-separator'. +These functions return the connection local value of the respective +variables. This can be used for remote hosts. + ++++ +** New predicate functions 'length<', 'length>' and 'length='. +Using these functions may be more efficient than using 'length' (if +the length of a (long) list is being computed just to compare this +length to a number). + ++++ +** New macro 'dlet' to dynamically bind variables. + ++++ +** New macro 'with-existing-directory'. +This macro binds 'default-directory' to some other existing directory +if 'default-directory' doesn't exist, and then executes the body forms. + ++++ +** New variable 'current-minibuffer-command'. +This is like 'this-command', but it is bound recursively when entering +the minibuffer. + ++++ +** New variable 'inhibit-interaction' to make user prompts signal an error. +If this is bound to something non-nil, functions like +'read-from-minibuffer', 'read-char' (and related) will signal an +'inhibited-interaction' error. + +--- +** New variable 'indent-line-ignored-functions'. +This allows modes to cycle through a set of indentation functions +appropriate for those modes. + ++++ +** New variable 'print-integers-as-characters' modifies integer printing. +If this variable is non-nil, character syntax is used for printing +numbers when this makes sense, such as '?A' for 65. + ++++ +** New variable 'tty-menu-calls-mouse-position-function'. +This controls whether 'mouse-position-function' is called by functions +that retrieve the mouse position when that happens during TTY menu +handling. Lisp programs that set 'mouse-position-function' should +also set this variable non-nil if they are compatible with the tty +menu handling. + ++++ +** New variables that hold default buffer names for shell output. +The new constants 'shell-command-buffer-name' and +'shell-command-buffer-name-async' store the default buffer names +for the output of, respectively, synchronous and async shell +commands. + +--- +** New variables 'read-char-choice-use-read-key' and 'y-or-n-p-use-read-key'. +When non-nil, then functions 'read-char-choice' and 'y-or-n-p' +(respectively) use the function 'read-key' to read a character instead +of using the minibuffer. + ++++ +** New variable 'global-minor-modes'. +This variable holds a list of currently enabled global minor modes (as +a list of symbols). + ++++ +** New buffer-local variable 'local-minor-modes'. +This permanently buffer-local variable holds a list of currently +enabled non-global minor modes in the current buffer (as a list of +symbols). + ++++ +** New completion function 'affixation-function' to add prefix/suffix. +It accepts a list of completions and should return a list where +each element is a list with three elements: a completion, +a prefix string, and a suffix string. + ++++ +** New completion function 'group-function' for grouping candidates. +It takes two arguments: a completion candidate and a 'transform' flag. + ++++ +** New error symbol 'minibuffer-quit'. +Signaling it has almost the same effect as 'quit' except that it +doesn't cause keyboard macro termination. + ++++ +** New error 'remote-file-error', a subcategory of 'file-error'. +It is signaled if a remote file operation fails due to internal +reasons, and could block Emacs. It does not replace 'file-error' +signals for the usual cases. Timers, process filters and process +functions, which run remote file operations, shall protect themselves +against this error. + +If such an error occurs, please report this as bug via 'M-x report-emacs-bug'. +Until it is solved you could ignore such errors by performing + + (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) + ++++ +** New macro 'named-let' added to subr-x.el. +It provides Scheme's "named let" looping construct. + +--- +** Emacs now attempts to test for high-rate subprocess output more fairly. +When several subprocesses produce output simultaneously at high rate, +Emacs will now by default attempt to service them all in a round-robin +fashion. Set the new variable 'process-prioritize-lower-fds' to a +non-nil value to get back the old behavior, whereby after reading +from a subprocess, Emacs would check for output of other subprocesses +in a way that is likely to read from the same process again. + ++++ +** 'set-process-buffer' now updates the process mark. +The mark will be set to point to the end of the new buffer. + ++++ +** 'unlock-buffer' displays warnings instead of signaling. +Instead of signaling 'file-error' conditions for file system level +errors, the function now calls 'display-warning' and continues as if +the error did not occur. + ++++ +** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'. +If you bind 'help-form' to a non-nil value while calling these functions, +then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form' +and display the result. + ++++ +** 'read-number' now has its own history variable. +Additionally, the function now accepts a HIST argument which can be +used to specify a custom history variable. + ++++ +** 'set-window-configuration' now takes two optional parameters, +'dont-set-frame' and 'dont-set-miniwindow'. The first of these, when +non-nil, instructs the function not to select the frame recorded in +the configuration. The second prevents the current minibuffer being +replaced by the one stored in the configuration. + +--- +** 'count-windows' now takes an optional parameter ALL-FRAMES. +The semantics are as with 'walk-windows'. + ++++ +** 'truncate-string-ellipsis' now uses '…' by default. +Modes that use 'truncate-string-to-width' with non-nil, non-string +argument ELLIPSIS, will now indicate truncation using '…' when +the selected frame can display it, and using "..." otherwise. + ++++ +** 'string-width' now accepts two optional arguments FROM and TO. +This allows calculating the width of a substring without consing a +new string. + ++++ +** 'directory-files' now takes an additional COUNT parameter. +The parameter makes 'directory-files' return COUNT first file names +from a directory. If MATCH is also given, the function will return +first COUNT file names that match the expression. The same COUNT +parameter has been added to 'directory-files-and-attributes'. + ++++ +** 'count-lines' can now ignore invisible lines. +This is controlled by the optional parameter IGNORE-INVISIBLE-LINES. + +--- +** 'count-words' now crosses field boundaries. +Originally, 'count-words' would stop counting at the first field +boundary it encountered; now it keeps counting all the way to the +region's (or buffer's) end. + ++++ +** File-related APIs can optionally follow symlinks. +The functions 'file-modes', 'set-file-modes', and 'set-file-times' now +have an optional argument specifying whether to follow symbolic links. + ++++ +** 'format-seconds' can now be used for sub-second times. +The new optional "," parameter has been added, and +'(format-seconds "%mm %,1ss" 66.4)' will now result in "1m 6.4s". + ++++ +** 'parse-time-string' can now parse ISO 8601 format strings. +These have a format like "2020-01-15T16:12:21-08:00". + +--- +** 'lookup-key' is more allowing when searching for extended menu items. +When looking for a menu item '[menu-bar Foo-Bar]', first try to find +an exact match, then look for the lowercased '[menu-bar foo-bar]'. +It will only try to downcase ASCII characters in the range "A-Z". +This improves backwards-compatibility when converting menus to use +'easy-menu-define'. + +--- +** 'make-network-process', 'make-serial-process' ':coding' behavior change. +Previously, passing ':coding nil' to either of these functions would +override any non-nil binding for 'coding-system-for-read' and +'coding-system-for-write'. For consistency with 'make-process' and +'make-pipe-process', passing ':coding nil' is now ignored. No code in +Emacs depended on the previous behavior; if you really want the +process' coding-system to be nil, use 'set-process-coding-system' +after the process has been created, or pass in ':coding '(nil nil)'. + ++++ +** 'open-network-stream' now accepts a ':coding' argument. +This allows specifying the coding systems used by a network process +for encoding and decoding without having to bind +'coding-system-for-{read,write}' or call 'set-process-coding-system'. + ++++ +** 'open-network-stream' can now take a ':capability-command' that's a function. +The function is called with the greeting from the server as its only +parameter, and allows sending different TLS capability commands to the +server based on that greeting. + ++++ +** 'open-gnutls-stream' now also accepts a ':coding' argument. + +--- +** 'process-attributes' now works under OpenBSD, too. + ++++ +** 'format-spec' now takes an optional SPLIT parameter. +If non-nil, 'format-spec' will split the resulting string into a list +of strings, based on where the format specs (and expansions) were. + +--- +** 'unload-feature' now also tries to undo additions to buffer-local hooks. + +--- +** 'while-no-input-ignore-events' accepts more special events. +The special events 'dbus-event' and 'file-notify' are now ignored in +'while-no-input' when added to this variable. + +--- +** 'start-process-shell-command' and 'start-file-process-shell-command' +do not support the old calling conventions any longer. + ++++ +** 'yes-or-no-p' and 'y-or-n-p' PROMPT parameter no longer needs trailing space. +In other words, the prompt can now end with "?" instead of "? ". This +has been the case since Emacs 24.4 but was not announced or documented +until now. (Checkdoc has also been updated to accept this convention.) + ++++ +** The 'uniquify' argument in 'auto-save-file-name-transforms' can be a symbol. +If this symbol is one of the members of 'secure-hash-algorithms', +Emacs constructs the nondirectory part of the auto-save file name by +applying that 'secure-hash' to the buffer file name. This avoids any +risk of excessively long file names. + ++++ +** New user option 'process-file-return-signal-string'. +It controls, whether 'process-file' returns a string when a remote +process is interrupted by a signal. + +** EIEIO Changes + ++++ +*** The macro 'oref-default' can now be used with 'setf'. +It is now defined as a generalized variable that can be used with +'setf' to modify the value stored in a given class slot. + +--- +*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated. +This corresponds to the behavior of defmethod in Common Lisp Object System. +For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now. + +** D-Bus + ++++ +*** Property values can be typed explicitly. +'dbus-register-property' and 'dbus-set-property' accept now optional +type symbols. Both functions propagate D-Bus errors. + ++++ +*** Registered properties can have the new access type ':write'. + ++++ +*** In case of problems, handlers can emit proper D-Bus error messages now. + ++++ +*** D-Bus errors, which have been converted from incoming D-Bus error +messages, contain the error name of that message now. + ++++ +*** D-Bus messages can be monitored with the new command 'dbus-monitor'. + ++++ +*** D-Bus events have changed their internal structure. +They carry now the destination and the error-name of an event. They +also keep the type information of their arguments. Use the +'dbus-event-*' accessor functions. + +** Buttons + ++++ +*** New minor mode 'button-mode'. +This minor mode does nothing except install 'button-buffer-map' as +a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate +to buttons), and can be used in any view-mode-like buffer that has +buttons in it. + ++++ +*** New utility function 'button-buttonize'. +This function takes a string and returns a string propertized in a way +that makes it a valid button. + +--- +** 'text-scale-mode' can now adjust font size of the header line. +When the new buffer local variable 'text-scale-remap-header-line' +is non-nil, 'text-scale-adjust' will also scale the text in the header +line when displaying that buffer. + +This is useful for major modes that arrange their display in a tabular +form below the header line. It is enabled by default in +'tabulated-list-mode' and its derived modes, and disabled by default +elsewhere. + +--- +** 'ascii' is now a coding system alias for 'us-ascii'. + +--- +** New coding-systems for EBCDIC variants. +New coding-systems 'ibm256', 'ibm273', 'ibm274', 'ibm277', 'ibm278', +'ibm280', 'ibm281', 'ibm284', 'ibm285', 'ibm290', 'ibm297'. These are +variants of the EBCDIC encoding tailored to some European and Japanese +locales. They are also available as aliases 'ebcdic-cp-*' (e.g., +'ebcdic-cp-fi' for the Finnish variant 'ibm278'), and 'cp2xx' (e.g., +'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to +support these coding-systems. + ++++ +** New 'Bindat type expression' description language. +This new system is provided by the new macro 'bindat-type' and +obsoletes the old data layout specifications. It supports +arbitrary-size integers, recursive types, and more. See the Info node +"(elisp) Byte Packing" in the ELisp manual for more details. + ++++ +** New macro 'with-environment-variables'. +This macro allows setting environment variables temporarily when +executing a form. + + +* Changes in Emacs 28.1 on Non-Free Operating Systems + ++++ +** On MS-Windows, Emacs can now use the native image API to display images. +Emacs can now use the MS-Windows GDI+ library to load and display +images in JPEG, PNG, GIF and TIFF formats. This support is available +unless Emacs was configured '--without-native-image-api'. + +This feature is experimental, and needs to be turned on to be used. +To turn this on, set the variable 'w32-use-native-image-API' to a +non-nil value. Please report any bugs you find while using the native +image API via 'M-x report-emacs-bug'. + ++++ +** On MS-Windows, Emacs can now toggle the IME. +A new function 'w32-set-ime-open-status' can now be used to disable +and enable the MS-Windows native Input Method Editor (IME) at run +time. A companion function 'w32-get-ime-open-status' returns the +current IME activation status. + +-- +** On macOS, 's-<left>' and 's-<right>' are now bound to +'move-beginning-of-line' and 'move-end-of-line' respectively. The commands +to select previous/next frame are still bound to 's-~' and 's-`'. + ++++ +** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix. +'module-file-suffix' now has the value ".dylib" on macOS, but the +".so" suffix is supported as well. + +--- +** On macOS, the user option 'make-pointer-invisible' is now honored. + +--- +** On macOS, Xwidget is now supported. +If Emacs was built with xwidget support, you can access the embedded +webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two +instances of xwidget webkit is not supported. + +--- +*** New user option 'xwidget-webkit-enable-plugins'. +If non-nil, enable plugins in xwidget. (This is only available on +macOS.) + ++++ +** New macOS Contacts back-end for EUDC. +This backend works on newer versions of macOS and is generally +preferred over the eudcb-mab.el backend. + + +---------------------------------------------------------------------- +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/>. + + +Local variables: +coding: utf-8 +mode: outline +paragraph-separate: "[ ]*$" +end: diff --git a/etc/PROBLEMS b/etc/PROBLEMS index bb5f3b76c1e..b069ccee56f 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1082,14 +1082,6 @@ The solution is to remove the corresponding lines from the appropriate 'fonts.alias' file, then run 'mkfontdir' in that directory, and then run 'xset fp rehash'. -** The 'oc-unicode' package doesn't work with Emacs 21. - -This package tries to define more private charsets than there are free -slots now. The current built-in Unicode support is actually more -flexible. (Use option 'utf-translate-cjk-mode' if you need CJK -support.) Files encoded as emacs-mule using oc-unicode aren't -generally read correctly by Emacs 21. - * X runtime problems ** X keyboard problems @@ -2287,20 +2279,6 @@ are compiling with the system's 'cc' and CFLAGS containing '-O5'. If so, you have hit a compiler bug. Please make sure to re-configure Emacs so that it isn't compiled with '-O5'. -*** AIX 4.3.x or 4.4: Compiling fails. - -This could happen if you use /bin/c89 as your compiler, instead of -the default 'cc'. /bin/c89 treats certain warnings, such as benign -redefinitions of macros, as errors, and fails the build. A solution -is to use the default compiler 'cc'. - -*** AIX 4: Some programs fail when run in a Shell buffer -with an error message like No terminfo entry for "unknown". - -On AIX, many terminal type definitions are not installed by default. -'unknown' is one of them. Install the "Special Generic Terminal -Definitions" to make them defined. - ** Solaris We list bugs in current versions here. See also the section on legacy @@ -2352,13 +2330,6 @@ runtime shared library, distributed with Windows 9X. A workaround is to build Emacs with MinGW runtime 3.x (the latest version is 3.20). -** addpm fails to run on Windows NT4, complaining about Shell32.dll - -This is likely to happen because Shell32.dll shipped with NT4 lacks -the updates required by Emacs. Installing Internet Explorer 4 solves -the problem. Note that it is NOT enough to install IE6, because doing -so will not install the Shell32.dll update. - ** A few seconds delay is seen at startup and for many file operations This happens when the Net Logon service is enabled. During Emacs @@ -2472,15 +2443,6 @@ C:\Users\<UserName>\): Look for the file 'emacs.lnk' there. -** Windows 95 and networking. - -To support server sockets, Emacs loads ws2_32.dll. If this file is -missing, all Emacs networking features are disabled. - -Old versions of Windows 95 may not have the required DLL. To use -Emacs's networking features on Windows 95, you must install the -"Windows Socket 2" update available from MicroSoft's support Web. - ** Emacs exits with "X protocol error" when run with an X server for MS-Windows. A certain X server for Windows had a bug which caused this. @@ -2517,11 +2479,6 @@ other) messages while waiting for a system function, which popped up the menu/dialog, to return the result of the dialog or pop-up menu interaction. -** Help text in tooltips does not work on old Windows versions - -Windows 95 and Windows NT up to version 4.0 do not support help text -for menus. Help text is only available in later versions of Windows. - ** Display problems with ClearType method of smoothing When "ClearType" method is selected as the "method to smooth edges of @@ -3140,15 +3097,6 @@ of PURESIZE in puresize.h. But in some of the cases listed above, this problem is a consequence of something else that is wrong. Be sure to check and fix the real problem. -*** OpenBSD 4.0 macppc: Segfault during dumping. - -The build aborts with signal 11 when the command './temacs --batch ---load loadup bootstrap' tries to load files.el. A workaround seems -to be to reduce the level of compiler optimization used during the -build (from -O2 to -O1). It is possible this is an OpenBSD -GCC problem specific to the macppc architecture, possibly only -occurring with older versions of GCC (e.g. 3.3.5). - *** openSUSE 10.3: Segfault in bcopy during dumping. This is due to a bug in the bcopy implementation in openSUSE 10.3. @@ -3303,8 +3251,51 @@ should do. pen@lysator.liu.se says (Feb 1998) that the Compose key does work if you link with the MIT X11 libraries instead of the Solaris X11 libraries. +** OpenBSD + +*** OpenBSD 4.0 macppc: Segfault during dumping. + +The build aborts with signal 11 when the command './temacs --batch +--load loadup bootstrap' tries to load files.el. A workaround seems +to be to reduce the level of compiler optimization used during the +build (from -O2 to -O1). It is possible this is an OpenBSD +GCC problem specific to the macppc architecture, possibly only +occurring with older versions of GCC (e.g. 3.3.5). + +** AIX + +*** AIX 4.3.x or 4.4: Compiling fails. + +This could happen if you use /bin/c89 as your compiler, instead of +the default 'cc'. /bin/c89 treats certain warnings, such as benign +redefinitions of macros, as errors, and fails the build. A solution +is to use the default compiler 'cc'. + +*** AIX 4: Some programs fail when run in a Shell buffer +with an error message like No terminfo entry for "unknown". + +On AIX, many terminal type definitions are not installed by default. +'unknown' is one of them. Install the "Special Generic Terminal +Definitions" to make them defined. + ** MS-Windows 95, 98, ME, and NT +*** MS-Windows 95: Networking. + +To support server sockets, Emacs loads ws2_32.dll. If this file is +missing, all Emacs networking features are disabled. + +Old versions of Windows 95 may not have the required DLL. To use +Emacs's networking features on Windows 95, you must install the +"Windows Socket 2" update available from MicroSoft's support Web. + +*** MS-Windows NT4: addpm fails to run, complaining about Shell32.dll + +This is likely to happen because Shell32.dll shipped with NT4 lacks +the updates required by Emacs. Installing Internet Explorer 4 solves +the problem. Note that it is NOT enough to install IE6, because doing +so will not install the Shell32.dll update. + *** MS-Windows NT/95: Problems running Perl under Emacs 'perl -de 0' just hangs when executed in an Emacs subshell. @@ -3368,6 +3359,11 @@ For Perl 4: } else { +*** MS-Windows NT/95: Help text in tooltips does not work + +Windows 95 and Windows NT up to version 4.0 do not support help text +for menus. Help text is only available in later versions of Windows. + *** MS-Windows 95: Alt-f6 does not get through to Emacs. This character seems to be trapped by the kernel in Windows 95. diff --git a/etc/e/README b/etc/e/README index dd2c8d64e25..1293292a878 100644 --- a/etc/e/README +++ b/etc/e/README @@ -1,12 +1,12 @@ -eterm-color.ti is a terminfo source file. eterm-color is a compiled -version produced by the terminfo compiler (tic). The compiled files -are binary, and depend on the version of tic, but they seem to be -system-independent and backwardly compatible. So there should be no -need to recompile the distributed binary version. If it is -necessary, use: +eterm-color.ti is a terminfo source file. eterm-color and +eterm-direct are compiled versions produced by the terminfo compiler +(tic). The compiled files are binary, and depend on the version of +tic, but they seem to be system-independent and backwardly compatible. +So there should be no need to recompile the distributed binary +version. If it is necessary, use: tic -o ../ ./eterm-color.ti -The compiled file is used by lisp/term.el, so if it is moved term.el -needs to be changed. terminfo requires it to be stored in an 'e' -subdirectory (the first character of the file name). +The compiled files are used by lisp/term.el, so if they are moved, +term.el needs to be changed. terminfo requires them to be stored in +an 'e' subdirectory (the first character of the file name). diff --git a/etc/e/eterm-color b/etc/e/eterm-color Binary files differindex bd3f5003ae6..bf44fa0f36d 100644 --- a/etc/e/eterm-color +++ b/etc/e/eterm-color diff --git a/etc/e/eterm-color.ti b/etc/e/eterm-color.ti index a6ef8149900..eeb9b0b6e6a 100644 --- a/etc/e/eterm-color.ti +++ b/etc/e/eterm-color.ti @@ -9,15 +9,16 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, # Any change to this file should be done at the same time with a # corresponding change to the TERMCAP environment variable in term.el. # Comments in term.el specify where each of these capabilities is implemented. - colors#8, + colors#256, cols#80, lines#24, - pairs#64, + pairs#32767, am, mir, msgr, xenl, bel=^G, + blink=\E[5m, bold=\E[1m, clear=\E[H\E[J, cr=\r, @@ -31,6 +32,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, cup=\E[%i%p1%d;%p2%dH, cuu1=\E[A, cuu=\E[%p1%dA, + dim=\E[2m, dch1=\E[P, dch=\E[%p1%dP, dl1=\E[M, @@ -60,14 +62,16 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, rc=\E8, rev=\E[7m, ri=\EM, + ritm=\E[23m, rmir=\E[4l, rmso=\E[27m, rmul=\E[24m, rs1=\Ec, sc=\E7, - setab=\E[%p1%{40}%+%dm, - setaf=\E[%p1%{30}%+%dm, + setab=\E[%?%p1%{8}%<%t4%p1%d%e%p1%{16}%<%t10%p1%{8}%-%d%e48;5;%p1%d%;m, + setaf=\E[%?%p1%{8}%<%t3%p1%d%e%p1%{16}%<%t9%p1%{8}%-%d%e38;5;%p1%d%;m, sgr0=\E[m, + sitm=\E[3m, smir=\E[4h, smul=\E[4m, smso=\E[7m, @@ -76,3 +80,10 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, # smcup=\E[?47h, # rmcup=\E[?47l, # rs2 may need to be added + +eterm-direct|Emacs term.el with direct-color indexing term-protocol-version 0.96, + use=eterm-color, + colors#0x1000000, + pairs#0x10000, + setab=\E[%?%p1%{8}%<%t4%p1%d%e48;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m, + setaf=\E[%?%p1%{8}%<%t3%p1%d%e38;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m, diff --git a/etc/e/eterm-direct b/etc/e/eterm-direct Binary files differnew file mode 100644 index 00000000000..c113c371369 --- /dev/null +++ b/etc/e/eterm-direct diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index 179be0af885..018be36eb46 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -40,7 +40,7 @@ \newlength{\ColThreeWidth} \setlength{\ColThreeWidth}{25mm} -\newcommand{\versionemacs}[0]{28} % version of Emacs this is for +\newcommand{\versionemacs}[0]{29} % version of Emacs this is for \newcommand{\cyear}[0]{2021} % copyright year \newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el index c98bec6cfa5..7d297df5260 100644 --- a/etc/themes/adwaita-theme.el +++ b/etc/themes/adwaita-theme.el @@ -96,6 +96,9 @@ default look of the Gnome 3 desktop.") `(gnus-cite-1 ((,class (:foreground "#00578E")))) `(gnus-cite-2 ((,class (:foreground "#0084C8")))) + `(image-dired-thumb-mark ((,class (:background "#CE5C00")))) + `(image-dired-thumb-flagged ((,class (:background "#B50000")))) + `(diff-added ((,class (:bold t :foreground "#4E9A06")))) `(diff-removed ((,class (:bold t :foreground "#F5666D")))))) diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el index cfe8a5bfb28..5895693386c 100644 --- a/etc/themes/deeper-blue-theme.el +++ b/etc/themes/deeper-blue-theme.el @@ -82,6 +82,8 @@ `(ido-first-match ((,class (:weight normal :foreground "orange")))) `(ido-only-match ((,class (:foreground "green")))) `(ido-subdir ((,class (:foreground nil :inherit font-lock-keyword-face)))) + `(image-dired-thumb-flagged ((,class (:background "Red1")))) + `(image-dired-thumb-mark ((,class (:background "dodgerblue3")))) `(info-header-node ((,class (:foreground "DeepSkyBlue1")))) `(info-header-xref ((,class (:foreground "SeaGreen2")))) `(info-menu-header ((,class (:family "helv" :weight bold)))) diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el index c59b24bef50..148ebd434cd 100644 --- a/etc/themes/dichromacy-theme.el +++ b/etc/themes/dichromacy-theme.el @@ -101,6 +101,9 @@ Ansi-Color faces are included.") `(gnus-header-subject ((,class (:foreground ,orange)))) `(gnus-header-name ((,class (:foreground ,skyblue)))) `(gnus-header-newsgroups ((,class (:foreground ,vermillion)))) + ;; Image-Dired + `(image-dired-thumb-flagged ((,class (:background ,vermillion)))) + `(image-dired-thumb-mark ((,class (:background ,orange)))) ;; Message faces `(message-header-name ((,class (:foreground ,skyblue)))) `(message-header-cc ((,class (:foreground ,vermillion)))) diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index 95ec303f706..514384ca2af 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -632,6 +632,8 @@ more...") `(ilog-echo-face ((,class (:height 2.0 :foreground "#006FE0")))) `(ilog-load-face ((,class (:foreground "#BA36A5")))) `(ilog-message-face ((,class (:foreground "#808080")))) + `(image-dired-thumb-flagged ((,class (:background "red")))) + `(image-dired-thumb-mark ((,class :background "#FFAAAA"))) `(indent-guide-face ((,class (:foreground "#D3D3D3")))) `(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background "LightSteelBlue1")))) `(info-header-node ((,class (:underline t :foreground "orange")))) ; nodes in header diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el index f49b37a15fd..547d2df04c0 100644 --- a/etc/themes/light-blue-theme.el +++ b/etc/themes/light-blue-theme.el @@ -29,6 +29,8 @@ (deftheme light-blue "Face colors utilizing a light blue background.") +(make-obsolete 'light-blue nil "29.1") + (let ((class '((class color) (min-colors 89)))) (custom-theme-set-faces 'light-blue diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index 0e5fb391198..f10b88507e3 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -221,6 +221,9 @@ jarring angry fruit salad look to reduce eye fatigue.") '(gnus-group-news-low-empty ((t (:foreground "DarkTurquoise")))) '(gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + ;; '(image-dired-thumb-flagged ((t (:background "red")))) + ;; '(image-dired-thumb-mark ((t (:background "Pink")))) + ;;message faces '(message-cited-text ((t (:foreground "red3")))) '(message-header-cc ((t (:bold t :foreground "chartreuse1" :weight bold)))) diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el index 729c082a331..9cf8e7dfc93 100644 --- a/etc/themes/whiteboard-theme.el +++ b/etc/themes/whiteboard-theme.el @@ -63,6 +63,8 @@ `(ido-first-match ((,class (:weight normal :foreground "DarkOrange3")))) `(ido-only-match ((,class (:foreground "SeaGreen4")))) `(ido-subdir ((,class (:foreground nil :inherit font-lock-keyword-face)))) + `(image-dired-thumb-flagged ((,class :background "Red1"))) + `(image-dired-thumb-mark ((,class :background "dodgerblue3"))) `(info-header-node ((,class (:foreground "DeepSkyBlue1")))) `(info-header-xref ((,class (:foreground "SeaGreen2")))) `(info-menu-header ((,class (:family "helv" :weight bold)))) diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index 2ee4f74c324..465768aa87c 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -1,4 +1,4 @@ -שיעור ראשון בשימוש ב־Emacs. זכויות שימוש ראה בסוף המסמך. +שיעור ראשון בשימוש ב־Emacs. זכויות שימוש ראה בסוף המסמך. פקודות רבות של Emacs משתמשות במקש CONTROL (בדרך־כלל מסומן ב־CTRL) או במקש META (בדרך־כלל מסומן ALT). במקום לציין את כל השמות האפשריים @@ -24,7 +24,7 @@ שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למסך, מה שמבטיח רציפות מסוימת בעת קריאת הטקסט. -הטקסט שלפניכם הינו עותק של שיעור בשימוש ב־Emacs שהותאם קלות עבורכם. +הטקסט שלפניכם הינו עותק של שיעור בשימוש ב־Emacs שהותאם קלות עבורכם. בהמשך תקבלו הוראות לנסות פקודות שונות כדי לבצע שינויים בטקסט הזה. אם במקרה תשנו את הטקסט לפני שנבקש, אל דאגה: זוהי "עריכה" שהיא יעודו של Emacs. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index cff3cec2a79..0e800dd7e89 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -116,6 +116,9 @@ static bool eval; /* True means open a new frame. --create-frame etc. */ static bool create_frame; +/* True means reuse a frame if it already exists. */ +static bool reuse_frame; + /* The display on which Emacs should work. --display. */ static char const *display; @@ -165,6 +168,7 @@ static struct option const longopts[] = { "tty", no_argument, NULL, 't' }, { "nw", no_argument, NULL, 't' }, { "create-frame", no_argument, NULL, 'c' }, + { "reuse-frame", no_argument, NULL, 'r' }, { "alternate-editor", required_argument, NULL, 'a' }, { "frame-parameters", required_argument, NULL, 'F' }, #ifdef SOCKETS_IN_FILE_SYSTEM @@ -551,6 +555,11 @@ decode_options (int argc, char **argv) create_frame = true; break; + case 'r': + create_frame = true; + reuse_frame = true; + break; + case 'p': parent_id = optarg; create_frame = true; @@ -647,6 +656,8 @@ The following OPTIONS are accepted:\n\ -nw, -t, --tty Open a new Emacs frame on the current terminal\n\ -c, --create-frame Create a new frame instead of trying to\n\ use the current Emacs frame\n\ +-r, --reuse-frame Create a new frame if none exists, otherwise\n\ + use the current Emacs frame\n\ ", "\ -F ALIST, --frame-parameters=ALIST\n\ Set the parameters of a new frame\n\ @@ -1941,7 +1952,7 @@ main (int argc, char **argv) if (nowait) send_to_emacs (emacs_socket, "-nowait "); - if (!create_frame) + if (!create_frame || reuse_frame) send_to_emacs (emacs_socket, "-current-frame "); if (display) diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index ccf827cf526..c8bcf742fea 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -20,14 +20,8 @@ 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/>. */ -/* Temporary workaround for compilation problems with MinGW64 GCC 11. - The funky #ifdef's are to avoid warnings about unused macros. */ -#define _GL_ATTRIBUTE_MALLOC -#define _GL_ATTRIBUTE_DEALLOC_FREE -#ifdef _GL_ATTRIBUTE_MALLOC -#endif -#ifdef _GL_ATTRIBUTE_DEALLOC_FREE -#endif +#define DEFER_MS_W32_H +#include <config.h> #include <windows.h> #include <stdlib.h> @@ -296,9 +290,6 @@ is_exec (const char * name) stricmp (p, ".cmd") == 0)); } -/* FIXME? This is in configure.ac now - is this still needed? */ -#define IS_DIRECTORY_SEP(x) ((x) == '/' || (x) == '\\') - /* We need stat/fsfat below because nt/inc/sys/stat.h defines struct stat that is incompatible with the MS run-time libraries. */ int diff --git a/lisp/abbrev.el b/lisp/abbrev.el index b0e8a4fa99c..d3daf637cc6 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -583,6 +583,7 @@ PROPS is a property list. The following properties are special: An obsolete but still supported calling form is: \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)." + (declare (indent defun)) (when (and (consp props) (or (null (car props)) (numberp (car props)))) ;; Old-style calling convention. (setq props `(:count ,(car props) @@ -1139,7 +1140,7 @@ Properties with special meaning: - `:enable-function' can be set to a function of no argument which returns non-nil if and only if the abbrevs in this table should be used for this instance of `expand-abbrev'." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; We used to manually add the docstring, but we also want to record this ;; location as the definition of the variable (in load-history), so we may ;; as well just use `defvar'. diff --git a/lisp/align.el b/lisp/align.el index 7ced7b70445..2fd6dcda6d7 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -553,8 +553,7 @@ The possible settings for `align-region-separate' are: (modes . align-text-modes) (repeat . t) (run-if . ,(lambda () - (and current-prefix-arg - (not (eq '- current-prefix-arg)))))) + (not (eq '- current-prefix-arg))))) ;; With a negative prefix argument, lists of dollar figures will ;; be aligned. @@ -836,11 +835,22 @@ See the variable `align-exclude-rules-list' for more details.") ;;;###autoload (defun align (beg end &optional separate rules exclude-rules) "Attempt to align a region based on a set of alignment rules. -BEG and END mark the region. If BEG and END are specifically set to -nil (this can only be done programmatically), the beginning and end of -the current alignment section will be calculated based on the location -of point, and the value of `align-region-separate' (or possibly each -rule's `separate' attribute). +Interactively, BEG and END are the mark/point of the current region. + +Many modes define specific alignment rules, and some of these +rules in some modes react to the current prefix argument. For +instance, in `text-mode', `M-x align' will align into columns +based on space delimiters, while `C-u - M-x align' will align +into columns based on the \"$\" character. See the +`align-rules-list' variable definition for the specific rules. + +Also see `align-regexp', which will guide you through various +parameters for aligning text. + +Non-interactively, if BEG and END are nil, the beginning and end +of the current alignment section will be calculated based on the +location of point, and the value of `align-region-separate' (or +possibly each rule's `separate' attribute). If SEPARATE is non-nil, it overrides the value of `align-region-separate' for all rules, except those that have their @@ -889,6 +899,15 @@ on the format of these lists." BEG and END mark the limits of the region. Interactively, this function prompts for the regular expression REGEXP to align with. +Interactively, if you specify a prefix argument, the function +will guide you through entering the full regular expression, and +then prompts for which subexpression parenthesis GROUP (default +1) within REGEXP to modify, the amount of SPACING (default +`align-default-spacing') to use, and whether or not to REPEAT the +rule throughout the line. + +See `align-rules-list' for more information about these options. + For example, let's say you had a list of phone numbers, and wanted to align them so that the opening parentheses would line up: @@ -908,15 +927,8 @@ regular expression after you enter it. Interactively, you only need to supply the characters to be lined up, and any preceding whitespace is replaced. -Non-interactively (or if you specify a prefix argument), you must -enter the full regular expression, including the subexpression. -Interactively, the function also then prompts for which -subexpression parenthesis GROUP (default 1) within REGEXP to -modify, the amount of SPACING (default `align-default-spacing') -to use, and whether or not to REPEAT the rule throughout the -line. - -See `align-rules-list' for more information about these options. +Non-interactively, you must enter the full regular expression, +including the subexpression. The non-interactive form of the previous example would look something like: (align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\") @@ -928,7 +940,7 @@ construct a rule to pass to `align-region', which does the real work." (list (region-beginning) (region-end)) (if current-prefix-arg (list (read-string "Complex align using regexp: " - "\\(\\s-*\\)" 'align-regexp-history) + "\\(\\s-*\\) " 'align-regexp-history) (string-to-number (read-string "Parenthesis group to modify (justify if negative): " "1")) diff --git a/lisp/allout.el b/lisp/allout.el index 5102ee73412..174184fc7ad 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -3079,6 +3079,8 @@ Move to buffer limit in indicated direction if headings are exhausted." (backward (if (< arg 0) (setq arg (* -1 arg)))) (step (if backward -1 1)) (progress (allout-current-bullet-pos)) + ;; Move to the next physical line. + (line-move-visual nil) prev got) (while (> arg 0) diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index b1c9cdaeca4..2e51264ec39 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -458,11 +458,18 @@ variable, and is meant to be used in `compilation-filter-hook'." ;; Working with strings (defvar-local ansi-color-context nil "Context saved between two calls to `ansi-color-apply'. -This is a list of the form (CODES FRAGMENT) or nil. CODES +This is a list of the form (FACE-VEC FRAGMENT) or nil. FACE-VEC represents the state the last call to `ansi-color-apply' ended -with, currently a list of ansi codes, and FRAGMENT is a string -starting with an escape sequence, possibly the start of a new -escape sequence.") +with, currently a list of the form: + + (BASIC-FACES FG BG) + +BASIC-FACES is a bool-vector that specifies which basic faces +from `ansi-color-basic-faces-vector' to apply. FG and BG are +ANSI color codes for the foreground and background color. + +FRAGMENT is a string starting with an escape sequence, possibly +the start of a new escape sequence.") (defun ansi-color-filter-apply (string) "Filter out all ANSI control sequences from STRING. @@ -473,17 +480,17 @@ will be used for the next call to `ansi-color-apply'. Set `ansi-color-context' to nil if you don't want this. This function can be added to `comint-preoutput-filter-functions'." - (let ((start 0) end result) + (let ((context (ansi-color--ensure-context 'ansi-color-context nil)) + (start 0) end result) ;; if context was saved and is a string, prepend it - (if (cadr ansi-color-context) - (setq string (concat (cadr ansi-color-context) string) - ansi-color-context nil)) + (setq string (concat (cadr context) string)) + (setcar (cdr context) "") ;; find the next escape sequence (while (setq end (string-match ansi-color-control-seq-regexp string start)) (push (substring string start end) result) (setq start (match-end 0))) ;; save context, add the remainder of the string to the result - (let (fragment) + (let ((fragment "")) (push (substring string start (if (string-match "\033" string start) (let ((pos (match-beginning 0))) @@ -491,25 +498,9 @@ This function can be added to `comint-preoutput-filter-functions'." pos) nil)) result) - (setq ansi-color-context (if fragment (list nil fragment)))) + (setcar (cdr context) fragment)) (apply #'concat (nreverse result)))) -(defun ansi-color--find-face (codes) - "Return the face corresponding to CODES." - ;; Sort the codes in ascending order to guarantee that "bold" comes before - ;; any of the colors. This ensures that `ansi-color-bold-is-bright' is - ;; applied correctly. - (let (faces bright (codes (sort (copy-sequence codes) #'<))) - (while codes - (when-let ((face (ansi-color-get-face-1 (pop codes) bright))) - (when (and ansi-color-bold-is-bright (eq face 'ansi-color-bold)) - (setq bright t)) - (push face faces))) - ;; Avoid some long-lived conses in the common case. - (if (cdr faces) - (nreverse faces) - (car faces)))) - (defun ansi-color-apply (string) "Translates SGR control sequences into text properties. Delete all other control sequences without processing them. @@ -524,49 +515,157 @@ This information will be used for the next call to `ansi-color-apply'. Set `ansi-color-context' to nil if you don't want this. This function can be added to `comint-preoutput-filter-functions'." - (let ((codes (car ansi-color-context)) - (start 0) end result) + (let* ((context + (ansi-color--ensure-context 'ansi-color-context nil)) + (face-vec (car context)) + (start 0) + end result) ;; If context was saved and is a string, prepend it. - (if (cadr ansi-color-context) - (setq string (concat (cadr ansi-color-context) string) - ansi-color-context nil)) + (setq string (concat (cadr context) string)) + (setcar (cdr context) "") ;; Find the next escape sequence. (while (setq end (string-match ansi-color-control-seq-regexp string start)) (let ((esc-end (match-end 0))) ;; Colorize the old block from start to end using old face. - (when codes + (when-let ((face (ansi-color--face-vec-face face-vec))) (put-text-property start end 'font-lock-face - (ansi-color--find-face codes) string)) + face string)) (push (substring string start end) result) (setq start (match-end 0)) ;; If this is a color escape sequence, (when (eq (aref string (1- esc-end)) ?m) ;; create a new face from it. - (setq codes (ansi-color-apply-sequence - (substring string end esc-end) codes))))) + (let ((cur-pos end)) + (ansi-color--update-face-vec + face-vec + (lambda () + (when (string-match ansi-color-parameter-regexp + string cur-pos) + (setq cur-pos (match-end 0)) + (when (<= cur-pos esc-end) + (string-to-number (match-string 1 string)))))))))) ;; if the rest of the string should have a face, put it there - (when codes + (when-let ((face (ansi-color--face-vec-face face-vec))) (put-text-property start (length string) - 'font-lock-face (ansi-color--find-face codes) string)) + 'font-lock-face face string)) ;; save context, add the remainder of the string to the result - (let (fragment) - (if (string-match "\033" string start) - (let ((pos (match-beginning 0))) - (setq fragment (substring string pos)) - (push (substring string start pos) result)) - (push (substring string start) result)) - (setq ansi-color-context (if (or codes fragment) (list codes fragment)))) + (if (string-match "\033" string start) + (let ((pos (match-beginning 0))) + (setcar (cdr context) (substring string pos)) + (push (substring string start pos) result)) + (push (substring string start) result)) (apply 'concat (nreverse result)))) +(defun ansi-color--ensure-context (context-sym position) + "Return CONTEXT-SYM's value as a valid context. +If it is nil, set CONTEXT-SYM's value to a new context and return +it. Context is a list of the form as described in +`ansi-color-context' if POSITION is nil, or +`ansi-color-context-region' if POSITION is non-nil. + +If CONTEXT-SYM's value is already non-nil, return it. If its +marker doesn't point anywhere yet, position it before character +number POSITION, if non-nil." + (let ((context (symbol-value context-sym))) + (if context + (if position + (let ((marker (cadr context))) + (unless (marker-position marker) + (set-marker marker position)) + context) + context) + (set context-sym + (list (list (make-bool-vector 8 nil) + nil nil) + (if position + (copy-marker position) + "")))))) + +(defun ansi-color--face-vec-face (face-vec) + "Return the face corresponding to FACE-VEC. +FACE-VEC is a list containing information about the ANSI sequence +code. It is usually stored as the car of the variable +`ansi-color-context-region'." + (let* ((basic-faces (car face-vec)) + (colors (cdr face-vec)) + (bright (and ansi-color-bold-is-bright (aref basic-faces 1))) + (faces nil)) + + (when-let ((fg (car colors))) + (push + `(:foreground + ,(or (ansi-color--code-as-hex fg) + (face-foreground + (aref (if (or bright (>= fg 8)) + ansi-color-bright-colors-vector + ansi-color-normal-colors-vector) + (mod fg 8)) + nil 'default))) + faces)) + (when-let ((bg (cadr colors))) + (push + `(:background + ,(or (ansi-color--code-as-hex bg) + (face-background + (aref (if (or bright (>= bg 8)) + ansi-color-bright-colors-vector + ansi-color-normal-colors-vector) + (mod bg 8)) + nil 'default))) + faces)) + + (let ((i 8)) + (while (> i 0) + (setq i (1- i)) + (when (aref basic-faces i) + (push (aref ansi-color-basic-faces-vector i) faces)))) + ;; Avoid some long-lived conses in the common case. + (if (cdr faces) + faces + (car faces)))) + +(defun ansi-color--code-as-hex (color) + "Convert COLOR to hexadecimal string representation. +COLOR is an ANSI color code. If it is between 16 and 255 +inclusive, it corresponds to a color from an 8-bit color cube. +If it is greater or equal than 256, it is subtracted by 256 to +directly specify a 24-bit color. + +Return a hexadecimal string, specifying the color, or nil, if +COLOR is less than 16." + (cond + ((< color 16) nil) + ((>= color 256) (format "#%06X" (- color 256))) + ((>= color 232) ;; Grayscale + (format "#%06X" (* #x010101 (+ 8 (* 10 (- color 232)))))) + (t ;; 6x6x6 color cube + (setq color (- color 16)) + (let ((res 0) + (frac (* 6 6))) + (while (<= 1 frac) ; Repeat 3 times + (setq res (* res #x000100)) + (let ((color-num (mod (/ color frac) 6))) + (unless (zerop color-num) + (setq res (+ res #x37 (* #x28 color-num))))) + (setq frac (/ frac 6))) + (format "#%06X" res))))) + ;; Working with regions (defvar-local ansi-color-context-region nil "Context saved between two calls to `ansi-color-apply-on-region'. -This is a list of the form (CODES MARKER) or nil. CODES +This is a list of the form (FACE-VEC MARKER) or nil. FACE-VEC represents the state the last call to `ansi-color-apply-on-region' -ended with, currently a list of ansi codes, and MARKER is a -buffer position within an escape sequence or the last position -processed.") +ended with, currently a list of the form: + + (BASIC-FACES FG BG). + +BASIC-FACES is a bool-vector that specifies which basic faces +from `ansi-color-basic-faces-vector' to apply. FG and BG are +ANSI color codes for the foreground and background color. + +MARKER is a buffer position within an escape sequence or the last +position processed.") (defun ansi-color-filter-region (begin end) "Filter out all ANSI control sequences from region BEGIN to END. @@ -576,8 +675,10 @@ Every call to this function will set and use the buffer-local variable used for the next call to `ansi-color-apply-on-region'. Specifically, it will override BEGIN, the start of the region. Set `ansi-color-context-region' to nil if you don't want this." - (let ((end-marker (copy-marker end)) - (start (or (cadr ansi-color-context-region) begin))) + (let* ((end-marker (copy-marker end)) + (context (ansi-color--ensure-context + 'ansi-color-context-region begin)) + (start (cadr context))) (save-excursion (goto-char start) ;; Delete escape sequences. @@ -585,8 +686,8 @@ it will override BEGIN, the start of the region. Set (delete-region (match-beginning 0) (match-end 0))) ;; save context, add the remainder of the string to the result (if (re-search-forward "\033" end-marker t) - (setq ansi-color-context-region (list nil (match-beginning 0))) - (setq ansi-color-context-region nil))))) + (set-marker start (match-beginning 0)) + (set-marker start nil))))) (defun ansi-color-apply-on-region (begin end &optional preserve-sequences) "Translates SGR control sequences into overlays or extents. @@ -608,58 +709,58 @@ this. If PRESERVE-SEQUENCES is t, the sequences are hidden instead of being deleted." - (let ((codes (car ansi-color-context-region)) - (start-marker (or (cadr ansi-color-context-region) - (copy-marker begin))) - (end-marker (copy-marker end))) + (let* ((context (ansi-color--ensure-context + 'ansi-color-context-region begin)) + (face-vec (car context)) + (start-marker (cadr context)) + (end-marker (copy-marker end))) (save-excursion (goto-char start-marker) ;; Find the next escape sequence. (while (re-search-forward ansi-color-control-seq-regexp end-marker t) ;; Extract escape sequence. - (let ((esc-seq (buffer-substring - (match-beginning 0) (point)))) - (if preserve-sequences - ;; Make the escape sequence transparent. - (overlay-put (make-overlay (match-beginning 0) (point)) - 'invisible t) - ;; Otherwise, strip. - (delete-region (match-beginning 0) (point))) - + (let ((esc-beg (match-beginning 0)) + (esc-end (point))) ;; Colorize the old block from start to end using old face. (funcall ansi-color-apply-face-function (prog1 (marker-position start-marker) ;; Store new start position. - (set-marker start-marker (point))) - (match-beginning 0) (ansi-color--find-face codes)) + (set-marker start-marker esc-end)) + esc-beg (ansi-color--face-vec-face face-vec)) ;; If this is a color sequence, - (when (eq (aref esc-seq (1- (length esc-seq))) ?m) - ;; update the list of ansi codes. - (setq codes (ansi-color-apply-sequence esc-seq codes))))) + (when (eq (char-before esc-end) ?m) + (goto-char esc-beg) + (ansi-color--update-face-vec + face-vec (lambda () + (when (re-search-forward ansi-color-parameter-regexp + esc-end t) + (string-to-number (match-string 1)))))) + + (if preserve-sequences + ;; Make the escape sequence transparent. + (overlay-put (make-overlay esc-beg esc-end) 'invisible t) + ;; Otherwise, strip. + (delete-region esc-beg esc-end)))) ;; search for the possible start of a new escape sequence (if (re-search-forward "\033" end-marker t) - (progn - ;; if the rest of the region should have a face, put it there - (funcall ansi-color-apply-face-function - start-marker (point) (ansi-color--find-face codes)) - ;; save codes and point - (setq ansi-color-context-region - (list codes (copy-marker (match-beginning 0))))) - ;; 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)) - ;; 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 (copy-marker (point))))))) - ;; Clean up our temporary markers. - (unless (eq start-marker (cadr ansi-color-context-region)) - (set-marker start-marker nil)) - (unless (eq end-marker (cadr ansi-color-context-region)) - (set-marker end-marker nil)))) + (progn + (while (re-search-forward "\033" end-marker t)) + (backward-char) + (funcall ansi-color-apply-face-function + start-marker (point) + (ansi-color--face-vec-face face-vec)) + (set-marker start-marker (point))) + (let ((faces (ansi-color--face-vec-face face-vec))) + (funcall ansi-color-apply-face-function + start-marker end-marker faces) + ;; 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. + (set-marker start-marker (when faces end-marker))))) + ;; Clean up our temporary marker. + (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. @@ -767,6 +868,7 @@ the foreground color code is replaced or added resp. deleted; if it is 40-47 (or 100-107) resp. 49, the background color code is replaced or added resp. deleted; any other code is discarded together with the old codes. Finally, the so changed list of codes is returned." + (declare (obsolete ansi-color--update-face-vec "29.1")) (let ((new-codes (ansi-color-parse-sequence escape-sequence))) (while new-codes (let* ((new (pop new-codes)) @@ -795,6 +897,72 @@ old codes. Finally, the so changed list of codes is returned." (_ nil))))) codes)) +(defun ansi-color--update-face-vec (face-vec iterator) + "Apply escape sequences to FACE-VEC. + +Destructively modify FACE-VEC, which should be a list containing +face information. It is described in +`ansi-color-context-region'. ITERATOR is a function which is +called repeatedly with zero arguments and should return either +the next ANSI code in the current sequence as a number or nil if +there are no more ANSI codes left. + +For each new code, the following happens: if it is 1-7, set the +corresponding properties; if it is 21-25 or 27, unset appropriate +properties; if it is 30-37 (or 90-97) or resp. 39, set the +foreground color or resp. unset it; if it is 40-47 (or 100-107) +resp. 49, set the background color or resp. unset it; if it is 38 +or 48, the following codes are used to set the foreground or +background color and the correct color mode; any other code will +unset all properties and colors." + (let ((basic-faces (car face-vec)) + (colors (cdr face-vec)) + new q do-clear) + (while (setq new (funcall iterator)) + (setq q (/ new 10)) + (pcase q + (0 (if (memq new '(0 8 9)) + (setq do-clear t) + (aset basic-faces new t))) + (2 (if (memq new '(20 26 28 29)) + (setq do-clear t) + ;; The standard says `21 doubly underlined' while + ;; https://en.wikipedia.org/wiki/ANSI_escape_code claims + ;; `21 Bright/Bold: off or Underline: Double'. + (aset basic-faces (- new 20) nil) + (aset basic-faces (pcase new (22 1) (25 6) (_ 0)) nil))) + ((or 3 4 9 10) + (let ((r (mod new 10)) + (cell (if (memq q '(3 9)) colors (cdr colors)))) + (pcase r + (8 + (pcase (funcall iterator) + (5 (setq new (setcar cell (funcall iterator))) + (setq do-clear (or (null new) (>= new 256)))) + (2 + (let ((red (funcall iterator)) + (green (funcall iterator)) + (blue (funcall iterator))) + (if (and red green blue + (progn + (setq new (+ (* #x010000 red) + (* #x000100 green) + (* #x000001 blue))) + (<= new #xFFFFFF))) + (setcar cell (+ 256 new)) + (setq do-clear t)))) + (_ (setq do-clear t)))) + (9 (setcar cell nil)) + (_ (setcar cell (+ (if (memq q '(3 4)) 0 8) r)))))) + (_ (setq do-clear t))) + + (when do-clear + (setq do-clear nil) + ;; Zero out our bool vector without any allocation. + (bool-vector-intersection basic-faces #&8"\0" basic-faces) + (setcar colors nil) + (setcar (cdr colors) nil))))) + (defun ansi-color-make-color-map () "Create a vector of face definitions and return it. @@ -859,6 +1027,7 @@ This function is obsolete, and no longer needed to use ansi-color." "Get face definition for ANSI-CODE. BRIGHT, if non-nil, requests \"bright\" ANSI colors, even if ANSI-CODE is a normal-intensity color." + (declare (obsolete ansi-color--face-vec-face "29.1")) (when (and bright (<= 30 ansi-code 49)) (setq ansi-code (+ ansi-code 60))) (cond ((<= 0 ansi-code 7) diff --git a/lisp/apropos.el b/lisp/apropos.el index fc15cd3e011..00919ed91b1 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -515,9 +515,9 @@ variables, not just user options." current-prefix-arg)) (apropos-command pattern nil (if (or do-all apropos-do-all) - #'(lambda (symbol) - (and (boundp symbol) - (get symbol 'variable-documentation))) + (lambda (symbol) + (and (boundp symbol) + (get symbol 'variable-documentation))) #'custom-variable-p))) ;;;###autoload diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 063d0a14d63..b448c0f8da9 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -415,6 +415,7 @@ Matches the visited file name against the elements of `auto-insert-alist'." "Associate CONDITION with (additional) ACTION in `auto-insert-alist'. Optional AFTER means to insert action after all existing actions for CONDITION, or if CONDITION had no actions, after all other CONDITIONs." + (declare (indent defun)) (let ((elt (assoc condition auto-insert-alist))) (if elt (setcdr elt diff --git a/lisp/bookmark.el b/lisp/bookmark.el index fb90f01456e..a4c28e751ca 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -498,11 +498,8 @@ If DEFAULT is nil then return empty string for empty input." 'string-lessp) (bookmark-all-names))) (let* ((completion-ignore-case bookmark-completion-ignore-case) - (default (unless (equal "" default) default)) - (prompt (concat prompt (if default - (format " (%s): " default) - ": ")))) - (completing-read prompt + (default (unless (equal "" default) default))) + (completing-read (format-prompt prompt default) (lambda (string pred action) (if (eq action 'metadata) '(metadata (category . bookmark)) @@ -2317,10 +2314,10 @@ Prompt with completion for the new path." (lambda () (setq timer (run-with-idle-timer bookmark-search-delay 'repeat - #'(lambda (buf) - (with-current-buffer buf - (bookmark-bmenu-filter-alist-by-regexp - (minibuffer-contents)))) + (lambda (buf) + (with-current-buffer buf + (bookmark-bmenu-filter-alist-by-regexp + (minibuffer-contents)))) (current-buffer)))) (read-string "Pattern: ") (when timer (cancel-timer timer) (setq timer nil))) diff --git a/lisp/button.el b/lisp/button.el index aedd07b762d..b790104e966 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -130,6 +130,7 @@ In addition, the keyword argument :supertype may be used to specify a `button-type' from which NAME inherits its default property values (however, the inheritance happens only when NAME is defined; subsequent changes to a supertype are not reflected in its subtypes)." + (declare (indent defun)) (let ((catsym (make-symbol (concat (symbol-name name) "-button"))) (super-catsym (button-category-symbol @@ -615,7 +616,9 @@ button at point is the button to describe." (button--describe props) t))) -(defun button-buttonize (string callback &optional data) +(define-obsolete-function-alias 'button-buttonize #'buttonize "29.1") + +(defun buttonize (string callback &optional data) "Make STRING into a button and return it. When clicked, CALLBACK will be called with the DATA as the function argument. If DATA isn't present (or is nil), the button diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index dd5063f27d5..8481d0b5e9d 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -111,9 +111,6 @@ C-w Describe how there is no warranty for Calc." (with-current-buffer "*Help*" (let ((inhibit-read-only t)) (goto-char (point-min)) - (when (search-forward "Major Mode Bindings:" nil t) - (delete-region (point-min) (point)) - (insert "Calc Mode Bindings:")) (when (search-forward "Global bindings:" nil t) (forward-line -1) (delete-region (point) (point-max))) diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 1c2e7bcf2bc..ba2b6b2ca9c 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -618,8 +618,9 @@ If this can't be done, return NIL." (defun math-nth-root-float (a nrf-n &optional guess) (math-inexact-result) (math-with-extra-prec 1 - (let ((math-nrf-nf (math-float nrf-n)) - (math-nrf-nfm1 (math-float (1- nrf-n)))) + (let ((math-nrf-n nrf-n) + (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)) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 3492b6d831b..b381f8afcf9 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -205,9 +205,8 @@ (progn (setq cmd-base-default (concat "User-" keyname)) (setq cmd (completing-read - (concat "Define M-x command name (default calc-" - cmd-base-default - "): ") + (format-prompt "Define M-x command name" + (concat "calc-" cmd-base-default)) obarray 'commandp nil (if (and odef (symbolp (cdr odef))) (symbol-name (cdr odef)) @@ -241,8 +240,8 @@ (setq func (concat "calcFunc-" (completing-read - (concat "Define algebraic function name (default " - cmd-base-default "): ") + (format-prompt "Define algebraic function name" + cmd-base-default) (mapcar (lambda (x) (substring x 9)) (all-completions "calcFunc-" obarray)) diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index ee29c440fe4..b3968555b62 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -586,7 +586,7 @@ (defun calc-permanent-variable (&optional var) (interactive) (calc-wrapper - (or var (setq var (calc-read-var-name "Save variable (default all): "))) + (or var (setq var (calc-read-var-name (format-prompt "Save variable" "all")))) (let (calc-pv-pos) (and var (or (and (boundp var) (symbol-value var)) (error "No such variable"))) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index fd6f3a7b67b..f6d749db117 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -486,18 +486,13 @@ If COMP or STD is non-nil, put that in the units table instead." (setq defunits (math-get-default-units expr)) (unless new-units (setq new-units - (read-string (concat + (read-string (format-prompt (if (and uoldname (not nouold)) (concat "Old units: " uoldname ", new units") "New units") - (if defunits - (concat - " (default " - defunits - "): ") - ": ")))) + defunits))) (if (and (string= new-units "") defunits) @@ -533,14 +528,7 @@ If COMP or STD is non-nil, put that in the units table instead." (let* ((old-units (math-extract-units expr)) (defunits (math-get-default-units expr)) units - (new-units - (read-string (concat "New units" - (if defunits - (concat - " (default " - defunits - "): ") - ": "))))) + (new-units (read-string (format-prompt "New units" defunits)))) (if (and (string= new-units "") defunits) @@ -596,19 +584,14 @@ If COMP or STD is non-nil, put that in the units table instead." (setq expr (math-mul expr uold))) (setq defunits (math-get-default-units expr)) (setq unew (or new-units - (completing-read - (concat - (if uoldname - (concat "Old temperature units: " - uoldname - ", new units") - "New temperature units") - (if defunits - (concat " (default " - defunits - "): ") - ": ")) - tempunits))) + (completing-read (format-prompt + (if uoldname + (concat "Old temperature units: " + uoldname + ", new units") + "New temperature units") + defunits) + tempunits))) (setq unew (math-read-expr (if (string= unew "") defunits unew))) (when (eq (car-safe unew) 'error) (error "Bad format in units expression: %s" (nth 2 unew))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 553bdc9c6ed..bd4ec4ff2f0 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -494,7 +494,7 @@ This setting only applies to floats in normal display mode.") (defmacro defcalcmodevar (var defval &optional doc) "Declare VAR as a Calc variable, with default value DEFVAL and doc-string DOC. The variable VAR will be added to `calc-mode-var-list'." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(progn (defvar ,var ,defval ,doc) (add-to-list 'calc-mode-var-list (list (quote ,var) ,defval)))) @@ -3439,7 +3439,7 @@ The prefix `calcFunc-' is added to the specified name to get the actual Lisp function name. See Info node `(calc)Defining Functions'." - (declare (doc-string 3)) ;; FIXME: Edebug spec? + (declare (doc-string 3) (indent defun)) ;; FIXME: Edebug spec? (require 'calc-ext) (math-do-defmath func args body)) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 0aa38166bc1..155c34927fd 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -406,7 +406,11 @@ entries only for the values that should be altered. For instance, if you want to \"add two months\" to TIME, then leave all other fields but the month field in DELTA nil, and make -the month field 2. The values in DELTA can be negative. +the month field 2. For instance: + + (decoded-time-add (decode-time) (make-decoded-time :month 2)) + +The values in DELTA can be negative. If applying a month/year delta leaves the time spec invalid, it is decreased to be valid (\"add one month\" to January 31st 2019 diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 18fb05e7eb4..e0717fbfe5a 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -156,7 +156,7 @@ local variables have been defined." DOCSTRING is optional and not used. To work properly, this should be put after PARENT mode local variables definition." - (declare (obsolete define-derived-mode "27.1")) + (declare (obsolete define-derived-mode "27.1") (indent 2)) `(mode-local--set-parent ',mode ',parent)) (defun mode-local-use-bindings-p (this-mode desired-mode) @@ -567,6 +567,7 @@ appropriate arguments deduced from ARGS. OVERARGS is a list of arguments passed to the override and `NAME-default' function, in place of those deduced from ARGS." (declare (doc-string 3) + (indent defun) (debug (&define name lambda-list stringp def-body))) `(eval-and-compile (defun ,name ,args @@ -595,6 +596,7 @@ DOCSTRING is the documentation string. BODY is the implementation of this function." ;; FIXME: Make this obsolete and use cl-defmethod with &context instead. (declare (doc-string 4) + (indent defun) (debug (&define name symbolp lambda-list stringp def-body))) (let ((newname (intern (format "%s-%s" name mode)))) `(progn diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 6cfbdd5f03f..375b97a7a5d 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -224,11 +224,10 @@ HISTORY is a symbol representing a variable to story the history in." ;; @todo - move from () to into the editable area (if (string-match ":" prompt) - (setq prompt (concat - (substring prompt 0 (match-beginning 0)) - " (default " default-as-string ")" - (substring prompt (match-beginning 0)))) - (setq prompt (concat prompt " (" default-as-string "): ")))) + (setq prompt (format-prompt + (substring prompt 0 (match-beginning 0)) + default-as-string)) + (setq prompt (format-prompt prompt default-as-string)))) ;; ;; Perform the Completion ;; diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 6271fb1ced6..0a234b3000d 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -391,6 +391,7 @@ etc., found in the semantic-decorate library. To add other kind of decorations on a tag, `NAME-highlight' must use `semantic-decorate-tag', and other functions of the semantic decoration API found in this library." + (declare (indent 1)) (let ((predicate (semantic-decorate-style-predicate name)) (highlighter (semantic-decorate-style-highlighter name)) (predicatedef (semantic-decorate-style-predicate-default name)) diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 0694b9c2329..cae38e6f111 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -82,6 +82,7 @@ users will customize. Creates a customizable variable users can customize that will keep semantic data structures up to date." + (declare (indent defun)) `(progn ;; Create a variable users can customize. (defcustom ,name ,value diff --git a/lisp/cedet/semantic/grm-wy-boot.el b/lisp/cedet/semantic/grm-wy-boot.el index a6bf211713a..ce63421fb37 100644 --- a/lisp/cedet/semantic/grm-wy-boot.el +++ b/lisp/cedet/semantic/grm-wy-boot.el @@ -149,10 +149,10 @@ ((type_decl)) ((use_macros_decl))) (default_prec_decl - ((DEFAULT-PREC) - `(wisent-raw-tag - (semantic-tag "default-prec" 'assoc :value - '("t"))))) + ((DEFAULT-PREC) + `(wisent-raw-tag + (semantic-tag "default-prec" 'assoc :value + '("t"))))) (no_default_prec_decl ((NO-DEFAULT-PREC) `(wisent-raw-tag diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 8073640a8bd..3297367db90 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1165,7 +1165,8 @@ of type `spp-macro-def' is to be created. VALFORM are forms that return the value to be saved for this macro, or nil. When implementing a macro, you can use `semantic-lex-spp-stream-for-macro' to convert text into a lexical stream for storage in the macro." - (declare (debug (&define name stringp stringp form def-body))) + (declare (debug (&define name stringp stringp form def-body)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) @@ -1199,7 +1200,8 @@ REGEXP is a regular expression for the analyzer to match. See `define-lex-regex-analyzer' for more on regexp. TOKIDX is an index into REGEXP for which a new lexical token of type `spp-macro-undef' is to be created." - (declare (debug (&define name stringp stringp form))) + (declare (debug (&define name stringp stringp form)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end"))) `(define-lex-regex-analyzer ,name @@ -1260,7 +1262,8 @@ type of include. The return value should be of the form: (NAME . TYPE) where NAME is the name of the include, and TYPE is the type of the include, where a valid symbol is `system', or nil." - (declare (debug (&define name stringp stringp form def-body))) + (declare (debug (&define name stringp stringp form def-body)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 69f20deeb76..d524b733db5 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -760,7 +760,7 @@ If two analyzers can match the same text, it is important to order the analyzers so that the one you want to match first occurs first. For example, it is good to put a number analyzer in front of a symbol analyzer which might mistake a number for a symbol." - (declare (debug (&define name stringp (&rest symbolp)))) + (declare (debug (&define name stringp (&rest symbolp))) (indent 1)) `(defun ,name (start end &optional depth length) ,(concat doc "\nSee `semantic-lex' for more information.") ;; Make sure the state of block parsing starts over. @@ -1096,7 +1096,7 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to after the location of the analyzed entry, and to add any discovered tokens at the beginning of `semantic-lex-token-stream'. This can be done by using `semantic-lex-push-token'." - (declare (debug (&define name stringp form def-body))) + (declare (debug (&define name stringp form def-body)) (indent 1)) `(eval-and-compile ;; This is the real info used by `define-lex' (via semantic-lex-one-token). (defconst ,name '(,condition ,@forms) ,doc) @@ -1118,7 +1118,7 @@ This can be done by using `semantic-lex-push-token'." "Create a lexical analyzer with NAME and DOC that will match REGEXP. FORMS are evaluated upon a successful match. See `define-lex-analyzer' for more about analyzers." - (declare (debug (&define name stringp form def-body))) + (declare (debug (&define name stringp form def-body)) (indent 1)) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1137,7 +1137,8 @@ FORMS are evaluated upon a successful match BEFORE the new token is created. It is valid to ignore FORMS. See `define-lex-analyzer' for more about analyzers." (declare (debug - (&define name stringp form symbolp [ &optional form ] def-body))) + (&define name stringp form symbolp [ &optional form ] def-body)) + (indent 1)) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1162,7 +1163,8 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM and CLOSE-DELIM are respectively the open and close delimiters identifying a block. OPEN-SYM and CLOSE-SYM are respectively the symbols returned in open and close tokens." - (declare (debug (&define name stringp form (&rest form)))) + (declare (debug (&define name stringp form (&rest form))) + (indent 1)) (let ((specs (cons spec1 specs)) spec open olist clist) (while specs @@ -1471,6 +1473,7 @@ syntax as specified by the syntax table." (defmacro define-lex-keyword-type-analyzer (name doc syntax) "Define a keyword type analyzer NAME with DOC string. SYNTAX is the regexp that matches a keyword syntactic expression." + (declare (indent 1)) (let ((key (make-symbol "key"))) `(define-lex-analyzer ,name ,doc @@ -1486,6 +1489,7 @@ SYNTAX is the regexp that matches a keyword syntactic expression." "Define a sexp type analyzer NAME with DOC string. SYNTAX is the regexp that matches the beginning of the s-expression. TOKEN is the lexical token returned when SYNTAX matches." + (declare (indent 1)) `(define-lex-regex-analyzer ,name ,doc ,syntax @@ -1504,6 +1508,7 @@ SYNTAX is the regexp that matches a syntactic expression. MATCHES is an alist of lexical elements used to refine the syntactic expression. DEFAULT is the default lexical token returned when no MATCHES." + (declare (indent 1)) (if matches (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) @@ -1536,6 +1541,7 @@ SYNTAX is the regexp that matches a syntactic expression. MATCHES is an alist of lexical elements used to refine the syntactic expression. DEFAULT is the default lexical token returned when no MATCHES." + (declare (indent 1)) (if matches (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) @@ -1633,6 +1639,7 @@ When the lexer encounters the open-paren delimiter \"(\": - If the maximum depth of parenthesis tracking is reached (current depth >= max depth), it returns the whole parenthesis block as a (PAREN_BLOCK start . end) token." + (declare (indent 1)) (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) (elt (make-symbol "elt"))) diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index f5f381d4079..afcdd142822 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -66,7 +66,7 @@ Returned tokens must have the form: (TOKSYM VALUE START . END) where VALUE is the buffer substring between START and END positions." - (declare (debug (&define name stringp def-body))) + (declare (debug (&define name stringp def-body)) (indent 1)) `(defun ,name () ,doc (cond diff --git a/lisp/comint.el b/lisp/comint.el index a0873c0b6a1..c114bdf758a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -889,12 +889,13 @@ series of processes in the same Comint buffer. The hook ;; and there is no way for us to define it here. ;; Some programs that use terminfo get very confused ;; if TERM is not a valid terminal type. - (if (and (boundp 'system-uses-terminfo) system-uses-terminfo) - (list (format "TERM=%s" comint-terminfo-terminal) - "TERMCAP=" - (format "COLUMNS=%d" (window-width))) - (list "TERM=emacs" - (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width))))) + (with-connection-local-variables + (if system-uses-terminfo + (list (format "TERM=%s" comint-terminfo-terminal) + "TERMCAP=" + (format "COLUMNS=%d" (window-width))) + (list "TERM=emacs" + (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width)))))) (defun comint-nonblank-p (str) "Return non-nil if STR contains non-whitespace syntax." @@ -2455,11 +2456,19 @@ This function could be in the list `comint-output-filter-functions'." (when (let ((case-fold-search t)) (string-match comint-password-prompt-regexp (string-replace "\r" "" string))) - (let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth))) - (if (> comint--prompt-recursion-depth 10) - (message "Password prompt recursion too deep") - (comint-send-invisible - (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+")))))) + ;; Use `run-at-time' in order not to pause execution of the + ;; process filter with a minibuffer + (run-at-time + 0 nil + (lambda (current-buf) + (with-current-buffer current-buf + (let ((comint--prompt-recursion-depth + (1+ comint--prompt-recursion-depth))) + (if (> comint--prompt-recursion-depth 10) + (message "Password prompt recursion too deep") + (comint-send-invisible + (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+")))))) + (current-buffer)))) ;; Low-level process communication diff --git a/lisp/composite.el b/lisp/composite.el index 99f528a0779..c2289e8998f 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -901,6 +901,4 @@ For more information on Auto Composition mode, see (provide 'composite) - - ;;; composite.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index a0bde396735..34a6db508d5 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1133,7 +1133,7 @@ for the MODE to customize." (defun customize-read-group () (let ((completion-ignore-case t)) - (completing-read "Customize group (default emacs): " + (completing-read (format-prompt "Customize group" "emacs") obarray (lambda (symbol) (or (and (get symbol 'custom-loads) @@ -1205,7 +1205,7 @@ Show the buffer in another window, but don't select it." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) -(defvar customize-changed-options-previous-release "27.2" +(defvar customize-changed-options-previous-release "28.1" "Version for `customize-changed' to refer back to by default.") ;; Packages will update this variable, so make it available. diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 6c0052bf860..5037ee77c7c 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -31,6 +31,9 @@ (defun custom-declare-face (face spec doc &rest args) "Like `defface', but with FACE evaluated as a normal argument." + (when (and doc + (not (stringp doc))) + (error "Invalid (or missing) doc string %S" doc)) (unless (get face 'face-defface-spec) (face-spec-set face (purecopy spec) 'face-defface-spec) (push (cons 'defface face) current-load-list) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 1a3e5682bba..a46107a6784 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -386,7 +386,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "When sent SIGUSR1" sigusr1) (const :tag "When sent SIGUSR2" sigusr2)) "24.1") - + (translate-upper-case-key-bindings keyboard boolean "29.1") ;; This is not good news because it will use the wrong ;; version-specific directories when you upgrade. We need ;; customization of the front of the list, maintaining the diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 07881e9b74e..f618e3341cb 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -627,22 +627,24 @@ Theme files are named *-theme.el in `")) (let ((help-echo "mouse-2: Enable this theme for this session") widget) (dolist (theme (custom-available-themes)) - (setq widget (widget-create 'checkbox - :value (custom-theme-enabled-p theme) - :theme-name theme - :help-echo help-echo - :action #'custom-theme-checkbox-toggle)) - (push (cons theme widget) custom--listed-themes) - (widget-create-child-and-convert widget 'push-button - :button-face-get 'ignore - :mouse-face-get 'ignore - :value (format " %s" theme) - :action #'widget-parent-action - :help-echo help-echo) - (widget-insert " -- " - (propertize (custom-theme-summary theme) - 'face 'shadow) - ?\n))) + ;; Don't list obsolete themes. + (unless (get theme 'byte-obsolete-info) + (setq widget (widget-create 'checkbox + :value (custom-theme-enabled-p theme) + :theme-name theme + :help-echo help-echo + :action #'custom-theme-checkbox-toggle)) + (push (cons theme widget) custom--listed-themes) + (widget-create-child-and-convert widget 'push-button + :button-face-get 'ignore + :mouse-face-get 'ignore + :value (format " %s" theme) + :action #'widget-parent-action + :help-echo help-echo) + (widget-insert " -- " + (propertize (custom-theme-summary theme) + 'face 'shadow) + ?\n)))) (goto-char (point-min)) (widget-setup)) diff --git a/lisp/custom.el b/lisp/custom.el index cc817403871..9252e80411f 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -364,7 +364,8 @@ call that function directly. See Info node `(elisp) Customization' in the Emacs Lisp manual for more information." - (declare (doc-string 3) (debug (name body))) + (declare (doc-string 3) (debug (name body)) + (indent defun)) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. @@ -447,7 +448,7 @@ In the ATTS property list, possible attributes are `:family', See Info node `(elisp) Faces' in the Emacs Lisp manual for more information." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. @@ -515,7 +516,7 @@ non-nil. See Info node `(elisp) Customization' in the Emacs Lisp manual for more information." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. @@ -1135,29 +1136,24 @@ list, in which A occurs before B if B was defined with a ;; (provide-theme 'THEME) -;; The IGNORED arguments to deftheme come from the XEmacs theme code, where -;; they were used to supply keyword-value pairs like `:immediate', -;; `:variable-reset-string', etc. We don't use any of these, so ignore them. - -(defmacro deftheme (theme &optional doc &rest _ignored) +(defmacro deftheme (theme &optional doc) "Declare THEME to be a Custom theme. The optional argument DOC is a doc string describing the theme. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." (declare (doc-string 2) - (advertised-calling-convention (theme &optional doc) "22.1")) + (indent 1)) (let ((feature (custom-make-theme-feature theme))) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) -(defun custom-declare-theme (theme feature &optional doc &rest _ignored) +(defun custom-declare-theme (theme feature &optional doc) "Like `deftheme', but THEME is evaluated as a normal argument. FEATURE is the feature this theme provides. Normally, this is a symbol created from THEME by `custom-make-theme-feature'." - (declare (advertised-calling-convention (theme feature &optional doc) "22.1")) (unless (custom-theme-name-valid-p theme) (error "Custom theme cannot be named %S" theme)) (unless (memq theme custom-known-themes) @@ -1335,6 +1331,13 @@ Return t if THEME was successfully loaded, nil otherwise." t)))) (t (error "Unable to load theme `%s'" theme)))) + (when-let ((obs (get theme 'byte-obsolete-info))) + (display-warning 'initialization + (format "The `%s' theme is obsolete%s" + theme + (if (nth 2 obs) + (format " since Emacs %s" (nth 2 obs)) + "")))) ;; Optimization: if the theme changes the `default' face, put that ;; entry first. This avoids some `frame-set-background-mode' rigmarole ;; by assigning the new background immediately. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 32375ac5253..ef299b21fd6 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -444,10 +444,10 @@ List has a form of (file-name full-file-name (attribute-list))." ((eq op-symbol 'chgrp) (file-attribute-group-id (file-attributes default-file 'string)))))) - (prompt (concat "Change " attribute-name " of %s to" - (if (eq op-symbol 'touch) - " (default now): " - ": "))) + (prompt (format-prompt "Change %s of %%s to" + (when (eq op-symbol 'touch) + "now") + attribute-name)) (new-attribute (dired-mark-read-string prompt nil op-symbol arg files default (cond ((eq op-symbol 'chown) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 7c6f49f2ae4..fc626aa76b5 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -554,7 +554,7 @@ If the region is active in Transient Mark mode, operate only on files in the active region if `dired-mark-region' is non-nil." (interactive (list (read-regexp - "Mark unmarked files matching regexp (default all): " + (format-prompt "Mark unmarked files matching regexp" "all") nil 'dired-regexp-history) nil current-prefix-arg nil)) (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) @@ -1478,12 +1478,12 @@ a prefix argument, when it offers the filename near point as a default." ;;; Internal functions -;; Fixme: This should probably use `thing-at-point'. -- fx (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." + (declare (obsolete "use (thing-at-point 'filename) instead." "29.1")) (save-excursion ;; First see if just past a filename. (or (eobp) ; why? @@ -1515,7 +1515,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-x-guess-file-name-at-point))) + (let ((guess (thing-at-point 'filename))) (read-file-name prompt (file-name-directory guess) guess diff --git a/lisp/dired.el b/lisp/dired.el index 46525891224..40dfc39b9ad 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -35,6 +35,7 @@ ;;; Code: (eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'cl-lib)) ;; When bootstrapping dired-loaddefs has not been generated. (require 'dired-loaddefs nil t) @@ -281,6 +282,11 @@ with the buffer narrowed to the listing." ;; Note this can't simply be run inside function `dired-ls' as the hook ;; functions probably depend on the dired-subdir-alist to be OK. +(defcustom dired-make-directory-clickable t + "When non-nil, make the directory at the start of the dired buffer clickable." + :version "29.1" + :type 'boolean) + (defcustom dired-initial-position-hook nil "This hook is used to position the point. It is run by the function `dired-initial-position'." @@ -1326,6 +1332,8 @@ wildcards, erases the buffer, and builds the subdir-alist anew (set-visited-file-modtime (file-attribute-modification-time attributes)))) (set-buffer-modified-p nil) + (when dired-make-directory-clickable + (dired--make-directory-clickable)) ;; No need to narrow since the whole buffer contains just ;; dired-readin's output, nothing else. The hook can ;; successfully use dired functions (e.g. dired-get-filename) @@ -1643,6 +1651,32 @@ see `dired-use-ls-dired' for more details.") 'invisible 'dired-hide-details-link)))) (forward-line 1)))) +(defun dired--make-directory-clickable () + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^ /" nil t 1) + (let ((bound (line-end-position)) + (segment-start (point)) + (inhibit-read-only t) + (dir "/")) + (while (search-forward "/" bound t 1) + (setq dir (concat dir (buffer-substring segment-start (point)))) + (add-text-properties + segment-start (1- (point)) + `( mouse-face highlight + help-echo "mouse-1: goto this directory" + keymap ,(let* ((current-dir dir) + (click (lambda () + (interactive) + (if (assoc current-dir dired-subdir-alist) + (dired-goto-subdir current-dir) + (dired current-dir))))) + (define-keymap + [mouse-2] click + [follow-link] 'mouse-face + ["RET"] click)))) + (setq segment-start (point))))))) + ;;; Reverting a dired buffer diff --git a/lisp/edmacro.el b/lisp/edmacro.el index e90b3a006ef..b3118b0aa67 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -604,6 +604,12 @@ This function assumes that the events can be stored in a string." (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) + ;; Not preloaded in without-x builds. + (require 'mwheel) + (defvar mouse-wheel-down-event) + (defvar mouse-wheel-left-event) + (defvar mouse-wheel-right-event) + (defvar mouse-wheel-up-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -634,101 +640,10 @@ This function assumes that the events can be stored in a string." ;;; Parsing a human-readable keyboard macro. (defun edmacro-parse-keys (string &optional need-vector) - (let ((case-fold-search nil) - (len (length string)) ; We won't alter string in the loop below. - (pos 0) - (res [])) - (while (and (< pos len) - (string-match "[^ \t\n\f]+" string pos)) - (let* ((word-beg (match-beginning 0)) - (word-end (match-end 0)) - (word (substring string word-beg len)) - (times 1) - key) - ;; Try to catch events of the form "<as df>". - (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) - (setq word (match-string 0 word) - pos (+ word-beg (match-end 0))) - (setq word (substring string word-beg word-end) - pos word-end)) - (when (string-match "\\([0-9]+\\)\\*." word) - (setq times (string-to-number (substring word 0 (match-end 1)))) - (setq word (substring word (1+ (match-end 1))))) - (cond ((string-match "^<<.+>>$" word) - (setq key (vconcat (if (eq (key-binding [?\M-x]) - 'execute-extended-command) - [?\M-x] - (or (car (where-is-internal - 'execute-extended-command)) - [?\M-x])) - (substring word 2 -2) "\r"))) - ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) - (progn - (setq word (concat (match-string 1 word) - (match-string 3 word))) - (not (string-match - "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" - word)))) - (setq key (list (intern word)))) - ((or (equal word "REM") (string-match "^;;" word)) - (setq pos (string-match "$" string pos))) - (t - (let ((orig-word word) (prefix 0) (bits 0)) - (while (string-match "^[ACHMsS]-." word) - (cl-incf bits (cdr (assq (aref word 0) - '((?A . ?\A-\^@) (?C . ?\C-\^@) - (?H . ?\H-\^@) (?M . ?\M-\^@) - (?s . ?\s-\^@) (?S . ?\S-\^@))))) - (cl-incf prefix 2) - (cl-callf substring word 2)) - (when (string-match "^\\^.$" word) - (cl-incf bits ?\C-\^@) - (cl-incf prefix) - (cl-callf substring word 1)) - (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") - ("LFD" . "\n") ("TAB" . "\t") - ("ESC" . "\e") ("SPC" . " ") - ("DEL" . "\177"))))) - (when found (setq word (cdr found)))) - (when (string-match "^\\\\[0-7]+$" word) - (cl-loop for ch across word - for n = 0 then (+ (* n 8) ch -48) - finally do (setq word (vector n)))) - (cond ((= bits 0) - (setq key word)) - ((and (= bits ?\M-\^@) (stringp word) - (string-match "^-?[0-9]+$" word)) - (setq key (cl-loop for x across word - collect (+ x bits)))) - ((/= (length word) 1) - (error "%s must prefix a single character, not %s" - (substring orig-word 0 prefix) word)) - ((and (/= (logand bits ?\C-\^@) 0) (stringp word) - ;; We used to accept . and ? here, - ;; but . is simply wrong, - ;; and C-? is not used (we use DEL instead). - (string-match "[@-_a-z]" word)) - (setq key (list (+ bits (- ?\C-\^@) - (logand (aref word 0) 31))))) - (t - (setq key (list (+ bits (aref word 0))))))))) - (when key - (cl-loop repeat times do (cl-callf vconcat res key))))) - (when (and (>= (length res) 4) - (eq (aref res 0) ?\C-x) - (eq (aref res 1) ?\() - (eq (aref res (- (length res) 2)) ?\C-x) - (eq (aref res (- (length res) 1)) ?\))) - (setq res (cl-subseq res 2 -2))) - (if (and (not need-vector) - (cl-loop for ch across res - always (and (characterp ch) - (let ((ch2 (logand ch (lognot ?\M-\^@)))) - (and (>= ch2 0) (<= ch2 127)))))) - (concat (cl-loop for ch across res - collect (if (= (logand ch ?\M-\^@) 0) - ch (+ ch 128)))) - res))) + (let ((result (kbd string))) + (if (and need-vector (stringp result)) + (seq-into result 'vector) + result))) (provide 'edmacro) diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index ba88c819133..f907bba4c6e 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -308,51 +308,51 @@ If point is not enclosed by any lists, return ((t) . (t))." ;; called when `scan-sexps' ran perfectly, when it found ;; a parenthesis pointing in the direction of travel. ;; Also when travel started inside a comment and exited it. - #'(lambda () - (setq outermost (list t)) - (unless innermost - (setq innermost (list t))))) + (lambda () + (setq outermost (list t)) + (unless innermost + (setq innermost (list t))))) (ended-prematurely-fn ;; called when `scan-sexps' crashed against a parenthesis ;; pointing opposite the direction of travel. After ;; traversing that character, the idea is to travel one sexp ;; in the opposite direction looking for a matching ;; delimiter. - #'(lambda () - (let* ((pos (point)) - (matched - (save-excursion - (cond ((< direction 0) - (condition-case nil - (eq (char-after pos) - (electric-pair--with-uncached-syntax - (table) - (matching-paren - (char-before - (scan-sexps (point) 1))))) - (scan-error nil))) - (t - ;; In this case, no need to use - ;; `scan-sexps', we can use some - ;; `electric-pair--syntax-ppss' in this - ;; case (which uses the quicker - ;; `syntax-ppss' in some cases) - (let* ((ppss (electric-pair--syntax-ppss - (1- (point)))) - (start (car (last (nth 9 ppss)))) - (opener (char-after start))) - (and start - (eq (char-before pos) - (or (with-syntax-table table - (matching-paren opener)) - opener)))))))) - (actual-pair (if (> direction 0) - (char-before (point)) - (char-after (point))))) - (unless innermost - (setq innermost (cons matched actual-pair))) - (unless matched - (setq outermost (cons matched actual-pair))))))) + (lambda () + (let* ((pos (point)) + (matched + (save-excursion + (cond ((< direction 0) + (condition-case nil + (eq (char-after pos) + (electric-pair--with-uncached-syntax + (table) + (matching-paren + (char-before + (scan-sexps (point) 1))))) + (scan-error nil))) + (t + ;; In this case, no need to use + ;; `scan-sexps', we can use some + ;; `electric-pair--syntax-ppss' in this + ;; case (which uses the quicker + ;; `syntax-ppss' in some cases) + (let* ((ppss (electric-pair--syntax-ppss + (1- (point)))) + (start (car (last (nth 9 ppss)))) + (opener (char-after start))) + (and start + (eq (char-before pos) + (or (with-syntax-table table + (matching-paren opener)) + opener)))))))) + (actual-pair (if (> direction 0) + (char-before (point)) + (char-after (point))))) + (unless innermost + (setq innermost (cons matched actual-pair))) + (unless matched + (setq outermost (cons matched actual-pair))))))) (save-excursion (while (not outermost) (condition-case err diff --git a/lisp/electric.el b/lisp/electric.el index 4394fae4366..a2f24ca05c6 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -506,11 +506,11 @@ This list's members correspond to left single quote, right single quote, left double quote, and right double quote, respectively." :version "26.1" :type '(list character character character character) - :safe #'(lambda (x) - (pcase x - (`(,(pred characterp) ,(pred characterp) - ,(pred characterp) ,(pred characterp)) - t))) + :safe (lambda (x) + (pcase x + (`(,(pred characterp) ,(pred characterp) + ,(pred characterp) ,(pred characterp)) + t))) :group 'electricity) (defcustom electric-quote-paragraph t diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c8990f23531..9c64083b64b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1186,6 +1186,72 @@ See Info node `(elisp) Integer Basics'." (put 'concat 'byte-optimizer #'byte-optimize-concat) +(defun byte-optimize-define-key (form) + "Expand key bindings in FORM." + (let ((key (nth 2 form))) + (if (and (vectorp key) + (= (length key) 1) + (stringp (aref key 0))) + ;; We have key on the form ["C-c C-c"]. + (if (not (kbd-valid-p (aref key 0))) + (error "Invalid `kbd' syntax: %S" key) + (list (nth 0 form) (nth 1 form) + (kbd (aref key 0)) (nth 4 form))) + ;; No improvement. + form))) + +(put 'define-key 'byte-optimizer #'byte-optimize-define-key) + +(defun byte-optimize-define-keymap (form) + "Expand key bindings in FORM." + (let ((result nil) + (orig-form form) + improved) + (push (pop form) result) + (while (and form + (keywordp (car form)) + (not (eq (car form) :menu))) + (unless (memq (car form) + '(:full :keymap :parent :suppress :name :prefix)) + (error "Invalid keyword: %s" (car form))) + (push (pop form) result) + (when (null form) + (error "Uneven number of keywords in %S" form)) + (push (pop form) result)) + ;; Bindings. + (while form + (let ((key (pop form))) + (if (and (vectorp key) + (= (length key) 1) + (stringp (aref key 0))) + (progn + (unless (kbd-valid-p (aref key 0)) + (error "Invalid `kbd' syntax: %S" key)) + (push (kbd (aref key 0)) result) + (setq improved t)) + ;; No improvement. + (push key result))) + (when (null form) + (error "Uneven number of key bindings in %S" form)) + (push (pop form) result)) + (if improved + (nreverse result) + orig-form))) + +(defun byte-optimize-define-keymap--define (form) + "Expand key bindings in FORM." + (if (not (consp (nth 1 form))) + form + (let ((optimized (byte-optimize-define-keymap (nth 1 form)))) + (if (eq optimized (nth 1 form)) + ;; No improvement. + form + (list (car form) optimized))))) + +(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap) +(put 'define-keymap--define 'byte-optimizer + #'byte-optimize-define-keymap--define) + ;; I'm not convinced that this is necessary. Doesn't the optimizer loop ;; take care of this? - Jamie ;; I think this may some times be necessary to reduce ie (quote 5) to 5, @@ -1261,7 +1327,7 @@ See Info node `(elisp) Integer Basics'." (list 'or (car (car clauses)) (byte-optimize-cond (cons (car form) (cdr (cdr form))))) - form)) + (and clauses form))) form)) (defun byte-optimize-if (form) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index da86fa5cecf..d82d9454e84 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -380,7 +380,7 @@ You don't need this. (See bytecomp.el commentary for more details.) "Define an inline function. The syntax is just like that of `defun'. \(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)" - (declare (debug defun) (doc-string 3)) + (declare (debug defun) (doc-string 3) (indent 2)) (or (memq (get name 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "`%s' is a primitive" name)) @@ -434,7 +434,7 @@ WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number. See the docstrings of `defalias' and `make-obsolete' for more details." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) `(progn (defalias ,obsolete-name ,current-name ,docstring) (make-obsolete ,obsolete-name ,current-name ,when))) @@ -483,7 +483,7 @@ 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: `saved-value', `saved-variable-comment'." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) `(progn (defvaralias ,obsolete-name ,current-name ,docstring) ;; See Bug#4706. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3f050d1b799..471a0b623ad 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -299,7 +299,7 @@ The information is logged to `byte-compile-log-buffer'." '(redefine callargs free-vars unresolved obsolete noruntime interactive-only make-local mapcar constants suspicious lexical lexical-dynamic - docstrings) + docstrings not-unused) "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). @@ -321,6 +321,7 @@ Elements of the list may be: lexically bound variable declared dynamic elsewhere make-local calls to `make-variable-buffer-local' that may be incorrect. mapcar mapcar called for effect. + not-unused warning about using variables with symbol names starting with _. constants let-binding of, or assignment to, constants/nonvariables. docstrings docstrings that are too wide (longer than `byte-compile-docstring-max-column' or diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 0a6b04b4c1f..03e109f2508 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -608,10 +608,9 @@ FORM is the parent form that binds this var." (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) ,_ ,_ ,_ ,_) ;; FIXME: Convert this warning to use `macroexp--warn-wrap' - ;; so as to give better position information and obey - ;; `byte-compile-warnings'. - (byte-compile-warn - "%s `%S' not left unused" varkind var)) + ;; so as to give better position information. + (when (byte-compile-warning-enabled-p 'not-unused var) + (byte-compile-warn "%s `%S' not left unused" varkind var))) ((and (let (or 'let* 'let) (car form)) `((,var) ;; (or `(,var nil) : Too many false positives: bug#47080 t nil ,_ ,_)) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index e03ddc4c666..7bb82c2e8bf 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -339,6 +339,7 @@ See Info node `(elisp) Documentation Tips' for background." ;; (setq checkdoc--argument-missing-flag nil) ; optional ;; (setq checkdoc--disambiguate-symbol-flag nil) ; optional ;; (setq checkdoc--interactive-docstring-flag nil) ; optional +;; (setq checkdoc-verb-check-experimental-flag nil) ;; Then use `M-x find-dired' ("-name '*.el'") and `M-x checkdoc-dired' (defvar checkdoc--argument-missing-flag t @@ -493,6 +494,9 @@ be re-created.") (defconst checkdoc--help-buffer "*Checkdoc Help*" "Name of buffer used for Checkdoc Help.") +(defvar checkdoc-commentary-header-string "\n;;; Commentary:\n;; \n\n" + "String inserted as commentary marker in `checkdoc-file-comments-engine'.") + ;;; User level commands ;; ;;;###autoload @@ -2125,13 +2129,11 @@ Examples of recognized abbreviations: \"e.g.\", \"i.e.\", \"cf.\"." ;; a part of a list. (rx letter ".") (rx (or - ;; The abbreviations: + ;; The abbreviations (a trailing dot is added below). (seq (any "cC") "f") ; cf. (seq (any "eE") ".g") ; e.g. (seq (any "iI") "." (any "eE")) ; i.e. - "a.k.a" ; a.k.a. - "etc" ; etc. - "vs" ; vs. + "a.k.a" "etc" "vs" "N.B" ;; Some non-standard or less common ones that we ;; might as well accept. "Inc" "Univ" "misc" "resp") @@ -2410,7 +2412,7 @@ Code:, and others referenced in the style guide." nil nil t))) (if (checkdoc-y-or-n-p "You should have a \";;; Commentary:\", add one?") - (insert "\n;;; Commentary:\n;; \n\n") + (insert checkdoc-commentary-header-string) (checkdoc-create-error "You should have a section marked \";;; Commentary:\"" nil nil t))) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 4834fb13c6a..2c292415cfe 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -100,6 +100,7 @@ (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-macs)) ;For cl--find-class. (eval-when-compile (require 'pcase)) +(eval-when-compile (require 'subr-x)) (cl-defstruct (cl--generic-generalizer (:constructor nil) @@ -589,19 +590,10 @@ The set of acceptable TYPEs (also called \"specializers\") is defined ;; e.g. for tracing/debug-on-entry. (defalias sym gfun))))) -(defmacro cl--generic-with-memoization (place &rest code) - (declare (indent 1) (debug t)) - (gv-letplace (getter setter) place - `(or ,getter - ,(macroexp-let2 nil val (macroexp-progn code) - `(progn - ,(funcall setter val) - ,val))))) - (defvar cl--generic-dispatchers (make-hash-table :test #'equal)) (defun cl--generic-get-dispatcher (dispatch) - (cl--generic-with-memoization + (with-memoization (gethash dispatch cl--generic-dispatchers) ;; (message "cl--generic-get-dispatcher (%S)" dispatch) (let* ((dispatch-arg (car dispatch)) @@ -644,10 +636,13 @@ The set of acceptable TYPEs (also called \"specializers\") is defined ;; overkill: better just use a `cl-typep' test. (byte-compile `(lambda (generic dispatches-left methods) + ;; FIXME: We should find a way to expand `with-memoize' once + ;; and forall so we don't need `subr-x' when we get here. + (eval-when-compile (require 'subr-x)) (let ((method-cache (make-hash-table :test #'eql))) (lambda (,@fixedargs &rest args) (let ,bindings - (apply (cl--generic-with-memoization + (apply (with-memoization (gethash ,tag-exp method-cache) (cl--generic-cache-miss generic ',dispatch-arg dispatches-left methods @@ -691,7 +686,7 @@ for all those different tags in the method-cache.") ;; Special case needed to fix a circularity during bootstrap. (cl--generic-standard-method-combination generic methods) (let ((f - (cl--generic-with-memoization + (with-memoization ;; FIXME: Since the fields of `generic' are modified, this ;; hash-table won't work right, because the hashes will change! ;; It's not terribly serious, but reduces the effectiveness of @@ -1143,7 +1138,7 @@ These match if the argument is a cons cell whose car is `eql' to VAL." ;; since we can't use the `head' specializer to implement itself. (if (not (eq (car-safe specializer) 'head)) (cl-call-next-method) - (cl--generic-with-memoization + (with-memoization (gethash (cadr specializer) cl--generic-head-used) specializer) (list cl--generic-head-generalizer))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 0592db85df4..163528acf6f 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -701,7 +701,8 @@ To specify a nil argument interactively, exit with an empty minibuffer." (interactive (list (let ((name (completing-read - "Cancel debug on entry to function (default all functions): " + (format-prompt "Cancel debug on entry to function" + "all functions") (mapcar #'symbol-name (debug--function-list)) nil t))) (when name (unless (string= name "") @@ -804,7 +805,8 @@ To specify a nil argument interactively, exit with an empty minibuffer." (interactive (list (let ((name (completing-read - "Cancel debug on set for variable (default all variables): " + (format-prompt "Cancel debug on set for variable" + "all variables") (mapcar #'symbol-name (debug--variable-list)) nil t))) (when name (unless (string= name "") diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index dd30846546b..af5eecc22a5 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -175,12 +175,7 @@ See Info node `(elisp)Derived Modes' for more details. (declare (debug (&define name symbolp sexp [&optional stringp] [&rest keywordp sexp] def-body)) (doc-string 4) - ;; Ask not what - ;;(indent 3) - ;; can do for you, ask what it can do to others. IOW, the - ;; missing of indentation setting here is the indentation - ;; setting and not an oversight. - ) + (indent defun)) (when (and docstring (not (stringp docstring))) ;; Some trickiness, since what appears to be the docstring may really be diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index f752861d80a..db86e0e0292 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -198,6 +198,7 @@ INIT-VALUE LIGHTER KEYMAP. \(fn MODE DOC [KEYWORD VAL ... &rest BODY])" (declare (doc-string 2) + (indent defun) (debug (&define name string-or-null-p [&optional [¬ keywordp] sexp &optional [¬ keywordp] sexp @@ -450,7 +451,7 @@ after running the major mode's hook. However, MODE is not turned on if the hook has explicitly disabled it. \(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" - (declare (doc-string 2)) + (declare (doc-string 2) (indent defun)) (let* ((global-mode-name (symbol-name global-mode)) (mode-name (symbol-name mode)) (pretty-name (easy-mmode-pretty-mode-name mode)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 4f3c05baa98..a38c8bd5ca9 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3519,7 +3519,8 @@ The removes the effect of `edebug-on-entry'. If FUNCTION is nil, remove `edebug-on-entry' on all functions." (interactive (list (let ((name (completing-read - "Cancel edebug on entry to (default all functions): " + (format-prompt "Cancel edebug on entry to" + "all functions") (let ((functions (edebug--edebug-on-entry-functions))) (unless functions (user-error "No functions have `edebug-on-entry'")) @@ -4548,7 +4549,8 @@ instrumentation for, defaulting to all functions." (user-error "Found no functions to remove instrumentation from")) (let ((name (completing-read - "Remove instrumentation from (default all functions): " + (format-prompt "Remove instrumentation from" + "all functions") functions))) (if (and name (not (equal name ""))) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 6d84839c341..60b0638c63f 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -70,7 +70,8 @@ is appropriate to use. Uses `defmethod' to create methods, and calls `defgeneric' for you. With this implementation the ARGS are currently ignored. You can use `defgeneric' to apply specialized top level documentation to a method." - (declare (doc-string 3) (obsolete cl-defgeneric "25.1")) + (declare (doc-string 3) (obsolete cl-defgeneric "25.1") + (indent defun)) `(eieio--defalias ',method (eieio--defgeneric-init-form ',method @@ -103,6 +104,7 @@ Summary: \"doc-string\" body)" (declare (doc-string 3) (obsolete cl-defmethod "25.1") + (indent defun) (debug (&define ; this means we are defining something [&name sexp] ;Allow (setf ...) additionally to symbols. diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 80d1711d817..7c5babcf54c 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -478,7 +478,8 @@ See `defclass' for more information." ;; (dotimes (cnt (length cslots)) ;; (setf (gethash (cl--slot-descriptor-name (aref cslots cnt)) oa) (- -1 cnt))) (dotimes (cnt (length slots)) - (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) cnt)) + (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) + (+ (eval-when-compile eieio--object-num-slots) cnt))) (setf (eieio--class-index-table newc) oa)) ;; Set up a specialized doc string. @@ -508,6 +509,7 @@ See `defclass' for more information." ;; Create the cached default object. (let ((cache (make-record newc (+ (length (eieio--class-slots newc)) + ;; FIXME: Why +1 -1 ? (eval-when-compile eieio--object-num-slots) -1) nil))) @@ -747,7 +749,7 @@ Argument FN is the function calling this verifier." (_ exp)))) (gv-setter eieio-oset)) (cl-check-type slot symbol) - (cl-check-type obj (or eieio-object class)) + (cl-check-type obj (or eieio-object class cl-structure-object)) (let* ((class (cond ((symbolp obj) (error "eieio-oref called on a class: %s" obj) (eieio--full-class-object obj)) @@ -763,7 +765,7 @@ Argument FN is the function calling this verifier." ;; to intercept missing slot definitions. Since it is also the LAST ;; thing called in this fn, its return value would be retrieved. (slot-missing obj slot 'oref)) - (cl-check-type obj eieio-object) + (cl-check-type obj (or eieio-object cl-structure-object)) (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) @@ -892,7 +894,7 @@ reverse-lookup that name, and recurse with the associated slot value." ;; Removed checks to outside this call (let* ((fsi (gethash slot (eieio--class-index-table class)))) (if (integerp fsi) - (+ (eval-when-compile eieio--object-num-slots) fsi) + fsi (let ((fn (eieio--initarg-to-attribute class slot))) (if fn ;; Accessing a slot via its :initarg is accepted by EIEIO diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 2dc3e0aeffa..3fbfe011e29 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -110,7 +110,7 @@ Options in CLOS not supported in EIEIO: Due to the way class options are set up, you can add any tags you wish, and reference them using the function `class-option'." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) (cl-check-type superclasses list) (cond ((and (stringp (car options-and-doc)) @@ -359,9 +359,7 @@ variable name of the same name as the slot." (defun eieio-pcase-slot-index-from-index-table (index-table slot) "Find the index to pass to `aref' to access SLOT." - (let ((index (gethash slot index-table))) - (if index (+ (eval-when-compile eieio--object-num-slots) - index)))) + (gethash slot index-table)) (pcase-defmacro eieio (&rest fields) "Pcase patterns that match EIEIO object EXPVAL. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index a1c3c3268f2..b30d3fc30f4 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -380,7 +380,14 @@ Also store it in `eldoc-last-message' and return that value." ;; it undesirable to print eldoc messages right this instant. (defun eldoc-display-message-no-interference-p () "Return nil if displaying a message would cause interference." - (not (or executing-kbd-macro (bound-and-true-p edebug-active)))) + (not (or executing-kbd-macro + (bound-and-true-p edebug-active) + ;; The following configuration shows "Matches..." in the + ;; echo area when point is after a closing bracket, which + ;; conflicts with eldoc. + (and show-paren-context-when-offscreen + (not (pos-visible-in-window-p + (overlay-end show-paren--overlay))))))) (defvar eldoc-documentation-functions nil diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 8c33b7c9948..fde7947a273 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -202,14 +202,13 @@ This variable is set by the master function.") (defvar elp-not-profilable ;; First, the functions used inside each instrumented function: '(called-interactively-p - ;; Then the functions used by the above functions. I used - ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) - ;; (aref (symbol-function 'elp-wrapper) 2))) - ;; to help me find this list. - error call-interactively apply current-time + ;; (delq + ;; nil (mapcar + ;; (lambda (x) (and (symbolp x) (fboundp x) x)) + ;; (aref (aref (aref (symbol-function 'elp--make-wrapper) 2) 1) 2))) + error apply current-time float-time time-subtract ;; Andreas Politz reports problems profiling these (Bug#4233): - + byte-code-function-p functionp byte-code subrp - indirect-function fboundp) + + byte-code-function-p functionp byte-code subrp fboundp) "List of functions that cannot be profiled. Those functions are used internally by the profiling code and profiling them would thus lead to infinite recursion.") diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 3fc57d5182d..a492ef5093f 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -368,17 +368,17 @@ variable `ert-resource-directory-format'. Before formatting, the file name will be trimmed using `string-trim' with arguments `ert-resource-directory-trim-left-regexp' and `ert-resource-directory-trim-right-regexp'." - `(let* ((testfile ,(or (macroexp-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))))))) + `(when-let ((testfile ,(or (macroexp-file-name) + buffer-file-name))) + (let ((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 absolute file name of resource (test data) file named FILE. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index b7d984374cb..aff38040271 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -63,6 +63,7 @@ (require 'ewoc) (require 'find-func) (require 'pp) +(require 'map) ;;; UI customization options. @@ -88,23 +89,6 @@ Use nil for no limit (caution: backtrace lines can be very long)." :background "red3")) "Face used for unexpected results in the ERT results buffer.") - -;;; Copies/reimplementations of cl functions. - -(defun ert-equal-including-properties (a b) - "Return t if A and B have similar structure and contents. - -This is like `equal-including-properties' except that it compares -the property values of text properties structurally (by -recursing) rather than with `eq'. Perhaps this is what -`equal-including-properties' should do in the first place; see -Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." - ;; This implementation is inefficient. Rather than making it - ;; efficient, let's hope bug 6581 gets fixed so that we can delete - ;; it altogether. - (not (ert--explain-equal-including-properties a b))) - - ;;; Defining and locating tests. ;; The data structure that represents a test case. @@ -218,11 +202,7 @@ it has to be wrapped in `(eval (quote ...))'. `(:expected-result-type ,expected-result)) ,@(when tags-supplied-p `(:tags ,tags)) - :body (lambda () - ;; Use the value of `lexical-binding' in - ;; the source file when evaluating the body. - (let ((lexical-binding ,lexical-binding)) - ,@body)))) + :body (lambda () ,@body))) ',name)))) (defvar ert--find-test-regexp @@ -469,7 +449,7 @@ Errors during evaluation are caught and handled like nil." (defun ert--explain-equal-rec (a b) "Return a programmer-readable explanation of why A and B are not `equal'. -Returns nil if they are." +Return nil if they are." (if (not (eq (type-of a) (type-of b))) `(different-types ,a ,b) (pcase a @@ -602,14 +582,9 @@ If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix." (t (substring s 0 len))))) -;; TODO(ohler): Once bug 6581 is fixed, rename this to -;; `ert--explain-equal-including-properties-rec' and add a fast-path -;; wrapper like `ert--explain-equal'. -(defun ert--explain-equal-including-properties (a b) - "Explainer function for `ert-equal-including-properties'. - -Returns a programmer-readable explanation of why A and B are not -`ert-equal-including-properties', or nil if they are." +(defun ert--explain-equal-including-properties-rec (a b) + "Return explanation of why A and B are not `equal-including-properties'. +Return nil if they are." (if (not (equal a b)) (ert--explain-equal a b) (cl-assert (stringp a) t) @@ -631,15 +606,17 @@ Returns a programmer-readable explanation of why A and B are not ,(ert--abbreviate-string (substring-no-properties a (1+ i)) 10 nil)))) - ;; TODO(ohler): Get `equal-including-properties' fixed in - ;; Emacs, delete `ert-equal-including-properties', and - ;; re-enable this assertion. - ;;finally (cl-assert (equal-including-properties a b) t) - ))) -(put 'ert-equal-including-properties - 'ert-explainer - 'ert--explain-equal-including-properties) + finally (cl-assert (equal-including-properties a b) t)))) +(defun ert--explain-equal-including-properties (a b) + "Explainer function for `equal-including-properties'." + ;; Do a quick comparison in C to avoid running our expensive + ;; comparison when possible. + (if (equal-including-properties a b) + nil + (ert--explain-equal-including-properties-rec a b))) +(put 'equal-including-properties 'ert-explainer + 'ert--explain-equal-including-properties) ;;; Implementation of `ert-info'. @@ -779,7 +756,8 @@ This mainly sets up debugger-related bindings." ;; handle ert errors. Once that's done, remove ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for ;; details. - (let ((debugger (lambda (&rest args) + (let ((lexical-binding t) + (debugger (lambda (&rest args) (ert--run-test-debugger test-execution-info args))) (debug-on-error t) @@ -2665,9 +2643,135 @@ To be used in the ERT results buffer." 'ert--activate-font-lock-keywords) nil) +(defun ert-test-erts-file (file &optional transform) + "Parse FILE as a file containing before/after parts. +TRANSFORM will be called to get from before to after." + (with-temp-buffer + (insert-file-contents file) + (let ((gen-specs (list (cons 'dummy t) + (cons 'code transform)))) + ;; Find the start of a test. + (while (re-search-forward "^=-=\n" nil t) + (setq gen-specs (ert-test--erts-test gen-specs file)) + ;; Search to the end of the test. + (re-search-forward "^=-=-=\n"))))) + +(defun ert-test--erts-test (gen-specs file) + (let* ((file-buffer (current-buffer)) + (specs (ert--erts-specifications (match-beginning 0))) + (name (cdr (assq 'name specs))) + (start-before (point)) + (end-after (if (re-search-forward "^=-=-=\n" nil t) + (match-beginning 0) + (point-max))) + (skip (cdr (assq 'skip specs))) + end-before start-after + after after-point) + (unless name + (error "No name for test case")) + (if (and skip + (eval (car (read-from-string skip)))) + ;; Skipping this test. + () + ;; Do the test. + (goto-char end-after) + ;; We have a separate after section. + (if (re-search-backward "^=-=\n" start-before t) + (setq end-before (match-beginning 0) + start-after (match-end 0)) + (setq end-before end-after + start-after start-before)) + ;; Update persistent specs. + (when-let ((point-char (assq 'point-char specs))) + (setq gen-specs + (map-insert gen-specs 'point-char (cdr point-char)))) + (when-let ((code (cdr (assq 'code specs)))) + (setq gen-specs + (map-insert gen-specs 'code (car (read-from-string code))))) + ;; Get the "after" strings. + (with-temp-buffer + (insert-buffer-substring file-buffer start-after end-after) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + ;; Get the expected "after" point. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (goto-char (point-min)) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)) + (setq after-point (point)))) + (setq after (buffer-string))) + ;; Do the test. + (with-temp-buffer + (insert-buffer-substring file-buffer start-before end-before) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (goto-char (point-min)) + ;; Place point in the specified place. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (let ((code (cdr (assq 'code gen-specs)))) + (unless code + (error "No code to run the transform")) + (funcall code)) + (unless (equal (buffer-string) after) + (ert-fail (list (format "Mismatch in test \"%s\", file %s" + name file) + (buffer-string) + after))) + (when (and after-point + (not (= after-point (point)))) + (ert-fail (list (format "Point wrong in test \"%s\", expected point %d, actual %d, file %s" + name + after-point (point) + file) + (buffer-string))))))) + ;; Return the new value of the general specifications. + gen-specs) + +(defun ert--erts-unquote () + (goto-char (point-min)) + (while (re-search-forward "^\\=-=\\(-=\\)$" nil t) + (delete-region (match-beginning 0) (1+ (match-beginning 0))))) + +(defun ert--erts-specifications (end) + "Find specifications before point (back to the previous test)." + (save-excursion + (goto-char end) + (goto-char + (if (re-search-backward "^=-=-=\n" nil t) + (match-end 0) + (point-min))) + (let ((specs nil)) + (while (< (point) end) + (if (looking-at "\\([^ \n\t:]+\\):\\([ \t]+\\)?\\(.*\\)") + (let ((name (intern (downcase (match-string 1)))) + (value (match-string 3))) + (forward-line 1) + (while (looking-at "[ \t]+\\(.*\\)") + (setq value (concat value (match-string 1))) + (forward-line 1)) + (push (cons name value) specs)) + (forward-line 1))) + (nreverse specs)))) + (defvar ert-unload-hook ()) (add-hook 'ert-unload-hook #'ert--unload-function) +;;; Obsolete + +(define-obsolete-function-alias 'ert-equal-including-properties + #'equal-including-properties "29.1") +(put 'ert-equal-including-properties 'ert-explainer + 'ert--explain-equal-including-properties) (provide 'ert) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index bb00a97f8e3..15afdef0252 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -29,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) (defvar font-lock-comment-face) (defvar font-lock-doc-face) @@ -590,6 +591,8 @@ containing STARTPOS." (defun lisp-string-after-doc-keyword-p (listbeg startpos) "Return non-nil if `:documentation' symbol ends at STARTPOS inside a list. +`:doc' can also be used. + LISTBEG is the position of the start of the innermost list containing STARTPOS." (and listbeg ; We are inside a Lisp form. @@ -597,7 +600,7 @@ containing STARTPOS." (goto-char startpos) (ignore-errors (progn (backward-sexp 1) - (looking-at ":documentation\\_>")))))) + (looking-at ":documentation\\_>\\|:doc\\_>")))))) (defun lisp-font-lock-syntactic-face-function (state) "Return syntactic face function for the position represented by STATE. @@ -1106,6 +1109,52 @@ is the buffer position of the start of the containing expression." (t normal-indent)))))) +(defun lisp--local-defform-body-p (state) + "Return non-nil when at local definition body according to STATE. +STATE is the `parse-partial-sexp' state for current position." + (when-let ((start-of-innermost-containing-list (nth 1 state))) + (let* ((parents (nth 9 state)) + (first-cons-after (cdr parents)) + (second-cons-after (cdr first-cons-after)) + first-order-parent second-order-parent) + (while second-cons-after + (when (= start-of-innermost-containing-list + (car second-cons-after)) + (setq second-order-parent (pop parents) + first-order-parent (pop parents) + ;; Leave the loop. + second-cons-after nil)) + (pop second-cons-after) + (pop parents)) + (when second-order-parent + (let (local-definitions-starting-point) + (and (save-excursion + (goto-char (1+ second-order-parent)) + (when-let ((head (ignore-errors + ;; FIXME: This does not distinguish + ;; between reading nil and a read error. + ;; We don't care but still, better fix this. + (read (current-buffer))))) + (when (memq head '( cl-flet cl-labels cl-macrolet cl-flet* + cl-symbol-macrolet)) + ;; In what follows, we rely on (point) returning non-nil. + (setq local-definitions-starting-point + (progn + (parse-partial-sexp + (point) first-order-parent nil + ;; From docstring of `parse-partial-sexp': + ;; Fourth arg non-nil means stop + ;; when we come to any character + ;; that starts a sexp. + t) + (point)))))) + (ignore-errors + ;; We rely on `backward-up-list' working + ;; even when sexp is incomplete “to the right”. + (backward-up-list 2) + t) + (= local-definitions-starting-point (point)))))))) + (defun lisp-indent-function (indent-point state) "This function is the normal value of the variable `lisp-indent-function'. The function `calculate-lisp-indent' calls this to determine @@ -1139,16 +1188,19 @@ Lisp function does not specify a special indentation." (if (and (elt state 2) (not (looking-at "\\sw\\|\\s_"))) ;; car of form doesn't seem to be a symbol - (progn + (if (lisp--local-defform-body-p state) + ;; We nevertheless check whether we are in flet-like form + ;; as we presume local function names could be non-symbols. + (lisp-indent-defform state indent-point) (if (not (> (save-excursion (forward-line 1) (point)) calculate-lisp-indent-last-sexp)) - (progn (goto-char calculate-lisp-indent-last-sexp) - (beginning-of-line) - (parse-partial-sexp (point) - calculate-lisp-indent-last-sexp 0 t))) - ;; Indent under the list or under the first sexp on the same - ;; line as calculate-lisp-indent-last-sexp. Note that first - ;; thing on that line has to be complete sexp since we are + (progn (goto-char calculate-lisp-indent-last-sexp) + (beginning-of-line) + (parse-partial-sexp (point) + calculate-lisp-indent-last-sexp 0 t))) + ;; Indent under the list or under the first sexp on the same + ;; line as calculate-lisp-indent-last-sexp. Note that first + ;; thing on that line has to be complete sexp since we are ;; inside the innermost containing sexp. (backward-prefix-chars) (current-column)) @@ -1159,15 +1211,14 @@ Lisp function does not specify a special indentation." 'lisp-indent-function) (get (intern-soft function) 'lisp-indent-hook))) (cond ((or (eq method 'defun) - (and (null method) - (> (length function) 3) - (string-match "\\`def" function))) + ;; Check whether we are in flet-like form. + (lisp--local-defform-body-p state)) (lisp-indent-defform state indent-point)) ((integerp method) (lisp-indent-specform method state indent-point normal-indent)) (method - (funcall method indent-point state))))))) + (funcall method indent-point state))))))) (defcustom lisp-body-indent 2 "Number of columns to indent the second line of a `(def...)' form." @@ -1235,6 +1286,13 @@ Lisp function does not specify a special indentation." (put 'autoload 'lisp-indent-function 'defun) ;Elisp (put 'progn 'lisp-indent-function 0) +(put 'defvar 'lisp-indent-function 'defun) +(put 'defalias 'lisp-indent-function 'defun) +(put 'defvaralias 'lisp-indent-function 'defun) +(put 'defconst 'lisp-indent-function 'defun) +(put 'define-category 'lisp-indent-function 'defun) +(put 'define-charset-internal 'lisp-indent-function 'defun) +(put 'define-fringe-bitmap 'lisp-indent-function 'defun) (put 'prog1 'lisp-indent-function 1) (put 'save-excursion 'lisp-indent-function 0) ;Elisp (put 'save-restriction 'lisp-indent-function 0) ;Elisp diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index 3166d33e029..450cdaa7a84 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -31,7 +31,7 @@ (require 'subr-x) (require 'cl-lib) -(defvar memory-report--type-size (make-hash-table)) +(defvar memory-report--type-size nil) ;;;###autoload (defun memory-report () @@ -84,6 +84,7 @@ by counted more than once." (gethash 'object memory-report--type-size))) (defun memory-report--set-size (elems) + (setq memory-report--type-size (make-hash-table)) (setf (gethash 'string memory-report--type-size) (cadr (assq 'strings elems))) (setf (gethash 'cons memory-report--type-size) @@ -282,7 +283,7 @@ by counted more than once." buffers) do (insert (memory-report--format size) " " - (button-buttonize + (buttonize (buffer-name buffer) #'memory-report--buffer-details buffer) "\n")) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5445fa970f8..fcbcdc79d8e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -714,6 +714,7 @@ REQUIREMENTS is a list of dependencies on other packages. where OTHER-VERSION is a string. EXTRA-PROPERTIES is currently unused." + (declare (indent defun)) ;; FIXME: Placeholder! Should we keep it? (error "Don't call me!")) @@ -2487,6 +2488,15 @@ The description is read from the installed package files." (format "%s.el" (package-desc-name desc)) srcdir)) ""))) +(defun package--describe-add-library-links () + "Add links to library names in package description." + (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t) + (if (locate-library (match-string 1)) + (make-text-button (match-beginning 1) (match-end 1) + 'xref (match-string-no-properties 1) + 'help-echo "Read this file's commentary" + :type 'package--finder-xref)))) + (defun describe-package-1 (pkg) "Insert the package description for PKG. Helper function for `describe-package'." @@ -2713,6 +2723,9 @@ Helper function for `describe-package'." t) (insert (or readme-string "This package does not provide a description."))))) + ;; Make library descriptions into links. + (goto-char start-of-description) + (package--describe-add-library-links) ;; Make URLs in the description into links. (goto-char start-of-description) (browse-url-add-buttons)))) @@ -2758,6 +2771,15 @@ function is a convenience wrapper used by `describe-package-1'." (apply #'insert-text-button button-text 'face button-face 'follow-link t properties))) +(defun package--finder-goto-xref (button) + "Jump to a Lisp file for the BUTTON at point." + (let* ((file (button-get button 'xref)) + (lib (locate-library file))) + (if lib (finder-commentary lib) + (message "Unable to locate `%s'" file)))) + +(define-button-type 'package--finder-xref 'action #'package--finder-goto-xref) + (defun package--print-email-button (recipient) "Insert a button whose action will send an email to RECIPIENT. NAME should have the form (FULLNAME . EMAIL) where FULLNAME is diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 0bf774dffd8..3f5e1a48469 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -33,22 +33,43 @@ (defcustom pp-escape-newlines t "Value of `print-escape-newlines' used by pp-* functions." + :type 'boolean) + +(defcustom pp-max-width t + "Max width to use when formatting. +If nil, there's no max width. If t, use the window width. +Otherwise this should be a number." + :type '(choice (const :tag "none" nil) + (const :tag "window width" t) + number) + :version "29.1") + +(defcustom pp-use-max-width nil + "If non-nil, `pp'-related functions will try to fold lines. +The target width is given by the `pp-max-width' variable." :type 'boolean - :group 'pp) + :version "29.1") + +(defvar pp--inhibit-function-formatting nil) ;;;###autoload (defun pp-to-string (object) "Return a string containing the pretty-printed representation of OBJECT. OBJECT can be any Lisp object. Quoting characters are used as needed to make output that `read' can handle, whenever this is possible." - (with-temp-buffer - (lisp-mode-variables nil) - (set-syntax-table emacs-lisp-mode-syntax-table) - (let ((print-escape-newlines pp-escape-newlines) - (print-quoted t)) - (prin1 object (current-buffer))) - (pp-buffer) - (buffer-string))) + (if pp-use-max-width + (let ((pp--inhibit-function-formatting t)) + (with-temp-buffer + (pp-emacs-lisp-code object) + (buffer-string))) + (with-temp-buffer + (lisp-mode-variables nil) + (set-syntax-table emacs-lisp-mode-syntax-table) + (let ((print-escape-newlines pp-escape-newlines) + (print-quoted t)) + (prin1 object (current-buffer))) + (pp-buffer) + (buffer-string)))) ;;;###autoload (defun pp-buffer () @@ -56,7 +77,6 @@ to make output that `read' can handle, whenever this is possible." (interactive) (goto-char (point-min)) (while (not (eobp)) - ;; (message "%06d" (- (point-max) (point))) (cond ((ignore-errors (down-list 1) t) (save-excursion @@ -82,11 +102,21 @@ to make output that `read' can handle, whenever this is possible." "Output the pretty-printed representation of OBJECT, any Lisp object. Quoting characters are printed as needed to make output that `read' can handle, whenever this is possible. + +This function does not apply special formatting rules for Emacs +Lisp code. See `pp-emacs-lisp-code' instead. + +By default, this function won't limit the line length of lists +and vectors. Bind `pp-use-max-width' to a non-nil value to do so. + Output stream is STREAM, or value of `standard-output' (which see)." (princ (pp-to-string object) (or stream standard-output))) -(defun pp-display-expression (expression out-buffer-name) +;;;###autoload +(defun pp-display-expression (expression out-buffer-name &optional lisp) "Prettify and display EXPRESSION in an appropriate way, depending on length. +If LISP, format with `pp-emacs-lisp-code'; use `pp' otherwise. + If a temporary buffer is needed for representation, it will be named after OUT-BUFFER-NAME." (let* ((old-show-function temp-buffer-show-function) @@ -110,11 +140,13 @@ after OUT-BUFFER-NAME." (select-window window) (run-hooks 'temp-buffer-show-hook)) (when (window-live-p old-selected) - (select-window old-selected)) - (message "See buffer %s." out-buffer-name))) + (select-window old-selected)))) (message "%s" (buffer-substring (point-min) (point)))))))) (with-output-to-temp-buffer out-buffer-name - (pp expression) + (if lisp + (with-current-buffer standard-output + (pp-emacs-lisp-code expression)) + (pp expression)) (with-current-buffer standard-output (emacs-lisp-mode) (setq buffer-read-only nil) @@ -179,6 +211,185 @@ Ignores leading comment characters." (insert (pp-to-string (macroexpand-1 (pp-last-sexp)))) (pp-macroexpand-expression (pp-last-sexp)))) +;;;###autoload +(defun pp-emacs-lisp-code (sexp) + "Insert SEXP into the current buffer, formatted as Emacs Lisp code. +Use the `pp-max-width' variable to control the desired line length." + (require 'edebug) + (let ((obuf (current-buffer))) + (with-temp-buffer + (emacs-lisp-mode) + (pp--insert-lisp sexp) + (insert "\n") + (goto-char (point-min)) + (indent-sexp) + (while (re-search-forward " +$" nil t) + (replace-match "")) + (insert-into-buffer obuf)))) + +(defun pp--insert-lisp (sexp) + (cl-case (type-of sexp) + (vector (pp--format-vector sexp)) + (cons (cond + ((consp (cdr sexp)) + (if (and (length= sexp 2) + (eq (car sexp) 'quote)) + (cond + ((symbolp (cadr sexp)) + (let ((print-quoted t)) + (prin1 sexp (current-buffer)))) + ((consp (cadr sexp)) + (insert "'") + (pp--format-list (cadr sexp) + (set-marker (make-marker) (1- (point)))))) + (pp--format-list sexp))) + (t + (princ sexp (current-buffer))))) + ;; Print some of the smaller integers as characters, perhaps? + (integer + (if (<= ?0 sexp ?z) + (let ((print-integers-as-characters t)) + (princ sexp (current-buffer))) + (princ sexp (current-buffer)))) + (string + (let ((print-escape-newlines t)) + (prin1 sexp (current-buffer)))) + (otherwise (princ sexp (current-buffer))))) + +(defun pp--format-vector (sexp) + (insert "[") + (cl-loop for i from 0 + for element across sexp + do (pp--insert (and (> i 0) " ") element)) + (insert "]")) + +(defun pp--format-list (sexp &optional start) + (if (and (symbolp (car sexp)) + (not pp--inhibit-function-formatting) + (not (keywordp (car sexp)))) + (pp--format-function sexp) + (insert "(") + (pp--insert start (pop sexp)) + (while sexp + (pp--insert " " (pop sexp))) + (insert ")"))) + +(defun pp--format-function (sexp) + (let* ((sym (car sexp)) + (edebug (get sym 'edebug-form-spec)) + (indent (get sym 'lisp-indent-function)) + (doc (get sym 'doc-string-elt))) + (when (eq indent 'defun) + (setq indent 2)) + ;; We probably want to keep all the elements before the doc string + ;; on a single line. + (when doc + (setq indent (1- doc))) + ;; Special-case closures -- these shouldn't really exist in actual + ;; source code, so there's no indentation information. But make + ;; them output slightly better. + (when (and (not indent) + (eq sym 'closure)) + (setq indent 0)) + (pp--insert "(" sym) + (pop sexp) + ;; Get the first entries on the first line. + (if indent + (pp--format-definition sexp indent edebug) + (let ((prev 0)) + (while sexp + (let ((start (point))) + ;; Don't put sexps on the same line as a multi-line sexp + ;; preceding it. + (pp--insert (if (> prev 1) "\n" " ") + (pop sexp)) + (setq prev (count-lines start (point))))))) + (insert ")"))) + +(defun pp--format-definition (sexp indent edebug) + (while (and (cl-plusp indent) + sexp) + (insert " ") + (if (and (consp (car edebug)) + (eq (caar edebug) '&rest)) + (pp--insert-binding (pop sexp)) + (if (null (car sexp)) + (insert "()") + (pp--insert-lisp (car sexp))) + (pop sexp)) + (pop edebug) + (cl-decf indent)) + (when (stringp (car sexp)) + (insert "\n") + (prin1 (pop sexp) (current-buffer))) + ;; Then insert the rest with line breaks before each form. + (while sexp + (insert "\n") + (if (keywordp (car sexp)) + (progn + (pp--insert-lisp (pop sexp)) + (when sexp + (pp--insert " " (pop sexp)))) + (pp--insert-lisp (pop sexp))))) + +(defun pp--insert-binding (sexp) + (insert "(") + (while sexp + (if (consp (car sexp)) + ;; Newlines after each (...) binding. + (progn + (pp--insert-lisp (car sexp)) + (when (cdr sexp) + (insert "\n"))) + ;; Keep plain symbols on the same line. + (pp--insert " " (car sexp))) + (pop sexp)) + (insert ")")) + +(defun pp--insert (delim &rest things) + (let ((start (if (markerp delim) + (prog1 + delim + (setq delim nil)) + (point-marker)))) + (when delim + (insert delim)) + (dolist (thing things) + (pp--insert-lisp thing)) + ;; We need to indent what we have so far to see if we have to fold. + (pp--indent-buffer) + (when (> (current-column) (pp--max-width)) + (save-excursion + (goto-char start) + (unless (looking-at "[ \t]+$") + (insert "\n")) + (pp--indent-buffer) + (goto-char (point-max)) + ;; If we're still too wide, then go up one step and try to + ;; insert a newline there. + (when (> (current-column) (pp--max-width)) + (condition-case () + (backward-up-list 1) + (:success (when (looking-back " " 2) + (insert "\n"))) + (error nil))))))) + +(defun pp--max-width () + (cond ((numberp pp-max-width) + pp-max-width) + ((null pp-max-width) + most-positive-fixnum) + ((eq pp-max-width t) + (window-width)) + (t + (error "Invalid pp-max-width value: %s" pp-max-width)))) + +(defun pp--indent-buffer () + (goto-char (point-min)) + (while (not (eobp)) + (lisp-indent-line) + (forward-line 1))) + (provide 'pp) ; so (require 'pp) works ;;; pp.el ends here diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 17ac3e471c0..c3d6c742940 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -71,6 +71,7 @@ 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." + (declare (indent defun)) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) @@ -158,6 +159,8 @@ There can be any number of :example/:result elements." :eval (split-string-and-unquote "foo \"bar zot\"")) (split-string-shell-command :eval (split-string-shell-command "ls /tmp/'foo bar'")) + (string-glyph-split + :eval (string-glyph-split "Hello, 👼🏻🧑🏼🤝🧑🏻")) (string-lines :eval (string-lines "foo\n\nbar") :eval (string-lines "foo\n\nbar" t)) @@ -241,7 +244,14 @@ There can be any number of :example/:result elements." :eval (number-to-string 42)) "Data About Strings" (length - :eval (length "foo")) + :eval (length "foo") + :eval (length "avocado: 🥑")) + (string-width + :eval (string-width "foo") + :eval (string-width "avocado: 🥑")) + (string-pixel-width + :eval (string-pixel-width "foo") + :eval (string-pixel-width "avocado: 🥑")) (string-search :eval (string-search "bar" "foobarzot")) (assoc-string @@ -348,6 +358,9 @@ There can be any number of :example/:result elements." (file-newer-than-file-p :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") :eg-result nil) + (file-has-changed-p + :no-eval (file-has-changed-p "/tmp/foo") + :eg-result t) (file-equal-p :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") :eg-result nil) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 788cd0f34bf..e3caf88c2f5 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -208,7 +208,9 @@ The variable list SPEC is the same as in `if-let'." (string= string "")) (defsubst string-join (strings &optional separator) - "Join all STRINGS using SEPARATOR." + "Join all STRINGS using SEPARATOR. +Optional argument SEPARATOR must be a string, a vector, or a list of +characters; nil stands for the empty string." (mapconcat #'identity strings separator)) (define-obsolete-function-alias 'string-reverse 'reverse "25.1") @@ -400,6 +402,68 @@ as the new values of the bound variables in the recursive invocation." (cl-labels ((,name ,fargs . ,body)) #',name) . ,aargs))) +(defmacro with-memoization (place &rest code) + "Return the value of CODE and stash it in PLACE. +If PLACE's value is non-nil, then don't bother evaluating CODE +and return the value found in PLACE instead." + (declare (indent 1) (debug (gv-place body))) + (gv-letplace (getter setter) place + `(or ,getter + ,(macroexp-let2 nil val (macroexp-progn code) + `(progn + ,(funcall setter val) + ,val))))) + +;;;###autoload +(defun ensure-empty-lines (&optional lines) + "Ensure that there's LINES number of empty lines before point. +If LINES is nil or missing, a this ensures that there's a single +empty line before point. + +Interactively, this command uses the numerical prefix for LINES. + +If there's already more empty lines before point than LINES, the +number of blank lines will be reduced. + +If point is not at the beginning of a line, a newline character +is inserted before adjusting the number of empty lines." + (interactive "p") + (unless (bolp) + (insert "\n")) + (let ((lines (or lines 1)) + (start (save-excursion + (if (re-search-backward "[^\n]" nil t) + (+ (point) 2) + (point-min))))) + (cond + ((> (- (point) start) lines) + (delete-region (point) (- (point) (- (point) start lines)))) + ((< (- (point) start) lines) + (insert (make-string (- lines (- (point) start)) ?\n)))))) + +;;;###autoload +(defun string-pixel-width (string) + "Return the width of STRING in pixels." + (with-temp-buffer + (insert string) + (car (window-text-pixel-size + (current-buffer) (point-min) (point))))) + +;;;###autoload +(defun string-glyph-split (string) + "Split STRING into a list of strings representing separate glyphs. +This takes into account combining characters and grapheme clusters." + (let ((result nil) + (start 0) + comp) + (while (< start (length string)) + (if (setq comp (find-composition-internal start nil string nil)) + (progn + (push (substring string (car comp) (cadr comp)) result) + (setq start (cadr comp))) + (push (substring string start (1+ start)) result) + (setq start (1+ start)))) + (nreverse result))) (provide 'subr-x) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 0ae355e5917..8f6c655dbef 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -115,16 +115,25 @@ where: This should be either a function, or a list. If a list, each element has the form (ID [DESC1 ... DESCN]), where: + - ID is nil, or a Lisp object uniquely identifying this entry, which is used to keep the cursor on the \"same\" entry when rearranging the list. Comparison is done with `equal'. - Each DESC is a column descriptor, one for each column - specified in `tabulated-list-format'. A descriptor is either - a string, which is printed as-is, or a list (LABEL . PROPS), - which means to use `insert-text-button' to insert a text - button with label LABEL and button properties PROPS. - The string, or button label, must not contain any newline. + specified in `tabulated-list-format'. The descriptor DESC is + one of: + + - A string, which is printed as-is, and must not contain any + newlines. + + - An image descriptor (a list), which is used to insert an + image (see Info node `(elisp) Image Descriptors'). + + - A list (LABEL . PROPS), which means to use + `insert-text-button' to insert a text button with label + LABEL and button properties PROPS. LABEL must not contain + any newlines. If `tabulated-list-entries' is a function, it is called with no arguments and must return a list of the above form.") @@ -547,7 +556,9 @@ Return the column number after insertion." (props (nthcdr 3 format)) (pad-right (or (plist-get props :pad-right) 1)) (right-align (plist-get props :right-align)) - (label (if (stringp col-desc) col-desc (car col-desc))) + (label (cond ((stringp col-desc) col-desc) + ((eq (car col-desc) 'image) " ") + (t (car col-desc)))) (label-width (string-width label)) (help-echo (concat (car format) ": " label)) (opoint (point)) @@ -571,11 +582,15 @@ Return the column number after insertion." 'display `(space :align-to ,(+ x shift)))) (setq width (- width shift)) (setq x (+ x shift)))) - (if (stringp col-desc) - (insert (if (get-text-property 0 'help-echo label) - label - (propertize label 'help-echo help-echo))) - (apply 'insert-text-button label (cdr col-desc))) + (cond ((stringp col-desc) + (insert (if (get-text-property 0 'help-echo label) + label + (propertize label 'help-echo help-echo)))) + ((eq (car col-desc) 'image) + (insert (propertize " " + 'display col-desc + 'help-echo help-echo))) + ((apply 'insert-text-button label (cdr col-desc)))) (let ((next-x (+ x pad-right width))) ;; No need to append any spaces if this is the last column. (when not-last-col diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 3976c1ea063..befcb423823 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -396,17 +396,17 @@ and after the region marked by the rectangle to search." (defcustom cua-rectangle-mark-key [(control return)] "Global key used to toggle the cua rectangle mark." - :set #'(lambda (symbol value) - (set symbol value) - (when (and (boundp 'cua--keymaps-initialized) - cua--keymaps-initialized) - (define-key cua-global-keymap value - #'cua-set-rectangle-mark) - (when (boundp 'cua--rectangle-keymap) - (define-key cua--rectangle-keymap value - #'cua-clear-rectangle-mark) - (define-key cua--region-keymap value - #'cua-toggle-rectangle-mark)))) + :set (lambda (symbol value) + (set symbol value) + (when (and (boundp 'cua--keymaps-initialized) + cua--keymaps-initialized) + (define-key cua-global-keymap value + #'cua-set-rectangle-mark) + (when (boundp 'cua--rectangle-keymap) + (define-key cua--rectangle-keymap value + #'cua-clear-rectangle-mark) + (define-key cua--region-keymap value + #'cua-toggle-rectangle-mark)))) :type 'key-sequence) (defcustom cua-rectangle-modifier-key 'meta @@ -699,6 +699,11 @@ Repeating prefix key when region is active works as a single prefix key." (interactive) (cua--prefix-override-replay 0)) +;; These aliases are so that we can look up the commands and find the +;; correct keys when generating menus. +(defalias 'cua-cut-handler #'cua--prefix-override-handler) +(defalias 'cua-copy-handler #'cua--prefix-override-handler) + (defun cua--prefix-repeat-handler () "Repeating prefix key when region is active works as a single prefix key." (interactive) @@ -1258,10 +1263,8 @@ If ARG is the atom `-', scroll upward by nearly full screen." (define-key cua--cua-keys-keymap [(meta v)] #'delete-selection-repeat-replace-region)) - (define-key cua--prefix-override-keymap [(control x)] - #'cua--prefix-override-handler) - (define-key cua--prefix-override-keymap [(control c)] - #'cua--prefix-override-handler) + (define-key cua--prefix-override-keymap [(control x)] #'cua-cut-handler) + (define-key cua--prefix-override-keymap [(control c)] #'cua-copy-handler) (define-key cua--prefix-repeat-keymap [(control x) (control x)] #'cua--prefix-repeat-handler) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 9f3d515bc6d..59be3f48462 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -35,9 +35,7 @@ (defvar viper--key-maps) (defvar viper--intercept-key-maps) (defvar iso-accents-mode) -(defvar quail-mode) (defvar quail-current-str) -(defvar mark-even-if-inactive) (defvar viper--init-message) (defvar viper-initial) (defvar undo-beg-posn) @@ -69,8 +67,7 @@ (nm-p (intern (concat snm "-p"))) (nms (intern (concat snm "s")))) `(defun ,nm-p (com) - (consp (viper-memq-char com ,nms) - )))) + (consp (memq com ,nms))))) ;; Variables for defining VI commands @@ -1035,23 +1032,23 @@ as a Meta key and any number of multiple escapes are allowed." cmd-info cmd-to-exec-at-end) (while (and cont - (viper-memq-char char - (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\" - viper-buffer-search-char))) + (memq char + (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\" + viper-buffer-search-char))) (if com ;; this means that we already have a command character, so we ;; construct a com list and exit while. however, if char is " ;; it is an error. (progn ;; new com is (CHAR . OLDCOM) - (if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell)) + (if (memq char '(?# ?\")) (user-error viper-ViperBell)) (setq com (cons char com)) (setq cont nil)) ;; If com is nil we set com as char, and read more. Again, if char is ;; ", we read the name of register and store it in viper-use-register. ;; if char is !, =, or #, a complete com is formed so we exit the while ;; loop. - (cond ((viper-memq-char char '(?! ?=)) + (cond ((memq char '(?! ?=)) (setq com char) (setq char (read-char)) (setq cont nil)) @@ -1091,7 +1088,7 @@ as a Meta key and any number of multiple escapes are allowed." `(key-binding (char-to-string ,char))))) ;; as com is non-nil, this means that we have a command to execute - (if (viper-memq-char (car com) '(?r ?R)) + (if (memq (car com) '(?r ?R)) ;; execute appropriate region command. (let ((char (car com)) (com (cdr com))) (setq prefix-arg (cons value com)) @@ -2603,12 +2600,12 @@ On reaching beginning of line, stop and signal error." (let ((prev-char (viper-char-at-pos 'backward)) (saved-point (point))) ;; skip non-newline separators backward - (while (and (not (viper-memq-char prev-char '(nil \n))) + (while (and (not (memq prev-char '(nil \n))) (< lim (point)) ;; must be non-newline separator (if (eq viper-syntax-preference 'strict-vi) - (viper-memq-char prev-char '(?\ ?\t)) - (viper-memq-char (char-syntax prev-char) '(?\ ?-)))) + (memq prev-char '(?\ ?\t)) + (memq (char-syntax prev-char) '(?\ ?-)))) (viper-backward-char-carefully) (setq prev-char (viper-char-at-pos 'backward))) @@ -2622,12 +2619,12 @@ On reaching beginning of line, stop and signal error." ;; skip again, but make sure we don't overshoot the limit (if twice - (while (and (not (viper-memq-char prev-char '(nil \n))) + (while (and (not (memq prev-char '(nil \n))) (< lim (point)) ;; must be non-newline separator (if (eq viper-syntax-preference 'strict-vi) - (viper-memq-char prev-char '(?\ ?\t)) - (viper-memq-char (char-syntax prev-char) '(?\ ?-)))) + (memq prev-char '(?\ ?\t)) + (memq (char-syntax prev-char) '(?\ ?-)))) (viper-backward-char-carefully) (setq prev-char (viper-char-at-pos 'backward)))) @@ -2645,10 +2642,10 @@ On reaching beginning of line, stop and signal error." (viper-forward-word-kernel val) (if com (progn - (cond ((viper-char-equal com ?c) + (cond ((eq com ?c) (viper-separator-skipback-special 'twice viper-com-point)) ;; Yank words including the whitespace, but not newline - ((viper-char-equal com ?y) + ((eq com ?y) (viper-separator-skipback-special nil viper-com-point)) ((viper-dotable-command-p com) (viper-separator-skipback-special nil viper-com-point))) @@ -2666,10 +2663,10 @@ On reaching beginning of line, stop and signal error." (viper-skip-nonseparators 'forward) (viper-skip-separators t)) (if com (progn - (cond ((viper-char-equal com ?c) + (cond ((eq com ?c) (viper-separator-skipback-special 'twice viper-com-point)) ;; Yank words including the whitespace, but not newline - ((viper-char-equal com ?y) + ((eq com ?y) (viper-separator-skipback-special nil viper-com-point)) ((viper-dotable-command-p com) (viper-separator-skipback-special nil viper-com-point))) @@ -4714,15 +4711,15 @@ Please, specify your level now: ")) (defun viper-submit-report () "Submit bug report on Viper." (interactive) - (defvar viper-color-display-p) + (defvar x-display-color-p) (defvar viper-frame-parameters) (defvar viper-minibuffer-emacs-face) (defvar viper-minibuffer-vi-face) (defvar viper-minibuffer-insert-face) (let ((reporter-prompt-for-summary-p t) - (viper-color-display-p (if (viper-window-display-p) - (viper-color-display-p) - 'non-x)) + (x-display-color-p (if (viper-window-display-p) + (x-display-color-p) + 'non-x)) (viper-frame-parameters (frame-parameters (selected-frame))) (viper-minibuffer-emacs-face (if (viper-has-face-support-p) (facep @@ -4780,7 +4777,7 @@ Please, specify your level now: ")) 'viper-expert-level 'major-mode 'window-system - 'viper-color-display-p + 'x-display-color-p 'viper-frame-parameters 'viper-minibuffer-vi-face 'viper-minibuffer-insert-face diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index ef15779e1bf..85c8b87b9a1 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -25,7 +25,6 @@ ;;; Code: ;; Compiler pacifier -(defvar read-file-name-map) (defvar viper-use-register) (defvar viper-s-string) (defvar viper-shift-width) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index fe3704841ac..e3790b74534 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -25,16 +25,12 @@ ;;; Code: ;; compiler pacifier -(defvar mark-even-if-inactive) -(defvar quail-mode) (defvar iso-accents-mode) (defvar viper-current-state) (defvar viper-version) (defvar viper-expert-level) (defvar current-input-method) (defvar default-input-method) -(defvar describe-current-input-method-function) -(defvar bar-cursor) (defvar cursor-type) ;; end pacifier @@ -48,11 +44,6 @@ (define-obsolete-function-alias 'viper-device-type #'window-system "27.1") -(defun viper-color-display-p () - (condition-case nil - (display-color-p) - (error nil))) - ;; in XEmacs: device-type is tty on tty and stream in batch. (defun viper-window-display-p () (and window-system (not (memq window-system '(tty stream pc))))) @@ -81,7 +72,7 @@ In all likelihood, you don't need to bother with this setting." (defun viper-has-face-support-p () (cond ((viper-window-display-p)) (viper-force-faces) - ((viper-color-display-p)) + ((x-display-color-p)) (t (memq window-system '(pc))))) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 02db39f1cb0..3d55690bd6f 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -26,7 +26,6 @@ ;; compiler pacifier (defvar double-click-time) -(defvar mouse-track-multi-click-time) (defvar viper-search-start-marker) (defvar viper-local-search-start-marker) (defvar viper-search-history) @@ -76,8 +75,8 @@ or a triple-click." ;; remembers prefix argument to pass along to commands invoked by second ;; click. -;; This is needed because in Emacs (not XEmacs), assigning to prefix-arg -;; causes Emacs to count the second click as if it was a single click +;; This is needed because assigning to prefix-arg causes Emacs to +;; count the second click as if it was a single click (defvar viper-global-prefix-argument nil) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 0f6dceb13cf..71043b189db 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -29,9 +29,6 @@ ;; Compiler pacifier (defvar viper-minibuffer-current-face) -(defvar viper-minibuffer-insert-face) -(defvar viper-minibuffer-vi-face) -(defvar viper-minibuffer-emacs-face) (defvar viper-replace-overlay-face) (defvar viper-fast-keyseq-timeout) (defvar ex-unix-type-shell) @@ -64,22 +61,8 @@ (define-obsolete-function-alias 'viper-iconify #'iconify-or-deiconify-frame "27.1") - -;; CHAR is supposed to be a char or an integer (positive or negative) -;; LIST is a list of chars, nil, and negative numbers -;; Check if CHAR is a member by trying to convert in characters, if necessary. -;; Introduced for compatibility with XEmacs, where integers are not the same as -;; chars. -(defun viper-memq-char (char list) - (cond ((and (integerp char) (>= char 0)) - (memq char list)) - ((memq char list)))) - -;; Check if char-or-int and char are the same as characters -(defun viper-char-equal (char-or-int char) - (cond ((and (integerp char-or-int) (>= char-or-int 0)) - (= char-or-int char)) - ((eq char-or-int char)))) +(define-obsolete-function-alias 'viper-memq-char #'memq "29.1") +(define-obsolete-function-alias 'viper-char-equal #'eq "29.1") ;; Like =, but accommodates null and also is t for eq-objects (defun viper= (char char1) @@ -88,8 +71,7 @@ (= char char1)) (t nil))) -(defsubst viper-color-display-p () - (x-display-color-p)) +(define-obsolete-function-alias 'viper-color-display-p #'x-display-color-p "29.1") (defun viper-get-cursor-color (&optional _frame) (cdr (assoc 'cursor-color (frame-parameters)))) @@ -110,7 +92,7 @@ Otherwise return the normal value." ;; cursor colors (defun viper-change-cursor-color (new-color &optional frame) - (if (and (viper-window-display-p) (viper-color-display-p) + (if (and (viper-window-display-p) (x-display-color-p) (stringp new-color) (x-color-defined-p new-color) (not (string= new-color (viper-get-cursor-color)))) (modify-frame-parameters @@ -142,7 +124,7 @@ Otherwise return the normal value." ;; By default, saves current frame cursor color before changing viper state (defun viper-save-cursor-color (before-which-mode) - (if (and (viper-window-display-p) (viper-color-display-p)) + (if (and (viper-window-display-p) (x-display-color-p)) (let ((color (viper-get-cursor-color))) (if (and (stringp color) (x-color-defined-p color) ;; there is something fishy in that the color is not saved if @@ -1183,25 +1165,23 @@ This option is appropriate if you like Emacs-style words." (looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]")) (or ;; or one of the additional chars being asked to include - (viper-memq-char char (viper-string-to-list addl-chars)) + (memq char (viper-string-to-list addl-chars)) (and ;; not one of the excluded word chars (note: ;; viper-non-word-characters is a list) - (not (viper-memq-char char viper-non-word-characters)) + (not (memq char viper-non-word-characters)) ;; char of the Viper-word syntax class - (viper-memq-char (char-syntax char) - (viper-string-to-list viper-ALPHA-char-class)))))) - )) + (memq (char-syntax char) + (viper-string-to-list viper-ALPHA-char-class)))))))) (defun viper-looking-at-separator () (let ((char (char-after (point)))) (if char (if (eq viper-syntax-preference 'strict-vi) - (viper-memq-char char (viper-string-to-list viper-strict-SEP-chars)) + (memq char (viper-string-to-list viper-strict-SEP-chars)) (or (eq char ?\n) ; RET is always a separator in Vi - (viper-memq-char (char-syntax char) - (viper-string-to-list viper-SEP-char-class))))) - )) + (memq (char-syntax char) + (viper-string-to-list viper-SEP-char-class))))))) (defsubst viper-looking-at-alphasep (&optional addl-chars) (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars))) @@ -1327,8 +1307,7 @@ This option is appropriate if you like Emacs-style words." ;; of the excluded characters (if (and (eq syntax-of-char-looked-at ?w) (not negated-syntax)) - (not (viper-memq-char - char-looked-at viper-non-word-characters)) + (not (memq char-looked-at viper-non-word-characters)) t)) (funcall skip-syntax-func 1) 0) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index e9c0fb5e24b..1ee53651264 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -304,7 +304,6 @@ ;; compiler pacifier (defvar mark-even-if-inactive) -(defvar quail-mode) (defvar viper-expert-level) (defvar viper-mode-string) (defvar viper-major-mode-modifier-list) diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index aa196851d4d..5b250af6d70 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -56,15 +56,15 @@ through Custom does that automatically." May either be a string or a list of strings.") (put 'epa-file-encrypt-to 'safe-local-variable - #'(lambda (val) - (or (stringp val) - (and (listp val) - (catch 'safe - (mapc (lambda (elt) - (unless (stringp elt) - (throw 'safe nil))) - val) - t))))) + (lambda (val) + (or (stringp val) + (and (listp val) + (catch 'safe + (mapc (lambda (elt) + (unless (stringp elt) + (throw 'safe nil))) + val) + t))))) (put 'epa-file-encrypt-to 'permanent-local t) diff --git a/lisp/epa.el b/lisp/epa.el index 57d355cb3e0..e4b89e984d2 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -648,7 +648,7 @@ If SECRET is non-nil, list secret keys instead of public keys." (setq input (file-name-sans-extension (expand-file-name input))) (expand-file-name (read-file-name - (concat "To file (default " (file-name-nondirectory input) ") ") + (format-prompt "To file" (file-name-nondirectory input)) (file-name-directory input) input))) @@ -1236,9 +1236,7 @@ If no one is selected, symmetric encryption will be performed. ") (list keys (expand-file-name (read-file-name - (concat "To file (default " - (file-name-nondirectory default-name) - ") ") + (format-prompt "To file" (file-name-nondirectory default-name)) (file-name-directory default-name) default-name))))) (let ((context (epg-make-context epa-protocol))) diff --git a/lisp/epg.el b/lisp/epg.el index ea7aa869a0f..3354eb2c1ed 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -334,6 +334,7 @@ callback data (if any)." (cl-defstruct (epg-key (:constructor nil) + (:copier epg--copy-key) (:constructor epg-make-key (owner-trust)) (:predicate nil)) (owner-trust nil :read-only t) @@ -1389,7 +1390,7 @@ NAME is either a string or a list of strings." (if (seq-find (lambda (user) (eq (epg-user-id-validity user) 'revoked)) (epg-key-user-id-list key)) - (let ((copy (copy-epg-key key))) + (let ((copy (epg--copy-key key))) (setf (epg-key-user-id-list copy) (seq-remove (lambda (user) (eq (epg-user-id-validity user) 'revoked)) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 140755fab51..6e5a768b70f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -197,8 +197,7 @@ active, use the `erc-server-process-alive' function instead.") "Non-nil if the user requests a quit.") (defvar-local erc-server-reconnecting nil - "Non-nil if the user requests an explicit reconnect, and the -current IRC process is still alive.") + "Non-nil if reconnecting or scheduled to.") (defvar-local erc-server-timed-out nil "Non-nil if the IRC server failed to respond to a ping.") @@ -616,36 +615,34 @@ Make sure you are in an ERC buffer when running this." (erc-log-irc-protocol line nil) (erc-parse-server-response process line))))))) -(define-inline erc-server-reconnect-p (event) +(defun erc--server-reconnect-p (event) "Return non-nil if ERC should attempt to reconnect automatically. EVENT is the message received from the closed connection process." - (inline-letevals (event) - (inline-quote - (or erc-server-reconnecting - (and erc-server-auto-reconnect - (not erc-server-banned) - ;; make sure we don't infinitely try to reconnect, unless the - ;; user wants that - (or (eq erc-server-reconnect-attempts t) - (and (integerp erc-server-reconnect-attempts) - (< erc-server-reconnect-count - erc-server-reconnect-attempts))) - (or erc-server-timed-out - (not (string-match "^deleted" ,event))) - ;; open-network-stream-nowait error for connection refused - (if (string-match "^failed with code 111" ,event) 'nonblocking t)))))) + (and erc-server-auto-reconnect + (not erc-server-banned) + ;; make sure we don't infinitely try to reconnect, unless the + ;; user wants that + (or (eq erc-server-reconnect-attempts t) + (and (integerp erc-server-reconnect-attempts) + (< erc-server-reconnect-count + erc-server-reconnect-attempts))) + (or erc-server-timed-out + (not (string-match "^deleted" event))) + ;; open-network-stream-nowait error for connection refused + (if (string-match "^failed with code 111" event) 'nonblocking t))) (defun erc-process-sentinel-2 (event buffer) "Called when `erc-process-sentinel-1' has detected an unexpected disconnect." (if (not (buffer-live-p buffer)) (erc-update-mode-line) (with-current-buffer buffer - (let ((reconnect-p (erc-server-reconnect-p event)) message delay) + (let ((reconnect-p (erc--server-reconnect-p event)) message delay) (setq message (if reconnect-p 'disconnected 'disconnected-noreconnect)) (erc-display-message nil 'error (current-buffer) message) (if (not reconnect-p) ;; terminate, do not reconnect (progn + (setq erc-server-reconnecting nil) (erc-display-message nil 'error (current-buffer) 'terminated ?e event) ;; Update mode line indicators @@ -654,7 +651,7 @@ EVENT is the message received from the closed connection process." ;; reconnect (condition-case nil (progn - (setq erc-server-reconnecting nil + (setq erc-server-reconnecting t erc-server-reconnect-count (1+ erc-server-reconnect-count)) (setq delay erc-server-reconnect-timeout) (run-at-time delay nil @@ -1169,7 +1166,8 @@ Would expand to: \(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)" (declare (debug (&define [&name "erc-response-handler@" (symbolp &rest symbolp)] - &optional sexp sexp def-body))) + &optional sexp sexp def-body)) + (indent defun)) (if (numberp name) (setq name (intern (format "%03i" name)))) (setq aliases (mapcar (lambda (a) (if (numberp a) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 6b1da2f9054..9bbc1f6a0d1 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -27,8 +27,6 @@ ;;; Code: -(require 'format-spec) - ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode #'define-minor-mode "28.1") diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index db278a1275c..f27425ac8a1 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1,7 +1,6 @@ ;;; erc-dcc.el --- CTCP DCC module for ERC -*- lexical-binding: t; -*- -;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2021 Free Software -;; Foundation, Inc. +;; Copyright (C) 1993-2021 Free Software Foundation, Inc. ;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu> ;; Noah Friedman <friedman@prep.ai.mit.edu> @@ -183,9 +182,7 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive." (let ((prop (car prem)) (val (cadr prem))) (setq prem (cddr prem) - ;; plist-member is a predicate in xemacs - test (and (plist-member elt prop) - (plist-get elt prop))) + test (cadr (plist-member elt prop))) ;; if the property exists and is equal, we continue, else, try the ;; next element of the list (or (and (eq prop :nick) (if (>= emacs-major-version 28) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index fc9a8d39ef4..683ac2d37c5 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -137,7 +137,7 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'." (goto-char (point-max)))) (defun erc-move-to-prompt-setup () - "Initialize the move-to-prompt module for XEmacs." + "Initialize the move-to-prompt module." (add-hook 'pre-command-hook #'erc-move-to-prompt nil t)) ;;; Keep place in unvisited channels diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index dcf6db7407a..522bc805f8d 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -1,7 +1,6 @@ ;;; erc-imenu.el --- Imenu support for ERC -*- lexical-binding: t; -*- -;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> ;; Maintainer: Amin Bandali <bandali@gnu.org> diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index 90c0ee6f8a4..b2e9047ce77 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el @@ -1,7 +1,6 @@ ;;; erc-replace.el --- wash and massage messages inserted into the buffer -*- lexical-binding: t; -*- -;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> ;; Maintainer: Amin Bandali <bandali@gnu.org> diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 885d311cf38..0da837012cc 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -12,7 +12,7 @@ ;; David Edmondson (dme@dme.org) ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) -;; Version: 5.4 +;; Version: 5.4.1 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -69,7 +69,7 @@ (require 'iso8601) (eval-when-compile (require 'subr-x)) -(defconst erc-version "5.4" +(defconst erc-version "5.4.1" "This version of ERC.") (defvar erc-official-location @@ -83,7 +83,8 @@ 'customize-package-emacs-version-alist '(ERC ("5.2" . "22.1") ("5.3" . "23.1") - ("5.4" . "28.1"))) + ("5.4" . "28.1") + ("5.4.1" . "29.1"))) (defgroup erc nil "Emacs Internet Relay Chat client." @@ -1291,7 +1292,7 @@ Example: #\\='erc-replace-insert)) ((remove-hook \\='erc-insert-modify-hook #\\='erc-replace-insert)))" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) (let* ((sn (symbol-name name)) (mode (intern (format "erc-%s-mode" (downcase sn)))) (group (intern (format "erc-%s" (downcase sn)))) @@ -2816,20 +2817,17 @@ present." (let ((prop-val (erc-get-parsed-vector position))) (and prop-val (member (erc-response.command prop-val) list)))) -(defvar-local erc-send-input-line-function 'erc-send-input-line) +(defvar-local erc-send-input-line-function 'erc-send-input-line + "Function for sending lines lacking a leading user command. +When a line typed into a buffer contains an explicit command, like /msg, +a corresponding handler (here, erc-cmd-MSG) is called. But lines typed +into a channel or query buffer already have an implicit target and +command (PRIVMSG). This function is called on such occasions and also +for special purposes (see erc-dcc.el).") (defun erc-send-input-line (target line &optional force) - "Send LINE to TARGET. - -See also `erc-server-send'." - (setq line (format "PRIVMSG %s :%s" - target - ;; If the line is empty, we still want to - ;; send it - i.e. an empty pasted line. - (if (string= line "\n") - " \n" - line))) - (erc-server-send line force target)) + "Send LINE to TARGET." + (erc-message "PRIVMSG" (concat target " " line) force)) (defun erc-get-arglist (fun) "Return the argument list of a function without the parens." diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 8e6506c301c..2b5a4647e06 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -939,7 +939,14 @@ This function could be in the list `eshell-output-filter-functions'." (beginning-of-line) (if (re-search-forward eshell-password-prompt-regexp eshell-last-output-end t) - (eshell-send-invisible)))))) + ;; Use `run-at-time' in order not to pause execution of + ;; the process filter with a minibuffer + (run-at-time + 0 nil + (lambda (current-buf) + (with-current-buffer current-buf + (eshell-send-invisible))) + (current-buffer))))))) (custom-add-option 'eshell-output-filter-functions 'eshell-watch-for-password-prompt) diff --git a/lisp/ezimage.el b/lisp/ezimage.el index 13f5c039a7f..57033cde058 100644 --- a/lisp/ezimage.el +++ b/lisp/ezimage.el @@ -45,6 +45,7 @@ (defmacro defezimage (variable imagespec docstring) "Define VARIABLE as an image if `defimage' is not available. IMAGESPEC is the image data, and DOCSTRING is documentation for the image." + (declare (indent defun)) `(progn (defimage ,variable ,imagespec ,docstring) (put (quote ,variable) 'ezimage t))) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 7417bb12030..fe458b8c07b 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -551,8 +551,8 @@ If the optional argument CALLBACK is non-nil, it should be a function to call each time the user types RET or clicks on a color. The function should accept a single argument, the color name." (interactive) - (when (and (null list) (> (display-color-cells) 0)) - (setq list (list-colors-duplicates (defined-colors))) + (when (> (display-color-cells) 0) + (setq list (list-colors-duplicates (or list (defined-colors)))) (when list-colors-sort ;; Schwartzian transform with `(color key1 key2 key3 ...)'. (setq list (mapcar diff --git a/lisp/faces.el b/lisp/faces.el index 327b0ac01ec..9ec20c42987 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -88,9 +88,9 @@ a font height that isn't optimal." :tag "Font selection order" :type '(list symbol symbol symbol symbol) :group 'font-selection - :set #'(lambda (symbol value) - (set-default symbol value) - (internal-set-font-selection-order value))) + :set (lambda (symbol value) + (set-default symbol value) + (internal-set-font-selection-order value))) ;; In the absence of Fontconfig support, Monospace and Sans Serif are @@ -140,9 +140,9 @@ ALTERNATIVE2 etc." :tag "Alternative font families to try" :type '(repeat (repeat string)) :group 'font-selection - :set #'(lambda (symbol value) - (set-default symbol value) - (internal-set-alternative-font-family-alist value))) + :set (lambda (symbol value) + (set-default symbol value) + (internal-set-alternative-font-family-alist value))) ;; This is defined originally in xfaces.c. @@ -167,9 +167,9 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc." :type '(repeat (repeat string)) :version "21.1" :group 'font-selection - :set #'(lambda (symbol value) - (set-default symbol value) - (internal-set-alternative-font-registry-alist value))) + :set (lambda (symbol value) + (set-default symbol value) + (internal-set-alternative-font-registry-alist value))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -702,9 +702,10 @@ for it to be relative to). `:weight' -VALUE specifies the weight of the font to use. It must be one of the -symbols `ultra-bold', `extra-bold', `bold', `semi-bold', `normal', -`semi-light', `light', `extra-light', `ultra-light'. +VALUE specifies the weight of the font to use. It must be one of +the symbols `ultra-heavy', `heavy', `ultra-bold', `extra-bold', +`bold', `semi-bold', `medium', `normal', `book', `semi-light', +`light', `extra-light', `ultra-light', or `thin'. `:slant' @@ -861,8 +862,8 @@ is specified, `:italic' is ignored." (defun make-face-bold (face &optional frame _noerror) "Make the font of FACE be bold, if possible. FRAME nil or not specified means change face on all frames. -Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of the font weight." + (declare (advertised-calling-convention (face &optional frame) "29.1")) (interactive (list (read-face-name "Make which face bold" (face-at-point t)))) (set-face-attribute face frame :weight 'bold)) @@ -870,8 +871,8 @@ Use `set-face-attribute' for finer control of the font weight." (defun make-face-unbold (face &optional frame _noerror) "Make the font of FACE be non-bold, if possible. -FRAME nil or not specified means change face on all frames. -Argument NOERROR is ignored and retained for compatibility." +FRAME nil or not specified means change face on all frames." + (declare (advertised-calling-convention (face &optional frame) "29.1")) (interactive (list (read-face-name "Make which face non-bold" (face-at-point t)))) (set-face-attribute face frame :weight 'normal)) @@ -880,8 +881,8 @@ Argument NOERROR is ignored and retained for compatibility." (defun make-face-italic (face &optional frame _noerror) "Make the font of FACE be italic, if possible. FRAME nil or not specified means change face on all frames. -Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of the font slant." + (declare (advertised-calling-convention (face &optional frame) "29.1")) (interactive (list (read-face-name "Make which face italic" (face-at-point t)))) (set-face-attribute face frame :slant 'italic)) @@ -889,8 +890,8 @@ Use `set-face-attribute' for finer control of the font slant." (defun make-face-unitalic (face &optional frame _noerror) "Make the font of FACE be non-italic, if possible. -FRAME nil or not specified means change face on all frames. -Argument NOERROR is ignored and retained for compatibility." +FRAME nil or not specified means change face on all frames." + (declare (advertised-calling-convention (face &optional frame) "29.1")) (interactive (list (read-face-name "Make which face non-italic" (face-at-point t)))) (set-face-attribute face frame :slant 'normal)) @@ -899,8 +900,8 @@ Argument NOERROR is ignored and retained for compatibility." (defun make-face-bold-italic (face &optional frame _noerror) "Make the font of FACE be bold and italic, if possible. FRAME nil or not specified means change face on all frames. -Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of font weight and slant." + (declare (advertised-calling-convention (face &optional frame) "29.1")) (interactive (list (read-face-name "Make which face bold-italic" (face-at-point t)))) (set-face-attribute face frame :weight 'bold :slant 'italic)) @@ -1100,7 +1101,7 @@ returned. Otherwise, DEFAULT is returned verbatim." ;; prompt. If so, remove it. (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt)) (let ((prompt (if default - (format-message "%s (default `%s'): " prompt default) + (format-prompt prompt default) (format "%s: " prompt))) aliasfaces nonaliasfaces faces) ;; Build up the completion tables. @@ -1146,27 +1147,27 @@ an integer value." (:foundry (list nil)) (:width - (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) + (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-width-table)) (:weight - (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) + (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-weight-table)) (:slant - (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) + (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-slant-table)) ((or :inverse-video :extend) - (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (mapcar (lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute))) ((or :underline :overline :strike-through :box) (if (window-system frame) - (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (nconc (mapcar (lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)) - (mapcar #'(lambda (c) (cons c c)) + (mapcar (lambda (c) (cons c c)) (defined-colors frame))) - (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (mapcar (lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)))) ((or :foreground :background) - (mapcar #'(lambda (c) (cons c c)) + (mapcar (lambda (c) (cons c c)) (defined-colors frame))) (:height 'integerp) @@ -1181,7 +1182,7 @@ an integer value." x-bitmap-file-path))))) (:inherit (cons '("none" . nil) - (mapcar #'(lambda (c) (cons (symbol-name c) c)) + (mapcar (lambda (c) (cons (symbol-name c) c)) (face-list)))) (_ (error "Internal error"))))) @@ -2285,19 +2286,19 @@ If you set `term-file-prefix' to nil, this function does nothing." (let* (term-init-func) ;; First, load the terminal initialization file, if it is ;; available and it hasn't been loaded already. - (tty-find-type #'(lambda (type) - (let ((file (locate-library (concat term-file-prefix type)))) - (and file - (or (assoc file load-history) - (load (replace-regexp-in-string - "\\.el\\(\\.gz\\)?\\'" "" - file) - t t))))) - type) + (tty-find-type (lambda (type) + (let ((file (locate-library (concat term-file-prefix type)))) + (and file + (or (assoc file load-history) + (load (replace-regexp-in-string + "\\.el\\(\\.gz\\)?\\'" "" + file) + t t))))) + type) ;; Next, try to find a matching initialization function, and call it. - (tty-find-type #'(lambda (type) - (fboundp (setq term-init-func - (intern (concat "terminal-init-" type))))) + (tty-find-type (lambda (type) + (fboundp (setq term-init-func + (intern (concat "terminal-init-" type))))) type) (when (fboundp term-init-func) (funcall term-init-func)) @@ -2877,11 +2878,15 @@ Note: Other faces cannot inherit from the cursor face." :background "grey96" :foreground "DarkBlue" ;; We use negative thickness of the horizontal box border line to ;; avoid enlarging the height of the echo-area display, which - ;; would then move the mode line a few pixels up. - :box (:line-width (1 . -1) :color "grey80")) + ;; would then move the mode line a few pixels up. We use + ;; negative thickness for the vertical border line to avoid + ;; making the characters wider, which then would cause unpleasant + ;; horizontal shifts of the cursor during C-n/C-p movement + ;; through a line with this face. + :box (:line-width (-1 . -1) :color "grey80")) (((class color) (min-colors 88) (background dark)) :background "grey19" :foreground "LightBlue" - :box (:line-width (1 . -1) :color "grey35")) + :box (:line-width (-1 . -1) :color "grey35")) (((class color grayscale) (background light)) :background "grey90") (((class color grayscale) (background dark)) :background "grey25") (t :background "grey90")) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 271fa270836..26954cc73f2 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -480,6 +480,14 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." ;; Modify `file-notify-descriptors' and send a `stopped' event. (file-notify--rm-descriptor descriptor)))) +(defun file-notify-rm-all-watches () + "Remove all existing file notification watches from Emacs." + (interactive) + (maphash + (lambda (key _value) + (file-notify-rm-watch key)) + file-notify-descriptors)) + (defun file-notify-valid-p (descriptor) "Check a watch specified by its DESCRIPTOR. DESCRIPTOR should be an object returned by `file-notify-add-watch'." diff --git a/lisp/files.el b/lisp/files.el index 20690742d3b..3af97303268 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2759,6 +2759,7 @@ since only a single case-insensitive search through the alist is made." ("\\.gif\\'" . image-mode) ("\\.png\\'" . image-mode) ("\\.jpe?g\\'" . image-mode) + ("\\.webp\\'" . image-mode) ("\\.te?xt\\'" . text-mode) ("\\.[tT]e[xX]\\'" . tex-mode) ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. @@ -2884,6 +2885,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.[ds]?va?h?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ("\\.wy\\'" . wisent-grammar-mode) + ("\\.erts\\'" . erts-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix or MS-DOS syntax. ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) @@ -2976,6 +2978,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.dng\\'" . image-mode) ("\\.dpx\\'" . image-mode) ("\\.fax\\'" . image-mode) + ("\\.heic\\'" . image-mode) ("\\.hrz\\'" . image-mode) ("\\.icb\\'" . image-mode) ("\\.icc\\'" . image-mode) @@ -6178,6 +6181,30 @@ Return nil if DIR is not an existing directory." (unless mismatch (file-equal-p root dir))))))) +(defvar file-has-changed-p--hash-table (make-hash-table :test #'equal) + "Internal variable used by `file-has-changed-p'.") + +(defun file-has-changed-p (file &optional tag) + "Return non-nil if FILE has changed. +The size and modification time of FILE are compared to the size +and modification time of the same FILE during a previous +invocation of `file-has-changed-p'. Thus, the first invocation +of `file-has-changed-p' always returns non-nil when FILE exists. +The optional argument TAG, which must be a symbol, can be used to +limit the comparison to invocations with identical tags; it can be +the symbol of the calling function, for example." + (let* (;; FIXME: Shall we use `file-truename'? + (file (directory-file-name file)) + (remote-file-name-inhibit-cache t) + (fileattr (file-attributes file 'integer)) + (attr (and fileattr + (cons (file-attribute-size fileattr) + (file-attribute-modification-time fileattr)))) + (sym (concat (symbol-name tag) "@" file)) + (cachedattr (gethash sym file-has-changed-p--hash-table))) + (when (not (equal attr cachedattr)) + (puthash sym attr file-has-changed-p--hash-table)))) + (defun copy-directory (directory newname &optional keep-time parents copy-contents) "Copy DIRECTORY to NEWNAME. Both args must be strings. This function always sets the file modes of the output files to match @@ -7130,16 +7157,16 @@ default directory. However, if FULL is non-nil, they are absolute." (let ((this-dir-contents ;; Filter out "." and ".." (delq nil - (mapcar #'(lambda (name) - (unless (string-match "\\`\\.\\.?\\'" - (file-name-nondirectory name)) - name)) + (mapcar (lambda (name) + (unless (string-match "\\`\\.\\.?\\'" + (file-name-nondirectory name)) + name)) (directory-files (or dir ".") full (wildcard-to-regexp nondir)))))) (setq contents (nconc (if (and dir (not full)) - (mapcar #'(lambda (name) (concat dir name)) + (mapcar (lambda (name) (concat dir name)) this-dir-contents) this-dir-contents) contents))))) diff --git a/lisp/finder.el b/lisp/finder.el index c2b9a6d0ef9..00f321b8028 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -362,19 +362,13 @@ not `finder-known-keywords'." (let ((package-list-unversioned t)) (package-show-package-list packages)))) -(define-button-type 'finder-xref 'action #'finder-goto-xref) - -(defun finder-goto-xref (button) - "Jump to a Lisp file for the BUTTON at point." - (let* ((file (button-get button 'xref)) - (lib (locate-library file))) - (if lib (finder-commentary lib) - (message "Unable to locate `%s'" file)))) - ;;;###autoload (defun finder-commentary (file) "Display FILE's commentary section. FILE should be in a form suitable for passing to `locate-library'." + ;; FIXME: Merge this function into `describe-package', which is + ;; strictly better as it has links to URL's and is in a proper help + ;; buffer with navigation forward and backward, etc. (interactive (list (completing-read "Library name: " @@ -391,12 +385,7 @@ FILE should be in a form suitable for passing to `locate-library'." (erase-buffer) (insert str) (goto-char (point-min)) - (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t) - (if (locate-library (match-string 1)) - (make-text-button (match-beginning 1) (match-end 1) - 'xref (match-string-no-properties 1) - 'help-echo "Read this file's commentary" - :type 'finder-xref))) + (package--describe-add-library-links) (goto-char (point-min)) (setq buffer-read-only t) (set-buffer-modified-p nil) @@ -469,6 +458,9 @@ Quit the window and kill all Finder-related buffers." ;; continue standard unloading nil) +(define-obsolete-function-alias 'finder-goto-xref + #'package--finder-goto-xref "29.1") + (provide 'finder) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index a4ab897f6f2..c2590eb3c11 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2075,7 +2075,7 @@ as the constructs of Haddock, Javadoc and similar systems." (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") (((class color) (min-colors 8)) :foreground "green") (t :weight bold :underline t)) - "Font Lock mode face used to highlight type and classes." + "Font Lock mode face used to highlight type and class names." :group 'font-lock-faces) (defface font-lock-constant-face diff --git a/lisp/format.el b/lisp/format.el index 6c0ba11641e..8ae51f19ebc 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -320,7 +320,7 @@ If the format is not specified, attempt a regexp-based guess. Set `buffer-file-format' to the format used, and call any format-specific mode functions." (interactive - (list (format-read "Translate buffer from format (default guess): "))) + (list (format-read (format-prompt "Translate buffer from format" "guess")))) (save-excursion (goto-char (point-min)) (format-decode format (buffer-size) t))) @@ -331,7 +331,7 @@ Arg FORMAT is optional; if omitted the format will be determined by looking for identifying regular expressions at the beginning of the region." (interactive (list (region-beginning) (region-end) - (format-read "Translate region from format (default guess): "))) + (format-read (format-prompt "Translate region from format" "guess")))) (save-excursion (goto-char from) (format-decode format (- to from) nil))) diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index bcf8dd014bc..68a90989046 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -239,6 +239,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." + (declare (indent defun)) (let ((defined-p (fboundp function))) (if defined-p `(defalias ',name ',function) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 6426d825465..20da295aca9 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -475,17 +475,16 @@ manipulated as follows: (gnus-run-hooks 'gnus-agent-mode-hook (intern (format "gnus-agent-%s-mode-hook" buffer))))) -(defvar gnus-agent-group-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-group-mode-map - "Ju" gnus-agent-fetch-groups - "Jc" gnus-enter-category-buffer - "Jj" gnus-agent-toggle-plugged - "Js" gnus-agent-fetch-session - "JY" gnus-agent-synchronize-flags - "JS" gnus-group-send-queue - "Ja" gnus-agent-add-group - "Jr" gnus-agent-remove-group - "Jo" gnus-agent-toggle-group-plugged) +(defvar-keymap gnus-agent-group-mode-map + "Ju" #'gnus-agent-fetch-groups + "Jc" #'gnus-enter-category-buffer + "Jj" #'gnus-agent-toggle-plugged + "Js" #'gnus-agent-fetch-session + "JY" #'gnus-agent-synchronize-flags + "JS" #'gnus-group-send-queue + "Ja" #'gnus-agent-add-group + "Jr" #'gnus-agent-remove-group + "Jo" #'gnus-agent-toggle-group-plugged) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -504,16 +503,15 @@ manipulated as follows: ["Synchronize flags" gnus-agent-synchronize-flags t] )))) -(defvar gnus-agent-summary-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-summary-mode-map - "Jj" gnus-agent-toggle-plugged - "Ju" gnus-agent-summary-fetch-group - "JS" gnus-agent-fetch-group - "Js" gnus-agent-summary-fetch-series - "J#" gnus-agent-mark-article - "J\M-#" gnus-agent-unmark-article - "@" gnus-agent-toggle-mark - "Jc" gnus-agent-catchup) +(defvar-keymap gnus-agent-summary-mode-map + "Jj" #'gnus-agent-toggle-plugged + "Ju" #'gnus-agent-summary-fetch-group + "JS" #'gnus-agent-fetch-group + "Js" #'gnus-agent-summary-fetch-series + "J#" #'gnus-agent-mark-article + "J\M-#" #'gnus-agent-unmark-article + "@" #'gnus-agent-toggle-mark + "Jc" #'gnus-agent-catchup) (defun gnus-agent-summary-make-menu-bar () (unless (boundp 'gnus-agent-summary-menu) @@ -527,11 +525,10 @@ manipulated as follows: ["Fetch downloadable" gnus-agent-summary-fetch-group t] ["Catchup undownloaded" gnus-agent-catchup t])))) -(defvar gnus-agent-server-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-server-mode-map - "Jj" gnus-agent-toggle-plugged - "Ja" gnus-agent-add-server - "Jr" gnus-agent-remove-server) +(defvar-keymap gnus-agent-server-mode-map + "Jj" #'gnus-agent-toggle-plugged + "Ja" #'gnus-agent-add-server + "Jr" #'gnus-agent-remove-server) (defun gnus-agent-server-make-menu-bar () (unless (boundp 'gnus-agent-server-menu) @@ -2597,25 +2594,20 @@ General format specifiers can also be used. See Info node (defvar gnus-category-line-format-spec nil) (defvar gnus-category-mode-line-format-spec nil) -(defvar gnus-category-mode-map nil) - -(unless gnus-category-mode-map - (setq gnus-category-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-category-mode-map) - - (gnus-define-keys gnus-category-mode-map - "q" gnus-category-exit - "k" gnus-category-kill - "c" gnus-category-copy - "a" gnus-category-add - "e" gnus-agent-customize-category - "p" gnus-category-edit-predicate - "g" gnus-category-edit-groups - "s" gnus-category-edit-score - "l" gnus-category-list - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) +(defvar-keymap gnus-category-mode-map + :suppress t + "q" #'gnus-category-exit + "k" #'gnus-category-kill + "c" #'gnus-category-copy + "a" #'gnus-category-add + "e" #'gnus-agent-customize-category + "p" #'gnus-category-edit-predicate + "g" #'gnus-category-edit-groups + "s" #'gnus-category-edit-score + "l" #'gnus-category-list + + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug) (defcustom gnus-category-menu-hook nil "Hook run after the creation of the menu." diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index cce0fc32b70..89b4a63ad92 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1167,6 +1167,19 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) +(defcustom gnus-treat-emojize-symbols nil + "Display emoji versions of symbol. +Some symbols have both a non-emoji presentation and an emoji +presentation. This treatment will make Gnus display the latter +as emojis even when they weren't sent as such. + +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :version "29.1" + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + (defcustom gnus-treat-unsplit-urls nil "Remove newlines from within URLs. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1650,6 +1663,7 @@ regexp." (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist '((gnus-treat-strip-cr gnus-article-remove-cr) + (gnus-treat-emojize-symbols gnus-article-emojize-symbols) (gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) (gnus-treat-strip-banner gnus-article-strip-banner) (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) @@ -2360,6 +2374,20 @@ fill width." (while (search-forward "\r" nil t) (replace-match "\n" t t))))) +(defun article-emojize-symbols () + "Display symbols (that have an emoji version) as emojis." + (interactive nil gnus-article-mode) + (when-let ((font (and (display-multi-font-p) + (car (internal-char-font nil ?😀))))) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (while (re-search-forward "[[:multibyte:]]" nil t) + ;; If there's already a grapheme cluster here, skip it. + (when (and (not (find-composition (point))) + (font-has-char-p font (char-after (match-beginning 0)))) + (insert "\N{VARIATION SELECTOR-16}"))))))) + (defun article-remove-trailing-blank-lines () "Remove all trailing blank lines from the article." (interactive nil gnus-article-mode) @@ -3933,8 +3961,8 @@ This format is defined by the `gnus-article-time-format' variable." ;; No split name was found. ((null split-name) (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") + (format-prompt prompt + (file-name-nondirectory default-name)) (file-name-directory default-name) default-name)) ;; A single group name is returned. @@ -3943,8 +3971,8 @@ This format is defined by the `gnus-article-time-format' variable." (funcall function split-name headers (symbol-value variable))) (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") + (format-prompt prompt + (file-name-nondirectory default-name)) (file-name-directory default-name) default-name)) ;; A single split name was found @@ -3956,9 +3984,8 @@ This format is defined by the `gnus-article-time-format' variable." (file-name-as-directory name)) ((file-exists-p name) name) (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name "): ") - dir name))) + (read-file-name (format-prompt prompt name) + dir name))) ;; A list of splits was found. (t (setq split-name (nreverse split-name)) @@ -4342,6 +4369,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-fill-long-lines article-capitalize-sentences article-remove-cr + article-emojize-symbols article-remove-leading-whitespace article-display-x-face article-display-face @@ -4387,44 +4415,44 @@ If variable `gnus-use-long-file-name' is non-nil, it is ;;; Gnus article mode ;;; -(set-keymap-parent gnus-article-mode-map button-buffer-map) - -(gnus-define-keys gnus-article-mode-map - " " gnus-article-goto-next-page - [?\S-\ ] gnus-article-goto-prev-page - "\177" gnus-article-goto-prev-page - [delete] gnus-article-goto-prev-page - "\C-c^" gnus-article-refer-article - "h" gnus-article-show-summary - "s" gnus-article-show-summary - "\C-c\C-m" gnus-article-mail - "?" gnus-article-describe-briefly - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug - "R" gnus-article-reply-with-original - "F" gnus-article-followup-with-original - "\C-hk" gnus-article-describe-key - "\C-hc" gnus-article-describe-key-briefly - "\C-hb" gnus-article-describe-bindings - - "e" gnus-article-read-summary-keys - "\C-d" gnus-article-read-summary-keys - "\C-c\C-f" gnus-summary-mail-forward - "\M-*" gnus-article-read-summary-keys - "\M-#" gnus-article-read-summary-keys - "\M-^" gnus-article-read-summary-keys - "\M-g" gnus-article-read-summary-keys) +(defvar gnus-article-send-map nil) + +(define-keymap :keymap gnus-article-mode-map :suppress t + :parent button-buffer-map + " " #'gnus-article-goto-next-page + [?\S-\ ] #'gnus-article-goto-prev-page + "\177" #'gnus-article-goto-prev-page + [delete] #'gnus-article-goto-prev-page + "\C-c^" #'gnus-article-refer-article + "h" #'gnus-article-show-summary + "s" #'gnus-article-show-summary + "\C-c\C-m" #'gnus-article-mail + "?" #'gnus-article-describe-briefly + "<" #'beginning-of-buffer + ">" #'end-of-buffer + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug + "R" #'gnus-article-reply-with-original + "F" #'gnus-article-followup-with-original + "\C-hk" #'gnus-article-describe-key + "\C-hc" #'gnus-article-describe-key-briefly + "\C-hb" #'gnus-article-describe-bindings + + "e" #'gnus-article-read-summary-keys + "\C-d" #'gnus-article-read-summary-keys + "\C-c\C-f" #'gnus-summary-mail-forward + "\M-*" #'gnus-article-read-summary-keys + "\M-#" #'gnus-article-read-summary-keys + "\M-^" #'gnus-article-read-summary-keys + "\M-g" #'gnus-article-read-summary-keys + + "S" (define-keymap :prefix 'gnus-article-send-map + "W" #'gnus-article-wide-reply-with-original + [t] #'gnus-article-read-summary-send-keys)) (substitute-key-definition #'undefined #'gnus-article-read-summary-keys gnus-article-mode-map) -(defvar gnus-article-send-map) -(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) - "W" gnus-article-wide-reply-with-original - [t] gnus-article-read-summary-send-keys) - (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) (gnus-summary-make-menu-bar)) @@ -4449,6 +4477,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Treat overstrike" gnus-article-treat-overstrike t] ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t] ["Remove carriage return" gnus-article-remove-cr t] + ["Emojize Symbols" gnus-article-emojize-symbols t] ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] ["Remove base64" gnus-article-de-base64-unreadable t] @@ -4509,7 +4538,8 @@ commands: (setq show-trailing-whitespace nil) ;; Arrange a callback from `mm-inline-message' if we're ;; displaying a message/rfc822 part. - (setq-local mm-inline-message-prepare-function #'gnus-mime--inline-message) + (setq-local mm-inline-message-prepare-function + #'gnus-mime--inline-message-function) (mm-enable-multibyte)) (defun gnus-article-setup-buffer () @@ -6045,7 +6075,7 @@ If nil, don't show those extra buttons." (defun gnus-mime-display-mixed (handles) (mapcar #'gnus-mime-display-part handles)) -(defun gnus-mime--inline-message (handle charset) +(defun gnus-mime--inline-message-function (handle charset) (let ((handles (let (gnus-article-mime-handles ;; disable prepare hook @@ -7222,50 +7252,43 @@ other groups." (defvar gnus-article-edit-done-function nil) -(defvar gnus-article-edit-mode-map nil) - -;; Should we be using derived.el for this? -(unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (make-keymap)) - (set-keymap-parent gnus-article-edit-mode-map text-mode-map) - - (gnus-define-keys gnus-article-edit-mode-map - "\C-c?" describe-mode - "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit - "\C-c\C-f\C-t" message-goto-to - "\C-c\C-f\C-o" message-goto-from - "\C-c\C-f\C-b" message-goto-bcc - ;;"\C-c\C-f\C-w" message-goto-fcc - "\C-c\C-f\C-c" message-goto-cc - "\C-c\C-f\C-s" message-goto-subject - "\C-c\C-f\C-r" message-goto-reply-to - "\C-c\C-f\C-n" message-goto-newsgroups - "\C-c\C-f\C-d" message-goto-distribution - "\C-c\C-f\C-f" message-goto-followup-to - "\C-c\C-f\C-m" message-goto-mail-followup-to - "\C-c\C-f\C-k" message-goto-keywords - "\C-c\C-f\C-u" message-goto-summary - "\C-c\C-f\C-i" message-insert-or-toggle-importance - "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to - "\C-c\C-b" message-goto-body - "\C-c\C-i" message-goto-signature - - "\C-c\C-t" message-insert-to - "\C-c\C-n" message-insert-newsgroups - "\C-c\C-o" message-sort-headers - "\C-c\C-e" message-elide-region - "\C-c\C-v" message-delete-not-region - "\C-c\C-z" message-kill-to-signature - "\M-\r" message-newline-and-reformat - "\C-c\C-a" mml-attach-file - "\C-a" message-beginning-of-line - "\t" message-tab - "\M-;" comment-region) - - (gnus-define-keys (gnus-article-edit-wash-map - "\C-c\C-w" gnus-article-edit-mode-map) - "f" gnus-article-edit-full-stops)) +(defvar-keymap gnus-article-edit-mode-map + :full t :parent text-mode-map + "\C-c?" #'describe-mode + "\C-c\C-c" #'gnus-article-edit-done + "\C-c\C-k" #'gnus-article-edit-exit + "\C-c\C-f\C-t" #'message-goto-to + "\C-c\C-f\C-o" #'message-goto-from + "\C-c\C-f\C-b" #'message-goto-bcc + ;;"\C-c\C-f\C-w" message-goto-fcc + "\C-c\C-f\C-c" #'message-goto-cc + "\C-c\C-f\C-s" #'message-goto-subject + "\C-c\C-f\C-r" #'message-goto-reply-to + "\C-c\C-f\C-n" #'message-goto-newsgroups + "\C-c\C-f\C-d" #'message-goto-distribution + "\C-c\C-f\C-f" #'message-goto-followup-to + "\C-c\C-f\C-m" #'message-goto-mail-followup-to + "\C-c\C-f\C-k" #'message-goto-keywords + "\C-c\C-f\C-u" #'message-goto-summary + "\C-c\C-f\C-i" #'message-insert-or-toggle-importance + "\C-c\C-f\C-a" #'message-generate-unsubscribed-mail-followup-to + "\C-c\C-b" #'message-goto-body + "\C-c\C-i" #'message-goto-signature + + "\C-c\C-t" #'message-insert-to + "\C-c\C-n" #'message-insert-newsgroups + "\C-c\C-o" #'message-sort-headers + "\C-c\C-e" #'message-elide-region + "\C-c\C-v" #'message-delete-not-region + "\C-c\C-z" #'message-kill-to-signature + "\M-\r" #'message-newline-and-reformat + "\C-c\C-a" #'mml-attach-file + "\C-a" #'message-beginning-of-line + "\t" #'message-tab + "\M-;" #'comment-region + + "\C-c\C-w" (define-keymap :prefix 'gnus-article-edit-wash-map + "f" #'gnus-article-edit-full-stops)) (easy-menu-define gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 83e482f14c1..171da9d17a0 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -418,32 +418,29 @@ That is, all information but the name." (defvar gnus-bookmark-bmenu-bookmark-column nil) (defvar gnus-bookmark-bmenu-hidden-bookmarks ()) -(defvar gnus-bookmark-bmenu-mode-map nil) - -(if gnus-bookmark-bmenu-mode-map - nil - (setq gnus-bookmark-bmenu-mode-map (make-keymap)) - (suppress-keymap gnus-bookmark-bmenu-mode-map t) - (define-key gnus-bookmark-bmenu-mode-map "q" 'quit-window) - (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select) - (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select) - (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete) - (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete) - (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards) - (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions) - (define-key gnus-bookmark-bmenu-mode-map " " 'next-line) - (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line) - (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line) - (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark) - (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode) - (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark) - (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark) - (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load) - (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save) - (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos) - (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details) - (define-key gnus-bookmark-bmenu-mode-map [mouse-2] - 'gnus-bookmark-bmenu-select-by-mouse)) + +(defvar-keymap gnus-bookmark-bmenu-mode-map + :full t + :suppress 'nodigits + "q" #'quit-window + "\C-m" #'gnus-bookmark-bmenu-select + "v" #'gnus-bookmark-bmenu-select + "d" #'gnus-bookmark-bmenu-delete + "k" #'gnus-bookmark-bmenu-delete + "\C-d" #'gnus-bookmark-bmenu-delete-backwards + "x" #'gnus-bookmark-bmenu-execute-deletions + " " #'next-line + "n" #'next-line + "p" #'previous-line + "\177" #'gnus-bookmark-bmenu-backup-unmark + "?" #'describe-mode + "u" #'gnus-bookmark-bmenu-unmark + "m" #'gnus-bookmark-bmenu-mark + "l" #'gnus-bookmark-bmenu-load + "s" #'gnus-bookmark-bmenu-save + "t" #'gnus-bookmark-bmenu-toggle-infos + "a" #'gnus-bookmark-bmenu-show-details + [mouse-2] #'gnus-bookmark-bmenu-select-by-mouse) ;; Bookmark Buffer Menu mode is suitable only for specially formatted ;; data. diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index e9eddae942f..be46d3a341d 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -53,12 +53,10 @@ (autoload 'message-buffers "message") (autoload 'gnus-print-buffer "gnus-sum") -(defvar gnus-dired-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-m\C-a" 'gnus-dired-attach) - (define-key map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap) - (define-key map "\C-c\C-m\C-p" 'gnus-dired-print) - map)) +(defvar-keymap gnus-dired-mode-map + "\C-c\C-m\C-a" #'gnus-dired-attach + "\C-c\C-m\C-l" #'gnus-dired-find-file-mailcap + "\C-c\C-m\C-p" #'gnus-dired-print) ;; FIXME: Make it customizable, change the default to `mail-user-agent' when ;; this file is renamed (e.g. to `dired-mime.el'). diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 9a0f21359f8..756e6d2d362 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -33,15 +33,12 @@ ;;; Draft minor mode -(defvar gnus-draft-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "Dt" gnus-draft-toggle-sending - "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' - "De" gnus-draft-edit-message - "Ds" gnus-draft-send-message - "DS" gnus-draft-send-all-messages) - map)) +(defvar-keymap gnus-draft-mode-map + "Dt" #'gnus-draft-toggle-sending + "e" #' gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' + "De" #'gnus-draft-edit-message + "Ds" #'gnus-draft-send-message + "DS" #'gnus-draft-send-all-messages) (defun gnus-draft-make-menu-bar () (unless (boundp 'gnus-draft-menu) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 3fd8bf51de4..b0aa58f0f28 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -48,13 +48,10 @@ (defvar gnus-edit-form-buffer "*Gnus edit form*") (defvar gnus-edit-form-done-function nil) -(defvar gnus-edit-form-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map emacs-lisp-mode-map) - (gnus-define-keys map - "\C-c\C-c" gnus-edit-form-done - "\C-c\C-k" gnus-edit-form-exit) - map)) +(defvar-keymap gnus-edit-form-mode-map + :parent emacs-lisp-mode-map + "\C-c\C-c" #'gnus-edit-form-done + "\C-c\C-k" #'gnus-edit-form-exit) (defun gnus-edit-form-make-menu-bar () (unless (boundp 'gnus-edit-form-menu) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index b1e486b0627..ddc819877c1 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -573,209 +573,209 @@ simple manner." ;;; Gnus group mode ;;; -(gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - "\M- " gnus-group-visible-select-group - [(meta control return)] gnus-group-select-group-ephemerally - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-toggle-subscription-at-point - "U" gnus-group-toggle-subscription - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "\M-c" gnus-group-clear-data - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "i" gnus-group-news - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-group-find-new-groups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - [mouse-2] gnus-mouse-pick-group - [follow-link] mouse-face - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - -(gnus-define-keys (gnus-group-cloud-map "~" gnus-group-mode-map) - "u" gnus-cloud-upload-all-data - "~" gnus-cloud-upload-all-data - "d" gnus-cloud-download-all-data - "\r" gnus-cloud-download-all-data) - -(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "b" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - -(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) - "u" gnus-sieve-update - "g" gnus-sieve-generate) - -(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "u" gnus-group-make-useful-group - "l" gnus-group-nnimap-edit-acl - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "w" gnus-group-make-web-group - "G" gnus-group-read-ephemeral-search-group - "g" gnus-group-make-search-group - "M" gnus-group-read-ephemeral-group - "r" gnus-group-rename-group - "R" gnus-group-make-rss-group - "c" gnus-group-customize - "z" gnus-group-compact-group - "x" gnus-group-expunge-group - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - -(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "l" gnus-group-sort-groups-by-level - "v" gnus-group-sort-groups-by-score - "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method - "n" gnus-group-sort-groups-by-real-name) - -(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) - "s" gnus-group-sort-selected-groups - "a" gnus-group-sort-selected-groups-by-alphabet - "u" gnus-group-sort-selected-groups-by-unread - "l" gnus-group-sort-selected-groups-by-level - "v" gnus-group-sort-selected-groups-by-score - "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method - "n" gnus-group-sort-selected-groups-by-real-name) - -(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level - "c" gnus-group-list-cached - "?" gnus-group-list-dormant - "!" gnus-group-list-ticked) - -(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) - "k" gnus-group-list-limit - "z" gnus-group-list-limit - "s" gnus-group-list-limit - "u" gnus-group-list-limit - "A" gnus-group-list-limit - "m" gnus-group-list-limit - "M" gnus-group-list-limit - "l" gnus-group-list-limit - "c" gnus-group-list-limit - "?" gnus-group-list-limit - "!" gnus-group-list-limit) - -(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) - "k" gnus-group-list-flush - "z" gnus-group-list-flush - "s" gnus-group-list-flush - "u" gnus-group-list-flush - "A" gnus-group-list-flush - "m" gnus-group-list-flush - "M" gnus-group-list-flush - "l" gnus-group-list-flush - "c" gnus-group-list-flush - "?" gnus-group-list-flush - "!" gnus-group-list-flush) - -(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) - "k" gnus-group-list-plus - "z" gnus-group-list-plus - "s" gnus-group-list-plus - "u" gnus-group-list-plus - "A" gnus-group-list-plus - "m" gnus-group-list-plus - "M" gnus-group-list-plus - "l" gnus-group-list-plus - "c" gnus-group-list-plus - "?" gnus-group-list-plus - "!" gnus-group-list-plus) - -(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache - "e" gnus-score-edit-all-score) - -(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "d" gnus-group-describe-group - "v" gnus-version) - -(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) - "l" gnus-group-set-current-level - "t" gnus-group-toggle-subscription-at-point - "s" gnus-group-toggle-subscription - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies) +(define-keymap :keymap gnus-group-mode-map + " " #'gnus-group-read-group + "=" #'gnus-group-select-group + "\r" #'gnus-group-select-group + "\M-\r" #'gnus-group-quick-select-group + "\M- " #'gnus-group-visible-select-group + [(meta control return)] #'gnus-group-select-group-ephemerally + "j" #'gnus-group-jump-to-group + "n" #'gnus-group-next-unread-group + "p" #'gnus-group-prev-unread-group + "\177" #'gnus-group-prev-unread-group + [delete] #'gnus-group-prev-unread-group + "N" #'gnus-group-next-group + "P" #'gnus-group-prev-group + "\M-n" #'gnus-group-next-unread-group-same-level + "\M-p" #'gnus-group-prev-unread-group-same-level + "," #'gnus-group-best-unread-group + "." #'gnus-group-first-unread-group + "u" #'gnus-group-toggle-subscription-at-point + "U" #'gnus-group-toggle-subscription + "c" #'gnus-group-catchup-current + "C" #'gnus-group-catchup-current-all + "\M-c" #'gnus-group-clear-data + "l" #'gnus-group-list-groups + "L" #'gnus-group-list-all-groups + "m" #'gnus-group-mail + "i" #'gnus-group-news + "g" #'gnus-group-get-new-news + "\M-g" #'gnus-group-get-new-news-this-group + "R" #'gnus-group-restart + "r" #'gnus-group-read-init-file + "B" #'gnus-group-browse-foreign-server + "b" #'gnus-group-check-bogus-groups + "F" #'gnus-group-find-new-groups + "\C-c\C-d" #'gnus-group-describe-group + "\M-d" #'gnus-group-describe-all-groups + "\C-c\C-a" #'gnus-group-apropos + "\C-c\M-\C-a" #'gnus-group-description-apropos + "a" #'gnus-group-post-news + "\ek" #'gnus-group-edit-local-kill + "\eK" #'gnus-group-edit-global-kill + "\C-k" #'gnus-group-kill-group + "\C-y" #'gnus-group-yank-group + "\C-w" #'gnus-group-kill-region + "\C-x\C-t" #'gnus-group-transpose-groups + "\C-c\C-l" #'gnus-group-list-killed + "\C-c\C-x" #'gnus-group-expire-articles + "\C-c\M-\C-x" #'gnus-group-expire-all-groups + "V" #'gnus-version + "s" #'gnus-group-save-newsrc + "z" #'gnus-group-suspend + "q" #'gnus-group-exit + "Q" #'gnus-group-quit + "?" #'gnus-group-describe-briefly + "\C-c\C-i" #'gnus-info-find-node + "\M-e" #'gnus-group-edit-group-method + "^" #'gnus-group-enter-server-mode + [mouse-2] #'gnus-mouse-pick-group + [follow-link] 'mouse-face + "<" #'beginning-of-buffer + ">" #'end-of-buffer + "\C-c\C-b" #'gnus-bug + "\C-c\C-s" #'gnus-group-sort-groups + "t" #'gnus-topic-mode + "\C-c\M-g" #'gnus-activate-all-groups + "\M-&" #'gnus-group-universal-argument + "#" #'gnus-group-mark-group + "\M-#" #'gnus-group-unmark-group + + "~" (define-keymap :prefix 'gnus-group-cloud-map + "u" #'gnus-cloud-upload-all-data + "~" #'gnus-cloud-upload-all-data + "d" #'gnus-cloud-download-all-data + "\r" #'gnus-cloud-download-all-data) + + "M" (define-keymap :prefix 'gnus-group-mark-map + "m" #'gnus-group-mark-group + "u" #'gnus-group-unmark-group + "w" #'gnus-group-mark-region + "b" #'gnus-group-mark-buffer + "r" #'gnus-group-mark-regexp + "U" #'gnus-group-unmark-all-groups) + + "D" (define-keymap :prefix 'gnus-group-sieve-map + "u" #'gnus-sieve-update + "g" #'gnus-sieve-generate) + + "G" (define-keymap :prefix 'gnus-group-group-map + "d" #'gnus-group-make-directory-group + "h" #'gnus-group-make-help-group + "u" #'gnus-group-make-useful-group + "l" #'gnus-group-nnimap-edit-acl + "m" #'gnus-group-make-group + "E" #'gnus-group-edit-group + "e" #'gnus-group-edit-group-method + "p" #'gnus-group-edit-group-parameters + "v" #'gnus-group-add-to-virtual + "V" #'gnus-group-make-empty-virtual + "D" #'gnus-group-enter-directory + "f" #'gnus-group-make-doc-group + "w" #'gnus-group-make-web-group + "G" #'gnus-group-read-ephemeral-search-group + "g" #'gnus-group-make-search-group + "M" #'gnus-group-read-ephemeral-group + "r" #'gnus-group-rename-group + "R" #'gnus-group-make-rss-group + "c" #'gnus-group-customize + "z" #'gnus-group-compact-group + "x" #'gnus-group-expunge-group + "\177" #'gnus-group-delete-group + [delete] #'gnus-group-delete-group + + "S" (define-keymap :prefix 'gnus-group-sort-map + "s" #'gnus-group-sort-groups + "a" #'gnus-group-sort-groups-by-alphabet + "u" #'gnus-group-sort-groups-by-unread + "l" #'gnus-group-sort-groups-by-level + "v" #'gnus-group-sort-groups-by-score + "r" #'gnus-group-sort-groups-by-rank + "m" #'gnus-group-sort-groups-by-method + "n" #'gnus-group-sort-groups-by-real-name) + + "P" (define-keymap :prefix 'gnus-group-sort-selected-map + "s" #'gnus-group-sort-selected-groups + "a" #'gnus-group-sort-selected-groups-by-alphabet + "u" #'gnus-group-sort-selected-groups-by-unread + "l" #'gnus-group-sort-selected-groups-by-level + "v" #'gnus-group-sort-selected-groups-by-score + "r" #'gnus-group-sort-selected-groups-by-rank + "m" #'gnus-group-sort-selected-groups-by-method + "n" #'gnus-group-sort-selected-groups-by-real-name)) + + "A" (define-keymap :prefix 'gnus-group-list-map + "k" #'gnus-group-list-killed + "z" #'gnus-group-list-zombies + "s" #'gnus-group-list-groups + "u" #'gnus-group-list-all-groups + "A" #'gnus-group-list-active + "a" #'gnus-group-apropos + "d" #'gnus-group-description-apropos + "m" #'gnus-group-list-matching + "M" #'gnus-group-list-all-matching + "l" #'gnus-group-list-level + "c" #'gnus-group-list-cached + "?" #'gnus-group-list-dormant + "!" #'gnus-group-list-ticked + + "/" (define-keymap :prefix 'gnus-group-list-limit-map + "k" #'gnus-group-list-limit + "z" #'gnus-group-list-limit + "s" #'gnus-group-list-limit + "u" #'gnus-group-list-limit + "A" #'gnus-group-list-limit + "m" #'gnus-group-list-limit + "M" #'gnus-group-list-limit + "l" #'gnus-group-list-limit + "c" #'gnus-group-list-limit + "?" #'gnus-group-list-limit + "!" #'gnus-group-list-limit) + + "f" (define-keymap :prefix 'gnus-group-list-flush-map + "k" #'gnus-group-list-flush + "z" #'gnus-group-list-flush + "s" #'gnus-group-list-flush + "u" #'gnus-group-list-flush + "A" #'gnus-group-list-flush + "m" #'gnus-group-list-flush + "M" #'gnus-group-list-flush + "l" #'gnus-group-list-flush + "c" #'gnus-group-list-flush + "?" #'gnus-group-list-flush + "!" #'gnus-group-list-flush) + + "p" (define-keymap :prefix 'gnus-group-list-plus-map + "k" #'gnus-group-list-plus + "z" #'gnus-group-list-plus + "s" #'gnus-group-list-plus + "u" #'gnus-group-list-plus + "A" #'gnus-group-list-plus + "m" #'gnus-group-list-plus + "M" #'gnus-group-list-plus + "l" #'gnus-group-list-plus + "c" #'gnus-group-list-plus + "?" #'gnus-group-list-plus + "!" #'gnus-group-list-plus)) + + "W" (define-keymap :prefix 'gnus-group-score-map + "f" #'gnus-score-flush-cache + "e" #'gnus-score-edit-all-score) + + "H" (define-keymap :prefix 'gnus-group-help-map + "d" #'gnus-group-describe-group + "v" #'gnus-version) + + "S" (define-keymap :prefix 'gnus-group-sub-map + "l" #'gnus-group-set-current-level + "t" #'gnus-group-toggle-subscription-at-point + "s" #'gnus-group-toggle-subscription + "k" #'gnus-group-kill-group + "y" #'gnus-group-yank-group + "w" #'gnus-group-kill-region + "\C-k" #'gnus-group-kill-level + "z" #'gnus-group-kill-all-zombies)) (defun gnus-topic-mode-p () "Return non-nil in `gnus-topic-mode'." diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index be62bfd81f5..c1815d3486c 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -71,21 +71,17 @@ fit these criteria." :group 'gnus-art :type 'float) -(defvar gnus-html-image-map - (let ((map (make-sparse-keymap))) - (define-key map "u" 'gnus-article-copy-string) - (define-key map "i" 'gnus-html-insert-image) - (define-key map "v" 'gnus-html-browse-url) - map)) - -(defvar gnus-html-displayed-image-map - (let ((map (make-sparse-keymap))) - (define-key map "a" 'gnus-html-show-alt-text) - (define-key map "i" 'gnus-html-browse-image) - (define-key map "\r" 'gnus-html-browse-url) - (define-key map "u" 'gnus-article-copy-string) - (define-key map [tab] 'button-forward) - map)) +(defvar-keymap gnus-html-image-map + "u" #'gnus-article-copy-string + "i" #'gnus-html-insert-image + "v" #'gnus-html-browse-url) + +(defvar-keymap gnus-html-displayed-image-map + "a" #'gnus-html-show-alt-text + "i" #'gnus-html-browse-image + "\r" #'gnus-html-browse-url + "u" #'gnus-article-copy-string + [tab] #'forward-button) (defun gnus-html-encode-url (url) "Encode URL." diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index b6e5e7f786a..81e46d7a51e 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -194,7 +194,11 @@ (caddr event)))) (cl-labels - ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) + ((attendee-role (prop) + ;; RFC5546: default ROLE is REQ-PARTICIPANT + (and prop + (or (plist-get (cadr prop) 'ROLE) + "REQ-PARTICIPANT"))) (attendee-name (prop) (or (plist-get (cadr prop) 'CN) @@ -225,7 +229,10 @@ (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) (attendee-names (gnus-icalendar-event--get-attendee-names ical)) - (role (plist-get (cadr attendee) 'ROLE)) + ;; RFC5546: default ROLE is REQ-PARTICIPANT + (role (and attendee + (or (plist-get (cadr attendee) 'ROLE) + "REQ-PARTICIPANT"))) (participation-type (pcase role ("REQ-PARTICIPANT" 'required) ("OPT-PARTICIPANT" 'optional) @@ -345,10 +352,16 @@ status will be retrieved from the first matching attendee record." (mapc #'process-event-line (split-string ical-request "\n")) + ;; RFC5546 refers to uninvited attendees as "party crashers". + ;; This situation is common if the invitation is sent to a group + ;; of people via a mailing list. (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) reply-event-lines) (lwarn 'gnus-icalendar :warning - "Could not find an event attendee matching given identity")) + "Could not find an event attendee matching given identity") + (push (format "ATTENDEE;RSVP=TRUE;PARTSTAT=%s;CN=%s:MAILTO:%s" + attendee-status user-full-name user-mail-address) + reply-event-lines)) (mapconcat #'identity `("BEGIN:VEVENT" ,@(nreverse reply-event-lines) @@ -847,10 +860,14 @@ These will be used to retrieve the RSVP information from ical events." button t gnus-data ,data)))) -(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) +(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject organizer) (let ((message-signature nil)) (with-current-buffer gnus-summary-buffer (gnus-summary-reply) + ;; Reply to the organizer, not to whoever sent the invitation. person + ;; Some calendar systems use specific email address as organizer to + ;; receive these responses. + (message-replace-header "To" organizer) (message-goto-body) (mml-insert-multipart "alternative") (mml-insert-empty-tag 'part 'type "text/plain") @@ -866,7 +883,8 @@ These will be used to retrieve the RSVP information from ical events." (event (caddr data)) (reply (gnus-icalendar-with-decoded-handle handle (gnus-icalendar-event-reply-from-buffer - (current-buffer) status (gnus-icalendar-identities))))) + (current-buffer) status (gnus-icalendar-identities)))) + (organizer (gnus-icalendar-event:organizer event))) (when reply (cl-labels @@ -883,7 +901,7 @@ These will be used to retrieve the RSVP information from ical events." (delete-region (point-min) (point-max)) (insert reply) (fold-icalendar-buffer) - (gnus-icalendar-send-buffer-by-mail (buffer-name) subject)) + (gnus-icalendar-send-buffer-by-mail (buffer-name) subject organizer)) ;; Back in article buffer (setq-local gnus-icalendar-reply-status status) @@ -897,10 +915,16 @@ These will be used to retrieve the RSVP information from ical events." (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) (cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) - (when (gnus-icalendar-event:rsvp event) - `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) - ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) - ("Decline" gnus-icalendar-reply (,handle declined ,event))))) + (let ((accept-btn "Accept") + (tentative-btn "Tentative") + (decline-btn "Decline")) + (unless (gnus-icalendar-event:rsvp event) + (setq accept-btn "Uninvited Accept" + tentative-btn "Uninvited Tentative" + decline-btn "Uninvited Decline")) + `((,accept-btn gnus-icalendar-reply (,handle accepted ,event)) + (,tentative-btn gnus-icalendar-reply (,handle tentative ,event)) + (,decline-btn gnus-icalendar-reply (,handle declined ,event))))) (cl-defmethod gnus-icalendar-event:inline-reply-buttons ((_event gnus-icalendar-event-reply) _handle) "No buttons for REPLY events." @@ -1038,13 +1062,14 @@ These will be used to retrieve the RSVP information from ical events." (add-to-list 'mm-automatic-display "text/calendar") (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) - (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map) - "a" gnus-icalendar-reply-accept - "t" gnus-icalendar-reply-tentative - "d" gnus-icalendar-reply-decline - "c" gnus-icalendar-event-check-agenda - "e" gnus-icalendar-event-export - "s" gnus-icalendar-event-show) + (define-key gnus-summary-mode-map "i" + (define-keymap :prefix 'gnus-summary-calendar-map + "a" #'gnus-icalendar-reply-accept + "t" #'gnus-icalendar-reply-tentative + "d" #'gnus-icalendar-reply-decline + "c" #'gnus-icalendar-event-check-agenda + "e" #'gnus-icalendar-event-export + "s" #'gnus-icalendar-event-show)) (require 'gnus-art) (add-to-list 'gnus-mime-action-alist diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 525823e72ce..7e589c54e97 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -66,18 +66,15 @@ of time." ;;; Gnus Kill File Mode ;;; -(defvar gnus-kill-file-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map emacs-lisp-mode-map) - (gnus-define-keymap map - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit) - map)) +(defvar-keymap gnus-kill-file-mode-map + :parent emacs-lisp-mode-map + "\C-c\C-k\C-s" #'gnus-kill-file-kill-by-subject + "\C-c\C-k\C-a" #'gnus-kill-file-kill-by-author + "\C-c\C-k\C-t" #'gnus-kill-file-kill-by-thread + "\C-c\C-k\C-x" #'gnus-kill-file-kill-by-xref + "\C-c\C-a" #'gnus-kill-file-apply-buffer + "\C-c\C-e" #'gnus-kill-file-apply-last-sexp + "\C-c\C-c" #'gnus-kill-file-exit) (define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill" "Major mode for editing kill files. diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index ee3abf2f7be..bf33194cf75 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -31,16 +31,13 @@ ;;; Mailing list minor mode -(defvar gnus-mailing-list-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "\C-c\C-nh" gnus-mailing-list-help - "\C-c\C-ns" gnus-mailing-list-subscribe - "\C-c\C-nu" gnus-mailing-list-unsubscribe - "\C-c\C-np" gnus-mailing-list-post - "\C-c\C-no" gnus-mailing-list-owner - "\C-c\C-na" gnus-mailing-list-archive) - map)) +(defvar-keymap gnus-mailing-list-mode-map + "\C-c\C-nh" #'gnus-mailing-list-help + "\C-c\C-ns" #'gnus-mailing-list-subscribe + "\C-c\C-nu" #'gnus-mailing-list-unsubscribe + "\C-c\C-np" #'gnus-mailing-list-post + "\C-c\C-no" #'gnus-mailing-list-owner + "\C-c\C-na" #'gnus-mailing-list-archive) (defvar gnus-mailing-list-menu) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 8a3272042f3..e88aa8f7d09 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -349,39 +349,39 @@ only affect the Gcc copy, but not the original message." ;;; Gnus Posting Functions ;;; -(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) - "p" gnus-summary-post-news - "i" gnus-summary-news-other-window - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "c" gnus-summary-cancel-article - "s" gnus-summary-supersede-article - "r" gnus-summary-reply - "y" gnus-summary-yank-message - "R" gnus-summary-reply-with-original - "L" gnus-summary-reply-to-list-with-original - "w" gnus-summary-wide-reply - "W" gnus-summary-wide-reply-with-original - "v" gnus-summary-very-wide-reply - "V" gnus-summary-very-wide-reply-with-original - "n" gnus-summary-followup-to-mail - "N" gnus-summary-followup-to-mail-with-original - "m" gnus-summary-mail-other-window - "u" gnus-uu-post-news - "A" gnus-summary-attach-article - "\M-c" gnus-summary-mail-crosspost-complaint - "Br" gnus-summary-reply-broken-reply-to - "BR" gnus-summary-reply-broken-reply-to-with-original - "om" gnus-summary-mail-forward - "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) - -(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) - "b" gnus-summary-resend-bounced-mail - ;; "c" gnus-summary-send-draft - "r" gnus-summary-resend-message - "e" gnus-summary-resend-message-edit) +(define-keymap :prefix 'gnus-summary-send-map + "p" #'gnus-summary-post-news + "i" #'gnus-summary-news-other-window + "f" #'gnus-summary-followup + "F" #'gnus-summary-followup-with-original + "c" #'gnus-summary-cancel-article + "s" #'gnus-summary-supersede-article + "r" #'gnus-summary-reply + "y" #'gnus-summary-yank-message + "R" #'gnus-summary-reply-with-original + "L" #'gnus-summary-reply-to-list-with-original + "w" #'gnus-summary-wide-reply + "W" #'gnus-summary-wide-reply-with-original + "v" #'gnus-summary-very-wide-reply + "V" #'gnus-summary-very-wide-reply-with-original + "n" #'gnus-summary-followup-to-mail + "N" #'gnus-summary-followup-to-mail-with-original + "m" #'gnus-summary-mail-other-window + "u" #'gnus-uu-post-news + "A" #'gnus-summary-attach-article + "\M-c" #'gnus-summary-mail-crosspost-complaint + "Br" #'gnus-summary-reply-broken-reply-to + "BR" #'gnus-summary-reply-broken-reply-to-with-original + "om" #'gnus-summary-mail-forward + "op" #'gnus-summary-post-forward + "Om" #'gnus-uu-digest-mail-forward + "Op" #'gnus-uu-digest-post-forward + + "D" (define-keymap :prefix 'gnus-send-bounce-map + "b" #'gnus-summary-resend-bounced-mail + ;; "c" gnus-summary-send-draft + "r" #'gnus-summary-resend-message + "e" #'gnus-summary-resend-message-edit)) ;;; Internal functions. diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 9b76f983227..8ce88dc81e4 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -990,9 +990,9 @@ Uses `gnus-registry-marks' to find what shortcuts to install." gnus-registry-misc-menus) (gnus-message 9 "Defined mark handling function %s" function-name)))))) - (gnus-define-keys-1 - '(gnus-registry-mark-map "M" gnus-summary-mark-map) - keys-plist) + (define-key gnus-summary-mark-map "M" + (apply #'define-keymap :prefix 'gnus-summary-mark-map + keys-plist)) (add-hook 'gnus-summary-menu-hook (lambda () (easy-menu-add-item @@ -1142,7 +1142,7 @@ non-nil." entry) (while (car-safe old) (cl-incf count) - ;; don't use progress reporters for backwards compatibility + ;; todo: use progress reporters. (when (and (< 0 expected) (= 0 (mod count 100))) (message "importing: %d of %d (%.2f%%)" diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index dc81dfc5f6c..8ffe4a4c573 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -64,15 +64,12 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;;; Internal variables. -(defvar gnus-pick-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - " " gnus-pick-next-page - "u" gnus-pick-unmark-article-or-thread - "." gnus-pick-article-or-thread - [down-mouse-2] gnus-pick-mouse-pick-region - "\r" gnus-pick-start-reading) - map)) +(defvar-keymap gnus-pick-mode-map + " " #'gnus-pick-next-page + "u" #'gnus-pick-unmark-article-or-thread + "." #'gnus-pick-article-or-thread + [down-mouse-2] #'gnus-pick-mouse-pick-region + "\r" #'gnus-pick-start-reading) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) @@ -315,11 +312,8 @@ This must be bound to a button-down mouse event." (defvar gnus-binary-mode-hook nil "Hook run in summary binary mode buffers.") -(defvar gnus-binary-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "g" gnus-binary-show-article) - map)) +(defvar-keymap gnus-binary-mode-map + "g" #'gnus-binary-show-article) (defun gnus-binary-make-menu-bar () (unless (boundp 'gnus-binary-menu) @@ -424,21 +418,17 @@ Two predefined functions are available: (defvar gnus-tree-displayed-thread nil) (defvar gnus-tree-inhibit nil) -(defvar gnus-tree-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (gnus-define-keys - map - "\r" gnus-tree-select-article - [mouse-2] gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary - - "\C-c\C-i" gnus-info-find-node) - - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys map) - map)) +(defvar-keymap gnus-tree-mode-map + :full t :suppress t + "\r" #'gnus-tree-select-article + [mouse-2] #'gnus-tree-pick-article + "\C-?" #'gnus-tree-read-summary-keys + "h" #'gnus-tree-show-summary + + "\C-c\C-i" #'gnus-info-find-node) + +(substitute-key-definition 'undefined #'gnus-tree-read-summary-keys + gnus-tree-mode-map) (defun gnus-tree-make-menu-bar () (unless (boundp 'gnus-tree-menu) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index e0ad9f698d3..2ca25802957 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -502,19 +502,20 @@ of the last successful match.") ;;; Summary mode score maps. -(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map) - "s" gnus-summary-set-score - "S" gnus-summary-current-score - "c" gnus-score-change-score-file - "C" gnus-score-customize - "m" gnus-score-set-mark-below - "x" gnus-score-set-expunge-below - "R" gnus-summary-rescore - "e" gnus-score-edit-current-scores - "f" gnus-score-edit-file - "F" gnus-score-flush-cache - "t" gnus-score-find-trace - "w" gnus-score-find-favorite-words) +(define-key gnus-summary-mode-map "V" + (define-keymap :prefix 'gnus-summary-score-map + "s" #'gnus-summary-set-score + "S" #'gnus-summary-current-score + "c" #'gnus-score-change-score-file + "C" #'gnus-score-customize + "m" #'gnus-score-set-mark-below + "x" #'gnus-score-set-expunge-below + "R" #'gnus-summary-rescore + "e" #'gnus-score-edit-current-scores + "f" #'gnus-score-edit-file + "F" #'gnus-score-flush-cache + "t" #'gnus-score-find-trace + "w" #'gnus-score-find-favorite-words)) ;; Summary score file commands diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 9c83d5fa376..31573588046 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1084,7 +1084,8 @@ Responsible for handling and, or, and parenthetical expressions.") Currently takes into account support for the LITERAL+ capability. Other capabilities could be tested here." (with-slots (literal-plus) engine - (when literal-plus + (when (and literal-plus + (string-match-p "\n" query)) (setq query (split-string query "\n"))) (cond ((consp query) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 5f2fc463330..f2ffb067b8e 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -103,7 +103,43 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-mode-line-format-spec nil) (defvar gnus-server-killed-servers nil) -(defvar gnus-server-mode-map nil) +(defvar-keymap gnus-server-mode-map + :full t :suppress t + " " #'gnus-server-read-server-in-server-buffer + "\r" #'gnus-server-read-server + [mouse-2] #'gnus-server-pick-server + "q" #'gnus-server-exit + "l" #'gnus-server-list-servers + "k" #'gnus-server-kill-server + "y" #'gnus-server-yank-server + "c" #'gnus-server-copy-server + "a" #'gnus-server-add-server + "e" #'gnus-server-edit-server + "S" #'gnus-server-show-server + "s" #'gnus-server-scan-server + + "O" #'gnus-server-open-server + "\M-o" #'gnus-server-open-all-servers + "C" #'gnus-server-close-server + "\M-c" #'gnus-server-close-all-servers + "D" #'gnus-server-deny-server + "L" #'gnus-server-offline-server + "R" #'gnus-server-remove-denials + + "n" #'next-line + "p" #'previous-line + + "g" #'gnus-server-regenerate-server + + "G" #'gnus-group-read-ephemeral-search-group + + "z" #'gnus-server-compact-server + + "i" #'gnus-server-toggle-cloud-server + "I" #'gnus-server-set-cloud-method-server + + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug) (defcustom gnus-server-menu-hook nil "Hook run after the creation of the server mode menu." @@ -145,47 +181,6 @@ If nil, a faster, but more primitive, buffer is used instead." (gnus-run-hooks 'gnus-server-menu-hook))) -(unless gnus-server-mode-map - (setq gnus-server-mode-map (make-keymap)) - (suppress-keymap gnus-server-mode-map) - - (gnus-define-keys gnus-server-mode-map - " " gnus-server-read-server-in-server-buffer - "\r" gnus-server-read-server - [mouse-2] gnus-server-pick-server - "q" gnus-server-exit - "l" gnus-server-list-servers - "k" gnus-server-kill-server - "y" gnus-server-yank-server - "c" gnus-server-copy-server - "a" gnus-server-add-server - "e" gnus-server-edit-server - "S" gnus-server-show-server - "s" gnus-server-scan-server - - "O" gnus-server-open-server - "\M-o" gnus-server-open-all-servers - "C" gnus-server-close-server - "\M-c" gnus-server-close-all-servers - "D" gnus-server-deny-server - "L" gnus-server-offline-server - "R" gnus-server-remove-denials - - "n" next-line - "p" previous-line - - "g" gnus-server-regenerate-server - - "G" gnus-group-read-ephemeral-search-group - - "z" gnus-server-compact-server - - "i" gnus-server-toggle-cloud-server - "I" gnus-server-set-cloud-method-server - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - (defface gnus-server-agent '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t)) (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) @@ -697,37 +692,31 @@ claim them." function (repeat function))) -(defvar gnus-browse-mode-map nil) - -(unless gnus-browse-mode-map - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - - (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - [delete] gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-toggle-subscription-at-point - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "d" gnus-browse-describe-group - [delete] gnus-browse-delete-group - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) +(defvar-keymap gnus-browse-mode-map + :full t :suppress t + " " #'gnus-browse-read-group + "=" #'gnus-browse-select-group + "n" #'gnus-browse-next-group + "p" #'gnus-browse-prev-group + "\177" #'gnus-browse-prev-group + [delete] #'gnus-browse-prev-group + "N" #'gnus-browse-next-group + "P" #'gnus-browse-prev-group + "\M-n" #'gnus-browse-next-group + "\M-p" #'gnus-browse-prev-group + "\r" #'gnus-browse-select-group + "u" #'gnus-browse-toggle-subscription-at-point + "l" #'gnus-browse-exit + "L" #'gnus-browse-exit + "q" #'gnus-browse-exit + "Q" #'gnus-browse-exit + "d" #'gnus-browse-describe-group + [delete] #'gnus-browse-delete-group + "\C-c\C-c" #'gnus-browse-exit + "?" #'gnus-browse-describe-briefly + + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug) (defun gnus-browse-make-menu-bar () (gnus-turn-off-edit-menu 'browse) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index c7be958edd1..606bd3a39a4 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -663,6 +663,7 @@ the first newsgroup." (defvar mail-sources) (defvar nnmail-scan-directory-mail-source-once) (defvar nnmail-split-history) +(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-close-all-servers () "Close all servers." @@ -707,6 +708,7 @@ the first newsgroup." gnus-current-select-method nil nnmail-split-history nil gnus-extended-servers nil + gnus-save-newsrc-file-last-timestamp nil gnus-ephemeral-servers nil) (gnus-shutdown 'gnus) ;; Kill the startup file. @@ -2731,7 +2733,6 @@ The form should return either t or nil." 'msdos-long-file-names (lambda () t)))) -(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file. Use the group string names in `gnus-group-list' to pull info diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d790655aa90..3beeace8979 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1907,485 +1907,483 @@ increase the score of each group you read." ;; Non-orthogonal keys -(gnus-define-keys gnus-summary-mode-map - " " gnus-summary-next-page - [?\S-\ ] gnus-summary-prev-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\M-\C-n" gnus-summary-next-same-subject - "\M-\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "." gnus-summary-first-unread-article - "," gnus-summary-best-unread-article - "[" gnus-summary-prev-unseen-article - "]" gnus-summary-next-unseen-article - "\M-s\M-s" gnus-summary-search-article-forward - "\M-s\M-r" gnus-summary-search-article-backward - "\M-r" gnus-summary-search-article-backward - "\M-S" gnus-summary-repeat-search-article-forward - "\M-R" gnus-summary-repeat-search-article-backward - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "j" gnus-summary-goto-article - "^" gnus-summary-refer-parent-article - "\M-^" gnus-summary-refer-article - "u" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "U" gnus-summary-tick-article-backward - "d" gnus-summary-mark-as-read-forward - "D" gnus-summary-mark-as-read-backward - "E" gnus-summary-mark-as-expirable - "\M-u" gnus-summary-clear-mark-forward - "\M-U" gnus-summary-clear-mark-backward - "k" gnus-summary-kill-same-subject-and-select - "\C-k" gnus-summary-kill-same-subject - "\M-\C-k" gnus-summary-kill-thread - "\M-\C-l" gnus-summary-lower-thread - "e" gnus-summary-edit-article - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "\M-\C-t" gnus-summary-toggle-threads - "\M-\C-s" gnus-summary-show-thread - "\M-\C-h" gnus-summary-hide-thread - "\M-\C-f" gnus-summary-next-thread - "\M-\C-b" gnus-summary-prev-thread - [(meta down)] gnus-summary-next-thread - [(meta up)] gnus-summary-prev-thread - "\M-\C-u" gnus-summary-up-thread - "\M-\C-d" gnus-summary-down-thread - "&" gnus-summary-execute-command - "c" gnus-summary-catchup-and-exit - "\C-w" gnus-summary-mark-region-as-read - "\C-t" toggle-truncate-lines - "?" gnus-summary-mark-as-dormant - "\C-c\M-\C-s" gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" gnus-summary-sort-by-number - "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number - "\C-c\C-s\C-l" gnus-summary-sort-by-lines - "\C-c\C-s\C-c" gnus-summary-sort-by-chars - "\C-c\C-s\C-m\C-m" gnus-summary-sort-by-marks - "\C-c\C-s\C-a" gnus-summary-sort-by-author - "\C-c\C-s\C-t" gnus-summary-sort-by-recipient - "\C-c\C-s\C-s" gnus-summary-sort-by-subject - "\C-c\C-s\C-d" gnus-summary-sort-by-date - "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date - "\C-c\C-s\C-i" gnus-summary-sort-by-score - "\C-c\C-s\C-o" gnus-summary-sort-by-original - "\C-c\C-s\C-r" gnus-summary-sort-by-random - "\C-c\C-s\C-u" gnus-summary-sort-by-newsgroups - "\C-c\C-s\C-x" gnus-summary-sort-by-extra - "=" gnus-summary-expand-window - "\C-x\C-s" gnus-summary-reselect-current-group - "\M-g" gnus-summary-rescan-group - "\C-c\C-r" gnus-summary-caesar-message - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "C" gnus-summary-cancel-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "\C-c\C-f" gnus-summary-mail-forward - "o" gnus-summary-save-article - "\C-o" gnus-summary-save-article-mail - "|" gnus-summary-pipe-output - "\M-k" gnus-summary-edit-local-kill - "\M-K" gnus-summary-edit-global-kill +(define-keymap :keymap gnus-summary-mode-map + " " #'gnus-summary-next-page + [?\S-\ ] #'gnus-summary-prev-page + "\177" #'gnus-summary-prev-page + [delete] #'gnus-summary-prev-page + "\r" #'gnus-summary-scroll-up + "\M-\r" #'gnus-summary-scroll-down + "n" #'gnus-summary-next-unread-article + "p" #'gnus-summary-prev-unread-article + "N" #'gnus-summary-next-article + "P" #'gnus-summary-prev-article + "\M-\C-n" #'gnus-summary-next-same-subject + "\M-\C-p" #'gnus-summary-prev-same-subject + "\M-n" #'gnus-summary-next-unread-subject + "\M-p" #'gnus-summary-prev-unread-subject + "." #'gnus-summary-first-unread-article + "," #'gnus-summary-best-unread-article + "[" #'gnus-summary-prev-unseen-article + "]" #'gnus-summary-next-unseen-article + "\M-s\M-s" #'gnus-summary-search-article-forward + "\M-s\M-r" #'gnus-summary-search-article-backward + "\M-r" #'gnus-summary-search-article-backward + "\M-S" #'gnus-summary-repeat-search-article-forward + "\M-R" #'gnus-summary-repeat-search-article-backward + "<" #'gnus-summary-beginning-of-article + ">" #'gnus-summary-end-of-article + "j" #'gnus-summary-goto-article + "^" #'gnus-summary-refer-parent-article + "\M-^" #'gnus-summary-refer-article + "u" #'gnus-summary-tick-article-forward + "!" #'gnus-summary-tick-article-forward + "U" #'gnus-summary-tick-article-backward + "d" #'gnus-summary-mark-as-read-forward + "D" #'gnus-summary-mark-as-read-backward + "E" #'gnus-summary-mark-as-expirable + "\M-u" #'gnus-summary-clear-mark-forward + "\M-U" #'gnus-summary-clear-mark-backward + "k" #'gnus-summary-kill-same-subject-and-select + "\C-k" #'gnus-summary-kill-same-subject + "\M-\C-k" #'gnus-summary-kill-thread + "\M-\C-l" #'gnus-summary-lower-thread + "e" #'gnus-summary-edit-article + "#" #'gnus-summary-mark-as-processable + "\M-#" #'gnus-summary-unmark-as-processable + "\M-\C-t" #'gnus-summary-toggle-threads + "\M-\C-s" #'gnus-summary-show-thread + "\M-\C-h" #'gnus-summary-hide-thread + "\M-\C-f" #'gnus-summary-next-thread + "\M-\C-b" #'gnus-summary-prev-thread + [(meta down)] #'gnus-summary-next-thread + [(meta up)] #'gnus-summary-prev-thread + "\M-\C-u" #'gnus-summary-up-thread + "\M-\C-d" #'gnus-summary-down-thread + "&" #'gnus-summary-execute-command + "c" #'gnus-summary-catchup-and-exit + "\C-w" #'gnus-summary-mark-region-as-read + "\C-t" #'toggle-truncate-lines + "?" #'gnus-summary-mark-as-dormant + "\C-c\M-\C-s" #'gnus-summary-limit-include-expunged + "\C-c\C-s\C-n" #'gnus-summary-sort-by-number + "\C-c\C-s\C-m\C-n" #'gnus-summary-sort-by-most-recent-number + "\C-c\C-s\C-l" #'gnus-summary-sort-by-lines + "\C-c\C-s\C-c" #'gnus-summary-sort-by-chars + "\C-c\C-s\C-m\C-m" #'gnus-summary-sort-by-marks + "\C-c\C-s\C-a" #'gnus-summary-sort-by-author + "\C-c\C-s\C-t" #'gnus-summary-sort-by-recipient + "\C-c\C-s\C-s" #'gnus-summary-sort-by-subject + "\C-c\C-s\C-d" #'gnus-summary-sort-by-date + "\C-c\C-s\C-m\C-d" #'gnus-summary-sort-by-most-recent-date + "\C-c\C-s\C-i" #'gnus-summary-sort-by-score + "\C-c\C-s\C-o" #'gnus-summary-sort-by-original + "\C-c\C-s\C-r" #'gnus-summary-sort-by-random + "\C-c\C-s\C-u" #'gnus-summary-sort-by-newsgroups + "\C-c\C-s\C-x" #'gnus-summary-sort-by-extra + "=" #'gnus-summary-expand-window + "\C-x\C-s" #'gnus-summary-reselect-current-group + "\M-g" #'gnus-summary-rescan-group + "\C-c\C-r" #'gnus-summary-caesar-message + "f" #'gnus-summary-followup + "F" #'gnus-summary-followup-with-original + "C" #'gnus-summary-cancel-article + "r" #'gnus-summary-reply + "R" #'gnus-summary-reply-with-original + "\C-c\C-f" #'gnus-summary-mail-forward + "o" #'gnus-summary-save-article + "\C-o" #'gnus-summary-save-article-mail + "|" #'gnus-summary-pipe-output + "\M-k" #'gnus-summary-edit-local-kill + "\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 - [mouse-2] gnus-mouse-pick-article - [follow-link] mouse-face - "m" gnus-summary-mail-other-window - "a" gnus-summary-post-news - "x" gnus-summary-limit-to-unread - "s" gnus-summary-isearch-article - "\t" gnus-summary-button-forward - [backtab] gnus-summary-button-backward - "w" gnus-summary-browse-url - "t" gnus-summary-toggle-header - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\M-\C-d" gnus-summary-read-document - "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-a" gnus-summary-customize-parameters - "\C-c\C-b" gnus-bug - "*" gnus-cache-enter-article - "\M-*" gnus-cache-remove-article - "\M-&" gnus-summary-universal-argument - "\C-l" gnus-recenter - "I" gnus-summary-increase-score - "L" gnus-summary-lower-score - "\M-i" gnus-symbolic-argument - "h" gnus-summary-select-article-buffer - - "b" gnus-article-view-part - "\M-t" gnus-summary-toggle-display-buttonized - - "V" gnus-summary-score-map - "X" gnus-uu-extract-map - "S" gnus-summary-send-map) - -;; Sort of orthogonal keymap -(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) - "t" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "d" gnus-summary-mark-as-read-forward - "r" gnus-summary-mark-as-read-forward - "c" gnus-summary-clear-mark-forward - " " gnus-summary-clear-mark-forward - "e" gnus-summary-mark-as-expirable - "x" gnus-summary-mark-as-expirable - "?" gnus-summary-mark-as-dormant - "b" gnus-summary-set-bookmark - "B" gnus-summary-remove-bookmark - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "S" gnus-summary-limit-include-expunged - "C" gnus-summary-catchup - "H" gnus-summary-catchup-to-here - "h" gnus-summary-catchup-from-here - "\C-c" gnus-summary-catchup-all - "k" gnus-summary-kill-same-subject-and-select - "K" gnus-summary-kill-same-subject - "P" gnus-uu-mark-map) - -(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) - "c" gnus-summary-clear-above - "u" gnus-summary-tick-above - "m" gnus-summary-mark-above - "k" gnus-summary-kill-below) - -(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) - "/" gnus-summary-limit-to-subject - "n" gnus-summary-limit-to-articles - "b" gnus-summary-limit-to-bodies - "h" gnus-summary-limit-to-headers - "w" gnus-summary-pop-limit - "s" gnus-summary-limit-to-subject - "a" gnus-summary-limit-to-author - "u" gnus-summary-limit-to-unread - "m" gnus-summary-limit-to-marks - "M" gnus-summary-limit-exclude-marks - "v" gnus-summary-limit-to-score - "*" gnus-summary-limit-include-cached - "D" gnus-summary-limit-include-dormant - "T" gnus-summary-limit-include-thread - "d" gnus-summary-limit-exclude-dormant - "t" gnus-summary-limit-to-age - "." gnus-summary-limit-to-unseen - "x" gnus-summary-limit-to-extra - "p" gnus-summary-limit-to-display-predicate - "E" gnus-summary-limit-include-expunged - "c" gnus-summary-limit-exclude-childless-dormant - "C" gnus-summary-limit-mark-excluded-as-read - "o" gnus-summary-insert-old-articles - "N" gnus-summary-insert-new-articles - "S" gnus-summary-limit-to-singletons - "r" gnus-summary-limit-to-replied - "R" gnus-summary-limit-to-recipient - "A" gnus-summary-limit-to-address) - -(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\C-n" gnus-summary-next-same-subject - "\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "f" gnus-summary-first-unread-article - "b" gnus-summary-best-unread-article - "u" gnus-summary-next-unseen-article - "U" gnus-summary-prev-unseen-article - "j" gnus-summary-goto-article - "g" gnus-summary-goto-subject - "l" gnus-summary-goto-last-article - "o" gnus-summary-pop-article) - -(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) - "k" gnus-summary-kill-thread - "E" gnus-summary-expire-thread - "l" gnus-summary-lower-thread - "i" gnus-summary-raise-thread - "T" gnus-summary-toggle-threads - "t" gnus-summary-rethread-current - "^" gnus-summary-reparent-thread - "\M-^" gnus-summary-reparent-children - "s" gnus-summary-show-thread - "S" gnus-summary-show-all-threads - "h" gnus-summary-hide-thread - "H" gnus-summary-hide-all-threads - "n" gnus-summary-next-thread - "p" gnus-summary-prev-thread - "u" gnus-summary-up-thread - "o" gnus-summary-top-thread - "d" gnus-summary-down-thread - "#" gnus-uu-mark-thread - "\M-#" gnus-uu-unmark-thread) - -(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) - "g" gnus-summary-prepare - "c" gnus-summary-insert-cached-articles - "d" gnus-summary-insert-dormant-articles - "t" gnus-summary-insert-ticked-articles) - -(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) - "c" gnus-summary-catchup-and-exit - "C" gnus-summary-catchup-all-and-exit - "E" gnus-summary-exit-no-update - "Q" gnus-summary-exit - "Z" gnus-summary-exit - "n" gnus-summary-catchup-and-goto-next-group - "p" gnus-summary-catchup-and-goto-prev-group - "R" gnus-summary-reselect-current-group - "G" gnus-summary-rescan-group - "N" gnus-summary-next-group - "s" gnus-summary-save-newsrc - "P" gnus-summary-prev-group) - -(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) - " " gnus-summary-next-page - "n" gnus-summary-next-page - [?\S-\ ] gnus-summary-prev-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "p" gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "b" gnus-summary-beginning-of-article - "e" gnus-summary-end-of-article - "^" gnus-summary-refer-parent-article - "r" gnus-summary-refer-parent-article - "C" gnus-summary-show-complete-article - "D" gnus-summary-enter-digest-group - "R" gnus-summary-refer-references - "T" gnus-summary-refer-thread - "W" gnus-warp-to-article - "g" gnus-summary-show-article - "s" gnus-summary-isearch-article - "\t" gnus-summary-button-forward - [backtab] gnus-summary-button-backward - "w" gnus-summary-browse-url - "P" gnus-summary-print-article - "S" gnus-sticky-article - "M" gnus-mailing-list-insinuate - "t" gnus-article-babel) - -(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) - "b" gnus-article-add-buttons - "B" gnus-article-add-buttons-to-head - "o" gnus-article-treat-overstrike - "e" gnus-article-emphasize - "w" gnus-article-fill-cited-article - "Q" gnus-article-fill-long-lines - "L" gnus-article-toggle-truncate-lines - "C" gnus-article-capitalize-sentences - "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable - "6" gnus-article-de-base64-unreadable - "Z" gnus-article-decode-HZ - "A" gnus-article-treat-ansi-sequences - "h" gnus-article-wash-html - "u" gnus-article-unsplit-urls - "s" gnus-summary-force-verify-and-decrypt - "f" gnus-article-display-x-face - "l" gnus-summary-stop-page-breaking - "r" gnus-summary-caesar-message - "m" gnus-summary-morse-message - "t" gnus-summary-toggle-header - "g" gnus-treat-smiley - "v" gnus-summary-verbose-headers - "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive - "p" gnus-article-verify-x-pgp-sig - "d" gnus-article-treat-smartquotes - "U" gnus-article-treat-non-ascii - "i" gnus-summary-idna-message) - -(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) - ;; mnemonic: deuglif*Y* - "u" gnus-article-outlook-unwrap-lines - "a" gnus-article-outlook-repair-attribution - "c" gnus-article-outlook-rearrange-citation - "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify - -(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) - "a" gnus-article-hide - "h" gnus-article-hide-headers - "b" gnus-article-hide-boring-headers - "s" gnus-article-hide-signature - "c" gnus-article-hide-citation - "C" gnus-article-hide-citation-in-followups - "l" gnus-article-hide-list-identifiers - "B" gnus-article-strip-banner - "P" gnus-article-hide-pem - "\C-c" gnus-article-hide-citation-maybe) - -(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) - "a" gnus-article-highlight - "h" gnus-article-highlight-headers - "c" gnus-article-highlight-citation - "s" gnus-article-highlight-signature) - -(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map) - "f" gnus-article-treat-fold-headers - "u" gnus-article-treat-unfold-headers - "n" gnus-article-treat-fold-newsgroups) - -(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map) - "x" gnus-article-display-x-face - "d" gnus-article-display-face - "s" gnus-treat-smiley - "D" gnus-article-remove-images - "W" gnus-article-show-images - "F" gnus-article-toggle-fonts - "f" gnus-treat-from-picon - "m" gnus-treat-mail-picon - "n" gnus-treat-newsgroups-picon - "g" gnus-treat-from-gravatar - "h" gnus-treat-mail-gravatar) - -(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) - "w" gnus-article-decode-mime-words - "c" gnus-article-decode-charset - "h" gnus-mime-buttonize-attachments-in-header - "v" gnus-mime-view-all-parts - "b" gnus-article-view-part) - -(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) - "z" gnus-article-date-ut - "u" gnus-article-date-ut - "l" gnus-article-date-local - "p" gnus-article-date-english - "e" gnus-article-date-lapsed - "o" gnus-article-date-original - "i" gnus-article-date-iso8601 - "s" gnus-article-date-user) - -(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) - "t" gnus-article-remove-trailing-blank-lines - "l" gnus-article-strip-leading-blank-lines - "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines - "A" gnus-article-strip-all-blank-lines - "s" gnus-article-strip-leading-space - "e" gnus-article-strip-trailing-space - "w" gnus-article-remove-leading-whitespace) - -(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) - "v" gnus-version - "d" gnus-summary-describe-group - "h" gnus-summary-describe-briefly - "i" gnus-info-find-node) - -(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) - "e" gnus-summary-expire-articles - "\M-\C-e" gnus-summary-expire-articles-now - "\177" gnus-summary-delete-article - [delete] gnus-summary-delete-article - [backspace] gnus-summary-delete-article - "m" gnus-summary-move-article - "r" gnus-summary-respool-article - "w" gnus-summary-edit-article - "c" gnus-summary-copy-article - "B" gnus-summary-crosspost-article - "q" gnus-summary-respool-query - "t" gnus-summary-respool-trace - "i" gnus-summary-import-article - "I" gnus-summary-create-article - "p" gnus-summary-article-posted-p) - -(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) - "o" gnus-summary-save-article - "m" gnus-summary-save-article-mail - "F" gnus-summary-write-article-file - "r" gnus-summary-save-article-rmail - "f" gnus-summary-save-article-file - "b" gnus-summary-save-article-body-file - "B" gnus-summary-write-article-body-file - "h" gnus-summary-save-article-folder - "v" gnus-summary-save-article-vm - "p" gnus-summary-pipe-output - "P" gnus-summary-muttprint) - -(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) - "b" gnus-summary-display-buttonized - "m" gnus-summary-repair-multipart - "v" gnus-article-view-part - "o" gnus-article-save-part - "O" gnus-article-save-part-and-strip - "r" gnus-article-replace-part - "d" gnus-article-delete-part - "t" gnus-article-view-part-as-type - "j" gnus-article-jump-to-part - "c" gnus-article-copy-part - "C" gnus-article-view-part-as-charset - "e" gnus-article-view-part-externally - "H" gnus-article-browse-html-article - "E" gnus-article-encrypt-body - "i" gnus-article-inline-part - "|" gnus-article-pipe-part) - -(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) - "p" gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "s" gnus-uu-mark-series - "r" gnus-uu-mark-region - "g" gnus-uu-unmark-region - "R" gnus-uu-mark-by-regexp - "G" gnus-uu-unmark-by-regexp - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "a" gnus-uu-mark-all - "b" gnus-uu-mark-buffer - "S" gnus-uu-mark-sparse - "k" gnus-summary-kill-process-mark - "y" gnus-summary-yank-process-mark - "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) - -(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) - ;;"x" gnus-uu-extract-any - "m" gnus-summary-save-parts - "u" gnus-uu-decode-uu - "U" gnus-uu-decode-uu-and-save - "s" gnus-uu-decode-unshar - "S" gnus-uu-decode-unshar-and-save - "o" gnus-uu-decode-save - "O" gnus-uu-decode-save - "b" gnus-uu-decode-binhex - "B" gnus-uu-decode-binhex - "Y" gnus-uu-decode-yenc - "p" gnus-uu-decode-postscript - "P" gnus-uu-decode-postscript-and-save) - -(gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) + "\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 + [mouse-2] #'gnus-mouse-pick-article + [follow-link] 'mouse-face + "m" #'gnus-summary-mail-other-window + "a" #'gnus-summary-post-news + "x" #'gnus-summary-limit-to-unread + "s" #'gnus-summary-isearch-article + "\t" #'gnus-summary-button-forward + [backtab] #'gnus-summary-button-backward + "w" #'gnus-summary-browse-url + "t" #'gnus-summary-toggle-header + "g" #'gnus-summary-show-article + "l" #'gnus-summary-goto-last-article + "\C-c\C-v\C-v" #'gnus-uu-decode-uu-view + "\C-d" #'gnus-summary-enter-digest-group + "\M-\C-d" #'gnus-summary-read-document + "\M-\C-e" #'gnus-summary-edit-parameters + "\M-\C-a" #'gnus-summary-customize-parameters + "\C-c\C-b" #'gnus-bug + "*" #'gnus-cache-enter-article + "\M-*" #'gnus-cache-remove-article + "\M-&" #'gnus-summary-universal-argument + "\C-l" #'gnus-recenter + "I" #'gnus-summary-increase-score + "L" #'gnus-summary-lower-score + "\M-i" #'gnus-symbolic-argument + "h" #'gnus-summary-select-article-buffer + + "b" #'gnus-article-view-part + "\M-t" #'gnus-summary-toggle-display-buttonized + + "S" #'gnus-summary-send-map + + ;; Sort of orthogonal keymaps. + "M" (define-keymap :prefix 'gnus-summary-mark-map + "t" #'gnus-summary-tick-article-forward + "!" #'gnus-summary-tick-article-forward + "d" #'gnus-summary-mark-as-read-forward + "r" #'gnus-summary-mark-as-read-forward + "c" #'gnus-summary-clear-mark-forward + " " #'gnus-summary-clear-mark-forward + "e" #'gnus-summary-mark-as-expirable + "x" #'gnus-summary-mark-as-expirable + "?" #'gnus-summary-mark-as-dormant + "b" #'gnus-summary-set-bookmark + "B" #'gnus-summary-remove-bookmark + "#" #'gnus-summary-mark-as-processable + "\M-#" #'gnus-summary-unmark-as-processable + "S" #'gnus-summary-limit-include-expunged + "C" #'gnus-summary-catchup + "H" #'gnus-summary-catchup-to-here + "h" #'gnus-summary-catchup-from-here + "\C-c" #'gnus-summary-catchup-all + "k" #'gnus-summary-kill-same-subject-and-select + "K" #'gnus-summary-kill-same-subject + + "P" (define-keymap :prefix 'gnus-uu-mark-map + "p" #'gnus-summary-mark-as-processable + "u" #'gnus-summary-unmark-as-processable + "U" #'gnus-summary-unmark-all-processable + "v" #'gnus-uu-mark-over + "s" #'gnus-uu-mark-series + "r" #'gnus-uu-mark-region + "g" #'gnus-uu-unmark-region + "R" #'gnus-uu-mark-by-regexp + "G" #'gnus-uu-unmark-by-regexp + "t" #'gnus-uu-mark-thread + "T" #'gnus-uu-unmark-thread + "a" #'gnus-uu-mark-all + "b" #'gnus-uu-mark-buffer + "S" #'gnus-uu-mark-sparse + "k" #'gnus-summary-kill-process-mark + "y" #'gnus-summary-yank-process-mark + "w" #'gnus-summary-save-process-mark + "i" #'gnus-uu-invert-processable) + + "V" (define-keymap :prefix 'gnus-summary-mscore-map + "c" #'gnus-summary-clear-above + "u" #'gnus-summary-tick-above + "m" #'gnus-summary-mark-above + "k" #'gnus-summary-kill-below)) + + "/" (define-keymap :prefix 'gnus-summary-limit-map + "/" #'gnus-summary-limit-to-subject + "n" #'gnus-summary-limit-to-articles + "b" #'gnus-summary-limit-to-bodies + "h" #'gnus-summary-limit-to-headers + "w" #'gnus-summary-pop-limit + "s" #'gnus-summary-limit-to-subject + "a" #'gnus-summary-limit-to-author + "u" #'gnus-summary-limit-to-unread + "m" #'gnus-summary-limit-to-marks + "M" #'gnus-summary-limit-exclude-marks + "v" #'gnus-summary-limit-to-score + "*" #'gnus-summary-limit-include-cached + "D" #'gnus-summary-limit-include-dormant + "T" #'gnus-summary-limit-include-thread + "d" #'gnus-summary-limit-exclude-dormant + "t" #'gnus-summary-limit-to-age + "." #'gnus-summary-limit-to-unseen + "x" #'gnus-summary-limit-to-extra + "p" #'gnus-summary-limit-to-display-predicate + "E" #'gnus-summary-limit-include-expunged + "c" #'gnus-summary-limit-exclude-childless-dormant + "C" #'gnus-summary-limit-mark-excluded-as-read + "o" #'gnus-summary-insert-old-articles + "N" #'gnus-summary-insert-new-articles + "S" #'gnus-summary-limit-to-singletons + "r" #'gnus-summary-limit-to-replied + "R" #'gnus-summary-limit-to-recipient + "A" #'gnus-summary-limit-to-address) + + "G" (define-keymap :prefix 'gnus-summary-goto-map + "n" #'gnus-summary-next-unread-article + "p" #'gnus-summary-prev-unread-article + "N" #'gnus-summary-next-article + "P" #'gnus-summary-prev-article + "\C-n" #'gnus-summary-next-same-subject + "\C-p" #'gnus-summary-prev-same-subject + "\M-n" #'gnus-summary-next-unread-subject + "\M-p" #'gnus-summary-prev-unread-subject + "f" #'gnus-summary-first-unread-article + "b" #'gnus-summary-best-unread-article + "u" #'gnus-summary-next-unseen-article + "U" #'gnus-summary-prev-unseen-article + "j" #'gnus-summary-goto-article + "g" #'gnus-summary-goto-subject + "l" #'gnus-summary-goto-last-article + "o" #'gnus-summary-pop-article) + + "T" (define-keymap :prefix 'gnus-summary-thread-map + "k" #'gnus-summary-kill-thread + "E" #'gnus-summary-expire-thread + "l" #'gnus-summary-lower-thread + "i" #'gnus-summary-raise-thread + "T" #'gnus-summary-toggle-threads + "t" #'gnus-summary-rethread-current + "^" #'gnus-summary-reparent-thread + "\M-^" #'gnus-summary-reparent-children + "s" #'gnus-summary-show-thread + "S" #'gnus-summary-show-all-threads + "h" #'gnus-summary-hide-thread + "H" #'gnus-summary-hide-all-threads + "n" #'gnus-summary-next-thread + "p" #'gnus-summary-prev-thread + "u" #'gnus-summary-up-thread + "o" #'gnus-summary-top-thread + "d" #'gnus-summary-down-thread + "#" #'gnus-uu-mark-thread + "\M-#" #'gnus-uu-unmark-thread) + + "Y" (define-keymap :prefix 'gnus-summary-buffer-map + "g" #'gnus-summary-prepare + "c" #'gnus-summary-insert-cached-articles + "d" #'gnus-summary-insert-dormant-articles + "t" #'gnus-summary-insert-ticked-articles) + + "Z" (define-keymap :prefix 'gnus-summary-exit-map + "c" #'gnus-summary-catchup-and-exit + "C" #'gnus-summary-catchup-all-and-exit + "E" #'gnus-summary-exit-no-update + "Q" #'gnus-summary-exit + "Z" #'gnus-summary-exit + "n" #'gnus-summary-catchup-and-goto-next-group + "p" #'gnus-summary-catchup-and-goto-prev-group + "R" #'gnus-summary-reselect-current-group + "G" #'gnus-summary-rescan-group + "N" #'gnus-summary-next-group + "s" #'gnus-summary-save-newsrc + "P" #'gnus-summary-prev-group) + + "A" (define-keymap :prefix 'gnus-summary-article-map + " " #'gnus-summary-next-page + "n" #'gnus-summary-next-page + [?\S-\ ] #'gnus-summary-prev-page + "\177" #'gnus-summary-prev-page + [delete] #'gnus-summary-prev-page + "p" #'gnus-summary-prev-page + "\r" #'gnus-summary-scroll-up + "\M-\r" #'gnus-summary-scroll-down + "<" #'gnus-summary-beginning-of-article + ">" #'gnus-summary-end-of-article + "b" #'gnus-summary-beginning-of-article + "e" #'gnus-summary-end-of-article + "^" #'gnus-summary-refer-parent-article + "r" #'gnus-summary-refer-parent-article + "C" #'gnus-summary-show-complete-article + "D" #'gnus-summary-enter-digest-group + "R" #'gnus-summary-refer-references + "T" #'gnus-summary-refer-thread + "W" #'gnus-warp-to-article + "g" #'gnus-summary-show-article + "s" #'gnus-summary-isearch-article + "\t" #'gnus-summary-button-forward + [backtab] #'gnus-summary-button-backward + "w" #'gnus-summary-browse-url + "P" #'gnus-summary-print-article + "S" #'gnus-sticky-article + "M" #'gnus-mailing-list-insinuate + "t" #'gnus-article-babel) + + "W" (define-keymap :prefix 'gnus-summary-wash-map + "b" #'gnus-article-add-buttons + "B" #'gnus-article-add-buttons-to-head + "o" #'gnus-article-treat-overstrike + "e" #'gnus-article-emphasize + "w" #'gnus-article-fill-cited-article + "Q" #'gnus-article-fill-long-lines + "L" #'gnus-article-toggle-truncate-lines + "C" #'gnus-article-capitalize-sentences + "c" #'gnus-article-remove-cr + "q" #'gnus-article-de-quoted-unreadable + "6" #'gnus-article-de-base64-unreadable + "Z" #'gnus-article-decode-HZ + "A" #'gnus-article-treat-ansi-sequences + "h" #'gnus-article-wash-html + "u" #'gnus-article-unsplit-urls + "s" #'gnus-summary-force-verify-and-decrypt + "f" #'gnus-article-display-x-face + "l" #'gnus-summary-stop-page-breaking + "r" #'gnus-summary-caesar-message + "m" #'gnus-summary-morse-message + "t" #'gnus-summary-toggle-header + "g" #'gnus-treat-smiley + "v" #'gnus-summary-verbose-headers + "a" #'gnus-article-strip-headers-in-body ;; mnemonic: wash archive + "p" #'gnus-article-verify-x-pgp-sig + "d" #'gnus-article-treat-smartquotes + "U" #'gnus-article-treat-non-ascii + "i" #'gnus-summary-idna-message + + "Y" (define-keymap :prefix 'gnus-summary-wash-deuglify-map + ;; mnemonic: deuglif*Y* + "u" #'gnus-article-outlook-unwrap-lines + "a" #'gnus-article-outlook-repair-attribution + "c" #'gnus-article-outlook-rearrange-citation + ;; mnemonic: full deuglify + "f" #'gnus-article-outlook-deuglify-article) + + "W" (define-keymap :prefix 'gnus-summary-wash-hide-map + "a" #'gnus-article-hide + "h" #'gnus-article-hide-headers + "b" #'gnus-article-hide-boring-headers + "s" #'gnus-article-hide-signature + "c" #'gnus-article-hide-citation + "C" #'gnus-article-hide-citation-in-followups + "l" #'gnus-article-hide-list-identifiers + "B" #'gnus-article-strip-banner + "P" #'gnus-article-hide-pem + "\C-c" #'gnus-article-hide-citation-maybe) + + "H" (define-keymap :prefix 'gnus-summary-wash-highlight-map + "a" #'gnus-article-highlight + "h" #'gnus-article-highlight-headers + "c" #'gnus-article-highlight-citation + "s" #'gnus-article-highlight-signature) + + "G" (define-keymap :prefix 'gnus-summary-wash-header-map + "f" #'gnus-article-treat-fold-headers + "u" #'gnus-article-treat-unfold-headers + "n" #'gnus-article-treat-fold-newsgroups) + + "D" (define-keymap :prefix 'gnus-summary-wash-display-map + "x" #'gnus-article-display-x-face + "d" #'gnus-article-display-face + "s" #'gnus-treat-smiley + "e" #'gnus-article-emojize-symbols + "D" #'gnus-article-remove-images + "W" #'gnus-article-show-images + "F" #'gnus-article-toggle-fonts + "f" #'gnus-treat-from-picon + "m" #'gnus-treat-mail-picon + "n" #'gnus-treat-newsgroups-picon + "g" #'gnus-treat-from-gravatar + "h" #'gnus-treat-mail-gravatar) + + "M" (define-keymap :prefix 'gnus-summary-wash-mime-map + "w" #'gnus-article-decode-mime-words + "c" #'gnus-article-decode-charset + "h" #'gnus-mime-buttonize-attachments-in-header + "v" #'gnus-mime-view-all-parts + "b" #'gnus-article-view-part) + + "T" (define-keymap :prefix 'gnus-summary-wash-time-map + "z" #'gnus-article-date-ut + "u" #'gnus-article-date-ut + "l" #'gnus-article-date-local + "p" #'gnus-article-date-english + "e" #'gnus-article-date-lapsed + "o" #'gnus-article-date-original + "i" #'gnus-article-date-iso8601 + "s" #'gnus-article-date-user) + + "E" (define-keymap :prefix 'gnus-summary-wash-empty-map + "t" #'gnus-article-remove-trailing-blank-lines + "l" #'gnus-article-strip-leading-blank-lines + "m" #'gnus-article-strip-multiple-blank-lines + "a" #'gnus-article-strip-blank-lines + "A" #'gnus-article-strip-all-blank-lines + "s" #'gnus-article-strip-leading-space + "e" #'gnus-article-strip-trailing-space + "w" #'gnus-article-remove-leading-whitespace)) + + "H" (define-keymap :prefix 'gnus-summary-help-map + "v" #'gnus-version + "d" #'gnus-summary-describe-group + "h" #'gnus-summary-describe-briefly + "i" #'gnus-info-find-node) + + "B" (define-keymap :prefix 'gnus-summary-backend-map + "e" #'gnus-summary-expire-articles + "\M-\C-e" #'gnus-summary-expire-articles-now + "\177" #'gnus-summary-delete-article + [delete] #'gnus-summary-delete-article + [backspace] #'gnus-summary-delete-article + "m" #'gnus-summary-move-article + "r" #'gnus-summary-respool-article + "w" #'gnus-summary-edit-article + "c" #'gnus-summary-copy-article + "B" #'gnus-summary-crosspost-article + "q" #'gnus-summary-respool-query + "t" #'gnus-summary-respool-trace + "i" #'gnus-summary-import-article + "I" #'gnus-summary-create-article + "p" #'gnus-summary-article-posted-p) + + "O" (define-keymap :prefix 'gnus-summary-save-map + "o" #'gnus-summary-save-article + "m" #'gnus-summary-save-article-mail + "F" #'gnus-summary-write-article-file + "r" #'gnus-summary-save-article-rmail + "f" #'gnus-summary-save-article-file + "b" #'gnus-summary-save-article-body-file + "B" #'gnus-summary-write-article-body-file + "h" #'gnus-summary-save-article-folder + "v" #'gnus-summary-save-article-vm + "p" #'gnus-summary-pipe-output + "P" #'gnus-summary-muttprint) + + "K" (define-keymap :prefix 'gnus-summary-mime-map + "b" #'gnus-summary-display-buttonized + "m" #'gnus-summary-repair-multipart + "v" #'gnus-article-view-part + "o" #'gnus-article-save-part + "O" #'gnus-article-save-part-and-strip + "r" #'gnus-article-replace-part + "d" #'gnus-article-delete-part + "t" #'gnus-article-view-part-as-type + "j" #'gnus-article-jump-to-part + "c" #'gnus-article-copy-part + "C" #'gnus-article-view-part-as-charset + "e" #'gnus-article-view-part-externally + "H" #'gnus-article-browse-html-article + "E" #'gnus-article-encrypt-body + "i" #'gnus-article-inline-part + "|" #'gnus-article-pipe-part) + + "X" (define-keymap :prefix 'gnus-uu-extract-map + ;;"x" gnus-uu-extract-any + "m" #'gnus-summary-save-parts + "u" #'gnus-uu-decode-uu + "U" #'gnus-uu-decode-uu-and-save + "s" #'gnus-uu-decode-unshar + "S" #'gnus-uu-decode-unshar-and-save + "o" #'gnus-uu-decode-save + "O" #'gnus-uu-decode-save + "b" #'gnus-uu-decode-binhex + "B" #'gnus-uu-decode-binhex + "Y" #'gnus-uu-decode-yenc + "p" #'gnus-uu-decode-postscript + "P" #'gnus-uu-decode-postscript-and-save + + "v" (define-keymap :prefix 'gnus-uu-extract-view-map + "u" #'gnus-uu-decode-uu-view + "U" #'gnus-uu-decode-uu-and-save-view + "s" #'gnus-uu-decode-unshar-view + "S" #'gnus-uu-decode-unshar-and-save-view + "o" #'gnus-uu-decode-save-view + "O" #'gnus-uu-decode-save-view + "b" #'gnus-uu-decode-binhex-view + "B" #'gnus-uu-decode-binhex-view + "p" #'gnus-uu-decode-postscript-view + "P" #'gnus-uu-decode-postscript-and-save-view))) (defvar gnus-article-post-menu nil) @@ -8067,9 +8065,7 @@ Return nil if there are no unread articles." Return nil if there are no unread articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t)) + (gnus-summary--goto-and-possibly-unhide t) (gnus-summary-position-point))) (defun gnus-summary-next-unseen-article (&optional backward) @@ -8103,23 +8099,27 @@ Return nil if there are no unread articles." Return nil if there are no unseen articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) + (gnus-summary--goto-and-possibly-unhide) (gnus-summary-position-point))) +(defun gnus-summary--goto-and-possibly-unhide (&optional unread undownloaded + unseen) + (let ((first (gnus-summary-first-subject unread undownloaded unseen))) + (if (and first + (not (= first (gnus-summary-article-number)))) + (progn + (gnus-summary-show-thread) + (gnus-summary-first-subject unread undownloaded unseen)) + first))) + (defun gnus-summary-first-unseen-or-unread-subject () "Place the point on the subject line of the first unseen and unread article. If all articles have been seen, on the subject line of the first unread article." (interactive nil gnus-summary-mode) (prog1 - (unless (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t))) + (unless (gnus-summary--goto-and-possibly-unhide nil nil t) + (gnus-summary-first-subject t)) (gnus-summary-position-point))) (defun gnus-summary-first-article () diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index c8bcccdfdde..e78dd1542c8 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1056,63 +1056,56 @@ articles in the topic and its subtopics." ;;; Topic mode, commands and keymap. -(defvar gnus-topic-mode-map nil) -(defvar gnus-group-topic-map nil) - -(unless gnus-topic-mode-map - (setq gnus-topic-mode-map (make-sparse-keymap)) - +(defvar-keymap gnus-topic-mode-map ;; Override certain group mode keys. - (gnus-define-keys gnus-topic-mode-map - "=" gnus-topic-select-group - "\r" gnus-topic-select-group - " " gnus-topic-read-group - "\C-c\C-x" gnus-topic-expire-articles - "c" gnus-topic-catchup-articles - "\C-k" gnus-topic-kill-group - "\C-y" gnus-topic-yank-group - "\M-g" gnus-topic-get-new-news-this-topic - "AT" gnus-topic-list-active - "Gp" gnus-topic-edit-parameters - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - [tab] gnus-topic-indent - [(meta tab)] gnus-topic-unindent - "\C-i" gnus-topic-indent - "\M-\C-i" gnus-topic-unindent - [mouse-2] gnus-mouse-pick-topic) - - ;; Define a new submap. - (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - "n" gnus-topic-create-topic - "m" gnus-topic-move-group - "D" gnus-topic-remove-group - "c" gnus-topic-copy-group - "h" gnus-topic-hide-topic - "s" gnus-topic-show-topic - "j" gnus-topic-jump-to-topic - "M" gnus-topic-move-matching - "C" gnus-topic-copy-matching - "\M-p" gnus-topic-goto-previous-topic - "\M-n" gnus-topic-goto-next-topic - "\C-i" gnus-topic-indent - [tab] gnus-topic-indent - "r" gnus-topic-rename - "\177" gnus-topic-delete - [delete] gnus-topic-delete - "H" gnus-topic-toggle-display-empty-topics) - - (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) - "s" gnus-topic-sort-groups - "a" gnus-topic-sort-groups-by-alphabet - "u" gnus-topic-sort-groups-by-unread - "l" gnus-topic-sort-groups-by-level - "e" gnus-topic-sort-groups-by-server - "v" gnus-topic-sort-groups-by-score - "r" gnus-topic-sort-groups-by-rank - "m" gnus-topic-sort-groups-by-method)) + "=" #'gnus-topic-select-group + "\r" #'gnus-topic-select-group + " " #'gnus-topic-read-group + "\C-c\C-x" #'gnus-topic-expire-articles + "c" #'gnus-topic-catchup-articles + "\C-k" #'gnus-topic-kill-group + "\C-y" #'gnus-topic-yank-group + "\M-g" #'gnus-topic-get-new-news-this-topic + "AT" #'gnus-topic-list-active + "Gp" #'gnus-topic-edit-parameters + "#" #'gnus-topic-mark-topic + "\M-#" #'gnus-topic-unmark-topic + [tab] #'gnus-topic-indent + [(meta tab)] #'gnus-topic-unindent + "\C-i" #'gnus-topic-indent + "\M-\C-i" #'gnus-topic-unindent + [mouse-2] #'gnus-mouse-pick-topic + + "T" (define-keymap :prefix 'gnus-group-topic-map + "#" #'gnus-topic-mark-topic + "\M-#" #'gnus-topic-unmark-topic + "n" #'gnus-topic-create-topic + "m" #'gnus-topic-move-group + "D" #'gnus-topic-remove-group + "c" #'gnus-topic-copy-group + "h" #'gnus-topic-hide-topic + "s" #'gnus-topic-show-topic + "j" #'gnus-topic-jump-to-topic + "M" #'gnus-topic-move-matching + "C" #'gnus-topic-copy-matching + "\M-p" #'gnus-topic-goto-previous-topic + "\M-n" #'gnus-topic-goto-next-topic + "\C-i" #'gnus-topic-indent + [tab] #'gnus-topic-indent + "r" #'gnus-topic-rename + "\177" #'gnus-topic-delete + [delete] #'gnus-topic-delete + "H" #'gnus-topic-toggle-display-empty-topics + + "S" (define-keymap :prefix 'gnus-topic-sort-map + "s" #'gnus-topic-sort-groups + "a" #'gnus-topic-sort-groups-by-alphabet + "u" #'gnus-topic-sort-groups-by-unread + "l" #'gnus-topic-sort-groups-by-level + "e" #'gnus-topic-sort-groups-by-server + "v" #'gnus-topic-sort-groups-by-score + "r" #'gnus-topic-sort-groups-by-rank + "m" #'gnus-topic-sort-groups-by-method))) (defun gnus-topic-make-menu-bar () (unless (boundp 'gnus-topic-menu) diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index 07cf5d495a6..0717a7ccfba 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -75,15 +75,12 @@ ;;; Minor mode definition. -(defvar gnus-undo-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "\M-\C-_" gnus-undo - "\C-_" gnus-undo - "\C-xu" gnus-undo - ;; Many people are used to type `C-/' on GUI frames and get `C-_'. - [(control /)] gnus-undo) - map)) +(defvar-keymap gnus-undo-mode-map + "\M-\C-_" #'gnus-undo + "\C-_" #'gnus-undo + "\C-xu" #'gnus-undo + ;; many people are used to type `C-/' on GUI frames and get `C-_'. + [(control /)] #'gnus-undo) (defun gnus-undo-make-menu-bar () ;; This is disabled for the time being. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index fb285962d6f..a777157f894 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -300,25 +300,26 @@ Symbols are also allowed; their print names are used instead." (defmacro gnus-local-set-keys (&rest plist) "Set the keys in PLIST in the current keymap." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 (current-local-map) ',plist)) (defmacro gnus-define-keys (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 ,(if (symbolp keymap) keymap `',keymap) (quote ,plist))) (defmacro gnus-define-keys-safe (keymap &rest plist) "Define all keys in PLIST in KEYMAP without overwriting previous definitions." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) (defmacro gnus-define-keymap (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 ,keymap (quote ,plist))) (defun gnus-define-keys-1 (keymap plist &optional safe) + (declare (obsolete define-keymap "29.1")) (when (null keymap) (error "Can't set keys in a null keymap")) (cond ((symbolp keymap) (error "First arg should be a keymap object")) @@ -1310,9 +1311,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', initial-input history def) "Call `gnus-completing-read-function'." (funcall gnus-completing-read-function - (concat prompt (when def - (concat " (default " def ")")) - ": ") + (format-prompt prompt def) collection require-match initial-input history def)) (defun gnus-emacs-completing-read (prompt collection &optional require-match diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index f558360361d..9b3181fd4d0 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2537,7 +2537,7 @@ are always t.") ;; Only used in gnus-util, which has an autoload. ("rmailsum" rmail-update-summary) ("gnus-xmas" gnus-xmas-splash) - ("score-mode" :interactive t gnus-score-mode) + ("score-mode" :interactive t gnus-score-mode gnus-score-edit-all-score) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder) @@ -2609,7 +2609,11 @@ are always t.") gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-uu-unmark-thread - gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable) + gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable + gnus-uu-decode-postscript-and-save-view + gnus-uu-decode-postscript-view gnus-uu-decode-postscript-and-save + gnus-uu-decode-yenc gnus-uu-unmark-by-regexp gnus-uu-unmark-region + gnus-uu-decode-postscript) ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) @@ -2656,6 +2660,7 @@ are always t.") gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-remove-cr gnus-article-remove-trailing-blank-lines + gnus-article-emojize-symbols gnus-article-display-x-face gnus-article-de-quoted-unreadable gnus-article-de-base64-unreadable gnus-article-decode-HZ @@ -2667,7 +2672,34 @@ are always t.") gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer - gnus-mime-view-all-parts) + gnus-mime-view-all-parts gnus-article-pipe-part + gnus-article-inline-part gnus-article-encrypt-body + gnus-article-browse-html-article gnus-article-view-part-externally + gnus-article-view-part-as-charset gnus-article-copy-part + gnus-article-jump-to-part gnus-article-view-part-as-type + gnus-article-delete-part gnus-article-replace-part + gnus-article-save-part-and-strip gnus-article-save-part + gnus-article-remove-leading-whitespace gnus-article-strip-trailing-space + gnus-article-strip-leading-space gnus-article-strip-all-blank-lines + gnus-article-strip-blank-lines gnus-article-strip-multiple-blank-lines + gnus-article-date-user gnus-article-date-iso8601 + gnus-article-date-english gnus-article-date-ut + gnus-article-decode-charset gnus-article-decode-mime-words + gnus-article-toggle-fonts gnus-article-show-images + gnus-article-remove-images gnus-article-display-face + gnus-article-treat-fold-newsgroups gnus-article-treat-unfold-headers + gnus-article-treat-fold-headers gnus-article-highlight-signature + gnus-article-highlight-headers gnus-article-highlight + gnus-article-strip-banner gnus-article-hide-list-identifiers + gnus-article-hide gnus-article-outlook-rearrange-citation + gnus-article-treat-non-ascii gnus-article-treat-smartquotes + gnus-article-verify-x-pgp-sig gnus-article-strip-headers-in-body + gnus-treat-smiley gnus-article-treat-ansi-sequences + gnus-article-capitalize-sentences gnus-article-toggle-truncate-lines + gnus-article-fill-long-lines gnus-article-emphasize + gnus-article-add-buttons-to-head gnus-article-add-button + gnus-article-babel gnus-sticky-article gnus-article-view-part + gnus-article-add-buttons) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch @@ -3754,6 +3786,8 @@ just the host name." (setq foreign server group (substring group (+ 1 colon)))) (setq foreign (concat foreign ":"))) + ;; Remove braces from name (common in IMAP groups). + (setq group (replace-regexp-in-string "[][]+" "" group)) ;; Collapse group name leaving LEVELS uncollapsed elements (let* ((slist (split-string group "/")) (slen (length slist)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index bbf1c78a01f..133f8424aea 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2870,84 +2870,78 @@ Consider adding this function to `message-header-setup-hook'" ;;; Set up keymap. -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (make-keymap)) - (set-keymap-parent message-mode-map text-mode-map) - (define-key message-mode-map "\C-c?" #'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from) - (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary) - (define-key message-mode-map "\C-c\C-f\C-i" - #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\C-f\C-a" - #'message-generate-unsubscribed-mail-followup-to) +(defvar-keymap message-mode-map + :full t :parent text-mode-map + :doc "Message Mode keymap." + "\C-c?" #'describe-mode + + "\C-c\C-f\C-t" #'message-goto-to + "\C-c\C-f\C-o" #'message-goto-from + "\C-c\C-f\C-b" #'message-goto-bcc + "\C-c\C-f\C-w" #'message-goto-fcc + "\C-c\C-f\C-c" #'message-goto-cc + "\C-c\C-f\C-s" #'message-goto-subject + "\C-c\C-f\C-r" #'message-goto-reply-to + "\C-c\C-f\C-n" #'message-goto-newsgroups + "\C-c\C-f\C-d" #'message-goto-distribution + "\C-c\C-f\C-f" #'message-goto-followup-to + "\C-c\C-f\C-m" #'message-goto-mail-followup-to + "\C-c\C-f\C-k" #'message-goto-keywords + "\C-c\C-f\C-u" #'message-goto-summary + "\C-c\C-f\C-i" #'message-insert-or-toggle-importance + "\C-c\C-f\C-a" #'message-generate-unsubscribed-mail-followup-to ;; modify headers (and insert notes in body) - (define-key message-mode-map "\C-c\C-fs" #'message-change-subject) + "\C-c\C-fs" #'message-change-subject ;; - (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to) + "\C-c\C-fx" #'message-cross-post-followup-to ;; prefix+message-cross-post-followup-to = same w/o cross-post - (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc) - (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header) + "\C-c\C-ft" #'message-reduce-to-to-cc + "\C-c\C-fa" #'message-add-archive-header ;; mark inserted text - (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region) - (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file) - - (define-key message-mode-map "\C-c\C-b" #'message-goto-body) - (define-key message-mode-map "\C-c\C-i" #'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" #'message-insert-to) - (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply) - (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups) - (define-key message-mode-map "\C-c\C-l" #'message-to-list-only) - (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires) - - (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\M-n" - #'message-insert-disposition-notification-to) - - (define-key message-mode-map "\C-c\C-y" #'message-yank-original) - (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer) - (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" #'message-insert-signature) - (define-key message-mode-map "\C-c\M-h" #'message-insert-headers) - (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" #'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" #'message-send) - (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" #'message-dont-send) - (define-key message-mode-map "\C-c\n" #'gnus-delay-article) - - (define-key message-mode-map "\C-c\M-k" #'message-kill-address) - (define-key message-mode-map "\C-c\C-e" #'message-elide-region) - (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region) - (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature) - (define-key message-mode-map "\M-\r" #'message-newline-and-reformat) - (define-key message-mode-map [remap split-line] #'message-split-line) - - (define-key message-mode-map "\C-c\C-a" #'mml-attach-file) - (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot) - - (define-key message-mode-map "\C-a" #'message-beginning-of-line) - (define-key message-mode-map "\t" #'message-tab) - - (define-key message-mode-map "\M-n" #'message-display-abbrev)) + "\C-c\M-m" #'message-mark-inserted-region + "\C-c\M-f" #'message-mark-insert-file + + "\C-c\C-b" #'message-goto-body + "\C-c\C-i" #'message-goto-signature + + "\C-c\C-t" #'message-insert-to + "\C-c\C-fw" #'message-insert-wide-reply + "\C-c\C-n" #'message-insert-newsgroups + "\C-c\C-l" #'message-to-list-only + "\C-c\C-f\C-e" #'message-insert-expires + "\C-c\C-u" #'message-insert-or-toggle-importance + "\C-c\M-n" #'message-insert-disposition-notification-to + + "\C-c\C-y" #'message-yank-original + "\C-c\M-\C-y" #'message-yank-buffer + "\C-c\C-q" #'message-fill-yanked-message + "\C-c\C-w" #'message-insert-signature + "\C-c\M-h" #'message-insert-headers + "\C-c\C-r" #'message-caesar-buffer-body + "\C-c\C-o" #'message-sort-headers + "\C-c\M-r" #'message-rename-buffer + + "\C-c\C-c" #'message-send-and-exit + "\C-c\C-s" #'message-send + "\C-c\C-k" #'message-kill-buffer + "\C-c\C-d" #'message-dont-send + "\C-c\n" #'gnus-delay-article + + "\C-c\M-k" #'message-kill-address + "\C-c\C-e" #'message-elide-region + "\C-c\C-v" #'message-delete-not-region + "\C-c\C-z" #'message-kill-to-signature + "\M-\r" #'message-newline-and-reformat + [remap split-line] #'message-split-line + + "\C-c\C-a" #'mml-attach-file + "\C-c\C-p" #'message-insert-screenshot + + "\C-a" #'message-beginning-of-line + "\t" #'message-tab + + "\M-n" #'message-display-abbrev) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -5358,7 +5352,7 @@ Otherwise, generate and save a value for `canlock-password' first." (zerop (length (setq to (completing-read - "Followups to (default no Followup-To header): " + (format-prompt "Followups to" "no Followup-To header") (mapcar #'list (cons "poster" (message-tokenize-header @@ -8893,7 +8887,8 @@ used to take the screenshot." (set-buffer-multibyte nil) (insert image) (base64-encode-region (point-min) (point-max) t) - (buffer-string)))) + (buffer-string))) + nil nil t) (insert "\n\n") (message ""))) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 5f35e73cd7c..079c1b51225 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1409,6 +1409,13 @@ to specify options." :version "22.1" ;; Gnus 5.10.9 :group 'message) +(defcustom mml-attach-file-at-the-end nil + "If non-nil, \\[mml-attach-file] attaches files at the end of the message. +If nil, files are attached at point." + :type 'boolean + :version "29.1" + :group 'message) + ;;;###autoload (defun mml-attach-file (file &optional type description disposition) "Attach a file to the outgoing MIME message. @@ -1423,6 +1430,8 @@ specifies how the attachment is intended to be displayed. It can be either \"inline\" (displayed automatically within the message body) or \"attachment\" (separate from the body). +Also see the `mml-attach-file-at-the-end' variable. + If given a prefix interactively, no prompting will be done for the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults will be computed and used." @@ -1440,8 +1449,11 @@ will be computed and used." (mml-minibuffer-read-disposition type nil file)))) (list file type description disposition))) ;; If in the message header, attach at the end and leave point unchanged. - (let ((head (unless (message-in-body-p) (point)))) - (if head (goto-char (point-max))) + (let ((at-end (and (or (not (message-in-body-p)) + mml-attach-file-at-the-end) + (point)))) + (when at-end + (goto-char (point-max))) (mml-insert-empty-tag 'part 'type type ;; icicles redefines read-file-name and returns a @@ -1451,13 +1463,13 @@ will be computed and used." 'description description) ;; When using Mail mode, make sure it does the mime encoding ;; when you send the message. - (or (eq mail-user-agent 'message-user-agent) - (setq mail-encode-mml t)) - (when head + (unless (eq mail-user-agent 'message-user-agent) + (setq mail-encode-mml t)) + (when at-end (unless (pos-visible-in-window-p) (message "The file \"%s\" has been attached at the end of the message" (file-name-nondirectory file))) - (goto-char head)))) + (goto-char at-end)))) (defun mml-dnd-attach-file (uri _action) "Attach a drag and drop file. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 059101c8907..8a2acf6459a 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -429,8 +429,18 @@ during splitting, which may be slow." now (nnimap-last-command-time nnimap-object)))) (with-local-quit - (ignore-errors ;E.g. "buffer foo has no process". - (nnimap-send-command "NOOP"))))))))) + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP")) + ;; If our connection has died in the meantime, clean it + ;; and its buffer up. + (unless (process-live-p (get-buffer-process buffer)) + (setq nnimap-process-buffers + (delq buffer nnimap-process-buffers)) + (setq nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buffer (cdr elt)))) + nnimap-connection-alist)) + (kill-buffer buffer))))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was @@ -662,10 +672,17 @@ during splitting, which may be slow." (deffoo nnimap-close-server (&optional server defs) (when (nnoo-change-server 'nnimap server defs) - (ignore-errors - (delete-process (get-buffer-process (nnimap-buffer)))) - (nnoo-close-server 'nnimap server) - t)) + (let ((buf (nnimap-buffer))) + (ignore-errors + (delete-process (get-buffer-process buf))) + (setq nnimap-process-buffers + (delq buf nnimap-process-buffers) + nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buf (cdr elt)))) + nnimap-connection-alist)) + (nnoo-close-server 'nnimap server) + t))) (deffoo nnimap-request-close () t) @@ -1937,10 +1954,13 @@ Return the server's response to the SELECT or EXAMINE command." (when entry (if (and (buffer-live-p (cadr entry)) (get-buffer-process (cadr entry)) - (memq (process-status (get-buffer-process (cadr entry))) - '(open run))) + (process-live-p (get-buffer-process (cadr entry)))) (get-buffer-process (cadr entry)) - (setq nnimap-connection-alist (delq entry nnimap-connection-alist)) + (setq nnimap-connection-alist (delq entry nnimap-connection-alist) + nnimap-process-buffers + (delq (cadr entry) nnimap-process-buffers)) + (when (buffer-live-p (cadr entry)) + (kill-buffer (cadr entry))) nil)))) ;; Leave room for `open-network-stream' to issue a couple of IMAP diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index d00f0a60b66..cfef69f1031 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -663,13 +663,13 @@ order for SpamAssassin to recognize the new registered spam." ;;; Key bindings for spam control. -(gnus-define-keys gnus-summary-mode-map - "St" spam-generic-score - "Sx" gnus-summary-mark-as-spam - "Mst" spam-generic-score - "Msx" gnus-summary-mark-as-spam - "\M-d" gnus-summary-mark-as-spam - "$" gnus-summary-mark-as-spam) +(define-keymap :keymap gnus-summary-mode-map + "St" #'spam-generic-score + "Sx" #'gnus-summary-mark-as-spam + "Mst" #'spam-generic-score + "Msx" #'gnus-summary-mark-as-spam + "\M-d" #'gnus-summary-mark-as-spam + "$" #'gnus-summary-mark-as-spam) (defvar spam-cache-lookups t "Whether spam.el will try to cache lookups using `spam-caches'.") diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index 233c50504bf..8eb397bc82d 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -229,11 +229,11 @@ this option, or use \"In certain situations\" and specify no text properties, to enable buffer local values." never)) :initialize 'custom-initialize-default - :set #'(lambda (variable value) - (set-default variable value) - (if (eq value 'never) - (help-at-pt-cancel-timer) - (help-at-pt-set-timer))) + :set (lambda (variable value) + (set-default variable value) + (if (eq value 'never) + (help-at-pt-cancel-timer) + (help-at-pt-set-timer))) :set-after '(help-at-pt-timer-delay) :require 'help-at-pt) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 2b759a5a5c5..17fabe4f63a 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1561,7 +1561,7 @@ If FRAME is omitted or nil, use the selected frame." (:fontset . "Fontset") (:extend . "Extend") (:inherit . "Inherit"))) - (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x))) + (max-width (apply #'max (mapcar (lambda (x) (length (cdr x))) attrs)))) (dolist (a attrs) (let ((attr (face-attribute face (car a) frame))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 0b404fe89f1..792f2e5af33 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -35,6 +35,8 @@ (let ((map (make-sparse-keymap))) (set-keymap-parent map (make-composed-keymap button-buffer-map special-mode-map)) + (define-key map "n" 'help-goto-next-page) + (define-key map "p" 'help-goto-previous-page) (define-key map "l" 'help-go-back) (define-key map "r" 'help-go-forward) (define-key map "\C-c\C-b" 'help-go-back) @@ -273,6 +275,10 @@ The format is (FUNCTION ARGS...).") (when (or (< position (point-min)) (> position (point-max))) (widen)) + ;; Save mark for the old location, unless the point is not + ;; actually going to move. + (unless (= (point) position) + (push-mark nil t)) (goto-char position)) (message "Unable to find location in file"))))) @@ -372,6 +378,13 @@ The format is (FUNCTION ARGS...).") (view-buffer-other-window (find-file-noselect file)) (goto-char pos)) 'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement")) + +;;;###autoload +(defun help-mode--add-function-link (str fun) + (make-text-button (copy-sequence str) nil + 'type 'help-function + 'help-args (list fun))) + (defvar bookmark-make-record-function) (defvar help-mode--current-data nil) @@ -631,34 +644,7 @@ that." "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t) (let ((sym (intern-soft (match-string 1)))) (if (fboundp sym) - (help-xref-button 1 'help-function sym))))) - ;; Look for commands in whole keymap substitutions: - (save-excursion - ;; Make sure to find the first keymap. - (goto-char (point-min)) - ;; Find a header and the column at which the command - ;; name will be found. - - ;; If the keymap substitution isn't the last thing in - ;; the doc string, and if there is anything on the same - ;; line after it, this code won't recognize the end of it. - (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" - nil t) - (let ((col (- (match-end 1) (match-beginning 1)))) - (while - (and (not (eobp)) - ;; Stop at a pair of blank lines. - (not (looking-at-p "\n\\s-*\n"))) - ;; Skip a single blank line. - (and (eolp) (forward-line)) - (end-of-line) - (skip-chars-backward "^ \t\n") - (if (and (>= (current-column) col) - (looking-at "\\(\\sw\\|\\s_\\)+$")) - (let ((sym (intern-soft (match-string 0)))) - (if (fboundp sym) - (help-xref-button 0 'help-function sym)))) - (forward-line)))))) + (help-xref-button 1 'help-function sym)))))) (set-syntax-table stab)) ;; Delete extraneous newlines at the end of the docstring (goto-char (point-max)) @@ -795,6 +781,26 @@ See `help-make-xrefs'." (help-xref-go-forward (current-buffer)) (user-error "No next help buffer"))) +(defun help-goto-next-page () + "Go to the next page (if any) in the current buffer. +The help buffers are divided into \"pages\" by the ^L character." + (interactive nil help-mode) + (push-mark) + (forward-page) + (unless (eobp) + (forward-line 1))) + +(defun help-goto-previous-page () + "Go to the previous page (if any) in the current buffer. +(If not at the start of a page, go to the start of the current page.) + +The help buffers are divided into \"pages\" by the ^L character." + (interactive nil help-mode) + (push-mark) + (backward-page (if (looking-back "\f\n" (- (point) 5)) 2 1)) + (unless (bobp) + (forward-line 1))) + (defun help-view-source () "View the source of the current help item." (interactive nil help-mode) diff --git a/lisp/help.el b/lisp/help.el index 21c8255c690..2a72656bb0d 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -561,11 +561,13 @@ To record all your input, use `open-dribble-file'." 'font-lock-face 'help-key-binding 'face 'help-key-binding)) -(defcustom describe-bindings-outline nil +(defcustom describe-bindings-outline t "Non-nil enables outlines in the output buffer of `describe-bindings'." :type 'boolean :group 'help - :version "28.1") + :version "29.1") + +(declare-function outline-hide-subtree "outline") (defun describe-bindings (&optional prefix buffer) "Display a buffer showing a list of all defined keys, and their definitions. @@ -581,8 +583,6 @@ or a buffer name." (help-setup-xref (list #'describe-bindings prefix buffer) (called-interactively-p 'interactive)) (with-help-window (help-buffer) - ;; Be aware that `describe-buffer-bindings' puts its output into - ;; the current buffer. (with-current-buffer (help-buffer) (describe-buffer-bindings buffer prefix) @@ -592,18 +592,18 @@ or a buffer name." (setq-local outline-level (lambda () 1)) (setq-local outline-minor-mode-cycle t outline-minor-mode-highlight t) + (setq-local outline-minor-mode-use-buttons t) (outline-minor-mode 1) (save-excursion + (goto-char (point-min)) (let ((inhibit-read-only t)) - (goto-char (point-min)) - (insert (substitute-command-keys - (concat "\\<outline-minor-mode-cycle-map>Type " - "\\[outline-cycle] or \\[outline-cycle-buffer] " - "on headings to cycle their visibility.\n\n"))) - ;; Hide the longest body - (when (and (re-search-forward "Key translations" nil t) - (fboundp 'outline-cycle)) - (outline-cycle)))))))) + ;; Hide the longest body. + (when (re-search-forward "Key translations" nil t) + (outline-hide-subtree)) + ;; Hide ^Ls. + (while (search-forward "\n\f\n" nil t) + (put-text-property (1+ (match-beginning 0)) (1- (match-end 0)) + 'invisible t)))))))) (defun where-is (definition &optional insert) "Print message listing key sequences that invoke the command DEFINITION. @@ -1064,6 +1064,14 @@ is currently activated with completion." result)) +(defcustom help-link-key-to-documentation t + "Non-nil means link keys to their command in *Help* buffers. +This affects \\\\=\\[command] substitutions in documentation +strings done by `substitute-command-keys'." + :type 'boolean + :version "29.1" + :group 'help) + (defun substitute-command-keys (string) "Substitute key descriptions for command names in STRING. Each substring of the form \\\\=[COMMAND] is replaced by either a @@ -1151,7 +1159,14 @@ Otherwise, return a new string." (delete-char 1)) ;; Function is on a key. (delete-char (- end-point (point))) - (insert (help--key-description-fontified key))))) + (let ((key (help--key-description-fontified key))) + (insert (if (and help-link-key-to-documentation + (functionp fun)) + ;; The `fboundp' fixes bootstrap. + (if (fboundp 'help-mode--add-function-link) + (help-mode--add-function-link key fun) + key) + key)))))) ;; 1D. \{foo} is replaced with a summary of the keymap ;; (symbol-value foo). ;; \<foo> just sets the keymap used for \[cmd]. @@ -1238,10 +1253,7 @@ 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')." +shadowed." (let* ((amaps (accessible-keymaps startmap prefix)) (orig-maps (if no-menu (progn @@ -1258,17 +1270,8 @@ Any inserted text ends in two newlines (used by 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 " - (help--key-description-fontified prefix))) - ":\n")) - "key binding\n" - "--- -------\n"))) + (print-title (or maps always-title)) + (start-point (point))) ;; Describe key bindings. (setq help--keymaps-seen nil) (while (consp maps) @@ -1293,8 +1296,24 @@ Any inserted text ends in two newlines (used by (describe-map (cdr elt) elt-prefix transl partial sub-shadows no-menu mention-shadow))) (setq maps (cdr maps))) - (when print-title - (insert "\n")))) + ;; Print title... + (when (and print-title + ;; ... unless the keymap was empty. + (/= (point) start-point)) + (save-excursion + (goto-char start-point) + (when (eolp) + (delete-region (point) (1+ (point)))) + (insert + (concat + (if title + (concat title + (if prefix + (concat " Starting With " + (help--key-description-fontified prefix))) + ":\n")) + "\nKey Binding\n" + (make-separator-line))))))) (defun help--shadow-lookup (keymap key accept-default remap) "Like `lookup-key', but with command remapping. @@ -1307,48 +1326,33 @@ Return nil if the key sequence is too long." 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)))) - ;; Avoid using the `help-keymap' face. - (let ((op (point))) - (indent-to description-column 1) - (set-text-properties op (point) '( face nil - font-lock-face nil))) - (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. - ;; Avoid using the `help-keymap' face. - (let ((op (point))) - (indent-to 16 1) - (set-text-properties op (point) '( face nil - font-lock-face nil))) +(defun help--describe-command (definition &optional translation) (cond ((symbolp definition) - (insert (symbol-name definition) "\n")) + (insert-text-button (symbol-name definition) + 'type 'help-function + 'help-args (list definition)) + (insert "\n")) ((or (stringp definition) (vectorp definition)) - (insert (key-description definition nil) "\n")) + (if translation + (insert (key-description definition nil) "\n") + (insert "Keyboard Macro\n"))) ((keymapp definition) (insert "Prefix Command\n")) - (t (insert "??\n")))) + ((byte-code-function-p definition) + (insert "[%s]\n" (buttonize "byte-code" #'disassemble definition))) + ((and (consp definition) + (memq (car definition) '(closure lambda))) + (insert (format "[%s]\n" + (buttonize + (symbol-name (car definition)) + (lambda (_) + (pp-display-expression + definition "*Help Source*" t)))))) + (t + (insert "??\n")))) + +(define-obsolete-function-alias 'help--describe-translation + #'help--describe-command "29.1") (defun help--describe-map-compare (a b) (let ((a (car a)) @@ -1362,7 +1366,8 @@ Return nil if the key sequence is too long." (string-version-lessp (symbol-name a) (symbol-name b))) (t nil)))) -(defun describe-map (map prefix transl partial shadow nomenu mention-shadow) +(defun describe-map (map &optional 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). @@ -1374,14 +1379,22 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in (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)) + (let ((columns ())) + (help--describe-vector + (car tail) prefix + (lambda (def) + (let ((start-line (line-beginning-position)) + (end-key (point)) + (column (current-column))) + (help--describe-command def transl) + (push (list column start-line end-key (1- (point))) + columns))) + partial shadow map mention-shadow) + (when columns + (describe-map--align-section columns)))) ((consp (car tail)) (let ((event (caar tail)) definition this-shadowed) @@ -1424,7 +1437,9 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in (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))) + (let ((vect (sort vect 'help--describe-map-compare)) + (columns ()) + line-start key-end column) ;; Now output them in sorted order. (while vect (let* ((elem (car vect)) @@ -1432,10 +1447,6 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in (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) @@ -1450,26 +1461,80 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in (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 (help--key-description-fontified (vector start) prefix)) - (when (not (eq start end)) - (insert " .. " (help--key-description-fontified (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))))) + (when (or (not (eq start end)) + ;; Don't output keymap prefixes. + (not (keymapp definition))) + (when first + (insert "\n") + (setq first nil)) + ;; Now START .. END is the range to describe next. + ;; Insert the string to describe the event START. + (setq line-start (point)) + (insert (help--key-description-fontified (vector start) prefix)) + (when (not (eq start end)) + (insert " .. " (help--key-description-fontified (vector end) + prefix))) + (setq key-end (point) + column (current-column)) + ;; Print a description of the definition of this character. + ;; Called function will take care of spacing out far enough + ;; for alignment purposes. + (help--describe-command definition transl) + (push (list column line-start key-end (1- (point))) columns) + ;; 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)))))) + (setq vect (cdr vect))) + (when columns + (describe-map--align-section columns))))) + +(defun describe-map--align-section (columns) + (save-excursion + (let ((max-key (apply #'max (mapcar #'car columns)))) + (cond + ;; It's fine to use the minimum, so just do it, but quantize to + ;; two different widths, because having each block align slightly + ;; differently looks untidy. + ((< max-key 16) + (describe-map--fill-columns columns 16)) + ((< max-key 24) + (describe-map--fill-columns columns 24)) + ((< max-key 32) + (describe-map--fill-columns columns 32)) + ;; We have some really wide ones in this block. + (t + (let ((window-width (window-width)) + (max-def (apply #'max (mapcar + (lambda (elem) + (- (nth 3 elem) (nth 2 elem))) + columns)))) + (if (< (+ max-def (max 16 max-key)) window-width) + ;; Can we do the block without continuation lines? Then do that. + (describe-map--fill-columns columns (1+ (max 16 max-key))) + ;; No, do continuation lines for some definitions. + (dolist (elem columns) + (goto-char (caddr elem)) + (if (< (+ (car elem) (- (nth 3 elem) (nth 2 elem))) window-width) + ;; Indent. + (insert-char ?\s (- (1+ max-key) (car elem))) + ;; Continuation. + (insert "\n") + (insert-char ?\t 2)))))))))) + +(defun describe-map--fill-columns (columns width) + (dolist (elem columns) + (goto-char (caddr elem)) + (let ((tabs (- (/ width tab-width) + (/ (car elem) tab-width)))) + (insert-char ?\t tabs) + (insert-char ?\s (if (zerop tabs) + (- width (car elem)) + (mod width tab-width)))))) ;;;; This Lisp version is 100 times slower than its C equivalent: ;; @@ -1605,10 +1670,16 @@ and some others." (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) +(defvar resize-temp-buffer-window-inhibit nil + "Non-nil means `resize-temp-buffer-window' should not resize.") + (defun resize-temp-buffer-window (&optional window) "Resize WINDOW to fit its contents. WINDOW must be a live window and defaults to the selected one. -Do not resize if WINDOW was not created by `display-buffer'. +Do not resize if WINDOW was not created by `display-buffer'. Do +not resize either if a `window-height', `window-width' or +`window-size' entry in `display-buffer-alist' prescribes some +alternative resizing for WINDOW's buffer. If WINDOW is part of a vertical combination, restrain its new size by `temp-buffer-max-height' and do not resize if its minimum @@ -1623,27 +1694,33 @@ provided `fit-frame-to-buffer' is non-nil. This function may call `preserve-window-size' to preserve the size of WINDOW." (setq window (window-normalize-window window t)) - (let ((height (if (functionp temp-buffer-max-height) + (let* ((buffer (window-buffer window)) + (height (if (functionp temp-buffer-max-height) + (with-selected-window window + (funcall temp-buffer-max-height buffer)) + temp-buffer-max-height)) + (width (if (functionp temp-buffer-max-width) (with-selected-window window - (funcall temp-buffer-max-height (window-buffer))) - temp-buffer-max-height)) - (width (if (functionp temp-buffer-max-width) - (with-selected-window window - (funcall temp-buffer-max-width (window-buffer))) - temp-buffer-max-width)) - (quit-cadr (cadr (window-parameter window 'quit-restore)))) - ;; Resize WINDOW iff it was made by `display-buffer'. + (funcall temp-buffer-max-width buffer)) + temp-buffer-max-width)) + (quit-cadr (cadr (window-parameter window 'quit-restore)))) + ;; Resize WINDOW only if it was made by `display-buffer'. (when (or (and (eq quit-cadr 'window) (or (and (window-combined-p window) (not (eq fit-window-to-buffer-horizontally 'only)) - (pos-visible-in-window-p (point-min) window)) + (pos-visible-in-window-p + (with-current-buffer buffer (point-min)) + window) + (not resize-temp-buffer-window-inhibit)) (and (window-combined-p window t) - fit-window-to-buffer-horizontally))) + fit-window-to-buffer-horizontally + (not resize-temp-buffer-window-inhibit)))) (and (eq quit-cadr 'frame) fit-frame-to-buffer - (eq window (frame-root-window window)))) - (fit-window-to-buffer window height nil width nil t)))) + (eq window (frame-root-window window)) + (not resize-temp-buffer-window-inhibit))) + (fit-window-to-buffer window height nil width nil t)))) ;;; Help windows. (defcustom help-window-select nil diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 01033474d38..a61c9d6354c 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -716,11 +716,6 @@ See `icomplete-mode' and `minibuffer-setup-hook'." (delete-region (overlay-start rfn-eshadow-overlay) (overlay-end rfn-eshadow-overlay))) (let* ((field-string (icomplete--field-string)) - ;; Not sure why, but such requests seem to come - ;; every once in a while. It's not fully - ;; deterministic but `C-x C-f M-DEL M-DEL ...' - ;; seems to trigger it fairly often! - (while-no-input-ignore-events '(selection-request)) (text (while-no-input (icomplete-completions field-string diff --git a/lisp/ido.el b/lisp/ido.el index 7c2d2eb0d75..6767d669880 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -354,8 +354,8 @@ The following values are possible: Setting this variable directly does not take effect; use either \\[customize] or the function `ido-mode'." - :set #'(lambda (_symbol value) - (ido-mode (or value 0))) + :set (lambda (_symbol value) + (ido-mode (or value 0))) :initialize #'custom-initialize-default :require 'ido :link '(emacs-commentary-link "ido.el") @@ -620,9 +620,9 @@ hosts on first use of UNC path." (function-item :tag "Use `NET VIEW'" :value ido-unc-hosts-net-view) (function :tag "Your own function")) - :set #'(lambda (symbol value) - (set symbol value) - (setq ido-unc-hosts-cache t))) + :set (lambda (symbol value) + (set symbol value) + (setq ido-unc-hosts-cache t))) (defcustom ido-downcase-unc-hosts t "Non-nil if UNC host names should be downcased." diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 329085c823c..76e84f13f34 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1,7 +1,7 @@ ;;; image-dired.el --- use dired to browse and manipulate your images -*- lexical-binding: t -*- -;; + ;; Copyright (C) 2005-2021 Free Software Foundation, Inc. -;; + ;; Version: 0.4.11 ;; Keywords: multimedia ;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com> @@ -22,7 +22,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: -;; + ;; BACKGROUND ;; ========== ;; @@ -59,19 +59,22 @@ ;; PREREQUISITES ;; ============= ;; -;; * The ImageMagick package. Currently, `convert' and `mogrify' are -;; used. Find it here: https://www.imagemagick.org. +;; * The GraphicsMagick or ImageMagick package; Image-Dired uses +;; whichever is available. +;; +;; A) For GraphicsMagick, `gm' is used. +;; Find it here: http://www.graphicsmagick.org/ +;; +;; B) For ImageMagick, `convert' and `mogrify' are used. +;; Find it here: https://www.imagemagick.org. ;; ;; * For non-lossy rotation of JPEG images, the JpegTRAN program is -;; needed. +;; needed. ;; -;; * 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: -;; https://exiftool.org/. These two functions are, among other -;; things, used for writing comments to image files using -;; `image-dired-thumbnail-set-image-description' and to create -;; "unique" file names using `image-dired-get-exif-file-name' (used by -;; `image-dired-copy-with-exif-file-name'). +;; * For `image-dired-set-exif-data' to work, the command line tool `exiftool' is +;; needed. It can be found here: https://exiftool.org/. This +;; function is, among other things, used for writing comments to +;; image files using `image-dired-thumbnail-set-image-description'. ;; ;; ;; USAGE @@ -89,24 +92,22 @@ ;; =========== ;; ;; * Supports all image formats that Emacs and convert supports, but -;; the thumbnails are hard-coded to JPEG format. +;; the thumbnails are hard-coded to JPEG or PNG format. It uses +;; JPEG by default, but can optionally follow the Thumbnail Managing +;; Standard (v0.9.0, Dec 2020), which mandates PNG. See the user +;; option `image-dired-thumbnail-storage'. ;; ;; * WARNING: The "database" format used might be changed so keep a -;; backup of `image-dired-db-file' when testing new versions. -;; -;; * `image-dired-display-image-mode' does not support animation +;; backup of `image-dired-db-file' when testing new versions. ;; ;; TODO ;; ==== ;; -;; * Support gallery creation when using per-directory thumbnail -;; storage. -;; ;; * Some sort of auto-rotate function based on rotate info in the -;; EXIF data. +;; EXIF data. ;; ;; * Investigate if it is possible to also write the tags to the image -;; files. +;; files. ;; ;; * From thumbs.el: Add an option for clean-up/max-size functionality ;; for thumbnail directory. @@ -119,38 +120,33 @@ ;; * From thumbs.el: Add the "modify" commands (emboss, negate, ;; monochrome etc). ;; -;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find -;; out which is best, saving old batch just before inserting new, or -;; saving the current batch in the ring when inserting it. Adding it -;; probably needs rewriting `image-dired-display-thumbs' to be more general. +;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find out +;; which is best, saving old batch just before inserting new, or +;; saving the current batch in the ring when inserting it. Adding +;; it probably needs rewriting `image-dired-display-thumbs' to be more general. ;; ;; * Find some way of toggling on and off really nice keybindings in -;; dired (for example, using C-n or <down> instead of C-S-n). Richard -;; suggested that we could keep C-t as prefix for image-dired commands -;; as it is currently not used in dired. He also suggested that -;; `dired-next-line' and `dired-previous-line' figure out if -;; image-dired is enabled in the current buffer and, if it is, call -;; `image-dired-dired-next-line' and -;; `image-dired-dired-previous-line', respectively. Update: This is -;; partly done; some bindings have now been added to dired. -;; -;; * Enhanced gallery creation with basic CSS-support and pagination -;; of tag pages with many pictures. -;; -;; * Rewrite `image-dired-modify-mark-on-thumb-original-file' to be -;; less ugly. +;; Dired (for example, using C-n or <down> instead of C-S-n). +;; Richard suggested that we could keep C-t as prefix for +;; image-dired commands as it is currently not used in Dired. He +;; also suggested that `dired-next-line' and `dired-previous-line' +;; figure out if image-dired is enabled in the current buffer and, +;; if it is, call `image-dired-dired-next-line' and `image-dired-dired-previous-line', +;; respectively. Update: This is partly done; some bindings have +;; now been added to Dired. ;; ;; * In some way keep track of buffers and windows and stuff so that -;; it works as the user expects. -;; -;; * More/better documentation -;; +;; it works as the user expects. ;; +;; * More/better documentation. + ;;; Code: (require 'dired) +(require 'exif) (require 'image-mode) (require 'widget) +(require 'xdg) (eval-when-compile (require 'cl-lib) @@ -165,108 +161,107 @@ (defcustom image-dired-dir (locate-user-emacs-file "image-dired/") "Directory where thumbnail images are stored. -The value of this option will be ignored if Image Dired is +The value of this option will be ignored if Image-Dired is customized to use the Thumbnail Managing Standard; they will be saved in \"$XDG_CACHE_HOME/thumbnails/\" instead. See `image-dired-thumbnail-storage'." :type 'directory) (defcustom image-dired-thumbnail-storage 'use-image-dired-dir - "How to store image-dired's thumbnail files. -Image-Dired can store thumbnail files in one of two ways and this is -controlled by this variable. \"Use image-dired dir\" means that the -thumbnails are stored in a central directory. \"Per directory\" -means that each thumbnail is stored in a subdirectory called -\".image-dired\" in the same directory where the image file is. -\"Thumbnail Managing Standard\" means that the thumbnails are -stored and generated according to the Thumbnail Managing Standard -that allows sharing of thumbnails across different programs." + "How `image-dired' stores thumbnail files. +There are two ways that Image-Dired can store and generate +thumbnails. If you set this variable to one of the two following +values, they will be stored in the JPEG format: + +- `use-image-dired-dir' means that the thumbnails are stored in a + central directory. + +- `per-directory' means that each thumbnail is stored in a + subdirectory called \".image-dired\" in the same directory + where the image file is. + +It can also use the \"Thumbnail Managing Standard\", which allows +sharing of thumbnails across different programs. Thumbnails will +be stored in \"$XDG_CACHE_HOME/thumbnails/\" instead of in +`image-dired-dir'. Thumbnails are saved in the PNG format, and +can be one of the following sizes: + +- `standard' means use thumbnails sized 128x128. +- `standard-large' means use thumbnails sized 256x256. +- `standard-x-large' means use thumbnails sized 512x512. +- `standard-xx-large' means use thumbnails sized 1024x1024. + +For more information on the Thumbnail Managing Standard, see: +https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html" :type '(choice :tag "How to store thumbnail files" (const :tag "Use image-dired-dir" use-image-dired-dir) - (const :tag "Thumbnail Managing Standard (normal 128x128)" standard) - (const :tag "Thumbnail Managing Standard (large 256x256)" standard-large) - (const :tag "Per-directory" per-directory))) + (const :tag "Thumbnail Managing Standard (normal 128x128)" + standard) + (const :tag "Thumbnail Managing Standard (large 256x256)" + standard-large) + (const :tag "Thumbnail Managing Standard (larger 512x512)" + standard-x-large) + (const :tag "Thumbnail Managing Standard (extra large 1024x1024)" + standard-xx-large) + (const :tag "Per-directory" per-directory)) + :version "29.1") + +(defconst image-dired--thumbnail-standard-sizes + '( standard standard-large + standard-x-large standard-xx-large) + "List of symbols representing thumbnail sizes in Thumbnail Managing Standard.") (defcustom image-dired-db-file (expand-file-name ".image-dired_db" image-dired-dir) "Database file where file names and their associated tags are stored." :type 'file) -(defcustom image-dired-temp-image-file - (expand-file-name ".image-dired_temp" image-dired-dir) - "Name of temporary image file used by various commands." - :type 'file) -(defcustom image-dired-gallery-dir - (expand-file-name ".image-dired_gallery" image-dired-dir) - "Directory to store generated gallery html pages. -This path needs to be \"shared\" to the public so that it can access -the index.html page that image-dired creates." - :type 'directory) - -(defcustom image-dired-gallery-image-root-url -"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." - :type 'string) - -(defcustom image-dired-gallery-thumb-image-root-url -"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." - :type 'string) (defcustom image-dired-cmd-create-thumbnail-program - "convert" + (if (executable-find "gm") "gm" "convert") "Executable used to create thumbnail. Used together with `image-dired-cmd-create-thumbnail-options'." - :type 'file) + :type 'file + :version "29.1") (defcustom image-dired-cmd-create-thumbnail-options - '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") + (let ((opts '("-size" "%wx%h" "%f[0]" + "-resize" "%wx%h>" + "-strip" "jpeg:%t"))) + (if (executable-find "gm") (cons "convert" opts) opts)) "Options of command used to create thumbnail image. Used with `image-dired-cmd-create-thumbnail-program'. Available format specifiers are: %w which is replaced by `image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height', %f which is replaced by the file name of the original image and %t which is replaced by the file name of the thumbnail file." - :version "26.1" - :type '(repeat (string :tag "Argument"))) - -(defcustom image-dired-cmd-create-temp-image-program "convert" - "Executable used to create temporary image. -Used together with `image-dired-cmd-create-temp-image-options'." - :type 'file) - -(defcustom image-dired-cmd-create-temp-image-options - '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") - "Options of command used to create temporary image for display window. -Used together with `image-dired-cmd-create-temp-image-program', -Available format specifiers are: %w and %h which are replaced by -the calculated max size for width and height in the image display window, -%f which is replaced by the file name of the original image and %t which -is replaced by the file name of the temporary file." - :version "26.1" + :version "29.1" :type '(repeat (string :tag "Argument"))) (defcustom image-dired-cmd-pngnq-program - (or (executable-find "pngnq") - (executable-find "pngnq-s9")) - "The file name of the `pngnq' program. + ;; Prefer pngquant to pngnq-s9 as it is faster on my machine. + ;; The project also seems more active than the alternatives. + ;; Prefer pngnq-s9 to pngnq as it fixes bugs in pngnq. + ;; The pngnq project seems dead (?) since 2011 or so. + (or (executable-find "pngquant") + (executable-find "pngnq-s9") + (executable-find "pngnq")) + "The file name of the `pngquant' or `pngnq' program. It quantizes colors of PNG images down to 256 colors or fewer using the NeuQuant algorithm." - :version "26.1" + :version "29.1" :type '(choice (const :tag "Not Set" nil) file)) (defcustom image-dired-cmd-pngnq-options - '("-f" "%t") + (if (executable-find "pngquant") + '("--ext" "-nq8.png" "%t") ; same extension as "pngnq" + '("-f" "%t")) "Arguments to pass `image-dired-cmd-pngnq-program'. Available format specifiers are the same as in `image-dired-cmd-create-thumbnail-options'." - :version "26.1" - :type '(repeat (string :tag "Argument"))) + :type '(repeat (string :tag "Argument")) + :version "29.1") (defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush") "The file name of the `pngcrush' program. @@ -321,23 +316,6 @@ Available format specifiers are the same as in :version "26.1" :type '(repeat (string :tag "Argument"))) -(defcustom image-dired-cmd-rotate-thumbnail-program - "mogrify" - "Executable used to rotate thumbnail. -Used together with `image-dired-cmd-rotate-thumbnail-options'." - :type 'file) - -(defcustom image-dired-cmd-rotate-thumbnail-options - '("-rotate" "%d" "%t") - "Arguments of command used to rotate thumbnail image. -Used with `image-dired-cmd-rotate-thumbnail-program'. -Available format specifiers are: %d which is replaced by the -number of (positive) degrees to rotate the image, normally 90 or 270 -\(for 90 degrees right and left), %t which is replaced by the file name -of the thumbnail file." - :version "26.1" - :type '(repeat (string :tag "Argument"))) - (defcustom image-dired-cmd-rotate-original-program "jpegtran" "Executable used to rotate original image. @@ -383,37 +361,18 @@ which is replaced by the tag value." :version "26.1" :type '(repeat (string :tag "Argument"))) -(defcustom image-dired-cmd-read-exif-data-program - "exiftool" - "Program used to read EXIF data to image. -Used together with `image-dired-cmd-read-exif-data-options'." - :type 'file) - -(defcustom image-dired-cmd-read-exif-data-options - '("-s" "-s" "-s" "-%t" "%f") - "Arguments of command used to read EXIF data. -Used with `image-dired-cmd-read-exif-data-program'. -Available format specifiers are: %f which is replaced -by the image file name and %t which is replaced by the tag name." - :version "26.1" - :type '(repeat (string :tag "Argument"))) - -(defcustom image-dired-gallery-hidden-tags - (list "private" "hidden" "pending") - "List of \"hidden\" tags. -Used by `image-dired-gallery-generate' to leave out \"hidden\" images." - :type '(repeat string)) - (defcustom image-dired-thumb-size (cond ((eq 'standard image-dired-thumbnail-storage) 128) ((eq 'standard-large image-dired-thumbnail-storage) 256) + ((eq 'standard-x-large image-dired-thumbnail-storage) 512) + ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024) (t 100)) "Size of thumbnails, in pixels. This is the default size for both `image-dired-thumb-width' and `image-dired-thumb-height'. -The value of this option will be ignored if Image Dired is +The value of this option will be ignored if Image-Dired is customized to use the Thumbnail Managing Standard; the standard sizes will be used instead. See `image-dired-thumbnail-storage'." :type 'integer) @@ -436,17 +395,28 @@ This is where you see the cursor." :type 'integer) (defcustom image-dired-thumb-visible-marks t - "Make marks visible in thumbnail buffer. + "Make marks and flags visible in thumbnail buffer. If non-nil, apply the `image-dired-thumb-mark' face to marked -images." +images and `image-dired-thumb-flagged' to images flagged for +deletion." :type 'boolean :version "28.1") (defface image-dired-thumb-mark - '((t (:background "orange"))) - "Background-color for marked images in thumbnail buffer." - :group 'image-dired - :version "28.1") + '((((class color) (min-colors 16)) :background "DarkOrange") + (((class color)) :foreground "yellow")) + "Face for marked images in thumbnail buffer." + :version "29.1") + +(defface image-dired-thumb-flagged + '((((class color) (min-colors 88) (background light)) :background "Red3") + (((class color) (min-colors 88) (background dark)) :background "Pink") + (((class color) (min-colors 16) (background light)) :background "Red3") + (((class color) (min-colors 16) (background dark)) :background "Pink") + (((class color) (min-colors 8)) :background "red") + (t :inverse-video t)) + "Face for images flagged for deletion in thumbnail buffer." + :version "29.1") (defcustom image-dired-line-up-method 'dynamic "Default method for line-up of thumbnails in thumbnail buffer. @@ -465,18 +435,6 @@ and No line-up means that no automatic line-up will be done." "Number of thumbnails to display per row in thumb buffer." :type 'integer) -(defcustom image-dired-display-window-width-correction 1 - "Number to be used to correct image display window width. -Change if the default (1) does not work (i.e. if the image does not -completely fit)." - :type 'integer) - -(defcustom image-dired-display-window-height-correction 0 - "Number to be used to correct image display window height. -Change if the default (0) does not work (i.e. if the image does not -completely fit)." - :type 'integer) - (defcustom image-dired-track-movement t "The current state of the tracking and mirroring. For more information, see the documentation for @@ -522,15 +480,31 @@ Including parameters. Used when displaying original image from :type '(choice string (const :tag "Not Set" nil))) -(defcustom image-dired-main-image-directory "~/pics/" +(defcustom image-dired-main-image-directory + (or (xdg-user-dir "PICTURES") "~/pics/") "Name of main image directory, if any. Used by `image-dired-copy-with-exif-file-name'." - :type 'string) + :type 'string + :version "29.1") -(defcustom image-dired-show-all-from-dir-max-files 50 - "Maximum number of files to show using `image-dired-show-all-from-dir' -before warning." - :type 'integer) +(defcustom image-dired-show-all-from-dir-max-files 500 + "Maximum number of files in directory before prompting. + +If there are more image files than this in a selected directory, +the `image-dired-show-all-from-dir' command will ask for +confirmation before creating the thumbnail buffer. If this +variable is nil, it will never ask." + :type '(choice integer + (const :tag "Disable warning" nil)) + :version "29.1") + +(defvar image-dired-debug nil + "Non-nil means enable debug messages.") + +(defun image-dired-debug-message (&rest args) + "Display debug message ARGS when `image-dired-debug' is non-nil." + (when image-dired-debug + (apply #'message args))) (defmacro image-dired--with-db-file (&rest body) "Run BODY in a temp buffer containing `image-dired-db-file'. @@ -571,11 +545,7 @@ Create the thumbnails directory if it does not exist." (file-attribute-modification-time (file-attributes file)))) (image-dired-create-thumb file thumb-file)) - (create-image thumb-file) -;; (list 'image :type 'jpeg -;; :file thumb-file -;; :relief image-dired-thumb-relief :margin image-dired-thumb-margin) - )) + (create-image thumb-file))) (defun image-dired-insert-thumbnail (file original-file-name associated-dired-buffer) @@ -583,13 +553,19 @@ Create the thumbnails directory if it does not exist." Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." (let (beg end) (setq beg (point)) - (image-dired-insert-image file - ;; TODO: this should depend on the real file type - (if (memq image-dired-thumbnail-storage - '(standard standard-large)) - 'png 'jpeg) - image-dired-thumb-relief - image-dired-thumb-margin) + (image-dired-insert-image + file + ;; Thumbnails are created asynchronously, so we might not yet + ;; have a file. But if it exists, it might have been cached from + ;; before and we should use it instead of our current settings. + (or (and (file-exists-p file) + (image-type-from-file-header file)) + (and (memq image-dired-thumbnail-storage + image-dired--thumbnail-standard-sizes) + 'png) + 'jpeg) + image-dired-thumb-relief + image-dired-thumb-margin) (setq end (point)) (add-text-properties beg end @@ -601,35 +577,39 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." 'comment (image-dired-get-comment original-file-name))))) (defun image-dired-thumb-name (file) - "Return thumbnail file name for FILE. -Depending on the value of `image-dired-thumbnail-storage', the file -name will vary. For central thumbnail file storage, make a -MD5-hash of the image file's directory name and add that to make -the thumbnail file name unique. For per-directory storage, just -add a subdirectory. For standard storage, produce the file name -according to the Thumbnail Managing Standard." - (cond ((memq image-dired-thumbnail-storage '(standard standard-large)) - (let* ((xdg (getenv "XDG_CACHE_HOME")) - (dir (if (and xdg (file-name-absolute-p xdg)) - xdg "~/.cache")) - (thumbdir (cl-case image-dired-thumbnail-storage - (standard "thumbnails/normal") - (standard-large "thumbnails/large")))) + "Return absolute file name for thumbnail FILE. +Depending on the value of `image-dired-thumbnail-storage', the +file name of the thumbnail will vary: +- For `use-image-dired-dir', make a SHA1-hash of the image file's + directory name and add that to make the thumbnail file name + unique. +- For `per-directory' storage, just add a subdirectory. +- For `standard' storage, produce the file name according to the + Thumbnail Managing Standard. Among other things, an MD5-hash + of the image file's directory name will be added to the + filename. +See also `image-dired-thumbnail-storage'." + (cond ((memq image-dired-thumbnail-storage + image-dired--thumbnail-standard-sizes) + (let ((thumbdir (cl-case image-dired-thumbnail-storage + (standard "thumbnails/normal") + (standard-large "thumbnails/large") + (standard-x-large "thumbnails/x-large") + (standard-xx-large "thumbnails/xx-large")))) (expand-file-name + ;; MD5 is mandated by the Thumbnail Managing Standard. (concat (md5 (concat "file://" (expand-file-name file))) ".png") - (expand-file-name thumbdir dir)))) + (expand-file-name thumbdir (xdg-cache-home))))) ((eq 'use-image-dired-dir image-dired-thumbnail-storage) (let* ((f (expand-file-name file)) - (md5-hash - ;; Is MD5 hashes fast enough? The checksum of a - ;; thumbnail file name need not be that - ;; "cryptographically" good so a faster one could - ;; be used here. - (md5 (file-name-as-directory (file-name-directory f))))) + (hash + ;; SHA1 is slightly faster than MD5, so let's use it. + ;; (We don't need anything crytographically strong.) + (sha1 (file-name-as-directory (file-name-directory f))))) (format "%s%s%s.thumb.%s" (file-name-as-directory (expand-file-name (image-dired-dir))) (file-name-base f) - (if md5-hash (concat "_" md5-hash) "") + (if hash (concat "_" hash) "") (file-name-extension f)))) ((eq 'per-directory image-dired-thumbnail-storage) (let ((f (expand-file-name file))) @@ -648,10 +628,15 @@ DIMENSION should be either the symbol `width' or `height'." (cond ((eq 'standard image-dired-thumbnail-storage) 128) ((eq 'standard-large image-dired-thumbnail-storage) 256) + ((eq 'standard-x-large image-dired-thumbnail-storage) 512) + ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024) (t (cl-ecase dimension (width image-dired-thumb-width) (height image-dired-thumb-height))))) +(defvar image-dired--generate-thumbs-start nil + "Time when `display-thumbs' was called.") + (defvar image-dired-queue nil "List of items in the queue. Each item has the form (ORIGINAL-FILE TARGET-FILE).") @@ -659,9 +644,12 @@ Each item has the form (ORIGINAL-FILE TARGET-FILE).") (defvar image-dired-queue-active-jobs 0 "Number of active jobs in `image-dired-queue'.") -(defvar image-dired-queue-active-limit 2 +(defvar image-dired-queue-active-limit (min 4 (max 2 (/ (num-processors) 2))) "Maximum number of concurrent jobs permitted for generating images. -Increase at own risk.") +Increase at own risk. If you want to experiment with this, +consider setting `image-dired-debug' to a non-nil value to see +the time spent on generating thumbnails. Run `image-clear-cache' +and remove the cached thumbnail files between each trial run.") (defvar image-dired-tag-history nil "Variable holding the tag history.") @@ -762,7 +750,7 @@ Increase at own risk.") (mapcar (lambda (arg) (format-spec arg spec)) (if (memq image-dired-thumbnail-storage - '(standard standard-large)) + image-dired--thumbnail-standard-sizes) image-dired-cmd-create-standard-thumbnail-options image-dired-cmd-create-thumbnail-options)))) @@ -771,6 +759,12 @@ Increase at own risk.") ;; Trigger next in queue once a thumbnail has been created (cl-decf image-dired-queue-active-jobs) (image-dired-thumb-queue-run) + (when (= image-dired-queue-active-jobs 0) + (image-dired-debug-message + (format-time-string + "Generated thumbnails in %s.%3N seconds" + (time-subtract (current-time) + image-dired--generate-thumbs-start)))) (if (not (and (eq (process-status process) 'exit) (zerop (process-exit-status process)))) (message "Thumb could not be created for %s: %s" @@ -781,7 +775,7 @@ Increase at own risk.") ;; PNG thumbnail has been created since we are ;; following the XDG thumbnail spec, so try to optimize (when (memq image-dired-thumbnail-storage - '(standard standard-large)) + image-dired--thumbnail-standard-sizes) (cond ((and image-dired-cmd-pngnq-program (executable-find image-dired-cmd-pngnq-program)) @@ -895,7 +889,7 @@ Otherwise, delete overlays." (interactive) (setq image-dired-append-when-browsing (not image-dired-append-when-browsing)) - (message "Append browsing %s." + (message "Append browsing %s" (if image-dired-append-when-browsing "on" "off"))) @@ -934,15 +928,6 @@ Otherwise, delete overlays." (defvar image-dired-display-image-buffer "*image-dired-display-image*" "Where larger versions of the images are display.") -(defun image-dired-create-display-image-buffer () - "Create image display buffer and set `image-dired-display-image-mode'." - (let ((buf (get-buffer-create image-dired-display-image-buffer))) - (with-current-buffer buf - (setq buffer-read-only t) - (if (not (eq major-mode 'image-dired-display-image-mode)) - (image-dired-display-image-mode))) - buf)) - (defvar image-dired-saved-window-configuration nil "Saved window configuration.") @@ -966,7 +951,7 @@ The current window configuration is saved and can be restored by calling `image-dired-restore-window-configuration'." (interactive "DDirectory: \nP") (let ((buf (image-dired-create-thumbnail-buffer)) - (buf2 (image-dired-create-display-image-buffer))) + (buf2 (get-buffer-create image-dired-display-image-buffer))) (setq image-dired-saved-window-configuration (current-window-configuration)) (dired dir) @@ -985,7 +970,7 @@ calling `image-dired-restore-window-configuration'." "Restore window configuration. Restore any changes to the window configuration made by calling `image-dired-dired-with-window-configuration'." - (interactive) + (interactive nil image-dired-thumbnail-mode) (if image-dired-saved-window-configuration (set-window-configuration image-dired-saved-window-configuration) (message "No saved window configuration"))) @@ -1025,6 +1010,7 @@ used or not. If non-nil, use `display-buffer' instead of `image-dired-previous-line-and-display' where we do not want the thumbnail buffer to be selected." (interactive "P") + (setq image-dired--generate-thumbs-start (current-time)) (let ((buf (image-dired-create-thumbnail-buffer)) thumb-name files dired-buf) (if arg @@ -1048,31 +1034,36 @@ thumbnail buffer to be selected." ;;;###autoload (defun image-dired-show-all-from-dir (dir) - "Make a preview buffer for all images in DIR and display it. -If the number of files in DIR matching `image-file-name-regexp' -exceeds `image-dired-show-all-from-dir-max-files', a warning will be -displayed." - (interactive "DImage Dired: ") + "Make a thumbnail buffer for all images in DIR and display it. +Any file matching `image-file-name-regexp' is considered an image +file. + +If the number of image files in DIR exceeds +`image-dired-show-all-from-dir-max-files', ask for confirmation +before creating the thumbnail buffer. If that variable is nil, +never ask for confirmation." + (interactive "DImage-Dired: ") (dired dir) (dired-mark-files-regexp (image-file-name-regexp)) - (let ((files (dired-get-marked-files))) - (if (or (<= (length files) image-dired-show-all-from-dir-max-files) - (and (> (length files) image-dired-show-all-from-dir-max-files) - (y-or-n-p - (format - "Directory contains more than %d image files. Proceed? " - image-dired-show-all-from-dir-max-files)))) - (progn - (image-dired-display-thumbs) - (pop-to-buffer image-dired-thumbnail-buffer)) - (message "Canceled.")))) + (let ((files (dired-get-marked-files nil nil nil t))) + (cond ((and (null (cdr files))) + (message "No image files in directory")) + ((or (not image-dired-show-all-from-dir-max-files) + (<= (length (cdr files)) image-dired-show-all-from-dir-max-files) + (and (> (length (cdr files)) image-dired-show-all-from-dir-max-files) + (y-or-n-p + (format + "Directory contains more than %d image files. Proceed?" + image-dired-show-all-from-dir-max-files)))) + (image-dired-display-thumbs) + (pop-to-buffer image-dired-thumbnail-buffer) + (setq default-directory dir) + (image-dired-unmark-all-marks)) + (t (message "Image-Dired canceled"))))) ;;;###autoload (defalias 'image-dired 'image-dired-show-all-from-dir) -;;;###autoload -(define-obsolete-function-alias 'tumme 'image-dired "24.4") - (defun image-dired-sane-db-file () "Check if `image-dired-db-file' exists. If not, try to create it (including any parent directories). @@ -1254,7 +1245,7 @@ around in the thumbnail or dired buffer will find the matching position in the other buffer." (interactive) (setq image-dired-track-movement (not image-dired-track-movement)) - (message "Tracking %s" (if image-dired-track-movement "on" "off"))) + (message "Movement tracking %s" (if image-dired-track-movement "on" "off"))) (defun image-dired-track-thumbnail () "Track current Dired file's thumb in `image-dired-thumbnail-buffer'. @@ -1296,51 +1287,59 @@ With prefix argument, move ARG lines." (if image-dired-track-movement (image-dired-track-thumbnail))) -(defun image-dired-forward-image (&optional arg) +(defun image-dired--display-thumb-properties-fun () + (let ((old-buf (current-buffer)) + (old-point (point))) + (lambda () + (when (and (equal (current-buffer) old-buf) + (= (point) old-point)) + (ignore-errors + (image-dired-display-thumb-properties)))))) + +(defun image-dired-forward-image (&optional arg wrap-around) "Move to next image and display properties. -Optional prefix ARG says how many images to move; default is one -image." +Optional prefix ARG says how many images to move; the default is +one image. Negative means move backwards. +On reaching end or beginning of buffer, stop and show a message. + +If optional argument WRAP-AROUND is non-nil, wrap around: if +point is on the last image, move to the last one and vice versa." (interactive "p") - (let (pos (steps (or arg 1))) - (dotimes (_ steps) - (if (and (not (eobp)) + (setq arg (or arg 1)) + (let (pos) + (dotimes (_ (abs arg)) + (if (and (not (if (> arg 0) (eobp) (bobp))) (save-excursion - (forward-char) - (while (and (not (eobp)) + (forward-char (if (> arg 0) 1 -1)) + (while (and (not (if (> arg 0) (eobp) (bobp))) (not (image-dired-image-at-point-p))) - (forward-char)) + (forward-char (if (> arg 0) 1 -1))) (setq pos (point)) (image-dired-image-at-point-p))) - (goto-char pos) - (error "At last image")))) + (progn (goto-char pos) + (image-dired-display-thumb-properties)) + (if wrap-around + (progn (goto-char (if (> arg 0) + (point-min) + ;; There are two spaces after the last image. + (- (point-max) 2))) + (image-dired-display-thumb-properties)) + (message "At %s image" (if (> arg 0) "last" "first")) + (run-at-time 1 nil (image-dired--display-thumb-properties-fun)))))) (when image-dired-track-movement - (image-dired-track-original-file)) - (image-dired-display-thumb-properties)) + (image-dired-track-original-file))) (defun image-dired-backward-image (&optional arg) "Move to previous image and display properties. -Optional prefix ARG says how many images to move; default is one -image." +Optional prefix ARG says how many images to move; the default is +one image. Negative means move forward. +On reaching end or beginning of buffer, stop and show a message." (interactive "p") - (let (pos (steps (or arg 1))) - (dotimes (_ steps) - (if (and (not (bobp)) - (save-excursion - (backward-char) - (while (and (not (bobp)) - (not (image-dired-image-at-point-p))) - (backward-char)) - (setq pos (point)) - (image-dired-image-at-point-p))) - (goto-char pos) - (error "At first image")))) - (when image-dired-track-movement - (image-dired-track-original-file)) - (image-dired-display-thumb-properties)) + (image-dired-forward-image (- (or arg 1)))) (defun image-dired-next-line () "Move to next line and display properties." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((goal-column (current-column))) (forward-line 1) (move-to-column goal-column)) @@ -1354,7 +1353,7 @@ image." (defun image-dired-previous-line () "Move to previous line and display properties." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((goal-column (current-column))) (forward-line -1) (move-to-column goal-column)) @@ -1368,6 +1367,28 @@ image." (image-dired-track-original-file)) (image-dired-display-thumb-properties)) +(defun image-dired-beginning-of-buffer () + "Move to the first image in the buffer and display properties." + (interactive nil image-dired-thumbnail-mode) + (goto-char (point-min)) + (while (and (not (image-at-point-p)) + (not (eobp))) + (forward-char 1)) + (when image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-display-thumb-properties)) + +(defun image-dired-end-of-buffer () + "Move to the last image in the buffer and display properties." + (interactive nil image-dired-thumbnail-mode) + (goto-char (point-max)) + (while (and (not (image-at-point-p)) + (not (bobp))) + (forward-char -1)) + (when image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-display-thumb-properties)) + (defun image-dired-format-properties-string (buf file props comment) "Format display properties. BUF is the associated Dired buffer, FILE is the original image file @@ -1397,61 +1418,76 @@ comment." props comment)))))) -(defun image-dired-dired-file-marked-p () - "Check whether file on current line is marked or not." +(defun image-dired-dired-file-marked-p (&optional marker) + "In Dired, return t if file on current line is marked. +If optional argument MARKER is non-nil, it is a character to look +for. The default is to look for `dired-marker-char'." + (setq marker (or marker dired-marker-char)) (save-excursion (beginning-of-line) - (looking-at-p dired-re-mark))) - -(defun image-dired-modify-mark-on-thumb-original-file (command) - "Modify mark in Dired buffer. -COMMAND is one of `mark' for marking file in Dired, `unmark' for -unmarking file in Dired or `flag' for flagging file for delete in -Dired." - (let ((file-name (image-dired-original-file-name)) - (dired-buf (image-dired-associated-dired-buffer))) - (if (not (and dired-buf file-name)) - (message "No image, or image with correct properties, at point.") - (with-current-buffer dired-buf - (message "%s" file-name) - (when (dired-goto-file file-name) - (cond ((eq command 'mark) (dired-mark 1)) - ((eq command 'unmark) (dired-unmark 1)) - ((eq command 'toggle) - (if (image-dired-dired-file-marked-p) - (dired-unmark 1) - (dired-mark 1))) - ((eq command 'flag) (dired-flag-file-deletion 1))) - (image-dired-thumb-update-marks)))))) + (and (looking-at dired-re-mark) + (= (aref (match-string 0) 0) marker)))) + +(defun image-dired-dired-file-flagged-p () + "In Dired, return t if file on current line is flagged for deletion." + (image-dired-dired-file-marked-p dired-del-marker)) + +(defmacro image-dired--on-file-in-dired-buffer (&rest body) + "Run BODY with point on file at point in Dired buffer. +Should be called from commands in `image-dired-thumbnail-mode'." + (declare (indent defun) + (debug 1)) + `(let ((file-name (image-dired-original-file-name)) + (dired-buf (image-dired-associated-dired-buffer))) + (if (not (and dired-buf file-name)) + (message "No image, or image with correct properties, at point.") + (with-current-buffer dired-buf + (when (dired-goto-file file-name) + ,@body + (image-dired-thumb-update-marks)))))) (defun image-dired-mark-thumb-original-file () "Mark original image file in associated Dired buffer." - (interactive) - (image-dired-modify-mark-on-thumb-original-file 'mark) + (interactive nil image-dired-thumbnail-mode) + (image-dired--on-file-in-dired-buffer + (dired-mark 1)) (image-dired-forward-image)) (defun image-dired-unmark-thumb-original-file () "Unmark original image file in associated Dired buffer." - (interactive) - (image-dired-modify-mark-on-thumb-original-file 'unmark) + (interactive nil image-dired-thumbnail-mode) + (image-dired--on-file-in-dired-buffer + (dired-unmark 1)) (image-dired-forward-image)) (defun image-dired-flag-thumb-original-file () "Flag original image file for deletion in associated Dired buffer." - (interactive) - (image-dired-modify-mark-on-thumb-original-file 'flag) + (interactive nil image-dired-thumbnail-mode) + (image-dired--on-file-in-dired-buffer + (dired-flag-file-deletion 1)) (image-dired-forward-image)) (defun image-dired-toggle-mark-thumb-original-file () "Toggle mark on original image file in associated Dired buffer." - (interactive) - (image-dired-modify-mark-on-thumb-original-file 'toggle)) + (interactive nil image-dired-thumbnail-mode) + (image-dired--on-file-in-dired-buffer + (if (image-dired-dired-file-marked-p) + (dired-unmark 1) + (dired-mark 1)))) + +(defun image-dired-unmark-all-marks () + "Remove all marks from all files in associated Dired buffer. +Also update the marks in the thumbnail buffer." + (interactive nil image-dired-thumbnail-mode) + (with-current-buffer (image-dired-associated-dired-buffer) + (dired-unmark-all-marks)) + (image-dired-thumb-update-marks)) (defun image-dired-jump-original-dired-buffer () "Jump to the Dired buffer associated with the current image file. You probably want to use this together with `image-dired-track-original-file'." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((buf (image-dired-associated-dired-buffer)) window frame) (setq window (image-dired-get-buffer-window buf)) @@ -1506,10 +1542,16 @@ You probably want to use this together with (define-key map "\C-p" 'image-dired-previous-line) (define-key map "\C-n" 'image-dired-next-line) + (define-key map "<" #'image-dired-beginning-of-buffer) + (define-key map ">" #'image-dired-end-of-buffer) + (define-key map (kbd "M-<") #'image-dired-beginning-of-buffer) + (define-key map (kbd "M->") #'image-dired-end-of-buffer) + (define-key map "d" 'image-dired-flag-thumb-original-file) (define-key map [delete] 'image-dired-flag-thumb-original-file) (define-key map "m" 'image-dired-mark-thumb-original-file) (define-key map "u" 'image-dired-unmark-thumb-original-file) + (define-key map "U" 'image-dired-unmark-all-marks) (define-key map "." 'image-dired-track-original-file) (define-key map [tab] 'image-dired-jump-original-dired-buffer) @@ -1521,8 +1563,6 @@ You probably want to use this together with (define-key map "\C-m" 'image-dired-display-thumbnail-original-image) (define-key map [C-return] 'image-dired-thumbnail-display-external) - (define-key map "l" 'image-dired-rotate-thumbnail-left) - (define-key map "r" 'image-dired-rotate-thumbnail-right) (define-key map "L" 'image-dired-rotate-original-left) (define-key map "R" 'image-dired-rotate-original-right) @@ -1535,6 +1575,15 @@ You probably want to use this together with ;; Mouse (define-key map [mouse-2] 'image-dired-mouse-display-image) (define-key map [mouse-1] 'image-dired-mouse-select-thumbnail) + (define-key map [mouse-3] #'image-dired-mouse-select-thumbnail) + (define-key map [down-mouse-1] #'image-dired-mouse-select-thumbnail) + (define-key map [down-mouse-2] #'image-dired-mouse-select-thumbnail) + (define-key map [down-mouse-3] #'image-dired-mouse-select-thumbnail) + ;; Let's disable mouse dragging, as it currently doesn't do + ;; anything useful. + (define-key map [drag-mouse-1] #'ignore) + (define-key map [drag-mouse-2] #'ignore) + (define-key map [drag-mouse-3] #'ignore) ;; Seems I must first set C-down-mouse-1 to undefined, or else it ;; will trigger the buffer menu. If I try to instead bind ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message @@ -1542,111 +1591,74 @@ You probably want to use this together with ;; probably do not completely understand mouse events. (define-key map [C-down-mouse-1] 'undefined) (define-key map [C-mouse-1] 'image-dired-mouse-toggle-mark) - - ;; Menu - (easy-menu-define nil map - "Menu for `image-dired-thumbnail-mode'." - '("Image-Dired" - ["Display image" image-dired-display-thumbnail-original-image] - ["Display in external viewer" image-dired-thumbnail-display-external] - - ["Mark original" image-dired-mark-thumb-original-file] - ["Unmark original" image-dired-unmark-thumb-original-file] - ["Flag original for deletion" image-dired-flag-thumb-original-file] - - ["Track original" image-dired-track-original-file] - ["Jump to dired buffer" image-dired-jump-original-dired-buffer] - - ["Toggle movement tracking on/off" image-dired-toggle-movement-tracking] - - ["Rotate original right" image-dired-rotate-original-right] - ["Rotate original left" image-dired-rotate-original-left] - ["Rotate thumbnail right" image-dired-rotate-thumbnail-right] - ["Rotate thumbnail left" image-dired-rotate-thumbnail-left] - - ["Line up thumbnails" image-dired-line-up] - ["Dynamic line up" image-dired-line-up-dynamic] - ["Refresh thumb" image-dired-refresh-thumb] - ["Comment thumbnail" image-dired-comment-thumbnail] - ["Tag current or marked thumbnails" image-dired-tag-thumbnail] - ["Remove tag from current or marked thumbnails" - image-dired-tag-thumbnail-remove] - ["Delete marked images" image-dired-delete-marked] - ["Delete thumbnail from buffer" image-dired-delete-char] - ["Quit" quit-window])) map) "Keymap for `image-dired-thumbnail-mode'.") +(easy-menu-define image-dired-thumbnail-mode-menu image-dired-thumbnail-mode-map + "Menu for `image-dired-thumbnail-mode'." + '("Image-Dired" + ["Display image" image-dired-display-thumbnail-original-image] + ["Display in external viewer" image-dired-thumbnail-display-external] + "---" + ["Mark original" image-dired-mark-thumb-original-file] + ["Unmark original" image-dired-unmark-thumb-original-file] + ["Flag original for deletion" image-dired-flag-thumb-original-file] + "---" + ["Track original" image-dired-track-original-file] + ["Jump to dired buffer" image-dired-jump-original-dired-buffer] + ["Toggle movement tracking on/off" image-dired-toggle-movement-tracking + :style toggle + :selected image-dired-track-movement] + "---" + ["Rotate original right" image-dired-rotate-original-right] + ["Rotate original left" image-dired-rotate-original-left] + "---" + ["Line up thumbnails" image-dired-line-up] + ["Dynamic line up" image-dired-line-up-dynamic] + ["Refresh thumb" image-dired-refresh-thumb] + "---" + ["Comment thumbnail" image-dired-comment-thumbnail] + ["Tag current or marked thumbnails" image-dired-tag-thumbnail] + "---" + ["Remove tag from current or marked thumbnails" + image-dired-tag-thumbnail-remove] + ["Unmark all marks" image-dired-unmark-all-marks] + ["Delete marked images" image-dired-delete-marked] + ["Delete thumbnail from buffer" image-dired-delete-char] + "---" + ["Quit" quit-window])) + (defvar image-dired-display-image-mode-map (let ((map (make-sparse-keymap))) - ;; `image-mode-map' has bindings that do not make sense in image-dired - ;; (set-keymap-parent map image-mode-map) - (define-key map "f" 'image-dired-display-current-image-full) - (define-key map "s" 'image-dired-display-current-image-sized) - (define-key map "g" nil) - - ;; Useful bindings from `image-mode-map' - (define-key map [remap forward-char] 'image-forward-hscroll) - (define-key map [remap backward-char] 'image-backward-hscroll) - (define-key map [remap right-char] 'image-forward-hscroll) - (define-key map [remap left-char] 'image-backward-hscroll) - (define-key map [remap previous-line] 'image-previous-line) - (define-key map [remap next-line] 'image-next-line) - (define-key map [remap scroll-up] 'image-scroll-up) - (define-key map [remap scroll-down] 'image-scroll-down) - (define-key map [remap scroll-up-command] 'image-scroll-up) - (define-key map [remap scroll-down-command] 'image-scroll-down) - (define-key map [remap scroll-left] 'image-scroll-left) - (define-key map [remap scroll-right] 'image-scroll-right) - (define-key map [remap move-beginning-of-line] 'image-bol) - (define-key map [remap move-end-of-line] 'image-eol) - (define-key map [remap beginning-of-buffer] 'image-bob) - (define-key map [remap end-of-buffer] 'image-eob) - - (easy-menu-define nil map - "Menu for `image-dired-display-image-mode-map'." - '("Image-Dired" - ["Display original, full size" image-dired-display-current-image-full] - ["Display original, sized to fit" image-dired-display-current-image-sized] - ["Quit" quit-window])) + ;; Disable keybindings from `image-mode-map' that doesn't make sense here. + (define-key map "o" nil) ; image-save + (define-key map "n" nil) ; image-next-file + (define-key map "p" nil) ; image-previous-file + ;; FIXME: Should be replaced with image-dired commands. + (define-key map (kbd "DEL") nil) ; image-next-file + (define-key map (kbd "SPC") nil) ; image-next-file + ;; FIXME: Should be replaced with image-dired commands. + (define-key map "m" nil) ; image-mode-mark-file + (define-key map "u" nil) ; image-mode-unmark-file map) "Keymap for `image-dired-display-image-mode'.") -(defun image-dired-display-current-image-full () - "Display current image in full size." - (interactive) - (let ((file (image-dired-original-file-name))) - (if file - (progn - (image-dired-display-image file t) - (message "Full size image displayed")) - (error "No original file name at point")))) - -(defun image-dired-display-current-image-sized () - "Display current image in sized to fit window dimensions." - (interactive) - (let ((file (image-dired-original-file-name))) - (if file - (progn - (image-dired-display-image file) - (message "Fitted image displayed")) - (error "No original file name at point")))) - (define-derived-mode image-dired-thumbnail-mode special-mode "image-dired-thumbnail" "Browse and manipulate thumbnail images using Dired. Use `image-dired-minor-mode' to get a nice setup." (buffer-disable-undo) - (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) + (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t) + (setq-local bookmark-make-record-function #'image-dired-bookmark-make-record) + ;; Use approximately as much vertical spacing as horizontal. + (setq-local line-spacing (frame-char-width))) (define-derived-mode image-dired-display-image-mode - special-mode "image-dired-image-display" + image-mode "image-dired-image-display" "Mode for displaying and manipulating original image. Resized or in full-size." - (buffer-disable-undo) - (image-mode-setup-winprops) - (setq cursor-type nil) - (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) + :interactive nil + (add-hook 'file-name-at-point-functions #'image-dired-file-name-at-point nil t)) (defvar image-dired-minor-mode-map (let ((map (make-sparse-keymap))) @@ -1670,44 +1682,45 @@ Resized or in full-size." (define-key map "\C-t." 'image-dired-display-thumb) (define-key map "\C-tc" 'image-dired-dired-comment-files) (define-key map "\C-tf" 'image-dired-mark-tagged-files) - - ;; Menu for dired - (easy-menu-define nil map - "Menu for `image-dired-minor-mode'." - '("Image-dired" - ["Display thumb for next file" image-dired-next-line-and-display] - ["Display thumb for previous file" image-dired-previous-line-and-display] - ["Mark and display next" image-dired-mark-and-display-next] - - ["Create thumbnails for marked files" image-dired-create-thumbs] - - ["Display thumbnails append" image-dired-display-thumbs-append] - ["Display this thumbnail" image-dired-display-thumb] - ["Display image" image-dired-dired-display-image] - ["Display in external viewer" image-dired-dired-display-external] - - ["Toggle display properties" image-dired-toggle-dired-display-properties] - ["Toggle append browsing" image-dired-toggle-append-browsing] - ["Toggle movement tracking" image-dired-toggle-movement-tracking] - - ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer] - ["Mark tagged files" image-dired-mark-tagged-files] - ["Comment files" image-dired-dired-comment-files] - ["Copy with EXIF file name" image-dired-copy-with-exif-file-name])) map) "Keymap for `image-dired-minor-mode'.") +(easy-menu-define image-dired-minor-mode-menu image-dired-minor-mode-map + "Menu for `image-dired-minor-mode'." + '("Image-dired" + ["Display thumb for next file" image-dired-next-line-and-display] + ["Display thumb for previous file" image-dired-previous-line-and-display] + ["Mark and display next" image-dired-mark-and-display-next] + "---" + ["Create thumbnails for marked files" image-dired-create-thumbs] + "---" + ["Display thumbnails append" image-dired-display-thumbs-append] + ["Display this thumbnail" image-dired-display-thumb] + ["Display image" image-dired-dired-display-image] + ["Display in external viewer" image-dired-dired-display-external] + "---" + ["Toggle display properties" image-dired-toggle-dired-display-properties + :style toggle + :selected image-dired-dired-disp-props] + ["Toggle append browsing" image-dired-toggle-append-browsing + :style toggle + :selected image-dired-append-when-browsing] + ["Toggle movement tracking" image-dired-toggle-movement-tracking + :style toggle + :selected image-dired-track-movement] + "---" + ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer] + ["Mark tagged files" image-dired-mark-tagged-files] + ["Comment files" image-dired-dired-comment-files] + ["Copy with EXIF file name" image-dired-copy-with-exif-file-name])) + ;;;###autoload (define-minor-mode image-dired-minor-mode "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'." +`image-dired-dired-next-line' and `image-dired-dired-previous-line'." :keymap image-dired-minor-mode-map) -;;;###autoload -(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode - "26.1") - (declare-function clear-image-cache "image.c" (&optional filter)) (defun image-dired-create-thumbs (&optional arg) @@ -1766,7 +1779,7 @@ Ask user for number of images to show and the delay in between." (defun image-dired-delete-char () "Remove current thumbnail from thumbnail buffer and line up." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((inhibit-read-only t)) (delete-char 1) (when (= (following-char) ?\s) @@ -1799,18 +1812,26 @@ See also `image-dired-line-up-dynamic'." (not (eobp))) (delete-char 1))) (goto-char (point-min)) - (let ((count 0)) + (let ((seen 0) + (thumb-prev-pos 0) + (thumb-width-chars + (ceiling (/ (+ (* 2 image-dired-thumb-relief) + (* 2 image-dired-thumb-margin) + (image-dired-thumb-size 'width)) + (float (frame-char-width)))))) (while (not (eobp)) (forward-char) (if (= image-dired-thumbs-per-row 1) (insert "\n") - (insert " ") - (setq count (1+ count)) - (when (and (= count (- image-dired-thumbs-per-row 1)) + (cl-incf thumb-prev-pos thumb-width-chars) + (insert (propertize " " 'display `(space :align-to ,thumb-prev-pos))) + (cl-incf seen) + (when (and (= seen (- image-dired-thumbs-per-row 1)) (not (eobp))) (forward-char) (insert "\n") - (setq count 0))))) + (setq seen 0) + (setq thumb-prev-pos 0))))) (goto-char (point-min)))) (defun image-dired-line-up-dynamic () @@ -1860,11 +1881,6 @@ Ask user how many thumbnails should be displayed per row." "Calculate WINDOW width in pixels." (* (window-width window) (frame-char-width))) -(defun image-dired-window-height-pixels (window) - "Calculate WINDOW height in pixels." - ;; Note: The mode-line consumes one line - (* (- (window-height window) 1) (frame-char-height))) - (defun image-dired-display-window () "Return window where `image-dired-display-image-buffer' is visible." (get-window-with-predicate @@ -1890,59 +1906,24 @@ Ask user how many thumbnails should be displayed per row." (equal (window-buffer window) buf)))) (error "No thumbnail image at point")))) -(defun image-dired-display-window-width (window) - "Return width, in pixels, of WINDOW." - (- (image-dired-window-width-pixels window) - image-dired-display-window-width-correction)) - -(defun image-dired-display-window-height (window) - "Return height, in pixels, of WINDOW." - (- (image-dired-window-height-pixels window) - image-dired-display-window-height-correction)) - -(defun image-dired-display-image (file &optional original-size) +(defun image-dired-display-image (file &optional _ignored) "Display image FILE in image buffer. -Use this when you want to display the image, semi sized, in a new -window. The image is sized to fit the display window (using a -temporary file, don't worry). Because of this, it will not be as -quick as opening it directly, but on most modern systems it -should feel snappy enough. - -If optional argument ORIGINAL-SIZE is non-nil, display image in its -original size." - (image-dired--check-executable-exists - 'image-dired-cmd-create-temp-image-program) - (let ((new-file (expand-file-name image-dired-temp-image-file)) - (window (image-dired-display-window)) - (image-type 'jpeg)) - (setq file (expand-file-name file)) - (if (not original-size) - (let* ((spec - (list - (cons ?p image-dired-cmd-create-temp-image-program) - (cons ?w (image-dired-display-window-width window)) - (cons ?h (image-dired-display-window-height window)) - (cons ?f file) - (cons ?t new-file))) - (ret - (apply #'call-process - image-dired-cmd-create-temp-image-program nil nil nil - (mapcar - (lambda (arg) (format-spec arg spec)) - image-dired-cmd-create-temp-image-options)))) - (when (not (zerop ret)) - (error "Could not resize image"))) - (setq image-type (image-type-from-file-name file)) - (copy-file file new-file t)) - (with-current-buffer (image-dired-create-display-image-buffer) - (let ((inhibit-read-only t)) - (erase-buffer) - (clear-image-cache) - (image-dired-insert-image image-dired-temp-image-file image-type 0 0) - (goto-char (point-min)) - (set-window-vscroll window 0) - (set-window-hscroll window 0) - (image-dired-update-property 'original-file-name file))))) +Use this when you want to display the image, in a new window. +The window will use `image-dired-display-image-mode' which is +based on `image-mode'." + (declare (advertised-calling-convention (file) "29.1")) + (setq file (expand-file-name file)) + (when (not (file-exists-p file)) + (error "No such file: %s" file)) + (let ((buf (get-buffer image-dired-display-image-buffer)) + (cur-win (selected-window))) + (when buf + (kill-buffer buf)) + (when-let ((buf (find-file-other-window file))) + (display-buffer buf) + (rename-buffer image-dired-display-image-buffer) + (image-dired-display-image-mode) + (select-window cur-win)))) (defun image-dired-display-thumbnail-original-image (&optional arg) "Display current thumbnail's original image in display buffer. @@ -1956,8 +1937,6 @@ With prefix argument ARG, display image in its original size." (message "No thumbnail at point") (if (not file) (message "No original file name found") - (image-dired-create-display-image-buffer) - (display-buffer image-dired-display-image-buffer) (image-dired-display-image file arg)))))) @@ -1967,41 +1946,15 @@ With prefix argument ARG, display image in its original size." See documentation for `image-dired-display-image' for more information. With prefix argument ARG, display image in its original size." (interactive "P") - (image-dired-create-display-image-buffer) - (display-buffer image-dired-display-image-buffer) (image-dired-display-image (dired-get-filename) arg)) (defun image-dired-image-at-point-p () "Return non-nil if there is an `image-dired' thumbnail at point." (get-text-property (point) 'image-dired-thumbnail)) -(defun image-dired-rotate-thumbnail (degrees) - "Rotate thumbnail DEGREES degrees." - (image-dired--check-executable-exists - 'image-dired-cmd-rotate-thumbnail-program) - (if (not (image-dired-image-at-point-p)) - (message "No thumbnail at point") - (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) - (thumb (expand-file-name file)) - (spec (list (cons ?d degrees) (cons ?t thumb)))) - (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil - (mapcar (lambda (arg) (format-spec arg spec)) - image-dired-cmd-rotate-thumbnail-options)) - (clear-image-cache thumb)))) - -(defun image-dired-rotate-thumbnail-left () - "Rotate thumbnail left (counter clockwise) 90 degrees." - (interactive) - (image-dired-rotate-thumbnail "270")) - -(defun image-dired-rotate-thumbnail-right () - "Rotate thumbnail counter right (clockwise) 90 degrees." - (interactive) - (image-dired-rotate-thumbnail "90")) - (defun image-dired-refresh-thumb () "Force creation of new image for current thumbnail." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let* ((file (image-dired-original-file-name)) (thumb (expand-file-name (image-dired-thumb-name file)))) (clear-image-cache (expand-file-name thumb)) @@ -2068,8 +2021,8 @@ YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from "%Y:%m:%d %H:%M:%S" (file-attribute-modification-time (file-attributes (expand-file-name file))))) - (setq data (image-dired-get-exif-data (expand-file-name file) - "DateTimeOriginal"))) + (setq data (exif-field 'date-time (exif-parse-file + (expand-file-name file))))) (while (string-match "[ :]" data) (setq data (replace-match "_" nil nil data))) (format "%s%s%s" data @@ -2086,7 +2039,7 @@ default value at the prompt." (if (not (image-dired-image-at-point-p)) (message "No thumbnail at point") (let* ((file (image-dired-original-file-name)) - (old-value (image-dired-get-exif-data file "ImageDescription"))) + (old-value (or (exif-field 'description (exif-parse-file file)) ""))) (if (eq 0 (image-dired-set-exif-data file "ImageDescription" (read-string "Value of ImageDescription: " @@ -2107,33 +2060,9 @@ default value at the prompt." (mapcar (lambda (arg) (format-spec arg spec)) image-dired-cmd-write-exif-data-options)))) -(defun image-dired-get-exif-data (file tag-name) - "From FILE, return EXIF tag TAG-NAME." - (image-dired--check-executable-exists - 'image-dired-cmd-read-exif-data-program) - (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) - (spec (list (cons ?f file) (cons ?t tag-name))) - tag-value) - (with-current-buffer buf - (delete-region (point-min) (point-max)) - (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program - nil t nil - (mapcar - (lambda (arg) (format-spec arg spec)) - image-dired-cmd-read-exif-data-options)) - 0)) - (error "Could not get EXIF tag") - (goto-char (point-min)) - ;; Clean buffer from newlines and carriage returns before - ;; getting final info - (while (search-forward-regexp "[\n\r]" nil t) - (replace-match "" nil t)) - (setq tag-value (buffer-substring (point-min) (point-max))))) - tag-value)) - (defun image-dired-copy-with-exif-file-name () "Copy file with unique name to main image directory. -Copy current or all marked files in dired to a new file in your +Copy current or all marked files in Dired to a new file in your main image directory, using a file name generated by `image-dired-get-exif-file-name'. A typical usage for this if when copying images from a digital camera into the image directory. @@ -2158,17 +2087,18 @@ function. The result is a couple of new files in (copy-file curr-file new-name)) files))) -(defun image-dired-display-next-thumbnail-original () - "In thumbnail buffer, move to next thumbnail and display the image." - (interactive) - (image-dired-forward-image) +(defun image-dired-display-next-thumbnail-original (&optional arg) + "In thumbnail buffer, move to next thumbnail and display the image. +With prefix ARG, move that many thumbnails." + (interactive "p" image-dired-thumbnail-mode) + (image-dired-forward-image arg t) (image-dired-display-thumbnail-original-image)) -(defun image-dired-display-previous-thumbnail-original () - "Move to previous thumbnail and display image." - (interactive) - (image-dired-backward-image) - (image-dired-display-thumbnail-original-image)) +(defun image-dired-display-previous-thumbnail-original (arg) + "In thumbnail buffer, move to previous thumbnail and display image. +With prefix ARG, move that many thumbnails." + (interactive "p" image-dired-thumbnail-mode) + (image-dired-display-next-thumbnail-original (- arg))) (defun image-dired-write-comments (file-comments) "Write file comments to database. @@ -2303,12 +2233,12 @@ non-nil." (interactive "e") (mouse-set-point event) (goto-char (posn-point (event-end event))) + (unless (image-at-point-p) + (image-dired-backward-image)) (let ((file (image-dired-original-file-name))) (when file (if image-dired-track-movement (image-dired-track-original-file)) - (image-dired-create-display-image-buffer) - (display-buffer image-dired-display-image-buffer) (image-dired-display-image file)))) (defun image-dired-mouse-select-thumbnail (event) @@ -2318,19 +2248,29 @@ non-nil." (interactive "e") (mouse-set-point event) (goto-char (posn-point (event-end event))) + (unless (image-at-point-p) + (image-dired-backward-image)) (if image-dired-track-movement (image-dired-track-original-file)) (image-dired-display-thumb-properties)) -(defun image-dired-thumb-file-marked-p () - "Check if file is marked in associated Dired buffer." +(defun image-dired-thumb-file-marked-p (&optional flagged) + "Check if file is marked in associated Dired buffer. +If optional argument FLAGGED is non-nil, check if file is flagged +for deletion instead." (let ((file-name (image-dired-original-file-name)) (dired-buf (image-dired-associated-dired-buffer))) (when (and dired-buf file-name) (with-current-buffer dired-buf (save-excursion (when (dired-goto-file file-name) - (image-dired-dired-file-marked-p))))))) + (if flagged + (image-dired-dired-file-flagged-p) + (image-dired-dired-file-marked-p)))))))) + +(defun image-dired-thumb-file-flagged-p () + "Check if file is flagged for deletion in associated Dired buffer." + (image-dired-thumb-file-marked-p t)) (defun image-dired-delete-marked () "Delete current or marked thumbnails and associated images." @@ -2351,11 +2291,14 @@ non-nil." (let ((inhibit-read-only t)) (while (not (eobp)) (with-silent-modifications - (if (image-dired-thumb-file-marked-p) - (add-face-text-property (point) (1+ (point)) - 'image-dired-thumb-mark) - (remove-text-properties (point) (1+ (point)) - '(face image-dired-thumb-mark)))) + (cond ((image-dired-thumb-file-marked-p) + (add-face-text-property (point) (1+ (point)) + 'image-dired-thumb-mark)) + ((image-dired-thumb-file-flagged-p) + (add-face-text-property (point) (1+ (point)) + 'image-dired-thumb-flagged)) + (t (remove-text-properties (point) (1+ (point)) + '(face image-dired-thumb-mark))))) (forward-char))))))) (defun image-dired-mouse-toggle-mark-1 () @@ -2402,6 +2345,52 @@ Track this in associated Dired buffer if props comment))))) + +;;;; Gallery support + +;; TODO: +;; * Support gallery creation when using per-directory thumbnail +;; storage. +;; * Enhanced gallery creation with basic CSS-support and pagination +;; of tag pages with many pictures. + +(defgroup image-dired-gallery nil + "Image-Dired support for generating a HTML gallery." + :prefix "image-dired-" + :group 'image-dired + :version "29.1") + +(defcustom image-dired-gallery-dir + (expand-file-name ".image-dired_gallery" image-dired-dir) + "Directory to store generated gallery html pages. +The name of this directory needs to be \"shared\" to the public +so that it can access the index.html page that image-dired creates." + :type 'directory) + +(defcustom image-dired-gallery-image-root-url + "https://example.org/image-diredpics" + "URL where the full size images are to be found on your web server. +Note that this URL has to be configured on your web server. +Image-Dired expects to find pictures in this directory. +This is used by `image-dired-gallery-generate'." + :type 'string + :version "29.1") + +(defcustom image-dired-gallery-thumb-image-root-url + "https://example.org/image-diredthumbs" + "URL where the thumbnail images are to be found on your web server. +Note that URL path has to be configured on your web server. +Image-Dired expects to find pictures in this directory. +This is used by `image-dired-gallery-generate'." + :type 'string + :version "29.1") + +(defcustom image-dired-gallery-hidden-tags + (list "private" "hidden" "pending") + "List of \"hidden\" tags. +Used by `image-dired-gallery-generate' to leave out \"hidden\" images." + :type '(repeat string)) + (defvar image-dired-tag-file-list nil "List to store tag-file structure.") @@ -2411,19 +2400,8 @@ Track this in associated Dired buffer if (defvar image-dired-file-comment-list nil "List to store file comments.") -(defun image-dired-add-to-tag-file-list (tag file) - "Add relation between TAG and FILE." - (let (curr) - (if image-dired-tag-file-list - (if (setq curr (assoc tag image-dired-tag-file-list)) - (if (not (member file curr)) - (setcdr curr (cons file (cdr curr)))) - (setcdr image-dired-tag-file-list - (cons (list tag file) (cdr image-dired-tag-file-list)))) - (setq image-dired-tag-file-list (list (list tag file)))))) - -(defun image-dired-add-to-tag-file-lists (tag file) - "Helper function used from `image-dired-create-gallery-lists'. +(defun image-dired--add-to-tag-file-lists (tag file) + "Helper function used from `image-dired--create-gallery-lists'. Add TAG to FILE in one list and FILE to TAG in the other. @@ -2457,8 +2435,8 @@ image-dired-tag-file-list: (cons (list tag file) (cdr image-dired-tag-file-list)))) (setq image-dired-tag-file-list (list (list tag file)))))) -(defun image-dired-add-to-file-comment-list (file comment) - "Helper function used from `image-dired-create-gallery-lists'. +(defun image-dired--add-to-file-comment-list (file comment) + "Helper function used from `image-dired--create-gallery-lists'. For FILE, add COMMENT to list. @@ -2476,7 +2454,7 @@ image-dired-file-comment-list: (cdr image-dired-file-comment-list)))) (setq image-dired-file-comment-list (list (cons file comment))))) -(defun image-dired-create-gallery-lists () +(defun image-dired--create-gallery-lists () "Create temporary lists used by `image-dired-gallery-generate'." (image-dired-sane-db-file) (image-dired--with-db-file @@ -2497,15 +2475,15 @@ image-dired-file-comment-list: (setq file (car row-tags)) (dolist (x (cdr row-tags)) (if (not (string-match "^comment:\\(.*\\)" x)) - (image-dired-add-to-tag-file-lists x file) - (image-dired-add-to-file-comment-list file (match-string 1 x))))))) + (image-dired--add-to-tag-file-lists x file) + (image-dired--add-to-file-comment-list file (match-string 1 x))))))) ;; Sort tag-file list (setq image-dired-tag-file-list (sort image-dired-tag-file-list (lambda (x y) (string< (car x) (car y)))))) -(defun image-dired-hidden-p (file) +(defun image-dired--hidden-p (file) "Return t if image FILE has a \"hidden\" tag." (cl-loop for tag in (cdr (assoc file image-dired-file-tag-list)) if (member tag image-dired-gallery-hidden-tags) return t)) @@ -2519,7 +2497,7 @@ it easier to generate, then HTML-files are created in (if (eq 'per-directory image-dired-thumbnail-storage) (error "Currently, gallery generation is not supported \ when using per-directory thumbnail file storage")) - (image-dired-create-gallery-lists) + (image-dired--create-gallery-lists) (let ((tags image-dired-tag-file-list) (index-file (format "%s/index.html" image-dired-gallery-dir)) count tag tag-file @@ -2601,6 +2579,9 @@ when using per-directory thumbnail file storage")) (insert " </body>\n") (insert "</html>")))) + +;;;; Tag support + (defvar image-dired-widget-list nil "List to keep track of meta data in edit buffer.") @@ -2702,6 +2683,272 @@ tags to their respective image file. Internal function used by (dolist (tag tag-list) (push (cons file tag) lst)))))) + +;;;; bookmark.el support + +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) + +(defun image-dired-bookmark-name () + "Create a default bookmark name for the current EWW buffer." + (file-name-nondirectory + (directory-file-name + (file-name-directory (image-dired-original-file-name))))) + +(defun image-dired-bookmark-make-record () + "Create a bookmark for the current EWW buffer." + `(,(image-dired-bookmark-name) + ,@(bookmark-make-record-default t) + (location . ,(file-name-directory (image-dired-original-file-name))) + (image-dired-file . ,(file-name-nondirectory (image-dired-original-file-name))) + (handler . image-dired-bookmark-jump))) + +;;;###autoload +(defun image-dired-bookmark-jump (bookmark) + "Default bookmark handler for Image-Dired buffers." + ;; User already cached thumbnails, so disable any checking. + (let ((image-dired-show-all-from-dir-max-files nil)) + (image-dired (bookmark-prop-get bookmark 'location)) + ;; TODO: Go to the bookmarked file, if it exists. + ;; (bookmark-prop-get bookmark 'image-dired-file) + (goto-char (point-min)))) + + +;;;; Obsolete + +;;;###autoload +(define-obsolete-function-alias 'tumme #'image-dired "24.4") + +;;;###autoload +(define-obsolete-function-alias 'image-dired-setup-dired-keybindings + #'image-dired-minor-mode "26.1") + +(defcustom image-dired-temp-image-file + (expand-file-name ".image-dired_temp" image-dired-dir) + "Name of temporary image file used by various commands." + :type 'file) +(make-obsolete-variable 'image-dired-temp-image-file + "no longer used." "29.1") + +(defcustom image-dired-cmd-create-temp-image-program + (if (executable-find "gm") "gm" "convert") + "Executable used to create temporary image. +Used together with `image-dired-cmd-create-temp-image-options'." + :type 'file + :version "29.1") +(make-obsolete-variable 'image-dired-cmd-create-temp-image-program + "no longer used." "29.1") + +(defcustom image-dired-cmd-create-temp-image-options + (let ((opts '("-size" "%wx%h" "%f[0]" + "-resize" "%wx%h>" + "-strip" "jpeg:%t"))) + (if (executable-find "gm") (cons "convert" opts) opts)) + "Options of command used to create temporary image for display window. +Used together with `image-dired-cmd-create-temp-image-program', +Available format specifiers are: %w and %h which are replaced by +the calculated max size for width and height in the image display window, +%f which is replaced by the file name of the original image and %t which +is replaced by the file name of the temporary file." + :version "29.1" + :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'image-dired-cmd-create-temp-image-options + "no longer used." "29.1") + +(defcustom image-dired-display-window-width-correction 1 + "Number to be used to correct image display window width. +Change if the default (1) does not work (i.e. if the image does not +completely fit)." + :type 'integer) +(make-obsolete-variable 'image-dired-display-window-width-correction + "no longer used." "29.1") + +(defcustom image-dired-display-window-height-correction 0 + "Number to be used to correct image display window height. +Change if the default (0) does not work (i.e. if the image does not +completely fit)." + :type 'integer) +(make-obsolete-variable 'image-dired-display-window-height-correction + "no longer used." "29.1") + +(defun image-dired-display-window-width (window) + "Return width, in pixels, of WINDOW." + (declare (obsolete nil "29.1")) + (- (image-dired-window-width-pixels window) + image-dired-display-window-width-correction)) + +(defun image-dired-display-window-height (window) + "Return height, in pixels, of WINDOW." + (declare (obsolete nil "29.1")) + (- (image-dired-window-height-pixels window) + image-dired-display-window-height-correction)) + +(defun image-dired-window-height-pixels (window) + "Calculate WINDOW height in pixels." + (declare (obsolete nil "29.1")) + ;; Note: The mode-line consumes one line + (* (- (window-height window) 1) (frame-char-height))) + +(defcustom image-dired-cmd-read-exif-data-program "exiftool" + "Program used to read EXIF data to image. +Used together with `image-dired-cmd-read-exif-data-options'." + :type 'file) +(make-obsolete-variable 'image-dired-cmd-read-exif-data-program + "use `exif-parse-file' and `exif-field' instead." "29.1") + +(defcustom image-dired-cmd-read-exif-data-options '("-s" "-s" "-s" "-%t" "%f") + "Arguments of command used to read EXIF data. +Used with `image-dired-cmd-read-exif-data-program'. +Available format specifiers are: %f which is replaced +by the image file name and %t which is replaced by the tag name." + :version "26.1" + :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'image-dired-cmd-read-exif-data-options + "use `exif-parse-file' and `exif-field' instead." "29.1") + +(defun image-dired-get-exif-data (file tag-name) + "From FILE, return EXIF tag TAG-NAME." + (declare (obsolete "use `exif-parse-file' and `exif-field' instead." "29.1")) + (image-dired--check-executable-exists + 'image-dired-cmd-read-exif-data-program) + (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) + (spec (list (cons ?f file) (cons ?t tag-name))) + tag-value) + (with-current-buffer buf + (delete-region (point-min) (point-max)) + (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program + nil t nil + (mapcar + (lambda (arg) (format-spec arg spec)) + image-dired-cmd-read-exif-data-options)) + 0)) + (error "Could not get EXIF tag") + (goto-char (point-min)) + ;; Clean buffer from newlines and carriage returns before + ;; getting final info + (while (search-forward-regexp "[\n\r]" nil t) + (replace-match "" nil t)) + (setq tag-value (buffer-substring (point-min) (point-max))))) + tag-value)) + +(defcustom image-dired-cmd-rotate-thumbnail-program + (if (executable-find "gm") "gm" "mogrify") + "Executable used to rotate thumbnail. +Used together with `image-dired-cmd-rotate-thumbnail-options'." + :type 'file + :version "29.1") +(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-program nil "29.1") + +(defcustom image-dired-cmd-rotate-thumbnail-options + (let ((opts '("-rotate" "%d" "%t"))) + (if (executable-find "gm") (cons "mogrify" opts) opts)) + "Arguments of command used to rotate thumbnail image. +Used with `image-dired-cmd-rotate-thumbnail-program'. +Available format specifiers are: %d which is replaced by the +number of (positive) degrees to rotate the image, normally 90 or 270 +\(for 90 degrees right and left), %t which is replaced by the file name +of the thumbnail file." + :version "29.1" + :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-options nil "29.1") + +(defun image-dired-rotate-thumbnail (degrees) + "Rotate thumbnail DEGREES degrees." + (declare (obsolete image-dired-refresh-thumb "29.1")) + (image-dired--check-executable-exists + 'image-dired-cmd-rotate-thumbnail-program) + (if (not (image-dired-image-at-point-p)) + (message "No thumbnail at point") + (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) + (thumb (expand-file-name file)) + (spec (list (cons ?d degrees) (cons ?t thumb)))) + (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-rotate-thumbnail-options)) + (clear-image-cache thumb)))) + +(defun image-dired-rotate-thumbnail-left () + "Rotate thumbnail left (counter clockwise) 90 degrees." + (declare (obsolete image-dired-refresh-thumb "29.1")) + (interactive) + (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail)) + (image-dired-rotate-thumbnail "270"))) + +(defun image-dired-rotate-thumbnail-right () + "Rotate thumbnail counter right (clockwise) 90 degrees." + (declare (obsolete image-dired-refresh-thumb "29.1")) + (interactive) + (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail)) + (image-dired-rotate-thumbnail "90"))) + +(defun image-dired-modify-mark-on-thumb-original-file (command) + "Modify mark in Dired buffer. +COMMAND is one of `mark' for marking file in Dired, `unmark' for +unmarking file in Dired or `flag' for flagging file for delete in +Dired." + (declare (obsolete image-dired--on-file-in-dired-buffer "29.1")) + (let ((file-name (image-dired-original-file-name)) + (dired-buf (image-dired-associated-dired-buffer))) + (if (not (and dired-buf file-name)) + (message "No image, or image with correct properties, at point.") + (with-current-buffer dired-buf + (message "%s" file-name) + (when (dired-goto-file file-name) + (cond ((eq command 'mark) (dired-mark 1)) + ((eq command 'unmark) (dired-unmark 1)) + ((eq command 'toggle) + (if (image-dired-dired-file-marked-p) + (dired-unmark 1) + (dired-mark 1))) + ((eq command 'flag) (dired-flag-file-deletion 1))) + (image-dired-thumb-update-marks)))))) + +(defun image-dired-display-current-image-full () + "Display current image in full size." + (declare (obsolete image-transform-original "29.1")) + (interactive nil image-dired-thumbnail-mode) + (let ((file (image-dired-original-file-name))) + (if file + (progn + (image-dired-display-image file) + (with-current-buffer image-dired-display-image-buffer + (image-transform-original))) + (error "No original file name at point")))) + +(defun image-dired-display-current-image-sized () + "Display current image in sized to fit window dimensions." + (declare (obsolete image-mode-fit-frame "29.1")) + (interactive nil image-dired-thumbnail-mode) + (let ((file (image-dired-original-file-name))) + (if file + (progn + (image-dired-display-image file)) + (error "No original file name at point")))) + +(defun image-dired-add-to-tag-file-list (tag file) + "Add relation between TAG and FILE." + (declare (obsolete nil "29.1")) + (let (curr) + (if image-dired-tag-file-list + (if (setq curr (assoc tag image-dired-tag-file-list)) + (if (not (member file curr)) + (setcdr curr (cons file (cdr curr)))) + (setcdr image-dired-tag-file-list + (cons (list tag file) (cdr image-dired-tag-file-list)))) + (setq image-dired-tag-file-list (list (list tag file)))))) + +(define-obsolete-function-alias 'image-dired-create-display-image-buffer + #'ignore "29.1") +(define-obsolete-function-alias 'image-dired-create-gallery-lists + #'image-dired--create-gallery-lists "29.1") +(define-obsolete-function-alias 'image-dired-add-to-file-comment-list + #'image-dired--add-to-file-comment-list "29.1") +(define-obsolete-function-alias 'image-dired-add-to-tag-file-lists + #'image-dired--add-to-tag-file-lists "29.1") +(define-obsolete-function-alias 'image-dired-hidden-p + #'image-dired--hidden-p "29.1") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;; TEST-SECTION ;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2733,23 +2980,6 @@ tags to their respective image file. Internal function used by ;; (setq dirsize (- dirsize (car (cdar files)))) ;; (setq files (cdr files))))) -;;;;;;;;;;;;;;;;;;;;;;, - -;; (defun dired-speedbar-buttons (dired-buffer) -;; (when (and (boundp 'image-dired-use-speedbar) -;; image-dired-use-speedbar) -;; (let ((filename (with-current-buffer dired-buffer -;; (dired-get-filename)))) -;; (when (and (not (string-equal filename (buffer-string))) -;; (string-match (image-file-name-regexp) filename)) -;; (erase-buffer) -;; (insert (propertize -;; filename -;; 'display -;; (image-dired-get-thumbnail-image filename))))))) - -;; (setq image-dired-use-speedbar t) - (provide 'image-dired) ;;; image-dired.el ends here diff --git a/lisp/image-file.el b/lisp/image-file.el index fbc9eaaf94e..6df43f737dd 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -37,7 +37,7 @@ ;;;###autoload (defcustom image-file-name-extensions - (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) + (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp")) "A list of image-file filename extensions. Filenames having one of these extensions are considered image files, in addition to those matching `image-file-name-regexps'. diff --git a/lisp/image.el b/lisp/image.el index 6e1dbbdf5cd..4815f009490 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -48,6 +48,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm) ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff) ("\\`[\t\n\r ]*%!PS" . postscript) ("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg) + ("\\`RIFF....WEBPVP8" . webp) (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)"))) (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<" @@ -67,6 +68,7 @@ a non-nil value, TYPE is the image's type.") '(("\\.png\\'" . png) ("\\.gif\\'" . gif) ("\\.jpe?g\\'" . jpeg) + ("\\.webp\\'" . webp) ("\\.bmp\\'" . bmp) ("\\.xpm\\'" . xpm) ("\\.pbm\\'" . pbm) @@ -92,6 +94,7 @@ be of image type IMAGE-TYPE.") (jpeg . maybe) (tiff . maybe) (svg . maybe) + (webp . maybe) (postscript . nil)) "Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files. \(See `image-type-auto-detected-p'). @@ -600,7 +603,7 @@ means display it in the right marginal area." ;;;###autoload -(defun insert-image (image &optional string area slice) +(defun insert-image (image &optional string area slice inhibit-isearch) "Insert IMAGE into current buffer at point. IMAGE is displayed by inserting STRING into the current buffer with a `display' property whose value is the image. @@ -617,7 +620,11 @@ SLICE specifies slice of IMAGE to insert. SLICE nil or omitted means insert whole image. SLICE is a list (X Y WIDTH HEIGHT) specifying the X and Y positions and WIDTH and HEIGHT of image area to insert. A float value 0.0 - 1.0 means relative to the width or -height of the image; integer values are taken as pixel values." +height of the image; integer values are taken as pixel values. + +Normally `isearch' is able to search for STRING in the buffer +even if it's hidden behind a displayed image. If INHIBIT-ISEARCH +is non-nil, this is inhibited." ;; Use a space as least likely to cause trouble when it's a hidden ;; character in the buffer. (unless string (setq string " ")) @@ -641,6 +648,7 @@ height of the image; integer values are taken as pixel values." (list (cons 'slice slice) image) image) rear-nonsticky t + inhibit-isearch ,inhibit-isearch keymap ,image-map)))) @@ -791,7 +799,7 @@ Example: (defimage test-image ((:type xpm :file \"~/test1.xpm\") (:type xbm :file \"~/test1.xbm\")))" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(defvar ,symbol (find-image ',specs) ,doc)) @@ -1137,6 +1145,13 @@ default is 20%." (error "No image under point")) image)) +;;;###autoload +(defun image-at-point-p () + "Return non-nil if there is an image at point." + (condition-case nil + (prog1 t (image--get-image)) + (error nil))) + (defun image--get-imagemagick-and-warn (&optional position) (declare-function image-transforms-p "image.c" (&optional frame)) (unless (or (fboundp 'imagemagick-types) (image-transforms-p)) diff --git a/lisp/image/exif.el b/lisp/image/exif.el index c2cf2346408..372e2d25553 100644 --- a/lisp/image/exif.el +++ b/lisp/image/exif.el @@ -58,6 +58,9 @@ ;; (:tag 306 :tag-name date-time :format 2 :format-type ascii ;; :value "2019:09:21 16:22:13") ;; ...) +;; +;; (exif-field 'date-time (exif-parse-file "test.jpg")) => +;; "2022:09:14 18:46:19" ;;; Code: @@ -65,6 +68,7 @@ (defvar exif-tag-alist '((11 processing-software) + (270 description) (271 make) (272 model) (274 orientation) @@ -73,7 +77,8 @@ (296 resolution-unit) (305 software) (306 date-time) - (315 artist)) + (315 artist) + (33432 copyright)) "Alist of tag values and their names.") (defconst exif--orientation @@ -122,13 +127,20 @@ If the data is invalid, an `exif-error' is signaled." (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) (exif--parse-exif-chunk app1)))))) +(defun exif-field (field data) + "Return raw FIELD from EXIF. +If FIELD is not present in the data, return nil. +FIELD is a symbol in the cdr of `exif-tag-alist'. +DATA is the result of calling `exif-parse-file'." + (plist-get (seq-find (lambda (e) + (eq field (plist-get e :tag-name))) + data) + :value)) + (defun exif-orientation (exif) "Return the orientation (in degrees) in EXIF. If the orientation isn't present in the data, return nil." - (let ((code (plist-get (cl-find 'orientation exif - :key (lambda (e) - (plist-get e :tag-name))) - :value))) + (let ((code (exif-field 'orientation exif))) (cadr (assq code exif--orientation)))) (defun exif--parse-jpeg () diff --git a/lisp/info-look.el b/lisp/info-look.el index cc6a806f56f..48120359193 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -43,6 +43,7 @@ (require 'info) (eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'cl-lib)) (defgroup info-lookup nil "Major mode sensitive help agent." @@ -123,6 +124,14 @@ OTHER-MODES is a list of cross references to other help modes.") (defsubst info-lookup->mode-value (topic mode) (assoc mode (info-lookup->topic-value topic))) +(defun info-lookup--expand-info (info) + ;; We have a dynamic doc-spec function. + (when (and (null (nth 3 info)) + (nth 6 info)) + (setf (nth 3 info) (funcall (nth 6 info)) + (nth 6 info) nil)) + info) + (defsubst info-lookup->regexp (topic mode) (nth 1 (info-lookup->mode-value topic mode))) @@ -145,7 +154,11 @@ Function arguments are specified as keyword/argument pairs: (KEYWORD . ARGUMENT) KEYWORD is either `:topic', `:mode', `:regexp', `:ignore-case', - `:doc-spec', `:parse-rule', or `:other-modes'. + `:doc-spec', `:parse-rule', `:other-modes' or `:doc-spec-function'. + `:doc-spec-function' is used to compute a `:doc-spec', but instead of + doing so at load time, this is done when the user asks for info on + the mode in question. + ARGUMENT has a value as explained in the documentation of the variable `info-lookup-alist'. @@ -161,7 +174,8 @@ for more details." (defun info-lookup-add-help* (maybe &rest arg) (let (topic mode regexp ignore-case doc-spec - parse-rule other-modes keyword value) + parse-rule other-modes keyword value + doc-spec-function) (setq topic 'symbol mode major-mode regexp "\\w+") @@ -184,6 +198,8 @@ for more details." (setq ignore-case value)) ((eq keyword :doc-spec) (setq doc-spec value)) + ((eq keyword :doc-spec-function) + (setq doc-spec-function value)) ((eq keyword :parse-rule) (setq parse-rule value)) ((eq keyword :other-modes) @@ -191,7 +207,8 @@ for more details." (t (error "Unknown keyword \"%S\"" keyword)))) (or (and maybe (info-lookup->mode-value topic mode)) - (let* ((data (list regexp ignore-case doc-spec parse-rule other-modes)) + (let* ((data (list regexp ignore-case doc-spec parse-rule other-modes + doc-spec-function)) (topic-cell (or (assoc topic info-lookup-alist) (car (setq info-lookup-alist (cons (cons topic nil) @@ -341,11 +358,22 @@ If optional argument QUERY is non-nil, query for the help mode." (error "No %s help available for `%s'" topic mode)) (setq info-lookup-mode mode))) +(defun info-lookup--item-to-mode (item mode) + (let ((spec (cons mode (car (split-string (if (stringp item) + item + (symbol-name item)) + "-"))))) + (if (assoc spec (cdr (assq 'symbol info-lookup-alist))) + spec + mode))) + (defun info-lookup (topic item mode) "Display the documentation of a help item." (or mode (setq mode (info-lookup-select-mode))) - (or (info-lookup->mode-value topic mode) - (error "No %s help available for `%s'" topic mode)) + (setq mode (info-lookup--item-to-mode item mode)) + (if-let ((info (info-lookup->mode-value topic mode))) + (info-lookup--expand-info info) + (error "No %s help available for `%s'" topic mode)) (let* ((completions (info-lookup->completions topic mode)) (ignore-case (info-lookup->ignore-case topic mode)) (entry (or (assoc (if ignore-case (downcase item) item) completions) @@ -724,6 +752,8 @@ Return nil if there is nothing appropriate in the buffer near point." (defun info-complete (topic mode) "Try to complete a help item." (barf-if-buffer-read-only) + (when-let ((info (info-lookup->mode-value topic mode))) + (info-lookup--expand-info info)) (let ((data (info-lookup-completions-at-point topic mode))) (if (null data) (error "No %s completion available for `%s' at point" topic mode) @@ -904,9 +934,16 @@ Return nil if there is nothing appropriate in the buffer near point." (info-lookup-maybe-add-help :mode 'python-mode - :doc-spec `((,(if (Info-find-file "python3.9" t) - "(python3.9)Index" - "(python)Index")))) + ;; Debian includes Python info files, but they're version-named + ;; instead of having a symlink. + :doc-spec-function (lambda () + (list + (list + (cl-loop for version from 20 downto 7 + for name = (format "python3.%d" version) + if (Info-find-file name t) + return (format "(%s)Index" name) + finally return "(python)Index"))))) (info-lookup-maybe-add-help :mode 'cperl-mode @@ -944,6 +981,67 @@ Return nil if there is nothing appropriate in the buffer near point." ("(cl)Function Index" nil "^ -+ .*: " "\\( \\|$\\)") ("(cl)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)"))) +(mapc + (lambda (elem) + (let* ((prefix (car elem))) + (info-lookup-add-help + :mode (cons 'emacs-lisp-mode prefix) + :regexp (concat "\\b" prefix "-[^][()`'‘’,\" \t\n]+") + :doc-spec (cl-loop for node in (cdr elem) + collect + (list (if (string-match-p "^(" node) + node + (format "(%s)%s" prefix node)) + nil "^ -+ .*: " "\\( \\|$\\)"))))) + ;; Below we have a list of prefixes (used to match on symbols in + ;; `emacs-lisp-mode') and the nodes where the function/variable + ;; indices live. If the prefix is different than the name of the + ;; manual, then the full "(manual)Node" name has to be used. + '(("auth" "Function Index" "Variable Index") + ("autotype" "Command Index" "Variable Index") + ("calc" "Lisp Function Index" "Variable Index") + ;;("cc-mode" "Variable Index" "Command and Function Index") + ("dbus" "Index") + ("ediff" "Index") + ("eieio" "Function Index") + ("gnutls" "(emacs-gnutls)Variable Index" "(emacs-gnutls)Function Index") + ("mm" "(emacs-mime)Index") + ("epa" "Variable Index" "Function Index") + ("ert" "Index") + ("eshell" "Function and Variable Index") + ("eudc" "Index") + ("eww" "Variable Index" "Lisp Function Index") + ("flymake" "Index") + ("forms" "Index") + ("gnus" "Index") + ("htmlfontify" "Functions" "Variables & Customization") + ("idlwave" "Index") + ("ido" "Variable Index" "Function Index") + ("info" "Index") + ("mairix" "(mairix-el)Variable Index" "(mairix-el)Function Index") + ("message" "Index") + ("mh" "(mh-e)Option Index" "(mh-e)Command Index") + ("newsticker" "Index") + ("octave" "(octave-mode)Variable Index" "(octave-mode)Lisp Function Index") + ("org" "Variable Index" "Command and Function Index") + ("pgg" "Variable Index" "Function Index") + ("rcirc" "Variable Index" "Index") + ("reftex" "Index") + ("sasl" "Variable Index" "Function Index") + ("sc" "Variable Index") + ("semantic" "Index") + ("ses" "Index") + ("sieve" "Index") + ("smtpmail" "Function and Variable Index") + ("srecode" "Index") + ("tramp" "Variable Index" "Function Index") + ("url" "Variable Index" "Function Index") + ("vhdl" "(vhdl-mode)Variable Index" "(vhdl-mode)Command Index") + ("viper" "Variable Index" "Function Index") + ("widget" "Index") + ("wisent" "Index") + ("woman" "Variable Index" "Command Index"))) + ;; docstrings talk about elisp, so have apropos-mode follow emacs-lisp-mode (info-lookup-maybe-add-help :mode 'apropos-mode diff --git a/lisp/info.el b/lisp/info.el index 8c08eaec3c8..41889d6de17 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2604,12 +2604,9 @@ new buffer." (if (eq (length completions) 1) (setq default (car completions))) (if completions - (let ((input (completing-read (if default - (concat - "Follow reference named (default " - default "): ") - "Follow reference named: ") - completions nil t))) + (let ((input (completing-read (format-prompt "Follow reference named" + default) + completions nil t))) (list (if (equal input "") default input) current-prefix-arg)) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 629cd4c2879..883b0b60fc9 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -1553,7 +1553,7 @@ MAP := MAP-IDs := MAP-ID ... MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET MAP-ID := integer" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(let ((prog ,(unwind-protect (progn ;; To make ,(charset-id CHARSET) works well. diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index fcd22e09d29..7c3a7cd1a9e 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -816,11 +816,16 @@ (#x1D7EC #x1D7F5 mathematical-sans-serif-bold) (#x1D7F6 #x1D7FF mathematical-monospace))) (let ((slot (assq (nth 2 math-subgroup) script-representative-chars))) + ;; Add both ends of each subgroup to help filter out some + ;; incomplete fonts, e.g. those that cover MATHEMATICAL SCRIPT + ;; CAPITAL glyphs but not MATHEMATICAL SCRIPT SMALL ones. (if slot - (if (vectorp (cdr slot)) - (setcdr slot (vconcat (cdr slot) (vector (car math-subgroup)))) - (setcdr slot (vector (cadr slot) (car math-subgroup)))) - (setq slot (list (nth 2 math-subgroup) (car math-subgroup))) + (setcdr slot (append (list (nth 0 math-subgroup) + (nth 1 math-subgroup)) + (cdr slot))) + (setq slot (list (nth 2 math-subgroup) + (nth 0 math-subgroup) + (nth 1 math-subgroup))) (nconc script-representative-chars (list slot)))) (set-fontset-font "fontset-default" diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index a0a6557c95c..91219ca480c 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2665,6 +2665,20 @@ For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"." locale)) locale)) +(defvar current-locale-environment nil + "The currently set locale environment.") + +(defmacro with-locale-environment (locale-name &rest body) + "Execute BODY with the locale set to LOCALE-NAME." + (declare (indent 1) (debug (sexp def-body))) + (let ((current (gensym))) + `(let ((,current current-locale-environment)) + (unwind-protect + (progn + (set-locale-environment ,locale-name) + ,@body) + (set-locale-environment ,current))))) + (defun set-locale-environment (&optional locale-name frame) "Set up multilingual environment for using LOCALE-NAME. This sets the language environment, the coding system priority, @@ -2690,6 +2704,10 @@ If FRAME is non-nil, only set the keyboard coding system and the terminal coding system for the terminal of that frame, and don't touch session-global parameters like the language environment. +This function sets the `current-locale-environment' variable. To +change the locale temporarily, `with-locale-environment' can be +used. + See also `locale-charset-language-names', `locale-language-names', `locale-preferred-coding-systems' and `locale-coding-system'." (interactive (list (completing-read "Set environment for locale: " @@ -2723,6 +2741,7 @@ See also `locale-charset-language-names', `locale-language-names', (when locale (setq locale (locale-translate locale)) + (setq current-locale-environment locale) ;; Leave the system locales alone if the caller did not specify ;; an explicit locale name, as their defaults are set from @@ -2927,6 +2946,7 @@ Optional 3rd argument DOCSTRING is a documentation string of the property. See also the documentation of `get-char-code-property' and `put-char-code-property'." + (declare (indent defun)) (or (symbolp name) (error "Not a symbol: %s" name)) (if (char-table-p table) @@ -3239,4 +3259,95 @@ as names, not numbers." (define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) +(defface confusingly-reordered + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :inherit warning)) + "Face for highlighting text that was bidi-reordered in confusing ways." + :version "29.1") + +(defvar reorder-starters "[\u202A\u202B\u202D\u202E\u2066-\u2068]+" + "Regular expression for characters that start forced-reordered text.") +(defvar reorder-enders "[\u202C\u2069]+\\|\n" + "Regular expression for characters that end forced-reordered text.") + +(autoload 'text-property-search-forward "text-property-search") +(autoload 'prop-match-beginning "text-property-search") +(autoload 'prop-match-end "text-property-search") + +(defun highlight-confusing-reorderings (beg end &optional remove) + "Highlight text in region that might be bidi-reordered in suspicious ways. +This command find and highlights segments of buffer text that could have +been reordered on display by using directional control characters, such +as RLO and LRI, in a way that their display is deliberately meant to +confuse the reader. These techniques can be used for obfuscating +malicious source code. The suspicious stretches of buffer text are +highlighted using the `confusingly-reordered' face. + +If the region is active, check the text inside the region. Otherwise +check the entire buffer. When called from Lisp, pass BEG and END to +specify the portion of the buffer to check. + +Optional argument REMOVE, if non-nil (interactively, prefix argument), +means remove the highlighting from the region between BEG and END, +or the active region if that is set." + (interactive + (if (use-region-p) + (list (region-beginning) (region-end) current-prefix-arg) + (list (point-min) (point-max) current-prefix-arg))) + (save-excursion + (if remove + (let (prop-match) + (goto-char beg) + (while (and + (setq prop-match + (text-property-search-forward 'font-lock-face + 'confusingly-reordered t)) + (< (prop-match-beginning prop-match) end)) + (with-silent-modifications + (remove-list-of-text-properties (prop-match-beginning prop-match) + (prop-match-end prop-match) + '(font-lock-face face mouse-face + help-echo))))) + (let (next) + (goto-char beg) + (while (setq next + (bidi-find-overridden-directionality + (point) end nil + (current-bidi-paragraph-direction))) + (goto-char next) + ;; We detect the problematic parts by watching directional + ;; properties of strong L2R and R2L characters. But + ;; malicious reordering in source buffers can, and usuually + ;; does, include syntactically-important punctuation + ;; characters. Those have "weak" directionality, so we + ;; cannot easily detect when they are affected in malicious + ;; ways. Therefore, once we find a strong directional + ;; character whose directionality was tweaked, we highlight + ;; the text around it, between the first bidi control + ;; character we find before it that starts an + ;; override/embedding/isolate, and the first control after + ;; it that ends these. This could sometimes highlight only + ;; part of the affected text. An alternative would be to + ;; find the first "starter" following BOL and the last + ;; "ender" before EOL, and highlight everything in between + ;; them -- this could sometimes highlight too much. + (let ((start + (save-excursion + (re-search-backward reorder-starters nil t))) + (finish + (save-excursion + (re-search-forward reorder-enders nil t)))) + (with-silent-modifications + (add-text-properties start (1- finish) + '(font-lock-face + confusingly-reordered + face confusingly-reordered + mouse-face highlight + help-echo "\ +This text is reordered on display in a way that could change its semantics; +use \\[forward-char] and \\[backward-char] to see the actual order of characters."))) + (goto-char finish))))))) + ;;; mule-cmds.el ends here diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 9a68fce2e81..ec027e9a932 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -148,6 +148,7 @@ (defmacro define-iso-single-byte-charset (symbol iso-symbol name nickname iso-ir iso-final emacs-mule-id map) + (declare (indent defun)) `(progn (define-charset ,symbol ,name diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 862c577bd5d..5cc73e43671 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -833,7 +833,7 @@ The IGNORED argument is ignored." "Display information about a font whose name is FONTNAME." (interactive (list (completing-read - "Font name (default current choice for ASCII chars): " + (format-prompt "Font name" "current choice for ASCII chars") (and window-system ;; Implied by `window-system'. (fboundp 'x-list-fonts) @@ -1004,7 +1004,7 @@ This shows which font is used for which character(s)." (mapcar 'cdr fontset-alias-alist))) (completion-ignore-case t)) (list (completing-read - "Fontset (default used by the current frame): " + (format-prompt "Fontset" "used by the current frame") fontset-list nil t))))) (if (= (length fontset) 0) (setq fontset (face-attribute 'default :fontset)) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 5022a17db5a..3e45a64dc9a 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -218,6 +218,7 @@ corresponding Unicode character code. If it is a string, it is a name of file that contains the above information. The file format is the same as what described for `:map' attribute." + (declare (indent defun)) (when (vectorp (car props)) ;; Old style code: ;; (define-charset CHARSET-ID CHARSET-SYMBOL INFO-VECTOR) @@ -890,6 +891,7 @@ non-nil. VALUE non-nil means Emacs prefers UTF-8 on code detection for non-ASCII files. This attribute is meaningful only when `:coding-type' is `undecided'." + (declare (indent defun)) (let* ((common-attrs (mapcar 'list '(:mnemonic :coding-type @@ -2320,6 +2322,7 @@ This function sets properties `translation-table' and `translation-table-id' of SYMBOL to the created table itself and the identification number of the table respectively. It also registers the table in `translation-table-vector'." + (declare (indent defun)) (let ((table (if (and (char-table-p (car args)) (eq (char-table-subtype (car args)) 'translation-table)) @@ -2394,6 +2397,7 @@ Value is what BODY returns." Analogous to `define-translation-table', but updates `translation-hash-table-vector' and the table is for use in the CCL `lookup-integer' and `lookup-character' functions." + (declare (indent defun)) (unless (and (symbolp symbol) (hash-table-p table)) (error "Bad args to define-translation-hash-table")) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index ee935b11ec0..5cdd6d6242b 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -917,7 +917,7 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'." The variable `quail-keyboard-layout-type' holds the currently selected keyboard type." (interactive - (list (completing-read "Keyboard type (default current choice): " + (list (completing-read (format-prompt "Keyboard type" "current choice") quail-keyboard-layout-alist nil t))) (or (and keyboard-type (> (length keyboard-type) 0)) diff --git a/lisp/isearch.el b/lisp/isearch.el index d9a48cfcf2d..4c4b9474245 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2478,8 +2478,8 @@ The arguments passed to `highlight-regexp' are the regexp from the last search and the face from `hi-lock-read-face-name'." (interactive) (isearch--highlight-regexp-or-lines - #'(lambda (regexp face lighter) - (highlight-regexp regexp face nil lighter)))) + (lambda (regexp face lighter) + (highlight-regexp regexp face nil lighter)))) (defun isearch-highlight-lines-matching-regexp () "Exit Isearch mode and call `highlight-lines-matching-regexp'. @@ -2487,8 +2487,8 @@ The arguments passed to `highlight-lines-matching-regexp' are the regexp from the last search and the face from `hi-lock-read-face-name'." (interactive) (isearch--highlight-regexp-or-lines - #'(lambda (regexp face _lighter) - (highlight-lines-matching-regexp regexp face)))) + (lambda (regexp face _lighter) + (highlight-lines-matching-regexp regexp face)))) (defun isearch-delete-char () @@ -3536,6 +3536,20 @@ Can be changed via `isearch-search-fun-function' for special needs." (if isearch-forward #'re-search-forward #'re-search-backward) regexp bound noerror count)))) +(defun isearch--search-skip-inhibited (func string bound noerror) + "Search for STRING with FUNC, but skip areas where isearch is inhibited. +Returns the value of the (final) call to the search function." + (let (pos) + (while (and (setq pos (funcall func string bound noerror)) + ;; If we're inhibited here, skip to the end of that + ;; area and try again. + (get-text-property (match-beginning 0) 'inhibit-isearch) + (goto-char (next-single-property-change + (match-beginning 0) + 'inhibit-isearch + nil (point-max))))) + pos)) + (defun isearch-search-string (string bound noerror) "Search for the first occurrence of STRING or its translation. STRING's characters are translated using `translation-table-for-input' @@ -3547,7 +3561,8 @@ The match found must not extend after that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil." (let* ((func (isearch-search-fun)) - (pos1 (save-excursion (funcall func string bound noerror))) + (pos1 (save-excursion + (isearch--search-skip-inhibited func string bound noerror))) pos2) (when (and ;; Avoid "obsolete" warnings for translation-table-for-input. @@ -3570,7 +3585,8 @@ Optional third argument, if t, means if fail just return nil (no error). (when translated (save-match-data (save-excursion - (if (setq pos2 (funcall func translated bound noerror)) + (if (setq pos2 (isearch--search-skip-inhibited + func string bound noerror)) (setq match-data (match-data t))))) (when (and pos2 (or (not pos1) @@ -3724,6 +3740,15 @@ Optional third argument, if t, means if fail just return nil (no error). (overlay-put ov 'isearch-invisible nil))))))) +(defun isearch--invisible-p (val) + "Like `invisible-p', but also takes into account `inhibit-isearch' properties. +If search is inhibited due to the latter, return `inhibit-isearch', and +if it's due to the former, return `invisible'." + (or (and (invisible-p val) + 'invisible) + (and (get-text-property (point) 'inhibit-isearch) + 'inhibit-isearch))) + (defun isearch-range-invisible (beg end) "Return t if all the text from BEG to END is invisible." (when (/= beg end) @@ -3733,16 +3758,19 @@ Optional third argument, if t, means if fail just return nil (no error). (let (;; can-be-opened keeps track if we can open some overlays. (can-be-opened (eq search-invisible 'open)) ;; the list of overlays that could be opened - (crt-overlays nil)) + (crt-overlays nil) + ii-prop) (when (and can-be-opened isearch-hide-immediately) (isearch-close-unnecessary-overlays beg end)) ;; If the following character is currently invisible, ;; skip all characters with that same `invisible' property value. ;; Do that over and over. - (while (and (< (point) end) (invisible-p (point))) - (if (invisible-p (get-text-property (point) 'invisible)) + (while (and (< (point) end) + (isearch--invisible-p (point))) + (if (setq ii-prop (isearch--invisible-p + (get-text-property (point) 'invisible))) (progn - (goto-char (next-single-property-change (point) 'invisible + (goto-char (next-single-property-change (point) ii-prop nil end)) ;; if text is hidden by an `invisible' text property ;; we cannot open it at all. diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index 04e681d743d..e404288ddca 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -60,7 +60,7 @@ If the argument is nil, we return the display table to its standard state." (list (let* ((completion-ignore-case t)) (completing-read - "Cyrillic language (default nil): " + (format-prompt "Cyrillic language" "nil") cyrillic-language-alist nil t nil nil nil)))) (or standard-display-table diff --git a/lisp/language/lao.el b/lisp/language/lao.el index c699d57c15a..93849461eae 100644 --- a/lisp/language/lao.el +++ b/lisp/language/lao.el @@ -59,11 +59,11 @@ (let* ((chars (car l)) (len (length chars)) ;; Replace `c', `t', `v' to consonant, tone, and vowel. - (regexp (mapconcat #'(lambda (c) - (cond ((= c ?c) consonant) - ((= c ?t) tone) - ((= c ?v) vowel-upper-lower) - (t (string c)))) + (regexp (mapconcat (lambda (c) + (cond ((= c ?c) consonant) + ((= c ?t) tone) + ((= c ?v) vowel-upper-lower) + (t (string c)))) (cdr l) "")) ;; Element of composition-function-table. (elt (list (vector regexp 1 #'lao-composition-function) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ee0a50be94e..4b9505a1359 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -338,11 +338,22 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) (autoload 'align "align" "\ Attempt to align a region based on a set of alignment rules. -BEG and END mark the region. If BEG and END are specifically set to -nil (this can only be done programmatically), the beginning and end of -the current alignment section will be calculated based on the location -of point, and the value of `align-region-separate' (or possibly each -rule's `separate' attribute). +Interactively, BEG and END are the mark/point of the current region. + +Many modes define specific alignment rules, and some of these +rules in some modes react to the current prefix argument. For +instance, in `text-mode', `M-x align' will align into columns +based on space delimiters, while `C-u - M-x align' will align +into columns based on the \"$\" character. See the +`align-rules-list' variable definition for the specific rules. + +Also see `align-regexp', which will guide you through various +parameters for aligning text. + +Non-interactively, if BEG and END are nil, the beginning and end +of the current alignment section will be calculated based on the +location of point, and the value of `align-region-separate' (or +possibly each rule's `separate' attribute). If SEPARATE is non-nil, it overrides the value of `align-region-separate' for all rules, except those that have their @@ -360,6 +371,15 @@ Align the current region using an ad-hoc rule read from the minibuffer. BEG and END mark the limits of the region. Interactively, this function prompts for the regular expression REGEXP to align with. +Interactively, if you specify a prefix argument, the function +will guide you through entering the full regular expression, and +then prompts for which subexpression parenthesis GROUP (default +1) within REGEXP to modify, the amount of SPACING (default +`align-default-spacing') to use, and whether or not to REPEAT the +rule throughout the line. + +See `align-rules-list' for more information about these options. + For example, let's say you had a list of phone numbers, and wanted to align them so that the opening parentheses would line up: @@ -379,15 +399,8 @@ regular expression after you enter it. Interactively, you only need to supply the characters to be lined up, and any preceding whitespace is replaced. -Non-interactively (or if you specify a prefix argument), you must -enter the full regular expression, including the subexpression. -Interactively, the function also then prompts for which -subexpression parenthesis GROUP (default 1) within REGEXP to -modify, the amount of SPACING (default `align-default-spacing') -to use, and whether or not to REPEAT the rule throughout the -line. - -See `align-rules-list' for more information about these options. +Non-interactively, you must enter the full regular expression, +including the subexpression. The non-interactive form of the previous example would look something like: (align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\") @@ -1665,6 +1678,8 @@ or if CONDITION had no actions, after all other CONDITIONs. \(fn CONDITION ACTION &optional AFTER)" nil nil) +(function-put 'define-auto-insert 'lisp-indent-function 'defun) + (defvar auto-insert-mode nil "\ Non-nil if Auto-Insert mode is enabled. See the `auto-insert-mode' command @@ -3438,6 +3453,8 @@ See Info node `(calc)Defining Functions'. (function-put 'defmath 'doc-string-elt '3) +(function-put 'defmath 'lisp-indent-function 'defun) + (register-definition-prefixes "calc" '("calc" "defcalcmodevar" "inexact-result" "math-" "var-")) ;;;*** @@ -4467,6 +4484,8 @@ MAP-ID := integer (function-put 'define-ccl-program 'doc-string-elt '3) +(function-put 'define-ccl-program 'lisp-indent-function 'defun) + (autoload 'check-ccl-program "ccl" "\ Check validity of CCL-PROGRAM. If CCL-PROGRAM is a symbol denoting a CCL program, return @@ -7409,6 +7428,8 @@ See Info node `(elisp)Derived Modes' for more details. (function-put 'define-derived-mode 'doc-string-elt '4) +(function-put 'define-derived-mode 'lisp-indent-function 'defun) + (autoload 'derived-mode-init-mode-variables "derived" "\ Initialize variables for a new MODE. Right now, if they don't already exist, set up a blank keymap, an @@ -8801,6 +8822,8 @@ INIT-VALUE LIGHTER KEYMAP. (function-put 'define-minor-mode 'doc-string-elt '2) +(function-put 'define-minor-mode 'lisp-indent-function 'defun) + (defalias 'easy-mmode-define-global-mode #'define-globalized-minor-mode) (defalias 'define-global-minor-mode #'define-globalized-minor-mode) @@ -8838,6 +8861,8 @@ on if the hook has explicitly disabled it. (function-put 'define-globalized-minor-mode 'doc-string-elt '2) +(function-put 'define-globalized-minor-mode 'lisp-indent-function 'defun) + (autoload 'easy-mmode-define-keymap "easy-mmode" "\ Return a keymap built from bindings BS. BS must be a list of (KEY . BINDING) where @@ -10929,7 +10954,7 @@ Look at CONFIG and try to expand GROUP. ;;;### (autoloads nil "erc" "erc/erc.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc.el -(push (purecopy '(erc 5 4)) package--builtin-versions) +(push (purecopy '(erc 5 4 1)) package--builtin-versions) (autoload 'erc-select-read-args "erc" "\ Prompt the user for values of nick, server, port, and password." nil nil) @@ -11135,6 +11160,22 @@ Kill all test buffers that are still live." t nil) ;;;*** +;;;### (autoloads nil "erts-mode" "progmodes/erts-mode.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from progmodes/erts-mode.el + +(autoload 'erts-mode "erts-mode" "\ +Major mode for editing erts (Emacs testing) files. +This mode mainly provides some font locking. + +\\{erts-mode-map} + +\(fn)" t nil) + +(register-definition-prefixes "erts-mode" '("erts-")) + +;;;*** + ;;;### (autoloads nil "esh-arg" "eshell/esh-arg.el" (0 0 0 0)) ;;; Generated autoloads from eshell/esh-arg.el @@ -11479,7 +11520,7 @@ See documentation of variable `tags-file-name'. (make-obsolete 'find-tag-regexp 'xref-find-apropos '"25.1") -(defalias 'pop-tag-mark 'xref-pop-marker-stack) +(defalias 'pop-tag-mark 'xref-go-back) (defalias 'next-file 'tags-next-file) @@ -14456,7 +14497,7 @@ CLEAN is obsolete and ignored. (autoload 'gnus-article-prepare-display "gnus-art" "\ Make the current buffer look like a nice article." nil nil) -(register-definition-prefixes "gnus-art" '("article-" "gnus-")) +(register-definition-prefixes "gnus-art" '(":keymap" "article-" "gnus-")) ;;;*** @@ -14764,7 +14805,7 @@ The arguments have the same meaning as those of \(fn IDS &optional WINDOW-CONF)" t nil) -(register-definition-prefixes "gnus-group" '("gnus-")) +(register-definition-prefixes "gnus-group" '(":keymap" "gnus-")) ;;;*** @@ -14991,7 +15032,7 @@ Like `message-reply'. (define-mail-user-agent 'gnus-user-agent 'gnus-msg-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) -(register-definition-prefixes "gnus-msg" '("gnus-")) +(register-definition-prefixes "gnus-msg" '(":prefix" "gnus-")) ;;;*** @@ -15205,7 +15246,7 @@ BOOKMARK is a bookmark name or a bookmark record. \(fn BOOKMARK)" nil nil) -(register-definition-prefixes "gnus-sum" '("gnus-")) +(register-definition-prefixes "gnus-sum" '(":keymap" "gnus-")) ;;;*** @@ -16232,6 +16273,11 @@ gives the window that lists the options.") ;;;### (autoloads nil "help-mode" "help-mode.el" (0 0 0 0)) ;;; Generated autoloads from help-mode.el +(autoload 'help-mode--add-function-link "help-mode" "\ + + +\(fn STR FUN)" nil nil) + (autoload 'help-mode "help-mode" "\ Major mode for viewing help text and navigating references in it. Entry to this mode runs the normal hook `help-mode-hook'. @@ -18325,6 +18371,8 @@ Example: (function-put 'defimage 'doc-string-elt '3) +(function-put 'defimage 'lisp-indent-function 'defun) + (autoload 'imagemagick-register-types "image" "\ Register file types that can be handled by ImageMagick. This function is called at startup, after loading the init file. @@ -18337,6 +18385,9 @@ recognizes these files as having image type `imagemagick'. If Emacs is compiled without ImageMagick support, this does nothing." nil nil) +(autoload 'image-at-point-p "image" "\ +Return non-nil if there is an image at point." nil nil) + (register-definition-prefixes "image" '("find-image--cache" "image" "unknown-image-type")) ;;;*** @@ -18406,17 +18457,19 @@ thumbnail buffer to be selected. \(fn &optional ARG APPEND DO-NOT-POP)" t nil) (autoload 'image-dired-show-all-from-dir "image-dired" "\ -Make a preview buffer for all images in DIR and display it. -If the number of files in DIR matching `image-file-name-regexp' -exceeds `image-dired-show-all-from-dir-max-files', a warning will be -displayed. +Make a thumbnail buffer for all images in DIR and display it. +Any file matching `image-file-name-regexp' is considered an image +file. + +If the number of image files in DIR exceeds +`image-dired-show-all-from-dir-max-files', ask for confirmation +before creating the thumbnail buffer. If that variable is nil, +never ask for confirmation. \(fn DIR)" t nil) (defalias 'image-dired 'image-dired-show-all-from-dir) -(define-obsolete-function-alias 'tumme 'image-dired "24.4") - (autoload 'image-dired-tag-files "image-dired" "\ Tag marked file(s) in Dired. With prefix ARG, tag file at point. @@ -18452,8 +18505,6 @@ disabled. \(fn &optional ARG)" t nil) -(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode "26.1") - (autoload 'image-dired-display-thumbs-append "image-dired" "\ Append thumbnails to `image-dired-thumbnail-buffer'." t nil) @@ -18486,6 +18537,15 @@ Edit comment and tags of current or marked image files. Edit comment and tags for all marked image files in an easy-to-use form." t nil) +(autoload 'image-dired-bookmark-jump "image-dired" "\ +Default bookmark handler for Image-Dired buffers. + +\(fn BOOKMARK)" nil nil) + +(define-obsolete-function-alias 'tumme #'image-dired "24.4") + +(define-obsolete-function-alias 'image-dired-setup-dired-keybindings #'image-dired-minor-mode "26.1") + (register-definition-prefixes "image-dired" '("image-dired-")) ;;;*** @@ -18493,7 +18553,7 @@ easy-to-use form." t nil) ;;;### (autoloads nil "image-file" "image-file.el" (0 0 0 0)) ;;; Generated autoloads from image-file.el -(defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\ +(defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp")) "\ A list of image-file filename extensions. Filenames having one of these extensions are considered image files, in addition to those matching `image-file-name-regexps'. @@ -19725,7 +19785,7 @@ one of the aforementioned options instead of using this mode. (dolist (name (list "node" "nodejs" "gjs" "rhino")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode))) -(register-definition-prefixes "js" '("js-" "with-js")) +(register-definition-prefixes "js" '("js-")) ;;;*** @@ -21659,7 +21719,7 @@ perform the operation on all messages in that region. \(fn)" t nil) -(register-definition-prefixes "mh-folder" '("mh-")) +(register-definition-prefixes "mh-folder" '(":keymap" "mh-")) ;;;*** @@ -21695,7 +21755,7 @@ perform the operation on all messages in that region. ;;;### (autoloads nil "mh-letter" "mh-e/mh-letter.el" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-letter.el -(register-definition-prefixes "mh-letter" '("mh-")) +(register-definition-prefixes "mh-letter" '(":keymap" "mh-")) ;;;*** @@ -21730,7 +21790,7 @@ perform the operation on all messages in that region. ;;;### (autoloads nil "mh-search" "mh-e/mh-search.el" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-search.el -(register-definition-prefixes "mh-search" '("mh-")) +(register-definition-prefixes "mh-search" '(":keymap" "mh-")) ;;;*** @@ -21744,14 +21804,14 @@ perform the operation on all messages in that region. ;;;### (autoloads nil "mh-show" "mh-e/mh-show.el" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-show.el -(register-definition-prefixes "mh-show" '("mh-")) +(register-definition-prefixes "mh-show" '(":keymap" "mh-")) ;;;*** ;;;### (autoloads nil "mh-speed" "mh-e/mh-speed.el" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-speed.el -(register-definition-prefixes "mh-speed" '("mh-")) +(register-definition-prefixes "mh-speed" '(":keymap" "mh-")) ;;;*** @@ -26573,13 +26633,25 @@ pattern to search for. Visit a file (with completion) in the current project. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." t nil) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'. + +\(fn &optional INCLUDE-ALL)" t nil) (autoload 'project-or-external-find-file "project" "\ Visit a file (with completion) in the current project or external roots. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." t nil) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'. + +\(fn &optional INCLUDE-ALL)" t nil) (autoload 'project-find-dir "project" "\ Start Dired in a directory inside the current project." t nil) @@ -30748,6 +30820,8 @@ SKELETON is as defined under `skeleton-insert'. (function-put 'define-skeleton 'doc-string-elt '2) +(function-put 'define-skeleton 'lisp-indent-function 'defun) + (autoload 'skeleton-proxy-new "skeleton" "\ Insert SKELETON. Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). @@ -31460,7 +31534,7 @@ installed through `spam-necessary-extra-headers'. \(fn &rest SYMBOLS)" t nil) -(register-definition-prefixes "spam" '("spam-")) +(register-definition-prefixes "spam" '(":keymap" "spam-")) ;;;*** @@ -32344,7 +32418,33 @@ If OMIT-NULLS, empty lines will be removed from the results. \(fn STRING &optional OMIT-NULLS)" nil nil) -(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "named-let" "replace-region-contents" "string-" "thread-" "when-let*")) +(autoload 'ensure-empty-lines "subr-x" "\ +Ensure that there's LINES number of empty lines before point. +If LINES is nil or missing, a this ensures that there's a single +empty line before point. + +Interactively, this command uses the numerical prefix for LINES. + +If there's already more empty lines before point than LINES, the +number of blank lines will be reduced. + +If point is not at the beginning of a line, a newline character +is inserted before adjusting the number of empty lines. + +\(fn &optional LINES)" t nil) + +(autoload 'string-pixel-width "subr-x" "\ +Return the width of STRING in pixels. + +\(fn STRING)" nil nil) + +(autoload 'string-glyph-split "subr-x" "\ +Split STRING into a list of strings representing separate glyphs. +This takes into account combining characters and grapheme clusters. + +\(fn STRING)" nil nil) + +(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "named-let" "replace-region-contents" "string-" "thread-" "when-let*" "with-memoization")) ;;;*** @@ -37093,7 +37193,7 @@ Key bindings: ;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/verilog-mode.el -(push (purecopy '(verilog-mode 2021 9 23 89128420)) package--builtin-versions) +(push (purecopy '(verilog-mode 2021 10 14 127365406)) package--builtin-versions) (autoload 'verilog-mode "verilog-mode" "\ Major mode for editing Verilog code. @@ -39241,15 +39341,24 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/xref.el -(push (purecopy '(xref 1 3 0)) package--builtin-versions) +(push (purecopy '(xref 1 3 2)) package--builtin-versions) (autoload 'xref-find-backend "xref" nil nil nil) -(autoload 'xref-pop-marker-stack "xref" "\ -Pop back to where \\[xref-find-definitions] was last invoked." t nil) +(defalias 'xref-pop-marker-stack #'xref-go-back) + +(autoload 'xref-go-back "xref" "\ +Go back to the previous position in xref history. +To undo, use \\[xref-go-forward]." t nil) + +(autoload 'xref-go-forward "xref" "\ +Got to the point where a previous \\[xref-go-back] was invoked." t nil) (autoload 'xref-marker-stack-empty-p "xref" "\ -Return t if the marker stack is empty; nil otherwise." nil nil) +Whether the xref back-history is empty." nil nil) + +(autoload 'xref-forward-history-empty-p "xref" "\ +Whether the xref forward-history is empty." nil nil) (autoload 'xref-find-definitions "xref" "\ Find the definition of the identifier at point. @@ -39261,7 +39370,7 @@ definition for IDENTIFIER, display it in the selected window. Otherwise, display the list of the possible definitions in a buffer where the user can select from the list. -Use \\[xref-pop-marker-stack] to return back to where you invoked this command. +Use \\[xref-go-back] to return back to where you invoked this command. \(fn IDENTIFIER)" t nil) @@ -39305,7 +39414,8 @@ output of this command when the backend is etags. \(fn PATTERN)" t nil) (define-key esc-map "." #'xref-find-definitions) - (define-key esc-map "," #'xref-pop-marker-stack) + (define-key esc-map "," #'xref-go-back) + (define-key esc-map [?\C-,] #'xref-go-forward) (define-key esc-map "?" #'xref-find-references) (define-key esc-map [?\C-.] #'xref-find-apropos) (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el index c25687574ed..ba6ea938425 100644 --- a/lisp/leim/quail/ipa.el +++ b/lisp/leim/quail/ipa.el @@ -278,10 +278,10 @@ string." (list (apply #'vector (mapcar - #'(lambda (entry) - (cl-assert (char-or-string-p entry) t) - (format "%s%s" to-prepend - (if (integerp entry) (string entry) entry))) + (lambda (entry) + (cl-assert (char-or-string-p entry) t) + (format "%s%s" to-prepend + (if (integerp entry) (string entry) entry))) quail-keymap)))) (defun ipa-x-sampa-underscore-implosive (input-string length) diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index 58a8eb7a370..d8fcc1c0a99 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -74,12 +74,9 @@ according to the choice made, and returns a symbol." (rmail-summary-exists) (and (setq old (rmail-get-keywords)) (mapc #'rmail-make-label (split-string old ", ")))) - (completing-read (concat prompt - (if rmail-last-label - (concat " (default " - (symbol-name rmail-last-label) - "): ") - ": ")) + (completing-read (format-prompt prompt + (and rmail-last-label + (symbol-name rmail-last-label))) rmail-label-obarray nil nil)))) diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 99bff66657b..66a1e9a4dbd 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -254,7 +254,7 @@ TRUNCATED is non-nil if the text of this entity was truncated.")) (unless (y-or-n-p "This entity is truncated; save anyway? ") (error "Aborted"))) (setq filename (expand-file-name - (read-file-name (format "Save as (default: %s): " filename) + (read-file-name (format-prompt "Save as" filename) directory (expand-file-name filename directory)) directory)) diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 91f86a234d4..1f5bb2d9f1b 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -107,9 +107,8 @@ error: %S\n" (read-file (expand-file-name (read-file-name - (concat "Output message to mail file (default " - (file-name-nondirectory default-file) - "): ") + (format-prompt "Output message to mail file" + (file-name-nondirectory default-file)) (file-name-directory default-file) (abbreviate-file-name default-file)) (file-name-directory default-file)))) diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el index 0a488e176f6..4347ff14022 100644 --- a/lisp/mail/uce.el +++ b/lisp/mail/uce.el @@ -30,26 +30,8 @@ ;; uce-reply-to-uce. Please let me know about your changes so I can ;; incorporate them. I'd appreciate it. -;; -- !!! NOTE !!! --------------------------------------------- -;; -;; Replying to spam is at best pointless, but most likely actively -;; harmful. -;; -;; - You will confirm that your email address is valid, thus ensuring -;; you get more spam. -;; -;; - You will leak information and open yourself up for further -;; attack. For example, they could use your \"geolocation\" to find -;; your home address and phone number. -;; -;; - The sender address is likely fake. -;; -;; - You help them refine their methods of spamming. -;; -;; Therefore, we strongly recommend that you do not use this package. -;; Use a spam filter instead, or just delete the spam. -;; -;; ------------------------------------------------------------- +;; NOTE: We don't recommend using this feature; see the message in +;; 'uce-reply-to-uce' for the reasons. ;; The command uce-reply-to-uce, if called when the current message ;; buffer is a UCE, will setup a reply *mail* buffer as follows. It @@ -234,6 +216,8 @@ These are mostly meant for headers that prevent delivery errors reporting." (declare-function rmail-maybe-set-message-counters "rmail" ()) (declare-function rmail-toggle-header "rmail" (&optional arg)) +(defvar uce--usage-warning-displayed nil) + ;;;###autoload (defun uce-reply-to-uce (&optional _ignored) "Compose a reply to unsolicited commercial email (UCE). @@ -379,7 +363,32 @@ You might need to set `uce-mail-reader' before using this." ;; Run hooks before we leave buffer for editing. Reasonable usage ;; might be to set up special key bindings, replace standard ;; functions in mail-mode, etc. - (run-hooks 'mail-setup-hook 'uce-setup-hook)))) + (run-hooks 'mail-setup-hook 'uce-setup-hook))) + (unless uce--usage-warning-displayed + (setq uce--usage-warning-displayed t) + (pop-to-buffer (get-buffer-create "uce-reply-to-uce warning")) + (insert "\ +-- !!! NOTE !!! --------------------------------------------- + +Replying to spam is at best pointless, but most likely actively +harmful. + +- You will confirm that your email address is valid, thus ensuring + you get more spam. + +- You will leak information and open yourself up for further + attack. For example, they could use your \"geolocation\" to find + your home address and phone number. + +- The sender address is likely fake. + +- You help them refine their methods of spamming. + +Therefore, we strongly recommend that you do not use this package. +Use a spam filter instead, or just delete the spam. + +------------------------------------------------------------- +"))) (defun uce-insert-ranting (&optional _ignored) "Insert text of the usual reply to UCE into current buffer." diff --git a/lisp/man.el b/lisp/man.el index 4ef2deac4f3..2bde1fc7fb2 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1786,7 +1786,7 @@ Returns t if section is found, nil otherwise." Man--last-section (car Man--sections))) (completion-ignore-case t) - (prompt (concat "Go to section (default " default "): ")) + (prompt (format-prompt "Go to section" default)) (chosen (completing-read prompt Man--sections nil nil nil nil default))) (list chosen)) @@ -1850,7 +1850,7 @@ Specify which REFERENCE to use; default is based on word at point." (defaults (mapcar 'substring-no-properties (cons default Man--refpages))) - (prompt (concat "Refer to (default " default "): ")) + (prompt (format-prompt "Refer to" default)) (chosen (completing-read prompt Man--refpages nil nil nil nil defaults))) chosen))) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index f19dc9e7c97..1a81f1a3d06 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -413,8 +413,14 @@ (bindings--define-key menu [separator-tag-file] '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p))) + (bindings--define-key menu [xref-forward] + '(menu-item "Forward" xref-go-forward + :visible (and (featurep 'xref) + (not (xref-forward-history-empty-p))) + :help "Forward to the position gone Back from")) + (bindings--define-key menu [xref-pop] - '(menu-item "Back" xref-pop-marker-stack + '(menu-item "Back" xref-go-back :visible (and (featurep 'xref) (not (xref-marker-stack-empty-p))) :help "Back to the position of the last search")) @@ -514,7 +520,11 @@ (cdr yank-menu) kill-ring)) (not buffer-read-only)))) - :help "Paste (yank) text most recently cut/copied")) + :help "Paste (yank) text most recently cut/copied" + :keys ,(lambda () + (if cua-mode + "\\[cua-paste]" + "\\[yank]")))) (bindings--define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better ;; under X (for GNUstep). @@ -523,14 +533,23 @@ 'kill-ring-save) :enable mark-active :help "Copy text in region between mark and current position" - :keys ,(if (featurep 'ns) - "\\[ns-copy-including-secondary]" - "\\[kill-ring-save]"))) + :keys ,(lambda () + (cond + ((featurep 'ns) + "\\[ns-copy-including-secondary]") + ((and cua-mode mark-active) + "\\[cua-copy-handler]") + (t + "\\[kill-ring-save]"))))) (bindings--define-key menu [cut] - '(menu-item "Cut" kill-region + `(menu-item "Cut" kill-region :enable (and mark-active (not buffer-read-only)) :help - "Cut (kill) text in region between mark and current position")) + "Cut (kill) text in region between mark and current position" + :keys ,(lambda () + (if (and cua-mode mark-active) + "\\[cua-cut-handler]" + "\\[kill-region]")))) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) (bindings--define-key menu [separator-undo] menu-bar-separator)) @@ -1918,10 +1937,7 @@ key, a click, or a menu-item")) (let* ((default (thing-at-point 'sexp)) (topic (read-from-minibuffer - (format "Subject to look up%s: " - (if default - (format " (default \"%s\")" default) - "")) + (format-prompt "Subject to look up" default) nil nil nil nil default))) (list (if (zerop (length topic)) default @@ -2163,6 +2179,12 @@ otherwise it could decide to silently do nothing." :type 'integer :group 'menu) +(defcustom yank-menu-max-items 60 + "Maximum number of entries to display in the `yank-menu'." + :type 'integer + :group 'menu + :version "29.1") + (defun menu-bar-update-yank-menu (string old) (let ((front (car (cdr yank-menu))) (menu-string (if (<= (length string) yank-menu-length) @@ -2186,8 +2208,9 @@ otherwise it could decide to silently do nothing." (cons (cons string (cons menu-string 'menu-bar-select-yank)) (cdr yank-menu))))) - (if (> (length (cdr yank-menu)) kill-ring-max) - (setcdr (nthcdr kill-ring-max yank-menu) nil))) + (let ((max-items (min yank-menu-max-items kill-ring-max))) + (if (> (length (cdr yank-menu)) max-items) + (setcdr (nthcdr max-items yank-menu) nil)))) (put 'menu-bar-select-yank 'apropos-inhibit t) (defun menu-bar-select-yank () diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 8fdcf3c62b4..0669f5bb22c 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -47,13 +47,13 @@ ;;;###mh-autoload (defmacro mh-do-in-gnu-emacs (&rest body) "Execute BODY if in GNU Emacs." - (declare (debug t) (indent defun)) + (declare (obsolete progn "29.1") (debug t) (indent defun)) (unless (featurep 'xemacs) `(progn ,@body))) ;;;###mh-autoload (defmacro mh-do-in-xemacs (&rest body) "Execute BODY if in XEmacs." - (declare (debug t) (indent defun)) + (declare (obsolete ignore "29.1") (debug t) (indent defun)) (when (featurep 'xemacs) `(progn ,@body))) ;;;###mh-autoload @@ -72,7 +72,8 @@ "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." - (declare (indent defun) (doc-string 4) + (declare (obsolete defun "29.1") + (indent defun) (doc-string 4) (debug (&define name symbolp sexp def-body))) `(defalias ',name (if (fboundp ',function) @@ -84,7 +85,8 @@ Otherwise, create function NAME with ARG-LIST and BODY." "Create macro NAME. If MACRO exists, then NAME becomes an alias for MACRO. Otherwise, create macro NAME with ARG-LIST and BODY." - (declare (indent defun) (doc-string 4) + (declare (obsolete defmacro "29.1") + (indent defun) (doc-string 4) (debug (&define name symbolp sexp def-body))) (let ((defined-p (fboundp macro))) (if defined-p @@ -99,22 +101,20 @@ Otherwise, create macro NAME with ARG-LIST and BODY." "Make HOOK local if needed. XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be called." + (declare (obsolete nil "29.1")) (when (and (fboundp 'make-local-hook) (not (get 'make-local-hook 'byte-obsolete-info))) `(make-local-hook ,hook))) ;;;###mh-autoload (defmacro mh-mark-active-p (check-transient-mark-mode-flag) - "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. -In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then -check if variable `transient-mark-mode' is active." - (cond ((featurep 'xemacs) ;XEmacs - '(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) - ((not check-transient-mark-mode-flag) ;GNU Emacs - '(and (boundp 'mark-active) mark-active)) - (t ;GNU Emacs - '(and (boundp 'transient-mark-mode) transient-mark-mode - (boundp 'mark-active) mark-active)))) + "If CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if +variable `transient-mark-mode' is active." + (declare (obsolete nil "29.1")) + (cond ((not check-transient-mark-mode-flag) + 'mark-active) + (t + '(and transient-mark-mode mark-active)))) ;;;###mh-autoload (defmacro with-mh-folder-updating (save-modification-flag &rest body) @@ -164,12 +164,8 @@ preserved." (original-position (make-symbol "original-position")) (modified-flag (make-symbol "modified-flag"))) `(save-excursion - (let* ((,event-window - (or (mh-funcall-if-exists posn-window (event-start ,event)) - (mh-funcall-if-exists event-window ,event))) - (,event-position - (or (mh-funcall-if-exists posn-point (event-start ,event)) - (mh-funcall-if-exists event-closest-point ,event))) + (let* ((,event-window (posn-window (event-start ,event))) + (,event-position (posn-point (event-start ,event))) (,original-window (selected-window)) (,original-position (progn (set-buffer (window-buffer ,event-window)) diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 37fdb166011..5761df5297c 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -112,10 +112,10 @@ COMMA-SEPARATOR is non-nil." (setq res (match-string 1 res))) ;; Replace "&" with capitalized username (if (string-search "&" res) - (setq res (mh-replace-regexp-in-string "&" (capitalize username) res))) + (setq res (replace-regexp-in-string "&" (capitalize username) res))) ;; Remove " character (if (string-search "\"" res) - (setq res (mh-replace-regexp-in-string "\"" "" res))) + (setq res (replace-regexp-in-string "\"" "" res))) ;; If empty string, use username instead (if (string-equal "" res) (setq res username)) @@ -155,7 +155,7 @@ Exclude all aliases already in `mh-alias-alist' from \"ali\"" (if (string-equal username realname) (concat "<" username ">") (concat realname " <" username ">")))) - (when (not (mh-assoc-string alias-name mh-alias-alist t)) + (when (not (assoc-string alias-name mh-alias-alist t)) (setq passwd-alist (cons (list alias-name alias-translation) passwd-alist))))))) (forward-line 1))) @@ -184,12 +184,12 @@ been loaded." (cond ((looking-at "^[ \t]")) ;Continuation line ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias - (when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t)) + (when (not (assoc-string (match-string 1) mh-alias-blind-alist t)) (setq mh-alias-blind-alist (cons (list (match-string 1)) mh-alias-blind-alist)) (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) ((looking-at "\\(.+\\): .*$") ; A new MH alias - (when (not (mh-assoc-string (match-string 1) mh-alias-alist t)) + (when (not (assoc-string (match-string 1) mh-alias-alist t)) (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))) (forward-line 1))) @@ -200,7 +200,7 @@ been loaded." user) (while local-users (setq user (car local-users)) - (if (not (mh-assoc-string (car user) mh-alias-alist t)) + (if (not (assoc-string (car user) mh-alias-alist t)) (setq mh-alias-alist (append mh-alias-alist (list user)))) (setq local-users (cdr local-users))))) (run-hooks 'mh-alias-reloaded-hook) @@ -239,16 +239,16 @@ done here." "Return expansion for ALIAS. Blind aliases or users from /etc/passwd are not expanded." (cond - ((mh-assoc-string alias mh-alias-blind-alist t) + ((assoc-string alias mh-alias-blind-alist t) alias) ; Don't expand a blind alias - ((mh-assoc-string alias mh-alias-passwd-alist t) - (cadr (mh-assoc-string alias mh-alias-passwd-alist t))) + ((assoc-string alias mh-alias-passwd-alist t) + (cadr (assoc-string alias mh-alias-passwd-alist t))) (t (mh-alias-ali alias)))) (eval-and-compile - (mh-require 'crm nil t) ; completing-read-multiple - (mh-require 'multi-prompt nil t)) + (require 'crm nil t) ; completing-read-multiple + (require 'multi-prompt nil t)) ;;;###mh-autoload (defun mh-read-address (prompt) @@ -281,7 +281,7 @@ Blind aliases or users from /etc/passwd are not expanded." (let* ((case-fold-search t) (beg (mh-beginning-of-word)) (the-name (buffer-substring-no-properties beg (point)))) - (if (mh-assoc-string the-name mh-alias-alist t) + (if (assoc-string the-name mh-alias-alist t) (message "%s -> %s" the-name (mh-alias-expand the-name)) ;; Check if it was a single word likely to be an alias (if (and (equal mh-alias-flash-on-comma 1) @@ -313,7 +313,7 @@ Blind aliases or users from /etc/passwd are not expanded." res) res))) ((t) (all-completions string mh-alias-alist pred)) - ((lambda) (mh-test-completion string mh-alias-alist pred))))))))) + ((lambda) (test-completion string mh-alias-alist pred))))))))) ;;; Alias File Updating diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 404b6b3ce75..130d3784ddd 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -177,9 +177,8 @@ Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.") "Messages annotated, either a sequence name or a list of message numbers. This variable can be used by `mh-annotate-msg-hook'.") -(defvar mh-insert-auto-fields-done-local nil +(defvar-local mh-insert-auto-fields-done-local nil "Buffer-local variable set when `mh-insert-auto-fields' called successfully.") -(make-variable-buffer-local 'mh-insert-auto-fields-done-local) @@ -304,21 +303,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 - (if (and (local-variable-p 'buffer-file-coding-system - (current-buffer)) ;XEmacs needs two args - ;; We're not sure why, but buffer-file-coding-system - ;; tends to get set to undecided-unix. - (not (memq buffer-file-coding-system - '(undecided undecided-unix undecided-dos)))) - buffer-file-coding-system - (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) - (and (default-boundp 'buffer-file-coding-system) - (default-value 'buffer-file-coding-system)) - 'utf-8))))) + (coding-system-for-write (select-message-coding-system))) ;; 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 @@ -433,7 +418,7 @@ See also `mh-send'." (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) (mh-insert-header-separator) ;; Merge in components - (mh-mapc + (mapc (lambda (header-field) (let ((field (car header-field)) (value (cdr header-field)) @@ -593,11 +578,12 @@ See also `mh-compose-forward-as-mime-flag', (goto-char (point-min)) ;; Set the local value of mh-mail-header-separator according to what is ;; present in the buffer... - (set (make-local-variable 'mh-mail-header-separator) - (save-excursion - (goto-char (mh-mail-header-end)) - (buffer-substring-no-properties (point) (mh-line-end-position)))) - (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) ;override sendmail.el + (setq-local mh-mail-header-separator + (save-excursion + (goto-char (mh-mail-header-end)) + (buffer-substring-no-properties (point) + (line-end-position)))) + (setq-local mail-header-separator mh-mail-header-separator) ;override sendmail.el ;; If using MML, translate MH-style directive (if (equal mh-compose-insertion 'mml) (save-excursion @@ -697,7 +683,7 @@ message and scan line." ;; For "From", the first value wins, with the identity's "From" ;; trumping anything in the distcomps file. (let ((components-file (mh-bare-components mh-dist-formfile))) - (mh-mapc + (mapc (lambda (header-field) (let ((field (car header-field)) (value (cdr header-field)) @@ -1077,7 +1063,6 @@ letter." ;; Insert identity. (mh-insert-identity mh-identity-default t) (mh-identity-make-menu) - (mh-identity-add-menu) ;; Cleanup possibly RFC2047 encoded subject header (mh-decode-message-subject) @@ -1096,7 +1081,6 @@ letter." (setq mh-previous-window-config config) (setq mode-line-buffer-identification (list " {%b}")) (mh-logo-display) - (mh-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook #'mh-tidy-draft-buffer nil t) (run-hook-with-args 'mh-compose-letter-function to subject cc)) @@ -1107,18 +1091,8 @@ The versions of MH-E, Emacs, and MH are shown." ;; Lazily initialize mh-x-mailer-string. (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string)) (setq mh-x-mailer-string - (format "MH-E %s; %s; %sEmacs %s" - mh-version mh-variant-in-use - (if (featurep 'xemacs) "X" "GNU ") - (cond ((not (featurep 'xemacs)) - (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?" - emacs-version) - (match-string 0 emacs-version)) - ((string-match "[0-9.]*\\( +([ a-z]+[0-9]+)\\)?" - emacs-version) - (match-string 0 emacs-version)) - (t (format "%s.%s" emacs-major-version - emacs-minor-version)))))) + (format "MH-E %s; %s; Emacs %s" + mh-version mh-variant-in-use emacs-version))) ;; Insert X-Mailer, but only if it doesn't already exist. (save-excursion (when (and mh-insert-x-mailer-flag @@ -1245,7 +1219,7 @@ discarded." (cond ((and overwrite-flag (mh-goto-header-field (concat field ":"))) (insert " " value) - (delete-region (point) (mh-line-end-position))) + (delete-region (point) (line-end-position))) ((and (not overwrite-flag) (mh-regexp-in-field-p (concat "\\b" (regexp-quote value) "\\b") field)) ;; Already there, do nothing. @@ -1288,11 +1262,8 @@ discarded." (set-syntax-table old-syntax-table)))) (defun mh-ascii-buffer-p () - "Check if current buffer is entirely composed of ASCII. -The function doesn't work for XEmacs since `find-charset-region' -doesn't exist there." - (cl-loop for charset in (mh-funcall-if-exists - find-charset-region (point-min) (point-max)) + "Check if current buffer is entirely composed of ASCII." + (cl-loop for charset in (find-charset-region (point-min) (point-max)) unless (eq charset 'ascii) return nil finally return t)) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index ade80e8b95e..19be5afd790 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -34,44 +34,13 @@ ;; Please use mh-gnus.el when providing compatibility with different ;; versions of Gnus. -;; Items are listed alphabetically (except for mh-require which is -;; needed sooner it would normally appear). +;; Items are listed alphabetically. (eval-when-compile (require 'mh-acros)) -(mh-do-in-gnu-emacs - (defalias 'mh-require #'require)) - -(mh-do-in-xemacs - (defun mh-require (feature &optional filename noerror) - "If feature FEATURE is not loaded, load it from FILENAME. -If FEATURE is not a member of the list `features', then the feature -is not loaded; so load the file FILENAME. -If FILENAME is omitted, the printname of FEATURE is used as the file name. -If the optional third argument NOERROR is non-nil, -then return nil if the file is not found instead of signaling an error. - -Simulate NOERROR argument in XEmacs which lacks it." - (if (not (featurep feature)) - (if filename - (load filename noerror t) - (load (format "%s" feature) noerror t))))) - -(defun-mh mh-assoc-string assoc-string (key list case-fold) - "Like `assoc' but specifically for strings. -Case is ignored if CASE-FOLD is non-nil. -This function is used by Emacs versions that lack `assoc-string', -introduced in Emacs 22." - ;; Test for fboundp is solely to silence compiler for Emacs >= 22.1. - (if (and case-fold (fboundp 'assoc-ignore-case)) - (assoc-ignore-case key list) - (assoc key list))) - -;; For XEmacs. -(defalias 'mh-cancel-timer - (if (fboundp 'cancel-timer) - 'cancel-timer - 'delete-itimer)) +(define-obsolete-function-alias 'mh-require #'require "29.1") +(define-obsolete-function-alias 'mh-assoc-string #'assoc-string "29.1") +(define-obsolete-function-alias 'mh-cancel-timer #'cancel-timer "29.1") ;; Emacs 24 made flet obsolete and suggested either cl-flet or ;; cl-letf. This macro is based upon gmm-flet from Gnus. @@ -90,17 +59,8 @@ the function cell of FUNCs rather than their value cell. ,@body) `(flet ,bindings ,@body))) -(defun mh-display-color-cells (&optional display) - "Return the number of color cells supported by DISPLAY. -This function is used by XEmacs to return 2 when `device-color-cells' -or `display-color-cells' returns nil. This happens when compiling or -running on a tty and causes errors since `display-color-cells' is -expected to return an integer." - (cond ((fboundp 'display-color-cells) ; GNU Emacs, XEmacs 21.5b28 - (or (display-color-cells display) 2)) - ((fboundp 'device-color-cells) ; XEmacs 21.4 - (or (device-color-cells display) 2)) - (t 2))) +(define-obsolete-function-alias 'mh-display-color-cells + #'display-color-cells "29.1") (defmacro mh-display-completion-list (completions &optional common-substring) "Display the list of COMPLETIONS. @@ -110,209 +70,54 @@ The optional argument COMMON-SUBSTRING, if non-nil, should be a string specifying a common substring for adding the faces `completions-first-difference' and `completions-common-part' to the completions." - (cond ((< emacs-major-version 22) `(display-completion-list ,completions)) - ((fboundp 'completion-hilit-commonality) ; Emacs 23.1 and later - `(display-completion-list - (completion-hilit-commonality ,completions - ,(length common-substring) nil))) - (t ; Emacs 22 - `(display-completion-list ,completions ,common-substring)))) - -(defmacro mh-face-foreground (face &optional frame inherit) - "Return the foreground color name of FACE, or nil if unspecified. -See documentation for `face-foreground' for a description of the -arguments FACE, FRAME, and perhaps INHERIT. -This macro is used by Emacs versions that lack an INHERIT argument, -introduced in Emacs 22." - (if (< emacs-major-version 22) - `(face-foreground ,face ,frame) - `(face-foreground ,face ,frame ,inherit))) - -(defmacro mh-face-background (face &optional frame inherit) - "Return the background color name of face, or nil if unspecified. -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." - (if (< emacs-major-version 22) - `(face-background ,face ,frame) - `(face-background ,face ,frame ,inherit))) - -(defun-mh mh-font-lock-add-keywords font-lock-add-keywords - (_mode _keywords &optional _how) - "XEmacs does not have `font-lock-add-keywords'. -This function returns nil on that system.") - -(defun-mh mh-image-load-path-for-library - image-load-path-for-library (library image &optional path no-error) - "Return a suitable search path for images used by LIBRARY. - -It searches for IMAGE in `image-load-path' (excluding -\"`data-directory'/images\") and `load-path', followed by a path -suitable for LIBRARY, which includes \"../../etc/images\" and -\"../etc/images\" relative to the library file itself, and then -in \"`data-directory'/images\". - -Then this function returns a list of directories which contains -first the directory in which IMAGE was found, followed by the -value of `load-path'. If PATH is given, it is used instead of -`load-path'. - -If NO-ERROR is non-nil and a suitable path can't be found, don't -signal an error. Instead, return a list of directories as before, -except that nil appears in place of the image directory. - -Here is an example that uses a common idiom to provide -compatibility with versions of Emacs that lack the variable -`image-load-path': - - ;; Shush compiler. - (defvar image-load-path) - - (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\")) - (image-load-path (cons (car load-path) - (when (boundp \\='image-load-path) - image-load-path)))) - (mh-tool-bar-folder-buttons-init))" - (unless library (error "No library specified")) - (unless image (error "No image specified")) - (let (image-directory image-directory-load-path) - ;; Check for images in image-load-path or load-path. - (let ((img image) - (dir (or - ;; Images in image-load-path. - (mh-image-search-load-path image) - ;; Images in load-path. - (locate-library image))) - parent) - ;; Since the image might be in a nested directory (for - ;; example, mail/attach.pbm), adjust `image-directory' - ;; accordingly. - (when dir - (setq dir (file-name-directory dir)) - (while (setq parent (file-name-directory img)) - (setq img (directory-file-name parent) - dir (expand-file-name "../" dir)))) - (setq image-directory-load-path dir)) - - ;; If `image-directory-load-path' isn't Emacs's image directory, - ;; it's probably a user preference, so use it. Then use a - ;; relative setting if possible; otherwise, use - ;; `image-directory-load-path'. - (cond - ;; User-modified image-load-path? - ((and image-directory-load-path - (not (equal image-directory-load-path - (file-name-as-directory - (expand-file-name "images" data-directory))))) - (setq image-directory image-directory-load-path)) - ;; Try relative setting. - ((let (library-name d1ei d2ei) - ;; First, find library in the load-path. - (setq library-name (locate-library library)) - (if (not library-name) - (error "Cannot find library %s in load-path" library)) - ;; And then set image-directory relative to that. - (setq - ;; Go down 2 levels. - d2ei (file-name-as-directory - (expand-file-name - (concat (file-name-directory library-name) "../../etc/images"))) - ;; Go down 1 level. - d1ei (file-name-as-directory - (expand-file-name - (concat (file-name-directory library-name) "../etc/images")))) - (setq image-directory - ;; Set it to nil if image is not found. - (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) - ((file-exists-p (expand-file-name image d1ei)) d1ei))))) - ;; Use Emacs's image directory. - (image-directory-load-path - (setq image-directory image-directory-load-path)) - (no-error - (message "Could not find image %s for library %s" image library)) - (t - (error "Could not find image %s for library %s" image library))) - - ;; Return an augmented `path' or `load-path'. - (nconc (list image-directory) - (delete image-directory (copy-sequence (or path load-path)))))) - -(defun-mh mh-image-search-load-path - image-search-load-path (_file &optional _path) - "Emacs 21 and XEmacs don't have `image-search-load-path'. -This function returns nil on those systems." - nil) - -;; For XEmacs. -(defalias 'mh-line-beginning-position - (if (fboundp 'line-beginning-position) - 'line-beginning-position - 'point-at-bol)) - -;; For XEmacs. -(defalias 'mh-line-end-position - (if (fboundp 'line-end-position) - 'line-end-position - 'point-at-eol)) - -(mh-require 'mailabbrev nil t) -(defun-mh mh-mail-abbrev-make-syntax-table - mail-abbrev-make-syntax-table () - "Emacs 21 and XEmacs don't have `mail-abbrev-make-syntax-table'. -This function returns nil on those systems." - nil) - -(defmacro mh-define-obsolete-variable-alias - (obsolete-name current-name &optional when docstring) - "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. -See documentation for `define-obsolete-variable-alias' for a description -of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN -and DOCSTRING. This macro is used by XEmacs that lacks WHEN and -DOCSTRING arguments." - (if (featurep 'xemacs) - `(define-obsolete-variable-alias ,obsolete-name ,current-name) - `(define-obsolete-variable-alias ,obsolete-name ,current-name ,when ,docstring))) - -(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type) - "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. -See documentation for `make-obsolete-variable' for a description -of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN -and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and -ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE, -introduced in Emacs 24." - (if (featurep 'xemacs) - `(make-obsolete-variable ,obsolete-name ,current-name) - (if (< emacs-major-version 24) - `(make-obsolete-variable ,obsolete-name ,current-name ,when) - `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type)))) - -(defun-mh mh-match-string-no-properties - match-string-no-properties (num &optional _string) - "Return string of text matched by last search, without text properties. -This function is used by XEmacs that lacks `match-string-no-properties'. -The function `buffer-substring-no-properties' is used instead. -The argument STRING is ignored." - (buffer-substring-no-properties - (match-beginning num) (match-end num))) - -(defun-mh mh-replace-regexp-in-string replace-regexp-in-string - (regexp rep string &optional _fixedcase literal _subexp _start) - "Replace REGEXP with REP everywhere in STRING and return result. -This function is used by XEmacs that lacks `replace-regexp-in-string'. -The function `replace-in-string' is used instead. -The arguments FIXEDCASE, SUBEXP, and START, used by -`replace-in-string' are ignored." - (if (featurep 'xemacs) ; silence Emacs compiler - (replace-in-string string regexp rep literal))) - -(defun-mh mh-test-completion - test-completion (_string _collection &optional _predicate) - "Return non-nil if STRING is a valid completion. -XEmacs does not have `test-completion'. This function returns nil -on that system." nil) - -;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21. + `(display-completion-list + (completion-hilit-commonality ,completions + ,(length common-substring) nil))) + +(define-obsolete-function-alias 'mh-face-foreground + #'face-foreground "29.1") + +(define-obsolete-function-alias 'mh-face-background + #'face-background "29.1") + +(define-obsolete-function-alias 'mh-font-lock-add-keywords + #'font-lock-add-keywords "29.1") + +;; Not preloaded in without-x builds. +(declare-function image-load-path-for-library "image") +(define-obsolete-function-alias 'mh-image-load-path-for-library + #'image-load-path-for-library "29.1") + +;; Not preloaded in without-x builds. +(declare-function image-search-load-path "image") +(define-obsolete-function-alias 'mh-image-search-load-path + #'image-search-load-path "29.1") + +(define-obsolete-function-alias 'mh-line-beginning-position + #'line-beginning-position "29.1") + +(define-obsolete-function-alias 'mh-line-end-position + #'line-end-position "29.1") + +(require 'mailabbrev nil t) +(define-obsolete-function-alias 'mh-mail-abbrev-make-syntax-table + #'mail-abbrev-make-syntax-table "29.1") + +(define-obsolete-function-alias 'mh-define-obsolete-variable-alias + #'define-obsolete-variable-alias "29.1") + +(define-obsolete-function-alias 'mh-make-obsolete-variable + #'make-obsolete-variable "29.1") + +(define-obsolete-function-alias 'mh-match-string-no-properties + #'match-string-no-properties "29.1") + +(define-obsolete-function-alias 'mh-replace-regexp-in-string + #'replace-regexp-in-string "29.1") + +(define-obsolete-function-alias 'mh-test-completion + #'test-completion "29.1") + (defconst mh-url-unreserved-chars '( ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z @@ -321,51 +126,21 @@ on that system." nil) ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) "A list of characters that are _NOT_ reserved in the URL spec. This is taken from RFC 2396.") +(make-obsolete-variable 'mh-url-unreserved-chars 'url-unreserved-chars "29.1") + +(define-obsolete-function-alias 'mh-url-hexify-string + #'url-hexify-string "29.1") + +(define-obsolete-function-alias 'mh-view-mode-enter + #'view-mode-enter "29.1") -(defun-mh mh-url-hexify-string url-hexify-string (str) - "Escape characters in a string. -This is a copy of `url-hexify-string' from url-util.el in Emacs -22; needed by Emacs 21." - (mapconcat - (lambda (char) - ;; Fixme: use a char table instead. - (if (not (memq char mh-url-unreserved-chars)) - (if (> char 255) - (error "Hexifying multibyte character %s" str) - (format "%%%02X" char)) - (char-to-string char))) - str "")) - -(defun-mh mh-view-mode-enter - view-mode-enter (&optional return-to exit-action) - "Enter View mode. -This function is used by XEmacs that lacks `view-mode-enter'. -The function `view-mode' is used instead. -The arguments RETURN-TO and EXIT-ACTION are ignored." - ;; Shush compiler. - (if return-to nil) - (if exit-action nil) - (view-mode 1)) - -(defun-mh mh-window-full-height-p - window-full-height-p (&optional _window) - "Return non-nil if WINDOW is not the result of a vertical split. -This function is defined in XEmacs as it lacks -`window-full-height-p'. The values of the functions -`window-height' and `frame-height' are compared instead. The -argument WINDOW is ignored." - (= (1+ (window-height)) - (frame-height))) +(define-obsolete-function-alias 'mh-window-full-height-p + #'window-full-height-p "29.1") (defmacro mh-write-file-functions () - "Return `write-file-functions' if it exists. -Otherwise return `local-write-file-hooks'. -This macro exists purely for compatibility. The former symbol is used -in Emacs 22 onward while the latter is used in previous versions and -XEmacs." - (if (boundp 'write-file-functions) - ''write-file-functions ;Emacs 22 on - ''local-write-file-hooks)) ;XEmacs + "Return `write-file-functions'. " + (declare (obsolete nil "29.1")) + ''write-file-functions) (provide 'mh-compat) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 9cbc8cfb737..4e1ca2897bc 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -88,29 +88,6 @@ (require 'mh-buffers) (require 'mh-compat) -(mh-do-in-xemacs - (require 'mh-xemacs)) - -(mh-font-lock-add-keywords - 'emacs-lisp-mode - (eval-when-compile - `((,(concat "(\\(" - ;; Function declarations (use font-lock-function-name-face). - "\\(def\\(un\\|macro\\)-mh\\)\\|" - ;; Variable declarations (use font-lock-variable-name-face). - "\\(def\\(custom\\|face\\)-mh\\)\\|" - ;; Group declarations (use font-lock-type-face). - "\\(defgroup-mh\\)" - "\\)\\>" - ;; Any whitespace and defined object. - "[ \t'(]*" - "\\(setf[ \t]+\\sw+)\\|\\sw+\\)?") - (1 font-lock-keyword-face) - (7 (cond ((match-beginning 2) font-lock-function-name-face) - ((match-beginning 4) font-lock-variable-name-face) - (t font-lock-type-face)) - nil t))))) - ;;; Global Variables @@ -368,15 +345,13 @@ when searching for a separator.") "This regular expression matches the signature separator. See `mh-signature-separator'.") -(defvar mh-thread-scan-line-map nil +(defvar-local mh-thread-scan-line-map nil "Map of message index to various parts of the scan line.") -(make-variable-buffer-local 'mh-thread-scan-line-map) -(defvar mh-thread-scan-line-map-stack nil +(defvar-local mh-thread-scan-line-map-stack nil "Old map of message index to various parts of the scan line. This is the original map that is stored when the folder is narrowed.") -(make-variable-buffer-local 'mh-thread-scan-line-map-stack) (defcustom mh-x-mailer-string nil "String containing the contents of the X-Mailer header field. @@ -486,7 +461,7 @@ all the strings have been used." (count 0)) (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) (push (buffer-substring-no-properties (point) - (mh-line-end-position)) + (line-end-position)) arg-list) (cl-incf count) (forward-line)) @@ -619,23 +594,18 @@ Output is expected to be shown to user, not parsed by MH-E." ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. (mh-exchange-point-and-mark-preserving-active-mark)) -;; Shush compiler. -(mh-do-in-xemacs - (defvar mark-active)) - (defun mh-exchange-point-and-mark-preserving-active-mark () "Put the mark where point is now, and point where the mark is now. This command works even when the mark is not active, and preserves whether the mark is active or not." (interactive nil) - (let ((is-active (and (boundp 'mark-active) mark-active))) + (let ((is-active mark-active)) (let ((omark (mark t))) (if (null omark) (error "No mark set in this buffer")) (set-mark (point)) (goto-char omark) - (if (boundp 'mark-active) - (setq mark-active is-active)) + (setq mark-active is-active) nil))) (defun mh-exec-lib-cmd-output (command &rest args) @@ -663,56 +633,39 @@ Set mark after inserted text." ;;; MH-E Customization Support Routines -;; Shush compiler (Emacs 21 and XEmacs). -(defvar customize-package-emacs-version-alist) - ;; Temporary function and data structure used customization. ;; These will be unbound after the options are defined. (defmacro mh-strip-package-version (args) - "Strip :package-version keyword and its value from ARGS. -In Emacs versions that support the :package-version keyword, -ARGS is returned unchanged." - `(if (boundp 'customize-package-emacs-version-alist) - ,args - (let (seen) - (cl-loop for keyword in ,args - if (cond ((eq keyword ':package-version) (setq seen t) nil) - (seen (setq seen nil) nil) - (t t)) - collect keyword)))) + "ARGS is returned unchanged." + (declare (obsolete identity "29.1")) + args) (defmacro defgroup-mh (symbol members doc &rest args) "Declare SYMBOL as a customization group containing MEMBERS. See documentation for `defgroup' for a description of the arguments -SYMBOL, MEMBERS, DOC and ARGS. -This macro is used by Emacs versions that lack the :package-version -keyword, introduced in Emacs 22." - (declare (doc-string 3) (indent defun)) - `(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args))) +SYMBOL, MEMBERS, DOC and ARGS." + (declare (obsolete defgroup "29.1") (doc-string 3) (indent defun)) + `(defgroup ,symbol ,members ,doc ,args)) (defmacro defcustom-mh (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. See documentation for `defcustom' for a description of the arguments -SYMBOL, VALUE, DOC and ARGS. -This macro is used by Emacs versions that lack the :package-version -keyword, introduced in Emacs 22." - (declare (doc-string 3) (indent defun)) - `(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args))) +SYMBOL, VALUE, DOC and ARGS." + (declare (obsolete defcustom "29.1") (doc-string 3) (indent defun)) + `(defcustom ,symbol ,value ,doc ,args)) (defmacro defface-mh (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. See documentation for `defface' for a description of the arguments -FACE, SPEC, DOC and ARGS. -This macro is used by Emacs versions that lack the :package-version -keyword, introduced in Emacs 22." - (declare (doc-string 3) (indent defun)) - `(defface ,face ,spec ,doc ,@(mh-strip-package-version args))) +FACE, SPEC, DOC and ARGS." + (declare (obsolete defface "29.1") (doc-string 3) (indent defun)) + `(defface ,face ,spec ,doc ,args)) ;;; Variant Support -(defcustom-mh mh-path nil +(defcustom mh-path nil "Additional list of directories to search for MH. See `mh-variant'." :group 'mh-e @@ -947,7 +900,7 @@ finally GNU mailutils MH." (mapconcat (lambda (x) (format "%s" (car x))) (mh-variants) " or ")))))) -(defcustom-mh mh-variant 'autodetect +(defcustom mh-variant 'autodetect "Specifies the variant used by MH-E. The default setting of this option is \"Auto-detect\" which means @@ -1023,19 +976,18 @@ windows in the frame are removed." (when delete-other-windows-flag (delete-other-windows))) -(if (boundp 'customize-package-emacs-version-alist) - (add-to-list 'customize-package-emacs-version-alist - '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1") - ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1") - ("7.4" . "22.1") ("8.0" . "22.1") ("8.1" . "23.1") - ("8.2" . "23.1") ("8.3" . "24.1") ("8.4" . "24.4") - ("8.5" . "24.4") ("8.6" . "24.4")))) +(add-to-list 'customize-package-emacs-version-alist + '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1") + ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1") + ("7.4" . "22.1") ("8.0" . "22.1") ("8.1" . "23.1") + ("8.2" . "23.1") ("8.3" . "24.1") ("8.4" . "24.4") + ("8.5" . "24.4") ("8.6" . "24.4"))) ;;; MH-E Customization Groups -(defgroup-mh mh-e nil +(defgroup mh-e nil "Emacs interface to the MH mail system. MH is the Rand Mail Handler. Other implementations include nmh and GNU mailutils." @@ -1043,126 +995,126 @@ and GNU mailutils." :group 'mail :package-version '(MH-E . "8.0")) -(defgroup-mh mh-alias nil +(defgroup mh-alias nil "Aliases." :link '(custom-manual "(mh-e)Aliases") :prefix "mh-alias-" :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-folder nil +(defgroup mh-folder nil "Organizing your mail with folders." :prefix "mh-" :link '(custom-manual "(mh-e)Folders") :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-folder-selection nil +(defgroup mh-folder-selection nil "Folder selection." :prefix "mh-" :link '(custom-manual "(mh-e)Folder Selection") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-identity nil +(defgroup mh-identity nil "Identities." :link '(custom-manual "(mh-e)Identities") :prefix "mh-identity-" :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-inc nil +(defgroup mh-inc nil "Incorporating your mail." :prefix "mh-inc-" :link '(custom-manual "(mh-e)Incorporating Mail") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-junk nil +(defgroup mh-junk nil "Dealing with junk mail." :link '(custom-manual "(mh-e)Junk") :prefix "mh-junk-" :group 'mh-e :package-version '(MH-E . "7.3")) -(defgroup-mh mh-letter nil +(defgroup mh-letter nil "Editing a draft." :prefix "mh-" :link '(custom-manual "(mh-e)Editing Drafts") :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-ranges nil +(defgroup mh-ranges nil "Ranges." :prefix "mh-" :link '(custom-manual "(mh-e)Ranges") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-scan-line-formats nil +(defgroup mh-scan-line-formats nil "Scan line formats." :link '(custom-manual "(mh-e)Scan Line Formats") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-search nil +(defgroup mh-search nil "Searching." :link '(custom-manual "(mh-e)Searching") :prefix "mh-search-" :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-sending-mail nil +(defgroup mh-sending-mail nil "Sending mail." :prefix "mh-" :link '(custom-manual "(mh-e)Sending Mail") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-sequences nil +(defgroup mh-sequences nil "Sequences." :prefix "mh-" :link '(custom-manual "(mh-e)Sequences") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-show nil +(defgroup mh-show nil "Reading your mail." :prefix "mh-" :link '(custom-manual "(mh-e)Reading Mail") :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-speedbar nil +(defgroup mh-speedbar nil "The speedbar." :prefix "mh-speed-" :link '(custom-manual "(mh-e)Speedbar") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-thread nil +(defgroup mh-thread nil "Threading." :prefix "mh-thread-" :link '(custom-manual "(mh-e)Threading") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-tool-bar nil +(defgroup mh-tool-bar nil "The tool bar" :link '(custom-manual "(mh-e)Tool Bar") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-hooks nil +(defgroup mh-hooks nil "MH-E hooks." :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-faces nil +(defgroup mh-faces nil "Faces used in MH-E." :link '(custom-manual "(mh-e)Top") :prefix "mh-" @@ -1178,7 +1130,7 @@ and GNU mailutils." ;;; Aliases (:group 'mh-alias) -(defcustom-mh mh-alias-completion-ignore-case-flag t +(defcustom mh-alias-completion-ignore-case-flag t "Non-nil means don't consider case significant in MH alias completion. As MH ignores case in the aliases, so too does MH-E. However, you @@ -1189,7 +1141,7 @@ lowercase for mailing lists and uppercase for people." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-expand-aliases-flag nil +(defcustom mh-alias-expand-aliases-flag nil "Non-nil means to expand aliases entered in the minibuffer. In other words, aliases entered in the minibuffer will be @@ -1199,7 +1151,7 @@ this expansion is not performed." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-flash-on-comma t +(defcustom mh-alias-flash-on-comma t "Specify whether to flash address or warn on translation. This option controls the behavior when a [comma] is pressed while @@ -1212,7 +1164,7 @@ does not display a warning if the alias is not found." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-insert-file nil +(defcustom mh-alias-insert-file nil "Filename used to store a new MH-E alias. The default setting of this option is \"Use Aliasfile Profile @@ -1226,7 +1178,7 @@ name, MH-E will prompt for one of them when MH-E adds an alias." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-insertion-location 'sorted +(defcustom mh-alias-insertion-location 'sorted "Specifies where new aliases are entered in alias files. This option is set to \"Alphabetical\" by default. If you organize @@ -1238,7 +1190,7 @@ or \"Bottom\" of your alias file might be more appropriate." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-local-users t +(defcustom mh-alias-local-users t "Non-nil means local users are added to alias completion. Aliases are created from \"/etc/passwd\" entries with a user ID @@ -1259,7 +1211,7 @@ NIS password file." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-local-users-prefix "local." +(defcustom mh-alias-local-users-prefix "local." "String prefixed to the real names of users from the password file. This option can also be set to \"Use Login\". @@ -1281,7 +1233,7 @@ turned off." :group 'mh-alias :package-version '(MH-E . "7.4")) -(defcustom-mh mh-alias-passwd-gecos-comma-separator-flag t +(defcustom mh-alias-passwd-gecos-comma-separator-flag t "Non-nil means the gecos field in the password file uses a comma separator. In the example in `mh-alias-local-users-prefix', commas are used @@ -1295,7 +1247,7 @@ whose contents may contain commas, you can turn this option off." ;;; Organizing Your Mail with Folders (:group 'mh-folder) -(defcustom-mh mh-new-messages-folders t +(defcustom mh-new-messages-folders t "Folders searched for the \"unseen\" sequence. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1310,7 +1262,7 @@ See also `mh-recursive-folders-flag'." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-ticked-messages-folders t +(defcustom mh-ticked-messages-folders t "Folders searched for `mh-tick-seq'. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1325,7 +1277,7 @@ See also `mh-recursive-folders-flag'." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-large-folder 200 +(defcustom mh-large-folder 200 "The number of messages that indicates a large folder. If a folder is deemed to be large, that is the number of messages @@ -1337,7 +1289,7 @@ folders are treated as if they are small." :group 'mh-folder :package-version '(MH-E . "7.0")) -(defcustom-mh mh-recenter-summary-flag nil +(defcustom mh-recenter-summary-flag nil "Non-nil means to recenter the summary window. If this option is turned on, recenter the summary window when the @@ -1346,13 +1298,13 @@ show window is toggled off." :group 'mh-folder :package-version '(MH-E . "7.0")) -(defcustom-mh mh-recursive-folders-flag nil +(defcustom mh-recursive-folders-flag nil "Non-nil means that commands which operate on folders do so recursively." :type 'boolean :group 'mh-folder :package-version '(MH-E . "7.0")) -(defcustom-mh mh-sortm-args nil +(defcustom mh-sortm-args nil "Additional arguments for \"sortm\"\\<mh-folder-mode-map>. This option is consulted when a prefix argument is used with @@ -1366,7 +1318,7 @@ an alternate view. For example, (\"-nolimit\" \"-textfield\" ;;; Folder Selection (:group 'mh-folder-selection) -(defcustom-mh mh-default-folder-for-message-function nil +(defcustom mh-default-folder-for-message-function nil "Function to select a default folder for refiling or \"Fcc:\". When this function is called, the current buffer contains the message @@ -1378,7 +1330,7 @@ the default, or an empty string to suppress the default entirely." :group 'mh-folder-selection :package-version '(MH-E . "8.0")) -(defcustom-mh mh-default-folder-list nil +(defcustom mh-default-folder-list nil "List of addresses and folders. The folder name associated with the first address found in this @@ -1396,7 +1348,7 @@ for more information." :group 'mh-folder-selection :package-version '(MH-E . "7.2")) -(defcustom-mh mh-default-folder-must-exist-flag t +(defcustom mh-default-folder-must-exist-flag t "Non-nil means guessed folder name must exist to be used. If the derived folder does not exist, and this option is on, then @@ -1410,7 +1362,7 @@ for more information." :group 'mh-folder-selection :package-version '(MH-E . "7.2")) -(defcustom-mh mh-default-folder-prefix "" +(defcustom mh-default-folder-prefix "" "Prefix used for folder names generated from aliases. The prefix is used to prevent clutter in your mail directory. @@ -1429,7 +1381,7 @@ for more information." Real definition will take effect when mh-identity is loaded." nil))) -(defcustom-mh mh-identity-list nil +(defcustom mh-identity-list nil "List of identities. To customize this option, click on the \"INS\" button and enter a label @@ -1498,7 +1450,7 @@ fashion." :group 'mh-identity :package-version '(MH-E . "7.1")) -(defcustom-mh mh-auto-fields-list nil +(defcustom mh-auto-fields-list nil "List of recipients for which header lines are automatically inserted. This option can be used to set the identity depending on the @@ -1559,14 +1511,14 @@ as the result is undefined." :group 'mh-identity :package-version '(MH-E . "7.3")) -(defcustom-mh mh-auto-fields-prompt-flag t +(defcustom mh-auto-fields-prompt-flag t "Non-nil means to prompt before sending if fields inserted. See `mh-auto-fields-list'." :type 'boolean :group 'mh-identity :package-version '(MH-E . "8.0")) -(defcustom-mh mh-identity-default nil +(defcustom mh-identity-default nil "Default identity to use when `mh-letter-mode' is called. See `mh-identity-list'." :type (append @@ -1577,7 +1529,7 @@ See `mh-identity-list'." :group 'mh-identity :package-version '(MH-E . "7.1")) -(defcustom-mh mh-identity-handlers +(defcustom mh-identity-handlers '(("From" . mh-identity-handler-top) (":default" . mh-identity-handler-bottom) (":attribution-verb" . mh-identity-handler-attribution-verb) @@ -1613,7 +1565,7 @@ containing the VALUE for the field is given." ;;; Incorporating Your Mail (:group 'mh-inc) -(defcustom-mh mh-inc-prog "inc" +(defcustom mh-inc-prog "inc" "Program to incorporate new mail into a folder. This program generates a one-line summary for each of the new @@ -1632,7 +1584,7 @@ several scan line format variables appropriately." Real definition will take effect when mh-inc is loaded." nil))) -(defcustom-mh mh-inc-spool-list nil +(defcustom mh-inc-spool-list nil "Alternate spool files. You can use the `mh-inc-spool-list' variable to direct MH-E to @@ -1662,10 +1614,7 @@ using the Emacs 22 command \"emacsclient\" as follows: origMode polltime 10 headertime 0 - command emacsclient --eval \\='(mh-inc-spool-mh-e)\\=' - -In XEmacs, the command \"gnuclient\" is used in a similar -fashion." + command emacsclient --eval \\='(mh-inc-spool-mh-e)\\='" :type '(repeat (list (file :tag "Spool File") (string :tag "Folder") (character :tag "Key Binding"))) @@ -1705,7 +1654,7 @@ The function is always called with SYMBOL bound to until (executable-find (symbol-name (car element))) finally return (car element))))) -(defcustom-mh mh-junk-background nil +(defcustom mh-junk-background nil "If on, spam programs are run in background. By default, the programs are run in the foreground, but this can @@ -1723,14 +1672,14 @@ may be useful for debugging." :group 'mh-junk :package-version '(MH-E . "8.0")) -(defcustom-mh mh-junk-disposition nil +(defcustom mh-junk-disposition nil "Disposition of junk mail." :type '(choice (const :tag "Delete Spam" nil) (string :tag "Spam Folder")) :group 'mh-junk :package-version '(MH-E . "8.0")) -(defcustom-mh mh-junk-program nil +(defcustom mh-junk-program nil "Spam program that MH-E should use. The default setting of this option is \"Auto-detect\" which means @@ -1748,7 +1697,7 @@ bogofilter, then you can set this option to \"Bogofilter\"." ;;; Editing a Draft (:group 'mh-letter) -(defcustom-mh mh-compose-insertion (if (locate-library "mml") 'mml 'mh) +(defcustom mh-compose-insertion (if (locate-library "mml") 'mml 'mh) "Type of tags used when composing MIME messages. In addition to MH-style directives, MH-E also supports MML (MIME @@ -1762,7 +1711,7 @@ MH-style directives are preferred." :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-compose-skipped-header-fields +(defcustom mh-compose-skipped-header-fields '("From" "Organization" "References" "In-Reply-To" "X-Face" "Face" "X-Image-URL" "X-Mailer") "List of header fields to skip over when navigating in draft." @@ -1770,13 +1719,13 @@ MH-style directives are preferred." :group 'mh-letter :package-version '(MH-E . "7.4")) -(defcustom-mh mh-compose-space-does-completion-flag nil +(defcustom mh-compose-space-does-completion-flag nil "Non-nil means \\<mh-letter-mode-map>\\[mh-letter-complete-or-space] does completion in message header." :type 'boolean :group 'mh-letter :package-version '(MH-E . "7.4")) -(defcustom-mh mh-delete-yanked-msg-window-flag nil +(defcustom mh-delete-yanked-msg-window-flag nil "Non-nil means delete any window displaying the message. This deletes the window containing the original message after @@ -1786,7 +1735,7 @@ more room on your screen for your reply." :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-extract-from-attribution-verb "wrote:" +(defcustom mh-extract-from-attribution-verb "wrote:" "Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. The attribution consists of the sender's name and email address @@ -1800,7 +1749,7 @@ followed by the content of this option. This option can be set to :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-ins-buf-prefix "> " +(defcustom mh-ins-buf-prefix "> " "String to put before each line of a yanked or inserted message. The prefix \"> \" is the default setting of this option. I @@ -1816,17 +1765,17 @@ flavors of `mh-yank-behavior' or you have added a :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-letter-complete-function 'ispell-complete-word +(defcustom mh-letter-complete-function 'ispell-complete-word "Function to call when completing outside of address or folder fields. In the body of the message, -\\<mh-letter-mode-map>\\[mh-letter-complete] runs this function, +\\<mh-letter-mode-map>\\[completion-at-point] runs this function, which is set to \"ispell-complete-word\" by default." :type '(choice function (const nil)) :group 'mh-letter :package-version '(MH-E . "7.1")) -(defcustom-mh mh-letter-fill-column 72 +(defcustom mh-letter-fill-column 72 "Fill column to use in MH Letter mode. By default, this option is 72 to allow others to quote your @@ -1835,7 +1784,7 @@ message without line wrapping." :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") +(defcustom mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") "Default method to use in security tags. This option is used to select between a variety of mail security @@ -1858,7 +1807,7 @@ you write!" :group 'mh-letter :package-version '(MH-E . "8.0")) -(defcustom-mh mh-signature-file-name "~/.signature" +(defcustom mh-signature-file-name "~/.signature" "Source of user's signature. By default, the text of your signature is taken from the file @@ -1881,7 +1830,7 @@ The signature is inserted into your message with the command :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-signature-separator-flag t +(defcustom mh-signature-separator-flag t "Non-nil means a signature separator should be inserted. It is not recommended that you change this option since various @@ -1892,7 +1841,7 @@ replying or yanking a letter into a draft." :group 'mh-letter :package-version '(MH-E . "8.0")) -(defcustom-mh mh-x-face-file "~/.face" +(defcustom mh-x-face-file "~/.face" "File containing face header field to insert in outgoing mail. If the file starts with either of the strings \"X-Face:\", \"Face:\" @@ -1921,7 +1870,7 @@ this option doesn't exist." :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-yank-behavior 'attribution +(defcustom mh-yank-behavior 'attribution "Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. To include the entire message, including the entire header, use @@ -1968,7 +1917,7 @@ inserted." ;;; Ranges (:group 'mh-ranges) -(defcustom-mh mh-interpret-number-as-range-flag t +(defcustom mh-interpret-number-as-range-flag t "Non-nil means interpret a number as a range. Since one of the most frequent ranges used is \"last:N\", MH-E @@ -1988,7 +1937,7 @@ message 200, then use the range \"200:200\"." Real definition, below, uses variables that aren't defined yet." (set-default symbol value)))) -(defcustom-mh mh-adaptive-cmd-note-flag t +(defcustom mh-adaptive-cmd-note-flag t "Non-nil means that the message number width is determined dynamically. If you've created your own format to handle long message numbers, @@ -2017,7 +1966,7 @@ set SYMBOL to VALUE." "unless you use \"Use MH-E scan Format\"") (set-default symbol value))) -(defcustom-mh mh-scan-format-file t +(defcustom mh-scan-format-file t "Specifies the format file to pass to the scan program. The default setting for this option is \"Use MH-E scan Format\". This @@ -2056,7 +2005,7 @@ Otherwise, set SYMBOL to VALUE." "is set to \"Use MH-E scan Format\"") (set-default symbol value))) -(defcustom-mh mh-scan-prog "scan" +(defcustom mh-scan-prog "scan" "Program used to scan messages. The name of the program that generates a listing of one line per @@ -2071,7 +2020,7 @@ directory. You may link another program to `scan' (see ;;; Searching (:group 'mh-search) -(defcustom-mh mh-search-program nil +(defcustom mh-search-program nil "Search program that MH-E shall use. The default setting of this option is \"Auto-detect\" which means @@ -2094,7 +2043,7 @@ MH-E can be found in the documentation of `mh-search'." ;;; Sending Mail (:group 'mh-sending-mail) -(defcustom-mh mh-compose-forward-as-mime-flag t +(defcustom mh-compose-forward-as-mime-flag t "Non-nil means that messages are forwarded as attachments. By default, this option is on which means that the forwarded @@ -2110,7 +2059,7 @@ regardless of the settings of this option." :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(defcustom-mh mh-compose-letter-function nil +(defcustom mh-compose-letter-function nil "Invoked when starting a new draft. However, it is the last function called before you edit your @@ -2122,13 +2071,13 @@ fields." :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-compose-prompt-flag nil +(defcustom mh-compose-prompt-flag nil "Non-nil means prompt for header fields when composing a new draft." :type 'boolean :group 'mh-sending-mail :package-version '(MH-E . "7.4")) -(defcustom-mh mh-forward-subject-format "%s: %s" +(defcustom mh-forward-subject-format "%s: %s" "Format string for forwarded message subject. This option is a string which includes two escapes (\"%s\"). The @@ -2138,7 +2087,7 @@ and the second one is replaced with the original \"Subject:\"." :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-insert-x-mailer-flag t +(defcustom mh-insert-x-mailer-flag t "Non-nil means append an \"X-Mailer:\" header field to the header. This header field includes the version of MH-E and Emacs that you @@ -2148,7 +2097,7 @@ can turn this option off." :group 'mh-sending-mail :package-version '(MH-E . "7.0")) -(defcustom-mh mh-redist-full-contents-flag nil +(defcustom mh-redist-full-contents-flag nil "Non-nil means the \"dist\" command needs entire letter for redistribution. This option must be turned on if \"dist\" requires the whole @@ -2160,7 +2109,7 @@ has been redistributed before, turn off this option." :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(defcustom-mh mh-reply-default-reply-to nil +(defcustom mh-reply-default-reply-to nil "Sets the person or persons to whom a reply will be sent. This option is set to \"Prompt\" by default so that you are @@ -2176,7 +2125,7 @@ this option to \"cc\". Other choices include \"from\", \"to\", or :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-reply-show-message-flag t +(defcustom mh-reply-show-message-flag t "Non-nil means the MH-Show buffer is displayed when replying. If you include the message automatically, you can hide the @@ -2193,7 +2142,7 @@ See also `mh-reply'." ;; the docstring: "Additional sequences that should not to be preserved can be ;; specified by setting `mh-unpropagated-sequences' appropriately." XXX -(defcustom-mh mh-refile-preserves-sequences-flag t +(defcustom mh-refile-preserves-sequences-flag t "Non-nil means that sequences are preserved when messages are refiled. If a message is in any sequence (except \"Previous-Sequence:\" @@ -2204,7 +2153,7 @@ desired, then turn off this option." :group 'mh-sequences :package-version '(MH-E . "7.4")) -(defcustom-mh mh-tick-seq 'tick +(defcustom mh-tick-seq 'tick "The name of the MH sequence for ticked messages. You can customize this option if you already use the \"tick\" @@ -2216,7 +2165,7 @@ there isn't much advantage to that." :group 'mh-sequences :package-version '(MH-E . "7.3")) -(defcustom-mh mh-update-sequences-after-mh-show-flag t +(defcustom mh-update-sequences-after-mh-show-flag t "Non-nil means flush MH sequences to disk after message is shown\\<mh-folder-mode-map>. Three sequences are maintained internally by MH-E and pushed out @@ -2231,7 +2180,7 @@ commands." :group 'mh-sequences :package-version '(MH-E . "7.0")) -(defcustom-mh mh-allowlist-preserves-sequences-flag t +(defcustom mh-allowlist-preserves-sequences-flag t "Non-nil means that sequences are preserved when messages are allowlisted. If a message is in any sequence (except \"Previous-Sequence:\" @@ -2244,7 +2193,7 @@ not desired, then turn off this option." ;;; Reading Your Mail (:group 'mh-show) -(defcustom-mh mh-bury-show-buffer-flag t +(defcustom mh-bury-show-buffer-flag t "Non-nil means show buffer is buried. One advantage of not burying the show buffer is that one can @@ -2255,7 +2204,7 @@ running \\[electric-buffer-list] to see what I mean." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-clean-message-header-flag t +(defcustom mh-clean-message-header-flag t "Non-nil means remove extraneous header fields. See also `mh-invisible-header-fields-default' and @@ -2264,7 +2213,7 @@ See also `mh-invisible-header-fields-default' and :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-decode-mime-flag (not (not (locate-library "mm-decode"))) +(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode"))) "Non-nil means attachments are handled\\<mh-folder-mode-map>. MH-E can handle attachments as well if the Gnus `mm-decode' @@ -2282,7 +2231,7 @@ messages and other graphical widgets. See the options :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-display-buttons-for-alternatives-flag nil +(defcustom mh-display-buttons-for-alternatives-flag nil "Non-nil means display buttons for all alternative attachments. Sometimes, a mail program will produce multiple alternatives of @@ -2294,7 +2243,7 @@ inline and buttons are shown for each of the other alternatives." :group 'mh-show :package-version '(MH-E . "7.4")) -(defcustom-mh mh-display-buttons-for-inline-parts-flag nil +(defcustom mh-display-buttons-for-inline-parts-flag nil "Non-nil means display buttons for all inline attachments\\<mh-folder-mode-map>. The sender can request that attachments should be viewed inline so @@ -2317,7 +2266,7 @@ text (including HTML) and images." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-do-not-confirm-flag nil +(defcustom mh-do-not-confirm-flag nil "Non-nil means non-reversible commands do not prompt for confirmation. Commands such as `mh-pack-folder' prompt to confirm whether to @@ -2329,7 +2278,7 @@ retracted--without question." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-fetch-x-image-url nil +(defcustom mh-fetch-x-image-url nil "Control fetching of \"X-Image-URL:\" header field image. This option controls the fetching of the \"X-Image-URL:\" header @@ -2365,7 +2314,7 @@ turned on." :group 'mh-show :package-version '(MH-E . "7.3")) -(defcustom-mh mh-graphical-smileys-flag t +(defcustom mh-graphical-smileys-flag t "Non-nil means graphical smileys are displayed. It is a long standing custom to inject body language using a @@ -2380,7 +2329,7 @@ turned off." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-graphical-emphasis-flag t +(defcustom mh-graphical-emphasis-flag t "Non-nil means graphical emphasis is displayed. A few typesetting features are indicated in ASCII text with @@ -2397,7 +2346,7 @@ turned off." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-highlight-citation-style 'gnus +(defcustom mh-highlight-citation-style 'gnus "Style for highlighting citations. If the sender of the message has cited other messages in his @@ -2819,7 +2768,7 @@ Because the function `mh-invisible-headers' uses both `mh-invisible-header-fields' and `mh-invisible-header-fields', it cannot be run until both variables have been initialized.") -(defcustom-mh mh-invisible-header-fields nil +(defcustom mh-invisible-header-fields nil "Additional header fields to hide. Header fields that you would like to hide that aren't listed in @@ -2842,7 +2791,7 @@ See also `mh-clean-message-header-flag'." :group 'mh-show :package-version '(MH-E . "7.1")) -(defcustom-mh mh-invisible-header-fields-default nil +(defcustom mh-invisible-header-fields-default nil "List of hidden header fields. The header fields listed in this option are hidden, although you @@ -2899,7 +2848,7 @@ removed and entries from `mh-invisible-header-fields' are added." ;; Compile invisible header fields. (mh-invisible-headers) -(defcustom-mh mh-lpr-command-format "lpr -J '%s'" +(defcustom mh-lpr-command-format "lpr -J '%s'" "Command used to print\\<mh-folder-mode-map>. This option contains the Unix command line which performs the @@ -2916,7 +2865,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-max-inline-image-height nil +(defcustom mh-max-inline-image-height nil "Maximum inline image height if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2932,7 +2881,7 @@ these numbers." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-max-inline-image-width nil +(defcustom mh-max-inline-image-width nil "Maximum inline image width if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2948,7 +2897,7 @@ these numbers." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-mhl-format-file nil +(defcustom mh-mhl-format-file nil "Specifies the format file to pass to the \"mhl\" program. Normally MH-E takes care of displaying messages itself (rather than @@ -2972,7 +2921,7 @@ file." :group 'mh-show :package-version '(MH-E . "8.0")) -(defcustom-mh mh-mime-save-parts-default-directory t +(defcustom mh-mime-save-parts-default-directory t "Default directory to use for \\<mh-folder-mode-map>\\[mh-mime-save-parts]. The default value for this option is \"Prompt Always\" so that @@ -2988,7 +2937,7 @@ directory's name." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-print-background-flag nil +(defcustom mh-print-background-flag nil "Non-nil means messages should be printed in the background\\<mh-folder-mode-map>. Normally messages are printed in the foreground. If this is slow on @@ -3004,7 +2953,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-show-maximum-size 0 +(defcustom mh-show-maximum-size 0 "Maximum size of message (in bytes) to display automatically. This option provides an opportunity to skip over large messages @@ -3014,7 +2963,7 @@ message are shown regardless of size." :group 'mh-show :package-version '(MH-E . "8.0")) -(defcustom-mh mh-show-use-xface-flag (>= emacs-major-version 21) +(defcustom mh-show-use-xface-flag (>= emacs-major-version 21) "Non-nil means display face images in MH-show buffers. MH-E can display the content of \"Face:\", \"X-Face:\", and @@ -3029,15 +2978,12 @@ and off. This feature will be turned on by default if your system 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 +\"Face:\" field. The \"Face:\" field appeared in Emacs 21. +For more information, see URL `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 -versions of XEmacs have internal support for \"X-Face:\" images. If -your version of XEmacs does not, then you'll need both \"uncompface\" -and the x-face package (see URL `https://www.jpl.org/ftp/pub/elisp/'). +`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Finally, MH-E will display images referenced by the \"X-Image-URL:\" header field if neither the \"Face:\" nor the \"X-Face:\" fields are @@ -3054,7 +3000,7 @@ The option `mh-fetch-x-image-url' controls the fetching of the :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-store-default-directory nil +(defcustom mh-store-default-directory nil "Default directory for \\<mh-folder-mode-map>\\[mh-store-msg]. If you would like to change the initial default directory, @@ -3066,7 +3012,7 @@ the content of these messages." :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-summary-height nil +(defcustom mh-summary-height nil "Number of lines in MH-Folder buffer (including the mode line). The default value of this option is \"Automatic\" which means @@ -3081,7 +3027,7 @@ lines you'd like to see." ;;; The Speedbar (:group 'mh-speedbar) -(defcustom-mh mh-speed-update-interval 60 +(defcustom mh-speed-update-interval 60 "Time between speedbar updates in seconds. Set to 0 to disable automatic update." :type 'integer @@ -3090,7 +3036,7 @@ Set to 0 to disable automatic update." ;;; Threading (:group 'mh-thread) -(defcustom-mh mh-show-threads-flag nil +(defcustom mh-show-threads-flag nil "Non-nil means new folders start in threaded mode. Threading large number of messages can be time consuming so this @@ -3106,7 +3052,7 @@ threaded is less than `mh-large-folder'." ;; mh-tool-bar-folder-buttons and mh-tool-bar-letter-buttons defined ;; dynamically in mh-tool-bar.el. -(defcustom-mh mh-tool-bar-search-function 'mh-search +(defcustom mh-tool-bar-search-function 'mh-search "Function called by the tool bar search button. By default, this is set to `mh-search'. You can also choose @@ -3117,47 +3063,11 @@ of your own choosing." :group 'mh-tool-bar :package-version '(MH-E . "7.0")) -;; XEmacs has a couple of extra customizations... -(mh-do-in-xemacs - (defcustom-mh mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag - "If non-nil, use tool bar. - -This option controls whether to show the MH-E icons at all. By -default, this option is turned on if the window system supports -tool bars. If your system doesn't support tool bars, then you -won't be able to turn on this option." - :type 'boolean - :group 'mh-tool-bar - :set (lambda (symbol value) - (if (and (eq value t) - (not mh-xemacs-has-tool-bar-flag)) - (error "Tool bar not supported")) - (set-default symbol value)) - :package-version '(MH-E . "7.3")) - - (defcustom-mh mh-xemacs-tool-bar-position nil - "Tool bar location. - -This option controls the placement of the tool bar along the four -edges of the frame. You can choose from one of \"Same As Default -Tool Bar\", \"Top\", \"Bottom\", \"Left\", or \"Right\". If this -variable is set to anything other than \"Same As Default Tool -Bar\" and the default tool bar is in a different location, then -two tool bars will be displayed: the MH-E tool bar and the -default tool bar." - :type '(radio (const :tag "Same As Default Tool Bar" :value nil) - (const :tag "Top" :value top) - (const :tag "Bottom" :value bottom) - (const :tag "Left" :value left) - (const :tag "Right" :value right)) - :group 'mh-tool-bar - :package-version '(MH-E . "7.3"))) - ;;; Hooks (:group 'mh-hooks + group where hook described) -(defcustom-mh mh-after-commands-processed-hook nil +(defcustom mh-after-commands-processed-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] after performing outstanding refile and delete requests. Variables that are useful in this hook include @@ -3169,14 +3079,14 @@ folder, which is also available in `mh-current-folder'." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-alias-reloaded-hook nil +(defcustom mh-alias-reloaded-hook nil "Hook run by `mh-alias-reload' after loading aliases." :type 'hook :group 'mh-hooks :group 'mh-alias :package-version '(MH-E . "8.0")) -(defcustom-mh mh-annotate-msg-hook nil +(defcustom mh-annotate-msg-hook nil "Hook run when a message is sent and after annotating the scan lines and message. Hook functions can access the current folder name with `mh-current-folder' and obtain the message numbers of the @@ -3186,7 +3096,7 @@ annotated messages with `mh-annotate-list'." :group 'mh-sending-mail :package-version '(MH-E . "8.1")) -(defcustom-mh mh-before-commands-processed-hook nil +(defcustom mh-before-commands-processed-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests. Variables that are useful in this hook include `mh-delete-list', @@ -3198,7 +3108,7 @@ used to see which changes will be made to the current folder, :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-before-quit-hook nil +(defcustom mh-before-quit-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-quit] before quitting MH-E. This hook is called before the quit occurs, so you might use it @@ -3211,7 +3121,7 @@ See also `mh-quit-hook'." :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-before-send-letter-hook nil +(defcustom mh-before-send-letter-hook nil "Hook run at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command. For example, if you want to check your spelling in your message @@ -3222,14 +3132,14 @@ before sending, add the `ispell-message' function." :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-blocklist-msg-hook nil +(defcustom mh-blocklist-msg-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blocklist] after marking each message for blocklisting." :type 'hook :group 'mh-hooks :group 'mh-show :package-version '(MH-E . "8.4")) -(defcustom-mh mh-delete-msg-hook nil +(defcustom mh-delete-msg-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-delete-msg] after marking each message for deletion. For example, a past maintainer of MH-E used this once when he @@ -3239,7 +3149,7 @@ kept statistics on his mail usage." :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-find-path-hook nil +(defcustom mh-find-path-hook nil "Hook run by `mh-find-path' after reading the user's MH profile. This hook can be used the change the value of the variables that @@ -3250,28 +3160,28 @@ between MH and MH-E." :group 'mh-e :package-version '(MH-E . "7.0")) -(defcustom-mh mh-folder-mode-hook nil +(defcustom mh-folder-mode-hook nil "Hook run by `mh-folder-mode' when visiting a new folder." :type 'hook :group 'mh-hooks :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-forward-hook nil +(defcustom mh-forward-hook nil "Hook run by `mh-forward' on a forwarded letter." :type 'hook :group 'mh-hooks :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(defcustom-mh mh-inc-folder-hook nil +(defcustom mh-inc-folder-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-inc-folder] after incorporating mail into a folder." :type 'hook :group 'mh-hooks :group 'mh-inc :package-version '(MH-E . "6.0")) -(defcustom-mh mh-insert-signature-hook nil +(defcustom mh-insert-signature-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-insert-signature] after signature has been inserted. Hook functions may access the actual name of the file or the @@ -3282,9 +3192,9 @@ function used to insert the signature with :group 'mh-letter :package-version '(MH-E . "8.0")) -(mh-define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks +(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks 'mh-kill-folder-suppress-prompt-functions "24.3") -(defcustom-mh mh-kill-folder-suppress-prompt-functions '(mh-search-p) +(defcustom mh-kill-folder-suppress-prompt-functions '(mh-search-p) "Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder]. The hook functions are called with no arguments and should return @@ -3302,7 +3212,7 @@ accident in the \"+inbox\" folder, you will not be happy." :group 'mh-folder :package-version '(MH-E . "7.4")) -(defcustom-mh mh-letter-mode-hook nil +(defcustom mh-letter-mode-hook nil "Hook run by `mh-letter-mode' on a new letter. This hook allows you to do some processing before editing a @@ -3315,14 +3225,14 @@ go." :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-mh-to-mime-hook nil +(defcustom mh-mh-to-mime-hook nil "Hook run on the formatted letter by \\<mh-letter-mode-map>\\[mh-mh-to-mime]." :type 'hook :group 'mh-hooks :group 'mh-letter :package-version '(MH-E . "8.0")) -(defcustom-mh mh-search-mode-hook nil +(defcustom mh-search-mode-hook nil "Hook run upon entry to `mh-search-mode'\\<mh-folder-mode-map>. If you find that you do the same thing over and over when editing @@ -3334,7 +3244,7 @@ This can be done with this hook which is called when :group 'mh-search :package-version '(MH-E . "8.0")) -(defcustom-mh mh-pack-folder-hook nil +(defcustom mh-pack-folder-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-pack-folder] after renumbering the messages. Hook functions can access the current folder name with `mh-current-folder'." :type 'hook @@ -3342,7 +3252,7 @@ Hook functions can access the current folder name with `mh-current-folder'." :group 'mh-folder :package-version '(MH-E . "8.2")) -(defcustom-mh mh-quit-hook nil +(defcustom mh-quit-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-quit] after quitting MH-E. This hook is not run in an MH-E context, so you might use it to @@ -3354,14 +3264,14 @@ See also `mh-before-quit-hook'." :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-refile-msg-hook nil +(defcustom mh-refile-msg-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-refile-msg] after marking each message for refiling." :type 'hook :group 'mh-hooks :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-show-hook nil +(defcustom mh-show-hook nil "Hook run after \\<mh-folder-mode-map>\\[mh-show] shows a message. It is the last thing called after messages are displayed. It's @@ -3372,7 +3282,7 @@ used to affect the behavior of MH-E in general or when :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-show-mode-hook nil +(defcustom mh-show-mode-hook nil "Hook run upon entry to `mh-show-mode'. This hook is called early on in the process of the message display, @@ -3384,7 +3294,7 @@ buffer itself. See also `mh-show-hook'." :group 'mh-show :package-version '(MH-E . "8.7")) -(defcustom-mh mh-unseen-updated-hook nil +(defcustom mh-unseen-updated-hook nil "Hook run after the unseen sequence has been updated. The variable `mh-seen-list' can be used by this hook to obtain @@ -3395,7 +3305,7 @@ sequence." :group 'mh-sequences :package-version '(MH-E . "6.0")) -(defcustom-mh mh-allowlist-msg-hook nil +(defcustom mh-allowlist-msg-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-junk-allowlist] after marking each message for allowlisting." :type 'hook :group 'mh-hooks @@ -3406,15 +3316,10 @@ sequence." ;;; Faces (:group 'mh-faces + group where faces described) -(if (boundp 'facemenu-unlisted-faces) - ;; This variable was removed in Emacs 22.1. - (add-to-list 'facemenu-unlisted-faces "^mh-")) - ;; To add a new face: ;; 1. Add entry to variable mh-face-data. -;; 2. Create face using defface-mh (which removes min-color spec and -;; :package-version keyword where these are not supported), -;; accessing face data with function mh-face-data. +;; 2. Create face using defface, accessing face data with function +;; mh-face-data. ;; 3. Add inherit argument to function mh-face-data if applicable. (defvar mh-face-data '((mh-folder-followup @@ -3561,18 +3466,17 @@ sequence." (:underline t))))) "MH-E face data. Used by function `mh-face-data' which returns spec that is -consumed by `defface-mh'.") +consumed by `defface'.") (require 'cus-face) -(defvar mh-inherit-face-flag (assq :inherit custom-face-attributes) - "Non-nil means that the `defface' :inherit keyword is available. -The :inherit keyword is available on all supported versions of -GNU Emacs and XEmacs from at least 21.5.23 on.") +(defvar mh-inherit-face-flag t + "Non-nil means that the `defface' :inherit keyword is available.") +(make-obsolete-variable 'mh-inherit-face-flag nil "29.1") -(defvar mh-min-colors-defined-flag (and (not (featurep 'xemacs)) - (>= emacs-major-version 22)) +(defvar mh-min-colors-defined-flag t "Non-nil means `defface' supports min-colors display requirement.") +(make-obsolete-variable 'mh-min-colors-defined-flag nil "29.1") (defun mh-face-data (face &optional inherit) "Return spec for FACE. @@ -3583,53 +3487,26 @@ keyword, return INHERIT literally; otherwise, return spec for FACE from the variable `mh-face-data'. This isn't a perfect implementation. In the case that the :inherit keyword is not supported, any additional attributes in the inherit parameter are -not added to the returned spec. - -Furthermore, when `mh-min-colors-defined-flag' is nil, this -function finds display entries with \"min-colors\" requirements -and either removes the \"min-colors\" requirement or strips the -display entirely if the display does not support the number of -specified colors." - (let ((spec - (if (and inherit mh-inherit-face-flag) - inherit - (or (cadr (assq face mh-face-data)) - (error "Could not find %s in mh-face-data" face))))) - - (if mh-min-colors-defined-flag - spec - (let ((cells (mh-display-color-cells)) - new-spec) - ;; Remove entries with min-colors, or delete them if we have - ;; fewer colors than they specify. - (cl-loop - for entry in (reverse spec) do - (let ((requirement (if (eq (car entry) t) - nil - (assq 'min-colors (car entry))))) - (if requirement - (when (>= cells (nth 1 requirement)) - (setq new-spec (cons (cons (delq requirement (car entry)) - (cdr entry)) - new-spec))) - (setq new-spec (cons entry new-spec))))) - new-spec)))) - -(defface-mh mh-folder-address +not added to the returned spec." + (or inherit + (cadr (assq face mh-face-data)) + (error "Could not find %s in mh-face-data" face))) + +(defface mh-folder-address (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Recipient face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-blocklisted +(defface mh-folder-blocklisted (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Blocklisted message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.4")) -(defface-mh mh-folder-body +(defface mh-folder-body (mh-face-data 'mh-folder-msg-number '((((class color)) (:inherit mh-folder-msg-number)) @@ -3640,7 +3517,7 @@ specified colors." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-cur-msg-number +(defface mh-folder-cur-msg-number (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number :bold t)))) "Current message number face." @@ -3648,39 +3525,39 @@ specified colors." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-date +(defface mh-folder-date (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Date face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-deleted +(defface mh-folder-deleted (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Deleted message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-followup (mh-face-data 'mh-folder-followup) +(defface mh-folder-followup (mh-face-data 'mh-folder-followup) "\"Re:\" face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) +(defface mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) "Message number face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-refiled (mh-face-data 'mh-folder-refiled) +(defface mh-folder-refiled (mh-face-data 'mh-folder-refiled) "Refiled message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-sent-to-me-hint +(defface mh-folder-sent-to-me-hint (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-date)))) "Fontification hint face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3690,7 +3567,7 @@ format `mh-scan-format-nmh' and the regular expression :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-sent-to-me-sender +(defface mh-folder-sent-to-me-sender (mh-face-data 'mh-folder-followup '((t (:inherit mh-folder-followup)))) "Sender face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3700,105 +3577,105 @@ format `mh-scan-format-nmh' and the regular expression :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-subject (mh-face-data 'mh-folder-subject) +(defface mh-folder-subject (mh-face-data 'mh-folder-subject) "Subject face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-tick (mh-face-data 'mh-folder-tick) +(defface mh-folder-tick (mh-face-data 'mh-folder-tick) "Ticked message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-to (mh-face-data 'mh-folder-to) +(defface mh-folder-to (mh-face-data 'mh-folder-to) "\"To:\" face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-allowlisted +(defface mh-folder-allowlisted (mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled)))) "Allowlisted message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.4")) -(defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field) +(defface mh-letter-header-field (mh-face-data 'mh-letter-header-field) "Editable header field value face in draft buffers." :group 'mh-faces :group 'mh-letter :package-version '(MH-E . "8.0")) -(defface-mh mh-search-folder (mh-face-data 'mh-search-folder) +(defface mh-search-folder (mh-face-data 'mh-search-folder) "Folder heading face in MH-Folder buffers created by searches." :group 'mh-faces :group 'mh-search :package-version '(MH-E . "8.0")) -(defface-mh mh-show-cc (mh-face-data 'mh-show-cc) +(defface mh-show-cc (mh-face-data 'mh-show-cc) "Face used to highlight \"cc:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-date (mh-face-data 'mh-show-date) +(defface mh-show-date (mh-face-data 'mh-show-date) "Face used to highlight \"Date:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-from (mh-face-data 'mh-show-from) +(defface mh-show-from (mh-face-data 'mh-show-from) "Face used to highlight \"From:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-header (mh-face-data 'mh-show-header) +(defface mh-show-header (mh-face-data 'mh-show-header) "Face used to deemphasize less interesting header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) +(defface mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) "Bad PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) +(defface mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) "Good PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) +(defface mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) "Unknown or untrusted PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-signature (mh-face-data 'mh-show-signature) +(defface mh-show-signature (mh-face-data 'mh-show-signature) "Signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-subject +(defface mh-show-subject (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Face used to highlight \"Subject:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-to (mh-face-data 'mh-show-to) +(defface mh-show-to (mh-face-data 'mh-show-to) "Face used to highlight \"To:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-xface +(defface mh-show-xface (mh-face-data 'mh-show-from '((t (:inherit (mh-show-from highlight))))) "X-Face image face. The background and foreground are used in the image." @@ -3806,13 +3683,13 @@ The background and foreground are used in the image." :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) +(defface mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) "Basic folder face." :group 'mh-faces :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-folder-with-unseen-messages +(defface mh-speedbar-folder-with-unseen-messages (mh-face-data 'mh-speedbar-folder '((t (:inherit mh-speedbar-folder :bold t)))) "Folder face when folder contains unread messages." @@ -3820,14 +3697,14 @@ The background and foreground are used in the image." :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-selected-folder +(defface mh-speedbar-selected-folder (mh-face-data 'mh-speedbar-selected-folder) "Selected folder face." :group 'mh-faces :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-selected-folder-with-unseen-messages +(defface mh-speedbar-selected-folder-with-unseen-messages (mh-face-data 'mh-speedbar-selected-folder '((t (:inherit mh-speedbar-selected-folder :bold t)))) "Selected folder face when folder contains unread messages." diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 35277ae46a1..c700b3348df 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -72,10 +72,8 @@ the MH mail system." ;;; Desktop Integration -;; desktop-buffer-mode-handlers appeared in Emacs 22. -(if (boundp 'desktop-buffer-mode-handlers) - (add-to-list 'desktop-buffer-mode-handlers - '(mh-folder-mode . mh-restore-desktop-buffer))) +(add-to-list 'desktop-buffer-mode-handlers + '(mh-folder-mode . mh-restore-desktop-buffer)) (defun mh-restore-desktop-buffer (_file-name name _misc) "Restore an MH folder buffer specified in a desktop file. @@ -213,141 +211,137 @@ annotation.") (defalias 'mh-alt-visit-folder #'mh-visit-folder) ;; Save the "b" binding for a future `back'. Maybe? -(gnus-define-keys mh-folder-mode-map - " " mh-page-msg - "!" mh-refile-or-write-again - "'" mh-toggle-tick - "," mh-header-display - "." mh-alt-show - ":" mh-show-preferred-alternative - ";" mh-toggle-mh-decode-mime-flag - ">" mh-write-msg-to-file - "?" mh-help - "E" mh-extract-rejected-mail - "M" mh-modify - "\177" mh-previous-page - "\C-d" mh-delete-msg-no-motion - "\t" mh-index-next-folder - [backtab] mh-index-previous-folder - "\M-\t" mh-index-previous-folder - "\e<" mh-first-msg - "\e>" mh-last-msg - "\ed" mh-redistribute - "\r" mh-show - "^" mh-alt-refile-msg - "c" mh-copy-msg - "d" mh-delete-msg - "e" mh-edit-again - "f" mh-forward - "g" mh-goto-msg - "i" mh-inc-folder - "k" mh-delete-subject-or-thread - "m" mh-alt-send - "n" mh-next-undeleted-msg - "\M-n" mh-next-unread-msg - "o" mh-refile-msg - "p" mh-previous-undeleted-msg - "\M-p" mh-previous-unread-msg - "q" mh-quit - "r" mh-reply - "s" mh-send - "t" mh-toggle-showing - "u" mh-undo - "v" mh-index-visit-folder - "x" mh-execute-commands - "|" mh-pipe-msg) - -(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) - "?" mh-prefix-help - "'" mh-index-ticked-messages - "S" mh-sort-folder - "c" mh-catchup - "f" mh-alt-visit-folder - "k" mh-kill-folder - "l" mh-list-folders - "n" mh-index-new-messages - "o" mh-alt-visit-folder - "p" mh-pack-folder - "q" mh-index-sequenced-messages - "r" mh-rescan-folder - "s" mh-search - "u" mh-undo-folder - "v" mh-visit-folder) - -(define-key mh-folder-mode-map "I" mh-inc-spool-map) - -(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map) - "?" mh-prefix-help - "a" mh-junk-allowlist - "b" mh-junk-blocklist - "w" mh-junk-whitelist) - -(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map) - "?" mh-prefix-help - "C" mh-ps-print-toggle-color - "F" mh-ps-print-toggle-faces - "f" mh-ps-print-msg-file - "l" mh-print-msg - "p" mh-ps-print-msg) - -(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) - "'" mh-narrow-to-tick - "?" mh-prefix-help - "d" mh-delete-msg-from-seq - "k" mh-delete-seq - "l" mh-list-sequences - "n" mh-narrow-to-seq - "p" mh-put-msg-in-seq - "s" mh-msg-is-in-seq - "w" mh-widen) - -(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map) - "?" mh-prefix-help - "u" mh-thread-ancestor - "p" mh-thread-previous-sibling - "n" mh-thread-next-sibling - "t" mh-toggle-threads - "d" mh-thread-delete - "o" mh-thread-refile) - -(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) - "'" mh-narrow-to-tick - "?" mh-prefix-help - "c" mh-narrow-to-cc - "g" mh-narrow-to-range - "m" mh-narrow-to-from - "s" mh-narrow-to-subject - "t" mh-narrow-to-to - "w" mh-widen) - -(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) - "?" mh-prefix-help - "s" mh-store-msg ;shar - "u" mh-store-msg) ;uuencode - -(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map) - " " mh-page-digest - "?" mh-prefix-help - "\177" mh-page-digest-backwards - "b" mh-burst-digest) - -(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) - "?" mh-prefix-help - "a" mh-mime-save-parts - "e" mh-display-with-external-viewer - "i" mh-folder-inline-mime-part - "o" mh-folder-save-mime-part - "t" mh-toggle-mime-buttons - "v" mh-folder-toggle-mime-part - "\t" mh-next-button - [backtab] mh-prev-button - "\M-\t" mh-prev-button) - -(cond - ((featurep 'xemacs) - (define-key mh-folder-mode-map [button2] 'mh-show-mouse)) - (t - (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse))) +(define-keymap :keymap mh-folder-mode-map + " " #'mh-page-msg + "!" #'mh-refile-or-write-again + "'" #'mh-toggle-tick + "," #'mh-header-display + "." #'mh-alt-show + ":" #'mh-show-preferred-alternative + ";" #'mh-toggle-mh-decode-mime-flag + ">" #'mh-write-msg-to-file + "?" #'mh-help + "E" #'mh-extract-rejected-mail + "M" #'mh-modify + "\177" #'mh-previous-page + "\C-d" #'mh-delete-msg-no-motion + "\t" #'mh-index-next-folder + [backtab] #'mh-index-previous-folder + "\M-\t" #'mh-index-previous-folder + "\e<" #'mh-first-msg + "\e>" #'mh-last-msg + "\ed" #'mh-redistribute + "\r" #'mh-show + "^" #'mh-alt-refile-msg + "c" #'mh-copy-msg + "d" #'mh-delete-msg + "e" #'mh-edit-again + "f" #'mh-forward + "g" #'mh-goto-msg + "i" #'mh-inc-folder + "k" #'mh-delete-subject-or-thread + "m" #'mh-alt-send + "n" #'mh-next-undeleted-msg + "\M-n" #'mh-next-unread-msg + "o" #'mh-refile-msg + "p" #'mh-previous-undeleted-msg + "\M-p" #'mh-previous-unread-msg + "q" #'mh-quit + "r" #'mh-reply + "s" #'mh-send + "t" #'mh-toggle-showing + "u" #'mh-undo + "v" #'mh-index-visit-folder + "x" #'mh-execute-commands + "|" #'mh-pipe-msg + + "F" (define-keymap :prefix 'mh-folder-map + "?" #'mh-prefix-help + "'" #'mh-index-ticked-messages + "S" #'mh-sort-folder + "c" #'mh-catchup + "f" #'mh-alt-visit-folder + "k" #'mh-kill-folder + "l" #'mh-list-folders + "n" #'mh-index-new-messages + "o" #'mh-alt-visit-folder + "p" #'mh-pack-folder + "q" #'mh-index-sequenced-messages + "r" #'mh-rescan-folder + "s" #'mh-search + "u" #'mh-undo-folder + "v" #'mh-visit-folder) + + "I" mh-inc-spool-map + + "J" (define-keymap :prefix 'mh-junk-map + "?" #'mh-prefix-help + "a" #'mh-junk-allowlist + "b" #'mh-junk-blocklist + "w" #'mh-junk-whitelist) + + "P" (define-keymap :prefix 'mh-ps-print-map + "?" #'mh-prefix-help + "C" #'mh-ps-print-toggle-color + "F" #'mh-ps-print-toggle-faces + "f" #'mh-ps-print-msg-file + "l" #'mh-print-msg + "p" #'mh-ps-print-msg) + + "S" (define-keymap :prefix 'mh-sequence-map + "'" #'mh-narrow-to-tick + "?" #'mh-prefix-help + "d" #'mh-delete-msg-from-seq + "k" #'mh-delete-seq + "l" #'mh-list-sequences + "n" #'mh-narrow-to-seq + "p" #'mh-put-msg-in-seq + "s" #'mh-msg-is-in-seq + "w" #'mh-widen) + + "T" (define-keymap :prefix 'mh-thread-map + "?" #'mh-prefix-help + "u" #'mh-thread-ancestor + "p" #'mh-thread-previous-sibling + "n" #'mh-thread-next-sibling + "t" #'mh-toggle-threads + "d" #'mh-thread-delete + "o" #'mh-thread-refile) + + "/" (define-keymap :prefix 'mh-limit-map + "'" #'mh-narrow-to-tick + "?" #'mh-prefix-help + "c" #'mh-narrow-to-cc + "g" #'mh-narrow-to-range + "m" #'mh-narrow-to-from + "s" #'mh-narrow-to-subject + "t" #'mh-narrow-to-to + "w" #'mh-widen) + + "X" (define-keymap :prefix 'mh-extract-map + "?" #'mh-prefix-help + "s" #'mh-store-msg ;shar + "u" #'mh-store-msg) ;uuencode + + "D" (define-keymap :prefix 'mh-digest-map + " " #'mh-page-digest + "?" #'mh-prefix-help + "\177" #'mh-page-digest-backwards + "b" #'mh-burst-digest) + + "K" (define-keymap :prefix 'mh-mime-map + "?" #'mh-prefix-help + "a" #'mh-mime-save-parts + "e" #'mh-display-with-external-viewer + "i" #'mh-folder-inline-mime-part + "o" #'mh-folder-save-mime-part + "t" #'mh-toggle-mime-buttons + "v" #'mh-folder-toggle-mime-part + "\t" #'mh-next-button + [backtab] #'mh-prev-button + "\M-\t" #'mh-prev-button) + + [mouse-2] #'mh-show-mouse) ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt @@ -512,24 +506,14 @@ font-lock is done highlighting.") ;;; MH-Folder Mode (defmacro mh-remove-xemacs-horizontal-scrollbar () - "Get rid of the horizontal scrollbar that XEmacs insists on putting in." - (when (featurep 'xemacs) - '(if (and (featurep 'scrollbar) - (fboundp 'set-specifier)) - (set-specifier horizontal-scrollbar-visible-p nil - (cons (current-buffer) nil))))) + (declare (obsolete nil "29.1")) + nil) ;; Register mh-folder-mode as supporting which-function-mode... -(eval-and-compile (mh-require 'which-func nil t)) +(eval-and-compile (require 'which-func nil t)) (when (and (boundp 'which-func-modes) (listp which-func-modes)) (add-to-list 'which-func-modes 'mh-folder-mode)) -;; Shush compiler. -(defvar desktop-save-buffer) -(defvar font-lock-auto-fontify) -(mh-do-in-xemacs - (defvar font-lock-defaults)) - ;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-folder-mode 'mode-class 'special) @@ -590,80 +574,68 @@ region in the MH-Folder buffer, then the MH-E command will perform the operation on all messages in that region. \\{mh-folder-mode-map}" - (mh-do-in-gnu-emacs - (unless mh-folder-tool-bar-map - (mh-tool-bar-folder-buttons-init)) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))) - (mh-do-in-xemacs - (mh-tool-bar-init :folder)) + (unless mh-folder-tool-bar-map + (mh-tool-bar-folder-buttons-init)) + (if (boundp 'tool-bar-map) + (setq-local tool-bar-map mh-folder-tool-bar-map)) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) (make-local-variable 'desktop-save-buffer) (setq desktop-save-buffer t) - (mh-make-local-vars - 'mh-colors-available-flag (mh-colors-available-p) + (setq-local + mh-colors-available-flag (mh-colors-available-p) ; Do we have colors available - 'mh-current-folder (buffer-name) ; Name of folder, a string - 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs - 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" + mh-current-folder (buffer-name) ; Name of folder, a string + mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs + mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" (file-name-as-directory (mh-expand-file-name (buffer-name))) - 'mh-display-buttons-for-inline-parts-flag + mh-display-buttons-for-inline-parts-flag mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to ; be toggled. - 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed - 'overlay-arrow-position nil ; Allow for simultaneous display in - 'overlay-arrow-string ">" ; different MH-E buffers. - 'mh-showing-mode nil ; Show message also? - 'mh-refile-list nil ; List of folder names in mh-seq-list - 'mh-delete-list nil ; List of msgs nums to delete - 'mh-blocklist nil ; List of messages to process as spam - 'mh-allowlist nil ; List of messages to process as ham - 'mh-seq-list nil ; Alist of (seq . msgs) nums - 'mh-seen-list nil ; List of displayed messages - 'mh-next-direction 'forward ; Direction to move to next message - 'mh-view-ops () ; Stack that keeps track of the order + mh-arrow-marker (make-marker) ; Marker where arrow is displayed + overlay-arrow-position nil ; Allow for simultaneous display in + overlay-arrow-string ">" ; different MH-E buffers. + mh-showing-mode nil ; Show message also? + mh-refile-list nil ; List of folder names in mh-seq-list + mh-delete-list nil ; List of msgs nums to delete + mh-blocklist nil ; List of messages to process as spam + mh-allowlist nil ; List of messages to process as ham + mh-seq-list nil ; Alist of (seq . msgs) nums + mh-seen-list nil ; List of displayed messages + mh-next-direction 'forward ; Direction to move to next message + mh-view-ops () ; Stack that keeps track of the order ; in which narrowing/threading has been ; carried out. - 'mh-folder-view-stack () ; Stack of previous views of the + mh-folder-view-stack () ; Stack of previous views of the ; folder. - 'mh-index-data nil ; If the folder was created by a call + mh-index-data nil ; If the folder was created by a call ; to mh-search, this contains info ; about the search results. - 'mh-index-previous-search nil ; folder, indexer, search-regexp - 'mh-index-msg-checksum-map nil ; msg -> checksum map - 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) - 'mh-index-sequence-search-flag nil ; folder resulted from sequence search - 'mh-first-msg-num nil ; Number of first msg in buffer - 'mh-last-msg-num nil ; Number of last msg in buffer - 'mh-msg-count nil ; Number of msgs in buffer - 'mh-mode-line-annotation nil ; Indicates message range - 'mh-sequence-notation-history (make-hash-table) + mh-index-previous-search nil ; folder, indexer, search-regexp + mh-index-msg-checksum-map nil ; msg -> checksum map + mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) + mh-index-sequence-search-flag nil ; folder resulted from sequence search + mh-first-msg-num nil ; Number of first msg in buffer + mh-last-msg-num nil ; Number of last msg in buffer + mh-msg-count nil ; Number of msgs in buffer + mh-mode-line-annotation nil ; Indicates message range + mh-sequence-notation-history (make-hash-table) ; Remember what is overwritten by ; mh-note-seq. - 'imenu-create-index-function 'mh-index-create-imenu-index + imenu-create-index-function 'mh-index-create-imenu-index ; Setup imenu support - 'mh-previous-window-config nil) ; Previous window configuration - (mh-remove-xemacs-horizontal-scrollbar) + mh-previous-window-config nil) ; Previous window configuration (setq truncate-lines t) (auto-save-mode -1) (setq buffer-offer-save t) - (mh-make-local-hook (mh-write-file-functions)) - (add-hook (mh-write-file-functions) #'mh-execute-commands nil t) + (add-hook 'write-file-functions #'mh-execute-commands nil t) (make-local-variable 'revert-buffer-function) (make-local-variable 'hl-line-mode) ; avoid pollution (mh-funcall-if-exists hl-line-mode 1) (setq revert-buffer-function #'mh-undo-folder) (add-to-list 'minor-mode-alist '(mh-showing-mode " Show")) - (mh-do-in-xemacs - (easy-menu-add mh-folder-sequence-menu) - (easy-menu-add mh-folder-message-menu) - (easy-menu-add mh-folder-folder-menu)) (mh-inc-spool-make) - (mh-set-help mh-folder-mode-help-messages) - (if (and (featurep 'xemacs) - font-lock-auto-fontify) - (turn-on-font-lock))) ; Force font-lock in XEmacs. + (mh-set-help mh-folder-mode-help-messages)) @@ -1571,35 +1543,35 @@ after the commands are processed." (append folders-changed (mh-index-execute-commands)))) ;; Then refile messages - (mh-mapc #'(lambda (folder-msg-list) - (let* ((dest-folder (symbol-name (car folder-msg-list))) - (last (car (mh-translate-range dest-folder "last"))) - (msgs (cdr folder-msg-list))) - (push dest-folder folders-changed) - (setq redraw-needed-flag t) - (apply #'mh-exec-cmd - "refile" "-src" folder dest-folder - (mh-coalesce-msg-list msgs)) - (mh-delete-scan-msgs msgs) - ;; Preserve sequences in destination folder... - (when mh-refile-preserves-sequences-flag - (clrhash dest-map) - (cl-loop - for i from (1+ (or last 0)) - for msg in (sort (copy-sequence msgs) #'<) - do (cl-loop for seq-name in (gethash msg seq-map) - do (push i (gethash seq-name dest-map)))) - (maphash - #'(lambda (seq msgs) - ;; Can't be run in the background, since the - ;; current folder is changed by mark this could - ;; lead to a race condition with the next refile. - (apply #'mh-exec-cmd "mark" - "-sequence" (symbol-name seq) dest-folder - "-add" (mapcar #'(lambda (x) (format "%s" x)) - (mh-coalesce-msg-list msgs)))) - dest-map)))) - mh-refile-list) + (mapc (lambda (folder-msg-list) + (let* ((dest-folder (symbol-name (car folder-msg-list))) + (last (car (mh-translate-range dest-folder "last"))) + (msgs (cdr folder-msg-list))) + (push dest-folder folders-changed) + (setq redraw-needed-flag t) + (apply #'mh-exec-cmd + "refile" "-src" folder dest-folder + (mh-coalesce-msg-list msgs)) + (mh-delete-scan-msgs msgs) + ;; Preserve sequences in destination folder... + (when mh-refile-preserves-sequences-flag + (clrhash dest-map) + (cl-loop + for i from (1+ (or last 0)) + for msg in (sort (copy-sequence msgs) #'<) + do (cl-loop for seq-name in (gethash msg seq-map) + do (push i (gethash seq-name dest-map)))) + (maphash + #'(lambda (seq msgs) + ;; Can't be run in the background, since the + ;; current folder is changed by mark this could + ;; lead to a race condition with the next refile. + (apply #'mh-exec-cmd "mark" + "-sequence" (symbol-name seq) dest-folder + "-add" (mapcar #'(lambda (x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) + dest-map)))) + mh-refile-list) (setq mh-refile-list ()) ;; Now delete messages @@ -1642,14 +1614,14 @@ after the commands are processed." do (cl-loop for seq-name in (gethash msg seq-map) do (push i (gethash seq-name allow-map)))) (maphash - #'(lambda (seq msgs) - ;; Can't be run in background, since the current - ;; folder is changed by mark this could lead to a - ;; race condition with the next refile/allowlist. - (apply #'mh-exec-cmd "mark" - "-sequence" (symbol-name seq) mh-inbox - "-add" (mapcar #'(lambda(x) (format "%s" x)) - (mh-coalesce-msg-list msgs)))) + (lambda (seq msgs) + ;; Can't be run in background, since the current + ;; folder is changed by mark this could lead to a + ;; race condition with the next refile/allowlist. + (apply #'mh-exec-cmd "mark" + "-sequence" (symbol-name seq) mh-inbox + "-add" (mapcar #'(lambda(x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) allow-map)) (setq mh-allowlist nil))) diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 4a5e670c1ef..0c73aae0d79 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -147,7 +147,7 @@ Display the results only if something went wrong." "-recurse" "-norecurse")) (goto-char (point-min)) - (mh-view-mode-enter) + (view-mode-enter) (setq view-exit-action 'kill-buffer) (message "Listing folders...done"))))) diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index cc60f7b6640..0e1bde71f20 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -29,110 +29,49 @@ (require 'mh-e) (eval-and-compile - (mh-require 'gnus-util nil t) - (mh-require 'mm-bodies nil t) - (mh-require 'mm-decode nil t) - (mh-require 'mm-view nil t) - (mh-require 'mml nil t)) - -;; Copy of function from gnus-util.el. -;; TODO This is not in Gnus 5.11. -(defun-mh mh-gnus-local-map-property gnus-local-map-property (map) + (require 'gnus-util nil t) + (require 'mm-bodies nil t) + (require 'mm-decode nil t) + (require 'mm-view nil t) + (require 'mml nil t)) + +(defun mh-gnus-local-map-property (map) "Return a list suitable for a text property list specifying keymap MAP." - (cond ((featurep 'xemacs) (list 'keymap map)) - ((>= emacs-major-version 21) (list 'keymap map)) - (t (list 'local-map map)))) - -;; Copy of function from mm-decode.el. -(defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2) - (append - (if (listp (car handles1)) - handles1 - (list handles1)) - (if (listp (car handles2)) - handles2 - (list handles2)))) - -;; Copy of function from mm-decode.el. -(defun-mh mh-mm-set-handle-multipart-parameter - mm-set-handle-multipart-parameter (handle parameter value) - ;; HANDLE could be a CTL. - (when handle - (put-text-property 0 (length (car handle)) parameter value - (car handle)))) - -;; Copy of function from mm-view.el. -(defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle) - (let ((inhibit-read-only t)) - (mm-insert-inline - handle - (concat "\n-- \n" - (ignore-errors - (if (fboundp 'vcard-pretty-print) - (vcard-pretty-print (mm-get-part handle)) - (vcard-format-string - (vcard-parse-string (mm-get-part handle) - 'vcard-standard-filter)))))))) - -;; Function from mm-decode.el used in PGP messages. Just define it with older -;; Gnus to avoid compiler warning. -(defun-mh mh-mm-possibly-verify-or-decrypt - mm-possibly-verify-or-decrypt (_parts _ctl) - nil) - -;; Copy of macro in mm-decode.el. -(defmacro-mh mh-mm-handle-multipart-ctl-parameter - mm-handle-multipart-ctl-parameter (handle parameter) - `(get-text-property 0 ,parameter (car ,handle))) - -;; Copy of function in mm-decode.el. -(defun-mh mh-mm-readable-p mm-readable-p (handle) - "Say whether the content of HANDLE is readable." - (and (< (with-current-buffer (mm-handle-buffer handle) - (buffer-size)) 10000) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (and (eq (mm-body-7-or-8) '7bit) - (not (mh-mm-long-lines-p 76)))))) - -;; Copy of function in mm-bodies.el. -(defun-mh mh-mm-long-lines-p mm-long-lines-p (length) - "Say whether any of the lines in the buffer is longer than LENGTH." - (save-excursion - (goto-char (point-min)) - (end-of-line) - (while (and (not (eobp)) - (not (> (current-column) length))) - (forward-line 1) - (end-of-line)) - (and (> (current-column) length) - (current-column)))) - -(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (_handle) - ;; Released Gnus doesn't keep handles associated with externally displayed - ;; MIME parts. So this will always return nil. - nil) - -(defun-mh mh-mm-destroy-parts mm-destroy-parts (_list) - "Older versions of Emacs don't have this function." - nil) - -(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (_handles) - "Emacs 21 and XEmacs don't have this function." - nil) - -;; Copy of function in mml.el. -(defun-mh mh-mml-minibuffer-read-disposition - mml-minibuffer-read-disposition (type &optional default filename) - (unless default - (setq default (mml-content-disposition type filename))) - (let ((disposition (completing-read - (format-prompt "Disposition" default) - '(("attachment") ("inline") ("")) - nil t nil nil default))) - (if (not (equal disposition "")) - disposition - default))) + (declare (obsolete nil "29.1")) + (list 'keymap map)) + +(define-obsolete-function-alias 'mh-mm-merge-handles + #'mm-merge-handles "29.1") + +(define-obsolete-function-alias 'mh-mm-set-handle-multipart-parameter + #'mm-set-handle-multipart-parameter "29.1") + +(define-obsolete-function-alias 'mh-mm-inline-text-vcard + #'mm-inline-text-vcard "29.1") + +(define-obsolete-function-alias 'mh-mm-possibly-verify-or-decrypt + #'mm-possibly-verify-or-decrypt "29.1") + +(define-obsolete-function-alias 'mh-mm-handle-multipart-ctl-parameter + #'mm-handle-multipart-ctl-parameter "29.1") + +(define-obsolete-function-alias 'mh-mm-readable-p + #'mm-readable-p "29.1") + +(define-obsolete-function-alias 'mh-mm-long-lines-p + #'mm-long-lines-p "29.1") + +(define-obsolete-function-alias 'mh-mm-keep-viewer-alive-p + #'mm-keep-viewer-alive-p "29.1") + +(define-obsolete-function-alias 'mh-mm-destroy-parts + #'mm-destroy-parts "29.1") + +(define-obsolete-function-alias 'mh-mm-uu-dissect-text-parts + #'mm-uu-dissect-text-parts "29.1") + +(define-obsolete-function-alias 'mh-mml-minibuffer-read-disposition + #'mml-minibuffer-read-disposition "29.1") ;; This is mm-save-part from Gnus 5.11 since that function in Emacs ;; 21.2 is buggy (the args to read-file-name are incorrect) and the @@ -163,8 +102,8 @@ PROMPT overrides the default one used to ask user for a file name." (defun mh-mm-text-html-renderer () "Find the renderer Gnus is using to display text/html MIME parts." - (or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer) - (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))) + (declare (obsolete mm-text-html-renderer "29.1")) + mm-text-html-renderer) (provide 'mh-gnus) diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index ceede0d07cb..994ab713915 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -39,11 +39,10 @@ (autoload 'mml-insert-tag "mml") -(defvar mh-identity-pgg-default-user-id nil +(defvar-local mh-identity-pgg-default-user-id nil "Holds the GPG key ID to be used by pgg.el. This is normally set as part of an Identity in `mh-identity-list'.") -(make-variable-buffer-local 'mh-identity-pgg-default-user-id) (defvar mh-identity-menu nil "The Identity menu.") @@ -54,8 +53,7 @@ This is normally set as part of an Identity in (defun mh-identity-make-menu () "Build the Identity menu. This should be called any time `mh-identity-list' or -`mh-auto-fields-list' change. -See `mh-identity-add-menu'." +`mh-auto-fields-list' change." (easy-menu-define mh-identity-menu mh-letter-mode-map "MH-E identity menu" (append @@ -88,12 +86,11 @@ See `mh-identity-add-menu'." (defun mh-identity-add-menu () "Add the current Identity menu. See `mh-identity-make-menu'." - (if mh-identity-menu - (mh-do-in-xemacs (easy-menu-add mh-identity-menu)))) + (declare (obsolete nil "29.1")) + nil) -(defvar mh-identity-local nil +(defvar-local mh-identity-local nil "Buffer-local variable that holds the identity currently in use.") -(make-variable-buffer-local 'mh-identity-local) (defun mh-header-field-delete (field value-only) "Delete header FIELD, or only its value if VALUE-ONLY is t. @@ -122,7 +119,7 @@ The field name is downcased. If the FIELD begins with the character \":\", then it must have a special handler defined in `mh-identity-handlers', else return an error since it is not a valid header field." - (or (cdr (mh-assoc-string field mh-identity-handlers t)) + (or (cdr (assoc-string field mh-identity-handlers t)) (and (eq (aref field 0) ?:) (error "Field %s not found in `mh-identity-handlers'" field)) (cdr (assoc ":default" mh-identity-handlers)) @@ -235,11 +232,9 @@ added." (if (null value) (mh-insert-signature) (mh-insert-signature value)) - (set (make-local-variable 'mh-identity-signature-start) - (point-min-marker)) + (setq-local mh-identity-signature-start (point-min-marker)) (set-marker-insertion-type mh-identity-signature-start t) - (set (make-local-variable 'mh-identity-signature-end) - (point-max-marker))))))) + (setq-local mh-identity-signature-end (point-max-marker))))))) (defvar mh-identity-attribution-verb-start nil "Marker for the beginning of the attribution verb.") @@ -271,11 +266,9 @@ If VALUE is nil, use `mh-extract-from-attribution-verb'." (if (null value) (insert mh-extract-from-attribution-verb) (insert value)) - (set (make-local-variable 'mh-identity-attribution-verb-start) - (point-min-marker)) + (setq-local mh-identity-attribution-verb-start (point-min-marker)) (set-marker-insertion-type mh-identity-attribution-verb-start t) - (set (make-local-variable 'mh-identity-attribution-verb-end) - (point-max-marker)))) + (setq-local mh-identity-attribution-verb-end (point-max-marker)))) (defun mh-identity-handler-default (field action top &optional value) "Process header FIELD. diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index ae5b80d5807..1f7902640a1 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -114,68 +114,68 @@ ;;; MH-Letter Keys ;; If this changes, modify mh-letter-mode-help-messages accordingly, above. -(gnus-define-keys mh-letter-mode-map - " " mh-letter-complete-or-space - "," mh-letter-confirm-address - "\C-c?" mh-help - "\C-c\C-\\" mh-fully-kill-draft ;if no C-q - "\C-c\C-^" mh-insert-signature ;if no C-s - "\C-c\C-c" mh-send-letter - "\C-c\C-d" mh-insert-identity - "\C-c\C-e" mh-mh-to-mime - "\C-c\C-f\C-a" mh-to-field - "\C-c\C-f\C-b" mh-to-field - "\C-c\C-f\C-c" mh-to-field - "\C-c\C-f\C-d" mh-to-field - "\C-c\C-f\C-f" mh-to-fcc - "\C-c\C-f\C-l" mh-to-field - "\C-c\C-f\C-m" mh-to-field - "\C-c\C-f\C-r" mh-to-field - "\C-c\C-f\C-s" mh-to-field - "\C-c\C-f\C-t" mh-to-field - "\C-c\C-fa" mh-to-field - "\C-c\C-fb" mh-to-field - "\C-c\C-fc" mh-to-field - "\C-c\C-fd" mh-to-field - "\C-c\C-ff" mh-to-fcc - "\C-c\C-fl" mh-to-field - "\C-c\C-fm" mh-to-field - "\C-c\C-fr" mh-to-field - "\C-c\C-fs" mh-to-field - "\C-c\C-ft" mh-to-field - "\C-c\C-i" mh-insert-letter - "\C-c\C-m\C-e" mh-mml-secure-message-encrypt - "\C-c\C-m\C-f" mh-compose-forward - "\C-c\C-m\C-g" mh-mh-compose-anon-ftp - "\C-c\C-m\C-i" mh-compose-insertion - "\C-c\C-m\C-m" mh-mml-to-mime - "\C-c\C-m\C-n" mh-mml-unsecure-message - "\C-c\C-m\C-s" mh-mml-secure-message-sign - "\C-c\C-m\C-t" mh-mh-compose-external-compressed-tar - "\C-c\C-m\C-u" mh-mh-to-mime-undo - "\C-c\C-m\C-x" mh-mh-compose-external-type - "\C-c\C-mee" mh-mml-secure-message-encrypt - "\C-c\C-mes" mh-mml-secure-message-signencrypt - "\C-c\C-mf" mh-compose-forward - "\C-c\C-mg" mh-mh-compose-anon-ftp - "\C-c\C-mi" mh-compose-insertion - "\C-c\C-mm" mh-mml-to-mime - "\C-c\C-mn" mh-mml-unsecure-message - "\C-c\C-mse" mh-mml-secure-message-signencrypt - "\C-c\C-mss" mh-mml-secure-message-sign - "\C-c\C-mt" mh-mh-compose-external-compressed-tar - "\C-c\C-mu" mh-mh-to-mime-undo - "\C-c\C-mx" mh-mh-compose-external-type - "\C-c\C-o" mh-open-line - "\C-c\C-q" mh-fully-kill-draft - "\C-c\C-s" mh-insert-signature - "\C-c\C-t" mh-letter-toggle-header-field-display - "\C-c\C-w" mh-check-whom - "\C-c\C-y" mh-yank-cur-msg - "\C-c\M-d" mh-insert-auto-fields - "\M-\t" mh-letter-complete - "\t" mh-letter-next-header-field-or-indent - [backtab] mh-letter-previous-header-field) +(define-keymap :keymap mh-letter-mode-map + " " #'mh-letter-complete-or-space + "," #'mh-letter-confirm-address + "\C-c?" #'mh-help + "\C-c\C-\\" #'mh-fully-kill-draft ;if no C-q + "\C-c\C-^" #'mh-insert-signature ;if no C-s + "\C-c\C-c" #'mh-send-letter + "\C-c\C-d" #'mh-insert-identity + "\C-c\C-e" #'mh-mh-to-mime + "\C-c\C-f\C-a" #'mh-to-field + "\C-c\C-f\C-b" #'mh-to-field + "\C-c\C-f\C-c" #'mh-to-field + "\C-c\C-f\C-d" #'mh-to-field + "\C-c\C-f\C-f" #'mh-to-fcc + "\C-c\C-f\C-l" #'mh-to-field + "\C-c\C-f\C-m" #'mh-to-field + "\C-c\C-f\C-r" #'mh-to-field + "\C-c\C-f\C-s" #'mh-to-field + "\C-c\C-f\C-t" #'mh-to-field + "\C-c\C-fa" #'mh-to-field + "\C-c\C-fb" #'mh-to-field + "\C-c\C-fc" #'mh-to-field + "\C-c\C-fd" #'mh-to-field + "\C-c\C-ff" #'mh-to-fcc + "\C-c\C-fl" #'mh-to-field + "\C-c\C-fm" #'mh-to-field + "\C-c\C-fr" #'mh-to-field + "\C-c\C-fs" #'mh-to-field + "\C-c\C-ft" #'mh-to-field + "\C-c\C-i" #'mh-insert-letter + "\C-c\C-m\C-e" #'mh-mml-secure-message-encrypt + "\C-c\C-m\C-f" #'mh-compose-forward + "\C-c\C-m\C-g" #'mh-mh-compose-anon-ftp + "\C-c\C-m\C-i" #'mh-compose-insertion + "\C-c\C-m\C-m" #'mh-mml-to-mime + "\C-c\C-m\C-n" #'mh-mml-unsecure-message + "\C-c\C-m\C-s" #'mh-mml-secure-message-sign + "\C-c\C-m\C-t" #'mh-mh-compose-external-compressed-tar + "\C-c\C-m\C-u" #'mh-mh-to-mime-undo + "\C-c\C-m\C-x" #'mh-mh-compose-external-type + "\C-c\C-mee" #'mh-mml-secure-message-encrypt + "\C-c\C-mes" #'mh-mml-secure-message-signencrypt + "\C-c\C-mf" #'mh-compose-forward + "\C-c\C-mg" #'mh-mh-compose-anon-ftp + "\C-c\C-mi" #'mh-compose-insertion + "\C-c\C-mm" #'mh-mml-to-mime + "\C-c\C-mn" #'mh-mml-unsecure-message + "\C-c\C-mse" #'mh-mml-secure-message-signencrypt + "\C-c\C-mss" #'mh-mml-secure-message-sign + "\C-c\C-mt" #'mh-mh-compose-external-compressed-tar + "\C-c\C-mu" #'mh-mh-to-mime-undo + "\C-c\C-mx" #'mh-mh-compose-external-type + "\C-c\C-o" #'mh-open-line + "\C-c\C-q" #'mh-fully-kill-draft + "\C-c\C-s" #'mh-insert-signature + "\C-c\C-t" #'mh-letter-toggle-header-field-display + "\C-c\C-w" #'mh-check-whom + "\C-c\C-y" #'mh-yank-cur-msg + "\C-c\M-d" #'mh-insert-auto-fields + "\M-\t" #'completion-at-point + "\t" #'mh-letter-next-header-field-or-indent + [backtab] #'mh-letter-previous-header-field) ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. @@ -253,17 +253,13 @@ searching for `mh-mail-header-separator' in the buffer." (goto-char (point-min)) (cond ((equal mh-mail-header-separator "") (point-min)) ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t) - (mh-line-beginning-position 0)) + (line-beginning-position 0)) (t (point-min))))) ;;; MH-Letter Mode -;; Shush compiler. -(mh-do-in-xemacs - (defvar font-lock-defaults)) - ;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-letter-mode 'mode-class 'special) @@ -295,24 +291,21 @@ order). (make-local-variable 'mh-previous-window-config) (make-local-variable 'mh-sent-from-folder) (make-local-variable 'mh-sent-from-msg) - (mh-do-in-gnu-emacs - (unless mh-letter-tool-bar-map - (mh-tool-bar-letter-buttons-init)) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))) - (mh-do-in-xemacs - (mh-tool-bar-init :letter)) + (unless mh-letter-tool-bar-map + (mh-tool-bar-letter-buttons-init)) + (if (boundp 'tool-bar-map) + (setq-local tool-bar-map mh-letter-tool-bar-map)) ;; Set the local value of mh-mail-header-separator according to what is ;; present in the buffer... - (set (make-local-variable 'mh-mail-header-separator) - (save-excursion - (goto-char (mh-mail-header-end)) - (buffer-substring-no-properties (point) (mh-line-end-position)))) + (setq-local mh-mail-header-separator + (save-excursion + (goto-char (mh-mail-header-end)) + (buffer-substring-no-properties (point) (line-end-position)))) (make-local-variable 'mail-header-separator) (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el (mh-set-help mh-letter-mode-help-messages) (setq buffer-invisibility-spec '((vanish . t) t)) - (set (make-local-variable 'line-move-ignore-invisible) t) + (setq-local line-move-ignore-invisible t) ;; Enable undo since a show-mode buffer might have been reused. (buffer-enable-undo) @@ -328,12 +321,10 @@ order). (t ;; ...or the header only (setq font-lock-defaults '((mh-show-font-lock-keywords) t)))) - (mh-do-in-xemacs (easy-menu-add mh-letter-menu)) ;; Maybe we want to use the existing Mail menu from mail-mode in ;; 9.0; in the mean time, let's remove it since the redundancy will ;; only produce confusion. (define-key mh-letter-mode-map [menu-bar mail] #'undefined) - (mh-do-in-xemacs (easy-menu-remove mail-menubar-menu)) (setq fill-column mh-letter-fill-column) (add-hook 'completion-at-point-functions #'mh-letter-completion-at-point nil 'local) @@ -488,29 +479,8 @@ This provides alias and folder completion in header fields according to (or (funcall func) #'ignore) mh-letter-complete-function))) -;; TODO Now that completion-at-point performs the task of -;; mh-letter-complete, perhaps mh-letter-complete along with -;; mh-complete-word should be rewritten as a more general function for -;; XEmacs, renamed to mh-completion-at-point, and moved to -;; mh-compat.el. -(defun-mh mh-letter-complete completion-at-point () - "Perform completion on header field or word preceding point. - -If the field contains addresses (for example, \"To:\" or \"Cc:\") -or folders (for example, \"Fcc:\") then this command will provide -alias completion. In the body of the message, this command runs -`mh-letter-complete-function' instead, which is set to -`ispell-complete-word' by default." - (interactive) - (let ((data (mh-letter-completion-at-point))) - (cond - ((functionp data) (funcall data)) - ((consp data) - (let ((start (nth 0 data)) - (end (nth 1 data)) - (table (nth 2 data))) - (mh-complete-word (buffer-substring-no-properties start end) - table start end)))))) +(define-obsolete-function-alias 'mh-letter-complete + #'completion-at-point "29.1") (defun mh-letter-complete-or-space (arg) "Perform completion or insert space. @@ -530,7 +500,7 @@ one space." ((> (point) end-of-prev) (self-insert-command arg)) ((let ((mh-letter-complete-function nil)) (mh-letter-completion-at-point)) - (mh-letter-complete)) + (completion-at-point)) (t (self-insert-command arg))))) (defun mh-letter-confirm-address () @@ -722,7 +692,7 @@ and `mh-ins-buf-prefix' is not inserted." ;; Find displayed message (with-current-buffer show-buffer (let* ((from-attr (mh-extract-from-attribution)) - (yank-region (mh-mark-active-p nil)) + (yank-region mark-active) (mh-ins-str (cond ((and yank-region (or (eq 'supercite mh-yank-behavior) @@ -834,7 +804,7 @@ body." ((< (point) (progn (beginning-of-line) (re-search-forward mh-letter-header-field-regexp - (mh-line-end-position) t) + (line-end-position) t) (point))) (beginning-of-line)) (t (end-of-line))) diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el index 39cf7c5d271..a00252284af 100644 --- a/lisp/mh-e/mh-limit.el +++ b/lisp/mh-e/mh-limit.el @@ -124,7 +124,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (setq pick-expr (let ((case-fold-search t)) (cl-loop for s in pick-expr - collect (mh-replace-regexp-in-string "re: *" "" s)))) + collect (replace-regexp-in-string "re: *" "" s)))) (mh-narrow-to-header-field 'subject pick-expr)) ;;;###mh-autoload @@ -214,7 +214,7 @@ Return number of messages put in the sequence: (string-equal "" (match-string 3))) (progn (message "No subject line") nil) - (let ((subject (mh-match-string-no-properties 3)) + (let ((subject (match-string-no-properties 3)) (list)) (if (> (length subject) mh-limit-max-subject-size) (setq subject (substring subject 0 mh-limit-max-subject-size))) @@ -222,7 +222,7 @@ Return number of messages put in the sequence: (if all (goto-char (point-min))) (while (re-search-forward mh-scan-subject-regexp nil t) - (let ((this-subject (mh-match-string-no-properties 3))) + (let ((this-subject (match-string-no-properties 3))) (if (> (length this-subject) mh-limit-max-subject-size) (setq this-subject (substring this-subject 0 mh-limit-max-subject-size))) @@ -313,7 +313,7 @@ The MH command pick is used to do the match." (while (not (eobp)) (let ((num (ignore-errors (string-to-number - (buffer-substring (point) (mh-line-end-position)))))) + (buffer-substring (point) (line-end-position)))))) (when num (push num msg-list)) (forward-line)))) (if (null msg-list) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index ad594aef906..0b58d7ba1f4 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -135,13 +135,11 @@ ("application/emacs-lisp" mm-display-elisp-inline identity) ("application/x-emacs-lisp" mm-display-elisp-inline identity) ("text/html" - ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text) + mm-inline-text-html (lambda (handle) - (or (and (boundp 'mm-inline-text-html-renderer) - mm-inline-text-html-renderer) - (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))) + mm-text-html-renderer)) ("text/x-vcard" - mh-mm-inline-text-vcard + mm-inline-text-vcard (lambda (handle) (or (featurep 'vcard) (locate-library "vcard")))) @@ -171,7 +169,7 @@ ("audio/.*" ignore ignore) ("image/.*" ignore ignore) ;; Default to displaying as text - (".*" mm-inline-text mh-mm-readable-p)) + (".*" mm-inline-text mm-readable-p)) "Alist of media types/tests saying whether types can be displayed inline.") (defvar mh-mime-save-parts-directory nil @@ -184,13 +182,7 @@ Set from last use.") '((mh-press-button "\r" "Toggle Display"))) (defvar mh-mime-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - ;; XEmacs doesn't care. - (set-keymap-parent map mh-show-mode-map)) - (mh-do-in-gnu-emacs - (define-key map [mouse-2] #'mh-push-button)) - (mh-do-in-xemacs - (define-key map '(button2) #'mh-push-button)) + (define-key map [mouse-2] #'mh-push-button) (dolist (c mh-mime-button-commands) (define-key map (cadr c) (car c))) map)) @@ -210,13 +202,8 @@ Set from last use.") (?D pressed-details ?s))) (defvar mh-mime-security-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - (set-keymap-parent map mh-show-mode-map)) (define-key map "\r" #'mh-press-button) - (mh-do-in-gnu-emacs - (define-key map [mouse-2] #'mh-push-button)) - (mh-do-in-xemacs - (define-key map '(button2) #'mh-push-button)) + (define-key map [mouse-2] #'mh-push-button) map)) @@ -251,24 +238,24 @@ usually reads the file \"/etc/mailcap\"." (when (consp part-index) (setq part-index (car part-index))) (mh-folder-mime-action part-index - #'(lambda () - (let* ((part (get-text-property (point) 'mh-data)) - (type (mm-handle-media-type part)) - (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) - (mailcap-mime-info type 'all))) - (def (caar methods)) - (prompt (format-prompt "Viewer" def)) - (method (completing-read prompt methods nil nil nil nil def)) - (folder mh-show-folder-buffer) - (buffer-read-only nil)) - (when (string-match "^[^% \t]+$" method) - (setq method (concat method " %s"))) - (mh-flet - ((mm-handle-set-external-undisplayer - (handle function) - (mh-handle-set-external-undisplayer folder handle function))) - (unwind-protect (mm-display-external part method) - (set-buffer-modified-p nil))))) + (lambda () + (let* ((part (get-text-property (point) 'mh-data)) + (type (mm-handle-media-type part)) + (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) + (mailcap-mime-info type 'all))) + (def (caar methods)) + (prompt (format-prompt "Viewer" def)) + (method (completing-read prompt methods nil nil nil nil def)) + (folder mh-show-folder-buffer) + (buffer-read-only nil)) + (when (string-match "^[^% \t]+$" method) + (setq method (concat method " %s"))) + (mh-flet + ((mm-handle-set-external-undisplayer + (handle function) + (mh-handle-set-external-undisplayer folder handle function))) + (unwind-protect (mm-display-external part method) + (set-buffer-modified-p nil))))) nil)) ;;;###mh-autoload @@ -299,14 +286,14 @@ the attachment labeled with that number." start end) (cond ((and data (not inserted-flag) (not displayed-flag)) (let ((contents (mm-get-part data))) - (add-text-properties (mh-line-beginning-position) - (mh-line-end-position) '(mh-mime-inserted t)) + (add-text-properties (line-beginning-position) + (line-end-position) '(mh-mime-inserted t)) (setq start (point-marker)) (forward-line 1) (mm-insert-inline data contents) (setq end (point-marker)) (add-text-properties - start (progn (goto-char start) (mh-line-end-position)) + start (progn (goto-char start) (line-end-position)) `(mh-region (,start . ,end))))) ((and data (or inserted-flag displayed-flag)) (mh-press-button) @@ -458,10 +445,10 @@ decoding the same message multiple times." (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data))) (let ((handles (mm-dissect-buffer nil))) (if handles - (mh-mm-uu-dissect-text-parts handles) + (mm-uu-dissect-text-parts handles) (setq handles (mm-uu-dissect))) (setf (mh-mime-handles (mh-buffer-data)) - (mh-mm-merge-handles + (mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))) handles)))) @@ -532,10 +519,10 @@ parsed and then displayed." (if pre-dissected-handles (setq handles pre-dissected-handles) (if (setq handles (mm-dissect-buffer nil)) - (mh-mm-uu-dissect-text-parts handles) + (mm-uu-dissect-text-parts handles) (setq handles (mm-uu-dissect))) (setf (mh-mime-handles (mh-buffer-data)) - (mh-mm-merge-handles handles + (mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))) (unless handles (mh-decode-message-body))) @@ -641,7 +628,7 @@ buttons for alternative parts that are usually suppressed." (let ((mh-mime-security-button-line-format mh-mime-security-button-end-line-format)) (mh-insert-mime-security-button handle)) - (mh-mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter handle 'mh-region (cons (point-min-marker) (point-max-marker))))) (defun mh-mime-display-single (handle) @@ -752,8 +739,8 @@ buttons for alternative parts that are usually suppressed." (mh-insert-mime-button handle id (mm-handle-displayed-p handle)) (goto-char point) (when region - (add-text-properties (mh-line-beginning-position) - (mh-line-end-position) + (add-text-properties (line-beginning-position) + (line-end-position) `(mh-region ,region))))))) (defun mh-mime-part-index (handle) @@ -777,20 +764,12 @@ This is only useful if a Content-Disposition header is not present." ; this only tells us if the image is ; something that emacs can display (let ((image (mm-get-image handle))) - (or (mh-do-in-xemacs - (and (mh-funcall-if-exists glyphp image) - (< (glyph-width image) - (or mh-max-inline-image-width (window-pixel-width))) - (< (glyph-height image) - (or mh-max-inline-image-height - (window-pixel-height))))) - (mh-do-in-gnu-emacs - (let ((size (and (fboundp 'image-size) (image-size image)))) - (and size - (< (cdr size) (or mh-max-inline-image-height - (1- (window-height)))) - (< (car size) (or mh-max-inline-image-width - (window-width))))))))))) + (let ((size (and (fboundp 'image-size) (image-size image)))) + (and size + (< (cdr size) (or mh-max-inline-image-height + (1- (window-height)))) + (< (car size) (or mh-max-inline-image-width + (window-width))))))))) (defun mh-inline-vcard-p (handle) "Decide if HANDLE is a vcard that must be displayed inline." @@ -813,27 +792,19 @@ being used to highlight the signature in a MIME part." ((not (and (equal (mm-handle-media-supertype handle) "text") (equal (mm-handle-media-subtype handle) "html"))) "^-- $") - ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$") + ((eq mm-text-html-renderer 'lynx) "^ --$") (t "^--$")))) (save-excursion (goto-char (point-max)) (when (re-search-backward regexp nil t) - (mh-do-in-gnu-emacs - (let ((ov (make-overlay (point) (point-max)))) - (overlay-put ov 'face 'mh-show-signature) - (overlay-put ov 'evaporate t))) - (mh-do-in-xemacs - (set-extent-property (make-extent (point) (point-max)) - 'face 'mh-show-signature)))))) + (let ((ov (make-overlay (point) (point-max)))) + (overlay-put ov 'face 'mh-show-signature) + (overlay-put ov 'evaporate t)))))) ;;; Button Display -;; Shush compiler. -(mh-do-in-xemacs - (defvar ov)) - (defun mh-insert-mime-button (handle index displayed) "Insert MIME button for HANDLE. INDEX is the part number that will be DISPLAYED. It is also used @@ -865,10 +836,10 @@ by commands like \"K v\" which operate on individual MIME parts." (setq begin (point)) (gnus-eval-format mh-mime-button-line-format mh-mime-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-button-map) - mh-callback mh-mm-display-part - mh-part ,index - mh-data ,handle))) + `(keymap ,mh-mime-button-map + mh-callback mh-mm-display-part + mh-part ,index + mh-data ,handle))) (setq end (point)) (widget-convert-button 'link begin end @@ -877,16 +848,12 @@ by commands like \"K v\" which operate on individual MIME parts." :button-keymap mh-mime-button-map :help-echo "Mouse-2 click or press RET (in show buffer) to toggle display") - (dolist (ov (mh-funcall-if-exists overlays-in begin end)) - (mh-funcall-if-exists overlay-put ov 'evaporate t)))) - -;; Shush compiler. -(defvar mm-verify-function-alist) ; < Emacs 22 -(defvar mm-decrypt-function-alist) ; < Emacs 22 + (dolist (ov (overlays-in begin end)) + (overlay-put ov 'evaporate t)))) (defun mh-insert-mime-security-button (handle) "Display buttons for PGP message, HANDLE." - (let* ((protocol (mh-mm-handle-multipart-ctl-parameter handle 'protocol)) + (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist)) (nth 2 (assoc protocol mm-decrypt-function-alist)) "Unknown")) @@ -897,10 +864,10 @@ by commands like \"K v\" which operate on individual MIME parts." (if (equal (car handle) "multipart/signed") " Signed" " Encrypted") " Part")) - (info (or (mh-mm-handle-multipart-ctl-parameter + (info (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) "Undecided")) - (details (mh-mm-handle-multipart-ctl-parameter + (details (mm-handle-multipart-ctl-parameter handle 'gnus-details)) pressed-details) (setq details (if details (concat "\n" details) "")) @@ -911,11 +878,11 @@ by commands like \"K v\" which operate on individual MIME parts." (gnus-eval-format mh-mime-security-button-line-format mh-mime-security-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-security-button-map) - mh-button-pressed ,mh-mime-security-button-pressed - mh-callback mh-mime-security-press-button - mh-line-format ,mh-mime-security-button-line-format - mh-data ,handle)) + `(keymap ,mh-mime-security-button-map + mh-button-pressed ,mh-mime-security-button-pressed + mh-callback mh-mime-security-press-button + mh-line-format ,mh-mime-security-button-line-format + mh-data ,handle)) (setq end (point)) (widget-convert-button 'link begin end :mime-handle handle @@ -923,8 +890,8 @@ by commands like \"K v\" which operate on individual MIME parts." :button-keymap mh-mime-security-button-map :button-face face :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") - (dolist (ov (mh-funcall-if-exists overlays-in begin end)) - (mh-funcall-if-exists overlay-put ov 'evaporate t)) + (dolist (ov (overlays-in begin end)) + (overlay-put ov 'evaporate t)) (when (equal info "Failed") (let* ((type (if (equal (car handle) "multipart/signed") "verification" "decryption")) @@ -1081,7 +1048,7 @@ This is only called in recent versions of Gnus. The MIME handles are stored in data structures corresponding to MH-E folder buffer FOLDER instead of in Gnus (as in the original). The MIME part, HANDLE is associated with the undisplayer FUNCTION." - (if (mh-mm-keep-viewer-alive-p handle) + (if (mm-keep-viewer-alive-p handle) (let ((new-handle (copy-sequence handle))) (mm-handle-set-undisplayer new-handle function) (mm-handle-set-undisplayer handle nil) @@ -1091,19 +1058,19 @@ HANDLE is associated with the undisplayer FUNCTION." (defun mh-mime-security-press-button (handle) "Callback from security button for part HANDLE." - (if (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info) + (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) (mh-mime-security-show-details handle) - (let ((region (mh-mm-handle-multipart-ctl-parameter handle 'mh-region)) + (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region)) point) (setq point (point)) (goto-char (car region)) (delete-region (car region) (cdr region)) - (with-current-buffer (mh-mm-handle-multipart-ctl-parameter handle 'buffer) + (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer) (let* ((mm-verify-option 'known) (mm-decrypt-option 'known) - (new (mh-mm-possibly-verify-or-decrypt (cdr handle) handle))) + (new (mm-possibly-verify-or-decrypt (cdr handle) handle))) (unless (eq new (cdr handle)) - (mh-mm-destroy-parts (cdr handle)) + (mm-destroy-parts (cdr handle)) (setcdr handle new)))) (mh-mime-display-security handle) (goto-char point)))) @@ -1113,7 +1080,7 @@ HANDLE is associated with the undisplayer FUNCTION." ;; to be no way of getting rid of the inserted text. (defun mh-mime-security-show-details (handle) "Toggle display of detailed security info for HANDLE." - (let ((details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details))) + (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) (when details (let ((mh-mime-security-button-pressed (not (get-text-property (point) 'mh-button-pressed))) @@ -1158,7 +1125,7 @@ this ;-)" (defun mh-display-smileys () "Display smileys." (when (and mh-graphical-smileys-flag (mh-small-show-buffer-p)) - (mh-funcall-if-exists smiley-region (point-min) (point-max)))) + (smiley-region (point-min) (point-max)))) ;;;###mh-autoload (defun mh-display-emphasis () @@ -1175,6 +1142,7 @@ this ;-)" This is used to decide if smileys and graphical emphasis should be displayed." (let ((max nil)) + ;; FIXME: font-lock-maximum-size is obsolete. (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size) (cond ((numberp font-lock-maximum-size) (setq max font-lock-maximum-size)) @@ -1303,7 +1271,7 @@ automatically." (type (mh-minibuffer-read-type file)) (description (mml-minibuffer-read-description)) (dispos (or disposition - (mh-mml-minibuffer-read-disposition type)))) + (mml-minibuffer-read-disposition type)))) (mml-insert-empty-tag 'part 'type type 'filename file 'disposition dispos 'description description))) @@ -1507,9 +1475,9 @@ This function will quote all such characters." (goto-char (point-min)) (while (re-search-forward "^#" nil t) (beginning-of-line) - (unless (mh-mh-directive-present-p (point) (mh-line-end-position)) + (unless (mh-mh-directive-present-p (point) (line-end-position)) (insert "#")) - (goto-char (mh-line-end-position))))) + (goto-char (line-end-position))))) ;;;###mh-autoload (defun mh-mh-to-mime-undo (noconfirm) @@ -1695,7 +1663,7 @@ buffer, while END defaults to the end of the buffer." (goto-char begin) (while (re-search-forward "^#" end t) (let ((s (buffer-substring-no-properties - (point) (mh-line-end-position)))) + (point) (line-end-position)))) (cond ((equal s "")) ((string-match "^forw[ \t\n]+" s) (cl-return-from search-for-mh-directive t)) @@ -1799,8 +1767,7 @@ initialized. Always use the command `mh-have-file-command'.") 'file -i' is used to get MIME type of composition insertion." (when (eq mh-have-file-command 'undefined) (setq mh-have-file-command - (and (fboundp 'executable-find) - (executable-find "file") ; file command exists + (and (executable-find "file") ; file command exists ; and accepts -i and -b args. (zerop (call-process "file" nil nil nil "-i" "-b" (expand-file-name "inc" mh-progs)))))) @@ -1814,10 +1781,9 @@ initialized. Always use the command `mh-have-file-command'.") (defun mh-mime-cleanup () "Free the decoded MIME parts." (let ((mime-data (gethash (current-buffer) mh-globals-hash))) - ;; This is for Emacs, what about XEmacs? - (mh-funcall-if-exists remove-images (point-min) (point-max)) + (remove-images (point-min) (point-max)) (when mime-data - (mh-mm-destroy-parts (mh-mime-handles mime-data)) + (mm-destroy-parts (mh-mime-handles mime-data)) (remhash (current-buffer) mh-globals-hash)))) ;;;###mh-autoload @@ -1825,7 +1791,7 @@ initialized. Always use the command `mh-have-file-command'.") "Free MIME data for externally displayed MIME parts." (let ((mime-data (mh-buffer-data))) (when mime-data - (mh-mm-destroy-parts (mh-mime-handles mime-data))) + (mm-destroy-parts (mh-mime-handles mime-data))) (remhash (current-buffer) mh-globals-hash))) (provide 'mh-mime) diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 5aa599942e3..5a1a671aee2 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -315,7 +315,7 @@ produced by \"inc\".") ;;; Widths, Offsets and Columns -(defvar mh-cmd-note 4 +(defvar-local mh-cmd-note 4 "Column for notations. This variable should be set with the function `mh-set-cmd-note'. @@ -323,7 +323,6 @@ This variable may be updated dynamically if `mh-adaptive-cmd-note-flag' is on. Note that columns in Emacs start with 0.") -(make-variable-buffer-local 'mh-cmd-note) (defvar mh-scan-cmd-note-width 1 "Number of columns consumed by the cmd-note field in `mh-scan-format'. diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index e03c9dc83f7..ef84c5eb283 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -42,6 +42,7 @@ ;;; Code: (require 'mh-e) +(require 'mh-letter) (require 'gnus-util) (require 'imenu) @@ -318,10 +319,6 @@ folder containing the index search results." (cl-loop for msg-hash being the hash-values of mh-index-data count (> (hash-table-count msg-hash) 0))))))) -;; Shush compiler. -(mh-do-in-xemacs - (defvar pick-folder)) ;FIXME: Why? - (defun mh-search-folder (folder window-config) "Search FOLDER for messages matching a pattern. @@ -336,8 +333,8 @@ configuration and is used when the search folder is dismissed." (not (y-or-n-p "Reuse pattern? "))) (mh-make-pick-template) (message "")) - (mh-make-local-vars 'mh-current-folder folder - 'mh-previous-window-config window-config) + (setq-local mh-current-folder folder + mh-previous-window-config window-config) (message "%s" (substitute-command-keys (concat "Type \\[mh-index-do-search] to search messages, " "\\[mh-pick-do-search] to use pick, " @@ -356,13 +353,13 @@ configuration and is used when the search folder is dismissed." (goto-char (point-min)) (dotimes (_ 5) (add-text-properties (point) (1+ (point)) '(front-sticky t)) - (add-text-properties (- (mh-line-end-position) 2) - (1- (mh-line-end-position)) + (add-text-properties (- (line-end-position) 2) + (1- (line-end-position)) '(rear-nonsticky t)) - (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t)) + (add-text-properties (point) (1- (line-end-position)) '(read-only t)) (forward-line)) (add-text-properties (point) (1+ (point)) '(front-sticky t)) - (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t)) + (add-text-properties (point) (1- (line-end-position)) '(read-only t)) (goto-char (point-max))) ;; Sequence Searches @@ -522,10 +519,10 @@ group of results." (cond ((and (bolp) (eolp)) (ignore-errors (forward-line -1)) (setq msg (mh-get-msg-num t))) - ((equal (char-after (mh-line-beginning-position)) ?+) + ((equal (char-after (line-beginning-position)) ?+) (setq folder (buffer-substring-no-properties - (mh-line-beginning-position) - (mh-line-end-position)))) + (line-beginning-position) + (line-end-position)))) (t (setq msg (mh-get-msg-num t))))) (when (not folder) (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) @@ -552,20 +549,20 @@ group of results." ;;; MH-Search Keys ;; If this changes, modify mh-search-mode-help-messages accordingly, below. -(gnus-define-keys mh-search-mode-map - "\C-c?" mh-help - "\C-c\C-c" mh-index-do-search - "\C-c\C-p" mh-pick-do-search - "\C-c\C-f\C-b" mh-to-field - "\C-c\C-f\C-c" mh-to-field - "\C-c\C-f\C-m" mh-to-field - "\C-c\C-f\C-s" mh-to-field - "\C-c\C-f\C-t" mh-to-field - "\C-c\C-fb" mh-to-field - "\C-c\C-fc" mh-to-field - "\C-c\C-fm" mh-to-field - "\C-c\C-fs" mh-to-field - "\C-c\C-ft" mh-to-field) +(define-keymap :keymap mh-search-mode-map + "\C-c?" #'mh-help + "\C-c\C-c" #'mh-index-do-search + "\C-c\C-p" #'mh-pick-do-search + "\C-c\C-f\C-b" #'mh-to-field + "\C-c\C-f\C-c" #'mh-to-field + "\C-c\C-f\C-m" #'mh-to-field + "\C-c\C-f\C-s" #'mh-to-field + "\C-c\C-f\C-t" #'mh-to-field + "\C-c\C-fb" #'mh-to-field + "\C-c\C-fc" #'mh-to-field + "\C-c\C-fm" #'mh-to-field + "\C-c\C-fs" #'mh-to-field + "\C-c\C-ft" #'mh-to-field) @@ -616,7 +613,6 @@ The hook `mh-search-mode-hook' is called upon entry to this mode. \\{mh-search-mode-map}" - (mh-do-in-xemacs (easy-menu-add mh-pick-menu)) (mh-set-help mh-search-mode-help-messages)) @@ -653,13 +649,13 @@ The cdr of the element is the pattern to search." start begin) (goto-char (point-min)) (while (not (eobp)) - (if (search-forward "--------" (mh-line-end-position) t) + (if (search-forward "--------" (line-end-position) t) (setq in-body-flag t) (beginning-of-line) (setq begin (point)) (setq start (if in-body-flag (point) - (search-forward ":" (mh-line-end-position) t) + (search-forward ":" (line-end-position) t) (point))) (push (cons (and (not in-body-flag) (intern (downcase @@ -667,7 +663,7 @@ The cdr of the element is the pattern to search." begin (1- start))))) (mh-index-parse-search-regexp (buffer-substring-no-properties - start (mh-line-end-position)))) + start (line-end-position)))) pattern-list)) (forward-line)) pattern-list))) @@ -977,8 +973,8 @@ is used to search." (cl-return nil)) (when (equal (char-after (point)) ?#) (cl-return 'error)) - (let* ((start (search-forward " " (mh-line-end-position) t)) - (end (search-forward " " (mh-line-end-position) t))) + (let* ((start (search-forward " " (line-end-position) t)) + (end (search-forward " " (line-end-position) t))) (unless (and start end) (cl-return 'error)) (setq end (1- end)) @@ -1056,7 +1052,7 @@ SEARCH-REGEXP-LIST is used to search." (cl-return 'error)) (let ((start (point)) end msg-start) - (setq end (mh-line-end-position)) + (setq end (line-end-position)) (unless (search-forward mh-mairix-folder end t) (cl-return 'error)) (goto-char (match-beginning 0)) @@ -1197,7 +1193,7 @@ is used to search." (cl-block nil (when (eobp) (cl-return nil)) (let ((file-name (buffer-substring-no-properties - (point) (mh-line-end-position)))) + (point) (line-end-position)))) (unless (equal (string-match mh-namazu-folder file-name) 0) (cl-return 'error)) (unless (file-exists-p file-name) @@ -1245,17 +1241,17 @@ is used to search." (prog1 (cl-block nil (when (eobp) (cl-return nil)) - (when (search-forward-regexp "^\\+" (mh-line-end-position) t) + (when (search-forward-regexp "^\\+" (line-end-position) t) (setq mh-index-pick-folder - (buffer-substring-no-properties (mh-line-beginning-position) - (mh-line-end-position))) + (buffer-substring-no-properties (line-beginning-position) + (line-end-position))) (cl-return 'error)) - (unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position) t) + (unless (search-forward-regexp "^[1-9][0-9]*$" (line-end-position) t) (cl-return 'error)) (list mh-index-pick-folder (string-to-number - (buffer-substring-no-properties (mh-line-beginning-position) - (mh-line-end-position))) + (buffer-substring-no-properties (line-beginning-position) + (line-end-position))) nil)) (forward-line))) @@ -1332,8 +1328,8 @@ record is invalid return `error'." (cl-block nil (when (eobp) (cl-return nil)) - (let ((eol-pos (mh-line-end-position)) - (bol-pos (mh-line-beginning-position)) + (let ((eol-pos (line-end-position)) + (bol-pos (line-beginning-position)) folder-start msg-end) (goto-char bol-pos) (unless (search-forward mh-user-path eol-pos t) @@ -1415,10 +1411,7 @@ being the list of messages originally from that folder." (when cur-msg (mh-goto-msg cur-msg t t)) (set-buffer-modified-p old-buffer-modified-flag))) -(eval-and-compile (mh-require 'which-func nil t)) - -;; Shush compiler. -(defvar which-func-mode) ; < Emacs 22, XEmacs +(eval-and-compile (require 'which-func nil t)) ;;;###mh-autoload (defun mh-index-create-imenu-index () @@ -1432,7 +1425,7 @@ being the list of messages originally from that folder." (save-excursion (beginning-of-line) (push (cons (buffer-substring-no-properties - (point) (mh-line-end-position)) + (point) (line-end-position)) (point-marker)) alist))) (setq imenu--index-alist (nreverse alist))))) @@ -1717,7 +1710,7 @@ folder, is removed from `mh-index-data'." "-format" "%{x-mhe-checksum}\n" folder msg) (goto-char (point-min)) (string-equal (buffer-substring-no-properties - (point) (mh-line-end-position)) + (point) (line-end-position)) checksum))) @@ -1826,8 +1819,8 @@ PROC is used to convert the value to actual data." (defun mh-md5sum-parser () "Parse md5sum output." - (let ((begin (mh-line-beginning-position)) - (end (mh-line-end-position)) + (let ((begin (line-beginning-position)) + (end (line-end-position)) first-space last-slash) (setq first-space (search-forward " " end t)) (goto-char end) @@ -1840,8 +1833,8 @@ PROC is used to convert the value to actual data." (defun mh-openssl-parser () "Parse openssl output." - (let ((begin (mh-line-beginning-position)) - (end (mh-line-end-position)) + (let ((begin (line-beginning-position)) + (end (line-end-position)) last-space last-slash) (goto-char end) (setq last-space (search-backward " " begin t)) @@ -1874,7 +1867,7 @@ origin-index) map is updated too." (let (msg checksum) (while (not (eobp)) (setq msg (buffer-substring-no-properties - (point) (mh-line-end-position))) + (point) (line-end-position))) (forward-line) (save-excursion (cond ((not (string-match "^[0-9]*$" msg))) @@ -1885,7 +1878,7 @@ origin-index) map is updated too." (t ;; update maps (setq checksum (buffer-substring-no-properties - (point) (mh-line-end-position))) + (point) (line-end-position))) (let ((msg (string-to-number msg))) (set-buffer folder) (mh-index-update-single-msg msg checksum origin-map))))) diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index a50319a455d..077e289c01d 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -38,9 +38,8 @@ (defvar mh-last-seq-used nil "Name of seq to which a msg was last added.") -(defvar mh-non-seq-mode-line-annotation nil +(defvar-local mh-non-seq-mode-line-annotation nil "Saved value of `mh-mode-line-annotation' when narrowed to a seq.") -(make-variable-buffer-local 'mh-non-seq-mode-line-annotation) (defvar mh-internal-seqs '(answered cur deleted forwarded printed)) @@ -167,7 +166,7 @@ The list appears in a buffer named \"*MH-E Sequences*\"." (insert "\n")) (setq seq-list (cdr seq-list))) (goto-char (point-min)) - (mh-view-mode-enter) + (view-mode-enter) (setq view-exit-action 'kill-buffer) (message "Listing sequences...done"))))) @@ -193,11 +192,6 @@ MESSAGE appears." (mh-list-to-string (mh-seq-containing-msg message t)) " ")))) -;; Shush compiler. -(mh-do-in-xemacs - (defvar tool-bar-mode)) -(defvar tool-bar-map) - ;;;###mh-autoload (defun mh-narrow-to-seq (sequence) "Restrict display to messages in SEQUENCE. @@ -229,12 +223,12 @@ When you want to widen the view to all your messages again, use (mh-make-folder-mode-line) (mh-recenter nil) (when (and (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) - mh-folder-seq-tool-bar-map) + (setq-local tool-bar-map + mh-folder-seq-tool-bar-map) (when (buffer-live-p (get-buffer mh-show-buffer)) (with-current-buffer mh-show-buffer - (set (make-local-variable 'tool-bar-map) - mh-show-seq-tool-bar-map)))) + (setq-local tool-bar-map + mh-show-seq-tool-bar-map)))) (push 'widen mh-view-ops))) (t (error "No messages in sequence %s" (symbol-name sequence)))))) @@ -362,10 +356,10 @@ remove all limits and sequence restrictions." (mh-notate-cur) (mh-recenter nil))) (when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map) + (setq-local tool-bar-map mh-folder-tool-bar-map) (when (buffer-live-p (get-buffer mh-show-buffer)) (with-current-buffer mh-show-buffer - (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))))) + (setq-local tool-bar-map mh-show-tool-bar-map))))) @@ -582,7 +576,7 @@ Otherwise, the message number at point is returned. This function is usually used with `mh-iterate-on-range' in order to provide a uniform interface to MH-E functions." - (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) + (cond ((and transient-mark-mode mark-active) (cons (region-beginning) (region-end))) (current-prefix-arg (mh-read-range range-prompt nil nil t t)) (default default) (t (mh-get-msg-num t)))) @@ -736,7 +730,7 @@ completion is over." (cl-multiple-value-bind (folder unseen total) (cl-values-list (mh-parse-flist-output-line - (buffer-substring (point) (mh-line-end-position)))) + (buffer-substring (point) (line-end-position)))) (list total unseen folder)))) (defun mh-folder-size-folder (folder) @@ -764,7 +758,7 @@ folders whose names end with a `+' character." (when (search-backward " out of " (point-min) t) (setq total (string-to-number (buffer-substring-no-properties - (match-end 0) (mh-line-end-position)))) + (match-end 0) (line-end-position)))) (when (search-backward " in sequence " (point-min) t) (setq p (point)) (when (search-backward " has " (point-min) t) @@ -786,10 +780,10 @@ If SAVE-REFILES is non-nil, then keep the sequences that note messages to be refiled." (let ((seqs ())) (cond (save-refiles - (mh-mapc (lambda (seq) ; Save the refiling sequences - (if (mh-folder-name-p (mh-seq-name seq)) - (setq seqs (cons seq seqs)))) - mh-seq-list))) + (mapc (lambda (seq) ; Save the refiling sequences + (if (mh-folder-name-p (mh-seq-name seq)) + (setq seqs (cons seq seqs)))) + mh-seq-list))) (save-excursion (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) (progn @@ -942,7 +936,7 @@ font-lock is turned on." ;; the case of user sequences. (mh-notate nil nil mh-cmd-note) (when font-lock-mode - (font-lock-fontify-region (point) (mh-line-end-position)))) + (font-lock-fontify-region (point) (line-end-position)))) (forward-char (+ mh-cmd-note mh-scan-field-destination-offset)) (let ((stack (gethash msg mh-sequence-notation-history))) (setf (gethash msg mh-sequence-notation-history) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 803f07e02b2..524179648dc 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -144,7 +144,7 @@ displayed." (if (not clean-message-header) (mh-start-of-uncleaned-message))) (mh-display-msg msg folder))) - (unless (mh-window-full-height-p) ; not vertically split + (unless (window-full-height-p) ; not vertically split (shrink-window (- (window-height) (or mh-summary-height (mh-summary-height))))) (mh-recenter nil) @@ -328,17 +328,15 @@ ignored if VISIBLE-HEADERS is non-nil." (defun mh-summary-height () "Return ideal value for the variable `mh-summary-height'. The current frame height is taken into consideration." - (or (and (fboundp 'frame-height) - (> (frame-height) 24) + (or (and (> (frame-height) 24) (min 10 (/ (frame-height) 6))) 4)) -;; Infrastructure to generate show-buffer functions from folder functions -;; XEmacs does not have deactivate-mark? What is the equivalent of -;; transient-mark-mode for XEmacs? Should we be restoring the mark in the -;; folder buffer after the operation has been carried out. +;; Infrastructure to generate show-buffer functions from folder functions. +;; Should we be restoring the mark in the folder buffer after the +;; operation has been carried out? (defmacro mh-defun-show-buffer (function original-function &optional dont-return) "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer. @@ -363,11 +361,11 @@ still visible.\n") folder-buffer) (delete-other-windows)) (mh-goto-cur-msg t) - (mh-funcall-if-exists deactivate-mark) + (deactivate-mark) (unwind-protect (prog1 (call-interactively (function ,original-function)) (setq normal-exit t)) - (mh-funcall-if-exists deactivate-mark) + (deactivate-mark) (when (eq major-mode 'mh-folder-mode) (mh-funcall-if-exists hl-line-highlight)) (cond ((not normal-exit) @@ -464,8 +462,7 @@ still visible.\n") (mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick) (mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick) (mh-defun-show-buffer mh-show-junk-allowlist mh-junk-allowlist) -(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-allowlist) -(make-obsolete 'mh-show-junk-whitelist 'mh-show-junk-allowlist "28.1") +(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) (mh-defun-show-buffer mh-show-junk-blocklist mh-junk-blocklist) (mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) (mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) @@ -562,132 +559,132 @@ still visible.\n") ;;; MH-Show Keys -(gnus-define-keys mh-show-mode-map - " " mh-show-page-msg - "!" mh-show-refile-or-write-again - "'" mh-show-toggle-tick - "," mh-show-header-display - "." mh-show-show - ":" mh-show-show-preferred-alternative - ">" mh-show-write-message-to-file - "?" mh-help - "E" mh-show-extract-rejected-mail - "M" mh-show-modify - "\177" mh-show-previous-page - "\C-d" mh-show-delete-msg-no-motion - "\t" mh-show-next-button - [backtab] mh-show-prev-button - "\M-\t" mh-show-prev-button - "\ed" mh-show-redistribute - "^" mh-show-refile-msg - "c" mh-show-copy-msg - "d" mh-show-delete-msg - "e" mh-show-edit-again - "f" mh-show-forward - "g" mh-show-goto-msg - "i" mh-show-inc-folder - "k" mh-show-delete-subject-or-thread - "m" mh-show-send - "n" mh-show-next-undeleted-msg - "\M-n" mh-show-next-unread-msg - "o" mh-show-refile-msg - "p" mh-show-previous-undeleted-msg - "\M-p" mh-show-previous-unread-msg - "q" mh-show-quit - "r" mh-show-reply - "s" mh-show-send - "t" mh-show-toggle-showing - "u" mh-show-undo - "x" mh-show-execute-commands - "v" mh-show-index-visit-folder - "|" mh-show-pipe-msg) - -(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) - "?" mh-prefix-help - "'" mh-index-ticked-messages - "S" mh-show-sort-folder - "c" mh-show-catchup - "f" mh-show-visit-folder - "k" mh-show-kill-folder - "l" mh-show-list-folders - "n" mh-index-new-messages - "o" mh-show-visit-folder - "p" mh-show-pack-folder - "q" mh-show-index-sequenced-messages - "r" mh-show-rescan-folder - "s" mh-search - "t" mh-show-toggle-threads - "u" mh-show-undo-folder - "v" mh-show-visit-folder) - -(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map) - "'" mh-show-narrow-to-tick - "?" mh-prefix-help - "d" mh-show-delete-msg-from-seq - "k" mh-show-delete-seq - "l" mh-show-list-sequences - "n" mh-show-narrow-to-seq - "p" mh-show-put-msg-in-seq - "s" mh-show-msg-is-in-seq - "w" mh-show-widen) - -(define-key mh-show-mode-map "I" mh-inc-spool-map) - -(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map) - "?" mh-prefix-help - "a" mh-show-junk-allowlist - "b" mh-show-junk-blocklist - "w" mh-show-junk-whitelist) - -(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map) - "?" mh-prefix-help - "C" mh-show-ps-print-toggle-color - "F" mh-show-ps-print-toggle-faces - "f" mh-show-ps-print-msg-file - "l" mh-show-print-msg - "p" mh-show-ps-print-msg) - -(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) - "?" mh-prefix-help - "u" mh-show-thread-ancestor - "p" mh-show-thread-previous-sibling - "n" mh-show-thread-next-sibling - "t" mh-show-toggle-threads - "d" mh-show-thread-delete - "o" mh-show-thread-refile) - -(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) - "'" mh-show-narrow-to-tick - "?" mh-prefix-help - "c" mh-show-narrow-to-cc - "g" mh-show-narrow-to-range - "m" mh-show-narrow-to-from - "s" mh-show-narrow-to-subject - "t" mh-show-narrow-to-to - "w" mh-show-widen) - -(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map) - "?" mh-prefix-help - "s" mh-show-store-msg - "u" mh-show-store-msg) - -(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map) - "?" mh-prefix-help - " " mh-show-page-digest - "\177" mh-show-page-digest-backwards - "b" mh-show-burst-digest) - -(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) - "?" mh-prefix-help - "a" mh-mime-save-parts - "e" mh-show-display-with-external-viewer - "v" mh-show-toggle-mime-part - "o" mh-show-save-mime-part - "i" mh-show-inline-mime-part - "t" mh-show-toggle-mime-buttons - "\t" mh-show-next-button - [backtab] mh-show-prev-button - "\M-\t" mh-show-prev-button) +(define-keymap :keymap mh-show-mode-map + " " #'mh-show-page-msg + "!" #'mh-show-refile-or-write-again + "'" #'mh-show-toggle-tick + "," #'mh-show-header-display + "." #'mh-show-show + ":" #'mh-show-show-preferred-alternative + ">" #'mh-show-write-message-to-file + "?" #'mh-help + "E" #'mh-show-extract-rejected-mail + "M" #'mh-show-modify + "\177" #'mh-show-previous-page + "\C-d" #'mh-show-delete-msg-no-motion + "\t" #'mh-show-next-button + [backtab] #'mh-show-prev-button + "\M-\t" #'mh-show-prev-button + "\ed" #'mh-show-redistribute + "^" #'mh-show-refile-msg + "c" #'mh-show-copy-msg + "d" #'mh-show-delete-msg + "e" #'mh-show-edit-again + "f" #'mh-show-forward + "g" #'mh-show-goto-msg + "i" #'mh-show-inc-folder + "k" #'mh-show-delete-subject-or-thread + "m" #'mh-show-send + "n" #'mh-show-next-undeleted-msg + "\M-n" #'mh-show-next-unread-msg + "o" #'mh-show-refile-msg + "p" #'mh-show-previous-undeleted-msg + "\M-p" #'mh-show-previous-unread-msg + "q" #'mh-show-quit + "r" #'mh-show-reply + "s" #'mh-show-send + "t" #'mh-show-toggle-showing + "u" #'mh-show-undo + "x" #'mh-show-execute-commands + "v" #'mh-show-index-visit-folder + "|" #'mh-show-pipe-msg + + "F" (define-keymap :prefix 'mh-show-folder-map + "?" #'mh-prefix-help + "'" #'mh-index-ticked-messages + "S" #'mh-show-sort-folder + "c" #'mh-show-catchup + "f" #'mh-show-visit-folder + "k" #'mh-show-kill-folder + "l" #'mh-show-list-folders + "n" #'mh-index-new-messages + "o" #'mh-show-visit-folder + "p" #'mh-show-pack-folder + "q" #'mh-show-index-sequenced-messages + "r" #'mh-show-rescan-folder + "s" #'mh-search + "t" #'mh-show-toggle-threads + "u" #'mh-show-undo-folder + "v" #'mh-show-visit-folder) + + "S" (define-keymap :prefix 'mh-show-sequence-map + "'" #'mh-show-narrow-to-tick + "?" #'mh-prefix-help + "d" #'mh-show-delete-msg-from-seq + "k" #'mh-show-delete-seq + "l" #'mh-show-list-sequences + "n" #'mh-show-narrow-to-seq + "p" #'mh-show-put-msg-in-seq + "s" #'mh-show-msg-is-in-seq + "w" #'mh-show-widen) + + "I" mh-inc-spool-map + + "J" (define-keymap :prefix 'mh-show-junk-map + "?" #'mh-prefix-help + "a" #'mh-show-junk-allowlist + "b" #'mh-show-junk-blocklist + "w" #'mh-show-junk-whitelist) + + "P" (define-keymap :prefix 'mh-show-ps-print-map + "?" #'mh-prefix-help + "C" #'mh-show-ps-print-toggle-color + "F" #'mh-show-ps-print-toggle-faces + "f" #'mh-show-ps-print-msg-file + "l" #'mh-show-print-msg + "p" #'mh-show-ps-print-msg) + + "T" (define-keymap :prefix 'mh-show-thread-map + "?" #'mh-prefix-help + "u" #'mh-show-thread-ancestor + "p" #'mh-show-thread-previous-sibling + "n" #'mh-show-thread-next-sibling + "t" #'mh-show-toggle-threads + "d" #'mh-show-thread-delete + "o" #'mh-show-thread-refile) + + "/" (define-keymap :prefix 'mh-show-limit-map + "'" #'mh-show-narrow-to-tick + "?" #'mh-prefix-help + "c" #'mh-show-narrow-to-cc + "g" #'mh-show-narrow-to-range + "m" #'mh-show-narrow-to-from + "s" #'mh-show-narrow-to-subject + "t" #'mh-show-narrow-to-to + "w" #'mh-show-widen) + + "X" (define-keymap :prefix 'mh-show-extract-map + "?" #'mh-prefix-help + "s" #'mh-show-store-msg + "u" #'mh-show-store-msg) + + "D" (define-keymap :prefix 'mh-show-digest-map + "?" #'mh-prefix-help + " " #'mh-show-page-digest + "\177" #'mh-show-page-digest-backwards + "b" #'mh-show-burst-digest) + + "K" (define-keymap :prefix 'mh-show-mime-map + "?" #'mh-prefix-help + "a" #'mh-mime-save-parts + "e" #'mh-show-display-with-external-viewer + "v" #'mh-show-toggle-mime-part + "o" #'mh-show-save-mime-part + "i" #'mh-show-inline-mime-part + "t" #'mh-show-toggle-mime-buttons + "\t" #'mh-show-next-button + [backtab] #'mh-show-prev-button + "\M-\t" #'mh-show-prev-button)) @@ -817,9 +814,6 @@ operation." ;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-show-mode 'mode-class 'special) -;; Shush compiler. -(defvar font-lock-auto-fontify) - ;;;###mh-autoload (define-derived-mode mh-show-mode text-mode "MH-Show" "Major mode for showing messages in MH-E.\\<mh-show-mode-map> @@ -836,17 +830,14 @@ The hook `mh-show-mode-hook' is called upon entry to this mode. See also `mh-folder-mode'. \\{mh-show-mode-map}" - (mh-do-in-gnu-emacs - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))) - (mh-do-in-xemacs - (mh-tool-bar-init :show)) - (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) + (if (boundp 'tool-bar-map) + (setq-local tool-bar-map mh-show-tool-bar-map)) + (setq-local mail-header-separator mh-mail-header-separator) (setq paragraph-start (default-value 'paragraph-start)) (setq buffer-invisibility-spec '((vanish . t) t)) - (set (make-local-variable 'line-move-ignore-invisible) t) + (setq-local line-move-ignore-invisible t) (make-local-variable 'font-lock-defaults) - ;;(set (make-local-variable 'font-lock-support-mode) nil) + ;;(setq-local font-lock-support-mode nil) (cond ((equal mh-highlight-citation-style 'font-lock) (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) @@ -858,16 +849,8 @@ See also `mh-folder-mode'. (mh-gnus-article-highlight-citation)) (t (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) - (if (and (featurep 'xemacs) - font-lock-auto-fontify) - (turn-on-font-lock)) (when mh-decode-mime-flag - (mh-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook #'mh-mime-cleanup nil t)) - (mh-do-in-xemacs - (easy-menu-add mh-show-sequence-menu) - (easy-menu-add mh-show-message-menu) - (easy-menu-add mh-show-folder-menu)) (make-local-variable 'mh-show-folder-buffer) (buffer-disable-undo) (use-local-map mh-show-mode-map)) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 76ef990d825..82b108c8c8d 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -63,13 +63,13 @@ '("--" ["Visit Folder" mh-speed-view (with-current-buffer speedbar-buffer - (get-text-property (mh-line-beginning-position) 'mh-folder))] + (get-text-property (line-beginning-position) 'mh-folder))] ["Expand Nested Folders" mh-speed-expand-folder - (and (get-text-property (mh-line-beginning-position) 'mh-children-p) - (not (get-text-property (mh-line-beginning-position) 'mh-expanded)))] + (and (get-text-property (line-beginning-position) 'mh-children-p) + (not (get-text-property (line-beginning-position) 'mh-expanded)))] ["Contract Nested Folders" mh-speed-contract-folder - (and (get-text-property (mh-line-beginning-position) 'mh-children-p) - (get-text-property (mh-line-beginning-position) 'mh-expanded))] + (and (get-text-property (line-beginning-position) 'mh-children-p) + (get-text-property (line-beginning-position) 'mh-expanded))] ["Refresh Speedbar" mh-speed-refresh t]) "Extra menu items for speedbar.") @@ -83,11 +83,11 @@ (defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap) "Specialized speedbar keymap for MH-E buffers.") -(gnus-define-keys mh-folder-speedbar-key-map - "+" mh-speed-expand-folder - "-" mh-speed-contract-folder - "\r" mh-speed-view - "r" mh-speed-refresh) +(define-keymap :keymap mh-folder-speedbar-key-map + "+" #'mh-speed-expand-folder + "-" #'mh-speed-contract-folder + "\r" #'mh-speed-view + "r" #'mh-speed-refresh) (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) @@ -150,7 +150,7 @@ The optional arguments from speedbar are IGNORED." (forward-line -1) (speedbar-change-expand-button-char ?+) (add-text-properties - (mh-line-beginning-position) (1+ (line-beginning-position)) + (line-beginning-position) (1+ (line-beginning-position)) '(mh-expanded nil))) (t (forward-line) @@ -158,14 +158,14 @@ The optional arguments from speedbar are IGNORED." (goto-char point) (speedbar-change-expand-button-char ?-) (add-text-properties - (mh-line-beginning-position) (1+ (line-beginning-position)) + (line-beginning-position) (1+ (line-beginning-position)) '(mh-expanded t))))))) (defun mh-speed-view (&rest _ignored) "Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder]. The optional arguments from speedbar are IGNORED." (interactive) - (let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder)) + (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) (range (and (stringp folder) (mh-read-range "Scan" folder t nil nil mh-interpret-number-as-range-flag)))) @@ -191,9 +191,9 @@ created." (forward-line -1) (setf (gethash nil mh-speed-folder-map) (set-marker (or (gethash nil mh-speed-folder-map) (make-marker)) - (1+ (mh-line-beginning-position)))) + (1+ (line-beginning-position)))) (add-text-properties - (mh-line-beginning-position) (1+ (line-beginning-position)) + (line-beginning-position) (1+ (line-beginning-position)) '(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) (mh-speed-stealth-update t) (when (> mh-speed-update-interval 0) @@ -260,12 +260,12 @@ The update is always carried out if FORCE is non-nil." (speedbar-with-writable (goto-char (gethash folder mh-speed-folder-map (point))) (beginning-of-line) - (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (mh-line-end-position) t) + (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t) (setq face (mh-speed-bold-face face)) (setq face (mh-speed-normal-face face))) (beginning-of-line) - (when (re-search-forward "\\[.\\] " (mh-line-end-position) t) - (put-text-property (point) (mh-line-end-position) 'face face))))) + (when (re-search-forward "\\[.\\] " (line-end-position) t) + (put-text-property (point) (line-end-position) 'face face))))) (defun mh-speed-normal-face (face) "Return normal face for given FACE." @@ -305,7 +305,7 @@ The function will expand out parent folders of FOLDER if needed." (while suffix-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) + (when (equal prefix (get-text-property (line-beginning-position) 'mh-folder)) (mh-speed-toggle) (unless (get-text-property (point) 'mh-expanded) @@ -359,9 +359,9 @@ uses." (setf (gethash folder-name mh-speed-folder-map) (set-marker (or (gethash folder-name mh-speed-folder-map) (make-marker)) - (1+ (mh-line-beginning-position)))) + (1+ (line-beginning-position)))) (add-text-properties - (mh-line-beginning-position) (1+ (mh-line-beginning-position)) + (line-beginning-position) (1+ (line-beginning-position)) `(mh-folder ,folder-name mh-expanded nil mh-children-p ,(not (not (cdr f))) @@ -374,12 +374,9 @@ uses." (defvar mh-speed-flists-folder nil) (defmacro mh-process-kill-without-query (process) - "PROCESS can be killed without query on Emacs exit. -Avoid using `process-kill-without-query' if possible since it is -now obsolete." - (if (fboundp 'set-process-query-on-exit-flag) - `(set-process-query-on-exit-flag ,process nil) - `(process-kill-without-query ,process))) + "PROCESS can be killed without query on Emacs exit." + (declare (obsolete set-process-query-on-exit-flag "29.1")) + `(set-process-query-on-exit-flag ,process nil)) ;;;###mh-autoload (defun mh-speed-flists (force &rest folders) @@ -391,7 +388,7 @@ flists is run only for that one folder." (interactive (list t)) (when force (when mh-speed-flists-timer - (mh-cancel-timer mh-speed-flists-timer) + (cancel-timer mh-speed-flists-timer) (setq mh-speed-flists-timer nil)) (when (and (processp mh-speed-flists-process) (not (eq (process-status mh-speed-flists-process) 'exit))) @@ -427,7 +424,7 @@ flists is run only for that one folder." (or mh-speed-flists-folder '("-recurse")))) ;; Run flists on all folders the next time around... (setq mh-speed-flists-folder nil) - (mh-process-kill-without-query mh-speed-flists-process) + (set-process-query-on-exit-flag mh-speed-flists-process nil) (set-process-filter mh-speed-flists-process #'mh-speed-parse-flists-output))))))) @@ -462,25 +459,25 @@ be handled next." face) (when pos (goto-char pos) - (goto-char (mh-line-beginning-position)) + (goto-char (line-beginning-position)) (cond ((null (get-text-property (point) 'mh-count)) - (goto-char (mh-line-end-position)) + (goto-char (line-end-position)) (setq face (get-text-property (1- (point)) 'face)) (insert (format " (%s/%s)" unseen total)) (mh-speed-highlight 'unknown face) - (goto-char (mh-line-beginning-position)) + (goto-char (line-beginning-position)) (add-text-properties (point) (1+ (point)) `(mh-count (,unseen . ,total)))) ((not (equal (get-text-property (point) 'mh-count) (cons unseen total))) - (goto-char (mh-line-end-position)) + (goto-char (line-end-position)) (setq face (get-text-property (1- (point)) 'face)) - (re-search-backward " " (mh-line-beginning-position) t) - (delete-region (point) (mh-line-end-position)) + (re-search-backward " " (line-beginning-position) t) + (delete-region (point) (line-end-position)) (insert (format " (%s/%s)" unseen total)) (mh-speed-highlight 'unknown face) - (goto-char (mh-line-beginning-position)) + (goto-char (line-beginning-position)) (add-text-properties (point) (1+ (point)) `(mh-count (,unseen . ,total)))))))))))) @@ -509,15 +506,15 @@ be handled next." (caar parent-kids))) (setq parent-change ? )))) (goto-char parent-position) - (when (equal (get-text-property (mh-line-beginning-position) 'mh-folder) + (when (equal (get-text-property (line-beginning-position) 'mh-folder) parent) - (when (get-text-property (mh-line-beginning-position) 'mh-expanded) + (when (get-text-property (line-beginning-position) 'mh-expanded) (mh-speed-toggle)) (when parent-change (speedbar-with-writable (mh-speedbar-change-expand-button-char parent-change) (add-text-properties - (mh-line-beginning-position) (1+ (mh-line-beginning-position)) + (line-beginning-position) (1+ (line-beginning-position)) `(mh-children-p ,(equal parent-change ?+))))) (mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder) (setq mh-speed-last-selected-folder nil) @@ -531,7 +528,7 @@ be handled next." "Change the expansion button character to CHAR for the current line." (save-excursion (beginning-of-line) - (if (re-search-forward "\\[.\\]" (mh-line-end-position) t) + (if (re-search-forward "\\[.\\]" (line-end-position) t) (speedbar-with-writable (backward-char 2) (delete-char 1) @@ -562,9 +559,9 @@ The function invalidates the latest ancestor that is present." (speedbar-with-writable (mh-speedbar-change-expand-button-char ?+) (add-text-properties - (mh-line-beginning-position) (1+ (mh-line-beginning-position)) + (line-beginning-position) (1+ (line-beginning-position)) '(mh-children-p t))) - (when (get-text-property (mh-line-beginning-position) 'mh-expanded) + (when (get-text-property (line-beginning-position) 'mh-expanded) (mh-speed-toggle)) (setq mh-speed-refresh-flag t)))) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index 89b0dbd9798..21954da6acd 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -86,41 +86,33 @@ message parent children (real-child-p t)) -(defvar mh-thread-id-hash nil +(defvar-local mh-thread-id-hash nil "Hash table used to canonicalize message identifiers.") -(make-variable-buffer-local 'mh-thread-id-hash) -(defvar mh-thread-subject-hash nil +(defvar-local mh-thread-subject-hash nil "Hash table used to canonicalize subject strings.") -(make-variable-buffer-local 'mh-thread-subject-hash) -(defvar mh-thread-id-table nil +(defvar-local mh-thread-id-table nil "Thread ID table maps from message identifiers to message containers.") -(make-variable-buffer-local 'mh-thread-id-table) -(defvar mh-thread-index-id-map nil +(defvar-local mh-thread-index-id-map nil "Table to look up message identifier from message index.") -(make-variable-buffer-local 'mh-thread-index-id-map) -(defvar mh-thread-id-index-map nil +(defvar-local mh-thread-id-index-map nil "Table to look up message index number from message identifier.") -(make-variable-buffer-local 'mh-thread-id-index-map) -(defvar mh-thread-subject-container-hash nil +(defvar-local mh-thread-subject-container-hash nil "Hash table used to group messages by subject.") -(make-variable-buffer-local 'mh-thread-subject-container-hash) -(defvar mh-thread-duplicates nil +(defvar-local mh-thread-duplicates nil "Hash table used to associate messages with the same message identifier.") -(make-variable-buffer-local 'mh-thread-duplicates) -(defvar mh-thread-history () +(defvar-local mh-thread-history () "Variable to remember the transformations to the thread tree. When new messages are added, these transformations are rewound, then the links are added from the newly seen messages. Finally the transformations are redone to get the new thread tree. This makes incremental threading easier.") -(make-variable-buffer-local 'mh-thread-history) (defvar mh-thread-body-width nil "Width of scan substring that contains subject and body of message.") @@ -294,7 +286,7 @@ at the end." (while (not (eobp)) (forward-char address-start-offset) (unless (equal (string-match spaces (buffer-substring-no-properties - (point) (mh-line-end-position))) + (point) (line-end-position))) 0) (beginning-of-line) (backward-char) @@ -455,8 +447,8 @@ If optional argument STRING is given then that is assumed to be the scan line. Otherwise uses the line at point as the scan line to parse." (let* ((string (or string (buffer-substring-no-properties - (mh-line-beginning-position) - (mh-line-end-position)))) + (line-beginning-position) + (line-end-position)))) (address-start (+ mh-cmd-note mh-scan-field-from-start-offset)) (body-start (+ mh-cmd-note mh-scan-field-from-end-offset)) (first-string (substring string 0 address-start))) @@ -597,20 +589,20 @@ Only information about messages in MSG-LIST are added to the tree." (while (not (eobp)) (cl-block process-message (let* ((index-line - (prog1 (buffer-substring (point) (mh-line-end-position)) + (prog1 (buffer-substring (point) (line-end-position)) (forward-line))) (index (string-to-number index-line)) - (id (prog1 (buffer-substring (point) (mh-line-end-position)) + (id (prog1 (buffer-substring (point) (line-end-position)) (forward-line))) (refs (prog1 - (buffer-substring (point) (mh-line-end-position)) + (buffer-substring (point) (line-end-position)) (forward-line))) (in-reply-to (prog1 (buffer-substring (point) - (mh-line-end-position)) + (line-end-position)) (forward-line))) (subject (prog1 (buffer-substring - (point) (mh-line-end-position)) + (point) (line-end-position)) (forward-line))) (subject-re-p nil)) (unless (gethash index mh-thread-scan-line-map) diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index 94aa8dd4a92..0200d232c33 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -27,10 +27,8 @@ ;;; Code: (require 'mh-e) -(mh-do-in-gnu-emacs - (require 'tool-bar)) -(mh-do-in-xemacs - (require 'toolbar)) +(require 'mh-acros) +(require 'tool-bar) ;;; Tool Bar Commands @@ -79,9 +77,6 @@ When INCLUDE-FLAG is non-nil, include message body being replied to." ;;; Tool Bar Creation -;; Shush compiler. -(defvar image-load-path) - (defmacro mh-tool-bar-define (defaults &rest buttons) "Define a tool bar for MH-E. DEFAULTS is the list of buttons that are present by default. It @@ -145,8 +140,6 @@ where, (let* ((name (nth 0 button)) (name-str (symbol-name name)) (icon (nth 2 button)) - (xemacs-icon (mh-do-in-xemacs - `(cdr (assoc (quote ,(intern icon)) mh-xemacs-icon-map)))) (full-doc (nth 3 button)) (doc (if (string-match "\\(.*\\)\n" full-doc) (match-string 1 full-doc) @@ -186,7 +179,7 @@ where, (t 'folder-buttons))) (docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs) ((eq mbuttons 'folder-buttons) 'folder-docs)))) - (add-to-list vector-list `(vector ,xemacs-icon ',function t ,full-doc)) + (add-to-list vector-list `(vector nil ',function t ,full-doc)) (add-to-list setter `(when (member ',name ,list) (mh-funcall-if-exists @@ -209,145 +202,69 @@ where, (unless (memq x letter-buttons) (error "Letter defaults contains unknown button %s" x))) `(eval-and-compile - ;; GNU Emacs tool bar specific code - (mh-do-in-gnu-emacs - (defun mh-buffer-exists-p (mode) - "Test whether a buffer with major mode MODE is present." - (cl-loop for buf in (buffer-list) - when (with-current-buffer buf - (eq major-mode mode)) - return t)) - ;; Tool bar initialization functions - (defun mh-tool-bar-folder-buttons-init () - (when (mh-buffer-exists-p 'mh-folder-mode) - (let* ((load-path (mh-image-load-path-for-library "mh-e" - "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (setq mh-folder-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse folder-button-setter) - tool-bar-map)) - (setq mh-folder-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) - ,@(nreverse sequence-button-setter) - tool-bar-map)) - (setq mh-show-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse show-button-setter) - tool-bar-map)) - (setq mh-show-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) - ,@(nreverse show-seq-button-setter) - tool-bar-map))))) - (defun mh-tool-bar-letter-buttons-init () - (when (mh-buffer-exists-p 'mh-letter-mode) - (let* ((load-path (mh-image-load-path-for-library "mh-e" - "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (setq mh-letter-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse letter-button-setter) - tool-bar-map))))) - ;; Custom setter functions - (defun mh-tool-bar-update (mode default-map sequence-map) - "Update `tool-bar-map' in all buffers of MODE. + (defun mh-buffer-exists-p (mode) + "Test whether a buffer with major mode MODE is present." + (cl-loop for buf in (buffer-list) + when (with-current-buffer buf + (eq major-mode mode)) + return t)) + ;; Tool bar initialization functions + (defun mh-tool-bar-folder-buttons-init () + (when (mh-buffer-exists-p 'mh-folder-mode) + (mh--with-image-load-path + (setq mh-folder-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse folder-button-setter) + tool-bar-map)) + (setq mh-folder-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) + ,@(nreverse sequence-button-setter) + tool-bar-map)) + (setq mh-show-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse show-button-setter) + tool-bar-map)) + (setq mh-show-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) + ,@(nreverse show-seq-button-setter) + tool-bar-map))))) + (defun mh-tool-bar-letter-buttons-init () + (when (mh-buffer-exists-p 'mh-letter-mode) + (mh--with-image-load-path + (setq mh-letter-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse letter-button-setter) + tool-bar-map))))) + ;; Custom setter functions + (defun mh-tool-bar-update (mode default-map sequence-map) + "Update `tool-bar-map' in all buffers of MODE. Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." - (cl-loop for buf in (buffer-list) - do (with-current-buffer buf - (when (eq mode major-mode) ;FIXME: derived-mode-p? - (let ((map (if mh-folder-view-stack - sequence-map - default-map))) - ;; Yes, make-local-variable is necessary since we - ;; get here during initialization when loading - ;; mh-e.el, after the +inbox buffer has been - ;; created, but before mh-folder-mode has run and - ;; created the local map. - (set (make-local-variable 'tool-bar-map) map)))))) - (defun mh-tool-bar-folder-buttons-set (symbol value) - "Construct tool bar for `mh-folder-mode' and `mh-show-mode'." - (set-default symbol value) - (mh-tool-bar-folder-buttons-init) - (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map - mh-folder-seq-tool-bar-map) - (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map - mh-show-seq-tool-bar-map)) - (defun mh-tool-bar-letter-buttons-set (symbol value) - "Construct tool bar for `mh-letter-mode'." - (set-default symbol value) - (mh-tool-bar-letter-buttons-init) - (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map - mh-letter-tool-bar-map))) - ;; XEmacs specific code - (mh-do-in-xemacs - (defvar mh-tool-bar-folder-vector-map - (list ,@(cl-loop for button in folder-buttons - for vector in folder-vectors - collect `(cons ',button ,vector)))) - (defvar mh-tool-bar-show-vector-map - (list ,@(cl-loop for button in show-buttons - for vector in show-vectors - collect `(cons ',button ,vector)))) - (defvar mh-tool-bar-letter-vector-map - (list ,@(cl-loop for button in letter-buttons - for vector in letter-vectors - collect `(cons ',button ,vector)))) - (defvar mh-tool-bar-folder-buttons) - (defvar mh-tool-bar-show-buttons) - (defvar mh-tool-bar-letter-buttons) - ;; Custom setter functions - (defun mh-tool-bar-letter-buttons-set (symbol value) - (set-default symbol value) - (when mh-xemacs-has-tool-bar-flag - (setq mh-tool-bar-letter-buttons - (cl-loop - for b in value - collect (cdr (assoc b mh-tool-bar-letter-vector-map)))))) - (defun mh-tool-bar-folder-buttons-set (symbol value) - (set-default symbol value) - (when mh-xemacs-has-tool-bar-flag - (setq mh-tool-bar-folder-buttons - (cl-loop - for b in value - collect (cdr (assoc b mh-tool-bar-folder-vector-map)))) - (setq mh-tool-bar-show-buttons - (cl-loop - for b in value - collect (cdr (assoc b mh-tool-bar-show-vector-map)))))) - (defun mh-tool-bar-init (mode) - "Install tool bar in MODE." - (when mh-xemacs-use-tool-bar-flag - (let ((tool-bar (cond ((eq mode :folder) - mh-tool-bar-folder-buttons) - ((eq mode :letter) - mh-tool-bar-letter-buttons) - ((eq mode :show) - mh-tool-bar-show-buttons))) - (height 37) - (width 40) - (buffer (current-buffer))) - (cond - ((eq mh-xemacs-tool-bar-position 'top) - (set-specifier top-toolbar tool-bar buffer) - (set-specifier top-toolbar-visible-p t) - (set-specifier top-toolbar-height height)) - ((eq mh-xemacs-tool-bar-position 'bottom) - (set-specifier bottom-toolbar tool-bar buffer) - (set-specifier bottom-toolbar-visible-p t) - (set-specifier bottom-toolbar-height height)) - ((eq mh-xemacs-tool-bar-position 'left) - (set-specifier left-toolbar tool-bar buffer) - (set-specifier left-toolbar-visible-p t) - (set-specifier left-toolbar-width width)) - ((eq mh-xemacs-tool-bar-position 'right) - (set-specifier right-toolbar tool-bar buffer) - (set-specifier right-toolbar-visible-p t) - (set-specifier right-toolbar-width width)) - (t (set-specifier default-toolbar tool-bar buffer))))))) + (cl-loop for buf in (buffer-list) + do (with-current-buffer buf + (when (eq mode major-mode) ;FIXME: derived-mode-p? + (let ((map (if mh-folder-view-stack + sequence-map + default-map))) + ;; Yes, make-local-variable is necessary since we + ;; get here during initialization when loading + ;; mh-e.el, after the +inbox buffer has been + ;; created, but before mh-folder-mode has run and + ;; created the local map. + (setq-local tool-bar-map map)))))) + (defun mh-tool-bar-folder-buttons-set (symbol value) + "Construct tool bar for `mh-folder-mode' and `mh-show-mode'." + (set-default symbol value) + (mh-tool-bar-folder-buttons-init) + (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map + mh-folder-seq-tool-bar-map) + (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map + mh-show-seq-tool-bar-map)) + (defun mh-tool-bar-letter-buttons-set (symbol value) + "Construct tool bar for `mh-letter-mode'." + (set-default symbol value) + (mh-tool-bar-letter-buttons-init) + (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map + mh-letter-tool-bar-map)) ;; Declare customizable tool bars (custom-declare-variable 'mh-tool-bar-folder-buttons @@ -372,7 +289,6 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." ;;:package-version '(MH-E "7.1") )))) -;; The icon names are duplicated in the Makefile and mh-xemacs.el. (mh-tool-bar-define ((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg mh-page-msg diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index bbce17013b1..feebf6416fe 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -52,7 +52,7 @@ used in lieu of `search' in the CL package." (let ((syntax-table (syntax-table))) (unwind-protect (save-excursion - (mh-mail-abbrev-make-syntax-table) + (mail-abbrev-make-syntax-table) (set-syntax-table mail-abbrev-syntax-table) (backward-word n) (point)) @@ -61,9 +61,9 @@ used in lieu of `search' in the CL package." ;;;###mh-autoload (defun mh-colors-available-p () "Check if colors are available in the Emacs being used." - (or (featurep 'xemacs) - (let ((color-cells (mh-display-color-cells))) - (and (numberp color-cells) (>= color-cells 8))))) + ;; FIXME: Can this be replaced with `display-color-p'? + (let ((color-cells (display-color-cells))) + (and (numberp color-cells) (>= color-cells 8)))) ;;;###mh-autoload (defun mh-colors-in-use-p () @@ -78,16 +78,13 @@ used in lieu of `search' in the CL package." ;;;###mh-autoload (defun mh-make-local-vars (&rest pairs) "Initialize local variables according to the variable-value PAIRS." + (declare (obsolete setq-local "29.1")) (while pairs (set (make-local-variable (car pairs)) (car (cdr pairs))) (setq pairs (cdr (cdr pairs))))) ;;;###mh-autoload -(defun mh-mapc (function list) - "Apply FUNCTION to each element of LIST for side effects only." - (while list - (funcall function (car list)) - (setq list (cdr list)))) +(define-obsolete-function-alias 'mh-mapc #'mapc "29.1") (defvar mh-pick-regexp-chars ".*$[" "List of special characters in pick regular expressions.") @@ -102,7 +99,7 @@ PICK-EXPR is a list of strings. Return nil if PICK-EXPR is nil." (not (string-equal string ""))) (cl-loop for i from 0 to (1- (length mh-pick-regexp-chars)) do (let ((s (string ?\\ (aref mh-pick-regexp-chars i)))) - (setq string (mh-replace-regexp-in-string s s string t t)))) + (setq string (replace-regexp-in-string s s string t t)))) (setq quoted-pick-expr (append quoted-pick-expr (list string))))) quoted-pick-expr)) @@ -119,34 +116,33 @@ Ignores case when searching for OLD." ;;; Logo Display -(defvar mh-logo-cache nil) +;;;###mh-autoload +(defmacro mh--with-image-load-path (&rest body) + "Load `image' and eval BODY with `image-load-path' set appropriately." + (declare (debug t) (indent 0)) + `(progn + ;; Not preloaded in without-x builds. + (require 'image) + (defvar image-load-path) + (declare-function image-load-path-for-library "image") + (let* ((load-path (image-load-path-for-library "mh-e" "mh-logo.xpm")) + (image-load-path (cons (car load-path) image-load-path))) + ,@body))) -;; Shush compiler. -(defvar image-load-path) +(defvar mh-logo-cache nil) ;;;###mh-autoload (defun mh-logo-display () "Modify mode line to display MH-E logo." - (mh-do-in-gnu-emacs - (let* ((load-path (mh-image-load-path-for-library "mh-e" "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (add-text-properties - 0 2 - `(display ,(or mh-logo-cache - (setq mh-logo-cache - (mh-funcall-if-exists - find-image '((:type xpm :ascent center - :file "mh-logo.xpm")))))) - (car mode-line-buffer-identification)))) - (mh-do-in-xemacs - (setq modeline-buffer-identification - (list - (if mh-modeline-glyph - (cons modeline-buffer-id-left-extent mh-modeline-glyph) - (cons modeline-buffer-id-left-extent "XEmacs%N:")) - (cons modeline-buffer-id-right-extent " %17b"))))) + (mh--with-image-load-path + (add-text-properties + 0 2 + `(display ,(or mh-logo-cache + (setq mh-logo-cache + (mh-funcall-if-exists + find-image '(( :type xpm :ascent center + :file "mh-logo.xpm" )))))) + (car mode-line-buffer-identification)))) @@ -509,8 +505,8 @@ they will not be returned." ;; folder is specified, ensure it is nil to avoid adding the ;; folder to the folder-list and adding a slash to it. (when folder - (setq folder (mh-replace-regexp-in-string "^\\+" "" folder)) - (setq folder (mh-replace-regexp-in-string "/+$" "" folder)) + (setq folder (replace-regexp-in-string "^\\+" "" folder)) + (setq folder (replace-regexp-in-string "/+$" "" folder)) (if (equal folder "") (setq folder nil))) ;; Add provided folder to list, unless all folders are asked for. @@ -573,10 +569,10 @@ Expects FOLDER to have already been normalized with (apply #'call-process arg-list) (goto-char (point-min)) (while (not (and (eolp) (bolp))) - (goto-char (mh-line-end-position)) - (let ((start-pos (mh-line-beginning-position)) + (goto-char (line-end-position)) + (let ((start-pos (line-beginning-position)) (has-pos (search-backward " has " - (mh-line-beginning-position) t))) + (line-beginning-position) t))) (when (integerp has-pos) (while (equal (char-after has-pos) ? ) (cl-decf has-pos)) @@ -591,7 +587,7 @@ Expects FOLDER to have already been normalized with (setq name (substring name 0 (1- (length name))))) (push (cons name - (search-forward "(others)" (mh-line-end-position) t)) + (search-forward "(others)" (line-end-position) t)) results)))) (forward-line 1)))) (setq results (nreverse results)) @@ -727,16 +723,12 @@ See Info node `(elisp) Programmed Completion' for details." ((equal path mh-user-path) nil) (t (file-directory-p path)))))))) -;; Shush compiler. -(defvar completion-root-regexp) ;; Apparently used in XEmacs - (defun mh-folder-completing-read (prompt default allow-root-folder-flag) "Read folder name with PROMPT and default result DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name corresponding to `mh-user-path'." (mh-normalize-folder-name - (let ((completion-root-regexp "^[+/]") ;FIXME: Who/what uses that? - (minibuffer-local-completion-map mh-folder-completion-map) + (let ((minibuffer-local-completion-map mh-folder-completion-map) (mh-allow-root-folder-flag allow-root-folder-flag)) (completing-read prompt 'mh-folder-completion-function nil nil nil 'mh-folder-hist default)) @@ -920,11 +912,7 @@ Handle RFC 822 (or later) continuation lines." (defvar mh-hidden-header-keymap (let ((map (make-sparse-keymap))) - (mh-do-in-gnu-emacs - (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button)) - (mh-do-in-xemacs - (define-key map '(button2) - #'mh-letter-toggle-header-field-display-button)) + (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button) map)) ;;;###mh-autoload @@ -958,9 +946,9 @@ is hidden, if positive then the field is displayed." (and (numberp arg) (>= arg 0)) (and (eq arg 'long) - (> (mh-line-beginning-position 5) end))) + (> (line-beginning-position 5) end))) (remove-text-properties begin end '(invisible nil)) - (search-forward ":" (mh-line-end-position) t) + (search-forward ":" (line-end-position) t) (mh-letter-skip-leading-whitespace-in-header-field)) ;; XXX Redesign to make usable by user. Perhaps use a positive ;; numeric prefix to make that many lines visible. diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 58177c1794e..0c1bcdfefd5 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -30,17 +30,11 @@ (autoload 'mail-header-parse-address "mail-parse") (autoload 'message-fetch-field "message") -(defvar mh-show-xface-function - (cond ((and (featurep 'xemacs) (locate-library "x-face") (not (featurep 'xface))) - (load "x-face" t t) - #'mh-face-display-function) - ((>= emacs-major-version 21) - #'mh-face-display-function) - (t #'ignore)) +(defvar mh-show-xface-function #'mh-face-display-function "Determine at run time what function should be called to display X-Face.") +(make-obsolete-variable 'mh-show-xface-function nil "29.1") -(defvar mh-uncompface-executable - (and (fboundp 'executable-find) (executable-find "uncompface"))) +(defvar mh-uncompface-executable (executable-find "uncompface")) @@ -52,7 +46,7 @@ (when (and window-system mh-show-use-xface-flag (or mh-decode-mime-flag mh-mhl-format-file mh-clean-message-header-flag)) - (funcall mh-show-xface-function))) + (mh-face-display-function))) (defun mh-face-display-function () "Display a Face, X-Face, or X-Image-URL header field. @@ -77,53 +71,21 @@ in this order is used." (when type (goto-char (point-min)) (when (re-search-forward "^from:" (point-max) t) - ;; GNU Emacs - (mh-do-in-gnu-emacs - (if (eq type 'url) - (mh-x-image-url-display url) - (mh-funcall-if-exists - insert-image (create-image - raw type t - :foreground - (mh-face-foreground 'mh-show-xface nil t) - :background - (mh-face-background 'mh-show-xface nil t)) - " "))) - ;; XEmacs - (mh-do-in-xemacs - (cond - ((eq type 'url) - (mh-x-image-url-display url)) - ((eq type 'png) - (when (featurep 'png) - (set-extent-begin-glyph - (make-extent (point) (point)) - (make-glyph (vector 'png ':data (mh-face-to-png face)))))) - ;; Try internal xface support if available... - ((and (eq type 'pbm) (featurep 'xface)) - (set-glyph-face - (set-extent-begin-glyph - (make-extent (point) (point)) - (make-glyph (vector 'xface ':data (concat "X-Face: " x-face)))) - 'mh-show-xface)) - ;; Otherwise try external support with x-face... - ((and (eq type 'pbm) - (fboundp 'x-face-xmas-wl-display-x-face) - (fboundp 'executable-find) (executable-find "uncompface")) - (mh-funcall-if-exists x-face-xmas-wl-display-x-face)) - ;; Picon display - ((and raw (member type '(xpm xbm gif))) - (when (featurep type) - (set-extent-begin-glyph - (make-extent (point) (point)) - (make-glyph (vector type ':data raw)))))) - (when raw (insert " ")))))))) + (if (eq type 'url) + (mh-x-image-url-display url) + (mh-funcall-if-exists + insert-image (create-image + raw type t + :foreground + (face-foreground 'mh-show-xface nil t) + :background + (face-background 'mh-show-xface nil t)) + " "))))))) (defun mh-face-to-png (data) "Convert base64 encoded DATA to png image." (with-temp-buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (insert data) (ignore-errors (base64-decode-region (point-min) (point-max))) (buffer-string))) @@ -131,8 +93,7 @@ in this order is used." (defun mh-uncompface (data) "Run DATA through `uncompface' to generate bitmap." (with-temp-buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (insert data) (when (and mh-uncompface-executable (equal (call-process-region (point-min) (point-max) @@ -176,10 +137,8 @@ The directories are searched for in the order they appear in the list.") (defvar mh-picon-image-types (cl-loop for type in '(xpm xbm gif) - when (or (mh-do-in-gnu-emacs - (ignore-errors - (mh-funcall-if-exists image-type-available-p type))) - (mh-do-in-xemacs (featurep type))) + when (ignore-errors + (image-type-available-p type)) collect type)) (autoload 'message-tokenize-header "sendmail") @@ -270,8 +229,7 @@ file contents as a string is returned. If FILE is nil, then both elements of the list are nil." (if (stringp file) (with-temp-buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (let ((type (and (string-match ".*\\.\\(...\\)$" file) (intern (match-string 1 file))))) (insert-file-contents-literally file) @@ -321,7 +279,7 @@ If the URL isn't present in the cache then it is fetched with wget." (let* ((cache-filename (mh-x-image-url-cache-canonicalize url)) (state (mh-x-image-get-download-state cache-filename)) (marker (point-marker))) - (set (make-local-variable 'mh-x-image-marker) marker) + (setq-local mh-x-image-marker marker) (cond ((not (mh-x-image-url-sane-p url))) ((eq state 'ok) (mh-x-image-display cache-filename marker)) @@ -357,14 +315,14 @@ This is only done if `mh-x-image-cache-directory' is nil." (defun mh-x-image-url-cache-canonicalize (url) "Canonicalize URL. Replace the ?/ character with a ?! character and append .png. -Also replaces special characters with `mh-url-hexify-string' +Also replaces special characters with `url-hexify-string' since not all characters, such as :, are valid within Windows filenames. In addition, replaces * with %2a. See URL `https://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iitemnamelimits/GetValidCharacters.asp'." (format "%s/%s.png" mh-x-image-cache-directory - (mh-replace-regexp-in-string + (replace-regexp-in-string "\\*" "%2a" - (mh-url-hexify-string + (url-hexify-string (with-temp-buffer (insert url) (mh-replace-string "/" "!") @@ -404,16 +362,7 @@ filenames. In addition, replaces * with %2a. See URL (when (and (file-readable-p image) (not (file-symlink-p image)) (eq marker mh-x-image-marker)) (goto-char marker) - (mh-do-in-gnu-emacs - (mh-funcall-if-exists insert-image (create-image image 'png))) - (mh-do-in-xemacs - (when (featurep 'png) - (set-extent-begin-glyph - (make-extent (point) (point)) - (make-glyph - (vector 'png ':data (with-temp-buffer - (insert-file-contents-literally image) - (buffer-string)))))))) + (insert-image (create-image image 'png))) (set-buffer-modified-p buffer-modified-flag))))) (defun mh-x-image-url-fetch-image (url cache-file marker sentinel) @@ -423,12 +372,11 @@ be displayed in a buffer and position specified by MARKER. The actual display is carried out by the SENTINEL function." (if mh-wget-executable (let ((buffer (generate-new-buffer mh-temp-fetch-buffer)) - (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch") - (expand-file-name (make-temp-name "~/mhe-fetch"))))) + (filename (make-temp-file "mhe-fetch"))) (with-current-buffer buffer - (set (make-local-variable 'mh-x-image-url-cache-file) cache-file) - (set (make-local-variable 'mh-x-image-marker) marker) - (set (make-local-variable 'mh-x-image-temp-file) filename)) + (setq-local mh-x-image-url-cache-file cache-file) + (setq-local mh-x-image-marker marker) + (setq-local mh-x-image-temp-file filename)) (set-process-sentinel (start-process "*mh-x-image-url-fetch*" buffer mh-wget-executable mh-wget-option filename url) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ca82b4a9e60..0fea057d1cb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1,4 +1,4 @@ -;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*- +;;; minibuffer.el --- Minibuffer and completion functions -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. diff --git a/lisp/mouse.el b/lisp/mouse.el index 7bac6dd07bf..d6912892eff 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1569,8 +1569,7 @@ The region will be defined with mark and point." (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) - (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541). - (start-posn (event-start start-event)) + (let* ((start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) (_ (with-current-buffer (window-buffer start-window) @@ -1592,72 +1591,84 @@ The region will be defined with mark and point." ;; Don't count the mode line. (1- (nth 3 bounds)))) (click-count (1- (event-click-count start-event))) - ;; Suppress automatic hscrolling, because that is a nuisance - ;; when setting point near the right fringe (but see below). + ;; Save original automatic scrolling behavior (see below). (auto-hscroll-mode-saved auto-hscroll-mode) - (old-track-mouse track-mouse)) + (scroll-margin-saved scroll-margin) + (old-track-mouse track-mouse) + (cleanup (lambda () + (setq track-mouse old-track-mouse) + (setq auto-hscroll-mode auto-hscroll-mode-saved) + (setq scroll-margin scroll-margin-saved)))) + (condition-case err + (progn + (setq mouse-selection-click-count click-count) + + ;; Suppress automatic scrolling near the edges while tracking + ;; movement, as it interferes with the natural dragging behavior + ;; (point will unexpectedly be moved beneath the pointer, making + ;; selections in auto-scrolling margins impossible). + (setq auto-hscroll-mode nil) + (setq scroll-margin 0) + + ;; In case the down click is in the middle of some intangible text, + ;; use the end of that text, and put it in START-POINT. + (if (< (point) start-point) + (goto-char start-point)) + (setq start-point (point)) + + ;; Activate the region, using `mouse-start-end' to determine where + ;; to put point and mark (e.g., double-click will select a word). + (setq-local transient-mark-mode + (if (eq transient-mark-mode 'lambda) + '(only) + (cons 'only transient-mark-mode))) + (let ((range (mouse-start-end start-point start-point click-count))) + (push-mark (nth 0 range) t t) + (goto-char (nth 1 range))) - (setq mouse-selection-click-count click-count) - ;; In case the down click is in the middle of some intangible text, - ;; use the end of that text, and put it in START-POINT. - (if (< (point) start-point) - (goto-char start-point)) - (setq start-point (point)) + (setf (terminal-parameter nil 'mouse-drag-start) start-event) + (setq track-mouse t) - ;; Activate the region, using `mouse-start-end' to determine where - ;; to put point and mark (e.g., double-click will select a word). - (setq-local transient-mark-mode - (if (eq transient-mark-mode 'lambda) - '(only) - (cons 'only transient-mark-mode))) - (let ((range (mouse-start-end start-point start-point click-count))) - (push-mark (nth 0 range) t t) - (goto-char (nth 1 range))) - - (setf (terminal-parameter nil 'mouse-drag-start) start-event) - (setq track-mouse t) - (setq auto-hscroll-mode nil) - - (set-transient-map - (let ((map (make-sparse-keymap))) - (define-key map [switch-frame] #'ignore) - (define-key map [select-window] #'ignore) - (define-key map [mouse-movement] - (lambda (event) (interactive "e") - (let* ((end (event-end event)) - (end-point (posn-point end))) - (unless (eq end-point start-point) - ;; As soon as the user moves, we can re-enable auto-hscroll. - (setq auto-hscroll-mode auto-hscroll-mode-saved) - ;; And remember that we have moved, so mouse-set-region can know - ;; its event is really a drag event. - (setcar start-event 'mouse-movement)) - (if (and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count) - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top) - nil start-point)) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) - nil start-point)))))))) - map) - t (lambda () - (setq track-mouse old-track-mouse) - (setq auto-hscroll-mode auto-hscroll-mode-saved) - ;; Don't deactivate the mark when the context menu was invoked - ;; by down-mouse-3 immediately after down-mouse-1 and without - ;; releasing the mouse button with mouse-1. This allows to use - ;; region-related context menu to operate on the selected region. - (unless (and context-menu-mode - (eq (car-safe (aref (this-command-keys-vector) 0)) - 'down-mouse-3)) - (deactivate-mark) - (pop-mark)))))) + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] + (lambda (event) (interactive "e") + (let* ((end (event-end event)) + (end-point (posn-point end))) + (unless (eq end-point start-point) + ;; And remember that we have moved, so mouse-set-region can know + ;; its event is really a drag event. + (setcar start-event 'mouse-movement)) + (if (and (eq (posn-window end) start-window) + (integer-or-marker-p end-point)) + (mouse--drag-set-mark-and-point start-point + end-point click-count) + (let ((mouse-row (cdr (cdr (mouse-position))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top) + nil start-point)) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) + nil start-point)))))))) + map) + t (lambda () + (funcall cleanup) + ;; Don't deactivate the mark when the context menu was invoked + ;; by down-mouse-3 immediately after down-mouse-1 and without + ;; releasing the mouse button with mouse-1. This allows to use + ;; region-related context menu to operate on the selected region. + (unless (and context-menu-mode + (eq (car-safe (aref (this-command-keys-vector) 0)) + 'down-mouse-3)) + (deactivate-mark) + (pop-mark))))) + ;; Cleanup on errors + (error (funcall cleanup) + (signal (car err) (cdr err)))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 2585833e1d4..a6c256eeba8 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1230,8 +1230,9 @@ only return the directory part of FILE." ;; found another machine with the same user. ;; Try that account. (read-passwd - (format "passwd for %s@%s (default same as %s@%s): " - user host user other) + (format-prompt "passwd for %s@%s" + (format "same as %s@%s" user other) + user host) nil (ange-ftp-lookup-passwd other user)) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 560ece67517..3fff5398c06 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -2252,15 +2252,19 @@ keywords `:system-private' or `:session-private', respectively." bus nil dbus-path-local dbus-interface-local "Disconnected" #'dbus-handle-bus-disconnect))) - -;; Initialize `:system' and `:session' buses. This adds their file -;; descriptors to input_wait_mask, in order to detect incoming -;; messages immediately. -(when (featurep 'dbusbind) - (dbus-ignore-errors - (dbus-init-bus :system)) - (dbus-ignore-errors - (dbus-init-bus :session))) + +(defun dbus--init () + ;; Initialize `:system' and `:session' buses. This adds their file + ;; descriptors to input_wait_mask, in order to detect incoming + ;; messages immediately. + (when (featurep 'dbusbind) + (dbus-ignore-errors + (dbus-init-bus :system)) + (dbus-ignore-errors + (dbus-init-bus :session)))) + +(add-hook 'after-pdump-load-hook #'dbus--init) +(dbus--init) (provide 'dbus) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 238900db0c3..94a5890ef56 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -178,6 +178,40 @@ the tab bar is enabled." :group 'eww :type 'hook) +(defcustom eww-auto-rename-buffer nil + "Automatically rename EWW buffers once the page is rendered. + +When nil, do not rename the buffer. With a non-nil value +determine the renaming scheme, as follows: + +- `title': Use the web page's title. +- `url': Use the web page's URL. +- a function's symbol: Run a user-defined function that returns a + string with which to rename the buffer. Sample of a + user-defined function: + + (defun my-eww-rename-buffer () + (when (eq major-mode 'eww-mode) + (when-let ((string (or (plist-get eww-data :title) + (plist-get eww-data :url)))) + (format \"*%s*\" string)))) + +The string of `title' and `url' is always truncated to the value +of `eww-buffer-name-length'." + :version "29.1" + :type '(choice + (const :tag "Do not rename buffers (default)" nil) + (const :tag "Rename buffer to web page title" title) + (const :tag "Rename buffer to web page URL" url) + (function :tag "A user-defined function to rename the buffer")) + :group 'eww) + +(defcustom eww-buffer-name-length 40 + "Length of renamed buffer name, per `eww-auto-rename-buffer'." + :type 'natnum + :version "29.1" + :group 'eww) + (defcustom eww-form-checkbox-selected-symbol "[X]" "Symbol used to represent a selected checkbox. See also `eww-form-checkbox-symbol'." @@ -271,15 +305,13 @@ See also `eww-form-checkbox-selected-symbol'." "text/html, text/plain, text/sgml, text/css, application/xhtml+xml, */*;q=0.01" "Value used for the HTTP 'Accept' header.") -(defvar eww-link-keymap - (let ((map (copy-keymap shr-map))) - (define-key map "\r" 'eww-follow-link) - map)) +(defvar-keymap eww-link-keymap + :parent shr-map + "\r" #'eww-follow-link) -(defvar eww-image-link-keymap - (let ((map (copy-keymap shr-image-map))) - (define-key map "\r" 'eww-follow-link) - map)) +(defvar-keymap eww-image-link-keymap + :parent shr-map + "\r" #'eww-follow-link) (defun eww-suggested-uris nil "Return the list of URIs to suggest at the `eww' prompt. @@ -313,13 +345,13 @@ will start Emacs and browse the GNU web site." ;;;###autoload -(defun eww (url &optional arg buffer) +(defun eww (url &optional new-buffer buffer) "Fetch URL and render the page. If the input doesn't look like an URL or a domain name, the word(s) will be searched for via `eww-search-prefix'. -If called with a prefix ARG, use a new buffer instead of reusing -the default EWW buffer. +If NEW-BUFFER is non-nil (interactively, the prefix arg), use a +new buffer instead of reusing the default EWW buffer. If BUFFER, the data to be rendered is in that buffer. In that case, this function doesn't actually fetch URL. BUFFER will be @@ -329,11 +361,11 @@ killed after rendering." (list (read-string (format-prompt "Enter URL or keywords" (and uris (car uris))) nil 'eww-prompt-history uris) - (prefix-numeric-value current-prefix-arg)))) + current-prefix-arg))) (setq url (eww--dwim-expand-url url)) (pop-to-buffer-same-window (cond - ((eq arg 4) + (new-buffer (generate-new-buffer "*eww*")) ((eq major-mode 'eww-mode) (current-buffer)) @@ -355,7 +387,7 @@ killed after rendering." (setq url (url-recreate-url parsed))) (plist-put eww-data :url url) (plist-put eww-data :title "") - (eww-update-header-line-format) + (eww--after-page-change) (let ((inhibit-read-only t)) (insert (format "Loading %s..." url)) (goto-char (point-min))) @@ -504,6 +536,30 @@ Currently this means either text/html or application/xhtml+xml." (member content-type '("text/html" "application/xhtml+xml"))) +(defun eww--rename-buffer () + "Rename the current EWW buffer. +The renaming scheme is performed in accordance with +`eww-auto-rename-buffer'." + (let ((rename-string) + (formatter + (lambda (string) + (format "*%s # eww*" (truncate-string-to-width + string eww-buffer-name-length)))) + (site-title (plist-get eww-data :title)) + (site-url (plist-get eww-data :url))) + (cond ((null eww-auto-rename-buffer)) + ((eq eww-auto-rename-buffer 'url) + (setq rename-string (funcall formatter site-url))) + ((functionp eww-auto-rename-buffer) + (setq rename-string (funcall eww-auto-rename-buffer))) + (t (setq rename-string + (funcall formatter (if (or (equal site-title "") + (null site-title)) + "Untitled" + site-title))))) + (when rename-string + (rename-buffer rename-string t)))) + (defun eww-render (status url &optional point buffer encode) (let* ((headers (eww-parse-headers)) (content-type @@ -554,7 +610,7 @@ Currently this means either text/html or application/xhtml+xml." (eww-display-raw buffer (or encode charset 'utf-8)))) (with-current-buffer buffer (plist-put eww-data :url url) - (eww-update-header-line-format) + (eww--after-page-change) (setq eww-history-position 0) (and last-coding-system-used (set-buffer-file-coding-system last-coding-system-used)) @@ -638,7 +694,8 @@ Currently this means either text/html or application/xhtml+xml." (meta . eww-tag-meta) (a . eww-tag-a))))) (erase-buffer) - (shr-insert-document document) + (with-delayed-message (2 "Rendering HTML...") + (shr-insert-document document)) (cond (point (goto-char point)) @@ -798,12 +855,16 @@ Currently this means either text/html or application/xhtml+xml." `((?u . ,(or url "")) (?t . ,title)))))))) +(defun eww--after-page-change () + (eww-update-header-line-format) + (eww--rename-buffer)) + (defun eww-tag-title (dom) (plist-put eww-data :title (replace-regexp-in-string "^ \\| $" "" (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom)))) - (eww-update-header-line-format)) + (eww--after-page-change)) (defun eww-display-raw (buffer &optional encode) (let ((data (buffer-substring (point) (point-max)))) @@ -931,7 +992,7 @@ the like." nil (current-buffer)) (dolist (elem '(:source :url :title :next :previous :up)) (plist-put eww-data elem (plist-get old-data elem))) - (eww-update-header-line-format))) + (eww--after-page-change))) (defun eww-score-readability (node) (let ((score -1)) @@ -973,67 +1034,64 @@ the like." (setq result highest)))) result)) -(defvar eww-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead! - (define-key map "G" 'eww) - (define-key map [?\M-\r] 'eww-open-in-new-buffer) - (define-key map [?\t] 'shr-next-link) - (define-key map [?\M-\t] 'shr-previous-link) - (define-key map [backtab] 'shr-previous-link) - (define-key map [delete] 'scroll-down-command) - (define-key map "l" 'eww-back-url) - (define-key map "r" 'eww-forward-url) - (define-key map "n" 'eww-next-url) - (define-key map "p" 'eww-previous-url) - (define-key map "u" 'eww-up-url) - (define-key map "t" 'eww-top-url) - (define-key map "&" 'eww-browse-with-external-browser) - (define-key map "d" 'eww-download) - (define-key map "w" 'eww-copy-page-url) - (define-key map "C" 'url-cookie-list) - (define-key map "v" 'eww-view-source) - (define-key map "R" 'eww-readable) - (define-key map "H" 'eww-list-histories) - (define-key map "E" 'eww-set-character-encoding) - (define-key map "s" 'eww-switch-to-buffer) - (define-key map "S" 'eww-list-buffers) - (define-key map "F" 'eww-toggle-fonts) - (define-key map "D" 'eww-toggle-paragraph-direction) - (define-key map [(meta C)] 'eww-toggle-colors) - (define-key map [(meta I)] 'eww-toggle-images) - - (define-key map "b" 'eww-add-bookmark) - (define-key map "B" 'eww-list-bookmarks) - (define-key map [(meta n)] 'eww-next-bookmark) - (define-key map [(meta p)] 'eww-previous-bookmark) - - (easy-menu-define nil map "" - '("Eww" - ["Exit" quit-window t] - ["Close browser" quit-window t] - ["Reload" eww-reload t] - ["Follow URL in new buffer" eww-open-in-new-buffer] - ["Back to previous page" eww-back-url - :active (not (zerop (length eww-history)))] - ["Forward to next page" eww-forward-url - :active (not (zerop eww-history-position))] - ["Browse with external browser" eww-browse-with-external-browser t] - ["Download" eww-download t] - ["View page source" eww-view-source] - ["Copy page URL" eww-copy-page-url t] - ["List histories" eww-list-histories t] - ["Switch to buffer" eww-switch-to-buffer t] - ["List buffers" eww-list-buffers t] - ["Add bookmark" eww-add-bookmark t] - ["List bookmarks" eww-list-bookmarks t] - ["List cookies" url-cookie-list t] - ["Toggle fonts" eww-toggle-fonts t] - ["Toggle colors" eww-toggle-colors t] - ["Toggle images" eww-toggle-images t] - ["Character Encoding" eww-set-character-encoding] - ["Toggle Paragraph Direction" eww-toggle-paragraph-direction])) - map)) +(defvar-keymap eww-mode-map + "g" #'eww-reload ;FIXME: revert-buffer-function instead! + "G" #'eww + [?\M-\r] #'eww-open-in-new-buffer + [?\t] #'shr-next-link + [?\M-\t] #'shr-previous-link + [backtab] #'shr-previous-link + [delete] #'scroll-down-command + "l" #'eww-back-url + "r" #'eww-forward-url + "n" #'eww-next-url + "p" #'eww-previous-url + "u" #'eww-up-url + "t" #'eww-top-url + "&" #'eww-browse-with-external-browser + "d" #'eww-download + "w" #'eww-copy-page-url + "C" #'url-cookie-list + "v" #'eww-view-source + "R" #'eww-readable + "H" #'eww-list-histories + "E" #'eww-set-character-encoding + "s" #'eww-switch-to-buffer + "S" #'eww-list-buffers + "F" #'eww-toggle-fonts + "D" #'eww-toggle-paragraph-direction + [(meta C)] #'eww-toggle-colors + [(meta I)] #'eww-toggle-images + + "b" #'eww-add-bookmark + "B" #'eww-list-bookmarks + [(meta n)] #'eww-next-bookmark + [(meta p)] #'eww-previous-bookmark + + :menu '("Eww" + ["Exit" quit-window t] + ["Close browser" quit-window t] + ["Reload" eww-reload t] + ["Follow URL in new buffer" eww-open-in-new-buffer] + ["Back to previous page" eww-back-url + :active (not (zerop (length eww-history)))] + ["Forward to next page" eww-forward-url + :active (not (zerop eww-history-position))] + ["Browse with external browser" eww-browse-with-external-browser t] + ["Download" eww-download t] + ["View page source" eww-view-source] + ["Copy page URL" eww-copy-page-url t] + ["List histories" eww-list-histories t] + ["Switch to buffer" eww-switch-to-buffer t] + ["List buffers" eww-list-buffers t] + ["Add bookmark" eww-add-bookmark t] + ["List bookmarks" eww-list-bookmarks t] + ["List cookies" url-cookie-list t] + ["Toggle fonts" eww-toggle-fonts t] + ["Toggle colors" eww-toggle-colors t] + ["Toggle images" eww-toggle-images t] + ["Character Encoding" eww-set-character-encoding] + ["Toggle Paragraph Direction" eww-toggle-paragraph-direction])) (defun eww-context-menu (menu click) "Populate MENU with eww commands at CLICK." @@ -1166,7 +1224,7 @@ instead of `browse-url-new-window-flag'." (goto-char (plist-get elem :point)) ;; Make buffer listings more informative. (setq list-buffers-directory (plist-get elem :url)) - (eww-update-header-line-format)))) + (eww--after-page-change)))) (defun eww-next-url () "Go to the page marked `next'. @@ -1230,54 +1288,43 @@ just re-display the HTML already fetched." (defvar eww-form nil) -(defvar eww-submit-map - (let ((map (make-sparse-keymap))) - (define-key map "\r" 'eww-submit) - (define-key map [(control c) (control c)] 'eww-submit) - map)) - -(defvar eww-submit-file - (let ((map (make-sparse-keymap))) - (define-key map "\r" 'eww-select-file) - (define-key map [(control c) (control c)] 'eww-submit) - map)) - -(defvar eww-checkbox-map - (let ((map (make-sparse-keymap))) - (define-key map " " 'eww-toggle-checkbox) - (define-key map "\r" 'eww-toggle-checkbox) - (define-key map [(control c) (control c)] 'eww-submit) - map)) - -(defvar eww-text-map - (let ((map (make-keymap))) - (set-keymap-parent map text-mode-map) - (define-key map "\r" 'eww-submit) - (define-key map [(control a)] 'eww-beginning-of-text) - (define-key map [(control c) (control c)] 'eww-submit) - (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 - (let ((map (make-keymap))) - (set-keymap-parent map text-mode-map) - (define-key map "\r" 'forward-line) - (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)) +(defvar-keymap eww-submit-map + "\r" #'eww-submit + [(control c) (control c)] #'eww-submit) + +(defvar-keymap eww-submit-file + "\r" #'eww-select-file + [(control c) (control c)] #'eww-submit) + +(defvar-keymap eww-checkbox-map + " " #'eww-toggle-checkbox + "\r" #'eww-toggle-checkbox + [(control c) (control c)] #'eww-submit) + +(defvar-keymap eww-text-map + :full t :parent text-mode-map + "\r" #'eww-submit + [(control a)] #'eww-beginning-of-text + [(control c) (control c)] #'eww-submit + [(control e)] #'eww-end-of-text + [?\t] #'shr-next-link + [?\M-\t] #'shr-previous-link + [backtab] #'shr-previous-link) + +(defvar-keymap eww-textarea-map + :full t :parent text-mode-map + "\r" #'forward-line + [(control c) (control c)] #'eww-submit + [?\t] #'shr-next-link + [?\M-\t] #'shr-previous-link + [backtab] #'shr-previous-link) + +(defvar-keymap eww-select-map + :doc "Map for select buttons" + "\r" #'eww-change-select + [follow-link] 'mouse-face + [mouse-2] #'eww-change-select + [(control c) (control c)] #'eww-submit) (defun eww-beginning-of-text () "Move to the start of the input field." @@ -2100,23 +2147,18 @@ If ERROR-OUT, signal user-error if there are no bookmarks." 'eww-bookmark))) (eww-browse-url (plist-get bookmark :url)))) -(defvar eww-bookmark-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [(control k)] 'eww-bookmark-kill) - (define-key map [(control y)] 'eww-bookmark-yank) - (define-key map "\r" 'eww-bookmark-browse) - - (easy-menu-define nil map - "Menu for `eww-bookmark-mode-map'." - '("Eww Bookmark" - ["Exit" quit-window t] - ["Browse" eww-bookmark-browse - :active (get-text-property (line-beginning-position) 'eww-bookmark)] - ["Kill" eww-bookmark-kill - :active (get-text-property (line-beginning-position) 'eww-bookmark)] - ["Yank" eww-bookmark-yank - :active eww-bookmark-kill-ring])) - map)) +(defvar-keymap eww-bookmark-mode-map + [(control k)] #'eww-bookmark-kill + [(control y)] #'eww-bookmark-yank + "\r" #'eww-bookmark-browse + :menu '("Eww Bookmark" + ["Exit" quit-window t] + ["Browse" eww-bookmark-browse + :active (get-text-property (line-beginning-position) 'eww-bookmark)] + ["Kill" eww-bookmark-kill + :active (get-text-property (line-beginning-position) 'eww-bookmark)] + ["Yank" eww-bookmark-yank + :active eww-bookmark-kill-ring])) (define-derived-mode eww-bookmark-mode special-mode "eww bookmarks" "Mode for listing bookmarks. @@ -2181,19 +2223,15 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (pop-to-buffer-same-window buffer))) (eww-restore-history history))) -(defvar eww-history-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\r" 'eww-history-browse) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) - - (easy-menu-define nil map - "Menu for `eww-history-mode-map'." - '("Eww History" - ["Exit" quit-window t] - ["Browse" eww-history-browse - :active (get-text-property (line-beginning-position) 'eww-history)])) - map)) +(defvar-keymap eww-history-mode-map + "\r" #'eww-history-browse + "n" #'next-line + "p" #'previous-line + :menu '("Eww History" + ["Exit" quit-window t] + ["Browse" eww-history-browse + :active (get-text-property (line-beginning-position) + 'eww-history)])) (define-derived-mode eww-history-mode special-mode "eww history" "Mode for listing eww-histories. @@ -2304,22 +2342,18 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (forward-line -1)) (eww-buffer-show)) -(defvar eww-buffers-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [(control k)] 'eww-buffer-kill) - (define-key map "\r" 'eww-buffer-select) - (define-key map "n" 'eww-buffer-show-next) - (define-key map "p" 'eww-buffer-show-previous) - - (easy-menu-define nil map - "Menu for `eww-buffers-mode-map'." - '("Eww Buffers" - ["Exit" quit-window t] - ["Select" eww-buffer-select - :active (get-text-property (line-beginning-position) 'eww-buffer)] - ["Kill" eww-buffer-kill - :active (get-text-property (line-beginning-position) 'eww-buffer)])) - map)) +(defvar-keymap eww-buffers-mode-map + [(control k)] #'eww-buffer-kill + "\r" #'eww-buffer-select + "n" #'eww-buffer-show-next + "p" #'eww-buffer-show-previous + :menu '("Eww Buffers" + ["Exit" quit-window t] + ["Select" eww-buffer-select + :active (get-text-property (line-beginning-position) 'eww-buffer)] + ["Kill" eww-buffer-kill + :active (get-text-property (line-beginning-position) + 'eww-buffer)])) (define-derived-mode eww-buffers-mode special-mode "eww buffers" "Mode for listing buffers. diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index 5af6d4324ae..5778857ff80 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -37,6 +37,7 @@ a string and return a digest of it (in binary form). B is a byte length of a block size of H. (B=64 for both SHA1 and MD5.) L is a byte length of hash outputs. (L=16 for MD5, L=20 for SHA1.) If BIT is non-nil, truncate output to specified bits." + (declare (indent defun)) `(defun ,name (text key) ,(concat "Compute " (upcase (symbol-name name)) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 83d0eeef9f1..df6bdd1aba5 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -423,14 +423,6 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (interactive (list nil t)) (when (or (not mailcap-parsed-p) force) - ;; Clear out all old data. - (setq mailcap--computed-mime-data nil) - ;; Add the Emacs-distributed defaults (which will be used as - ;; fallbacks). Do it this way instead of just copying the list, - ;; since entries are destructively modified. - (cl-loop for (major . minors) in mailcap-mime-data - do (cl-loop for (minor . entry) in minors - do (mailcap-add-mailcap-entry major minor entry))) (cond (path nil) ((getenv "MAILCAPS") @@ -447,18 +439,29 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus ("/etc/mailcap" system) ("/usr/etc/mailcap" system) ("/usr/local/etc/mailcap" system))))) - ;; The ~/.mailcap entries will end up first in the resulting data. - (dolist (spec (reverse - (if (stringp path) - (split-string path path-separator t) - path))) - (let ((source (and (consp spec) (cadr spec))) - (file-name (if (stringp spec) - spec - (car spec)))) - (when (and (file-readable-p file-name) - (file-regular-p file-name)) - (mailcap-parse-mailcap file-name source)))) + (when (seq-some (lambda (f) + (file-has-changed-p (car f) 'mail-parse-mailcaps)) + path) + ;; Clear out all old data. + (setq mailcap--computed-mime-data nil) + ;; Add the Emacs-distributed defaults (which will be used as + ;; fallbacks). Do it this way instead of just copying the list, + ;; since entries are destructively modified. + (cl-loop for (major . minors) in mailcap-mime-data + do (cl-loop for (minor . entry) in minors + do (mailcap-add-mailcap-entry major minor entry))) + ;; The ~/.mailcap entries will end up first in the resulting data. + (dolist (spec (reverse + (if (stringp path) + (split-string path path-separator t) + path))) + (let ((source (and (consp spec) (cadr spec))) + (file-name (if (stringp spec) + spec + (car spec)))) + (when (and (file-readable-p file-name) + (file-regular-p file-name)) + (mailcap-parse-mailcap file-name source))))) (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname &optional source) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index f33272fad85..cb8ee73c14c 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -247,23 +247,21 @@ and other things: (defvar shr-target-id nil "Target fragment identifier anchor.") -(defvar shr-map - (let ((map (make-sparse-keymap))) - (define-key map "a" #'shr-show-alt-text) - (define-key map "i" #'shr-browse-image) - (define-key map "z" #'shr-zoom-image) - (define-key map [?\t] #'shr-next-link) - (define-key map [?\M-\t] #'shr-previous-link) - (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] #'shr-browse-url) - (define-key map [C-down-mouse-1] #'shr-mouse-browse-url-new-window) - (define-key map "I" #'shr-insert-image) - (define-key map "w" #'shr-maybe-probe-and-copy-url) - (define-key map "u" #'shr-maybe-probe-and-copy-url) - (define-key map "v" #'shr-browse-url) - (define-key map "O" #'shr-save-contents) - (define-key map "\r" #'shr-browse-url) - map)) +(defvar-keymap shr-map + "a" #'shr-show-alt-text + "i" #'shr-browse-image + "z" #'shr-zoom-image + [?\t] #'shr-next-link + [?\M-\t] #'shr-previous-link + [follow-link] 'mouse-face + [mouse-2] #'shr-browse-url + [C-down-mouse-1] #'shr-mouse-browse-url-new-window + "I" #'shr-insert-image + "w" #'shr-maybe-probe-and-copy-url + "u" #'shr-maybe-probe-and-copy-url + "v" #'shr-browse-url + "O" #'shr-save-contents + "\r" #'shr-browse-url) (defvar shr-image-map (let ((map (copy-keymap shr-map))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6f3b3245225..62921909406 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2494,9 +2494,14 @@ The method used must be an out-of-band method." (with-tramp-progress-reporter v 0 (format "Uncompressing %s" file) (when (tramp-send-command-and-check - v (concat (nth 2 suffix) " " - (tramp-shell-quote-argument localname))) - (dired-remove-file file) + v (if (string-match-p "%[io]" (nth 2 suffix)) + (replace-regexp-in-string + "%i" (tramp-shell-quote-argument localname) + (nth 2 suffix)) + (concat (nth 2 suffix) " " + (tramp-shell-quote-argument localname)))) + (unless (string-match-p "\\.tar\\.gz" file) + (dired-remove-file file)) (string-match (car suffix) file) (concat (substring file 0 (match-beginning 0)))))) (t @@ -2504,14 +2509,21 @@ The method used must be an out-of-band method." ;; Try gzip. (with-tramp-progress-reporter v 0 (format "Compressing %s" file) (when (tramp-send-command-and-check - v (concat "gzip -f " - (tramp-shell-quote-argument localname))) - (dired-remove-file file) - (cond ((file-exists-p (concat file ".gz")) - (concat file ".gz")) - ((file-exists-p (concat file ".z")) - (concat file ".z")) - (t nil))))))))) + v (if (file-directory-p file) + (format "tar -cf - %s | gzip -c9 > %s.tar.gz" + (tramp-shell-quote-argument + (file-name-nondirectory localname)) + (tramp-shell-quote-argument localname)) + (concat "gzip -f " + (tramp-shell-quote-argument localname)))) + (unless (file-directory-p file) + (dired-remove-file file)) + (catch 'found nil + (dolist (target (mapcar (lambda (suffix) + (concat file suffix)) + '(".tar.gz" ".gz" ".z"))) + (when (file-exists-p target) + (throw 'found target))))))))))) (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el index 619bc06122b..0dba366192e 100644 --- a/lisp/obsolete/cl-compat.el +++ b/lisp/obsolete/cl-compat.el @@ -52,6 +52,7 @@ ;;; Keyword routines not supported by new package. (defmacro defkeyword (x &optional doc) + (declare (indent defun)) (cl-list* 'defconst x (list 'quote x) (and doc (list doc)))) (defun keyword-of (sym) diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el index 9df62318572..a892ed7c76b 100644 --- a/lisp/obsolete/cl.el +++ b/lisp/obsolete/cl.el @@ -513,7 +513,8 @@ a temporary-variables list, a value-forms list, a store-variables list See `gv-define-expander', and `gv-define-setter' for better and simpler ways to define setf-methods." (declare (debug - (&define name cl-lambda-list cl-declarations-or-string def-body))) + (&define name cl-lambda-list cl-declarations-or-string def-body)) + (indent defun)) `(progn ,@(if (stringp (car body)) (list `(put ',name 'setf-documentation ,(pop body)))) @@ -554,7 +555,8 @@ You can replace this form with `gv-define-setter'. (&define name [&or [symbolp &optional stringp] [cl-lambda-list (symbolp)]] - cl-declarations-or-string def-body))) + cl-declarations-or-string def-body)) + (indent defun)) (if (and (listp arg1) (consp args)) ;; Like `gv-define-setter' but with `cl-function'. `(gv-define-expander ,name @@ -615,7 +617,8 @@ arguments from ARGLIST using FUNC. For example: You can replace this macro with `gv-letplace'." (declare (debug (&define name cl-lambda-list ;; should exclude &key - symbolp &optional stringp))) + symbolp &optional stringp)) + (indent defun)) (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) (require 'cl-macs) ;For cl--arglist-args. diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el index 69bf3ed12bc..ccf9aaa2b6a 100644 --- a/lisp/obsolete/crisp.el +++ b/lisp/obsolete/crisp.el @@ -231,27 +231,13 @@ does not load the scroll-all package." ;; The cut and paste routines are different between XEmacs and Emacs ;; so we need to set up aliases for the functions. - -(defalias 'crisp-set-clipboard - (if (fboundp 'clipboard-kill-ring-save) - 'clipboard-kill-ring-save - 'copy-primary-selection)) - -(defalias 'crisp-kill-region - (if (fboundp 'clipboard-kill-region) - 'clipboard-kill-region - 'kill-primary-selection)) - -(defalias 'crisp-yank-clipboard - (if (fboundp 'clipboard-yank) - 'clipboard-yank - 'yank-clipboard-selection)) +(defalias 'crisp-set-clipboard 'clipboard-kill-ring-save) +(defalias 'crisp-kill-region 'clipboard-kill-region) +(defalias 'crisp-yank-clipboard 'clipboard-yank) (defun crisp-region-active () "Compatibility function to test for an active region." - (if (featurep 'xemacs) - zmacs-region-active-p - mark-active)) + mark-active) (defun crisp-version (&optional arg) "Version number of the CRiSP emulator package. diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el index 187879ce2f7..51a6780d903 100644 --- a/lisp/obsolete/eudcb-ph.el +++ b/lisp/obsolete/eudcb-ph.el @@ -176,9 +176,7 @@ SERVER is either a string naming the server or a list (NAME PORT)." (setq eudc-ph-process-buffer (get-buffer-create (format " *PH-%s*" host))) (with-current-buffer eudc-ph-process-buffer (erase-buffer) - (setq eudc-ph-read-point (point)) - (and (featurep 'xemacs) (featurep 'mule) - (set-buffer-file-coding-system 'binary t))) + (setq eudc-ph-read-point (point))) (setq process (open-network-stream "ph" eudc-ph-process-buffer host port)) (if (null process) (throw 'done nil)) diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index 960233d5627..1dee7120c0e 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -283,10 +283,7 @@ If a number, only buffers greater than this size have processing messages." (other :tag "always" t) (integer :tag "size"))) -(defvar fast-lock-save-faces - (when (featurep 'xemacs) - ;; XEmacs uses extents for everything, so we have to pick the right ones. - font-lock-face-list) +(defvar fast-lock-save-faces nil "Faces that will be saved in a Font Lock cache file. If nil, means information for all faces will be saved.") @@ -707,35 +704,7 @@ See `fast-lock-get-face-properties'." (while regions (add-text-properties (nth 0 regions) (nth 1 regions) plist) (setq regions (nthcdr 2 regions)))))))) - -;; Functions for XEmacs: - -(unless (boundp 'font-lock-syntactic-keywords) - (defvar font-lock-syntactic-keywords nil)) - -(unless (boundp 'font-lock-inhibit-thing-lock) - (defvar font-lock-inhibit-thing-lock nil)) - -(unless (fboundp 'font-lock-compile-keywords) - (defalias 'font-lock-compile-keywords #'identity)) - -(unless (fboundp 'font-lock-eval-keywords) - (defun font-lock-eval-keywords (keywords) - (if (symbolp keywords) - (font-lock-eval-keywords (if (fboundp keywords) - (funcall keywords) - (eval keywords t))) - keywords))) - -(unless (fboundp 'font-lock-value-in-major-mode) - (defun font-lock-value-in-major-mode (alist) - (if (consp alist) - (cdr (or (assq major-mode alist) (assq t alist))) - alist))) - -(unless (fboundp 'current-message) - (defun current-message () - "")) + ;; Install ourselves: diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index a630baf3543..807f5485d5f 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -977,17 +977,7 @@ Return the modified list with the last element prepended to it." (set-buffer buf)) (with-output-to-temp-buffer temp-buf - (if (featurep 'xemacs) - - ;; XEmacs extents are put on by default, doesn't seem to be - ;; any way of switching them off. - (display-completion-list (or iswitchb-matches iswitchb-buflist) - :help-string "iswitchb " - :activate-callback - (lambda (_x _y _z) - (message "doesn't work yet, sorry!"))) - ;; else running Emacs - (display-completion-list (or iswitchb-matches iswitchb-buflist)))) + (display-completion-list (or iswitchb-matches iswitchb-buflist))) (setq iswitchb-common-match-inserted nil)))) ;;; KILL CURRENT BUFFER @@ -1326,9 +1316,7 @@ This is an example function which can be hooked on to "Return non-nil if we should ignore case when matching. See the variable `iswitchb-case' for details." (if iswitchb-case - (if (featurep 'xemacs) - (isearch-no-upper-case-p iswitchb-text) - (isearch-no-upper-case-p iswitchb-text t)))) + (isearch-no-upper-case-p iswitchb-text t))) ;;;###autoload (define-minor-mode iswitchb-mode diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el index 47f5089452f..a71d2b82e4c 100644 --- a/lisp/obsolete/otodo-mode.el +++ b/lisp/obsolete/otodo-mode.el @@ -908,8 +908,7 @@ If INCLUDE-SEP is non-nil, return point after the separator." ;;;###autoload (define-derived-mode todo-mode nil "TODO" "Major mode for editing TODO lists." - (when (featurep 'xemacs) - (easy-menu-add todo-menu))) + nil) (with-suppressed-warnings ((lexical date entry)) (defvar date) diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el index 2c76365a415..3e4c216abef 100644 --- a/lisp/obsolete/pgg-parse.el +++ b/lisp/obsolete/pgg-parse.el @@ -496,8 +496,7 @@ (defun pgg-parse-armor (string) (with-temp-buffer (buffer-disable-undo) - (unless (featurep 'xemacs) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (insert string) (pgg-decode-armor-region (point-min)(point)))) diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el index 5ed59933f23..127e1dc15c0 100644 --- a/lisp/obsolete/pgg.el +++ b/lisp/obsolete/pgg.el @@ -376,8 +376,7 @@ signer's public key from `pgg-default-keyserver-address'." (if (null signature) nil (with-temp-buffer (buffer-disable-undo) - (unless (featurep 'xemacs) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (insert-file-contents signature) (cdr (assq 2 (pgg-decode-armor-region (point-min)(point-max))))))) diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el index e0e89c390ea..b59fb8c868c 100644 --- a/lisp/obsolete/tpu-edt.el +++ b/lisp/obsolete/tpu-edt.el @@ -650,12 +650,8 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.") (setq tpu-mark-flag (if transient-mark-mode "" (if (tpu-mark) " @" " "))) (force-mode-line-update)) -(cond ((featurep 'xemacs) - (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line) - (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line)) - (t - (add-hook 'activate-mark-hook 'tpu-update-mode-line) - (add-hook 'deactivate-mark-hook 'tpu-update-mode-line))) +(add-hook 'activate-mark-hook 'tpu-update-mode-line) +(add-hook 'deactivate-mark-hook 'tpu-update-mode-line) ;;; @@ -727,15 +723,13 @@ Otherwise sets the tpu-match markers to nil and returns nil." "TPU-edt version of the mark function. Return the appropriate value of the mark for the current version of Emacs." - (cond ((featurep 'xemacs) (mark (not zmacs-regions))) - (t (and mark-active (mark (not transient-mark-mode)))))) + (and mark-active (mark (not transient-mark-mode)))) (defun tpu-set-mark (pos) "TPU-edt version of the `set-mark' function. Sets the mark at POS and activates the region according to the current version of Emacs." - (set-mark pos) - (when (featurep 'xemacs) (when pos (zmacs-activate-region)))) + (set-mark pos)) (defun tpu-string-prompt (prompt history-symbol) "Read a string with PROMPT." @@ -2306,17 +2300,14 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." ;;; (defun tpu-load-xkeys (file) "Load the TPU-edt X-windows key definitions FILE. -If FILE is nil, try to load a default file. The default file names are -`~/.tpu-lucid-keys' for XEmacs, and `~/.tpu-keys' for Emacs." +If FILE is nil, try to load a default file. The default file name is +`~/.tpu-keys'." (interactive "fX key definition file: ") (cond (file (setq file (expand-file-name file))) (tpu-xkeys-file (setq file (expand-file-name tpu-xkeys-file))) - ((featurep 'xemacs) - (setq file (convert-standard-filename - (expand-file-name "~/.tpu-lucid-keys")))) - (t + (t (setq file (convert-standard-filename (expand-file-name "~/.tpu-keys"))) (and (not (file-exists-p file)) diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el index 5ae0a6558d5..02ba3632504 100644 --- a/lisp/obsolete/tpu-mapper.el +++ b/lisp/obsolete/tpu-mapper.el @@ -46,24 +46,14 @@ ;;; (defun tpu-map-key (ident descrip func gold-func) (interactive) - (if (featurep 'xemacs) - (progn - (setq tpu-key-seq (read-key-sequence - (format "Press %s%s: " ident descrip)) - tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0)))) - (unless (equal tpu-key tpu-return) - (set-buffer "Keys") - (insert (format"(global-set-key %s %s)\n" tpu-key func)) - (set-buffer "Gold-Keys") - (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)))) - (message "Press %s%s: " ident descrip) - (setq tpu-key-seq (read-event) - tpu-key (format "[%s]" tpu-key-seq)) - (unless (equal tpu-key tpu-return) - (set-buffer "Keys") - (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func)) - (set-buffer "Gold-Keys") - (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)))) + (message "Press %s%s: " ident descrip) + (setq tpu-key-seq (read-event) + tpu-key (format "[%s]" tpu-key-seq)) + (unless (equal tpu-key tpu-return) + (set-buffer "Keys") + (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func)) + (set-buffer "Gold-Keys") + (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))) (set-buffer "Directions") tpu-key) @@ -103,8 +93,7 @@ your local X guru can try to figure out why the key is being ignored." ;; Make sure the window is big enough to display the instructions - (if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36) - (set-frame-size (selected-frame) 80 36)) + (set-frame-size (selected-frame) 80 36) ;; Create buffers - Directions, Keys, Gold-Keys @@ -162,14 +151,9 @@ your local X guru can try to figure out why the key is being ignored." ;; Save <CR> for future reference - (cond - ((featurep 'xemacs) - (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) - (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) - (t - (message "Hit carriage-return <CR> to continue ") - (setq tpu-return-seq (read-event)) - (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")))) + (message "Hit carriage-return <CR> to continue ") + (setq tpu-return-seq (read-event)) + (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")) ;; Build the keymap file @@ -308,24 +292,14 @@ your local X guru can try to figure out why the key is being ignored." ;; ") - (cond ((featurep 'xemacs) - (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) - (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) - (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n") - (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n") - (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n") - (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n")) - (t - (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) + (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)) (append-to-buffer "Keys" 1 (point)) (set-buffer "Keys") ;; Save the key mapping program - (let ((file - (convert-standard-filename - (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys")))) + (let ((file (convert-standard-filename "~/.tpu-keys"))) (set-visited-file-name (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) (save-buffer) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index a9350c58d52..1756b34fc5b 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1815,10 +1815,13 @@ by their respective `org-store-link-plist' properties if present." ;; Load history list for current prompt. (setq org-capture--prompt-history (gethash prompt org-capture--prompt-history-table)) - (push (org-completing-read - (concat (or prompt "Enter string") - (and default (format " [%s]" default)) - ": ") + (push (org-completing-read + ;; `format-prompt' is new in Emacs 28.1. + (if (fboundp 'format-prompt) + (format-prompt (or prompt "Enter string") default) + (concat (or prompt "Enter string") + (and default (format " [%s]" default)) + ": ")) completions nil nil nil 'org-capture--prompt-history default) strings) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 678759e10db..73eaad6bf52 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -640,11 +640,13 @@ this function appends the default value from org-refile-target-table)) (completion-ignore-case t) cdef - (prompt (concat prompt - (or (and (car org-refile-history) - (concat " (default " (car org-refile-history) ")")) - (and (assoc cbnex tbl) (setq cdef cbnex) - (concat " (default " cbnex ")"))) ": ")) + (prompt (let ((default (or (car org-refile-history) + (and (assoc cbnex tbl) (setq cdef cbnex) + cbnex)))) + ;; `format-prompt' is new in Emacs 28.1. + (if (fboundp 'format-prompt) + (format-prompt prompt default) + (concat prompt " (default " default ": ")))) pa answ parent-target child parent old-hist) (setq old-hist org-refile-history) (setq answ (funcall cfunc prompt tbl nil (not new-nodes) diff --git a/lisp/outline.el b/lisp/outline.el index 52a94b4d9f4..5b20a42c97b 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -35,6 +35,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup outlines nil "Support for hierarchical outlining." :prefix "outline-" @@ -272,6 +274,21 @@ in the file it applies to.") (defvar outline-font-lock-faces [outline-1 outline-2 outline-3 outline-4 outline-5 outline-6 outline-7 outline-8]) + +(defcustom outline-minor-mode-use-buttons nil + "If non-nil, use clickable buttons on the headings. +The `outline-minor-mode-buttons' variable specifies how the +buttons should look." + :type 'boolean + :version "29.1") + +(defcustom outline-minor-mode-buttons + '(("▶️" "🔽" outline--valid-emoji-p) + ("▶" "▼" outline--valid-char-p)) + "List of close/open pairs to use if using buttons." + :type 'sexp + :version "29.1") + (defvar outline-level #'outline-level "Function of no args to compute a header's nesting level in an outline. @@ -388,6 +405,8 @@ faces to major mode's faces." (goto-char (match-beginning 0)) (not (get-text-property (point) 'face)))) (overlay-put overlay 'face (outline-font-lock-face))) + (when outline-minor-mode-use-buttons + (outline--insert-open-button)) (when outline-minor-mode-cycle (overlay-put overlay 'keymap outline-minor-mode-cycle-map))) (goto-char (match-end 0)))))) @@ -923,11 +942,74 @@ Note that this does not hide the lines preceding the first heading line." (define-obsolete-function-alias 'show-all #'outline-show-all "25.1") -(defun outline-hide-subtree () - "Hide everything after this heading at deeper levels." - (interactive) +(defun outline-hide-subtree (&optional event) + "Hide everything after this heading at deeper levels. +If non-nil, EVENT should be a mouse event." + (interactive (list last-nonmenu-event)) + (when (mouse-event-p event) + (mouse-set-point event)) + (when (and outline-minor-mode-use-buttons outline-minor-mode) + (outline--insert-close-button)) (outline-flag-subtree t)) +(defun outline--make-button (type) + (cl-loop for (close open test) in outline-minor-mode-buttons + when (and (funcall test close) (funcall test open)) + return (concat (if (eq type 'close) + close + open) + " " (buffer-substring (point) (1+ (point)))))) + +(defun outline--valid-emoji-p (string) + (when-let ((font (and (display-multi-font-p) + (car (internal-char-font nil ?😀))))) + (font-has-char-p font (aref string 0)))) + +(defun outline--valid-char-p (string) + (char-displayable-p (aref string 0))) + +(defun outline--make-button-overlay (type) + (let ((o (seq-find (lambda (o) + (overlay-get o 'outline-button)) + (overlays-at (point))))) + (unless o + (setq o (make-overlay (point) (1+ (point)))) + (overlay-put o 'follow-link 'mouse-face) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'outline-button t)) + (overlay-put o 'display (outline--make-button type)) + o)) + +(defun outline--insert-open-button () + (save-excursion + (beginning-of-line) + (let ((o (outline--make-button-overlay 'open))) + (overlay-put o 'help-echo "Click to hide") + (overlay-put o 'keymap + (define-keymap + :parent outline-minor-mode-cycle-map + ["RET"] #'outline-hide-subtree + ["<mouse-2>"] #'outline-hide-subtree))))) + +(defun outline--insert-close-button () + (save-excursion + (beginning-of-line) + (let ((o (outline--make-button-overlay 'close))) + (overlay-put o 'help-echo "Click to show") + (overlay-put o 'keymap + (define-keymap + :parent outline-minor-mode-cycle-map + ["RET"] #'outline-show-subtree + ["<mouse-2>"] #'outline-show-subtree))))) + +(defun outline--fix-up-all-buttons () + (outline-map-region + (lambda () + (if (eq (outline--cycle-state) 'show-all) + (outline--insert-open-button) + (outline--insert-close-button))) + (point-min) (point-max))) + (define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1") (defun outline-hide-leaves () @@ -943,9 +1025,13 @@ Note that this does not hide the lines preceding the first heading line." (define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1") -(defun outline-show-subtree () +(defun outline-show-subtree (&optional event) "Show everything after this heading at deeper levels." - (interactive) + (interactive (list last-nonmenu-event)) + (when (mouse-event-p event) + (mouse-set-point event)) + (when (and outline-minor-mode-use-buttons outline-minor-mode) + (outline--insert-open-button)) (outline-flag-subtree nil)) (define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1") @@ -1295,7 +1381,9 @@ Return either 'hide-all, 'headings-only, or 'show-all." (t (outline-show-all) (setq outline--cycle-buffer-state 'show-all) - (message "Show all"))))) + (message "Show all"))) + (when outline-minor-mode-use-buttons + (outline--fix-up-all-buttons)))) (defvar outline-navigation-repeat-map (let ((map (make-sparse-keymap))) diff --git a/lisp/paren.el b/lisp/paren.el index ce6aa9ae13b..7e7cf6c262a 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -88,6 +88,14 @@ is not highlighted, the cursor being regarded as adequate to mark its position." :type 'boolean) +(defcustom show-paren-context-when-offscreen nil + "If non-nil, show context in the echo area when the openparen is offscreen. +The context is usually the line that contains the openparen, +except if the openparen is on its own line, in which case the +context includes the previous nonblank line." + :type 'boolean + :version "29.1") + (defvar show-paren--idle-timer nil) (defvar show-paren--overlay (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) @@ -312,6 +320,19 @@ It is the default value of `show-paren-data-function'." (current-buffer)) (move-overlay show-paren--overlay there-beg there-end (current-buffer))) + ;; If `show-paren-open-line-when-offscreen' is t and point + ;; is at a close paren, show the line that contains the + ;; openparen in the echo area. + (let ((openparen (min here-beg there-beg))) + (if (and show-paren-context-when-offscreen + (< there-beg here-beg) + (not (pos-visible-in-window-p openparen))) + (let ((open-paren-line-string + (blink-paren-open-paren-line-string openparen)) + (message-log-max nil)) + (minibuffer-message + "Matches %s" + (substring-no-properties open-paren-line-string))))) ;; Always set the overlay face, since it varies. (overlay-put show-paren--overlay 'priority show-paren-priority) (overlay-put show-paren--overlay 'face face)))))) diff --git a/lisp/proced.el b/lisp/proced.el index fec2a29c847..e959e91c6e2 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -658,6 +658,7 @@ After displaying or updating a Proced buffer, Proced runs the normal hook `proced-post-display-hook'. \\{proced-mode-map}" + :interactive nil (abbrev-mode 0) (auto-fill-mode 0) (setq buffer-read-only t @@ -721,7 +722,7 @@ Proced buffers." With prefix ARG, update this buffer automatically if ARG is positive, otherwise do not update. Sets the variable `proced-auto-update-flag'. The time interval for updates is specified via `proced-auto-update-interval'." - (interactive (list (or current-prefix-arg 'toggle))) + (interactive (list (or current-prefix-arg 'toggle)) proced-mode) (setq proced-auto-update-flag (cond ((eq arg 'toggle) (not proced-auto-update-flag)) (arg (> (prefix-numeric-value arg) 0)) @@ -733,19 +734,19 @@ The time interval for updates is specified via `proced-auto-update-interval'." (defun proced-mark (&optional count) "Mark the current (or next COUNT) processes." - (interactive "p") + (interactive "p" proced-mode) (proced-do-mark t count)) (defun proced-unmark (&optional count) "Unmark the current (or next COUNT) processes." - (interactive "p") + (interactive "p" proced-mode) (proced-do-mark nil count)) (defun proced-unmark-backward (&optional count) "Unmark the previous (or COUNT previous) processes." ;; Analogous to `dired-unmark-backward', ;; but `ibuffer-unmark-backward' behaves different. - (interactive "p") + (interactive "p" proced-mode) (proced-do-mark nil (- (or count 1)))) (defun proced-do-mark (mark &optional count) @@ -762,7 +763,7 @@ The time interval for updates is specified via `proced-auto-update-interval'." (defun proced-toggle-marks () "Toggle marks: marked processes become unmarked, and vice versa." - (interactive) + (interactive nil proced-mode) (let ((mark-re (proced-marker-regexp)) buffer-read-only) (save-excursion @@ -788,14 +789,14 @@ Otherwise move one line forward after inserting the mark." "Mark all processes. If `transient-mark-mode' is turned on and the region is active, mark the region." - (interactive) + (interactive nil proced-mode) (proced-do-mark-all t)) (defun proced-unmark-all () "Unmark all processes. If `transient-mark-mode' is turned on and the region is active, unmark the region." - (interactive) + (interactive nil proced-mode) (proced-do-mark-all nil)) (defun proced-do-mark-all (mark) @@ -830,14 +831,14 @@ mark the region." (defun proced-mark-children (ppid &optional omit-ppid) "Mark child processes of process PPID. Also mark process PPID unless prefix OMIT-PPID is non-nil." - (interactive (list (proced-pid-at-point) current-prefix-arg)) + (interactive (list (proced-pid-at-point) current-prefix-arg) proced-mode) (proced-mark-process-alist (proced-filter-children proced-process-alist ppid omit-ppid))) (defun proced-mark-parents (cpid &optional omit-cpid) "Mark parent processes of process CPID. Also mark CPID unless prefix OMIT-CPID is non-nil." - (interactive (list (proced-pid-at-point) current-prefix-arg)) + (interactive (list (proced-pid-at-point) current-prefix-arg) proced-mode) (proced-mark-process-alist (proced-filter-parents proced-process-alist cpid omit-cpid))) @@ -870,7 +871,7 @@ If `transient-mark-mode' is turned on and the region is active, omit the processes in region. If QUIET is non-nil suppress status message. Returns count of omitted lines." - (interactive "P") + (interactive "P" proced-mode) (let ((mark-re (proced-marker-regexp)) (count 0) buffer-read-only) @@ -947,7 +948,8 @@ Set variable `proced-filter' to SCHEME. Revert listing." (interactive (let ((scheme (completing-read "Filter: " proced-filter-alist nil t))) - (list (if (string= "" scheme) nil (intern scheme))))) + (list (if (string= "" scheme) nil (intern scheme)))) + proced-mode) ;; only update if necessary (unless (eq proced-filter scheme) (setq proced-filter scheme) @@ -1057,7 +1059,7 @@ Each parent process is followed by its child processes. The process tree inherits the chosen sorting order of the process listing, that is, child processes of the same parent process are sorted using the selected sorting order." - (interactive (list (or current-prefix-arg 'toggle))) + (interactive (list (or current-prefix-arg 'toggle)) proced-mode) (setq proced-tree-flag (cond ((eq arg 'toggle) (not proced-tree-flag)) (arg (> (prefix-numeric-value arg) 0)) @@ -1140,7 +1142,7 @@ This command refines an already existing process listing generated initially based on the value of the variable `proced-filter'. It does not change this variable. It does not revert the listing. If you frequently need a certain refinement, consider defining a new filter in `proced-filter-alist'." - (interactive (list last-input-event)) + (interactive (list last-input-event) proced-mode) (if event (posn-set-point (event-end event))) (let ((key (get-text-property (point) 'proced-key)) (pid (get-text-property (point) 'proced-pid))) @@ -1269,7 +1271,8 @@ in the mode line, using \"+\" or \"-\" for ascending or descending order." nil t))) (list (if (string= "" scheme) nil (intern scheme)) ;; like 'toggle in `define-derived-mode' - (or current-prefix-arg 'no-arg)))) + (or current-prefix-arg 'no-arg))) + proced-mode) (setq proced-descend ;; If `proced-sort-interactive' is called repeatedly for the same @@ -1290,37 +1293,37 @@ in the mode line, using \"+\" or \"-\" for ascending or descending order." (defun proced-sort-pcpu (&optional arg) "Sort Proced buffer by percentage CPU time (%CPU). Prefix ARG controls sort order, see `proced-sort-interactive'." - (interactive (list (or current-prefix-arg 'no-arg))) + (interactive (list (or current-prefix-arg 'no-arg)) proced-mode) (proced-sort-interactive 'pcpu arg)) (defun proced-sort-pmem (&optional arg) "Sort Proced buffer by percentage memory usage (%MEM). Prefix ARG controls sort order, see `proced-sort-interactive'." - (interactive (list (or current-prefix-arg 'no-arg))) + (interactive (list (or current-prefix-arg 'no-arg)) proced-mode) (proced-sort-interactive 'pmem arg)) (defun proced-sort-pid (&optional arg) "Sort Proced buffer by PID. Prefix ARG controls sort order, see `proced-sort-interactive'." - (interactive (list (or current-prefix-arg 'no-arg))) + (interactive (list (or current-prefix-arg 'no-arg)) proced-mode) (proced-sort-interactive 'pid arg)) (defun proced-sort-start (&optional arg) "Sort Proced buffer by time the command started (START). Prefix ARG controls sort order, see `proced-sort-interactive'." - (interactive (list (or current-prefix-arg 'no-arg))) + (interactive (list (or current-prefix-arg 'no-arg)) proced-mode) (proced-sort-interactive 'start arg)) (defun proced-sort-time (&optional arg) "Sort Proced buffer by CPU time (TIME). Prefix ARG controls sort order, see `proced-sort-interactive'." - (interactive (list (or current-prefix-arg 'no-arg))) + (interactive (list (or current-prefix-arg 'no-arg)) proced-mode) (proced-sort-interactive 'time arg)) (defun proced-sort-user (&optional arg) "Sort Proced buffer by USER. Prefix ARG controls sort order, see `proced-sort-interactive'." - (interactive (list (or current-prefix-arg 'no-arg))) + (interactive (list (or current-prefix-arg 'no-arg)) proced-mode) (proced-sort-interactive 'user arg)) (defun proced-sort-header (event &optional arg) @@ -1329,7 +1332,7 @@ EVENT is a mouse event with starting position in the header line. It is converted to the corresponding attribute key. This command updates the variable `proced-sort'. Prefix ARG controls sort order, see `proced-sort-interactive'." - (interactive (list last-input-event (or last-prefix-arg 'no-arg))) + (interactive (list last-input-event (or last-prefix-arg 'no-arg)) proced-mode) (let ((start (event-start event)) col key) (save-selected-window @@ -1534,7 +1537,8 @@ With prefix REVERT non-nil revert listing." (let ((scheme (completing-read "Format: " proced-format-alist nil t))) (list (if (string= "" scheme) nil (intern scheme)) - current-prefix-arg))) + current-prefix-arg)) + proced-mode) ;; only update if necessary (when (or (not (eq proced-format scheme)) revert) (setq proced-format scheme) @@ -1566,7 +1570,7 @@ Suppress status information if QUIET is nil. After updating a displayed Proced buffer run the normal hook `proced-post-display-hook'." ;; This is the main function that generates and updates the process listing. - (interactive "P") + (interactive "P" proced-mode) (setq revert (or revert (not proced-process-alist))) (or quiet (message (if revert "Updating process information..." "Updating process display..."))) @@ -1772,11 +1776,12 @@ supported but discouraged. It will be removed in a future version of Emacs." `(: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): ") + (list (completing-read (format-prompt "Send signal [%s]" + "TERM" pnum) proced-signal-list nil nil nil nil "TERM") - process-alist)))) + process-alist))) + proced-mode) (unless (and signal process-alist) ;; Discouraged usage (supported for backward compatibility): @@ -1797,8 +1802,8 @@ supported but discouraged. It will be removed in a future version of Emacs." `(: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): ") + (setq signal (completing-read (format-prompt "Send signal [%s]" + "TERM" pnum) proced-signal-list nil nil nil nil "TERM")))))) @@ -1861,7 +1866,8 @@ the normal hook `proced-after-send-signal-hook'." (let ((process-alist (proced-marked-processes))) (proced-with-processes-buffer process-alist (list (read-number "New priority: ") - process-alist)))) + process-alist))) + proced-mode) (if (numberp priority) (setq priority (number-to-string priority))) (let (failures) @@ -1893,7 +1899,7 @@ the normal hook `proced-after-send-signal-hook'." "Pop up a buffer with error log output from Proced. A group of errors from a single command ends with a formfeed. Thus, use \\[backward-page] to find the beginning of a group of errors." - (interactive) + (interactive nil proced-mode) (if (get-buffer proced-log-buffer) (save-selected-window ;; move `proced-log-buffer' to the front of the buffer list @@ -1945,7 +1951,7 @@ STRING is an overall summary of the failures." (defun proced-help () "Provide help for the Proced user." - (interactive) + (interactive nil proced-mode) (proced-why) (if (eq last-command 'proced-help) (describe-mode) @@ -1955,7 +1961,7 @@ STRING is an overall summary of the failures." "Undo in a Proced buffer. This doesn't recover killed processes, it just undoes changes in the Proced buffer. You can use it to recover marks." - (interactive) + (interactive nil proced-mode) (let (buffer-read-only) (undo)) (message "Change in Proced buffer undone. diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index d7b12db2211..d7092a37d44 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -269,9 +269,9 @@ via the internet it might also be http.") ;; pull/17 page if 17 is a PR. Explicit user/project#17 links to ;; possibly different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql github)) protocol) + (host-domain (_forge-type (eql 'github)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -285,9 +285,9 @@ via the internet it might also be http.") ;; namespace/project#18 or namespace/project!17 references to possibly ;; different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql gitlab)) protocol) + (host-domain (_forge-type (eql 'gitlab)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -302,9 +302,9 @@ via the internet it might also be http.") ;; Gitea: The systematics is exactly as for Github projects. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql gitea)) protocol) + (host-domain (_forge-type (eql 'gitea)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -323,7 +323,7 @@ via the internet it might also be http.") ;; repo without tracker, or a repo with a tracker using a different ;; name, etc. So we can only try to make a good guess. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql sourcehut)) protocol) + (host-domain (_forge-type (eql 'sourcehut)) protocol) `(,(concat "[/@]\\(?:git\\|hg\\)." (regexp-quote host-domain) "[/:]\\(~[.A-Za-z0-9_/-]+\\)") "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index a9a52636b78..50249728048 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1896,16 +1896,18 @@ defun." (if (< arg 0) (c-while-widening-to-decl-block (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where))) 0))) - ;; Move forward to the next opening brace.... - (when (and (= arg 0) - (progn - (c-while-widening-to-decl-block - (not (c-syntactic-re-search-forward "{" nil 'eob))) - (eq (char-before) ?{))) - (backward-char) - ;; ... and backward to the function header. - (c-beginning-of-decl-1) - t)) + (prog1 + ;; Move forward to the next opening brace.... + (when (and (= arg 0) + (progn + (c-while-widening-to-decl-block + (not (c-syntactic-re-search-forward "{" nil 'eob))) + (eq (char-before) ?{))) + (backward-char) + ;; ... and backward to the function header. + (c-beginning-of-decl-1) + t) + (c-keep-region-active))) ;; Move backward to the opening brace of a function, making successively ;; larger portions of the buffer visible as necessary. @@ -3413,7 +3415,8 @@ to call `c-scan-conditionals' directly instead." (interactive "p") (let ((new-point (c-scan-conditionals count target-depth with-else))) (push-mark) - (goto-char new-point))) + (goto-char new-point)) + (c-keep-region-active)) (defun c-scan-conditionals (count &optional target-depth with-else) "Scan forward across COUNT preprocessor conditionals. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c42c95764a2..a4568bd4efc 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -165,12 +165,16 @@ (defvar c-doc-line-join-end-ch) (defvar c-syntactic-context) (defvar c-syntactic-element) +(defvar c-new-id-start) +(defvar c-new-id-end) +(defvar c-new-id-is-type) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) (cc-bytecomp-defun c-clear-string-fences) (cc-bytecomp-defun c-restore-string-fences) (cc-bytecomp-defun c-remove-string-fences) +(cc-bytecomp-defun c-fontify-new-found-type) ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. @@ -6813,21 +6817,32 @@ comment at the start of cc-engine.el for more info." (setq c-found-types (make-hash-table :test #'equal :weakness nil))) -(defun c-add-type (from to) - ;; Add the given region as a type in `c-found-types'. If the region - ;; doesn't match an existing type but there is a type which is equal - ;; to the given one except that the last character is missing, then - ;; the shorter type is removed. That's done to avoid adding all - ;; prefixes of a type as it's being entered and font locked. This - ;; doesn't cover cases like when characters are removed from a type - ;; or added in the middle. We'd need the position of point when the - ;; font locking is invoked to solve this well. +(defun c-add-type-1 (from to) + ;; Add the given region as a type in `c-found-types'. Prepare occurrences + ;; of this new type for fontification throughout the buffer. ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) (unless (gethash type c-found-types) - (remhash (substring type 0 -1) c-found-types) - (puthash type t c-found-types)))) + (puthash type t c-found-types) + (when (and (eq (string-match c-symbol-key type) 0) + (eq (match-end 0) (length type))) + (c-fontify-new-found-type type))))) + +(defun c-add-type (from to) + ;; Add the given region as a type in `c-found-types'. Also perform the + ;; actions of `c-add-type-1'. If the region is or overlaps an identifier + ;; which might be being typed in, don't record it. This is tested by + ;; checking `c-new-id-start' and `c-new-id-end'. That's done to avoid + ;; adding all prefixes of a type as it's being entered and font locked. + ;; This is a bit rough and ready, but now covers adding characters into the + ;; middle of an identifer. + ;; + ;; This function might do hidden buffer changes. + (if (and c-new-id-start c-new-id-end + (<= from c-new-id-end) (>= to c-new-id-start)) + (setq c-new-id-is-type t) + (c-add-type-1 from to))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. @@ -12087,7 +12102,10 @@ comment at the start of cc-engine.el for more info." (and (c-major-mode-is 'pike-mode) c-decl-block-key))) (while (eq braceassignp 'dontknow) - (cond ((eq (char-after) ?\;) + (cond ((or (eq (char-after) ?\;) + (save-excursion + (progn (c-backward-syntactic-ws) + (c-at-vsemi-p)))) (setq braceassignp nil)) ((and class-key (looking-at class-key)) @@ -14011,7 +14029,8 @@ comment at the start of cc-engine.el for more info." ;; clause - we assume only C++ needs it. (c-syntactic-skip-backward "^;,=" lim t)) (setq placeholder (point)) - (memq (char-before) '(?, ?= ?<))) + (and (memq (char-before) '(?, ?= ?<)) + (not (c-crosses-statement-barrier-p (point) indent-point)))) (cond ;; CASE 5D.6: Something like C++11's "using foo = <type-exp>" diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index bc0ae6cc95a..9355409b2af 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -93,10 +93,14 @@ (cc-bytecomp-defvar c-preprocessor-face-name) (cc-bytecomp-defvar c-reference-face-name) (cc-bytecomp-defvar c-block-comment-flag) +(cc-bytecomp-defvar c-type-finder-pos) +(cc-bytecomp-defvar c-inhibit-type-finder) +(cc-bytecomp-defvar c-type-finder-timer) (cc-bytecomp-defun c-fontify-recorded-types-and-refs) (cc-bytecomp-defun c-font-lock-declarators) (cc-bytecomp-defun c-font-lock-objc-method) (cc-bytecomp-defun c-font-lock-invalid-string) +(cc-bytecomp-defun c-before-context-fl-expand-region) ;; Note that font-lock in XEmacs doesn't expand face names as @@ -919,13 +923,6 @@ casts and declarations are fontified. Used on level 2 and higher." ;; This function does hidden buffer changes. ;;(message "c-font-lock-complex-decl-prepare %s %s" (point) limit) - - ;; Clear the list of found types if we start from the start of the - ;; buffer, to make it easier to get rid of misspelled types and - ;; variables that have gotten recognized as types in malformed code. - (when (bobp) - (c-clear-found-types)) - (c-skip-comments-and-strings limit) (when (< (point) limit) @@ -1605,6 +1602,175 @@ casts and declarations are fontified. Used on level 2 and higher." nil)))) +(defun c-find-types-background (start limit) + ;; Find any "found types" between START and LIMIT. Allow any such types to + ;; be entered into `c-found-types' by the action of `c-forward-name' or + ;; `c-forward-type' called from this function. This process also causes + ;; occurrences of the type to be prepared for fontification throughout the + ;; buffer. + ;; + ;; Return POINT at the end of the function. This should be at or after + ;; LIMIT, and not later than the next decl-spot after LIMIT. + ;; + ;; This function is called from the timer `c-type-finder-timer'. It may do + ;; hidden buffer changes. + (save-excursion + (save-restriction + (widen) + (goto-char start) + ;; If we're in a (possibly large) literal, skip over it. + (let ((lit-bounds (nth 2 (c-full-pp-to-literal (point))))) + (if lit-bounds + (goto-char (cdr lit-bounds)))) + (when (< (point) limit) + (let (;; o - 'decl if we're in an arglist containing declarations + ;; (but if `c-recognize-paren-inits' is set it might also be + ;; an initializer arglist); + ;; o - '<> if the arglist is of angle bracket type; + ;; o - 'arglist if it's some other arglist; + ;; o - nil, if not in an arglist at all. This includes the + ;; parenthesized condition which follows "if", "while", etc. + context + ;; A list of starting positions of possible type declarations, or of + ;; the typedef preceding one, if any. + last-cast-end + ;; The result from `c-forward-decl-or-cast-1'. + decl-or-cast + ;; The maximum of the end positions of all the checked type + ;; decl expressions in the successfully identified + ;; declarations. The position might be either before or + ;; after the syntactic whitespace following the last token + ;; in the type decl expression. + (max-type-decl-end 0) + ;; Same as `max-type-decl-*', but used when we're before + ;; `token-pos'. + (max-type-decl-end-before-token 0) + ) + (goto-char start) + (c-find-decl-spots + limit + c-decl-start-re + nil ; (eval c-maybe-decl-faces) + + (lambda (match-pos inside-macro &optional toplev) + ;; Note to maintainers: don't use `limit' inside this lambda form; + ;; c-find-decl-spots sometimes narrows to less than `limit'. + (if (and c-macro-with-semi-re + (looking-at c-macro-with-semi-re)) + ;; Don't do anything more if we're looking at something that + ;; can't start a declaration. + t + + ;; Set `context' and `c-restricted-<>-arglists'. Look for + ;; "<" for the sake of C++-style template arglists. + ;; "Ignore "(" when it's part of a control flow construct + ;; (e.g. "for ("). + (let ((got-context + (c-get-fontification-context + match-pos + (< match-pos (if inside-macro + max-type-decl-end-before-token + max-type-decl-end)) + toplev))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + + ;; In QT, "more" is an irritating keyword that expands to nothing. + ;; We skip over it to prevent recognition of "more slots: <symbol>" + ;; as a bitfield declaration. + (when (and (c-major-mode-is 'c++-mode) + (looking-at + (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) + (goto-char (match-end 1)) + (c-forward-syntactic-ws)) + + ;; Now analyze the construct. This analysis will cause + ;; `c-forward-name' and `c-forward-type' to call `c-add-type', + ;; triggering the desired recognition and fontification of + ;; these found types. + (when (not (eq context 'not-decl)) + (setq decl-or-cast + (c-forward-decl-or-cast-1 + match-pos context last-cast-end)) + + (cond + ((eq decl-or-cast 'cast) + ;; Save the position after the previous cast so we can feed + ;; it to `c-forward-decl-or-cast-1' in the next round. That + ;; helps it discover cast chains like "(a) (b) c". + (setq last-cast-end (point)) + nil) + (decl-or-cast + ;; We've found a declaration. + + ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' + ;; under the assumption that we're after the first type decl + ;; expression in the declaration now. That's not really true; + ;; we could also be after a parenthesized initializer + ;; expression in C++, but this is only used as a last resort + ;; to slant ambiguous expression/declarations, and overall + ;; it's worth the risk to occasionally fontify an expression + ;; as a declaration in an initializer expression compared to + ;; getting ambiguous things in normal function prototypes + ;; fontified as expressions. + (if inside-macro + (when (> (point) max-type-decl-end-before-token) + (setq max-type-decl-end-before-token (point))) + (when (> (point) max-type-decl-end) + (setq max-type-decl-end (point))))) + (t t)))))))) + (point)))) + +(defun c-type-finder-timer-func () + ;; A CC Mode idle timer function for finding "found types". It triggers + ;; every `c-type-finder-repeat-time' seconds and processes buffer chunks of + ;; size around `c-type-finder-chunk-size' characters, and runs for (a little + ;; over) `c-type-finder-time-slot' seconds. The types it finds are inserted + ;; into `c-found-types', and their occurrences throughout the buffer are + ;; prepared for fontification. + (when (and c-type-finder-time-slot + (boundp 'font-lock-support-mode) + (eq font-lock-support-mode 'jit-lock-mode)) + (if c-inhibit-type-finder ; No processing immediately after a GC operation. + (setq c-inhibit-type-finder nil) + (let* ((stop-time (+ (float-time) c-type-finder-time-slot)) + (buf-list (buffer-list))) + ;; One CC Mode buffer needing processing each time around this loop. + (while (and buf-list + (< (float-time) stop-time)) + ;; Cdr through BUF-LIST to find the next buffer needing processing. + (while (and buf-list + (not (with-current-buffer (car buf-list) c-type-finder-pos))) + (setq buf-list (cdr buf-list))) + (when buf-list + (with-current-buffer (car buf-list) + ;; (message "%s" (current-buffer)) ; Useful diagnostic. + (save-restriction + (widen) + ;; Process one `c-type-finder-chunk-size' chunk each time + ;; around this loop. + (while (and c-type-finder-pos + (< (float-time) stop-time)) + ;; Process one chunk per iteration. + (save-match-data + (c-save-buffer-state + (case-fold-search + (beg (marker-position c-type-finder-pos)) + (end (min (+ beg c-type-finder-chunk-size) (point-max))) + (region (c-before-context-fl-expand-region beg end))) + (setq beg (car region) + end (cdr region)) + (setq beg (max (c-find-types-background beg end) end)) + (move-marker c-type-finder-pos + (if (save-excursion (goto-char beg) (eobp)) + nil + beg)) + (when (not (marker-position c-type-finder-pos)) + (setq c-type-finder-pos nil)))))))))))) + ;; Set the timer to run again. + (setq c-type-finder-timer + (run-at-time c-type-finder-repeat-time nil #'c-type-finder-timer-func))) + (defun c-font-lock-enum-body (limit) ;; Fontify the identifiers of each enum we find by searching forward. ;; @@ -2255,6 +2421,46 @@ higher." ;; defvar will install its default value later on. (makunbound def-var))) +;; `c-re-redisplay-timer' is a timer which, when triggered, causes a +;; redisplay. +(defvar c-re-redisplay-timer nil) + +(defun c-force-redisplay (start end) + ;; Force redisplay immediately. This assumes `font-lock-support-mode' is + ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. + (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) + (setq c-re-redisplay-timer nil)) + +(defun c-fontify-new-found-type (type) + ;; Cause the fontification of TYPE, a string, wherever it occurs in the + ;; buffer. If TYPE is currently displayed in a window, cause redisplay to + ;; happen "instantaneously". These actions are done only when jit-lock-mode + ;; is active. + (when (and (boundp 'font-lock-support-mode) + (eq font-lock-support-mode 'jit-lock-mode)) + (c-save-buffer-state + ((window-boundaries + (mapcar (lambda (win) + (cons (window-start win) + (window-end win))) + (get-buffer-window-list (current-buffer) 'no-mini t))) + (target-re (concat "\\_<" type "\\_>"))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward target-re nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'fontified nil) + (dolist (win-boundary window-boundaries) + (when (and (< (match-beginning 0) (cdr win-boundary)) + (> (match-end 0) (car win-boundary)) + (c-get-char-property (match-beginning 0) 'fontified) + (not c-re-redisplay-timer)) + (setq c-re-redisplay-timer + (run-with-timer 0 nil #'c-force-redisplay + (match-beginning 0) (match-end 0))))))))))) + ;;; C. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index c9b7a95df60..f9435c9ceee 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -129,6 +129,16 @@ ; ' (require 'cc-fonts) ;) +(defvar c-type-finder-timer nil) +;; The variable which holds the repeating idle timer which triggers off the +;; background type finding search. + +(defvar c-inhibit-type-finder nil) +;; When non-nil (set by `c-post-gc-hook') don't perform the type finding +;; activities the next time `c-type-finder-timer' triggers. This ensures +;; keyboard/mouse input will be dealt with when garbage collection is taking a +;; large portion of CPU time. + ;; The following three really belong to cc-fonts.el, but they are required ;; even when cc-fonts.el hasn't been loaded (this happens in XEmacs when ;; font-lock-mode is nil). @@ -179,6 +189,18 @@ (when c-buffer-is-cc-mode (save-restriction (widen) + (let ((lst (buffer-list))) + (catch 'found + (dolist (b lst) + (if (and (not (eq b (current-buffer))) + (with-current-buffer b + c-buffer-is-cc-mode)) + (throw 'found nil))) + (remove-hook 'post-command-hook 'c-post-command) + (remove-hook 'post-gc-hook 'c-post-gc-hook) + (and c-type-finder-timer + (progn (cancel-timer c-type-finder-timer) + (setq c-type-finder-timer nil))))) (c-save-buffer-state () (c-clear-char-properties (point-min) (point-max) 'category) (c-clear-char-properties (point-min) (point-max) 'syntax-table) @@ -574,6 +596,12 @@ preferably use the `c-mode-menu' language constant directly." ;; currently no such text property. (make-variable-buffer-local 'c-max-syn-tab-mkr) +;; `c-type-finder-pos' is a marker marking the current place in a CC Mode +;; buffer which is due to be searched next for "found types", or nil if the +;; searching is complete. +(defvar c-type-finder-pos nil) +(make-variable-buffer-local 'c-type-finder-pos) + (defun c-basic-common-init (mode default-style) "Initialize the syntax handling routines and the line breaking/filling code. Intended to be used by other packages that embed CC Mode. @@ -745,6 +773,19 @@ that requires a literal mode spec at compile time." ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need ;; c-after-font-lock-init. (add-hook 'after-change-functions 'c-after-change nil t) + (add-hook 'post-command-hook 'c-post-command) + (setq c-type-finder-pos + (save-restriction + (widen) + (move-marker (make-marker) (point-min)))) + + ;; Install the functionality for seeking "found types" at mode startup: + (or c-type-finder-timer + (setq c-type-finder-timer + (run-at-time + c-type-finder-repeat-time nil #'c-type-finder-timer-func))) + (add-hook 'post-gc-hook #'c-post-gc-hook) + (when (boundp 'font-lock-extend-after-change-region-function) (set (make-local-variable 'font-lock-extend-after-change-region-function) 'c-extend-after-change-region))) ; Currently (2009-05) used by all @@ -1950,6 +1991,46 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; confused by already processed single quotes. (narrow-to-region (point) (point-max)))))) +;; The next two variables record the bounds of an identifier currently being +;; typed in. These are used to prevent such a partial identifier being +;; recorded as a found type by c-add-type. +(defvar c-new-id-start nil) +(make-variable-buffer-local 'c-new-id-start) +(defvar c-new-id-end nil) +(make-variable-buffer-local 'c-new-id-end) +;; The next variable, when non-nil, records that the previous two variables +;; define a type. +(defvar c-new-id-is-type nil) +(make-variable-buffer-local 'c-new-id-is-type) + +(defun c-update-new-id (end) + ;; Note the bounds of any identifier that END is in or just after, in + ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to + ;; nil. + (save-excursion + (goto-char end) + (let ((id-beg (c-on-identifier))) + (setq c-new-id-start id-beg + c-new-id-end (and id-beg + (progn (c-end-of-current-token) (point))))))) + + +(defun c-post-command () + ;; If point was inside of a new identifier and no longer is, record that + ;; fact. + (when (and c-buffer-is-cc-mode + c-new-id-start c-new-id-end + (or (> (point) c-new-id-end) + (< (point) c-new-id-start))) + (when c-new-id-is-type + (c-add-type-1 c-new-id-start c-new-id-end)) + (setq c-new-id-start nil + c-new-id-end nil + c-new-id-is-type nil))) + +(defun c-post-gc-hook (&optional _stats) ; For XEmacs. + (setq c-inhibit-type-finder t)) + (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls ;; the language dependent `c-get-state-before-change-functions'. It is @@ -1969,11 +2050,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (unless (c-called-from-text-property-change-p) (save-restriction (widen) + ;; Clear the list of found types if we make a change at the start of the + ;; buffer, to make it easier to get rid of misspelled types and + ;; variables that have gotten recognized as types in malformed code. + (when (eq beg (point-min)) + (c-clear-found-types)) (if c-just-done-before-change - ;; We have two consecutive calls to `before-change-functions' without - ;; an intervening `after-change-functions'. An example of this is bug - ;; #38691. To protect CC Mode, assume that the entire buffer has - ;; changed. + ;; We have two consecutive calls to `before-change-functions' + ;; without an intervening `after-change-functions'. An example of + ;; this is bug #38691. To protect CC Mode, assume that the entire + ;; buffer has changed. (setq beg (point-min) end (point-max) c-just-done-before-change 'whole-buffer) @@ -2151,6 +2237,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") c->-as-paren-syntax) (c-clear-char-property-with-value beg end 'syntax-table nil))) + (c-update-new-id end) (c-trim-found-types beg end old-len) ; maybe we don't ; need all of these. (c-invalidate-sws-region-after beg end old-len) @@ -2549,17 +2636,24 @@ This function is called from `c-common-init', once per mode initialization." At the time of call, point is just after the newly inserted CHAR. -When CHAR is \", t will be returned unless the \" is marked with -a string fence syntax-table text property. For other characters, -the default value of `electric-pair-inhibit-predicate' is called -and its value returned. +When CHAR is \" and not within a comment, t will be returned if +the quotes on the current line are already balanced (i.e. if the +last \" is not marked with a string fence syntax-table text +property). For other cases, the default value of +`electric-pair-inhibit-predicate' is called and its value +returned. This function is the appropriate value of `electric-pair-inhibit-predicate' for CC Mode modes, which mark invalid strings with such a syntax table text property on the opening \" and the next unescaped end of line." - (if (eq char ?\") - (not (equal (get-text-property (1- (point)) 'c-fl-syn-tab) '(15))) + (if (and (eq char ?\") + (not (memq (cadr (c-semi-pp-to-literal (1- (point)))) '(c c++)))) + (let ((last-quote (save-match-data + (save-excursion + (goto-char (c-point 'eoll)) + (search-backward "\""))))) + (not (equal (c-get-char-property last-quote 'c-fl-syn-tab) '(15)))) (funcall (default-value 'electric-pair-inhibit-predicate) char))) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index d843c783ed0..40a43c32ed9 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -179,7 +179,7 @@ STYLE stands for the choice where the value is taken from some style setting. PREAMBLE is optionally prepended to FOO; that is, if FOO contains :tag or :value, the respective two-element list component is ignored." - (declare (debug (symbolp form stringp &rest))) + (declare (debug (symbolp form stringp &rest)) (indent defun)) (let* ((expanded-doc (concat doc " This is a style variable. Apart from the valid values described @@ -1524,6 +1524,39 @@ working due to this change." :type 'boolean :group 'c) +(defcustom c-type-finder-time-slot 0.05 + "The length in seconds of a background type search time slot. + +In CC Mode modes, \"found types\" wouldn't always get cleanly +fontified without the background searching for them which happens +in the seconds after starting Emacs or initializing the major +mode. + +This background searching can be disabled by setting this option +to nil." + :type '(choice (const :tag "disabled" nil) + number) + :group 'c) + +(defcustom c-type-finder-repeat-time 0.1 + "The interval, in seconds, at which background type searches occur. + +This interval must be greater than `c-type-finder-time-slot'." + :type 'number + :group 'c) + +(defcustom c-type-finder-chunk-size 1000 + "The size, in characters, of a chunk for background type search. + +Chunks of this size are searched atomically for \"found types\" +just after starting Emacs or initializing the major mode. + +This chunk size is a balance between efficiency (with larger +values) and responsiveness of the keyboard (with smaller values). +See also `c-type-finder-time-slot'." + :type 'integer + :group 'c) + (define-widget 'c-extra-types-widget 'radio "Internal CC Mode widget for the `*-font-lock-extra-types' variables." :args '((const :tag "none" nil) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index ac26f5e9341..14da5880203 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2228,6 +2228,7 @@ The parent is always `compilation-mode' and the customizable `compilation-...' variables are also set from the name of the mode you have chosen, by replacing the first word, e.g., `compilation-scroll-output' from `grep-scroll-output' if that variable exists." + (declare (indent defun)) (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode)))) `(define-derived-mode ,mode compilation-mode ,name ,doc diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 1afeb60ac5f..a23505a9d3b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5951,7 +5951,7 @@ default function." (eval cperl--basic-identifier-rx))) (0+ blank) "(") ;; '("\\<for\\(each\\)?\\([ \t]+\\(state\\|my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" - 4 font-lock-variable-name-face) + 1 font-lock-variable-name-face) ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntactically '("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face) '("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend))) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index d800365e66d..baee72b332d 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -702,11 +702,8 @@ BRANCH should be either nil (false branch), t (true branch) or `both'." (x-popup-menu cpp-button-event (list prompt (cons prompt cpp-face-default-list))) (let ((name (car (rassq default cpp-face-default-list)))) - (cdr (assoc (completing-read (if name - (concat prompt - " (default " name "): ") - (concat prompt ": ")) - cpp-face-default-list nil t) + (cdr (assoc (completing-read (format-prompt "%s" name prompt) + cpp-face-default-list nil t) cpp-face-all-list)))) default)) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index ab0329d7eec..6e416d064a8 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1330,9 +1330,9 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise." "Set the indentation width of the tree display." (interactive) (let ((width (string-to-number (read-string - (concat "Indentation (default " - (int-to-string ebrowse--indentation) - "): ") + (format-prompt + "Indentation" + (int-to-string ebrowse--indentation)) nil nil ebrowse--indentation)))) (when (cl-plusp width) (setq-local ebrowse--indentation width) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 9522055670d..7da93a351a2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -636,7 +636,8 @@ functions are annotated with \"<f>\" via the :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (quoted (list nil (elisp--completion-local-symbols) ;; Don't include all symbols (bug#16646). @@ -652,7 +653,8 @@ functions are annotated with \"<f>\" via the :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (t (list nil (completion-table-merge elisp--local-variables-completion-table @@ -667,7 +669,8 @@ functions are annotated with \"<f>\" via the 'variable)) :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location))) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated))) ;; Looks like a funcall position. Let's double check. (save-excursion (goto-char (1- beg)) @@ -714,13 +717,15 @@ functions are annotated with \"<f>\" via the :company-kind (lambda (_) 'variable) :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (_ (list nil (elisp--completion-local-symbols) :predicate #'elisp--shorthand-aware-fboundp :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated )))))))) (nconc (list beg end) (if (null (car table-etc)) @@ -743,6 +748,11 @@ functions are annotated with \"<f>\" via the ((facep sym) 'color) (t 'text)))) +(defun elisp--company-deprecated (str) + (let ((sym (intern-soft str))) + (or (get sym 'byte-obsolete-variable) + (get sym 'byte-obsolete-info)))) + (defun lisp-completion-at-point (&optional _predicate) (declare (obsolete elisp-completion-at-point "25.1")) (elisp-completion-at-point)) diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el new file mode 100644 index 00000000000..8a271ec3182 --- /dev/null +++ b/lisp/progmodes/erts-mode.el @@ -0,0 +1,220 @@ +;;; erts-mode.el --- major mode to edit erts files -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(require 'ert) + +(defgroup erts-mode nil + "Major mode for editing Emacs test files." + :group 'lisp) + +(defface erts-mode-specification-name + '((((class color) + (background dark)) + :foreground "green") + (((class color) + (background light)) + :foreground "cornflower blue") + (t + :bold t)) + "Face used for displaying specification names." + :group 'erts-mode) + +(defface erts-mode-specification-value + '((((class color) + (background dark)) + :foreground "DeepSkyBlue1") + (((class color) + (background light)) + :foreground "blue") + (t + :bold t)) + "Face used for displaying specificaton values." + :group 'erts-mode) + +(defface erts-mode-start-test + '((t :inherit font-lock-keyword-face)) + "Face used for displaying specificaton test start markers." + :group 'erts-mode) + +(defface erts-mode-end-test + '((t :inherit font-lock-comment-face)) + "Face used for displaying specificaton test start markers." + :group 'erts-mode) + +(defvar erts-mode-map + (let ((map (make-keymap))) + (set-keymap-parent map prog-mode-map) + (define-key map "\C-c\C-r" 'erts-tag-region) + (define-key map "\C-c\C-c" 'erts-run-test) + map)) + +(defvar erts-mode-font-lock-keywords + ;; Specifications. + `((erts-mode--match-not-in-test + ("^\\([^ \t\n:]+:\\)[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?" + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'erts-mode-specification-name) + (2 'erts-mode-specification-value))) + ("^=-=$" 0 'erts-mode-start-test) + ("^=-=-=$" 0 'erts-mode-end-test))) + +(defun erts-mode--match-not-in-test (_limit) + (when (erts-mode--in-test-p (point)) + (erts-mode--end-of-test)) + (let ((start (point))) + (goto-char + (if (re-search-forward "^=-=$" nil t) + (match-beginning 0) + (point-max))) + (if (< (point) start) + nil + ;; Here we disregard LIMIT so that we may extend the area again. + (set-match-data (list start (point))) + (point)))) + +(defun erts-mode--end-of-test () + (search-forward "^=-=-=\n" nil t)) + +(defun erts-mode--in-test-p (point) + "Say whether POINT is in a test." + (save-excursion + (goto-char point) + (beginning-of-line) + (if (looking-at "=-=\\(-=\\)?$") + t + (let ((test-start (save-excursion + (re-search-backward "^=-=\n" nil t)))) + ;; Before the first test. + (and test-start + (let ((test-end (re-search-backward "^=-=-=\n" nil t))) + (or (null test-end) + ;; Between tests. + (> test-start test-end)))))))) + +;;;###autoload +(define-derived-mode erts-mode prog-mode "erts" + "Major mode for editing erts (Emacs testing) files. +This mode mainly provides some font locking. + +\\{erts-mode-map}" + (setq-local font-lock-defaults '(erts-mode-font-lock-keywords t))) + +(defun erts-tag-region (start end name) + "Tag the region between START and END as a test. +Interactively, this is the region. + +NAME should be a string appropriate for output by ert if the test fails. +If NAME is nil or the empty string, a name will be auto-generated." + (interactive "r\nsTest name: " erts-mode) + ;; Automatically make a name. + (when (zerop (length name)) + (save-excursion + (goto-char (point-min)) + (let ((names nil)) + (while (re-search-forward "^Name:[ \t]*\\(.*\\)" nil t) + (let ((name (match-string 1))) + (unless (erts-mode--in-test-p (point)) + (push name names)))) + (setq name + (cl-loop with base = (file-name-sans-extension (buffer-name)) + for i from 1 + for name = (format "%s%d" base i) + unless (member name names) + return name))))) + (save-excursion + (goto-char end) + (unless (bolp) + (insert "\n")) + (insert "=-=-=\n") + (goto-char start) + (insert "Name: " name "\n\n") + (insert "=-=\n"))) + +(defun erts-run-test (test-function &optional verbose) + "Run the current test. +If the current erts file doesn't define a test function, the user +will be prompted for one. + +If VERBOSE (interactively, the prefix), display a diff of the +expected results and the actual results in a separate buffer." + (interactive + (list (save-excursion + ;; Find the preceding Code spec. + (while (and (re-search-backward "^Code:" nil t) + (erts-mode--in-test-p (point)))) + (if (and (not (erts-mode--in-test-p (point))) + (re-search-forward "^=-=$" nil t)) + (progn + (goto-char (match-beginning 0)) + (cdr (assq 'code (ert--erts-specifications (point))))) + (read-string "Transformation function: "))) + current-prefix-arg) + erts-mode) + (save-excursion + (erts-mode--goto-start-of-test) + (condition-case arg + (ert-test--erts-test + (list (cons 'dummy t) + (cons 'code (car (read-from-string test-function)))) + (buffer-file-name)) + (:success (message "Test successful")) + (ert-test-failed + (if (not verbose) + (message "Test failure; result: \n%s" + (substring-no-properties (cadr (cadr arg)))) + (message "Test failure") + (let (expected got) + (unwind-protect + (progn + (with-current-buffer + (setq expected (generate-new-buffer "erts expected")) + (insert (nth 1 (cadr arg)))) + (with-current-buffer + (setq got (generate-new-buffer "erts results")) + (insert (nth 2 (cadr arg)))) + (diff-buffers expected got)) + (kill-buffer expected) + (kill-buffer got)))))))) + +(defun erts-mode--goto-start-of-test () + (if (not (erts-mode--in-test-p (point))) + (re-search-forward "^=-=\n" nil t) + (re-search-backward "^=-=\n" nil t) + (let ((potential-start (match-end 0))) + ;; See if we're in a two-clause ("before" and "after") test or not. + (if-let ((start (and (save-excursion (re-search-backward "^=-=\n" nil t)) + (match-end 0)))) + (let ((end (save-excursion (re-search-backward "^=-=-=\n" nil t)))) + (if (or (not end) + (> start end)) + ;; We are, so go to the real start. + (goto-char start) + (goto-char potential-start))) + (goto-char potential-start))))) + +(provide 'erts-mode) + +;;; erts-mode.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index f53b09d9e8c..d833612cd90 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -145,7 +145,9 @@ Otherwise, `find-tag-default' is used." :type '(choice (const nil) function)) (define-obsolete-variable-alias 'find-tag-marker-ring-length - 'xref-marker-ring-length "25.1") + 'tags-location-ring-length "25.1") + +(defvar tags-location-ring-length 16) (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." @@ -180,10 +182,11 @@ Example value: (sexp :tag "Tags to search"))) :version "21.1") -(defvaralias 'find-tag-marker-ring 'xref--marker-ring) +;; Obsolete variable kept for compatibility. We don't use it in any way. +(defvar find-tag-marker-ring (make-ring 16)) (make-obsolete-variable 'find-tag-marker-ring - "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead." + "use `xref-push-marker-stack' or `xref-go-back' instead." "25.1") (defvar default-tags-table-function nil @@ -191,7 +194,7 @@ Example value: This function receives no arguments and should return the default tags table file to use for the current buffer.") -(defvar tags-location-ring (make-ring xref-marker-ring-length) +(defvar tags-location-ring (make-ring tags-location-ring-length) "Ring of markers which are locations visited by \\[find-tag]. Pop back to the last location with \\[negative-argument] \\[find-tag].") @@ -292,7 +295,7 @@ file the tag was in." (or (locate-dominating-file default-directory "TAGS") default-directory))) (list (read-file-name - "Visit tags table (default TAGS): " + (format-prompt "Visit tags table" "TAGS") ;; default to TAGS from default-directory up to root. default-tag-dir (expand-file-name "TAGS" default-tag-dir) @@ -625,7 +628,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (car list)) ;; Finally, prompt the user for a file name. (expand-file-name - (read-file-name "Visit tags table (default TAGS): " + (read-file-name (format-prompt "Visit tags table" "TAGS") default-directory "TAGS" t)))))) @@ -731,13 +734,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (interactive) ;; Clear out the markers we are throwing away. (let ((i 0)) - (while (< i xref-marker-ring-length) + (while (< i tags-location-ring-length) (if (aref (cddr tags-location-ring) i) (set-marker (aref (cddr tags-location-ring) i) nil)) (setq i (1+ i)))) (xref-clear-marker-stack) (setq tags-file-name nil - tags-location-ring (make-ring xref-marker-ring-length) + tags-location-ring (make-ring tags-location-ring-length) tags-table-list nil tags-table-computed-list nil tags-table-computed-list-for nil @@ -1068,7 +1071,7 @@ See documentation of variable `tags-file-name'." regexp next-p t)) ;;;###autoload -(defalias 'pop-tag-mark 'xref-pop-marker-stack) +(defalias 'pop-tag-mark 'xref-go-back) (defvar tag-lines-already-matched nil diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index f9e6101e7ab..acc0d96ea5b 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -345,6 +345,7 @@ The options are `downcase-word', `upcase-word', `capitalize-word' and nil." ;; there are spaces. "contiguous" "submodule" "concurrent" "codimension" "sync all" "sync memory" "critical" "image_index" "error stop" + "impure" )) "\\_>") "Regexp used by the function `f90-change-keywords'.") diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index fa54f511608..39fcfd341cb 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1612,6 +1612,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with ;; Used to display windows with thread-bound buffers (defmacro def-gdb-preempt-display-buffer (name buffer &optional doc split-horizontal) + (declare (indent defun)) `(defun ,name (&optional thread) ,(when doc doc) (message "%s" thread) @@ -3012,6 +3013,7 @@ calling `gdb-current-context-command'). Triggers defined by this command are meant to be used as a trigger argument when describing buffer types with `gdb-set-buffer-rules'." + (declare (indent defun)) `(defun ,trigger-name (&optional signal) (when (or (not ,signal-list) @@ -3032,6 +3034,7 @@ Erase current buffer and evaluate CUSTOM-DEFUN. Then call `gdb-update-buffer-name'. If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." + (declare (indent defun)) `(defun ,handler-name () (let* ((inhibit-read-only t) ,@(unless nopreserve @@ -3055,6 +3058,7 @@ See `def-gdb-auto-update-trigger'. HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See `def-gdb-auto-update-handler'." + (declare (indent defun)) `(progn (def-gdb-auto-update-trigger ,trigger-name ,gdb-command @@ -3473,6 +3477,7 @@ corresponding to the mode line clicked." CUSTOM-DEFUN may use locally bound `thread' variable, which will be the value of `gdb-thread' property of the current line. If `gdb-thread' is nil, error is signaled." + (declare (indent defun)) `(defun ,name (&optional event) ,(when doc doc) (interactive (list last-input-event)) @@ -3488,6 +3493,7 @@ If `gdb-thread' is nil, error is signaled." &optional doc) "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." + (declare (indent defun)) `(def-gdb-thread-buffer-command ,name (,buffer-command (gdb-mi--field thread 'id)) ,doc)) @@ -3543,6 +3549,7 @@ on the current line." "Define a NAME which will execute GUD-COMMAND with `gdb-thread-number' locally bound to id of thread on the current line." + (declare (indent defun)) `(def-gdb-thread-buffer-command ,name (if gdb-non-stop (let ((gdb-thread-number (gdb-mi--field thread 'id)) @@ -3711,6 +3718,7 @@ in `gdb-memory-format'." (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) "Define a function NAME which reads new VAR value from minibuffer." + (declare (indent defun)) `(defun ,name (event) ,(when doc doc) (interactive "e") @@ -3739,6 +3747,7 @@ in `gdb-memory-format'." "Define a function NAME to switch memory buffer to use FORMAT. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name () ,(when doc doc) (interactive) (customize-set-variable 'gdb-memory-format ,format) @@ -3808,6 +3817,7 @@ DOC is an optional documentation string." "Define a function NAME to switch memory unit size to UNIT-SIZE. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name () ,(when doc doc) (interactive) (customize-set-variable 'gdb-memory-unit ,unit-size) @@ -3832,6 +3842,7 @@ The defined function switches Memory buffer to show address stored in ADDRESS-VAR variable. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name ,(when doc doc) (interactive) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index ec2850737c8..001989e39ad 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1057,11 +1057,9 @@ REGEXP is used as a string in the prompt." default-extension (car grep-files-history) (car (car grep-files-aliases)))) - (files (completing-read - (concat "Search for \"" regexp - "\" in files matching wildcard" - (if default (concat " (default " default ")")) - ": ") + (files (completing-read + (format-prompt "Search for \"%s\" in files matching wildcard" + default regexp) #'read-file-name-internal nil nil nil 'grep-files-history (delete-dups diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 2061d414802..9b884c4ff80 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3539,8 +3539,8 @@ Treats actions as defuns." #'gdb-script-end-of-defun) (setq-local font-lock-defaults '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face))) + (font-lock-syntactic-face-function + . gdb-script-font-lock-syntactic-face))) ;; Recognize docstrings. (setq-local syntax-propertize-function gdb-script-syntax-propertize-function) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index a18a67249ae..87732c10489 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -2456,7 +2456,7 @@ This allows #ifdef VAR to be hidden." (t nil)))) (var (read-minibuffer "Define what? " default)) - (val (read-from-minibuffer (format "Set %s to? (default 1): " var) + (val (read-from-minibuffer (format-prompt "Set %s to?" "1" var) nil nil t nil "1"))) (list var val))) (hif-set-var var (or val 1)) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 845ca8609d7..f11995127d4 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -33,7 +33,7 @@ ;; The main features of this JavaScript mode are syntactic ;; highlighting (enabled with `font-lock-mode' or ;; `global-font-lock-mode'), automatic indentation and filling of -;; comments, C preprocessor fontification, and MozRepl integration. +;; comments, and C preprocessor fontification. ;; ;; General Remarks: ;; @@ -51,7 +51,6 @@ (require 'cc-fonts)) (require 'newcomment) (require 'imenu) -(require 'moz nil t) (require 'json) (require 'prog-mode) @@ -59,12 +58,9 @@ (require 'cl-lib) (require 'ido)) -(defvar inferior-moz-buffer) -(defvar moz-repl-name) (defvar ido-cur-list) (defvar electric-layout-rules) (declare-function ido-mode "ido" (&optional arg)) -(declare-function inferior-moz-process "ext:mozrepl" ()) ;;; Constants @@ -485,25 +481,22 @@ seldom use, either globally or on a per-buffer basis." (list 'const x)) js--available-frameworks))) -(defcustom js-js-switch-tabs - (and (memq system-type '(darwin)) t) +(defvar js-js-switch-tabs (and (memq system-type '(darwin)) t) "Whether `js-mode' should display tabs while selecting them. This is useful only if the windowing system has a good mechanism -for preventing Firefox from stealing the keyboard focus." - :type 'boolean) +for preventing Firefox from stealing the keyboard focus.") +(make-obsolete-variable 'js-js-switch-tabs "MozRepl no longer exists" "28.1") -(defcustom js-js-tmpdir - (locate-user-emacs-file "js/js") +(defvar js-js-tmpdir (locate-user-emacs-file "js/js") "Temporary directory used by `js-mode' to communicate with Mozilla. -This directory must be readable and writable by both Mozilla and Emacs." - :type 'directory - :version "28.1") +This directory must be readable and writable by both Mozilla and Emacs.") +(make-obsolete-variable 'js-js-tmpdir "MozRepl no longer exists" "28.1") -(defcustom js-js-timeout 5 +(defvar js-js-timeout 5 "Reply timeout for executing commands in Mozilla via `js-mode'. The value is given in seconds. Increase this value if you are -getting timeout messages." - :type 'integer) +getting timeout messages.") +(make-obsolete-variable 'js-js-timeout "MozRepl no longer exists" "28.1") (defcustom js-indent-first-init nil "Non-nil means specially indent the first variable declaration's initializer. @@ -671,18 +664,7 @@ This variable is like `sgml-attribute-offset'." (defvar js-mode-map (let ((keymap (make-sparse-keymap))) - (define-key keymap [(control ?c) (meta ?:)] #'js-eval) - (define-key keymap [(control ?c) (control ?j)] #'js-set-js-context) - (define-key keymap [(control meta ?x)] #'js-eval-defun) (define-key keymap [(meta ?.)] #'js-find-symbol) - (easy-menu-define nil keymap "JavaScript Menu" - '("JavaScript" - ["Select New Mozilla Context..." js-set-js-context - (fboundp #'inferior-moz-process)] - ["Evaluate Expression in Mozilla Context..." js-eval - (fboundp #'inferior-moz-process)] - ["Send Current Function to Mozilla..." js-eval-defun - (fboundp #'inferior-moz-process)])) keymap) "Keymap for `js-mode'.") @@ -3308,10 +3290,7 @@ marker." (setf (car bounds) (point)))) (buffer-substring (car bounds) (cdr bounds))))) -(defvar find-tag-marker-ring) ; etags - -;; etags loads ring. -(declare-function ring-insert "ring" (ring item)) +(declare-function xref-push-marker-stack "xref" (&optional m)) (defun js-find-symbol (&optional arg) "Read a JavaScript symbol and jump to it. @@ -3319,7 +3298,7 @@ With a prefix argument, restrict symbols to those from the current buffer. Pushes a mark onto the tag ring just like `find-tag'." (interactive "P") - (require 'etags) + (require 'xref) (let (symbols marker) (if (not arg) (setq symbols (js--get-all-known-symbols)) @@ -3331,1111 +3310,11 @@ current buffer. Pushes a mark onto the tag ring just like symbols "Jump to: " (js--guess-symbol-at-point)))) - (ring-insert find-tag-marker-ring (point-marker)) + (xref-push-marker-stack) (switch-to-buffer (marker-buffer marker)) (push-mark) (goto-char marker))) -;;; MozRepl integration - -(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error)) -(define-error 'js-js-error "JavaScript Error") ;; '(js-error error)) - -(defun js--wait-for-matching-output - (process regexp timeout &optional start) - "Wait TIMEOUT seconds for PROCESS to output a match for REGEXP. -On timeout, return nil. On success, return t with match data -set. If START is non-nil, look for output starting from START. -Otherwise, use the current value of `process-mark'." - (with-current-buffer (process-buffer process) - (cl-loop with start-pos = (or start - (marker-position (process-mark process))) - with end-time = (time-add nil timeout) - for time-left = (float-time (time-subtract end-time nil)) - do (goto-char (point-max)) - if (looking-back regexp start-pos) return t - while (> time-left 0) - do (accept-process-output process time-left nil t) - do (goto-char (process-mark process)) - finally do (signal - 'js-moz-bad-rpc - (list (format "Timed out waiting for output matching %S" regexp)))))) - -(cl-defstruct js--js-handle - ;; Integer, mirrors the value we see in JS - (id nil :read-only t) - - ;; Process to which this thing belongs - (process nil :read-only t)) - -(defun js--js-handle-expired-p (x) - (not (eq (js--js-handle-process x) - (inferior-moz-process)))) - -(defvar js--js-references nil - "Maps Elisp JavaScript proxy objects to their JavaScript IDs.") - -(defvar js--js-process nil - "The most recent MozRepl process object.") - -(defvar js--js-gc-idle-timer nil - "Idle timer for cleaning up JS object references.") - -(defvar js--js-last-gcs-done nil) - -(defconst js--moz-interactor - (replace-regexp-in-string - "[ \n]+" " " - ; */" Make Emacs happy -"(function(repl) { - repl.defineInteractor('js', { - onStart: function onStart(repl) { - if(!repl._jsObjects) { - repl._jsObjects = {}; - repl._jsLastID = 0; - repl._jsGC = this._jsGC; - } - this._input = ''; - }, - - _jsGC: function _jsGC(ids_in_use) { - var objects = this._jsObjects; - var keys = []; - var num_freed = 0; - - for(var pn in objects) { - keys.push(Number(pn)); - } - - keys.sort(function(x, y) x - y); - ids_in_use.sort(function(x, y) x - y); - var i = 0; - var j = 0; - - while(i < ids_in_use.length && j < keys.length) { - var id = ids_in_use[i++]; - while(j < keys.length && keys[j] !== id) { - var k_id = keys[j++]; - delete objects[k_id]; - ++num_freed; - } - ++j; - } - - while(j < keys.length) { - var k_id = keys[j++]; - delete objects[k_id]; - ++num_freed; - } - - return num_freed; - }, - - _mkArray: function _mkArray() { - var result = []; - for(var i = 0; i < arguments.length; ++i) { - result.push(arguments[i]); - } - return result; - }, - - _parsePropDescriptor: function _parsePropDescriptor(parts) { - if(typeof parts === 'string') { - parts = [ parts ]; - } - - var obj = parts[0]; - var start = 1; - - if(typeof obj === 'string') { - obj = window; - start = 0; - } else if(parts.length < 2) { - throw new Error('expected at least 2 arguments'); - } - - for(var i = start; i < parts.length - 1; ++i) { - obj = obj[parts[i]]; - } - - return [obj, parts[parts.length - 1]]; - }, - - _getProp: function _getProp(/*...*/) { - if(arguments.length === 0) { - throw new Error('no arguments supplied to getprop'); - } - - if(arguments.length === 1 && - (typeof arguments[0]) !== 'string') - { - return arguments[0]; - } - - var [obj, propname] = this._parsePropDescriptor(arguments); - return obj[propname]; - }, - - _putProp: function _putProp(properties, value) { - var [obj, propname] = this._parsePropDescriptor(properties); - obj[propname] = value; - }, - - _delProp: function _delProp(propname) { - var [obj, propname] = this._parsePropDescriptor(arguments); - delete obj[propname]; - }, - - _typeOf: function _typeOf(thing) { - return typeof thing; - }, - - _callNew: function(constructor) { - if(typeof constructor === 'string') - { - constructor = window[constructor]; - } else if(constructor.length === 1 && - typeof constructor[0] !== 'string') - { - constructor = constructor[0]; - } else { - var [obj,propname] = this._parsePropDescriptor(constructor); - constructor = obj[propname]; - } - - /* Hacky, but should be robust */ - var s = 'new constructor('; - for(var i = 1; i < arguments.length; ++i) { - if(i != 1) { - s += ','; - } - - s += 'arguments[' + i + ']'; - } - - s += ')'; - return eval(s); - }, - - _callEval: function(thisobj, js) { - return eval.call(thisobj, js); - }, - - getPrompt: function getPrompt(repl) { - return 'EVAL>' - }, - - _lookupObject: function _lookupObject(repl, id) { - if(typeof id === 'string') { - switch(id) { - case 'global': - return window; - case 'nil': - return null; - case 't': - return true; - case 'false': - return false; - case 'undefined': - return undefined; - case 'repl': - return repl; - case 'interactor': - return this; - case 'NaN': - return NaN; - case 'Infinity': - return Infinity; - case '-Infinity': - return -Infinity; - default: - throw new Error('No object with special id:' + id); - } - } - - var ret = repl._jsObjects[id]; - if(ret === undefined) { - throw new Error('No object with id:' + id + '(' + typeof id + ')'); - } - return ret; - }, - - _findOrAllocateObject: function _findOrAllocateObject(repl, value) { - if(typeof value !== 'object' && typeof value !== 'function') { - throw new Error('_findOrAllocateObject called on non-object(' - + typeof(value) + '): ' - + value) - } - - for(var id in repl._jsObjects) { - id = Number(id); - var obj = repl._jsObjects[id]; - if(obj === value) { - return id; - } - } - - var id = ++repl._jsLastID; - repl._jsObjects[id] = value; - return id; - }, - - _fixupList: function _fixupList(repl, list) { - for(var i = 0; i < list.length; ++i) { - if(list[i] instanceof Array) { - this._fixupList(repl, list[i]); - } else if(typeof list[i] === 'object') { - var obj = list[i]; - if(obj.funcall) { - var parts = obj.funcall; - this._fixupList(repl, parts); - var [thisobj, func] = this._parseFunc(parts[0]); - list[i] = func.apply(thisobj, parts.slice(1)); - } else if(obj.objid) { - list[i] = this._lookupObject(repl, obj.objid); - } else { - throw new Error('Unknown object type: ' + obj.toSource()); - } - } - } - }, - - _parseFunc: function(func) { - var thisobj = null; - - if(typeof func === 'string') { - func = window[func]; - } else if(func instanceof Array) { - if(func.length === 1 && typeof func[0] !== 'string') { - func = func[0]; - } else { - [thisobj, func] = this._parsePropDescriptor(func); - func = thisobj[func]; - } - } - - return [thisobj,func]; - }, - - _encodeReturn: function(value, array_as_mv) { - var ret; - - if(value === null) { - ret = ['special', 'null']; - } else if(value === true) { - ret = ['special', 'true']; - } else if(value === false) { - ret = ['special', 'false']; - } else if(value === undefined) { - ret = ['special', 'undefined']; - } else if(typeof value === 'number') { - if(isNaN(value)) { - ret = ['special', 'NaN']; - } else if(value === Infinity) { - ret = ['special', 'Infinity']; - } else if(value === -Infinity) { - ret = ['special', '-Infinity']; - } else { - ret = ['atom', value]; - } - } else if(typeof value === 'string') { - ret = ['atom', value]; - } else if(array_as_mv && value instanceof Array) { - ret = ['array', value.map(this._encodeReturn, this)]; - } else { - ret = ['objid', this._findOrAllocateObject(repl, value)]; - } - - return ret; - }, - - _handleInputLine: function _handleInputLine(repl, line) { - var ret; - var array_as_mv = false; - - try { - if(line[0] === '*') { - array_as_mv = true; - line = line.substring(1); - } - var parts = eval(line); - this._fixupList(repl, parts); - var [thisobj, func] = this._parseFunc(parts[0]); - ret = this._encodeReturn( - func.apply(thisobj, parts.slice(1)), - array_as_mv); - } catch(x) { - ret = ['error', x.toString() ]; - } - - var JSON = Components.classes['@mozilla.org/dom/json;1'].createInstance(Components.interfaces.nsIJSON); - repl.print(JSON.encode(ret)); - repl._prompt(); - }, - - handleInput: function handleInput(repl, chunk) { - this._input += chunk; - var match, line; - while(match = this._input.match(/.*\\n/)) { - line = match[0]; - - if(line === 'EXIT\\n') { - repl.popInteractor(); - repl._prompt(); - return; - } - - this._input = this._input.substring(line.length); - this._handleInputLine(repl, line); - } - } - }); -}) -") - - "String to set MozRepl up into a simple-minded evaluation mode.") - -(defun js--js-encode-value (x) - "Marshall the given value for JS. -Strings and numbers are JSON-encoded. Lists (including nil) are -made into JavaScript array literals and their contents encoded -with `js--js-encode-value'." - (cond ((or (stringp x) (numberp x)) (json-encode x)) - ((symbolp x) (format "{objid:%S}" (symbol-name x))) - ((js--js-handle-p x) - - (when (js--js-handle-expired-p x) - (error "Stale JS handle")) - - (format "{objid:%s}" (js--js-handle-id x))) - - ((sequencep x) - (if (eq (car-safe x) 'js--funcall) - (format "{funcall:[%s]}" - (mapconcat #'js--js-encode-value (cdr x) ",")) - (concat - "[" (mapconcat #'js--js-encode-value x ",") "]"))) - (t - (error "Unrecognized item: %S" x)))) - -(defconst js--js-prompt-regexp "\\(repl[0-9]*\\)> $") -(defconst js--js-repl-prompt-regexp "^EVAL>$") -(defvar js--js-repl-depth 0) - -(defun js--js-wait-for-eval-prompt () - (js--wait-for-matching-output - (inferior-moz-process) - js--js-repl-prompt-regexp js-js-timeout - - ;; start matching against the beginning of the line in - ;; order to catch a prompt that's only partially arrived - (save-excursion (forward-line 0) (point)))) - -;; Presumably "inferior-moz-process" loads comint. -(declare-function comint-send-string "comint" (process string)) -(declare-function comint-send-input "comint" - (&optional no-newline artificial)) - -(defun js--js-enter-repl () - (inferior-moz-process) ; called for side-effect - (with-current-buffer inferior-moz-buffer - (goto-char (point-max)) - - ;; Do some initialization the first time we see a process - (unless (eq (inferior-moz-process) js--js-process) - (setq js--js-process (inferior-moz-process)) - (setq js--js-references (make-hash-table :test 'eq :weakness t)) - (setq js--js-repl-depth 0) - - ;; Send interactor definition - (comint-send-string js--js-process js--moz-interactor) - (comint-send-string js--js-process - (concat "(" moz-repl-name ")\n")) - (js--wait-for-matching-output - (inferior-moz-process) js--js-prompt-regexp - js-js-timeout)) - - ;; Sanity check - (when (looking-back js--js-prompt-regexp - (save-excursion (forward-line 0) (point))) - (setq js--js-repl-depth 0)) - - (if (> js--js-repl-depth 0) - ;; If js--js-repl-depth > 0, we *should* be seeing an - ;; EVAL> prompt. If we don't, give Mozilla a chance to catch - ;; up with us. - (js--js-wait-for-eval-prompt) - - ;; Otherwise, tell Mozilla to enter the interactor mode - (insert (match-string-no-properties 1) - ".pushInteractor('js')") - (comint-send-input nil t) - (js--wait-for-matching-output - (inferior-moz-process) js--js-repl-prompt-regexp - js-js-timeout)) - - (cl-incf js--js-repl-depth))) - -(defun js--js-leave-repl () - (cl-assert (> js--js-repl-depth 0)) - (when (= 0 (cl-decf js--js-repl-depth)) - (with-current-buffer inferior-moz-buffer - (goto-char (point-max)) - (js--js-wait-for-eval-prompt) - (insert "EXIT") - (comint-send-input nil t) - (js--wait-for-matching-output - (inferior-moz-process) js--js-prompt-regexp - js-js-timeout)))) - -(defsubst js--js-not (value) - (memq value '(nil null false undefined))) - -(defsubst js--js-true (value) - (not (js--js-not value))) - -(eval-and-compile - (defun js--optimize-arglist (arglist) - "Convert immediate js< and js! references to deferred ones." - (cl-loop for item in arglist - if (eq (car-safe item) 'js<) - collect (append (list 'list ''js--funcall - '(list 'interactor "_getProp")) - (js--optimize-arglist (cdr item))) - else if (eq (car-safe item) 'js>) - collect (append (list 'list ''js--funcall - '(list 'interactor "_putProp")) - - (if (atom (cadr item)) - (list (cadr item)) - (list - (append - (list 'list ''js--funcall - '(list 'interactor "_mkArray")) - (js--optimize-arglist (cadr item))))) - (js--optimize-arglist (cddr item))) - else if (eq (car-safe item) 'js!) - collect (pcase-let ((`(,_ ,function . ,body) item)) - (append (list 'list ''js--funcall - (if (consp function) - (cons 'list - (js--optimize-arglist function)) - function)) - (js--optimize-arglist body))) - else - collect item))) - -(defmacro js--js-get-service (class-name interface-name) - `(js! ("Components" "classes" ,class-name "getService") - (js< "Components" "interfaces" ,interface-name))) - -(defmacro js--js-create-instance (class-name interface-name) - `(js! ("Components" "classes" ,class-name "createInstance") - (js< "Components" "interfaces" ,interface-name))) - -(defmacro js--js-qi (object interface-name) - `(js! (,object "QueryInterface") - (js< "Components" "interfaces" ,interface-name))) - -(defmacro with-js (&rest forms) - "Run FORMS with the Mozilla repl set up for js commands. -Inside the lexical scope of `with-js', `js?', `js!', -`js-new', `js-eval', `js-list', `js<', `js>', `js-get-service', -`js-create-instance', and `js-qi' are defined." - (declare (indent 0) (debug t)) - `(progn - (js--js-enter-repl) - (unwind-protect - (cl-macrolet ((js? (&rest body) `(js--js-true ,@body)) - (js! (function &rest body) - `(js--js-funcall - ,(if (consp function) - (cons 'list - (js--optimize-arglist function)) - function) - ,@(js--optimize-arglist body))) - - (js-new (function &rest body) - `(js--js-new - ,(if (consp function) - (cons 'list - (js--optimize-arglist function)) - function) - ,@body)) - - (js-eval (thisobj js) - `(js--js-eval - ,@(js--optimize-arglist - (list thisobj js)))) - - (js-list (&rest args) - `(js--js-list - ,@(js--optimize-arglist args))) - - (js-get-service (&rest args) - `(js--js-get-service - ,@(js--optimize-arglist args))) - - (js-create-instance (&rest args) - `(js--js-create-instance - ,@(js--optimize-arglist args))) - - (js-qi (&rest args) - `(js--js-qi - ,@(js--optimize-arglist args))) - - (js< (&rest body) `(js--js-get - ,@(js--optimize-arglist body))) - (js> (props value) - `(js--js-funcall - '(interactor "_putProp") - ,(if (consp props) - (cons 'list - (js--optimize-arglist props)) - props) - ,@(js--optimize-arglist (list value)) - )) - (js-handle? (arg) `(js--js-handle-p ,arg))) - ,@forms) - (js--js-leave-repl)))) - -(defvar js--js-array-as-list nil - "Whether to listify any Array returned by a Mozilla function. -If nil, the whole Array is treated as a JS symbol.") - -(defun js--js-decode-retval (result) - (pcase (intern (cl-first result)) - ('atom (cl-second result)) - ('special (intern (cl-second result))) - ('array - (mapcar #'js--js-decode-retval (cl-second result))) - ('objid - (or (gethash (cl-second result) - js--js-references) - (puthash (cl-second result) - (make-js--js-handle - :id (cl-second result) - :process (inferior-moz-process)) - js--js-references))) - - ('error (signal 'js-js-error (list (cl-second result)))) - (x (error "Unmatched case in js--js-decode-retval: %S" x)))) - -(defvar comint-last-input-end) - -(defun js--js-funcall (function &rest arguments) - "Call the Mozilla function FUNCTION with arguments ARGUMENTS. -If function is a string, look it up as a property on the global -object and use the global object for `this'. -If FUNCTION is a list with one element, use that element as the -function with the global object for `this', except that if that -single element is a string, look it up on the global object. -If FUNCTION is a list with more than one argument, use the list -up to the last value as a property descriptor and the last -argument as a function." - - (with-js - (let ((argstr (js--js-encode-value - (cons function arguments)))) - - (with-current-buffer inferior-moz-buffer - ;; Actual funcall - (when js--js-array-as-list - (insert "*")) - (insert argstr) - (comint-send-input nil t) - (js--wait-for-matching-output - (inferior-moz-process) "EVAL>" - js-js-timeout) - (goto-char comint-last-input-end) - - ;; Read the result - (let* ((json-array-type 'list) - (result (prog1 (json-read) - (goto-char (point-max))))) - (js--js-decode-retval result)))))) - -(defun js--js-new (constructor &rest arguments) - "Call CONSTRUCTOR as a constructor, with arguments ARGUMENTS. -CONSTRUCTOR is a JS handle, a string, or a list of these things." - (apply #'js--js-funcall - '(interactor "_callNew") - constructor arguments)) - -(defun js--js-eval (thisobj js) - (js--js-funcall '(interactor "_callEval") thisobj js)) - -(defun js--js-list (&rest arguments) - "Return a Lisp array resulting from evaluating each of ARGUMENTS." - (let ((js--js-array-as-list t)) - (apply #'js--js-funcall '(interactor "_mkArray") - arguments))) - -(defun js--js-get (&rest props) - (apply #'js--js-funcall '(interactor "_getProp") props)) - -(defun js--js-put (props value) - (js--js-funcall '(interactor "_putProp") props value)) - -(defun js-gc (&optional force) - "Tell the repl about any objects we don't reference anymore. -With argument, run even if no intervening GC has happened." - (interactive) - - (when force - (setq js--js-last-gcs-done nil)) - - (let ((this-gcs-done gcs-done) keys num) - (when (and js--js-references - (boundp 'inferior-moz-buffer) - (buffer-live-p inferior-moz-buffer) - - ;; Don't bother running unless we've had an intervening - ;; garbage collection; without a gc, nothing is deleted - ;; from the weak hash table, so it's pointless telling - ;; MozRepl about that references we still hold - (not (eq js--js-last-gcs-done this-gcs-done)) - - ;; Are we looking at a normal prompt? Make sure not to - ;; interrupt the user if he's doing something - (with-current-buffer inferior-moz-buffer - (save-excursion - (goto-char (point-max)) - (looking-back js--js-prompt-regexp - (save-excursion (forward-line 0) (point)))))) - - (setq keys (cl-loop for x being the hash-keys - of js--js-references - collect x)) - (setq num (js--js-funcall '(repl "_jsGC") (or keys []))) - - (setq js--js-last-gcs-done this-gcs-done) - (when (called-interactively-p 'interactive) - (message "Cleaned %s entries" num)) - - num))) - -(run-with-idle-timer 30 t #'js-gc) - -(defun js-eval (js) - "Evaluate the JavaScript in JS and return JSON-decoded result." - (interactive "MJavaScript to evaluate: ") - (with-js - (let* ((content-window (js--js-content-window - (js--get-js-context))) - (result (js-eval content-window js))) - (when (called-interactively-p 'interactive) - (message "%s" (js! "String" result))) - result))) - -(defun js--get-tabs () - "Enumerate all JavaScript contexts available. -Each context is a list: - (TITLE URL BROWSER TAB TABBROWSER) for content documents - (TITLE URL WINDOW) for windows - -All tabs of a given window are grouped together. The most recent -window is first. Within each window, the tabs are returned -left-to-right." - (with-js - (let (windows) - - (cl-loop with window-mediator = (js! ("Components" "classes" - "@mozilla.org/appshell/window-mediator;1" - "getService") - (js< "Components" "interfaces" - "nsIWindowMediator")) - with enumerator = (js! (window-mediator "getEnumerator") nil) - - while (js? (js! (enumerator "hasMoreElements"))) - for window = (js! (enumerator "getNext")) - for window-info = (js-list window - (js< window "document" "title") - (js! (window "location" "toString")) - (js< window "closed") - (js< window "windowState")) - - unless (or (js? (cl-fourth window-info)) - (eq (cl-fifth window-info) 2)) - do (push window-info windows)) - - (cl-loop for (window title location) in windows - collect (list title location window) - - for gbrowser = (js< window "gBrowser") - if (js-handle? gbrowser) - nconc (cl-loop - for x below (js< gbrowser "browsers" "length") - collect (js-list (js< gbrowser - "browsers" - x - "contentDocument" - "title") - - (js! (gbrowser - "browsers" - x - "contentWindow" - "location" - "toString")) - (js< gbrowser - "browsers" - x) - - (js! (gbrowser - "tabContainer" - "childNodes" - "item") - x) - - gbrowser)))))) - -(defvar js-read-tab-history nil) - -(declare-function ido-chop "ido" (items elem)) - -(defun js--read-tab (prompt) - "Read a Mozilla tab with prompt PROMPT. -Return a cons of (TYPE . OBJECT). TYPE is either `window' or -`tab', and OBJECT is a JavaScript handle to a ChromeWindow or a -browser, respectively." - - ;; Prime IDO - (unless ido-mode - (ido-mode 1) - (ido-mode -1)) - - (with-js - (let ((tabs (js--get-tabs)) selected-tab-cname - selected-tab prev-hitab) - - ;; Disambiguate names - (setq tabs - (cl-loop with tab-names = (make-hash-table :test 'equal) - for tab in tabs - for cname = (format "%s (%s)" - (cl-second tab) (cl-first tab)) - for num = (cl-incf (gethash cname tab-names -1)) - if (> num 0) - do (setq cname (format "%s <%d>" cname num)) - collect (cons cname tab))) - - (cl-labels - ((find-tab-by-cname - (cname) - (cl-loop for tab in tabs - if (equal (car tab) cname) - return (cdr tab))) - - (mogrify-highlighting - (hitab unhitab) - - ;; Hack to reduce the number of - ;; round-trips to mozilla - (let (cmds) - (cond - ;; Highlighting tab - ((cl-fourth hitab) - (push '(js! ((cl-fourth hitab) "setAttribute") - "style" - "color: red; font-weight: bold") - cmds) - - ;; Highlight window proper - (push '(js! ((cl-third hitab) - "setAttribute") - "style" - "border: 8px solid red") - cmds) - - ;; Select tab, when appropriate - (when js-js-switch-tabs - (push - '(js> ((cl-fifth hitab) "selectedTab") (cl-fourth hitab)) - cmds))) - - ;; Highlighting whole window - ((cl-third hitab) - (push '(js! ((cl-third hitab) "document" - "documentElement" "setAttribute") - "style" - (concat "-moz-appearance: none;" - "border: 8px solid red;")) - cmds))) - - (cond - ;; Unhighlighting tab - ((cl-fourth unhitab) - (push '(js! ((cl-fourth unhitab) "setAttribute") "style" "") - cmds) - (push '(js! ((cl-third unhitab) "setAttribute") "style" "") - cmds)) - - ;; Unhighlighting window - ((cl-third unhitab) - (push '(js! ((cl-third unhitab) "document" - "documentElement" "setAttribute") - "style" "") - cmds))) - - (eval `(with-js - (js-list ,@(nreverse cmds))) - t))) - - (command-hook - () - (let* ((tab (find-tab-by-cname (car ido-matches)))) - (mogrify-highlighting tab prev-hitab) - (setq prev-hitab tab))) - - (setup-hook - () - ;; Fiddle with the match list a bit: if our first match - ;; is a tabbrowser window, rotate the match list until - ;; the active tab comes up - (let ((matched-tab (find-tab-by-cname (car ido-matches)))) - (when (and matched-tab - (null (cl-fourth matched-tab)) - (equal "navigator:browser" - (js! ((cl-third matched-tab) - "document" - "documentElement" - "getAttribute") - "windowtype"))) - - (cl-loop with tab-to-match = (js< (cl-third matched-tab) - "gBrowser" - "selectedTab") - - for match in ido-matches - for candidate-tab = (find-tab-by-cname match) - if (eq (cl-fourth candidate-tab) tab-to-match) - do (setq ido-cur-list - (ido-chop ido-cur-list match)) - and return t))) - - (add-hook 'post-command-hook #'command-hook t t))) - - - (unwind-protect - ;; FIXME: Don't impose IDO on the user. - (setq selected-tab-cname - (let ((ido-minibuffer-setup-hook - (cons #'setup-hook ido-minibuffer-setup-hook))) - (ido-completing-read - prompt - (mapcar #'car tabs) - nil t nil - 'js-read-tab-history))) - - (when prev-hitab - (mogrify-highlighting nil prev-hitab) - (setq prev-hitab nil))) - - (add-to-history 'js-read-tab-history selected-tab-cname) - - (setq selected-tab (cl-loop for tab in tabs - if (equal (car tab) selected-tab-cname) - return (cdr tab))) - - (cons (if (cl-fourth selected-tab) 'browser 'window) - (cl-third selected-tab)))))) - -(defun js--guess-eval-defun-info (pstate) - "Helper function for `js-eval-defun'. -Return a list (NAME . CLASSPARTS), where CLASSPARTS is a list of -strings making up the class name and NAME is the name of the -function part." - (cond ((and (= (length pstate) 3) - (eq (js--pitem-type (cl-first pstate)) 'function) - (= (length (js--pitem-name (cl-first pstate))) 1) - (consp (js--pitem-type (cl-second pstate)))) - - (append (js--pitem-name (cl-second pstate)) - (list (cl-first (js--pitem-name (cl-first pstate)))))) - - ((and (= (length pstate) 2) - (eq (js--pitem-type (cl-first pstate)) 'function)) - - (append - (butlast (js--pitem-name (cl-first pstate))) - (list (car (last (js--pitem-name (cl-first pstate))))))) - - (t (error "Function not a toplevel defun or class member")))) - -(defvar js--js-context nil - "The current JavaScript context. -This is a cons like the one returned from `js--read-tab'. -Change with `js-set-js-context'.") - -(defconst js--js-inserter - "(function(func_info,func) { - func_info.unshift('window'); - var obj = window; - for(var i = 1; i < func_info.length - 1; ++i) { - var next = obj[func_info[i]]; - if(typeof next !== 'object' && typeof next !== 'function') { - next = obj.prototype && obj.prototype[func_info[i]]; - if(typeof next !== 'object' && typeof next !== 'function') { - alert('Could not find ' + func_info.slice(0, i+1).join('.') + - ' or ' + func_info.slice(0, i+1).join('.') + '.prototype'); - return; - } - - func_info.splice(i+1, 0, 'prototype'); - ++i; - } - } - - obj[func_info[i]] = func; - alert('Successfully updated '+func_info.join('.')); - })") - -(defun js-set-js-context (context) - "Set the JavaScript context to CONTEXT. -When called interactively, prompt for CONTEXT." - (interactive (list (js--read-tab "JavaScript Context: "))) - (setq js--js-context context)) - -(defun js--get-js-context () - "Return a valid JavaScript context. -If one hasn't been set, or if it's stale, prompt for a new one." - (with-js - (when (or (null js--js-context) - (js--js-handle-expired-p (cdr js--js-context)) - (pcase (car js--js-context) - ('window (js? (js< (cdr js--js-context) "closed"))) - ('browser (not (js? (js< (cdr js--js-context) - "contentDocument")))) - (x (error "Unmatched case in js--get-js-context: %S" x)))) - (setq js--js-context (js--read-tab "JavaScript Context: "))) - js--js-context)) - -(defun js--js-content-window (context) - (with-js - (pcase (car context) - ('window (cdr context)) - ('browser (js< (cdr context) - "contentWindow" "wrappedJSObject")) - (x (error "Unmatched case in js--js-content-window: %S" x))))) - -(defun js--make-nsilocalfile (path) - (with-js - (let ((file (js-create-instance "@mozilla.org/file/local;1" - "nsILocalFile"))) - (js! (file "initWithPath") path) - file))) - -(defun js--js-add-resource-alias (alias path) - (with-js - (let* ((io-service (js-get-service "@mozilla.org/network/io-service;1" - "nsIIOService")) - (res-prot (js! (io-service "getProtocolHandler") "resource")) - (res-prot (js-qi res-prot "nsIResProtocolHandler")) - (path-file (js--make-nsilocalfile path)) - (path-uri (js! (io-service "newFileURI") path-file))) - (js! (res-prot "setSubstitution") alias path-uri)))) - -(cl-defun js-eval-defun () - "Update a Mozilla tab using the JavaScript defun at point." - (interactive) - - ;; This function works by generating a temporary file that contains - ;; the function we'd like to insert. We then use the elisp-js bridge - ;; to command mozilla to load this file by inserting a script tag - ;; into the document we set. This way, debuggers and such will have - ;; a way to find the source of the just-inserted function. - ;; - ;; We delete the temporary file if there's an error, but otherwise - ;; we add an unload event listener on the Mozilla side to delete the - ;; file. - - (save-excursion - (let (begin end pstate defun-info temp-name defun-body) - (js-end-of-defun) - (setq end (point)) - (js--ensure-cache) - (js-beginning-of-defun) - (re-search-forward "\\_<function\\_>") - (setq begin (match-beginning 0)) - (setq pstate (js--forward-pstate)) - - (when (or (null pstate) - (> (point) end)) - (error "Could not locate function definition")) - - (setq defun-info (js--guess-eval-defun-info pstate)) - - (let ((overlay (make-overlay begin end))) - (overlay-put overlay 'face 'highlight) - (unwind-protect - (unless (y-or-n-p (format "Send %s to Mozilla? " - (mapconcat #'identity defun-info "."))) - (message "") ; question message lingers until next command - (cl-return-from js-eval-defun)) - (delete-overlay overlay))) - - (setq defun-body (buffer-substring-no-properties begin end)) - - (make-directory js-js-tmpdir t) - - ;; (Re)register a Mozilla resource URL to point to the - ;; temporary directory - (js--js-add-resource-alias "js" js-js-tmpdir) - - (setq temp-name (make-temp-file (concat js-js-tmpdir - "/js-") - nil ".js")) - (unwind-protect - (with-js - (with-temp-buffer - (insert js--js-inserter) - (insert "(") - (let ((standard-output (current-buffer))) - (json--print-list defun-info)) - (insert ",\n") - (insert defun-body) - (insert "\n)") - (write-region (point-min) (point-max) temp-name - nil 1)) - - ;; Give Mozilla responsibility for deleting this file - (let* ((content-window (js--js-content-window - (js--get-js-context))) - (content-document (js< content-window "document")) - (head (if (js? (js< content-document "body")) - ;; Regular content - (js< (js! (content-document "getElementsByTagName") - "head") - 0) - ;; Chrome - (js< content-document "documentElement"))) - (elem (js! (content-document "createElementNS") - "http://www.w3.org/1999/xhtml" "script"))) - - (js! (elem "setAttribute") "type" "text/javascript") - (js! (elem "setAttribute") "src" - (format "resource://js/%s" - (file-name-nondirectory temp-name))) - - (js! (head "appendChild") elem) - - (js! (content-window "addEventListener") "unload" - (js! ((js-new - "Function" "file" - "return function() { file.remove(false) }")) - (js--make-nsilocalfile temp-name)) - 'false) - (setq temp-name nil) - - - - )) - - ;; temp-name is set to nil on success - (when temp-name - (delete-file temp-name)))))) - ;;; Syntax extensions (defvar js-syntactic-mode-name t diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 6bf070cf9e5..79530f81673 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1814,18 +1814,18 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first." (user-error "Aborted"))) (_ name))) -(defvar find-tag-marker-ring) +(declare-function xref-push-marker-stack "xref" (&optional m)) (defun octave-find-definition (fn) "Find the definition of FN. Functions implemented in C++ can be found if variable `octave-source-directories' is set correctly." (interactive (list (octave-completing-read))) - (require 'etags) + (require 'xref) (let ((orig (point))) (if (and (derived-mode-p 'octave-mode) (octave-goto-function-definition fn)) - (ring-insert find-tag-marker-ring (copy-marker orig)) + (xref-push-marker-stack (copy-marker orig)) (inferior-octave-send-list-and-digest ;; help NAME is more verbose (list (format "\ @@ -1840,7 +1840,7 @@ if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n" (setq file (match-string 1 line)))) (if (not file) (user-error "%s" (or line (format-message "`%s' not found" fn))) - (ring-insert find-tag-marker-ring (point-marker)) + (xref-push-marker-stack) (setq file (funcall octave-find-definition-filename-function file)) (when file (find-file file) diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index e6e6e40aa19..5938da542ac 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1357,9 +1357,7 @@ The default is a name found in the buffer around point." default "")) (label ;; Do completion with default. - (completing-read (if (not (string= default "")) - (concat "Label (default " default "): ") - "Label: ") + (completing-read (format-prompt "Label" default) ;; Complete with the defuns found in the ;; current-buffer. (let ((buf (current-buffer))) diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 3e1a915e320..db350a5f704 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -51,7 +51,7 @@ (unless (xref-marker-stack-empty-p) (define-key-after menu [xref-pop] - '(menu-item "Back Definition" xref-pop-marker-stack + '(menu-item "Back Definition" xref-go-back :help "Back to the position of the last search") 'prog-separator)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da7435cddf3..ed076a683d1 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -322,7 +322,15 @@ to find the list of ignores for each directory." (process-file-shell-command command nil t)) (pt (point-min))) (unless (zerop status) - (error "File listing failed: %s" (buffer-string))) + (goto-char (point-min)) + (if (and + (not (eql status 127)) + (search-forward "Permission denied\n" nil t)) + (let ((end (1- (point)))) + (re-search-backward "\\`\\|\0") + (error "File listing failed: %s" + (buffer-substring (1+ (point)) end))) + (error "File listing failed: %s" (buffer-string)))) (goto-char pt) (while (search-forward "\0" nil t) (push (buffer-substring-no-properties (1+ pt) (1- (point))) @@ -840,28 +848,36 @@ pattern to search for." project-regexp-history-variable))) ;;;###autoload -(defun project-find-file () +(defun project-find-file (&optional include-all) "Visit a file (with completion) in the current project. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." - (interactive) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'." + (interactive "P") (let* ((pr (project-current t)) (dirs (list (project-root pr)))) - (project-find-file-in (thing-at-point 'filename) dirs pr))) + (project-find-file-in (thing-at-point 'filename) dirs pr include-all))) ;;;###autoload -(defun project-or-external-find-file () +(defun project-or-external-find-file (&optional include-all) "Visit a file (with completion) in the current project or external roots. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." - (interactive) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'." + (interactive "P") (let* ((pr (project-current t)) (dirs (cons (project-root pr) (project-external-roots pr)))) - (project-find-file-in (thing-at-point 'filename) dirs pr))) + (project-find-file-in (thing-at-point 'filename) dirs pr include-all))) (defcustom project-read-file-name-function #'project--read-file-cpd-relative "Function to call to read a file name from a list. @@ -914,12 +930,25 @@ by the user at will." predicate hist mb-default)) -(defun project-find-file-in (suggested-filename dirs project) +(defun project-find-file-in (suggested-filename dirs project &optional include-all) "Complete a file name in DIRS in PROJECT and visit the result. SUGGESTED-FILENAME is a relative file name, or part of it, which -is used as part of \"future history\"." - (let* ((all-files (project-files project dirs)) +is used as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files from DIRS, except for VCS +directories listed in `vc-directory-exclusion-list'." + (let* ((vc-dirs-ignores (mapcar + (lambda (dir) + (concat dir "/")) + vc-directory-exclusion-list)) + (all-files + (if include-all + (mapcan + (lambda (dir) (project--files-in-directory dir vc-dirs-ignores)) + dirs) + (project-files project dirs))) (completion-ignore-case read-file-name-completion-ignore-case) (file (funcall project-read-file-name-function "Find file" all-files nil nil diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 59004e413eb..c36082bb6d0 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -2484,11 +2484,8 @@ Interaction supports completion." (if (eq (try-completion default prolog-info-alist) nil) (setq default nil)) ;; Read the PredSpec from the user - (completing-read - (if (zerop (length default)) - "Help on predicate: " - (concat "Help on predicate (default " default "): ")) - prolog-info-alist nil t nil nil default))) + (completing-read (format-prompt "Help on predicate" default) + prolog-info-alist nil t nil nil default))) (defun prolog-build-info-alist (&optional verbose) "Build an alist of all builtins and library predicates. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f1c3e75bb73..b12f5ddc0d1 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina <fgallina@gnu.org> ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.2") (cl-lib "1.0")) +;; Package-Requires: ((emacs "24.4") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -1518,7 +1518,10 @@ Returns nil if point is not in a def or class." (python-util-forward-comment -1) (forward-line 1) ;; Ensure point moves forward. - (and (> beg-pos (point)) (goto-char beg-pos))))) + (and (> beg-pos (point)) (goto-char beg-pos)) + ;; Return non-nil if we did something (because then we were in a + ;; def/class). + (/= beg-pos (point))))) (defun python-nav--syntactically (fn poscompfn &optional contextfn) "Move point using FN avoiding places with specific context. @@ -2724,20 +2727,12 @@ goes wrong and syntax highlighting in the shell gets messed up." (deactivate-mark nil) (start-pos prompt-end) (buffer-undo-list t) - (font-lock-buffer-pos nil) (replacement (python-shell-font-lock-with-font-lock-buffer - (delete-region (line-beginning-position) - (point-max)) - (setq font-lock-buffer-pos (point)) + (delete-region (point-min) (point-max)) (insert input) - ;; Ensure buffer is fontified, keeping it - ;; compatible with Emacs < 24.4. - (if (fboundp 'font-lock-ensure) - (funcall 'font-lock-ensure) - (font-lock-default-fontify-buffer)) - (buffer-substring font-lock-buffer-pos - (point-max)))) + (font-lock-ensure) + (buffer-string))) (replacement-length (length replacement)) (i 0)) ;; Inject text properties to get input fontified. @@ -3810,7 +3805,7 @@ With argument MSG show activation/deactivation message." (comint-redirect-perform-sanity-check nil) (comint-redirect-insert-matching-regexp t) (comint-redirect-finished-regexp - "1__dummy_completion__[[:space:]]*\n") + "1__dummy_completion__.*\n") (comint-redirect-output-buffer redirect-buffer)) ;; Compatibility with Emacs 24.x. Comint changed and ;; now `comint-redirect-filter' gets 3 args. This @@ -4670,7 +4665,10 @@ See `python-check-command' for the default." target = obj objtype = 'def' if target: - args = inspect.formatargspec(*argspec_function(target)) + if hasattr(inspect, 'signature'): + args = str(inspect.signature(target)) + else: + args = inspect.formatargspec(*argspec_function(target)) name = obj.__name__ doc = '{objtype} {name}{args}'.format( objtype=objtype, name=name, args=args @@ -4769,10 +4767,14 @@ Interactively, prompt for symbol." (interactive (let ((symbol (python-eldoc--get-symbol-at-point)) (enable-recursive-minibuffers t)) - (list (read-string (if symbol - (format "Describe symbol (default %s): " symbol) - "Describe symbol: ") - nil nil symbol)))) + (list (read-string + ;; `format-prompt' is new in Emacs 28.1. + (if (fboundp 'format-prompt) + (format-prompt "Describe symbol" symbol) + (if symbol + (format "Describe symbol (default %s): " symbol) + "Describe symbol: ")) + nil nil symbol)))) (message (python-eldoc--get-doc-at-point symbol))) (defun python-describe-at-point (symbol process) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 57351a7308d..abcdcb3349e 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -143,7 +143,6 @@ (setq-local comment-start-skip ";+[ \t]*") (setq-local comment-use-syntax t) (setq-local comment-column 40) - (setq-local parse-sexp-ignore-comments t) (setq-local lisp-indent-function 'scheme-indent-function) (setq mode-line-process '("" scheme-mode-line-process)) (setq-local imenu-case-fold-search t) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0dd9f2b4fa2..c6b6f83471d 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -628,7 +628,8 @@ removed when closing the here document." (wksh sh-append ksh88) (zsh sh-append ksh88 - "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" + "autoload" "always" + "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" "disable" "disown" "echotc" "enable" "functions" "getln" "hash" "history" "integer" "limit" "local" "log" "popd" "pushd" "r" "readonly" "rehash" "sched" "setopt" "source" "suspend" "true" diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 5dfbf87e452..f5888a0ce7a 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -481,9 +481,9 @@ file. Since that is a plaintext file, this could be dangerous." :list-all ("\\d+" . "\\dS+") :list-table ("\\d+ %s" . "\\dS+ %s") :completion-object sql-postgres-completion-object - :prompt-regexp "^[[:alnum:]_]*=[#>] " + :prompt-regexp "^[-[:alnum:]_]*[-=][#>] " :prompt-length 5 - :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] " + :prompt-cont-regexp "^[-[:alnum:]_]*[-'(][#>] " :statement sql-postgres-statement-starters :input-filter sql-remove-tabs-filter :terminator ("\\(^\\s-*\\\\g\\|;\\)" . "\\g")) @@ -700,8 +700,17 @@ making new SQLi sessions." (sexp :tag "Value Expression"))))) :version "24.1") -(defvaralias 'sql-dialect 'sql-product) +(defun sql-add-connection (connection params) + "Add a new connection to `sql-connection-alist'. +If CONNECTION already exists, it is replaced with PARAMS." + (setq sql-connection-alist + (assoc-delete-all connection sql-connection-alist)) + (push + (cons connection params) + sql-connection-alist)) + +(defvaralias 'sql-dialect 'sql-product) (defcustom sql-product 'ansi "Select the SQL database product used. This allows highlighting buffers properly when you open them." @@ -963,12 +972,7 @@ If set to \"\\n\", each line in the history file will be interpreted as one command. Multi-line commands are split into several commands when the input ring is initialized from a history file. -This variable used to initialize `comint-input-ring-separator'. -`comint-input-ring-separator' is part of Emacs 21; if your Emacs -does not have it, setting `sql-input-ring-separator' will have no -effect. In that case multiline commands will be split into several -commands when the input history is read, as if you had set -`sql-input-ring-separator' to \"\\n\"." +This variable used to initialize `comint-input-ring-separator'." :type 'string) ;; The usual hooks @@ -1357,8 +1361,6 @@ specified, it's `sql-product' or `sql-connection' must match." (defvar sql-interactive-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map comint-mode-map) - (if (fboundp 'set-keymap-name) - (set-keymap-name map 'sql-interactive-mode-map)); XEmacs (define-key map (kbd "C-j") 'sql-accumulate-and-indent) (define-key map (kbd "C-c C-w") 'sql-copy-column) (define-key map (kbd "O") 'sql-magic-go) @@ -2832,16 +2834,6 @@ configured." (font-lock-mode-internal nil) (font-lock-mode-internal t)) - (add-hook 'font-lock-mode-hook - (lambda () - ;; Provide defaults for new font-lock faces. - (defvar font-lock-builtin-face - (if (boundp 'font-lock-preprocessor-face) - font-lock-preprocessor-face - font-lock-keyword-face)) - (defvar font-lock-doc-face font-lock-string-face)) - nil t) - ;; Setup imenu; it needs the same syntax-alist. (when imenu (setq imenu-syntax-alist syntax-alist)))) @@ -3219,14 +3211,7 @@ For both `:file' and `:completion', there can also be a symbol (let* ((default (plist-get plist :default)) (last-value (sql-default-value symbol)) - (prompt-def - (if default - (if (string-match "\\(\\):[ \t]*\\'" prompt) - (replace-match (format " (default \"%s\")" default) t t prompt 1) - (replace-regexp-in-string "[ \t]*\\'" - (format " (default \"%s\") " default) - prompt t t)) - prompt)) + (prompt-def (format-prompt prompt default)) (use-dialog-box nil)) (cond ((plist-member plist :file) @@ -3311,7 +3296,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (let ((plist (cdr-safe w))) (pcase (or (car-safe w) w) ('user - (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) + (sql-get-login-ext 'sql-user "User" 'sql-user-history plist)) ('password (setq-default sql-password @@ -3330,14 +3315,14 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (read-passwd "Password: " nil (sql-default-value 'sql-password))))) ('server - (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) + (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist)) ('database - (sql-get-login-ext 'sql-database "Database: " + (sql-get-login-ext 'sql-database "Database" 'sql-database-history plist)) ('port - (sql-get-login-ext 'sql-port "Port: " + (sql-get-login-ext 'sql-port "Port" nil (append '(:number t) plist))))))) (defun sql-find-sqli-buffer (&optional product connection) @@ -4182,10 +4167,6 @@ must tell Emacs. Here's how to do that in your init file: (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table - (when (and (featurep 'xemacs) - sql-mode-menu) - (easy-menu-add sql-mode-menu)) - ;; (smie-setup sql-smie-grammar #'sql-smie-rules) (setq-local comment-start "--") ;; Make each buffer in sql-mode remember the "current" SQLi buffer. @@ -4308,9 +4289,6 @@ you entered, right above the output it created. (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name) (symbol-name sql-product)) "]")) - (when (and (featurep 'xemacs) - sql-interactive-mode-menu) - (easy-menu-add sql-interactive-mode-menu)) ;; Note that making KEYWORDS-ONLY nil will cause havoc if you try ;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column @@ -4681,6 +4659,14 @@ the call to \\[sql-product-interactive] with (get-buffer new-sqli-buffer))))) (user-error "No default SQL product defined: set `sql-product'"))) +(defun sql-comint-automatic-password (_) + "Intercept password prompts when we know the password. +This must also do the job of detecting password prompts." + (when (and + sql-password + (not (string= "" sql-password))) + sql-password)) + (defun sql-comint (product params &optional buf-name) "Set up a comint buffer to run the SQL processor. @@ -4705,6 +4691,13 @@ buffer. If nil, a name is chosen for it." (setq buf-name (sql-generate-unique-sqli-buffer-name product nil))) (set-text-properties 0 (length buf-name) nil buf-name) + ;; Create the buffer first, because we want to set it up before + ;; comint starts to run. + (set-buffer (get-buffer-create buf-name)) + ;; Set up the automatic population of passwords, if supported. + (when (sql-get-product-feature product :password-in-comint) + (setq comint-password-function #'sql-comint-automatic-password)) + ;; Start the command interpreter in the buffer ;; PROC-NAME is BUF-NAME without enclosing asterisks (let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1" buf-name))) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 52c34d9fbc6..14f252b42d4 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2021.09.23.089128420 +;; Version: 2021.10.14.127365406 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2021-09-23-54ffde4-vpo-GNU" +(defconst verilog-mode-version "2021-10-14-797711e-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -1264,7 +1264,9 @@ See `verilog-auto-inst-param-value'." Also affects AUTOINSTPARAM. Declaration order is the default for backward compatibility, and as some teams prefer signals that are declared together to remain together. Sorted order reduces -changes when declarations are moved around in a file. +changes when declarations are moved around in a file. Sorting is +within input/output/inout groupings, there is intentionally no +option to intermix between input/output/inouts. See also `verilog-auto-arg-sort'." :version "24.1" ; rev688 @@ -5478,8 +5480,11 @@ becomes: (let* ((pop-up-windows t)) (let ((name (expand-file-name (read-file-name - (format "Find this error in: (default %s) " - file) + ;; `format-prompt' is new in Emacs 28.1. + (if (fboundp 'format-prompt) + (format-prompt "Find this error in" file) + (format "Find this error in (default %s): " + file)) nil ;; dir file t)))) (setq buffer @@ -6598,7 +6603,8 @@ Also move point to constraint." (equal (char-before) ?\;) (equal (char-before) ?\})) ;; skip what looks like bus repetition operator {#{ - (not (string-match "^{\\s-*[\\(\\)0-9a-zA-Z_]*\\s-*{" (buffer-substring p (point))))))))) + (not (string-match "^{\\s-*[()0-9a-zA-Z_\\]*\\s-*{" + (buffer-substring p (point))))))))) (progn (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) @@ -7863,14 +7869,14 @@ If search fails, other files are checked based on (let* ((default (verilog-get-default-symbol)) ;; The following variable is used in verilog-comp-function (verilog-buffer-to-use (current-buffer)) - (label (if (not (string= default "")) - ;; Do completion with default - (completing-read (concat "Goto-Label: (default " - default ") ") - #'verilog-comp-defun nil nil "") - ;; There is no default value. Complete without it - (completing-read "Goto-Label: " - #'verilog-comp-defun nil nil ""))) + (label + (completing-read (cond ((fboundp 'format-prompt) + ;; `format-prompt' is new in Emacs 28.1. + (format-prompt "Goto-Label" default)) + ((not (string= default "")) + (concat "Goto-Label (default " default "): ")) + (t "Goto-Label: ")) + #'verilog-comp-defun nil nil "")) pt) ;; Make sure library paths are correct, in case need to resolve module (verilog-auto-reeval-locals) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 46922a3f3b9..26188bbddab 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. -;; Version: 1.3.0 +;; Version: 1.3.2 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -75,7 +75,7 @@ (require 'project) (eval-and-compile - (when (version< emacs-version "28") + (when (version< emacs-version "28.0.60") ;; etags.el in Emacs 26 and 27 uses EIEIO, and its location type ;; inherits from `xref-location'. (require 'eieio) @@ -195,16 +195,23 @@ is not known." ;;; Cross-reference -(cl-defstruct (xref-item - (:constructor xref-make (summary location)) - (:noinline t)) +(defmacro xref--defstruct (name &rest fields) + (declare (indent 1)) + `(cl-defstruct ,(if (>= emacs-major-version 27) + name + (remq (assq :noinline name) name)) + ,@fields)) + +(xref--defstruct (xref-item + (:constructor xref-make (summary location)) + (:noinline t)) "An xref item describes a reference to a location somewhere." summary location) -(cl-defstruct (xref-match-item - (:include xref-item) - (:constructor xref-make-match (summary location length)) - (:noinline t)) +(xref--defstruct (xref-match-item + (:include xref-item) + (:constructor xref-make-match (summary location length)) + (:noinline t)) "A match xref item describes a search result." length) @@ -334,15 +341,9 @@ backward." (t (goto-char start) nil)))) -;;; Marker stack (M-. pushes, M-, pops) - -(defcustom xref-marker-ring-length 16 - "Length of the xref marker ring. -If this variable is not set through Customize, you must call -`xref-set-marker-ring-length' for changes to take effect." - :type 'integer - :initialize #'custom-initialize-default - :set #'xref-set-marker-ring-length) +;; Dummy variable retained for compatibility. +(defvar xref-marker-ring-length 16) +(make-obsolete-variable 'xref-marker-ring-length nil "29.1") (defcustom xref-prompt-for-identifier '(not xref-find-definitions xref-find-definitions-other-window @@ -413,29 +414,49 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) -(defvar xref--marker-ring (make-ring xref-marker-ring-length) - "Ring of markers to implement the marker stack.") +(defvar xref--history (cons nil nil) + "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.") -(defun xref-set-marker-ring-length (var val) - "Set `xref-marker-ring-length'. -VAR is the symbol `xref-marker-ring-length' and VAL is the new -value." - (set-default var val) - (if (ring-p xref--marker-ring) - (ring-resize xref--marker-ring val))) +(make-obsolete-variable 'xref-marker-ring nil "29.1") + +(defun xref-set-marker-ring-length (_var _val) + (declare (obsolete nil "29.1")) + nil) (defun xref-push-marker-stack (&optional m) - "Add point M (defaults to `point-marker') to the marker stack." - (ring-insert xref--marker-ring (or m (point-marker)))) + "Add point M (defaults to `point-marker') to the marker stack. +The future stack is erased." + (push (or m (point-marker)) (car xref--history)) + (dolist (mk (cdr xref--history)) + (set-marker mk nil nil)) + (setcdr xref--history nil)) + +;;;###autoload +(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1") + +;;;###autoload +(defun xref-go-back () + "Go back to the previous position in xref history. +To undo, use \\[xref-go-forward]." + (interactive) + (if (null (car xref--history)) + (user-error "At start of xref history") + (let ((marker (pop (car xref--history)))) + (push (point-marker) (cdr xref--history)) + (switch-to-buffer (or (marker-buffer marker) + (user-error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil) + (run-hooks 'xref-after-return-hook)))) ;;;###autoload -(defun xref-pop-marker-stack () - "Pop back to where \\[xref-find-definitions] was last invoked." +(defun xref-go-forward () + "Got to the point where a previous \\[xref-go-back] was invoked." (interactive) - (let ((ring xref--marker-ring)) - (when (ring-empty-p ring) - (user-error "Marker stack is empty")) - (let ((marker (ring-remove ring 0))) + (if (null (cdr xref--history)) + (user-error "At end of xref history") + (let ((marker (pop (cdr xref--history)))) + (push (point-marker) (car xref--history)) (switch-to-buffer (or (marker-buffer marker) (user-error "The marked buffer has been deleted"))) (goto-char (marker-position marker)) @@ -458,17 +479,23 @@ value." ;; etags.el needs this (defun xref-clear-marker-stack () - "Discard all markers from the marker stack." - (let ((ring xref--marker-ring)) - (while (not (ring-empty-p ring)) - (let ((marker (ring-remove ring))) - (set-marker marker nil nil))))) + "Discard all markers from the xref history." + (dolist (l (list (car xref--history) (cdr xref--history))) + (dolist (m l) + (set-marker m nil nil))) + (setq xref--history (cons nil nil)) + nil) ;;;###autoload (defun xref-marker-stack-empty-p () - "Return t if the marker stack is empty; nil otherwise." - (ring-empty-p xref--marker-ring)) + "Whether the xref back-history is empty." + (null (car xref--history))) +;; FIXME: rename this to `xref-back-history-empty-p'. +;;;###autoload +(defun xref-forward-history-empty-p () + "Whether the xref forward-history is empty." + (null (cdr xref--history))) (defun xref--goto-char (pos) @@ -683,7 +710,7 @@ quit the *xref* buffer." "Quit *xref* buffer, then pop the xref marker stack." (interactive) (quit-window) - (xref-pop-marker-stack)) + (xref-go-back)) (defun xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. @@ -1322,12 +1349,17 @@ definitions." (xref--prompt-p this-command)) (let ((id (completing-read - (if def - (format "%s (default %s): " - (substring prompt 0 (string-match - "[ :]+\\'" prompt)) - def) - prompt) + ;; `format-prompt' is new in Emacs 28.1 + (if (fboundp 'format-prompt) + (format-prompt (substring prompt 0 (string-match + "[ :]+\\'" prompt)) + def) + (if def + (format "%s (default %s): " + (substring prompt 0 (string-match + "[ :]+\\'" prompt)) + def) + prompt)) (xref-backend-identifier-completion-table backend) nil nil nil 'xref--read-identifier-history def))) @@ -1388,7 +1420,7 @@ definition for IDENTIFIER, display it in the selected window. Otherwise, display the list of the possible definitions in a buffer where the user can select from the list. -Use \\[xref-pop-marker-stack] to return back to where you invoked this command." +Use \\[xref-go-back] to return back to where you invoked this command." (interactive (list (xref--read-identifier "Find definitions of: "))) (xref--find-definitions identifier nil)) @@ -1479,7 +1511,8 @@ output of this command when the backend is etags." ;;; Key bindings ;;;###autoload (define-key esc-map "." #'xref-find-definitions) -;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack) +;;;###autoload (define-key esc-map "," #'xref-go-back) +;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward) ;;;###autoload (define-key esc-map "?" #'xref-find-references) ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos) ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index ab8af40628a..2d1dcd2b686 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1209,8 +1209,8 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n" (ps-output-prologue (format "ETOP%d %d %d put\n" i (car font) index)) (setq index (1+ index)))) (ps-output-prologue (format "/VTOP%d [%s] def\n" i - (mapconcat #'(lambda (x) - (format "F%02X" (cdr x))) + (mapconcat (lambda (x) + (format "F%02X" (cdr x))) font-list " "))))) ;; Redefine fonts f0, f1, f2, f3, h0, h1, H0. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index b1d03fda1d4..0fc95546794 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3855,7 +3855,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." (defun ps-color-scale (color) ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. - (mapcar #'(lambda (value) (/ value ps-print-color-scale)) + (mapcar (lambda (value) (/ value ps-print-color-scale)) (color-values color))) @@ -4747,11 +4747,11 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defun ps-background-pages (page-list func) (if page-list (mapcar - #'(lambda (pages) - (let ((start (if (consp pages) (car pages) pages)) - (end (if (consp pages) (cdr pages) pages))) - (and (integerp start) (integerp end) (<= start end) - (add-to-list 'ps-background-pages (vector start end func))))) + (lambda (pages) + (let ((start (if (consp pages) (car pages) pages)) + (end (if (consp pages) (cdr pages) pages))) + (and (integerp start) (integerp end) (<= start end) + (add-to-list 'ps-background-pages (vector start end func))))) page-list) (setq ps-background-all-pages (cons func ps-background-all-pages)))) @@ -4789,76 +4789,76 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defun ps-background-text () (mapcar - #'(lambda (text) - (setq ps-background-text-count (1+ ps-background-text-count)) - (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count)) - (ps-output-string (nth 0 text)) ; text - (ps-output - "\n" - (ps-float-format (nth 4 text) 200.0) ; font size - (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name - (ps-float-format (nth 6 text) - "PrintHeight PrintPageWidth atan") ; rotation - (ps-float-format (nth 5 text) 0.85) ; gray - (ps-float-format (nth 1 text) "0") ; x position - (ps-float-format (nth 2 text) "0") ; y position - "\nShowBackText}def\n") - (ps-background-pages (nthcdr 7 text) ; page list - (format "ShowBackText-%d\n" - ps-background-text-count))) + (lambda (text) + (setq ps-background-text-count (1+ ps-background-text-count)) + (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count)) + (ps-output-string (nth 0 text)) ; text + (ps-output + "\n" + (ps-float-format (nth 4 text) 200.0) ; font size + (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name + (ps-float-format (nth 6 text) + "PrintHeight PrintPageWidth atan") ; rotation + (ps-float-format (nth 5 text) 0.85) ; gray + (ps-float-format (nth 1 text) "0") ; x position + (ps-float-format (nth 2 text) "0") ; y position + "\nShowBackText}def\n") + (ps-background-pages (nthcdr 7 text) ; page list + (format "ShowBackText-%d\n" + ps-background-text-count))) ps-print-background-text)) (defun ps-background-image () (mapcar - #'(lambda (image) - (let ((image-file (expand-file-name (nth 0 image)))) - (when (file-readable-p image-file) - (setq ps-background-image-count (1+ ps-background-image-count)) - (ps-output - (format "/ShowBackImage-%d{\n--back-- " - ps-background-image-count) - (ps-float-format (nth 5 image) 0.0) ; rotation - (ps-float-format (nth 3 image) 1.0) ; x scale - (ps-float-format (nth 4 image) 1.0) ; y scale - (ps-float-format (nth 1 image) ; x position - "PrintPageWidth 2 div") - (ps-float-format (nth 2 image) ; y position - "PrintHeight 2 div BottomMargin add") - "\nBeginBackImage\n") - (ps-insert-file image-file) - ;; coordinate adjustment to center image - ;; around x and y position - (let ((box (ps-get-boundingbox))) - (with-current-buffer ps-spool-buffer - (save-excursion - (if (re-search-backward "^--back--" nil t) - (replace-match - (format "%s %s" - (ps-float-format - (- (+ (/ (- (aref box 2) (aref box 0)) 2.0) - (aref box 0)))) - (ps-float-format - (- (+ (/ (- (aref box 3) (aref box 1)) 2.0) - (aref box 1))))) - t))))) - (ps-output "\nEndBackImage}def\n") - (ps-background-pages (nthcdr 6 image) ; page list - (format "ShowBackImage-%d\n" - ps-background-image-count))))) + (lambda (image) + (let ((image-file (expand-file-name (nth 0 image)))) + (when (file-readable-p image-file) + (setq ps-background-image-count (1+ ps-background-image-count)) + (ps-output + (format "/ShowBackImage-%d{\n--back-- " + ps-background-image-count) + (ps-float-format (nth 5 image) 0.0) ; rotation + (ps-float-format (nth 3 image) 1.0) ; x scale + (ps-float-format (nth 4 image) 1.0) ; y scale + (ps-float-format (nth 1 image) ; x position + "PrintPageWidth 2 div") + (ps-float-format (nth 2 image) ; y position + "PrintHeight 2 div BottomMargin add") + "\nBeginBackImage\n") + (ps-insert-file image-file) + ;; coordinate adjustment to center image + ;; around x and y position + (let ((box (ps-get-boundingbox))) + (with-current-buffer ps-spool-buffer + (save-excursion + (if (re-search-backward "^--back--" nil t) + (replace-match + (format "%s %s" + (ps-float-format + (- (+ (/ (- (aref box 2) (aref box 0)) 2.0) + (aref box 0)))) + (ps-float-format + (- (+ (/ (- (aref box 3) (aref box 1)) 2.0) + (aref box 1))))) + t))))) + (ps-output "\nEndBackImage}def\n") + (ps-background-pages (nthcdr 6 image) ; page list + (format "ShowBackImage-%d\n" + ps-background-image-count))))) ps-print-background-image)) (defun ps-background (page-number) (let (has-local-background) - (mapc #'(lambda (range) - (and (<= (aref range 0) page-number) - (<= page-number (aref range 1)) - (if has-local-background - (ps-output (aref range 2)) - (setq has-local-background t) - (ps-output "/printLocalBackground{\n" - (aref range 2))))) + (mapc (lambda (range) + (and (<= (aref range 0) page-number) + (<= page-number (aref range 1)) + (if has-local-background + (ps-output (aref range 2)) + (setq has-local-background t) + (ps-output "/printLocalBackground{\n" + (aref range 2))))) ps-background-pages) (and has-local-background (ps-output "}def\n")))) @@ -5697,8 +5697,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") (> (car page) 0) (<= (car page) (cdr page)) (setq new (cons page new)))))) - (setq ps-selected-pages (sort new #'(lambda (one other) - (< (car one) (car other)))) + (setq ps-selected-pages (sort new (lambda (one other) + (< (car one) (car other)))) ps-last-selected-pages ps-selected-pages ps-first-page nil ps-last-page nil)) @@ -5782,8 +5782,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") "unspecified-fg" 0.0) ps-foreground-list (mapcar - #'(lambda (arg) - (ps-rgb-color arg "unspecified-fg" 0.0)) + (lambda (arg) + (ps-rgb-color arg "unspecified-fg" 0.0)) (append (and (not (member ps-print-color-p '(nil black-white))) ps-fg-list) @@ -6012,9 +6012,9 @@ XSTART YSTART are the relative position for the first page in a sheet.") (if (and (boundp 'ucs-mule-8859-to-mule-unicode) (char-table-p ucs-mule-8859-to-mule-unicode)) (map-char-table - #'(lambda (k v) - (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v)) - (aset tbl k v))) + (lambda (k v) + (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v)) + (aset tbl k v))) ucs-mule-8859-to-mule-unicode)) tbl) "Translation table for PostScript printing. diff --git a/lisp/recentf.el b/lisp/recentf.el index 57cbaf0debb..6b5a47c66fd 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -674,55 +674,55 @@ Return nil if file NAME is not one of the ten more recent." "Sort the list of menu elements L in ascending order. The MENU-ITEM part of each menu element is compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (recentf-menu-element-item e1) - (recentf-menu-element-item e2))))) + (lambda (e1 e2) + (recentf-string-lessp + (recentf-menu-element-item e1) + (recentf-menu-element-item e2))))) (defsubst recentf-sort-descending (l) "Sort the list of menu elements L in descending order. The MENU-ITEM part of each menu element is compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (recentf-menu-element-item e2) - (recentf-menu-element-item e1))))) + (lambda (e1 e2) + (recentf-string-lessp + (recentf-menu-element-item e2) + (recentf-menu-element-item e1))))) (defsubst recentf-sort-basenames-ascending (l) "Sort the list of menu elements L in ascending order. Only filenames sans directory are compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (file-name-nondirectory (recentf-menu-element-value e1)) - (file-name-nondirectory (recentf-menu-element-value e2)))))) + (lambda (e1 e2) + (recentf-string-lessp + (file-name-nondirectory (recentf-menu-element-value e1)) + (file-name-nondirectory (recentf-menu-element-value e2)))))) (defsubst recentf-sort-basenames-descending (l) "Sort the list of menu elements L in descending order. Only filenames sans directory are compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (file-name-nondirectory (recentf-menu-element-value e2)) - (file-name-nondirectory (recentf-menu-element-value e1)))))) + (lambda (e1 e2) + (recentf-string-lessp + (file-name-nondirectory (recentf-menu-element-value e2)) + (file-name-nondirectory (recentf-menu-element-value e1)))))) (defsubst recentf-sort-directories-ascending (l) "Sort the list of menu elements L in ascending order. Compares directories then filenames to order the list." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-directory-compare - (recentf-menu-element-value e1) - (recentf-menu-element-value e2))))) + (lambda (e1 e2) + (recentf-directory-compare + (recentf-menu-element-value e1) + (recentf-menu-element-value e2))))) (defsubst recentf-sort-directories-descending (l) "Sort the list of menu elements L in descending order. Compares directories then filenames to order the list." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-directory-compare - (recentf-menu-element-value e2) - (recentf-menu-element-value e1))))) + (lambda (e1 e2) + (recentf-directory-compare + (recentf-menu-element-value e2) + (recentf-menu-element-value e1))))) (defun recentf-show-basenames (l &optional no-dir) "Filter the list of menu elements L to show filenames sans directory. @@ -1382,5 +1382,5 @@ buffers you switch to a lot, you can say something like the following: (provide 'recentf) (run-hooks 'recentf-load-hook) - + ;;; recentf.el ends here diff --git a/lisp/replace.el b/lisp/replace.el index 84ec042f455..5287be2c524 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2263,11 +2263,11 @@ See also `multi-occur'." (defun occur-engine-add-prefix (lines &optional prefix-face) (mapcar - #'(lambda (line) - (concat (if prefix-face - (propertize " :" 'font-lock-face prefix-face) - " :") - line "\n")) + (lambda (line) + (concat (if prefix-face + (propertize " :" 'font-lock-face prefix-face) + " :") + line "\n")) lines)) (defun occur-accumulate-lines (count &optional keep-props pt) diff --git a/lisp/select.el b/lisp/select.el index 15e171c13f9..3c9f961f6db 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -440,13 +440,13 @@ two markers or an overlay. Otherwise, it is nil." (setq type 'C_STRING)) (t (let (non-latin-1 non-unicode eight-bit) - (mapc #'(lambda (x) - (if (>= x #x100) - (if (< x #x110000) - (setq non-latin-1 t) - (if (< x #x3FFF80) - (setq non-unicode t) - (setq eight-bit t))))) + (mapc (lambda (x) + (if (>= x #x100) + (if (< x #x110000) + (setq non-latin-1 t) + (if (< x #x3FFF80) + (setq non-unicode t) + (setq eight-bit t))))) str) (setq type (if (or non-unicode (and diff --git a/lisp/server.el b/lisp/server.el index 6359a761994..d9986562377 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -90,12 +90,12 @@ (defcustom server-use-tcp nil "If non-nil, use TCP sockets instead of local sockets." - :set #'(lambda (sym val) - (unless (featurep 'make-network-process '(:family local)) - (setq val t) - (unless load-in-progress - (message "Local sockets unsupported, using TCP sockets"))) - (set-default sym val)) + :set (lambda (sym val) + (unless (featurep 'make-network-process '(:family local)) + (setq val t) + (unless load-in-progress + (message "Local sockets unsupported, using TCP sockets"))) + (set-default sym val)) :type 'boolean :version "22.1") @@ -485,11 +485,11 @@ If CLIENT is non-nil, add a description of it to the logged message." (when (and (frame-live-p frame) proc ;; See if this is the last frame for this client. - (>= 1 (let ((frame-num 0)) - (dolist (f (frame-list)) - (when (eq proc (frame-parameter f 'client)) - (setq frame-num (1+ frame-num)))) - frame-num))) + (not (seq-some + (lambda (f) + (and (not (eq frame f)) + (eq proc (frame-parameter f 'client)))) + (frame-list)))) (server-log (format "server-handle-delete-frame, frame %s" frame) proc) (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later. @@ -1580,13 +1580,13 @@ specifically for the clients and did not exist before their request for it." (server-buffer-done (current-buffer)))) (defun server-kill-emacs-query-function () - "Ask before exiting Emacs if it has live clients." - (or (not (let (live-client) - (dolist (proc server-clients) - (when (memq t (mapcar #'buffer-live-p - (process-get proc 'buffers))) - (setq live-client t))) - live-client)) + "Ask before exiting Emacs if it has live clients. +A \"live client\" is a client with at least one live buffer +associated with it." + (or (not (seq-some (lambda (proc) + (seq-some #'buffer-live-p + (process-get proc 'buffers))) + server-clients)) (yes-or-no-p "This Emacs session has clients; exit anyway? "))) (defun server-kill-buffer () diff --git a/lisp/ses.el b/lisp/ses.el index ea966295b18..5e2d254881b 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -3554,7 +3554,7 @@ With prefix, sorts in REVERSE order." (push (cons (buffer-substring-no-properties (point) end) (+ minrow x)) keys)) - (setq keys (sort keys #'(lambda (x y) (string< (car x) (car y))))) + (setq keys (sort keys (lambda (x y) (string< (car x) (car y))))) ;;Extract the lines in reverse sorted order (or reverse (setq keys (nreverse keys))) @@ -3774,7 +3774,9 @@ function is redefined." (setq name (intern name)) (let* ((cur-printer (gethash name ses--local-printer-hashmap)) (default (and cur-printer (ses--locprn-def cur-printer)))) - (setq def (ses-read-printer (format "Enter definition of printer %S" name) + (setq def (ses-read-printer (format-prompt + "Enter definition of printer %S" + default name) default))) (list name def))) diff --git a/lisp/simple.el b/lisp/simple.el index 94a459b7795..456844d08ec 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -527,21 +527,28 @@ Other major modes are defined by comparison with this one." (kill-all-local-variables) (run-mode-hooks)) +(define-derived-mode clean-mode fundamental-mode "Clean" + "A mode that removes all overlays and text properties." + (kill-all-local-variables t) + (let ((inhibit-read-only t)) + (dolist (overlay (overlays-in (point-min) (point-max))) + (delete-overlay overlay)) + (set-text-properties (point-min) (point-max) nil) + (setq-local yank-excluded-properties t))) + ;; Special major modes to view specially formatted data rather than files. -(defvar special-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'quit-window) - (define-key map " " 'scroll-up-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map "\C-?" 'scroll-down-command) - (define-key map "?" 'describe-mode) - (define-key map "h" 'describe-mode) - (define-key map ">" 'end-of-buffer) - (define-key map "<" 'beginning-of-buffer) - (define-key map "g" 'revert-buffer) - map)) +(defvar-keymap special-mode-map + :suppress t + "q" #'quit-window + " " #'scroll-up-command + [?\S-\ ] #'scroll-down-command + "\C-?" #'scroll-down-command + "?" #'describe-mode + "h" #'describe-mode + ">" #'end-of-buffer + "<" #'beginning-of-buffer + "g" #'revert-buffer) (put 'special-mode 'mode-class 'special) (define-derived-mode special-mode nil "Special" @@ -703,9 +710,10 @@ When called from Lisp code, ARG may be a prefix string to copy." :height 0.1 :background "#505050") (((type graphic) (background light)) :height 0.1 :background "#a0a0a0") - (t :foreground "ForestGreen")) + (t + :foreground "ForestGreen" :underline t)) "Face for separator lines." - :version "28.1" + :version "29.1" :group 'text) (defun make-separator-line (&optional length) @@ -713,14 +721,10 @@ When called from Lisp code, ARG may be a prefix string to copy." This uses the `separator-line' face. If LENGTH is nil, use the window width." - (if (display-graphic-p) - (if length - (concat (propertize (make-string length ?\s) 'face 'separator-line) - "\n") - (propertize "\n" 'face '(:inherit separator-line :extend t))) - (concat (propertize (make-string (or length (1- (window-width))) ?-) - 'face 'separator-line) - "\n"))) + (if length + (concat (propertize (make-string length ?\s) 'face 'separator-line) + "\n") + (propertize "\n" 'face '(:inherit separator-line :extend t)))) (defun delete-indentation (&optional arg beg end) "Join this line to previous and fix up whitespace at join. @@ -5069,10 +5073,11 @@ interact nicely with `interprogram-cut-function' and interaction; you may want to use them instead of manipulating the kill ring directly.") -(defcustom kill-ring-max 60 +(defcustom kill-ring-max 120 "Maximum length of kill ring before oldest elements are thrown away." :type 'integer - :group 'killing) + :group 'killing + :version "29.1") (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") @@ -8573,40 +8578,43 @@ The function should return non-nil if the two tokens do not match.") (current-buffer)) (sit-for blink-matching-delay)) (delete-overlay blink-matching--overlay))))) - (t - (let ((open-paren-line-string - (save-excursion - (goto-char blinkpos) - ;; Show what precedes the open in its line, if anything. - (cond - ((save-excursion (skip-chars-backward " \t") (not (bolp))) - (buffer-substring (line-beginning-position) - (1+ blinkpos))) - ;; Show what follows the open in its line, if anything. - ((save-excursion - (forward-char 1) - (skip-chars-forward " \t") - (not (eolp))) - (buffer-substring blinkpos - (line-end-position))) - ;; Otherwise show the previous nonblank line, - ;; if there is one. - ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) - (concat - (buffer-substring (progn - (skip-chars-backward "\n \t") - (line-beginning-position)) - (progn (end-of-line) - (skip-chars-backward " \t") - (point))) - ;; Replace the newline and other whitespace with `...'. - "..." - (buffer-substring blinkpos (1+ blinkpos)))) - ;; There is nothing to show except the char itself. - (t (buffer-substring blinkpos (1+ blinkpos))))))) - (minibuffer-message - "Matches %s" - (substring-no-properties open-paren-line-string)))))))) + ((not show-paren-context-when-offscreen) + (minibuffer-message + "Matches %s" + (substring-no-properties + (blink-paren-open-paren-line-string blinkpos)))))))) + +(defun blink-paren-open-paren-line-string (pos) + "Return the line string that contains the openparen at POS." + (save-excursion + (goto-char pos) + ;; Show what precedes the open in its line, if anything. + (cond + ((save-excursion (skip-chars-backward " \t") (not (bolp))) + (buffer-substring (line-beginning-position) + (1+ pos))) + ;; Show what follows the open in its line, if anything. + ((save-excursion + (forward-char 1) + (skip-chars-forward " \t") + (not (eolp))) + (buffer-substring pos + (line-end-position))) + ;; Otherwise show the previous nonblank line, + ;; if there is one. + ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) + (concat + (buffer-substring (progn + (skip-chars-backward "\n \t") + (line-beginning-position)) + (progn (end-of-line) + (skip-chars-backward " \t") + (point))) + ;; Replace the newline and other whitespace with `...'. + "..." + (buffer-substring pos (1+ pos)))) + ;; There is nothing to show except the char itself. + (t (buffer-substring pos (1+ pos)))))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. @@ -9856,6 +9864,7 @@ does not have any effect until this variable is set. CUSTOMIZATIONS, if non-nil, should be composed of alternating `defcustom' keywords and values to add to the declaration of `COMMAND-alternatives' (typically :group and :version)." + (declare (indent defun)) (let* ((command-name (symbol-name command)) (varalt-name (concat command-name "-alternatives")) (varalt-sym (intern varalt-name)) diff --git a/lisp/skeleton.el b/lisp/skeleton.el index c363fb2c489..2b183996d83 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -113,7 +113,8 @@ are integer buffer positions in the reverse order of the insertion order.") "Define a user-configurable COMMAND that enters a statement skeleton. DOCUMENTATION is that of the command. SKELETON is as defined under `skeleton-insert'." - (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec))) + (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec)) + (indent defun)) (if skeleton-debug (set command skeleton)) `(progn diff --git a/lisp/sort.el b/lisp/sort.el index d6767ed5098..09259805415 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -540,8 +540,8 @@ Use \\[untabify] to convert tabs to spaces before sorting." (narrow-to-region beg1 end1) (goto-char beg1) (sort-subr reverse 'forward-line 'end-of-line - #'(lambda () (move-to-column col-start) nil) - #'(lambda () (move-to-column col-end) nil)))))))) + (lambda () (move-to-column col-start) nil) + (lambda () (move-to-column col-end) nil)))))))) ;;;###autoload (defun reverse-region (beg end) diff --git a/lisp/subr.el b/lisp/subr.el index 8ff403e1139..f6dbd00532e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -193,7 +193,7 @@ set earlier in the `setq-local'. The return value of the "Define VAR as a buffer-local variable with default value VAL. Like `defvar' but additionally marks the variable as being automatically buffer-local wherever it is set." - (declare (debug defvar) (doc-string 3)) + (declare (debug defvar) (doc-string 3) (indent 2)) ;; Can't use backquote here, it's too early in the bootstrap. (list 'progn (list 'defvar var val docstring) (list 'make-variable-buffer-local (list 'quote var)))) @@ -925,19 +925,191 @@ side-effects, and the argument LIST is not modified." ;;;; Keymap support. +(defun kbd-valid-p (keys) + "Say whether KEYS is a valid `kbd' sequence. +A `kbd' sequence is a string consisting of one and more key +strokes. The key strokes are separated by a space character. + +Each key stroke is either a single character, or the name of an +event, surrounded by angle brackets. In addition, any key stroke +may be preceded by one or more modifier keys. Finally, a limited +number of characters have a special shorthand syntax. + +Here's some example key sequences. + + \"f\" (the key 'f') + \"S o m\" (a three key sequence of the keys 'S', 'o' and 'm') + \"C-c o\" (a two key sequence of the keys 'c' with the control modifier + and then the key 'o') + \"H-<left>\" (the key named \"left\" with the hyper modifier) + \"M-RET\" (the \"return\" key with a meta modifier) + \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers) + +These are the characters that have shorthand syntax: +NUL, RET, TAB, LFD, ESC, SPC, DEL. + +Modifiers have to be specified in this order: + + A-C-H-M-S-s + +which is + + Alt-Control-Hyper-Meta-Shift-super" + (declare (pure t) (side-effect-free t)) + (and (stringp keys) + (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) + (save-match-data + (catch 'exit + (let ((prefixes + "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?") + (case-fold-search nil)) + (dolist (key (split-string keys " ")) + ;; Every key might have these modifiers, and they should be + ;; in this order. + (when (string-match (concat "\\`" prefixes) key) + (setq key (substring key (match-end 0)))) + (unless (or (and (= (length key) 1) + ;; Don't accept control characters as keys. + (not (< (aref key 0) ?\s)) + ;; Don't accept Meta'd characters as keys. + (or (multibyte-string-p key) + (not (<= 127 (aref key 0) 255)))) + (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key) + ;; Don't allow <M-C-down>. + (= (progn + (string-match + (concat "\\`<" prefixes) key) + (match-end 0)) + 1)) + (string-match-p + "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" + key)) + ;; Invalid. + (throw 'exit nil))) + t))))) + (defun kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such as `C-h k' (`describe-key'). + This is the same format used for saving keyboard macros (see `edmacro-mode'). +Here's some example key sequences: + + \"f\" + \"C-c C-c\" + \"H-<left>\" + \"M-RET\" + \"C-M-<return>\" + 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) (side-effect-free t)) ;; A pure function is expected to preserve the match data. - (save-match-data (read-kbd-macro keys))) + (save-match-data + (let ((case-fold-search nil) + (len (length keys)) ; We won't alter keys in the loop below. + (pos 0) + (res [])) + (while (and (< pos len) + (string-match "[^ \t\n\f]+" keys pos)) + (let* ((word-beg (match-beginning 0)) + (word-end (match-end 0)) + (word (substring keys word-beg len)) + (times 1) + key) + ;; Try to catch events of the form "<as df>". + (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) + (setq word (match-string 0 word) + pos (+ word-beg (match-end 0))) + (setq word (substring keys word-beg word-end) + pos word-end)) + (when (string-match "\\([0-9]+\\)\\*." word) + (setq times (string-to-number (substring word 0 (match-end 1)))) + (setq word (substring word (1+ (match-end 1))))) + (cond ((string-match "^<<.+>>$" word) + (setq key (vconcat (if (eq (key-binding [?\M-x]) + 'execute-extended-command) + [?\M-x] + (or (car (where-is-internal + 'execute-extended-command)) + [?\M-x])) + (substring word 2 -2) "\r"))) + ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) + (progn + (setq word (concat (match-string 1 word) + (match-string 3 word))) + (not (string-match + "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" + word)))) + (setq key (list (intern word)))) + ((or (equal word "REM") (string-match "^;;" word)) + (setq pos (string-match "$" keys pos))) + (t + (let ((orig-word word) (prefix 0) (bits 0)) + (while (string-match "^[ACHMsS]-." word) + (setq bits (+ bits (cdr (assq (aref word 0) + '((?A . ?\A-\^@) (?C . ?\C-\^@) + (?H . ?\H-\^@) (?M . ?\M-\^@) + (?s . ?\s-\^@) (?S . ?\S-\^@)))))) + (setq prefix (+ prefix 2)) + (setq word (substring word 2))) + (when (string-match "^\\^.$" word) + (setq bits (+ bits ?\C-\^@)) + (setq prefix (1+ prefix)) + (setq word (substring word 1))) + (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") + ("LFD" . "\n") ("TAB" . "\t") + ("ESC" . "\e") ("SPC" . " ") + ("DEL" . "\177"))))) + (when found (setq word (cdr found)))) + (when (string-match "^\\\\[0-7]+$" word) + (let ((n 0)) + (dolist (ch (cdr (string-to-list word))) + (setq n (+ (* n 8) ch -48))) + (setq word (vector n)))) + (cond ((= bits 0) + (setq key word)) + ((and (= bits ?\M-\^@) (stringp word) + (string-match "^-?[0-9]+$" word)) + (setq key (mapcar (lambda (x) (+ x bits)) + (append word nil)))) + ((/= (length word) 1) + (error "%s must prefix a single character, not %s" + (substring orig-word 0 prefix) word)) + ((and (/= (logand bits ?\C-\^@) 0) (stringp word) + ;; We used to accept . and ? here, + ;; but . is simply wrong, + ;; and C-? is not used (we use DEL instead). + (string-match "[@-_a-z]" word)) + (setq key (list (+ bits (- ?\C-\^@) + (logand (aref word 0) 31))))) + (t + (setq key (list (+ bits (aref word 0))))))))) + (when key + (dolist (_ (number-sequence 1 times)) + (setq res (vconcat res key)))))) + (when (and (>= (length res) 4) + (eq (aref res 0) ?\C-x) + (eq (aref res 1) ?\() + (eq (aref res (- (length res) 2)) ?\C-x) + (eq (aref res (- (length res) 1)) ?\))) + (setq res (apply #'vector (let ((lres (append res nil))) + ;; Remove the first and last two elements. + (setq lres (cdr (cdr lres))) + (nreverse lres) + (setq lres (cdr (cdr lres))) + (nreverse lres) + lres)))) + (if (not (memq nil (mapcar (lambda (ch) + (and (numberp ch) + (<= 0 ch 127))) + res))) + ;; Return a string. + (concat (mapcar #'identity res)) + ;; Return a vector. + res)))) (defun undefined () "Beep to tell the user this binding is undefined." @@ -1000,6 +1172,7 @@ Bindings are always added before any inherited map. The order of bindings in a keymap matters only when it is used as a menu, so this function is not useful for non-menu keymaps." + (declare (indent defun)) (unless after (setq after t)) (or (keymapp keymap) (signal 'wrong-type-argument (list 'keymapp keymap))) @@ -1752,6 +1925,7 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete 'window-redisplay-end-trigger nil "23.1") (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") (make-obsolete-variable 'operating-system-release nil "28.1") +(make-obsolete-variable 'inhibit-changing-match-data 'save-match-data "29.1") (make-obsolete 'run-window-configuration-change-hook nil "27.1") @@ -3567,6 +3741,9 @@ If either NAME or VAL are specified, both should be specified." (defvar suspend-resume-hook nil "Normal hook run by `suspend-emacs', after Emacs is continued.") +(defvar after-pdump-load-hook nil + "Normal hook run after loading the .pdmp file.") + (defvar temp-buffer-show-hook nil "Normal hook run by `with-output-to-temp-buffer' after displaying the buffer. When the hook runs, the temporary buffer is current, and the window it @@ -4386,11 +4563,6 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; that intends to handle the quit signal next time. (eval '(ignore nil))))) -;; Don't throw `throw-on-input' on those events by default. -(setq while-no-input-ignore-events - '(focus-in focus-out help-echo iconify-frame - make-frame-visible selection-request)) - (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. If input arrives, that ends the execution of BODY, @@ -4763,14 +4935,12 @@ wherever possible, since it is slow." (defsubst looking-at-p (regexp) "\ Same as `looking-at' except this function does not change the match data." - (let ((inhibit-changing-match-data t)) - (looking-at regexp))) + (looking-at regexp t)) (defsubst string-match-p (regexp string &optional start) "\ Same as `string-match' except this function does not change the match data." - (let ((inhibit-changing-match-data t)) - (string-match regexp string start))) + (string-match regexp string start t)) (defun subregexp-context-p (regexp pos &optional start) "Return non-nil if POS is in a normal subregexp context in REGEXP. @@ -5575,6 +5745,7 @@ If HOOKVAR is nil, `mail-send-hook' is used. The properties used on SYMBOL are `composefunc', `sendfunc', `abortfunc', and `hookvar'." + (declare (indent defun)) (put symbol 'composefunc composefunc) (put symbol 'sendfunc sendfunc) (put symbol 'abortfunc (or abortfunc #'kill-buffer)) @@ -6462,4 +6633,125 @@ not a list, return a one-element list containing OBJECT." object (list object))) +(defun define-keymap (&rest definitions) + "Create a new keymap and define KEY/DEFEFINITION pairs as key sequences. +The new keymap is returned. + +Options can be given as keywords before the KEY/DEFEFINITION +pairs. Available keywords are: + +:full If non-nil, create a chartable alist (see `make-keymap'). + If nil (i.e., the default), create a sparse keymap (see + `make-sparse-keymap'). + +:suppress If non-nil, the keymap will be suppressed (see `suppress-keymap'). + If `nodigits', treat digits like other chars. + +:parent If non-nil, this should be a keymap to use as the parent + (see `set-keymap-parent'). + +:keymap If non-nil, instead of creating a new keymap, the given keymap + will be destructively modified instead. + +:name If non-nil, this should be a string to use as the menu for + the keymap in case you use it as a menu with `x-popup-menu'. + +:prefix If non-nil, this should be a symbol to be used as a prefix + command (see `define-prefix-command'). If this is the case, + this symbol is returned instead of the map itself. + +KEY/DEFINITION pairs are as KEY and DEF in `define-key'. KEY can +also be the special symbol `:menu', in which case DEFINITION +should be a MENU form as accepted by `easy-menu-define'. + +\(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" + (declare (indent defun)) + (define-keymap--define definitions)) + +(defun define-keymap--define (definitions) + (let (full suppress parent name prefix keymap) + ;; Handle keywords. + (while (and definitions + (keywordp (car definitions)) + (not (eq (car definitions) :menu))) + (let ((keyword (pop definitions))) + (unless definitions + (error "Missing keyword value for %s" keyword)) + (let ((value (pop definitions))) + (pcase keyword + (:full (setq full value)) + (:keymap (setq keymap value)) + (:parent (setq parent value)) + (:suppress (setq suppress value)) + (:name (setq name value)) + (:prefix (setq prefix value)) + (_ (error "Invalid keyword: %s" keyword)))))) + + (when (and prefix + (or full parent suppress keymap)) + (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords")) + + (when (and keymap full) + (error "Invalid combination: :keymap with :full")) + + (let ((keymap (cond + (keymap keymap) + (prefix (define-prefix-command prefix nil name)) + (full (make-keymap name)) + (t (make-sparse-keymap name))))) + (when suppress + (suppress-keymap keymap (eq suppress 'nodigits))) + (when parent + (set-keymap-parent keymap parent)) + + ;; Do the bindings. + (while definitions + (let ((key (pop definitions))) + (unless definitions + (error "Uneven number of key/definition pairs")) + (let ((def (pop definitions))) + (if (eq key :menu) + (easy-menu-define nil keymap "" def) + (define-key keymap key def))))) + keymap))) + +(defmacro defvar-keymap (variable-name &rest defs) + "Define VARIABLE-NAME as a variable with a keymap definition. +See `define-keymap' for an explanation of the keywords and KEY/DEFINITION. + +In addition to the keywords accepted by `define-keymap', this +macro also accepts a `:doc' keyword, which (if present) is used +as the variable documentation string. + +\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" + (declare (indent 1)) + (let ((opts nil) + doc) + (while (and defs + (keywordp (car defs)) + (not (eq (car defs) :menu))) + (let ((keyword (pop defs))) + (unless defs + (error "Uneven number of keywords")) + (if (eq keyword :doc) + (setq doc (pop defs)) + (push keyword opts) + (push (pop defs) opts)))) + (unless (zerop (% (length defs) 2)) + (error "Uneven number of key/definition pairs: %s" defs)) + `(defvar ,variable-name + (define-keymap--define (list ,@(nreverse opts) ,@defs)) + ,@(and doc (list doc))))) + +(defmacro with-delayed-message (args &rest body) + "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. +The MESSAGE form will be evaluated immediately, but the resulting +string will be displayed only if BODY takes longer than TIMEOUT seconds. + +\(fn (timeout message) &rest body)" + (declare (indent 1)) + `(funcall-with-delayed-message ,(car args) ,(cadr args) + (lambda () + ,@body))) + ;;; subr.el ends here diff --git a/lisp/term.el b/lisp/term.el index e76eb77647f..698bef08b2d 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -303,6 +303,7 @@ (require 'ange-ftp) (require 'cl-lib)) (require 'comint) ; Password regexp. +(require 'ansi-color) (require 'ehelp) (require 'ring) (require 'shell) @@ -710,13 +711,20 @@ Buffer local variable.") (defvar term-ansi-at-save-pwd nil) (defvar term-ansi-at-save-anon nil) (defvar term-ansi-current-bold nil) +(defvar term-ansi-current-faint nil) +(defvar term-ansi-current-italic nil) +(defvar term-ansi-current-underline nil) +(defvar term-ansi-current-slow-blink nil) +(defvar term-ansi-current-fast-blink nil) (defvar term-ansi-current-color 0) (defvar term-ansi-face-already-done nil) (defvar term-ansi-current-bg-color 0) -(defvar term-ansi-current-underline nil) (defvar term-ansi-current-reverse nil) (defvar term-ansi-current-invisible nil) +(make-obsolete-variable 'term-ansi-face-already-done + "it doesn't have any effect." "29.1") + ;;; Faces (defvar ansi-term-color-vector [term @@ -765,12 +773,36 @@ Buffer local variable.") :group 'term :version "28.1") +(defface term-faint + '((t :inherit ansi-color-faint)) + "Default face to use for faint text." + :group 'term + :version "29.1") + +(defface term-italic + '((t :inherit ansi-color-italic)) + "Default face to use for italic text." + :group 'term + :version "29.1") + (defface term-underline '((t :inherit ansi-color-underline)) "Default face to use for underlined text." :group 'term :version "28.1") +(defface term-slow-blink + '((t :inherit ansi-color-slow-blink)) + "Default face to use for slowly blinking text." + :group 'term + :version "29.1") + +(defface term-fast-blink + '((t :inherit ansi-color-fast-blink)) + "Default face to use for rapidly blinking text." + :group 'term + :version "29.1") + (defface term-color-black '((t :inherit ansi-color-black)) "Face used to render black color code." @@ -1034,15 +1066,15 @@ is buffer-local." (defun term-ansi-reset () (setq term-current-face 'term) - (setq term-ansi-current-underline nil) (setq term-ansi-current-bold nil) + (setq term-ansi-current-faint nil) + (setq term-ansi-current-italic nil) + (setq term-ansi-current-underline nil) + (setq term-ansi-current-slow-blink nil) + (setq term-ansi-current-fast-blink nil) (setq term-ansi-current-reverse nil) (setq term-ansi-current-color 0) (setq term-ansi-current-invisible nil) - ;; Stefan thought this should be t, but could not remember why. - ;; Setting it to t seems to cause bug#11785. Setting it to nil - ;; again to see if there are other consequences... - (setq term-ansi-face-already-done nil) (setq term-ansi-current-bg-color 0)) (define-derived-mode term-mode fundamental-mode "Term" @@ -1499,7 +1531,6 @@ commands to use in that buffer. (getenv "ESHELL") shell-file-name)))) (set-buffer (make-term "terminal" program)) - (term-mode) (term-char-mode) (switch-to-buffer "*terminal*")) @@ -1581,10 +1612,12 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.") :nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\ :al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=^J\ :dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\ +:mb=\\E[5m:mh=\\E[2m:ZR=\\E[23m:ZH=\\E[3m\ :so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\ :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\ :kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\ -:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\ +:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#256:pa#32767\ +:AB=\\E[48;5;%%dm:AF=\\E[38;5;%%dm:cr=^M\ :bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E[24m\ :kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:" ;; : -undefine ic @@ -2375,7 +2408,14 @@ Checks if STRING contains a password prompt as defined by (when (term-in-line-mode) (when (let ((case-fold-search t)) (string-match comint-password-prompt-regexp string)) - (term-send-invisible (read-passwd string))))) + ;; Use `run-at-time' in order not to pause execution of the + ;; process filter with a minibuffer + (run-at-time + 0 nil + (lambda (current-buf) + (with-current-buffer current-buf + (term-send-invisible (read-passwd string)))) + (current-buffer))))) ;;; Low-level process communication @@ -3104,30 +3144,34 @@ See `term-prompt-regexp'." (term-horizontal-column) term-ansi-current-bg-color term-ansi-current-bold + term-ansi-current-faint + term-ansi-current-italic + term-ansi-current-underline + term-ansi-current-slow-blink + term-ansi-current-fast-blink term-ansi-current-color term-ansi-current-invisible term-ansi-current-reverse - term-ansi-current-underline term-current-face))) (?8 ;; Restore cursor (terminfo: rc, [ctlseqs] ;; "DECRC"). (when term-saved-cursor (term-goto (nth 0 term-saved-cursor) (nth 1 term-saved-cursor)) - (setq term-ansi-current-bg-color - (nth 2 term-saved-cursor) - term-ansi-current-bold - (nth 3 term-saved-cursor) - term-ansi-current-color - (nth 4 term-saved-cursor) - term-ansi-current-invisible - (nth 5 term-saved-cursor) - term-ansi-current-reverse - (nth 6 term-saved-cursor) - term-ansi-current-underline - (nth 7 term-saved-cursor) - term-current-face - (nth 8 term-saved-cursor)))) + (pcase-setq + `( ,_ ,_ + ,term-ansi-current-bg-color + ,term-ansi-current-bold + ,term-ansi-current-faint + ,term-ansi-current-italic + ,term-ansi-current-underline + ,term-ansi-current-slow-blink + ,term-ansi-current-fast-blink + ,term-ansi-current-color + ,term-ansi-current-invisible + ,term-ansi-current-reverse + ,term-current-face) + term-saved-cursor))) (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS"). ;; This is used by the "clear" program. (term-reset-terminal)) @@ -3285,133 +3329,141 @@ option is enabled. See `term-set-goto-process-mark'." (setq term-current-row 0) (setq term-current-column 1) (term--reset-scroll-region) - (setq term-insert-mode nil) - ;; FIXME: No idea why this is here, it looks wrong. --Stef - (setq term-ansi-face-already-done nil)) - -(defun term--maybe-brighten-color (color bold) - "Possibly convert COLOR to its bright variant. -COLOR is an index into `ansi-term-color-vector'. If BOLD and -`ansi-color-bold-is-bright' are non-nil and COLOR is a regular color, -return the bright version of COLOR; otherwise, return COLOR." - (if (and ansi-color-bold-is-bright bold (<= 1 color 8)) - (+ color 8) - color)) + (setq term-insert-mode nil)) + +(defun term--color-as-hex (for-foreground) + "Return the current ANSI color as a hexadecimal color string. +Use the current background color if FOR-FOREGROUND is nil, +otherwise use the current foreground color." + (let ((color (if for-foreground term-ansi-current-color + term-ansi-current-bg-color))) + (or (ansi-color--code-as-hex (1- color)) + (progn + (and ansi-color-bold-is-bright term-ansi-current-bold + (<= 1 color 8) + (setq color (+ color 8))) + (if for-foreground + (face-foreground (elt ansi-term-color-vector color) + nil 'default) + (face-background (elt ansi-term-color-vector color) + nil 'default)))))) ;; New function to deal with ansi colorized output, as you can see you can ;; have any bold/underline/fg/bg/reverse combination. -mm (defun term-handle-colors-array (parameter) - (cond - - ;; Bold (terminfo: bold) - ((eq parameter 1) - (setq term-ansi-current-bold t)) - - ;; Underline - ((eq parameter 4) - (setq term-ansi-current-underline t)) - - ;; Blink (unsupported by Emacs), will be translated to bold. - ;; This may change in the future though. - ((eq parameter 5) - (setq term-ansi-current-bold t)) - - ;; Reverse (terminfo: smso) - ((eq parameter 7) - (setq term-ansi-current-reverse t)) - - ;; Invisible - ((eq parameter 8) - (setq term-ansi-current-invisible t)) - - ;; Reset underline (terminfo: rmul) - ((eq parameter 24) - (setq term-ansi-current-underline nil)) - - ;; Reset reverse (terminfo: rmso) - ((eq parameter 27) - (setq term-ansi-current-reverse nil)) - - ;; Foreground - ((and (>= parameter 30) (<= parameter 37)) - (setq term-ansi-current-color (- parameter 29))) - - ;; Bright foreground - ((and (>= parameter 90) (<= parameter 97)) - (setq term-ansi-current-color (- parameter 81))) - - ;; Reset foreground - ((eq parameter 39) - (setq term-ansi-current-color 0)) - - ;; Background - ((and (>= parameter 40) (<= parameter 47)) - (setq term-ansi-current-bg-color (- parameter 39))) - - ;; Bright foreground - ((and (>= parameter 100) (<= parameter 107)) - (setq term-ansi-current-bg-color (- parameter 91))) - - ;; Reset background - ((eq parameter 49) - (setq term-ansi-current-bg-color 0)) - - ;; 0 (Reset) or unknown (reset anyway) - (t - (term-ansi-reset))) - - ;; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d" - ;; term-ansi-current-underline - ;; term-ansi-current-reverse - ;; term-ansi-current-bold - ;; term-ansi-current-invisible - ;; term-ansi-face-already-done - ;; term-ansi-current-color - ;; term-ansi-current-bg-color) - - (unless term-ansi-face-already-done - (let ((current-color (term--maybe-brighten-color - term-ansi-current-color - term-ansi-current-bold)) - (current-bg-color (term--maybe-brighten-color - term-ansi-current-bg-color - term-ansi-current-bold))) - (if term-ansi-current-invisible - (let ((color - (if term-ansi-current-reverse - (face-foreground - (elt ansi-term-color-vector current-color) - nil 'default) - (face-background - (elt ansi-term-color-vector current-bg-color) - nil 'default)))) - (setq term-current-face - (list :background color - :foreground color)) - ) ;; No need to bother with anything else if it's invisible. - (setq term-current-face - (list :foreground - (face-foreground - (elt ansi-term-color-vector current-color) - nil 'default) - :background - (face-background - (elt ansi-term-color-vector current-bg-color) - nil 'default) - :inverse-video term-ansi-current-reverse)) - - (when term-ansi-current-bold - (setq term-current-face - `(,term-current-face :inherit term-bold))) - - (when term-ansi-current-underline - (setq term-current-face - `(,term-current-face :inherit term-underline)))))) - - ;; (message "Debug %S" term-current-face) - ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef - (setq term-ansi-face-already-done nil)) + (declare (obsolete term--handle-colors-list "29.1")) + (term--handle-colors-list (list parameter))) + +(defun term--handle-colors-list (parameters) + (while parameters + (pcase (pop parameters) + (1 (setq term-ansi-current-bold t)) ; (terminfo: bold) + (2 (setq term-ansi-current-faint t)) ; (terminfo: dim) + (3 (setq term-ansi-current-italic t)) ; (terminfo: sitm) + (4 (setq term-ansi-current-underline t)) ; (terminfo: smul) + (5 (setq term-ansi-current-slow-blink t)) ; (terminfo: blink) + (6 (setq term-ansi-current-fast-blink t)) + (7 (setq term-ansi-current-reverse t)) ; (terminfo: smso, rev) + (8 (setq term-ansi-current-invisible t)) ; (terminfo: invis) + (21 (setq term-ansi-current-bold nil)) + (22 (setq term-ansi-current-bold nil) + (setq term-ansi-current-faint nil)) + (23 (setq term-ansi-current-italic nil)) ; (terminfo: ritm) + (24 (setq term-ansi-current-underline nil)) ; (terminfo: rmul) + (25 (setq term-ansi-current-slow-blink nil) + (setq term-ansi-current-fast-blink nil)) + (27 (setq term-ansi-current-reverse nil)) ; (terminfo: rmso) + + ;; Foreground (terminfo: setaf) + ((and param (guard (<= 30 param 37))) + (setq term-ansi-current-color (- param 29))) + + ;; Bright foreground (terminfo: setaf) + ((and param (guard (<= 90 param 97))) + (setq term-ansi-current-color (- param 81))) + + ;; Extended foreground (terminfo: setaf) + (38 + (pcase (pop parameters) + ;; 256 color + (5 (if (setq term-ansi-current-color (pop parameters)) + (cl-incf term-ansi-current-color) + (term-ansi-reset))) + ;; Full 24-bit color + (2 (cl-loop with color = (1+ 256) ; Base + for i from 16 downto 0 by 8 + if (pop parameters) + do (setq color (+ color (ash it i))) + else return (term-ansi-reset) + finally + (if (> color (+ 1 256 #xFFFFFF)) + (term-ansi-reset) + (setq term-ansi-current-color color)))) + (_ (term-ansi-reset)))) + + ;; Reset foreground (terminfo: op) + (39 (setq term-ansi-current-color 0)) + + ;; Background (terminfo: setab) + ((and param (guard (<= 40 param 47))) + (setq term-ansi-current-bg-color (- param 39))) + + ;; Bright background (terminfo: setab) + ((and param (guard (<= 100 param 107))) + (setq term-ansi-current-bg-color (- param 91))) + + ;; Extended background (terminfo: setab) + (48 + (pcase (pop parameters) + ;; 256 color + (5 (if (setq term-ansi-current-bg-color (pop parameters)) + (cl-incf term-ansi-current-bg-color) + (term-ansi-reset))) + ;; Full 24-bit color + (2 (cl-loop with color = (1+ 256) ; Base + for i from 16 downto 0 by 8 + if (pop parameters) + do (setq color (+ color (ash it i))) + else return (term-ansi-reset) + finally + (if (> color (+ 1 256 #xFFFFFF)) + (term-ansi-reset) + (setq term-ansi-current-bg-color color)))) + (_ (term-ansi-reset)))) + + ;; Reset background (terminfo: op) + (49 (setq term-ansi-current-bg-color 0)) + + ;; 0 (Reset) (terminfo: sgr0) or unknown (reset anyway) + (_ (term-ansi-reset)))) + + (let (fg bg) + (if term-ansi-current-invisible + (setq bg (term--color-as-hex term-ansi-current-reverse) + fg bg) + (setq fg (term--color-as-hex t) + bg (term--color-as-hex nil))) + (setq term-current-face + `( :foreground ,fg + :background ,bg + ,@(unless term-ansi-current-invisible + (list :inverse-video term-ansi-current-reverse))))) + + (setq term-current-face + `(,term-current-face + ,@(when term-ansi-current-bold + '(term-bold)) + ,@(when term-ansi-current-faint + '(term-faint)) + ,@(when term-ansi-current-italic + '(term-italic)) + ,@(when term-ansi-current-underline + '(term-underline)) + ,@(when term-ansi-current-slow-blink + '(term-slow-blink)) + ,@(when term-ansi-current-fast-blink + '(term-fast-blink))))) ;; Handle a character assuming (eq terminal-state 2) - @@ -3497,9 +3549,9 @@ return the bright version of COLOR; otherwise, return COLOR." ;; Modified to allow ansi coloring -mm ;; \E[m - Set/reset modes, set bg/fg - ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) + ;;(terminfo: smso,rmso,smul,rmul,rev,bold,dim,sitm,ritm,blink,sgr0,invis,op,setab,setaf) ((eq char ?m) - (mapc #'term-handle-colors-array params)) + (term--handle-colors-list params)) ;; \E[6n - Report cursor position (terminfo: u7) ((eq char ?n) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 1a3811a37c2..67a417c1161 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -867,10 +867,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; For Darwin nothing except UTF-8 makes sense. (when (eq system-type 'darwin) (add-hook 'before-init-hook - #'(lambda () - (setq locale-coding-system 'utf-8-unix) - (setq default-process-coding-system - '(utf-8-unix . utf-8-unix))))) + (lambda () + (setq locale-coding-system 'utf-8-unix) + (setq default-process-coding-system + '(utf-8-unix . utf-8-unix))))) ;; Mac OS X Lion introduces PressAndHold, which is unsupported by this port. ;; See this thread for more details: diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 5d1dc606676..8b745c495d5 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -274,6 +274,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") '(gif "libgif-6.dll" "giflib5.dll" "gif.dll") '(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll"))) '(svg "librsvg-2-2.dll") + '(webp "libwebp-7.dll" "libwebp.dll") '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") '(glib "libglib-2.0-0.dll") '(gio "libgio-2.0-0.dll") diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index c42286e5bc3..25f0c35aa5d 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -2840,9 +2840,8 @@ Returns a list of strings." (if (memq system-type '(windows-nt ms-dos)) (artist-figlet-get-font-list-windows) (artist-figlet-get-font-list))) - (font (completing-read (concat "Select font (default " - artist-figlet-default-font - "): ") + (font (completing-read (format-prompt "Select font" + artist-figlet-default-font) (mapcar (lambda (font) (cons font font)) avail-fonts)))) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 237a1d99353..c06e8bfa1bb 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -4317,8 +4317,6 @@ for a crossref key, t otherwise." (eqb (goto-char pos)) (t (set-buffer buffer) (goto-char pos))) pos)) -;; backward compatibility -(defalias 'bibtex-find-crossref 'bibtex-search-crossref) (defun bibtex-dist (pos beg end) "Return distance between POS and region delimited by BEG and END." @@ -4381,8 +4379,6 @@ A prefix arg negates the value of `bibtex-search-entry-globally'." (if display (bibtex-reposition-window))) (display (message "Key `%s' not found" key))) pnt))) -;; backward compatibility -(defalias 'bibtex-find-entry 'bibtex-search-entry) (defun bibtex-prepare-new-entry (index) "Prepare a new BibTeX entry with index INDEX. @@ -5608,5 +5604,8 @@ If APPEND is non-nil, append ENTRIES to those already displayed." (setq buffer-read-only t) (goto-char (point-min))) +(define-obsolete-function-alias 'bibtex-find-crossref #'bibtex-search-crossref "29.1") +(define-obsolete-function-alias 'bibtex-find-entry #'bibtex-search-entry "29.1") + (provide 'bibtex) ;;; bibtex.el ends here diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index decce88573b..73d76a8ac67 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -396,12 +396,8 @@ and `fill-nobreak-invisible'." (save-excursion (skip-chars-backward " ") (and (eq (preceding-char) ?.) - (looking-at " \\([^ ]\\|$\\)")))) - ;; Another approach to the same problem. - (save-excursion - (skip-chars-backward " ") - (and (eq (preceding-char) ?.) - (not (progn (forward-char -1) (looking-at (sentence-end)))))) + ;; There's something more after the space. + (looking-at " [^ \n]")))) ;; Don't split a line if the rest would look like a new paragraph. (unless use-hard-newlines (save-excursion diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index c521a07f192..b8c75cb21b6 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -345,7 +345,17 @@ of master file." ;; Find external document specifications (goto-char 1) - (while (re-search-forward "[\n\r][ \t]*\\\\externaldocument\\(\\[\\([^]]*\\)\\]\\)?{\\([^}]+\\)}" nil t) + (while (re-search-forward + (concat "[\n\r][ \t]*" + ;; Support \externalcitedocument macro + "\\\\external\\(?:cite\\)?document" + ;; The optional prefix + "\\(\\[\\([^]]*\\)\\]\\)?" + ;; The 2nd opt. arg can only be nocite + "\\(?:\\[nocite\\]\\)?" + ;; Mandatory file argument + "{\\([^}]+\\)}") + nil t) (push (list 'xr-doc (reftex-match-string 2) (reftex-match-string 3)) docstruct)) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 7ef8161ab5c..22a90ca9cfb 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -440,7 +440,8 @@ These have to be run via `sgml-syntax-propertize'")) ;; internal (defvar sgml-face-tag-alist () - "Alist of face and tag name for facemenu.") + "Alist of face and tag name for facemenu. +The tag name can be a string or a list of strings.") (defvar sgml-tag-face-alist () "Tag names and face or list of faces to fontify with when invisible. @@ -528,11 +529,13 @@ an optional alist of possible values." (comment-indent-new-line soft))) (defun sgml-mode-facemenu-add-face-function (face _end) - (let ((tag-face (cdr (assq face sgml-face-tag-alist)))) + "Add \"face\" tags with `facemenu-keymap' commands." + (let ((tag-face (ensure-list (cdr (assq face sgml-face-tag-alist))))) (cond (tag-face (setq tag-face (funcall skeleton-transformation-function tag-face)) - (setq facemenu-end-add-face (concat "</" tag-face ">")) - (concat "<" tag-face ">")) + (setq facemenu-end-add-face + (mapconcat (lambda (f) (concat "</" f ">")) (reverse tag-face) "")) + (mapconcat (lambda (f) (concat "<" f ">")) tag-face "")) ((and (consp face) (consp (car face)) (null (cdr face)) @@ -1868,6 +1871,7 @@ This takes effect when first loading the library.") (defvar html-face-tag-alist '((bold . "strong") (italic . "em") + (bold-italic . ("strong" "em")) (underline . "u") (mode-line . "rev")) "Value of `sgml-face-tag-alist' for HTML mode.") diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 6fd66b2502f..5fba93c76eb 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2457,7 +2457,7 @@ Only applies the FSPEC to the args part of FORMAT." (default (tex-compile-default fspec))) (list default-directory (completing-read - (format "Command [%s]: " (tex-summarize-command default)) + (format-prompt "Command" (tex-summarize-command default)) (mapcar (lambda (x) (list (tex-format-cmd (eval (car x) t) fspec))) tex-compile-commands) diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 4c863883ba4..001b2c8e770 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -91,7 +91,7 @@ When it reaches that size (in bytes), a warning is sent." (defcustom thumbs-conversion-program (if (eq system-type 'windows-nt) ;; FIXME is this necessary, or can a sane PATHEXE be assumed? - ;; Eg find-program does not do this. + ;; E.g. find-program does not do this. "convert.exe" "convert") "Name of conversion program for thumbnails generation. @@ -292,22 +292,11 @@ smaller according to whether INCREMENT is 1 or -1." (thumbs-call-convert fn tn "sample" thumbs-geometry)) tn)) -(defun thumbs-image-type (img) - "Return image type from filename IMG." - (cond ((string-match ".*\\.jpe?g\\'" img) 'jpeg) - ((string-match ".*\\.xpm\\'" img) 'xpm) - ((string-match ".*\\.xbm\\'" img) 'xbm) - ((string-match ".*\\.pbm\\'" img) 'pbm) - ((string-match ".*\\.gif\\'" img) 'gif) - ((string-match ".*\\.bmp\\'" img) 'bmp) - ((string-match ".*\\.png\\'" img) 'png) - ((string-match ".*\\.tiff?\\'" img) 'tiff))) - (declare-function image-size "image.c" (spec &optional pixels frame)) (defun thumbs-file-size (img) (let ((i (image-size - (find-image `((:type ,(thumbs-image-type img) :file ,img))) t))) + (find-image `((:type ,(image-type-from-file-name img) :file ,img))) t))) (concat (number-to-string (round (car i))) "x" (number-to-string (round (cdr i)))))) @@ -410,7 +399,7 @@ and SAME-WINDOW to show thumbs in the same window." thumbs-image-num (or num 0)) (delete-region (point-min)(point-max)) (save-excursion - (thumbs-insert-image img (thumbs-image-type img) 0))))) + (thumbs-insert-image img (image-type-from-file-name img) 0))))) (defun thumbs-find-image-at-point (&optional img otherwin) "Display image IMG for thumbnail at point. @@ -544,7 +533,7 @@ Open another window." " - " (number-to-string num))) (let ((inhibit-read-only t)) (erase-buffer) - (thumbs-insert-image img (thumbs-image-type img) 0) + (thumbs-insert-image img (image-type-from-file-name img) 0) (goto-char (point-min)))) (setq thumbs-image-num num thumbs-current-image-filename img)))) @@ -775,6 +764,9 @@ ACTION and ARG should be a valid convert command." (define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked) (define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot) +(define-obsolete-function-alias 'thumbs-image-type + #'image-type-from-file-name "29.1") + (provide 'thumbs) ;;; thumbs.el ends here diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el index d40a628b994..8691f03f86d 100644 --- a/lisp/tree-widget.el +++ b/lisp/tree-widget.el @@ -214,8 +214,8 @@ Give the image the specified properties PROPS." See also the option `widget-image-conversion'." (delq nil (mapcar - #'(lambda (fmt) - (and (image-type-available-p (car fmt)) fmt)) + (lambda (fmt) + (and (image-type-available-p (car fmt)) fmt)) widget-image-conversion))) ;; Buffer local cache of theme data. diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 63b886362ba..86b62eb1ce6 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -29,23 +29,22 @@ ;;; Code: (require 'cl-lib) -(require 'pcvs-util) +(require 'pcvs) +(require 'easy-mmode) ;;; -(easy-mmode-defmap cvs-status-mode-map - '(("n" . next-line) - ("p" . previous-line) - ("N" . cvs-status-next) - ("P" . cvs-status-prev) - ("\M-n" . cvs-status-next) - ("\M-p" . cvs-status-prev) - ("t" . cvs-status-cvstrees) - ("T" . cvs-status-trees) - (">" . cvs-mode-checkout)) - "CVS-Status' keymap." - :group 'cvs-status - :inherit 'cvs-mode-map) +(defvar-keymap cvs-status-mode-map + :parent 'cvs-mode-map + "n" #'next-line + "p" #'previous-line + "N" #'cvs-status-next + "P" #'cvs-status-prev + ["M-n"] #'cvs-status-next + ["M-p"] #'cvs-status-prev + "t" #'cvs-status-cvstrees + "T" #'cvs-status-trees + ">" #'cvs-mode-checkout) ;;(easy-menu-define cvs-status-menu cvs-status-mode-map ;; "Menu for `cvs-status-mode'." diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 057ffcd06e3..746f76b46c3 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -55,6 +55,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) +(require 'easy-mmode) (autoload 'vc-find-revision "vc") (autoload 'vc-find-revision-no-save "vc") @@ -162,57 +163,55 @@ and hunk-based syntax highlighting otherwise as a fallback." ;;;; keymap, menu, ... ;;;; -(easy-mmode-defmap diff-mode-shared-map - '(("n" . diff-hunk-next) - ("N" . diff-file-next) - ("p" . diff-hunk-prev) - ("P" . diff-file-prev) - ("\t" . diff-hunk-next) - ([backtab] . diff-hunk-prev) - ("k" . diff-hunk-kill) - ("K" . diff-file-kill) - ("}" . diff-file-next) ; From compilation-minor-mode. - ("{" . diff-file-prev) - ("\C-m" . diff-goto-source) - ([mouse-2] . diff-goto-source) - ("W" . widen) - ("o" . diff-goto-source) ; other-window - ("A" . diff-ediff-patch) - ("r" . diff-restrict-view) - ("R" . diff-reverse-direction) - ([remap undo] . diff-undo)) - "Basic keymap for `diff-mode', bound to various prefix keys." - :inherit special-mode-map) - -(easy-mmode-defmap diff-mode-map - `(("\e" . ,(let ((map (make-sparse-keymap))) - ;; We want to inherit most bindings from diff-mode-shared-map, - ;; but not all since they may hide useful M-<foo> global - ;; bindings when editing. - (set-keymap-parent map diff-mode-shared-map) - (dolist (key '("A" "r" "R" "g" "q" "W" "z")) - (define-key map key nil)) - map)) - ;; From compilation-minor-mode. - ("\C-c\C-c" . diff-goto-source) - ;; By analogy with the global C-x 4 a binding. - ("\C-x4A" . diff-add-change-log-entries-other-window) - ;; Misc operations. - ("\C-c\C-a" . diff-apply-hunk) - ("\C-c\C-e" . diff-ediff-patch) - ("\C-c\C-n" . diff-restrict-view) - ("\C-c\C-s" . diff-split-hunk) - ("\C-c\C-t" . diff-test-hunk) - ("\C-c\C-r" . diff-reverse-direction) - ("\C-c\C-u" . diff-context->unified) - ;; `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'.") +(defvar-keymap diff-mode-shared-map + :parent special-mode-map + "n" #'diff-hunk-next + "N" #'diff-file-next + "p" #'diff-hunk-prev + "P" #'diff-file-prev + ["TAB"] #'diff-hunk-next + [backtab] #'diff-hunk-prev + "k" #'diff-hunk-kill + "K" #'diff-file-kill + "}" #'diff-file-next ; From compilation-minor-mode. + "{" #'diff-file-prev + ["RET"] #'diff-goto-source + [mouse-2] #'diff-goto-source + "W" #'widen + "o" #'diff-goto-source ; other-window + "A" #'diff-ediff-patch + "r" #'diff-restrict-view + "R" #'diff-reverse-direction + [remap undo] #'diff-undo) + +(defvar-keymap diff-mode-map + :doc "Keymap for `diff-mode'. See also `diff-mode-shared-map'." + ["ESC"] (let ((map (define-keymap :parent diff-mode-shared-map))) + ;; We want to inherit most bindings from + ;; `diff-mode-shared-map', but not all since they may hide + ;; useful `M-<foo>' global bindings when editing. + (dolist (key '("A" "r" "R" "g" "q" "W" "z")) + (define-key map key nil)) + map) + ;; From compilation-minor-mode. + ["C-c C-c"] #'diff-goto-source + ;; By analogy with the global C-x 4 a binding. + ["C-x 4 A"] #'diff-add-change-log-entries-other-window + ;; Misc operations. + ["C-c C-a"] #'diff-apply-hunk + ["C-c C-e"] #'diff-ediff-patch + ["C-c C-n"] #'diff-restrict-view + ["C-c C-s"] #'diff-split-hunk + ["C-c C-t"] #'diff-test-hunk + ["C-c C-r"] #'diff-reverse-direction + ["C-c C-u"] #'diff-context->unified + ;; `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) (easy-menu-define diff-mode-menu diff-mode-map "Menu for `diff-mode'." @@ -269,9 +268,9 @@ and hunk-based syntax highlighting otherwise as a fallback." "Prefix key for `diff-minor-mode' commands." :type '(choice (string "\e") (string "C-c=") string)) -(easy-mmode-defmap diff-minor-mode-map - `((,diff-minor-mode-prefix . ,diff-mode-shared-map)) - "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'.") +(defvar-keymap diff-minor-mode-map + :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." + diff-minor-mode-prefix diff-mode-shared-map) (define-minor-mode diff-auto-refine-mode "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). @@ -894,6 +893,9 @@ data such as \"Index: ...\" and such." ;; Fix the original hunk-header. (diff-fixup-modifs start pos)))) +(defun diff--outline-level () + (if (string-match-p diff-hunk-header-re (match-string 0)) + 2 1)) ;;;; ;;;; jump to other buffers @@ -1494,7 +1496,6 @@ a diff with \\[diff-reverse-direction]. (setq-local font-lock-defaults diff-font-lock-defaults) (add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local) - (setq-local outline-regexp diff-outline-regexp) (setq-local imenu-generic-expression diff-imenu-generic-expression) ;; These are not perfect. They would be better done separately for @@ -1543,7 +1544,12 @@ a diff with \\[diff-reverse-direction]. (setq-local diff-buffer-type (if (re-search-forward "^diff --git" nil t) 'git - nil)))) + nil))) + (when (eq diff-buffer-type 'git) + (setq diff-outline-regexp + (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)")) + (setq-local outline-level #'diff--outline-level)) + (setq-local outline-regexp diff-outline-regexp)) ;;;###autoload (define-minor-mode diff-minor-mode @@ -2603,13 +2609,15 @@ fixed, visit it in a buffer." (or (match-beginning 2) (match-beginning 1)) 'display (propertize (cond - ((null (match-beginning 1)) "new file ") - ((null (match-beginning 2)) "deleted ") - (t "modified ")) + ((null (match-beginning 1)) + (concat "new file " (match-string 2))) + ((null (match-beginning 2)) + (concat "deleted " (match-string 1))) + (t + (concat "modified " (match-string 1)))) 'face '(diff-file-header diff-header))) - (unless (match-beginning 2) - (put-text-property (match-end 1) (1- (match-end 0)) - 'display ""))))) + (put-text-property (match-end 1) (1- (match-end 0)) + 'display "")))) nil) ;;; Syntax highlighting from font-lock diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 352fa693ffb..4061fedd578 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -96,15 +96,15 @@ Non-interactively, OLD and NEW may each be a file or a buffer." (interactive (let* ((newf (if (and buffer-file-name (file-exists-p buffer-file-name)) (read-file-name - (concat "Diff new file (default " - (file-name-nondirectory buffer-file-name) "): ") + (format-prompt "Diff new file" + (file-name-nondirectory buffer-file-name)) nil buffer-file-name t) (read-file-name "Diff new file: " nil nil t))) (oldf (file-newest-backup newf))) (setq oldf (if (and oldf (file-exists-p oldf)) (read-file-name - (concat "Diff original file (default " - (file-name-nondirectory oldf) "): ") + (format-prompt "Diff original file" + (file-name-nondirectory oldf)) (file-name-directory oldf) oldf t) (read-file-name "Diff original file: " (file-name-directory newf) nil t))) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 4135e8b4702..7622cf4c196 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -503,15 +503,11 @@ are two possible targets for this %spatch. However, these files do not exist." patch-file-name) (setq patch-file-name (read-file-name - (format "Patch is in file%s: " - (cond ((and buffer-file-name - (equal (expand-file-name dir) - (file-name-directory buffer-file-name))) - (concat - " (default " - (file-name-nondirectory buffer-file-name) - ")")) - (t ""))) + (format-prompt "Patch is in file" + (and buffer-file-name + (equal (expand-file-name dir) + (file-name-directory buffer-file-name)) + (file-name-nondirectory buffer-file-name))) dir buffer-file-name 'must-match)) (if (file-directory-p patch-file-name) (error "Patch file cannot be a directory: %s" patch-file-name) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 7c36291eea1..d4660a179e6 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3103,11 +3103,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." (lambda () (when defaults (setq minibuffer-default defaults))) (read-file-name - (format "%s%s " - prompt - (cond (default-file - (concat " (default " default-file "):")) - (t (concat " (default " default-dir "):")))) + (format-prompt prompt (or default-file default-dir)) default-dir (or default-file default-dir) t ; must match, no-confirm diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 4d151d555cc..c8d089e4113 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -54,21 +54,19 @@ (define-obsolete-variable-alias 'vc-log-mode-map 'log-edit-mode-map "28.1") (define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1") -(easy-mmode-defmap log-edit-mode-map - '(("\C-c\C-c" . log-edit-done) - ("\C-c\C-a" . log-edit-insert-changelog) - ("\C-c\C-w" . log-edit-generate-changelog-from-diff) - ("\C-c\C-d" . log-edit-show-diff) - ("\C-c\C-f" . log-edit-show-files) - ("\C-c\C-k" . log-edit-kill-buffer) - ("\C-a" . log-edit-beginning-of-line) - ("\M-n" . log-edit-next-comment) - ("\M-p" . log-edit-previous-comment) - ("\M-r" . log-edit-comment-search-backward) - ("\M-s" . log-edit-comment-search-forward) - ("\C-c?" . log-edit-mode-help)) - "Keymap for the `log-edit-mode' (to edit version control log messages)." - :group 'log-edit) +(defvar-keymap log-edit-mode-map + (kbd "C-c C-c") #'log-edit-done + (kbd "C-c C-a") #'log-edit-insert-changelog + (kbd "C-c C-w") #'log-edit-generate-changelog-from-diff + (kbd "C-c C-d") #'log-edit-show-diff + (kbd "C-c C-f") #'log-edit-show-files + (kbd "C-c C-k") #'log-edit-kill-buffer + (kbd "C-a") #'log-edit-beginning-of-line + (kbd "M-n") #'log-edit-next-comment + (kbd "M-p") #'log-edit-previous-comment + (kbd "M-r") #'log-edit-comment-search-backward + (kbd "M-s") #'log-edit-comment-search-forward + (kbd "C-c ?") #'log-edit-mode-help) (easy-menu-define log-edit-menu log-edit-mode-map "Menu used for `log-edit-mode'." diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index c2f008fc47d..2c78000e38b 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -110,6 +110,7 @@ ;;; Code: (require 'pcvs-util) +(require 'easy-mmode) (autoload 'vc-find-revision "vc") (autoload 'vc-diff-internal "vc") @@ -121,39 +122,23 @@ :group 'pcl-cvs :prefix "log-view-") -(easy-mmode-defmap log-view-mode-map - '( - ("-" . negative-argument) - ("0" . digit-argument) - ("1" . digit-argument) - ("2" . digit-argument) - ("3" . digit-argument) - ("4" . digit-argument) - ("5" . digit-argument) - ("6" . digit-argument) - ("7" . digit-argument) - ("8" . digit-argument) - ("9" . digit-argument) - - ("\C-m" . log-view-toggle-entry-display) - ("m" . log-view-toggle-mark-entry) - ("e" . log-view-modify-change-comment) - ("d" . log-view-diff) - ("=" . log-view-diff) - ("D" . log-view-diff-changeset) - ("a" . log-view-annotate-version) - ("f" . log-view-find-revision) - ("n" . log-view-msg-next) - ("p" . log-view-msg-prev) - ("\t" . log-view-msg-next) - ([backtab] . log-view-msg-prev) - ("N" . log-view-file-next) - ("P" . log-view-file-prev) - ("\M-n" . log-view-file-next) - ("\M-p" . log-view-file-prev)) - "Log-View's keymap." - :inherit special-mode-map - :group 'log-view) +(defvar-keymap log-view-mode-map + (kbd "RET") #'log-view-toggle-entry-display + "m" #'log-view-toggle-mark-entry + "e" #'log-view-modify-change-comment + "d" #'log-view-diff + "=" #'log-view-diff + "D" #'log-view-diff-changeset + "a" #'log-view-annotate-version + "f" #'log-view-find-revision + "n" #'log-view-msg-next + "p" #'log-view-msg-prev + (kbd "TAB") #'log-view-msg-next + (kbd "<backtab>") #'log-view-msg-prev + "N" #'log-view-file-next + "P" #'log-view-file-prev + (kbd "M-n") #'log-view-file-next + (kbd "M-p") #'log-view-file-prev) (easy-menu-define log-view-mode-menu log-view-mode-map "Log-View Display Menu." diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index 54ef06960f9..c3109f7e85b 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -264,160 +264,6 @@ This variable is buffer local and only used in the *cvs* buffer.") (defconst cvs-vendor-branch "1.1.1" "The default branch used by CVS for vendor code.") -(easy-mmode-defmap cvs-mode-diff-map - '(("E" "imerge" . cvs-mode-imerge) - ("=" . cvs-mode-diff) - ("e" "idiff" . cvs-mode-idiff) - ("2" "other" . cvs-mode-idiff-other) - ("d" "diff" . cvs-mode-diff) - ("b" "backup" . cvs-mode-diff-backup) - ("h" "head" . cvs-mode-diff-head) - ("r" "repository" . cvs-mode-diff-repository) - ("y" "yesterday" . cvs-mode-diff-yesterday) - ("v" "vendor" . cvs-mode-diff-vendor)) - "Keymap for diff-related operations in `cvs-mode'." - :name "Diff") -;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] -;; in substitute-command-keys. -(fset 'cvs-mode-diff-map cvs-mode-diff-map) - -(easy-mmode-defmap cvs-mode-map - ;;(define-prefix-command 'cvs-mode-map-diff-prefix) - ;;(define-prefix-command 'cvs-mode-map-control-c-prefix) - '(;; various - ;; (undo . cvs-mode-undo) - ("?" . cvs-help) - ("h" . cvs-help) - ("q" . cvs-bury-buffer) - ("z" . kill-this-buffer) - ("F" . cvs-mode-set-flags) - ;; ("\M-f" . cvs-mode-force-command) - ("!" . cvs-mode-force-command) - ("\C-c\C-c" . cvs-mode-kill-process) - ;; marking - ("m" . cvs-mode-mark) - ("M" . cvs-mode-mark-all-files) - ("S" . cvs-mode-mark-on-state) - ("u" . cvs-mode-unmark) - ("\C-?". cvs-mode-unmark-up) - ("%" . cvs-mode-mark-matching-files) - ("T" . cvs-mode-toggle-marks) - ("\M-\C-?" . cvs-mode-unmark-all-files) - ;; navigation keys - (" " . cvs-mode-next-line) - ("n" . cvs-mode-next-line) - ("p" . cvs-mode-previous-line) - ("\t" . cvs-mode-next-line) - ([backtab] . cvs-mode-previous-line) - ;; M- keys are usually those that operate on modules - ;;("\M-C". cvs-mode-rcs2log) ; i.e. "Create a ChangeLog" - ;;("\M-t". cvs-rtag) - ;;("\M-l". cvs-rlog) - ("\M-c". cvs-checkout) - ("\M-e". cvs-examine) - ("g" . cvs-mode-revert-buffer) - ("\M-u". cvs-update) - ("\M-s". cvs-status) - ;; diff commands - ("=" . cvs-mode-diff) - ("d" . cvs-mode-diff-map) - ;; keys that operate on individual files - ("\C-k" . cvs-mode-acknowledge) - ("A" . cvs-mode-add-change-log-entry-other-window) - ;;("B" . cvs-mode-byte-compile-files) - ("C" . cvs-mode-commit-setup) - ("O" . cvs-mode-update) - ("U" . cvs-mode-undo) - ("I" . cvs-mode-insert) - ("a" . cvs-mode-add) - ("b" . cvs-set-branch-prefix) - ("B" . cvs-set-secondary-branch-prefix) - ("c" . cvs-mode-commit) - ("e" . cvs-mode-examine) - ("f" . cvs-mode-find-file) - ("\C-m" . cvs-mode-find-file) - ("i" . cvs-mode-ignore) - ("l" . cvs-mode-log) - ("o" . cvs-mode-find-file-other-window) - ("r" . cvs-mode-remove) - ("s" . cvs-mode-status) - ("t" . cvs-mode-tag) - ("v" . cvs-mode-view-file) - ("x" . cvs-mode-remove-handled) - ;; cvstree bindings - ("+" . cvs-mode-tree) - ;; mouse bindings - ([mouse-2] . cvs-mode-find-file) - ([follow-link] . (lambda (pos) - (if (eq (get-char-property pos 'face) 'cvs-filename) t))) - ([(down-mouse-3)] . cvs-menu) - ;; dired-like bindings - ("\C-o" . cvs-mode-display-file) - ;; Emacs-21 toolbar - ;;([tool-bar item1] . (menu-item "Examine" cvs-examine :image (image :file "/usr/share/icons/xpaint.xpm" :type xpm))) - ;;([tool-bar item2] . (menu-item "Update" cvs-update :image (image :file "/usr/share/icons/mail1.xpm" :type xpm))) - ) - "Keymap for `cvs-mode'." - :dense t - :suppress t) - -(fset 'cvs-mode-map cvs-mode-map) - -(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." - '("CVS" - ["Open file" cvs-mode-find-file t] - ["Open in other window" cvs-mode-find-file-other-window t] - ["Display in other window" cvs-mode-display-file t] - ["Interactive merge" cvs-mode-imerge t] - ("View diff" - ["Interactive diff" cvs-mode-idiff t] - ["Current diff" cvs-mode-diff t] - ["Diff with head" cvs-mode-diff-head t] - ["Diff with vendor" cvs-mode-diff-vendor t] - ["Diff against yesterday" cvs-mode-diff-yesterday t] - ["Diff with backup" cvs-mode-diff-backup t]) - ["View log" cvs-mode-log t] - ["View status" cvs-mode-status t] - ["View tag tree" cvs-mode-tree t] - "----" - ["Insert" cvs-mode-insert] - ["Update" cvs-mode-update (cvs-enabledp 'update)] - ["Re-examine" cvs-mode-examine t] - ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)] - ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))] - ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)] - ["Add" cvs-mode-add (cvs-enabledp 'add)] - ["Remove" cvs-mode-remove (cvs-enabledp 'remove)] - ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)] - ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t] - "----" - ["Mark" cvs-mode-mark t] - ["Mark all" cvs-mode-mark-all-files t] - ["Mark by regexp..." cvs-mode-mark-matching-files t] - ["Mark by state..." cvs-mode-mark-on-state t] - ["Unmark" cvs-mode-unmark t] - ["Unmark all" cvs-mode-unmark-all-files t] - ["Hide handled" cvs-mode-remove-handled t] - "----" - ["PCL-CVS Manual" (lambda () (interactive) - (info "(pcl-cvs)Top")) t] - "----" - ["Quit" cvs-mode-quit t])) - -;;;; -;;;; CVS-Minor mode -;;;; - -(defcustom cvs-minor-mode-prefix "\C-xc" - "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." - :type 'string) - -(easy-mmode-defmap cvs-minor-mode-map - `((,cvs-minor-mode-prefix . cvs-mode-map) - ("e" . (menu-item nil cvs-mode-edit-log - :filter (lambda (x) (if (derived-mode-p 'log-view-mode) x))))) - "Keymap for `cvs-minor-mode', used in buffers related to PCL-CVS.") - (defvar cvs-buffer nil "(Buffer local) The *cvs* buffer associated with this buffer.") (put 'cvs-buffer 'permanent-local t) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index bbc81ef195d..2daa42fbf8f 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -117,11 +117,11 @@ (require 'cl-lib) (require 'ewoc) ;Ewoc was once cookie -(require 'pcvs-defs) (require 'pcvs-util) (require 'pcvs-parse) (require 'pcvs-info) (require 'vc-cvs) +(require 'easy-mmode) ;;;; @@ -138,6 +138,147 @@ (defvar cvs-from-vc nil "Bound to t inside VC advice.") +(defvar-keymap cvs-mode-diff-map + :name "Diff" + "E" (cons "imerge" #'cvs-mode-imerge) + "=" #'cvs-mode-diff + "e" (cons "idiff" #'cvs-mode-idiff) + "2" (cons "other" #'cvs-mode-idiff-other) + "d" (cons "diff" #'cvs-mode-diff) + "b" (cons "backup" #'cvs-mode-diff-backup) + "h" (cons "head" #'cvs-mode-diff-head) + "r" (cons "repository" #'cvs-mode-diff-repository) + "y" (cons "yesterday" #'cvs-mode-diff-yesterday) + "v" (cons "vendor" #'cvs-mode-diff-vendor)) +;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] +;; in substitute-command-keys. +(fset 'cvs-mode-diff-map cvs-mode-diff-map) + +(defvar-keymap cvs-mode-map + :full t + :suppress t + ;; various + "?" #'cvs-help + "h" #'cvs-help + "q" #'cvs-bury-buffer + "z" #'kill-this-buffer + "F" #'cvs-mode-set-flags + "!" #'cvs-mode-force-command + ["C-c C-c"] #'cvs-mode-kill-process + ;; marking + "m" #'cvs-mode-mark + "M" #'cvs-mode-mark-all-files + "S" #'cvs-mode-mark-on-state + "u" #'cvs-mode-unmark + ["DEL"] #'cvs-mode-unmark-up + "%" #'cvs-mode-mark-matching-files + "T" #'cvs-mode-toggle-marks + ["M-DEL"] #'cvs-mode-unmark-all-files + ;; navigation keys + " " #'cvs-mode-next-line + "n" #'cvs-mode-next-line + "p" #'cvs-mode-previous-line + "\t" #'cvs-mode-next-line + [backtab] #'cvs-mode-previous-line + ;; M- keys are usually those that operate on modules + ["M-c"] #'cvs-checkout + ["M-e"] #'cvs-examine + "g" #'cvs-mode-revert-buffer + ["M-u"] #'cvs-update + ["M-s"] #'cvs-status + ;; diff commands + "=" #'cvs-mode-diff + "d" cvs-mode-diff-map + ;; keys that operate on individual files + ["C-k"] #'cvs-mode-acknowledge + "A" #'cvs-mode-add-change-log-entry-other-window + "C" #'cvs-mode-commit-setup + "O" #'cvs-mode-update + "U" #'cvs-mode-undo + "I" #'cvs-mode-insert + "a" #'cvs-mode-add + "b" #'cvs-set-branch-prefix + "B" #'cvs-set-secondary-branch-prefix + "c" #'cvs-mode-commit + "e" #'cvs-mode-examine + "f" #'cvs-mode-find-file + ["RET"] #'cvs-mode-find-file + "i" #'cvs-mode-ignore + "l" #'cvs-mode-log + "o" #'cvs-mode-find-file-other-window + "r" #'cvs-mode-remove + "s" #'cvs-mode-status + "t" #'cvs-mode-tag + "v" #'cvs-mode-view-file + "x" #'cvs-mode-remove-handled + ;; cvstree bindings + "+" #'cvs-mode-tree + ;; mouse bindings + [mouse-2] #'cvs-mode-find-file + [follow-link] (lambda (pos) + (eq (get-char-property pos 'face) 'cvs-filename)) + [(down-mouse-3)] #'cvs-menu + ;; dired-like bindings + "\C-o" #'cvs-mode-display-file) + +(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." + '("CVS" + ["Open file" cvs-mode-find-file t] + ["Open in other window" cvs-mode-find-file-other-window t] + ["Display in other window" cvs-mode-display-file t] + ["Interactive merge" cvs-mode-imerge t] + ("View diff" + ["Interactive diff" cvs-mode-idiff t] + ["Current diff" cvs-mode-diff t] + ["Diff with head" cvs-mode-diff-head t] + ["Diff with vendor" cvs-mode-diff-vendor t] + ["Diff against yesterday" cvs-mode-diff-yesterday t] + ["Diff with backup" cvs-mode-diff-backup t]) + ["View log" cvs-mode-log t] + ["View status" cvs-mode-status t] + ["View tag tree" cvs-mode-tree t] + "----" + ["Insert" cvs-mode-insert] + ["Update" cvs-mode-update (cvs-enabledp 'update)] + ["Re-examine" cvs-mode-examine t] + ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)] + ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))] + ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)] + ["Add" cvs-mode-add (cvs-enabledp 'add)] + ["Remove" cvs-mode-remove (cvs-enabledp 'remove)] + ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)] + ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t] + "----" + ["Mark" cvs-mode-mark t] + ["Mark all" cvs-mode-mark-all-files t] + ["Mark by regexp..." cvs-mode-mark-matching-files t] + ["Mark by state..." cvs-mode-mark-on-state t] + ["Unmark" cvs-mode-unmark t] + ["Unmark all" cvs-mode-unmark-all-files t] + ["Hide handled" cvs-mode-remove-handled t] + "----" + ["PCL-CVS Manual" (lambda () (interactive) + (info "(pcl-cvs)Top")) t] + "----" + ["Quit" cvs-mode-quit t])) + +;;;; +;;;; CVS-Minor mode +;;;; + +(defcustom cvs-minor-mode-prefix "\C-xc" + "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." + :type 'string + :group 'pcl-cvs) + +(defvar-keymap cvs-minor-mode-map + cvs-minor-mode-prefix 'cvs-mode-map + "e" '(menu-item nil cvs-mode-edit-log + :filter (lambda (x) + (and (derived-mode-p 'log-view-mode) x)))) + +(require 'pcvs-defs) + ;;;; ;;;; flags variables ;;;; @@ -758,6 +899,7 @@ clear what alternative to use. - `DOUBLE' is the generic case." (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body)) + (indent defun) (doc-string 3)) (let ((style (cvs-cdr fun)) (fun (cvs-car fun))) @@ -1284,8 +1426,7 @@ marked instead. A directory can never be marked." (intern (upcase (completing-read - (concat - "Mark files in state" (if default (concat " [" default "]")) ": ") + (format-prompt "Mark files in state" default) (mapcar (lambda (x) (list (downcase (symbol-name (car x))))) cvs-states) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index b2a875c81ff..2cc5ee739fd 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -47,6 +47,7 @@ (require 'diff) ;For diff-check-labels. (require 'diff-mode) ;For diff-refine. (require 'newcomment) +(require 'easy-mmode) ;;; The real definition comes later. (defvar smerge-mode) @@ -142,25 +143,24 @@ Used in `smerge-diff-base-upper' and related functions." "Face used for added characters shown by `smerge-refine'." :version "24.3") -(easy-mmode-defmap smerge-basic-map - `(("n" . smerge-next) - ("p" . smerge-prev) - ("r" . smerge-resolve) - ("a" . smerge-keep-all) - ("b" . smerge-keep-base) - ("o" . smerge-keep-lower) ; for the obsolete keep-other - ("l" . smerge-keep-lower) - ("m" . smerge-keep-upper) ; for the obsolete keep-mine - ("u" . smerge-keep-upper) - ("E" . smerge-ediff) - ("C" . smerge-combine-with-next) - ("R" . smerge-refine) - ("\C-m" . smerge-keep-current) - ("=" . ,(make-sparse-keymap "Diff")) - ("=<" "base-upper" . smerge-diff-base-upper) - ("=>" "base-lower" . smerge-diff-base-lower) - ("==" "upper-lower" . smerge-diff-upper-lower)) - "The base keymap for `smerge-mode'.") +(defvar-keymap smerge-basic-map + "n" #'smerge-next + "p" #'smerge-prev + "r" #'smerge-resolve + "a" #'smerge-keep-all + "b" #'smerge-keep-base + "o" #'smerge-keep-lower ; for the obsolete keep-other + "l" #'smerge-keep-lower + "m" #'smerge-keep-upper ; for the obsolete keep-mine + "u" #'smerge-keep-upper + "E" #'smerge-ediff + "C" #'smerge-combine-with-next + "R" #'smerge-refine + ["C-m"] #'smerge-keep-current + "=" (define-keymap :name "Diff" + "<" (cons "base-upper" #'smerge-diff-base-upper) + ">" (cons "base-lower" #'smerge-diff-base-lower) + "=" (cons "upper-lower" #'smerge-diff-upper-lower))) (defcustom smerge-command-prefix "\C-c^" "Prefix for `smerge-mode' commands." @@ -169,9 +169,8 @@ Used in `smerge-diff-base-upper' and related functions." (const :tag "none" "") string)) -(easy-mmode-defmap smerge-mode-map - `((,smerge-command-prefix . ,smerge-basic-map)) - "Keymap for `smerge-mode'.") +(defvar-keymap smerge-mode-map + smerge-command-prefix smerge-basic-map) (defvar-local smerge-check-cache nil) (defun smerge-check (n) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 0ed9f7c31fe..6bec9edbf35 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -672,7 +672,6 @@ Return the byte's value as an integer." (let* ((result nil) (flen (length fname)) (case-fold-search nil) - (inhibit-changing-match-data t) ;; Find a conservative bound for the loop below by using ;; Boyer-Moore on the raw dirstate without parsing it; we ;; know we can't possibly find fname _after_ the last place @@ -976,10 +975,9 @@ REPO must be the directory name of an hg repository." "Test whether the ignore pattern set HGIP says to ignore FILENAME. FILENAME must be the file's true absolute name." (let ((patterns (vc-hg--ignore-patterns-ignore-patterns hgip)) - (inhibit-changing-match-data t) (ignored nil)) (while (and patterns (not ignored)) - (setf ignored (string-match (pop patterns) filename))) + (setf ignored (string-match-p (pop patterns) filename))) ignored)) (defvar vc-hg--cached-ignore-patterns nil @@ -1043,7 +1041,8 @@ Avoids the need to repeatedly scan dirstate on repeated calls to (equal size (pop cache)) (equal ascii-fname (pop cache))) (pop cache) - (let ((result (vc-hg--raw-dirstate-search dirstate ascii-fname))) + (let ((result (save-match-data + (vc-hg--raw-dirstate-search dirstate ascii-fname)))) (setf vc-hg--dirstate-scan-cache (list dirstate mtime size ascii-fname result)) result)))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 67003c83926..c9500f454ae 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -937,11 +937,18 @@ repository, prompting for the directory and the VC backend to use." (catch 'found ;; First try: find a responsible backend, it must be a backend - ;; under which FILE is not yet registered. - (dolist (backend vc-handled-backends) - (and (not (vc-call-backend backend 'registered file)) - (vc-call-backend backend 'responsible-p file) - (throw 'found backend))) + ;; under which FILE is not yet registered and with the most + ;; specific path to FILE. + (let ((max 0) + bk) + (dolist (backend vc-handled-backends) + (when (not (vc-call-backend backend 'registered file)) + (let* ((path (vc-call-backend backend 'responsible-p file)) + (len (length path))) + (when (and len (> len max)) + (setq max len bk backend))))) + (when bk + (throw 'found bk))) ;; no responsible backend (let* ((possible-backends (let (pos) @@ -1188,7 +1195,11 @@ For old-style locking-based version control systems, like RCS: *vc-log* buffer to check in the changes. Leave a read-only copy of each changed file after checking in. If every file is locked by you and unchanged, unlock them. - If every file is locked by someone else, offer to steal the lock." + If every file is locked by someone else, offer to steal the lock. + +When using this command to register a new file (or files), it +will automatically deduce which VC repository to register it +with, using the most specific one." (interactive "P") (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files)) (backend (car vc-fileset)) @@ -1793,7 +1804,6 @@ Return t if the buffer had changes, nil otherwise." (setq files (nreverse filtered)))) (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async) (set-buffer buffer) - (diff-mode) (setq-local diff-vc-backend (car vc-fileset)) (setq-local diff-vc-revisions (list rev1 rev2)) (setq-local revert-buffer-function @@ -1815,7 +1825,9 @@ Return t if the buffer had changes, nil otherwise." ;; after `pop-to-buffer'; the former assumes the diff buffer is ;; shown in some window. (let ((buf (current-buffer))) - (vc-run-delayed (vc-diff-finish buf (when verbose messages)))) + (vc-run-delayed (progn + (vc-diff-finish buf (when verbose messages)) + (diff-mode)))) ;; In the async case, we return t even if there are no differences ;; because we don't know that yet. t))) @@ -1863,13 +1875,10 @@ Return t if the buffer had changes, nil otherwise." (vc-working-revision first)))) (when (string= rev1-default "") (setq rev1-default nil)))) ;; construct argument list - (let* ((rev1-prompt (if rev1-default - (concat "Older revision (default " - rev1-default "): ") - "Older revision: ")) - (rev2-prompt (concat "Newer revision (default " - ;; (or rev2-default - "current source): ")) + (let* ((rev1-prompt (format-prompt "Older revision" rev1-default)) + (rev2-prompt (format-prompt "Newer revision" + ;; (or rev2-default + "current source")) (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) (rev2 (vc-read-revision rev2-prompt files backend nil))) ;; rev2-default (when (string= rev1 "") (setq rev1 nil)) @@ -2082,7 +2091,7 @@ If `F.~REV~' already exists, use it instead of checking it out again." (with-current-buffer (or (buffer-base-buffer) (current-buffer)) (vc-ensure-vc-buffer) (list - (vc-read-revision "Revision to visit (default is working revision): " + (vc-read-revision (format-prompt "Revision to visit" "working revision") (list buffer-file-name))))) (set-buffer (or (buffer-base-buffer) (current-buffer))) (vc-ensure-vc-buffer) @@ -2378,7 +2387,7 @@ This function runs the hook `vc-retrieve-tag-hook' when finished." (read-directory-name "Directory: " default-directory nil t)))) (list dir - (vc-read-revision "Tag name to retrieve (default latest revisions): " + (vc-read-revision (format-prompt "Tag name to retrieve" "latest revisions") (list dir) (vc-responsible-backend dir))))) (let* ((backend (vc-responsible-backend dir)) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 017409d6a42..5a482c5253a 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1687,32 +1687,32 @@ cleaning up these problems." (or whitespace-active-style whitespace-style))) (bogus-list (mapcar - #'(lambda (option) - (when force - (push (car option) style)) - (goto-char rstart) - (let ((regexp - (cond - ((eq (car option) 'indentation) - (whitespace-indentation-regexp)) - ((eq (car option) 'indentation::tab) - (whitespace-indentation-regexp 'tab)) - ((eq (car option) 'indentation::space) - (whitespace-indentation-regexp 'space)) - ((eq (car option) 'space-after-tab) - (whitespace-space-after-tab-regexp)) - ((eq (car option) 'space-after-tab::tab) - (whitespace-space-after-tab-regexp 'tab)) - ((eq (car option) 'space-after-tab::space) - (whitespace-space-after-tab-regexp 'space)) - ((eq (car option) 'missing-newline-at-eof) - "[^\n]\\'") - (t - (cdr option))))) - (when (re-search-forward regexp rend t) - (unless has-bogus - (setq has-bogus (memq (car option) style))) - t))) + (lambda (option) + (when force + (push (car option) style)) + (goto-char rstart) + (let ((regexp + (cond + ((eq (car option) 'indentation) + (whitespace-indentation-regexp)) + ((eq (car option) 'indentation::tab) + (whitespace-indentation-regexp 'tab)) + ((eq (car option) 'indentation::space) + (whitespace-indentation-regexp 'space)) + ((eq (car option) 'space-after-tab) + (whitespace-space-after-tab-regexp)) + ((eq (car option) 'space-after-tab::tab) + (whitespace-space-after-tab-regexp 'tab)) + ((eq (car option) 'space-after-tab::space) + (whitespace-space-after-tab-regexp 'space)) + ((eq (car option) 'missing-newline-at-eof) + "[^\n]\\'") + (t + (cdr option))))) + (when (re-search-forward regexp rend t) + (unless has-bogus + (setq has-bogus (memq (car option) style))) + t))) whitespace-report-list))) (when (pcase report-if-bogus ('nil t) ('never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) @@ -2463,5 +2463,4 @@ It should be added buffer-locally to `write-file-functions'." "use `with-eval-after-load' instead." "28.1") (run-hooks 'whitespace-load-hook) - ;;; whitespace.el ends here diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index a2e9bf41ade..fb06a95f51c 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -131,16 +131,21 @@ This exists as a variable so it can be set locally in certain buffers.") (((class grayscale color) (background light)) :background "gray85" + ;; We use negative thickness of the horizontal box border line to + ;; avoid making lines taller when fields become visible. + :box (:line-width (1 . -1) :color "gray80") :extend t) (((class grayscale color) (background dark)) :background "dim gray" + :box (:line-width (1 . -1) :color "gray46") :extend t) (t :slant italic :extend t)) "Face used for editable fields." - :group 'widget-faces) + :group 'widget-faces + :version "28.1") (defface widget-single-line-field '((((type tty)) :background "green3" @@ -3320,7 +3325,7 @@ It reads a file name from an editable text field." ;;; (file (file-name-nondirectory value)) ;;; (menu-tag (widget-apply widget :menu-tag-get)) ;;; (must-match (widget-get widget :must-match)) -;;; (answer (read-file-name (concat menu-tag " (default " value "): ") +;;; (answer (read-file-name (format-prompt menu-tag value) ;;; dir nil must-match file))) ;;; (widget-value-set widget (abbreviate-file-name answer)) ;;; (widget-setup) diff --git a/lisp/widget.el b/lisp/widget.el index 393fe6c21b3..0232f6cf93f 100644 --- a/lisp/widget.el +++ b/lisp/widget.el @@ -44,7 +44,7 @@ ;; (list 'or (list 'boundp (list 'car 'keywords)) ;; (list 'set (list 'car 'keywords) (list 'car 'keywords))) ;; (list 'setq 'keywords (list 'cdr 'keywords))))) - (declare (obsolete nil "27.1")) + (declare (obsolete nil "27.1") (indent defun)) nil) ;;(define-widget-keywords :documentation-indent @@ -83,7 +83,7 @@ create identical widgets: * (apply #\\='widget-create CLASS ARGS) The third argument DOC is a documentation string for the widget." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; (unless (or (null doc) (stringp doc)) (error "Widget documentation must be nil or a string")) diff --git a/lisp/window.el b/lisp/window.el index d12232641e3..25827436795 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -108,11 +108,14 @@ Return the buffer." ;; Return the buffer. buffer))) +;; Defined in help.el. +(defvar resize-temp-buffer-window-inhibit) + (defun temp-buffer-window-show (buffer &optional action) "Show temporary buffer BUFFER in a window. Return the window showing BUFFER. Pass ACTION as action argument to `display-buffer'." - (let (window frame) + (let (resize-temp-buffer-window-inhibit window) (with-current-buffer buffer (set-buffer-modified-p nil) (setq buffer-read-only t) @@ -130,9 +133,9 @@ to `display-buffer'." t window-combination-limit))) (setq window (display-buffer buffer action))) - (setq frame (window-frame window)) - (unless (eq frame (selected-frame)) - (raise-frame frame)) + ;; We used to raise the window's frame here. Do not do that + ;; since it would override an `inhibit-switch-frame' entry + ;; specified for the action alist used by `display-buffer'. (setq minibuffer-scroll-window window) (set-window-hscroll window 0) (with-selected-window window @@ -1514,21 +1517,11 @@ Emacs won't change the size of any window displaying that buffer, unless it has no other choice (like when deleting a neighboring window).") -(defun window--preservable-size (window &optional horizontal) - "Return height of WINDOW as `window-preserve-size' would preserve it. -Optional argument HORIZONTAL non-nil means to return the width of -WINDOW as `window-preserve-size' would preserve it." - (if horizontal - (window-body-width window t) - (+ (window-body-height window t) - (window-header-line-height window) - (window-mode-line-height window)))) - (defun window-preserve-size (&optional window horizontal preserve) - "Preserve height of window WINDOW. + "Preserve height of specified WINDOW's body. WINDOW must be a live window and defaults to the selected one. -Optional argument HORIZONTAL non-nil means preserve the width of -WINDOW. +Optional argument HORIZONTAL non-nil means to preserve the width +of WINDOW's body. PRESERVE t means to preserve the current height/width of WINDOW's body in frame and window resizing operations whenever possible. @@ -1545,21 +1538,15 @@ WINDOW as argument also removes the respective restraint. Other values of PRESERVE are reserved for future use." (setq window (window-normalize-window window t)) (let* ((parameter (window-parameter window 'window-preserved-size)) - (width (nth 1 parameter)) - (height (nth 2 parameter))) - (if horizontal - (set-window-parameter - window 'window-preserved-size - (list - (window-buffer window) - (and preserve (window--preservable-size window t)) - height)) - (set-window-parameter - window 'window-preserved-size - (list - (window-buffer window) - width - (and preserve (window--preservable-size window))))))) + (width (if horizontal + (and preserve (window-body-width window t)) + (nth 1 parameter))) + (height (if horizontal + (nth 2 parameter) + (and preserve (window-body-height window t))))) + (set-window-parameter + window 'window-preserved-size + (list (window-buffer window) width height)))) (defun window-preserved-size (&optional window horizontal) "Return preserved height of window WINDOW. @@ -1567,12 +1554,9 @@ WINDOW must be a live window and defaults to the selected one. Optional argument HORIZONTAL non-nil means to return preserved width of WINDOW." (setq window (window-normalize-window window t)) - (let* ((parameter (window-parameter window 'window-preserved-size)) - (buffer (nth 0 parameter)) - (width (nth 1 parameter)) - (height (nth 2 parameter))) - (when (eq buffer (window-buffer window)) - (if horizontal width height)))) + (let ((parameter (window-parameter window 'window-preserved-size))) + (when (eq (nth 0 parameter) (window-buffer window)) + (nth (if horizontal 1 2) parameter)))) (defun window--preserve-size (window horizontal) "Return non-nil when the height of WINDOW shall be preserved. @@ -1580,7 +1564,7 @@ Optional argument HORIZONTAL non-nil means to return non-nil when the width of WINDOW shall be preserved." (let ((size (window-preserved-size window horizontal))) (and (numberp size) - (= size (window--preservable-size window horizontal))))) + (= size (window-body-size window horizontal t))))) (defun window-safe-min-size (&optional window horizontal pixelwise) "Return safe minimum size of WINDOW. @@ -7250,11 +7234,15 @@ Return WINDOW if BUFFER and WINDOW are live." (inhibit-modification-hooks t)) (funcall (cdr (assq 'body-function alist)) window))) - (let ((quit-restore (window-parameter window 'quit-restore)) - (height (cdr (assq 'window-height alist))) - (width (cdr (assq 'window-width alist))) - (size (cdr (assq 'window-size alist))) - (preserve-size (cdr (assq 'preserve-size alist)))) + (let* ((frame (window-frame window)) + (quit-restore (window-parameter window 'quit-restore)) + (window-height (assq 'window-height alist)) + (height (cdr window-height)) + (window-width (assq 'window-width alist)) + (width (cdr window-width)) + (window-size (assq 'window-size alist)) + (size (cdr window-size)) + (preserve-size (cdr (assq 'preserve-size alist)))) (cond ((or (eq type 'frame) (and (eq (car quit-restore) 'same) @@ -7265,29 +7253,43 @@ Return WINDOW if BUFFER and WINDOW are live." ;; Adjust size of frame if asked for. We probably should do ;; that only for a single window frame. (cond - ((not size)) + ((not size) + (when window-size + (setq resize-temp-buffer-window-inhibit t))) ((consp size) - (let ((width (car size)) - (height (cdr size)) - (frame (window-frame window))) - (when (and (numberp width) (numberp height)) - (set-frame-height - frame (+ (frame-height frame) - (- height (window-total-height window)))) - (set-frame-width - frame (+ (frame-width frame) - (- width (window-total-width window))))))) - ((functionp size) - (ignore-errors (funcall size window))))) + ;; Modifying the parameters of a newly created frame might + ;; not work everywhere, but then `temp-buffer-resize-mode' + ;; will certainly fail in a similar fashion. + (if (eq (car size) 'body-chars) + (let ((width (+ (frame-text-width frame) + (* (frame-char-width frame) (cadr size)) + (- (window-body-width window t)))) + (height (+ (frame-text-height frame) + (* (frame-char-height frame) (cddr size)) + (- (window-body-height window t))))) + (modify-frame-parameters + frame `((height . (text-pixels . ,height)) + (width . (text-pixels . ,width))))) + (let ((width (- (+ (frame-width frame) (car size)) + (window-total-width window))) + (height (- (+ (frame-height frame) (cdr size)) + (window-total-height window)))) + (modify-frame-parameters + frame `((height . ,height) (width . ,width))))) + (setq resize-temp-buffer-window-inhibit t)) + ((functionp size) + (ignore-errors (funcall size window)) + (setq resize-temp-buffer-window-inhibit t)))) ((or (eq type 'window) (and (eq (car quit-restore) 'same) (eq (nth 1 quit-restore) 'window))) ;; A window that never showed another buffer but BUFFER ever - ;; since it was created on an existing frame. - ;; - ;; Adjust width and/or height of window if asked for. + ;; since it was created on an existing frame. Adjust its width + ;; and/or height if asked for. (cond - ((not height)) + ((not height) + (when window-height + (setq resize-temp-buffer-window-inhibit 'vertical))) ((numberp height) (let* ((new-height (if (integerp height) @@ -7298,12 +7300,23 @@ Return WINDOW if BUFFER and WINDOW are live." (delta (- new-height (window-total-height window)))) (when (and (window--resizable-p window delta nil 'safe) (window-combined-p window)) - (window-resize window delta nil 'safe)))) - ((functionp height) - (ignore-errors (funcall height window)))) + (window-resize window delta nil 'safe))) + (setq resize-temp-buffer-window-inhibit 'vertical)) + ((and (consp height) (eq (car height) 'body-lines)) + (let* ((delta (- (* (frame-char-height frame) (cdr height)) + (window-body-height window t)))) + (and (window--resizable-p window delta nil 'safe nil nil nil t) + (window-combined-p window) + (window-resize window delta nil 'safe t))) + (setq resize-temp-buffer-window-inhibit 'vertical)) + ((functionp height) + (ignore-errors (funcall height window)) + (setq resize-temp-buffer-window-inhibit 'vertical))) ;; Adjust width of window if asked for. (cond - ((not width)) + ((not width) + (when window-width + (setq resize-temp-buffer-window-inhibit 'horizontal))) ((numberp width) (let* ((new-width (if (integerp width) @@ -7314,13 +7327,24 @@ Return WINDOW if BUFFER and WINDOW are live." (delta (- new-width (window-total-width window)))) (when (and (window--resizable-p window delta t 'safe) (window-combined-p window t)) - (window-resize window delta t 'safe)))) + (window-resize window delta t 'safe))) + (setq resize-temp-buffer-window-inhibit 'horizontal)) + ((and (consp width) (eq (car width) 'body-columns)) + (let* ((delta (- (* (frame-char-width frame) (cdr width)) + (window-body-width window t)))) + (and (window--resizable-p window delta t 'safe nil nil nil t) + (window-combined-p window t) + (window-resize window delta t 'safe t))) + (setq resize-temp-buffer-window-inhibit 'horizontal)) ((functionp width) - (ignore-errors (funcall width window)))) + (ignore-errors (funcall width window)) + (setq resize-temp-buffer-window-inhibit 'horizontal))) + ;; Preserve window size if asked for. (when (consp preserve-size) (window-preserve-size window t (car preserve-size)) (window-preserve-size window nil (cdr preserve-size))))) + ;; Assign any window parameters specified. (let ((parameters (cdr (assq 'window-parameters alist)))) (dolist (parameter parameters) @@ -7563,6 +7587,9 @@ Action alist entries are: window from being used for display. `inhibit-switch-frame' -- A non-nil value prevents any frame used for showing the buffer from being raised or selected. + Note that a window manager may still raise a new frame and + give it focus, effectively overriding the value specified + here. `reusable-frames' -- The value specifies the set of frames to search for a window that already displays the buffer. Possible values are nil (the selected frame), t (any live @@ -7572,20 +7599,33 @@ Action alist entries are: frame parameters to give a new frame, if one is created. `window-height' -- The value specifies the desired height of the window chosen and is either an integer (the total height of - the window), a floating point number (the fraction of its - total height with respect to the total height of the frame's - root window) or a function to be called with one argument - - the chosen window. The function is supposed to adjust the - height of the window; its return value is ignored. Suitable - functions are `shrink-window-if-larger-than-buffer' and - `fit-window-to-buffer'. + the window specified in frame lines), a floating point + number (the fraction of its total height with respect to the + total height of the frame's root window), a cons cell whose + car is 'body-lines' and whose cdr is an integer that + specifies the height of the window's body in frame lines, or + a function to be called with one argument - the chosen + window. That function is supposed to adjust the height of + the window. Suitable functions are `fit-window-to-buffer' + and `shrink-window-if-larger-than-buffer'. `window-width' -- The value specifies the desired width of the window chosen and is either an integer (the total width of - the window), a floating point number (the fraction of its - total width with respect to the width of the frame's root - window) or a function to be called with one argument - the - chosen window. The function is supposed to adjust the width - of the window; its return value is ignored. + the window specified in frame lines), a floating point + number (the fraction of its total width with respect to the + width of the frame's root window), a cons cell whose car is + 'body-columns' and whose cdr is an integer that specifies the + width of the window's body in frame columns, or a function to + be called with one argument - the chosen window. That + function is supposed to adjust the width of the window. + `window-size' -- This entry is only useful for windows appearing + alone on their frame and specifies the desired size of that + window either as a cons of integers (the total width and + height of the window on that frame), a cons cell whose car is + 'body-chars' and whose cdr is a cons of integers (the desired + width and height of the window's body in columns and lines of + its frame), or a function to be called with one argument - + the chosen window. That function is supposed to adjust the + size of the frame. `preserve-size' -- The value should be either (t . nil) to preserve the width of the chosen window, (nil . t) to preserve its height or (t . t) to preserve its height and @@ -7601,9 +7641,9 @@ Action alist entries are: to fill the window body with some contents that might depend on dimensions of the displayed window. -The entries `window-height', `window-width' and `preserve-size' -are applied only when the window used for displaying the buffer -never showed another buffer before. +The entries `window-height', `window-width', `window-size' and +`preserve-size' are applied only when the window used for +displaying the buffer never showed another buffer before. The ACTION argument can also have a non-nil and non-list value. This means to display the buffer in a window other than the diff --git a/lisp/xdg.el b/lisp/xdg.el index db890f9494b..aee0dcad67f 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -85,6 +85,23 @@ According to the XDG Base Directory Specification version should be used.\"" (xdg--dir-home "XDG_DATA_HOME" "~/.local/share")) +(defun xdg-state-home () + "Return the base directory for user-specific state data. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"The $XDG_STATE_HOME contains state data that should persist + between (application) restarts, but that is not important or + portable enough to the user that it should be stored in + $XDG_DATA_HOME. It may contain: + + * actions history (logs, history, recently used files, …) + + * current state of the application that can be reused on a + restart (view, layout, open files, undo history, …)\"" + (xdg--dir-home "XDG_STATE_HOME" "~/.local/state")) + (defun xdg-runtime-dir () "Return the value of $XDG_RUNTIME_DIR. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index ff3d4f2064c..ef4bc24fe40 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "28.0.60"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.0.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in index 66cde9f4eeb..f9f0ec08571 100644 --- a/nextstep/templates/Info.plist.in +++ b/nextstep/templates/Info.plist.in @@ -555,7 +555,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. <key>UTTypeIdentifier</key> <string>org.orgmode.org</string> <key>UTTypeReferenceURL</key> - <string>http://orgmode.org</string> + <string>https://orgmode.org</string> <key>UTTypeTagSpecification</key> <dict> <key>public.filename-extension</key> diff --git a/nt/INSTALL b/nt/INSTALL index 9f543151a94..c324fb4ae7d 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -488,6 +488,7 @@ build will run on Windows 9X and newer systems). Does Emacs use a gif library? yes Does Emacs use a png library? yes Does Emacs use -lrsvg-2? yes + Does Emacs use -lwebp? yes Does Emacs use cairo? no Does Emacs use -llcms2? yes Does Emacs use imagemagick? no @@ -597,8 +598,8 @@ build will run on Windows 9X and newer systems). * Optional image library support In addition to its "native" image formats (pbm and xbm), Emacs can - handle other image types: xpm, tiff, gif, png, jpeg and experimental - support for svg. + handle other image types: xpm, tiff, gif, png, jpeg, webp and + experimental support for svg. To build Emacs with support for them, the corresponding headers must be in the include path and libraries should be where the linker @@ -736,6 +737,18 @@ build will run on Windows 9X and newer systems). without it by specifying the --without-rsvg switch to the configure script. + For WebP images you will need libwebp. You can find it here: + + http://sourceforge.net/projects/ezwinports/files/ + + Note: the MS-Windows binary distribution on the Google site: + + https://developers.google.com/speed/webp/ + + was compiled by MSVC, and includes only static libraries, no DLLs. + So you cannot use that to build Emacs with WebP support on + MS-Windows, as that needs libwebp as a DLL. + Binaries for the other image libraries can be found on the ezwinports site or at the GnuWin32 project (the latter are generally very old, so not recommended). Note specifically that, due to some diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index 8f0d0c9528f..c3845d5b177 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -51,6 +51,7 @@ packages (you can copy and paste it into the shell with Shift + Insert): mingw-w64-x86_64-libpng \ mingw-w64-x86_64-libjpeg-turbo \ mingw-w64-x86_64-librsvg \ + mingw-w64-x86_64-libwebp \ mingw-w64-x86_64-lcms2 \ mingw-w64-x86_64-jansson \ mingw-w64-x86_64-libxml2 \ diff --git a/nt/Makefile.in b/nt/Makefile.in index 3274ff924f9..811680da851 100644 --- a/nt/Makefile.in +++ b/nt/Makefile.in @@ -144,6 +144,7 @@ LIBS_ADDPM = -lole32 -luuid ## Compilation and linking flags BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) \ + -I../src -I${srcdir}/../src -I../lib -I${srcdir}/../lib \ -I. -I${srcdir} ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} diff --git a/nt/README.W32 b/nt/README.W32 index a37695ecb12..495af0baede 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2021 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 28.0.60 for MS-Windows + Emacs version 29.0.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You diff --git a/nt/addpm.c b/nt/addpm.c index f54a6ea9f7c..4fbcf6c05ea 100644 --- a/nt/addpm.c +++ b/nt/addpm.c @@ -34,6 +34,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ installed, then the DDE fallback for creating icons the Windows 3.1 progman way will be used instead, but that is prone to lockups caused by other applications not servicing their message queues. */ + +#define DEFER_MS_W32_H +#include <config.h> + #include <stdlib.h> #include <stdio.h> #include <malloc.h> diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 224f68b1e85..f5a0550aa9d 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -27,6 +27,9 @@ 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/>. */ +#define DEFER_MS_W32_H +#include <config.h> + #include <windows.h> #include <stdarg.h> /* va_args */ diff --git a/nt/ddeclient.c b/nt/ddeclient.c index c577bfcfa93..0a44cbfd770 100644 --- a/nt/ddeclient.c +++ b/nt/ddeclient.c @@ -16,6 +16,9 @@ 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/>. */ +#define DEFER_MS_W32_H +#include <config.h> + #include <windows.h> #include <ddeml.h> #include <stdlib.h> diff --git a/nt/preprep.c b/nt/preprep.c index 78ed1c32381..8b054b19a71 100644 --- a/nt/preprep.c +++ b/nt/preprep.c @@ -21,6 +21,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. based on code from addsection.c */ +#define DEFER_MS_W32_H +#include <config.h> + #include <stdlib.h> #include <stdio.h> #include <fcntl.h> diff --git a/nt/runemacs.c b/nt/runemacs.c index 308e856be2a..b4ed9fb1564 100644 --- a/nt/runemacs.c +++ b/nt/runemacs.c @@ -40,6 +40,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* #define CHOOSE_NEWEST_EXE */ +#define DEFER_MS_W32_H +#include <config.h> + #include <windows.h> #include <string.h> #include <malloc.h> diff --git a/src/Makefile.in b/src/Makefile.in index 6d75e3537a6..e82eb4fa9e4 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -124,7 +124,7 @@ LIB_MATH=@LIB_MATH@ ## -lpthread, or empty. LIB_PTHREAD=@LIB_PTHREAD@ -LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ +LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ @WEBP_LIBS@ XCB_LIBS=@XCB_LIBS@ XFT_LIBS=@XFT_LIBS@ @@ -223,6 +223,8 @@ CFLAGS_SOUND= @CFLAGS_SOUND@ RSVG_LIBS= @RSVG_LIBS@ RSVG_CFLAGS= @RSVG_CFLAGS@ +WEBP_CFLAGS= @WEBP_CFLAGS@ + WEBKIT_LIBS= @WEBKIT_LIBS@ WEBKIT_CFLAGS= @WEBKIT_CFLAGS@ @@ -372,7 +374,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \ $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \ - $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \ + $(WEBKIT_CFLAGS) $(WEBP_CFLAGS) $(LCMS2_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \ diff --git a/src/alloc.c b/src/alloc.c index 0c04d5cde05..aa790d3afae 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -765,7 +765,7 @@ xmalloc (size_t size) val = lmalloc (size, false); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -782,7 +782,7 @@ xzalloc (size_t size) val = lmalloc (size, true); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -796,15 +796,15 @@ xrealloc (void *block, size_t size) void *val; MALLOC_BLOCK_INPUT; - /* We must call malloc explicitly when BLOCK is 0, since some - reallocs don't do this. */ + /* Call lmalloc when BLOCK is null, for the benefit of long-obsolete + platforms lacking support for realloc (NULL, size). */ if (! block) val = lmalloc (size, false); else val = lrealloc (block, size); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -988,8 +988,7 @@ record_xmalloc (size_t size) /* Like malloc but used for allocating Lisp data. NBYTES is the number of bytes to allocate, TYPE describes the intended use of the - allocated memory block (for strings, for conses, ...). - NBYTES must be positive. */ + allocated memory block (for strings, for conses, ...). */ #if ! USE_LSB_TAG void *lisp_malloc_loser EXTERNALLY_VISIBLE; @@ -1330,16 +1329,20 @@ laligned (void *p, size_t size) || size % LISP_ALIGNMENT != 0); } -/* Like malloc and realloc except that if SIZE is Lisp-aligned, make - sure the result is too, if necessary by reallocating (typically - with larger and larger sizes) until the allocator returns a - Lisp-aligned pointer. Code that needs to allocate C heap memory +/* Like malloc and realloc except return null only on failure, + the result is Lisp-aligned if SIZE is, and lrealloc's pointer + argument must be nonnull. Code allocating C heap memory for a Lisp object should use one of these functions to obtain a pointer P; that way, if T is an enum Lisp_Type value and L == make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T. + If CLEARIT, arrange for the allocated memory to be cleared. + This might use calloc, as calloc can be faster than malloc+memset. + On typical modern platforms these functions' loops do not iterate. - On now-rare (and perhaps nonexistent) platforms, the loops in + On now-rare (and perhaps nonexistent) platforms, the code can loop, + reallocating (typically with larger and larger sizes) until the + allocator returns a Lisp-aligned pointer. This loop in theory could repeat forever. If an infinite loop is possible on a platform, a build would surely loop and the builder can then send us a bug report. Adding a counter to try to detect any such loop @@ -1353,8 +1356,13 @@ lmalloc (size_t size, bool clearit) if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) { void *p = aligned_alloc (LISP_ALIGNMENT, size); - if (clearit && p) - memclear (p, size); + if (p) + { + if (clearit) + memclear (p, size); + } + else if (! (MALLOC_0_IS_NONNULL || size)) + return aligned_alloc (LISP_ALIGNMENT, LISP_ALIGNMENT); return p; } #endif @@ -1362,7 +1370,7 @@ lmalloc (size_t size, bool clearit) while (true) { void *p = clearit ? calloc (1, size) : malloc (size); - if (laligned (p, size)) + if (laligned (p, size) && (MALLOC_0_IS_NONNULL || size || p)) return p; free (p); size_t bigger = size + LISP_ALIGNMENT; @@ -1377,7 +1385,7 @@ lrealloc (void *p, size_t size) while (true) { p = realloc (p, size); - if (laligned (p, size)) + if (laligned (p, size) && (size || p)) return p; size_t bigger = size + LISP_ALIGNMENT; if (size < bigger) diff --git a/src/atimer.c b/src/atimer.c index 9b198675ab4..ab47bbf9688 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -583,15 +583,17 @@ init_atimer (void) timerfd = (egetenv ("EMACS_IGNORE_TIMERFD") || have_buggy_timerfd () ? -1 : timerfd_create (CLOCK_REALTIME, TFD_NONBLOCK | TFD_CLOEXEC)); # endif - if (timerfd < 0) - { - struct sigevent sigev; - sigev.sigev_notify = SIGEV_SIGNAL; - sigev.sigev_signo = SIGALRM; - sigev.sigev_value.sival_ptr = &alarm_timer; - alarm_timer_ok - = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0; - } + /* We're starting the alarms even if we have timerfd, because + timerfd events do not fire while Emacs Lisp is busy and doesn't + call thread_select. This might or might not mean that the + timerfd code doesn't really give us anything and should be + removed, see discussion in bug#19776. */ + struct sigevent sigev; + sigev.sigev_notify = SIGEV_SIGNAL; + sigev.sigev_signo = SIGALRM; + sigev.sigev_value.sival_ptr = &alarm_timer; + alarm_timer_ok + = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0; #endif free_atimers = stopped_atimers = atimers = NULL; diff --git a/src/bidi.c b/src/bidi.c index 1413ba6b888..511b4602fec 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -3564,11 +3564,17 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it) } /* Utility function for looking for strong directional characters - whose bidi type was overridden by a directional override. */ + whose bidi type was overridden by directional override or embedding + or isolate control characters. */ ptrdiff_t bidi_find_first_overridden (struct bidi_it *bidi_it) { ptrdiff_t found_pos = ZV; + /* Maximum bidi levels we allow for L2R and R2L characters. Note + that these are levels after resolving explicit embeddings, + overrides, and isolates, i.e. before resolving implicit levels. */ + int max_l2r = bidi_it->paragraph_dir == L2R ? 0 : 2; + int max_r2l = 1; do { @@ -3577,10 +3583,21 @@ bidi_find_first_overridden (struct bidi_it *bidi_it) former. */ bidi_type_t type = bidi_resolve_weak (bidi_it); + /* Detect strong L or R types that have been overridden by + explicit overrides. */ if ((type == STRONG_R && bidi_it->orig_type == STRONG_L) || (type == STRONG_L && (bidi_it->orig_type == STRONG_R - || bidi_it->orig_type == STRONG_AL))) + || bidi_it->orig_type == STRONG_AL)) + /* Detect strong L or R types or WEAK_EN types that were + pushed into higher embedding levels (and will thus + reorder) by explicit embeddings and isolates. */ + || ((bidi_it->orig_type == STRONG_L + || bidi_it->orig_type == WEAK_EN) + && bidi_it->level_stack[bidi_it->stack_idx].level > max_l2r) + || ((bidi_it->orig_type == STRONG_R + || bidi_it->orig_type == STRONG_AL) + && bidi_it->level_stack[bidi_it->stack_idx].level > max_r2l)) found_pos = bidi_it->charpos; } while (found_pos == ZV && bidi_it->charpos < ZV diff --git a/src/buffer.c b/src/buffer.c index eca2843e2bc..9d8892a797a 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -2805,7 +2805,7 @@ current buffer is cleared. */) } DEFUN ("kill-all-local-variables", Fkill_all_local_variables, - Skill_all_local_variables, 0, 0, 0, + Skill_all_local_variables, 0, 1, 0, doc: /* Switch to Fundamental mode by killing current buffer's local variables. Most local variable bindings are eliminated so that the default values become effective once more. Also, the syntax table is set from @@ -2816,18 +2816,20 @@ This function also forces redisplay of the mode line. Every function to select a new major mode starts by calling this function. -As a special exception, local variables whose names have -a non-nil `permanent-local' property are not eliminated by this function. +As a special exception, local variables whose names have a non-nil +`permanent-local' property are not eliminated by this function. If +the optional KILL-PERMANENT argument is non-nil, clear out these local +variables, too. The first thing this function does is run the normal hook `change-major-mode-hook'. */) - (void) + (Lisp_Object kill_permanent) { run_hook (Qchange_major_mode_hook); /* Actually eliminate all local bindings of this buffer. */ - reset_buffer_local_variables (current_buffer, 0); + reset_buffer_local_variables (current_buffer, !NILP (kill_permanent)); /* Force mode-line redisplay. Useful here because all major mode commands call this function. */ diff --git a/src/casefiddle.c b/src/casefiddle.c index a7a25414909..81e9ed153fb 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -54,6 +54,9 @@ struct casing_context /* Whether the context is within a word. */ bool inword; + + /* What the last operation was. */ + bool downcase_last; }; /* Initialize CTX structure for casing characters. */ @@ -143,10 +146,14 @@ case_character_impl (struct casing_str_buf *buf, /* Handle simple, one-to-one case. */ if (flag == CASE_DOWN) - cased = downcase (ch); + { + cased = downcase (ch); + ctx->downcase_last = true; + } else { bool cased_is_set = false; + ctx->downcase_last = false; if (!NILP (ctx->titlecase_char_table)) { prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch); @@ -297,6 +304,16 @@ do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj) return obj; } +static int +ascii_casify_character (bool downcase, int c) +{ + Lisp_Object cased = CHAR_TABLE_REF (downcase? + uniprop_table (Qlowercase) : + uniprop_table (Quppercase), + c); + return FIXNATP (cased) ? XFIXNAT (cased) : c; +} + static Lisp_Object do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) { @@ -310,11 +327,12 @@ do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) cased = case_single_character (ctx, ch); if (ch == cased) continue; - cased = make_char_unibyte (cased); - /* If the char can't be converted to a valid byte, just don't - change it. */ - if (SINGLE_BYTE_CHAR_P (cased)) - SSET (obj, i, cased); + /* If down/upcasing changed an ASCII character into a non-ASCII + character (this can happen in some locales, like the Turkish + "I"), downcase using the ASCII char table. */ + if (ASCII_CHAR_P (ch) && !SINGLE_BYTE_CHAR_P (cased)) + cased = ascii_casify_character (ctx->downcase_last, ch); + SSET (obj, i, make_char_unibyte (cased)); } return obj; } @@ -339,10 +357,13 @@ casify_object (enum case_action flag, Lisp_Object obj) DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, doc: /* Convert argument to upper case and return that. -The argument may be a character or string. The result has the same type. +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. + See also `capitalize', `downcase' and `upcase-initials'. */) (Lisp_Object obj) { @@ -351,7 +372,15 @@ See also `capitalize', `downcase' and `upcase-initials'. */) DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0, doc: /* Convert argument to lower case and return that. -The argument may be a character or string. The result has the same type. +The argument may be a character or string. The result has the same type, +including the multibyteness of the string. + +This means that if this function is called with a unibyte string +argument, and downcasing it would turn it into a multibyte string +(according to the current locale), the downcasing is done using ASCII +\"C\" rules instead. To accurately downcase according to the current +locale, the string must be converted into multibyte first. + The argument object is not altered--the value is a copy. */) (Lisp_Object obj) { @@ -362,7 +391,10 @@ DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, doc: /* Convert argument to capitalized form and return that. This means that each word's first character is converted to either title case or upper case, and the rest to lower case. -The argument may be a character or string. The result has the same type. + +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. */) @@ -377,7 +409,10 @@ DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0, doc: /* Convert the initial of each word in the argument to upper case. This means that each word's first character is converted to either title case or upper case, and the rest are left unchanged. -The argument may be a character or string. The result has the same type. + +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. */) @@ -651,6 +686,8 @@ syms_of_casefiddle (void) DEFSYM (Qbounds, "bounds"); DEFSYM (Qidentity, "identity"); DEFSYM (Qtitlecase, "titlecase"); + DEFSYM (Qlowercase, "lowercase"); + DEFSYM (Quppercase, "uppercase"); DEFSYM (Qspecial_uppercase, "special-uppercase"); DEFSYM (Qspecial_lowercase, "special-lowercase"); DEFSYM (Qspecial_titlecase, "special-titlecase"); diff --git a/src/comp.c b/src/comp.c index bc1adcf4e2f..5b947fc99b6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4123,7 +4123,7 @@ one for the file name and another for its contents, followed by .eln. */) FOR_EACH_TAIL (lds_re_tail) { Lisp_Object match_idx = - Fstring_match (XCAR (lds_re_tail), filename, Qnil); + Fstring_match (XCAR (lds_re_tail), filename, Qnil, Qnil); if (EQ (match_idx, make_fixnum (0))) { filename = @@ -5260,7 +5260,8 @@ file_in_eln_sys_dir (Lisp_Object filename) eln_sys_dir = XCAR (tmp); return !NILP (Fstring_match (Fregexp_quote (Fexpand_file_name (eln_sys_dir, Qnil)), - Fexpand_file_name (filename, Qnil), Qnil)); + Fexpand_file_name (filename, Qnil), + Qnil, Qnil)); } /* Load related routines. */ diff --git a/src/dispextern.h b/src/dispextern.h index 08dac5d4557..5b28fe76664 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3162,7 +3162,7 @@ struct image_cache /* Size of bucket vector of image caches. Should be prime. */ -#define IMAGE_CACHE_BUCKETS_SIZE 1001 +#define IMAGE_CACHE_BUCKETS_SIZE 1009 #endif /* HAVE_WINDOW_SYSTEM */ @@ -3722,10 +3722,8 @@ extern Lisp_Object gui_default_parameter (struct frame *, Lisp_Object, const char *, const char *, enum resource_types); -#ifndef HAVE_NS /* These both used on W32 and X only. */ extern bool gui_mouse_grabbed (Display_Info *); extern void gui_redo_mouse_highlight (Display_Info *); -#endif /* HAVE_NS */ #endif /* HAVE_WINDOW_SYSTEM */ diff --git a/src/dispnew.c b/src/dispnew.c index 53eb8984747..4a73244c896 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3850,6 +3850,9 @@ gui_update_window_end (struct window *w, bool cursor_on_p, w->output_cursor.hpos, w->output_cursor.vpos, w->output_cursor.x, w->output_cursor.y); + if (cursor_in_mouse_face_p (w) && cursor_on_p) + mouse_face_overwritten_p = 1; + if (draw_window_fringes (w, true)) { if (WINDOW_RIGHT_DIVIDER_WIDTH (w)) diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index fe52587c1a5..a56e4dd12ae 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -169,6 +169,19 @@ struct emacs_env_28 @module_env_snippet_28@ }; +struct emacs_env_29 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ + +@module_env_snippet_28@ + +@module_env_snippet_29@ +}; + /* Every module should define a function as follows. */ extern int emacs_module_init (struct emacs_runtime *runtime) EMACS_NOEXCEPT diff --git a/src/emacs.c b/src/emacs.c index 866e43fda94..032b27fcf3c 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -133,6 +133,7 @@ extern char etext; #endif #include "pdumper.h" +#include "fingerprint.h" #include "epaths.h" static const char emacs_version[] = PACKAGE_VERSION; @@ -255,6 +256,7 @@ Initialization options:\n\ #ifdef HAVE_PDUMPER "\ --dump-file FILE read dumped state from FILE\n\ +--fingerprint output fingerprint and exit\n\ ", #endif #if SECCOMP_USABLE @@ -830,6 +832,8 @@ load_pdump (int argc, char **argv) const char *const suffix = ".pdmp"; int result; char *emacs_executable = argv[0]; + ptrdiff_t hexbuf_size; + char *hexbuf; const char *strip_suffix = #if defined DOS_NT || defined CYGWIN ".exe" @@ -924,12 +928,18 @@ load_pdump (int argc, char **argv) path_exec = ns_relocate (path_exec); #endif - /* Look for "emacs.pdmp" in PATH_EXEC. We hardcode "emacs" in - "emacs.pdmp" so that the Emacs binary still works if the user - copies and renames it. */ + /* Look for "emacs-FINGERPRINT.pdmp" in PATH_EXEC. We hardcode + "emacs" in "emacs-FINGERPRINT.pdmp" so that the Emacs binary + still works if the user copies and renames it. */ + hexbuf_size = 2 * sizeof fingerprint; + hexbuf = xmalloc (hexbuf_size + 1); + hexbuf_digest (hexbuf, (char *) fingerprint, sizeof fingerprint); + hexbuf[hexbuf_size] = '\0'; needed = (strlen (path_exec) + 1 + strlen (argv0_base) + + 1 + + strlen (hexbuf) + strlen (suffix) + 1); if (bufsize < needed) @@ -937,8 +947,8 @@ load_pdump (int argc, char **argv) xfree (dump_file); dump_file = xpalloc (NULL, &bufsize, needed - bufsize, -1, 1); } - sprintf (dump_file, "%s%c%s%s", - path_exec, DIRECTORY_SEP, argv0_base, suffix); + sprintf (dump_file, "%s%c%s-%s%s", + path_exec, DIRECTORY_SEP, argv0_base, hexbuf, suffix); #if !defined (NS_SELF_CONTAINED) /* Assume the Emacs binary lives in a sibling directory as set up by the default installation configuration. */ @@ -1387,6 +1397,24 @@ main (int argc, char **argv) exit (0); } +#ifdef HAVE_PDUMPER + if (argmatch (argv, argc, "-fingerprint", "--fingerprint", 4, + NULL, &skip_args)) + { + if (initialized) + { + dump_fingerprint (stdout, "", + (unsigned char *) fingerprint); + exit (0); + } + else + { + fputs ("Not initialized\n", stderr); + exit (1); + } + } +#endif + emacs_wd = emacs_get_current_dir_name (); #ifdef HAVE_PDUMPER if (dumped_with_pdumper_p ()) @@ -1844,7 +1872,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_bignum (); init_threads (); init_eval (); - init_atimer (); running_asynch_code = 0; init_random (); @@ -2006,6 +2033,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!will_dump_p ()) set_initial_environment (); + /* Has to run after the environment is set up. */ + init_atimer (); + #ifdef WINDOWSNT globals_of_w32 (); #ifdef HAVE_W32NOTIFY @@ -2305,6 +2335,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (dump_mode) Vdump_mode = build_string (dump_mode); +#ifdef HAVE_PDUMPER + /* Allow code to be run (mostly useful after redumping). */ + safe_run_hooks (Qafter_pdump_load_hook); +#endif + /* Enter editor command loop. This never returns. */ set_initial_minibuffer_mode (); Frecursive_edit (); @@ -2327,6 +2362,9 @@ struct standard_args static const struct standard_args standard_args[] = { { "-version", "--version", 150, 0 }, +#ifdef HAVE_PDUMPER + { "-fingerprint", "--fingerprint", 140, 0 }, +#endif { "-chdir", "--chdir", 130, 1 }, { "-t", "--terminal", 120, 1 }, { "-nw", "--no-window-system", 110, 0 }, diff --git a/src/eval.c b/src/eval.c index 0f792b487ed..94ad0607732 100644 --- a/src/eval.c +++ b/src/eval.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "dispextern.h" #include "buffer.h" #include "pdumper.h" +#include "atimer.h" /* CACHEABLE is ordinarily nothing, except it is 'volatile' if necessary to cajole GCC into not warning incorrectly that a @@ -1078,6 +1079,47 @@ usage: (while TEST BODY...) */) return Qnil; } +static void +with_delayed_message_display (struct atimer *timer) +{ + message3 (build_string (timer->client_data)); +} + +static void +with_delayed_message_cancel (void *timer) +{ + xfree (((struct atimer *) timer)->client_data); + cancel_atimer (timer); +} + +DEFUN ("funcall-with-delayed-message", + Ffuncall_with_delayed_message, Sfuncall_with_delayed_message, + 3, 3, 0, + doc: /* Like `funcall', but display MESSAGE if FUNCTION takes longer than TIMEOUT. +TIMEOUT is a number of seconds, and can be an integer or a floating +point number. + +If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE +is not displayed. */) + (Lisp_Object timeout, Lisp_Object message, Lisp_Object function) +{ + ptrdiff_t count = SPECPDL_INDEX (); + + CHECK_NUMBER (timeout); + CHECK_STRING (message); + + /* Set up the atimer. */ + struct timespec interval = dtotimespec (XFLOATINT (timeout)); + struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval, + with_delayed_message_display, + xstrdup (SSDATA (message))); + record_unwind_protect_ptr (with_delayed_message_cancel, timer); + + Lisp_Object result = CALLN (Ffuncall, function); + + return unbind_to (count, result); +} + DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0, doc: /* Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. @@ -4511,6 +4553,7 @@ alist of active lexical bindings. */); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); diff --git a/src/fns.c b/src/fns.c index 6f358dd1ba4..76c76c92ba9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2855,12 +2855,16 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) return leni; } -DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0, +DEFUN ("mapconcat", Fmapconcat, Smapconcat, 2, 3, 0, doc: /* Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. In between each pair of results, stick in SEPARATOR. Thus, " " as SEPARATOR results in spaces between the values returned by FUNCTION. + SEQUENCE may be a list, a vector, a bool-vector, or a string. -SEPARATOR must be a string, a vector, or a list of characters. + +Optional argument SEPARATOR must be a string, a vector, or a list of +characters; nil stands for the empty string. + FUNCTION must be a function of one argument, and must return a value that is a sequence of characters: either a string, or a vector or list of numbers that are valid character codepoints. */) diff --git a/src/font.c b/src/font.c index 6cd4a6b5c11..f70054ea408 100644 --- a/src/font.c +++ b/src/font.c @@ -57,24 +57,26 @@ struct table_entry int numeric; /* The first one is a valid name as a face attribute. The second one (if any) is a typical name in XLFD field. */ - const char *names[5]; + const char *names[6]; }; /* Table of weight numeric values and their names. This table must be - sorted by numeric values in ascending order. */ + sorted by numeric values in ascending order and the numeric values + must approximately match the weights in the font files. */ static const struct table_entry weight_table[] = { { 0, { "thin" }}, - { 20, { "ultra-light", "ultralight" }}, - { 40, { "extra-light", "extralight" }}, + { 40, { "ultra-light", "ultralight", "extra-light", "extralight" }}, { 50, { "light" }}, - { 75, { "semi-light", "semilight", "demilight", "book" }}, - { 100, { "normal", "medium", "regular", "unspecified" }}, - { 180, { "semi-bold", "semibold", "demibold", "demi" }}, + { 55, { "semi-light", "semilight", "demilight" }}, + { 80, { "regular", "normal", "unspecified", "book" }}, + { 100, { "medium" }}, + { 180, { "semi-bold", "semibold", "demibold", "demi-bold", "demi" }}, { 200, { "bold" }}, - { 205, { "extra-bold", "extrabold" }}, - { 210, { "ultra-bold", "ultrabold", "black" }} + { 205, { "extra-bold", "extrabold", "ultra-bold", "ultrabold" }}, + { 210, { "black", "heavy" }}, + { 250, { "ultra-heavy", "ultraheavy" }} }; /* Table of slant numeric values and their names. This table must be @@ -1484,11 +1486,20 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) #define PROP_MATCH(STR) (word_len == strlen (STR) \ && memcmp (p, STR, strlen (STR)) == 0) - if (PROP_MATCH ("light") + if (PROP_MATCH ("thin") + || PROP_MATCH ("ultra-light") + || PROP_MATCH ("light") + || PROP_MATCH ("semi-light") + || PROP_MATCH ("book") || PROP_MATCH ("medium") + || PROP_MATCH ("normal") + || PROP_MATCH ("semibold") || PROP_MATCH ("demibold") || PROP_MATCH ("bold") - || PROP_MATCH ("black")) + || PROP_MATCH ("ultra-bold") + || PROP_MATCH ("black") + || PROP_MATCH ("heavy") + || PROP_MATCH ("ultra-heavy")) FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val); else if (PROP_MATCH ("roman") || PROP_MATCH ("italic") @@ -4966,6 +4977,33 @@ If the font is not OpenType font, CAPABILITY is nil. */) : Qnil)); } +DEFUN ("font-has-char-p", Ffont_has_char_p, Sfont_has_char_p, 2, 3, 0, + doc: + /* Return non-nil if FONT on FRAME has a glyph for character CH. +FONT can be either a font-entity or a font-object. If it is +a font-entity and the result is nil, it means the font needs to be +opened (with `open-font') to check. +FRAME defaults to the selected frame if it is nil or omitted. */) + (Lisp_Object font, Lisp_Object ch, Lisp_Object frame) +{ + struct frame *f; + CHECK_FONT (font); + CHECK_CHARACTER (ch); + + if (NILP (frame)) + f = XFRAME (selected_frame); + else + { + CHECK_FRAME (frame); + f = XFRAME (frame); + } + + if (font_has_char (f, font, XFIXNAT (ch)) <= 0) + return Qnil; + else + return Qt; +} + DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0, doc: /* Return a vector of FONT-OBJECT's glyphs for the specified characters. @@ -4984,8 +5022,13 @@ where CODE is the glyph-code of C in FONT-OBJECT. WIDTH thru DESCENT are the metrics (in pixels) of the glyph. ADJUSTMENT is always nil. -If FONT-OBJECT doesn't have a glyph for a character, -the corresponding element is nil. */) + +If FONT-OBJECT doesn't have a glyph for a character, the corresponding +element is nil. + +Also see `font-has-char-p', which is more efficient than this function +if you just want to check whether FONT-OBJECT has a glyph for a +character. */) (Lisp_Object font_object, Lisp_Object from, Lisp_Object to, Lisp_Object object) { @@ -5537,6 +5580,7 @@ syms_of_font (void) defsubr (&Sclose_font); defsubr (&Squery_font); defsubr (&Sfont_get_glyphs); + defsubr (&Sfont_has_char_p); defsubr (&Sfont_match_p); defsubr (&Sfont_at); #if 0 diff --git a/src/frame.c b/src/frame.c index 2b1cb452efd..79a7c89e0dd 100644 --- a/src/frame.c +++ b/src/frame.c @@ -5028,8 +5028,6 @@ gui_set_no_special_glyphs (struct frame *f, Lisp_Object new_value, Lisp_Object o } -#ifndef HAVE_NS - /* Non-zero if mouse is grabbed on DPYINFO and we know the frame where it is. */ @@ -5054,8 +5052,6 @@ gui_redo_mouse_highlight (Display_Info *dpyinfo) dpyinfo->last_mouse_motion_y); } -#endif /* HAVE_NS */ - /* Subroutines of creating an X frame. */ /* Make sure that Vx_resource_name is set to a reasonable value. diff --git a/src/gtkutil.c b/src/gtkutil.c index e87845caf70..a9eabf47d8f 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -2237,20 +2237,34 @@ xg_get_file_name (struct frame *f, #ifdef HAVE_GTK3 -#define XG_WEIGHT_TO_SYMBOL(w) \ - (w <= PANGO_WEIGHT_THIN ? Qextra_light \ - : w <= PANGO_WEIGHT_ULTRALIGHT ? Qlight \ - : w <= PANGO_WEIGHT_LIGHT ? Qsemi_light \ - : w < PANGO_WEIGHT_MEDIUM ? Qnormal \ - : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold \ - : w <= PANGO_WEIGHT_BOLD ? Qbold \ - : w <= PANGO_WEIGHT_HEAVY ? Qextra_bold \ - : Qultra_bold) - -#define XG_STYLE_TO_SYMBOL(s) \ - (s == PANGO_STYLE_OBLIQUE ? Qoblique \ - : s == PANGO_STYLE_ITALIC ? Qitalic \ - : Qnormal) +static +Lisp_Object xg_weight_to_symbol (PangoWeight w) +{ + return + (w <= PANGO_WEIGHT_THIN ? Qthin /* 100 */ + : w <= PANGO_WEIGHT_ULTRALIGHT ? Qultra_light /* 200 */ + : w <= PANGO_WEIGHT_LIGHT ? Qlight /* 300 */ +#if PANGO_VERSION_CHECK(1, 36, 7) + : w <= PANGO_WEIGHT_SEMILIGHT ? Qsemi_light /* 350 */ +#endif + : w <= PANGO_WEIGHT_BOOK ? Qbook /* 380 */ + : w <= PANGO_WEIGHT_NORMAL ? Qnormal /* 400 */ + : w <= PANGO_WEIGHT_MEDIUM ? Qmedium /* 500 */ + : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold /* 600 */ + : w <= PANGO_WEIGHT_BOLD ? Qbold /* 700 */ + : w <= PANGO_WEIGHT_ULTRABOLD ? Qultra_bold /* 800 */ + : w <= PANGO_WEIGHT_HEAVY ? Qblack /* 900 */ + : Qultra_heavy); /* 1000 */ +} + +static +Lisp_Object xg_style_to_symbol (PangoStyle s) +{ + return + (s == PANGO_STYLE_OBLIQUE ? Qoblique + : s == PANGO_STYLE_ITALIC ? Qitalic + : Qnormal); +} #endif /* HAVE_GTK3 */ @@ -2341,8 +2355,8 @@ xg_get_font (struct frame *f, const char *default_name) font = CALLN (Ffont_spec, QCfamily, build_string (family), QCsize, make_float (pango_units_to_double (size)), - QCweight, XG_WEIGHT_TO_SYMBOL (weight), - QCslant, XG_STYLE_TO_SYMBOL (style)); + QCweight, xg_weight_to_symbol (weight), + QCslant, xg_style_to_symbol (style)); char *font_desc_str = pango_font_description_to_string (desc); dupstring (&x_last_font_name, font_desc_str); diff --git a/src/image.c b/src/image.c index 49b26301e8b..6769e491202 100644 --- a/src/image.c +++ b/src/image.c @@ -3547,10 +3547,8 @@ convert_mono_to_color_image (struct frame *f, struct image *img, release_frame_dc (f, hdc); old_prev = SelectObject (old_img_dc, img->pixmap); new_prev = SelectObject (new_img_dc, new_pixmap); - /* Windows convention for mono bitmaps is black = background, - white = foreground. */ - SetTextColor (new_img_dc, background); - SetBkColor (new_img_dc, foreground); + SetTextColor (new_img_dc, foreground); + SetBkColor (new_img_dc, background); BitBlt (new_img_dc, 0, 0, img->width, img->height, old_img_dc, 0, 0, SRCCOPY); @@ -4116,9 +4114,9 @@ struct xpm_cached_color }; /* The hash table used for the color cache, and its bucket vector - size. */ + size (which should be prime). */ -#define XPM_COLOR_CACHE_BUCKETS 1001 +#define XPM_COLOR_CACHE_BUCKETS 1009 static struct xpm_cached_color **xpm_color_cache; /* Initialize the color cache. */ @@ -6421,9 +6419,8 @@ image_can_use_native_api (Lisp_Object type) } /* - * These functions are actually defined in the OS-native implementation - * file. Currently, for Windows GDI+ interface, w32image.c, but other - * operating systems can follow suit. + * These functions are actually defined in the OS-native implementation file. + * Currently, for Windows GDI+ interface, w32image.c, and nsimage.m for macOS. */ /* Indices of image specification fields in native format, below. */ @@ -8233,24 +8230,30 @@ gif_image_p (Lisp_Object object) # undef DrawText # endif -/* Giflib before 5.0 didn't define these macros (used only if HAVE_NTGUI). */ -# ifndef GIFLIB_MINOR -# define GIFLIB_MINOR 0 -# endif -# ifndef GIFLIB_RELEASE -# define GIFLIB_RELEASE 0 -# endif - # else /* HAVE_NTGUI */ # include <gif_lib.h> # endif /* HAVE_NTGUI */ -/* Giflib before 5.0 didn't define these macros. */ +/* Giflib before 4.1.6 didn't define these macros. */ # ifndef GIFLIB_MAJOR # define GIFLIB_MAJOR 4 # endif +# ifndef GIFLIB_MINOR +# define GIFLIB_MINOR 0 +# endif +# ifndef GIFLIB_RELEASE +# define GIFLIB_RELEASE 0 +# endif +/* Giflib before 5.0 didn't define these macros. */ +# if GIFLIB_MAJOR < 5 +# define DISPOSAL_UNSPECIFIED 0 /* No disposal specified. */ +# define DISPOSE_DO_NOT 1 /* Leave image in place. */ +# define DISPOSE_BACKGROUND 2 /* Set area too background color. */ +# define DISPOSE_PREVIOUS 3 /* Restore to previous content. */ +# define NO_TRANSPARENT_COLOR -1 +# endif /* GifErrorString is declared to return char const * when GIFLIB_MAJOR and GIFLIB_MINOR indicate 5.1 or later. Do not bother using it in @@ -8273,6 +8276,8 @@ DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *)); # else DEF_DLL_FN (GifFileType *, DGifOpen, (void *, InputFunc, int *)); DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *, int *)); +DEF_DLL_FN (int, DGifSavedExtensionToGCB, + (GifFileType *, int, GraphicsControlBlock *)); # endif # if HAVE_GIFERRORSTRING DEF_DLL_FN (char const *, GifErrorString, (int)); @@ -8290,6 +8295,9 @@ init_gif_functions (void) LOAD_DLL_FN (library, DGifSlurp); LOAD_DLL_FN (library, DGifOpen); LOAD_DLL_FN (library, DGifOpenFileName); +# if GIFLIB_MAJOR >= 5 + LOAD_DLL_FN (library, DGifSavedExtensionToGCB); +# endif # if HAVE_GIFERRORSTRING LOAD_DLL_FN (library, GifErrorString); # endif @@ -8300,12 +8308,18 @@ init_gif_functions (void) # undef DGifOpen # undef DGifOpenFileName # undef DGifSlurp +# if GIFLIB_MAJOR >= 5 +# undef DGifSavedExtensionToGCB +# endif # undef GifErrorString # define DGifCloseFile fn_DGifCloseFile # define DGifOpen fn_DGifOpen # define DGifOpenFileName fn_DGifOpenFileName # define DGifSlurp fn_DGifSlurp +# if GIFLIB_MAJOR >= 5 +# define DGifSavedExtensionToGCB fn_DGifSavedExtensionToGCB +# endif # define GifErrorString fn_GifErrorString # endif /* WINDOWSNT */ @@ -8383,7 +8397,7 @@ gif_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file); - return 0; + return false; } Lisp_Object encoded_file = ENCODE_FILE (file); @@ -8406,8 +8420,7 @@ gif_load (struct frame *f, struct image *img) else #endif image_error ("Cannot open `%s'", file); - - return 0; + return false; } } else @@ -8415,7 +8428,7 @@ gif_load (struct frame *f, struct image *img) if (!STRINGP (specified_data)) { image_error ("Invalid image data `%s'", specified_data); - return 0; + return false; } /* Read from memory! */ @@ -8439,7 +8452,7 @@ gif_load (struct frame *f, struct image *img) else #endif image_error ("Cannot open memory source `%s'", img->spec); - return 0; + return false; } } @@ -8447,8 +8460,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, gif->SWidth, gif->SHeight)) { image_size_error (); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Read entire contents. */ @@ -8459,8 +8471,7 @@ gif_load (struct frame *f, struct image *img) image_error ("Error reading `%s'", img->spec); else image_error ("Error reading GIF data"); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Which sub-image are we to display? */ @@ -8471,8 +8482,7 @@ gif_load (struct frame *f, struct image *img) { image_error ("Invalid image number `%s' in image `%s'", image_number, img->spec); - gif_close (gif, NULL); - return 0; + goto gif_error; } } @@ -8489,8 +8499,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { image_size_error (); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Check that the selected subimages fit. It's not clear whether @@ -8507,18 +8516,14 @@ gif_load (struct frame *f, struct image *img) && 0 <= subimg_left && subimg_left <= width - subimg_width)) { image_error ("Subimage does not fit in image"); - gif_close (gif, NULL); - return 0; + goto gif_error; } } /* Create the X image and pixmap. */ Emacs_Pix_Container ximg; if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) - { - gif_close (gif, NULL); - return 0; - } + goto gif_error; /* Clear the part of the screen image not covered by the image. Full animated GIF support requires more here (see the gif89 spec, @@ -8577,13 +8582,17 @@ gif_load (struct frame *f, struct image *img) char *, which invites problems with bytes >= 0x80. */ struct SavedImage *subimage = gif->SavedImages + j; unsigned char *raster = (unsigned char *) subimage->RasterBits; - int transparency_color_index = -1; - int disposal = 0; int subimg_width = subimage->ImageDesc.Width; int subimg_height = subimage->ImageDesc.Height; int subimg_top = subimage->ImageDesc.Top; int subimg_left = subimage->ImageDesc.Left; + /* From gif89a spec: 1 = "keep in place", 2 = "restore + to background". Treat any other value like 2. */ + int disposal = DISPOSAL_UNSPECIFIED; + int transparency_color_index = NO_TRANSPARENT_COLOR; + +#if GIFLIB_MAJOR < 5 /* Find the Graphic Control Extension block for this sub-image. Extract the disposal method and transparency color. */ for (i = 0; i < subimage->ExtensionBlockCount; i++) @@ -8594,24 +8603,29 @@ gif_load (struct frame *f, struct image *img) && extblock->ByteCount == 4 && extblock->Bytes[0] & 1) { - /* From gif89a spec: 1 = "keep in place", 2 = "restore - to background". Treat any other value like 2. */ disposal = (extblock->Bytes[0] >> 2) & 7; transparency_color_index = (unsigned char) extblock->Bytes[3]; break; } } +#else + GraphicsControlBlock gcb; + DGifSavedExtensionToGCB (gif, j, &gcb); + disposal = gcb.DisposalMode; + transparency_color_index = gcb.TransparentColor; +#endif /* We can't "keep in place" the first subimage. */ if (j == 0) - disposal = 2; + disposal = DISPOSE_BACKGROUND; - /* For disposal == 0, the spec says "No disposal specified. The - decoder is not required to take any action." In practice, it - seems we need to treat this like "keep in place", see e.g. + /* For disposal == 0 (DISPOSAL_UNSPECIFIED), the spec says + "No disposal specified. The decoder is not required to take + any action." In practice, it seems we need to treat this + like "keep in place" (DISPOSE_DO_NOT), see e.g. https://upload.wikimedia.org/wikipedia/commons/3/37/Clock.gif */ - if (disposal == 0) - disposal = 1; + if (disposal == DISPOSAL_UNSPECIFIED) + disposal = DISPOSE_DO_NOT; gif_color_map = subimage->ImageDesc.ColorMap; if (!gif_color_map) @@ -8650,7 +8664,7 @@ gif_load (struct frame *f, struct image *img) for (x = 0; x < subimg_width; x++) { int c = raster[y * subimg_width + x]; - if (transparency_color_index != c || disposal != 1) + if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { PUT_PIXEL (ximg, x + subimg_left, row + subimg_top, pixel_colors[c]); @@ -8664,7 +8678,7 @@ gif_load (struct frame *f, struct image *img) for (x = 0; x < subimg_width; ++x) { int c = raster[y * subimg_width + x]; - if (transparency_color_index != c || disposal != 1) + if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { PUT_PIXEL (ximg, x + subimg_left, y + subimg_top, pixel_colors[c]); @@ -8734,14 +8748,296 @@ gif_load (struct frame *f, struct image *img) /* Put ximg into the image. */ image_put_x_image (f, img, ximg, 0); - return 1; + return true; + + gif_error: + gif_close (gif, NULL); + return false; } #endif /* HAVE_GIF */ +#ifdef HAVE_WEBP + + +/*********************************************************************** + WebP + ***********************************************************************/ + +#include "webp/decode.h" + +/* Indices of image specification fields in webp_format, below. */ + +enum webp_keyword_index +{ + WEBP_TYPE, + WEBP_DATA, + WEBP_FILE, + WEBP_ASCENT, + WEBP_MARGIN, + WEBP_RELIEF, + WEBP_ALGORITHM, + WEBP_HEURISTIC_MASK, + WEBP_MASK, + WEBP_BACKGROUND, + WEBP_LAST +}; + +/* Vector of image_keyword structures describing the format + of valid user-defined image specifications. */ + +static const struct image_keyword webp_format[WEBP_LAST] = +{ + {":type", IMAGE_SYMBOL_VALUE, 1}, + {":data", IMAGE_STRING_VALUE, 0}, + {":file", IMAGE_STRING_VALUE, 0}, + {":ascent", IMAGE_ASCENT_VALUE, 0}, + {":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0}, + {":relief", IMAGE_INTEGER_VALUE, 0}, + {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":background", IMAGE_STRING_OR_NIL_VALUE, 0} +}; + +/* Return true if OBJECT is a valid WebP image specification. */ + +static bool +webp_image_p (Lisp_Object object) +{ + struct image_keyword fmt[WEBP_LAST]; + memcpy (fmt, webp_format, sizeof fmt); + + if (!parse_image_spec (object, fmt, WEBP_LAST, Qwebp)) + return false; + + /* Must specify either the :data or :file keyword. */ + return fmt[WEBP_FILE].count + fmt[WEBP_DATA].count == 1; +} + +#ifdef WINDOWSNT + +/* WebP library details. */ + +DEF_DLL_FN (int, WebPGetInfo, (const uint8_t *, size_t, int *, int *)); +/* WebPGetFeatures is a static inline function defined in WebP's + decode.h. Since we cannot use that with dynamically-loaded libwebp + DLL, we instead load the internal function it calls and redirect to + that through a macro. */ +DEF_DLL_FN (VP8StatusCode, WebPGetFeaturesInternal, + (const uint8_t *, size_t, WebPBitstreamFeatures *, int)); +DEF_DLL_FN (uint8_t *, WebPDecodeRGBA, (const uint8_t *, size_t, int *, int *)); +DEF_DLL_FN (uint8_t *, WebPDecodeRGB, (const uint8_t *, size_t, int *, int *)); +DEF_DLL_FN (void, WebPFree, (void *)); + +static bool +init_webp_functions (void) +{ + HMODULE library; + + if (!(library = w32_delayed_load (Qwebp))) + return false; + + LOAD_DLL_FN (library, WebPGetInfo); + LOAD_DLL_FN (library, WebPGetFeaturesInternal); + LOAD_DLL_FN (library, WebPDecodeRGBA); + LOAD_DLL_FN (library, WebPDecodeRGB); + LOAD_DLL_FN (library, WebPFree); + return true; +} + +#undef WebPGetInfo +#undef WebPGetFeatures +#undef WebPDecodeRGBA +#undef WebPDecodeRGB +#undef WebPFree + +#define WebPGetInfo fn_WebPGetInfo +#define WebPGetFeatures(d,s,f) \ + fn_WebPGetFeaturesInternal(d,s,f,WEBP_DECODER_ABI_VERSION) +#define WebPDecodeRGBA fn_WebPDecodeRGBA +#define WebPDecodeRGB fn_WebPDecodeRGB +#define WebPFree fn_WebPFree + +#endif /* WINDOWSNT */ + +/* Load WebP image IMG for use on frame F. Value is true if + successful. */ + +static bool +webp_load (struct frame *f, struct image *img) +{ + ptrdiff_t size = 0; + uint8_t *contents; + Lisp_Object file; + + /* Open the WebP file. */ + Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); + Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); + + if (NILP (specified_data)) + { + int fd; + file = image_find_image_fd (specified_file, &fd); + if (!STRINGP (file)) + { + image_error ("Cannot find image file `%s'", specified_file); + return false; + } + + contents = (uint8_t *) slurp_file (fd, &size); + if (contents == NULL) + { + image_error ("Error loading WebP image `%s'", file); + return false; + } + } + else + { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data); + return false; + } + contents = SDATA (specified_data); + size = SBYTES (specified_data); + } + + /* Validate the WebP image header. */ + if (!WebPGetInfo (contents, size, NULL, NULL)) + { + if (NILP (specified_data)) + image_error ("Not a WebP file: `%s'", file); + else + image_error ("Invalid header in WebP image data"); + goto webp_error1; + } + + /* Get WebP features. */ + WebPBitstreamFeatures features; + VP8StatusCode result = WebPGetFeatures (contents, size, &features); + switch (result) + { + case VP8_STATUS_OK: + break; + case VP8_STATUS_NOT_ENOUGH_DATA: + case VP8_STATUS_OUT_OF_MEMORY: + case VP8_STATUS_INVALID_PARAM: + case VP8_STATUS_BITSTREAM_ERROR: + case VP8_STATUS_UNSUPPORTED_FEATURE: + case VP8_STATUS_SUSPENDED: + case VP8_STATUS_USER_ABORT: + default: + /* Error out in all other cases. */ + if (NILP (specified_data)) + image_error ("Error when interpreting WebP image data: `%s'", file); + else + image_error ("Error when interpreting WebP image data"); + goto webp_error1; + } + + /* Decode WebP data. */ + uint8_t *decoded; + int width, height; + if (features.has_alpha) + /* Linear [r0, g0, b0, a0, r1, g1, b1, a1, ...] order. */ + decoded = WebPDecodeRGBA (contents, size, &width, &height); + else + /* Linear [r0, g0, b0, r1, g1, b1, ...] order. */ + decoded = WebPDecodeRGB (contents, size, &width, &height); + + if (!(width <= INT_MAX && height <= INT_MAX + && check_image_size (f, width, height))) + { + image_size_error (); + goto webp_error2; + } + + /* Create the x image and pixmap. */ + Emacs_Pix_Container ximg, mask_img; + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, false)) + goto webp_error2; + + /* Create an image and pixmap serving as mask if the WebP image + contains an alpha channel. */ + if (features.has_alpha + && !image_create_x_image_and_pixmap (f, img, width, height, 1, &mask_img, true)) + { + image_destroy_x_image (ximg); + image_clear_image_1 (f, img, CLEAR_IMAGE_PIXMAP); + goto webp_error2; + } + + /* Fill the X image and mask from WebP data. */ + init_color_table (); + + uint8_t *p = decoded; + for (int y = 0; y < height; ++y) + { + for (int x = 0; x < width; ++x) + { + int r = *p++ << 8; + int g = *p++ << 8; + int b = *p++ << 8; + PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, r, g, b)); + + /* An alpha channel associates variable transparency with an + image. WebP allows up to 256 levels of partial transparency. + We handle this like with PNG (which see), using the frame's + background color to combine the image with. */ + if (features.has_alpha) + { + if (mask_img) + PUT_PIXEL (mask_img, x, y, *p > 0 ? PIX_MASK_DRAW : PIX_MASK_RETAIN); + ++p; + } + } + } + +#ifdef COLOR_TABLE_SUPPORT + /* Remember colors allocated for this image. */ + img->colors = colors_in_color_table (&img->ncolors); + free_color_table (); +#endif /* COLOR_TABLE_SUPPORT */ + + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); + + /* Same for the mask. */ + if (mask_img) + { + /* Fill in the background_transparent field while we have the + mask handy. Casting avoids a GCC warning. */ + image_background_transparent (img, f, (Emacs_Pix_Context)mask_img); + + image_put_x_image (f, img, mask_img, 1); + } + + img->width = width; + img->height = height; + + /* Clean up. */ + WebPFree (decoded); + if (NILP (specified_data)) + xfree (contents); + return true; + + webp_error2: + WebPFree (decoded); + + webp_error1: + if (NILP (specified_data)) + xfree (contents); + return false; +} + +#endif /* HAVE_WEBP */ + + #ifdef HAVE_IMAGEMAGICK + /*********************************************************************** ImageMagick ***********************************************************************/ @@ -9676,14 +9972,15 @@ DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions, 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 # if LIBRSVG_CHECK_VERSION (2, 48, 0) DEF_DLL_FN (gboolean, rsvg_handle_set_stylesheet, (RsvgHandle *, const guint8 *, gsize, GError **)); # endif -DEF_DLL_FN (void, rsvg_handle_get_dimensions, - (RsvgHandle *, RsvgDimensionData *)); 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 *)); @@ -9734,11 +10031,12 @@ init_svg_functions (void) #if LIBRSVG_CHECK_VERSION (2, 46, 0) LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions); LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); +#else + LOAD_DLL_FN (library, rsvg_handle_get_dimensions); #endif #if LIBRSVG_CHECK_VERSION (2, 48, 0) LOAD_DLL_FN (library, rsvg_handle_set_stylesheet); #endif - LOAD_DLL_FN (library, rsvg_handle_get_dimensions); LOAD_DLL_FN (library, rsvg_handle_get_pixbuf); LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width); @@ -9776,8 +10074,9 @@ init_svg_functions (void) # if LIBRSVG_CHECK_VERSION (2, 46, 0) # undef rsvg_handle_get_intrinsic_dimensions # undef rsvg_handle_get_geometry_for_layer +# else +# undef rsvg_handle_get_dimensions # endif -# undef rsvg_handle_get_dimensions # if LIBRSVG_CHECK_VERSION (2, 48, 0) # undef rsvg_handle_set_stylesheet # endif @@ -9812,8 +10111,9 @@ init_svg_functions (void) fn_rsvg_handle_get_intrinsic_dimensions # 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_dimensions fn_rsvg_handle_get_dimensions # if LIBRSVG_CHECK_VERSION (2, 48, 0) # define rsvg_handle_set_stylesheet fn_rsvg_handle_set_stylesheet # endif @@ -10088,21 +10388,13 @@ svg_load_image (struct frame *f, struct image *img, char *contents, viewbox_width = viewbox.x + viewbox.width; viewbox_height = viewbox.y + viewbox.height; } - - if (viewbox_width == 0 || viewbox_height == 0) +#else + /* In librsvg before 2.46.0, guess the viewbox from the image dimensions. */ + RsvgDimensionData dimension_data; + rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); + viewbox_width = dimension_data.width; + viewbox_height = dimension_data.height; #endif - { - /* The functions 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; - } compute_image_size (viewbox_width, viewbox_height, img, &width, &height); @@ -10727,6 +11019,10 @@ static struct image_type const image_types[] = { SYMBOL_INDEX (Qxpm), xpm_image_p, xpm_load, image_clear_image, IMAGE_TYPE_INIT (init_xpm_functions) }, #endif +#if defined HAVE_WEBP + { SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, image_clear_image, + IMAGE_TYPE_INIT (init_webp_functions) }, +#endif { SYMBOL_INDEX (Qxbm), xbm_image_p, xbm_load, image_clear_image }, { SYMBOL_INDEX (Qpbm), pbm_image_p, pbm_load, image_clear_image }, }; @@ -10892,6 +11188,11 @@ non-numeric, there is no explicit limit on the size of images. */); add_image_type (Qpng); #endif +#if defined (HAVE_WEBP) + DEFSYM (Qwebp, "webp"); + add_image_type (Qwebp); +#endif + #if defined (HAVE_IMAGEMAGICK) DEFSYM (Qimagemagick, "imagemagick"); add_image_type (Qimagemagick); diff --git a/src/intervals.c b/src/intervals.c index f88a41f2549..11d5b6bbb6f 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -166,10 +166,11 @@ merge_properties (register INTERVAL source, register INTERVAL target) } } -/* Return true if the two intervals have the same properties. */ +/* Return true if the two intervals have the same properties. + If use_equal is true, use Fequal for comparisons instead of EQ. */ -bool -intervals_equal (INTERVAL i0, INTERVAL i1) +static bool +intervals_equal_1 (INTERVAL i0, INTERVAL i1, bool use_equal) { Lisp_Object i0_cdr, i0_sym; Lisp_Object i1_cdr, i1_val; @@ -204,7 +205,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* i0 and i1 both have sym, but it has different values in each. */ if (!CONSP (i1_val) || (i1_val = XCDR (i1_val), !CONSP (i1_val)) - || !EQ (XCAR (i1_val), XCAR (i0_cdr))) + || use_equal ? NILP (Fequal (XCAR (i1_val), XCAR (i0_cdr))) + : !EQ (XCAR (i1_val), XCAR (i0_cdr))) return false; i0_cdr = XCDR (i0_cdr); @@ -218,6 +220,14 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* Lengths of the two plists were equal. */ return (NILP (i0_cdr) && NILP (i1_cdr)); } + +/* Return true if the two intervals have the same properties. */ + +bool +intervals_equal (INTERVAL i0, INTERVAL i1) +{ + return intervals_equal_1 (i0, i1, false); +} /* Traverse an interval tree TREE, performing FUNCTION on each node. @@ -2291,7 +2301,7 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2) /* If we ever find a mismatch between the strings, they differ. */ - if (! intervals_equal (i1, i2)) + if (! intervals_equal_1 (i1, i2, true)) return 0; /* Advance POS till the end of the shorter interval, diff --git a/src/keyboard.c b/src/keyboard.c index c608c072f01..aa6a4b9e976 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -375,6 +375,7 @@ static void timer_resume_idle (void); static void deliver_user_signal (int); static char *find_user_signal_name (int); static void store_user_signal_events (void); +static bool is_ignored_event (union buffered_input_event *); /* Advance or retreat a buffered input event pointer. */ @@ -2943,20 +2944,8 @@ read_char (int commandflag, Lisp_Object map, last_input_event = c; call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt); - if (CONSP (c) - && (EQ (XCAR (c), Qselect_window) - || EQ (XCAR (c), Qfocus_out) -#ifdef HAVE_DBUS - || EQ (XCAR (c), Qdbus_event) -#endif -#ifdef USE_FILE_NOTIFY - || EQ (XCAR (c), Qfile_notify) -#endif -#ifdef THREADS_ENABLED - || EQ (XCAR (c), Qthread_event) -#endif - || EQ (XCAR (c), Qconfig_changed_event)) - && !end_time) + if (CONSP (c) && !NILP (Fmemq (XCAR (c), Vwhile_no_input_ignore_events)) + && !end_time) /* We stopped being idle for this event; undo that. This prevents automatic window selection (under mouse-autoselect-window) from acting as a real input event, for @@ -3458,8 +3447,13 @@ readable_events (int flags) if (flags & READABLE_EVENTS_DO_TIMERS_NOW) timer_check (); - /* If the buffer contains only FOCUS_IN/OUT_EVENT events, and - READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */ + /* READABLE_EVENTS_FILTER_EVENTS is meant to be used only by + input-pending-p and similar callers, which aren't interested in + some input events. If this flag is set, and + input-pending-p-filter-events is non-nil, ignore events in + while-no-input-ignore-events. If the flag is set and + input-pending-p-filter-events is nil, ignore only + FOCUS_IN/OUT_EVENT events. */ if (kbd_fetch_ptr != kbd_store_ptr) { /* See https://lists.gnu.org/r/emacs-devel/2005-05/msg00297.html @@ -3478,8 +3472,11 @@ readable_events (int flags) #ifdef USE_TOOLKIT_SCROLL_BARS (flags & READABLE_EVENTS_FILTER_EVENTS) && #endif - (event->kind == FOCUS_IN_EVENT - || event->kind == FOCUS_OUT_EVENT)) + ((!input_pending_p_filter_events + && (event->kind == FOCUS_IN_EVENT + || event->kind == FOCUS_OUT_EVENT)) + || (input_pending_p_filter_events + && is_ignored_event (event)))) #ifdef USE_TOOLKIT_SCROLL_BARS && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES) && (event->kind == SCROLL_BAR_CLICK_EVENT @@ -3661,29 +3658,10 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, #endif /* subprocesses */ } - Lisp_Object ignore_event; - - switch (event->kind) - { - case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break; - case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break; - case HELP_EVENT: ignore_event = Qhelp_echo; break; - case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; - case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; - case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; -#ifdef USE_FILE_NOTIFY - case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break; -#endif -#ifdef HAVE_DBUS - case DBUS_EVENT: ignore_event = Qdbus_event; break; -#endif - default: ignore_event = Qnil; break; - } - /* If we're inside while-no-input, and this event qualifies as input, set quit-flag to cause an interrupt. */ if (!NILP (Vthrow_on_input) - && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) + && !is_ignored_event (event)) Vquit_flag = Vthrow_on_input; } @@ -7856,7 +7834,9 @@ parse_menu_item (Lisp_Object item, int inmenubar) else if (EQ (tem, QCkeys)) { tem = XCAR (item); - if (CONSP (tem) || STRINGP (tem)) + if (FUNCTIONP (tem)) + ASET (item_properties, ITEM_PROPERTY_KEYEQ, call0 (tem)); + else if (CONSP (tem) || STRINGP (tem)) ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem); } else if (EQ (tem, QCbutton) && CONSP (XCAR (item))) @@ -10184,7 +10164,8 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, use the corresponding lower-case letter instead. */ if (NILP (current_binding) && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t - && FIXNUMP (key)) + && FIXNUMP (key) + && translate_upper_case_key_bindings) { Lisp_Object new_key; EMACS_INT k = XFIXNUM (key); @@ -10236,12 +10217,14 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, int modifiers = CONSP (breakdown) ? (XFIXNUM (XCAR (XCDR (breakdown)))) : 0; - if (modifiers & shift_modifier - /* Treat uppercase keys as shifted. */ - || (FIXNUMP (key) - && (KEY_TO_CHAR (key) - < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->header.size) - && uppercasep (KEY_TO_CHAR (key)))) + if (translate_upper_case_key_bindings + && (modifiers & shift_modifier + /* Treat uppercase keys as shifted. */ + || (FIXNUMP (key) + && (KEY_TO_CHAR (key) + < XCHAR_TABLE (BVAR (current_buffer, + downcase_table))->header.size) + && uppercasep (KEY_TO_CHAR (key))))) { Lisp_Object new_key = (modifiers & shift_modifier @@ -11617,6 +11600,52 @@ static const struct event_head head_table[] = { {SYMBOL_INDEX (Qselect_window), SYMBOL_INDEX (Qswitch_frame)} }; +static Lisp_Object +init_while_no_input_ignore_events (void) +{ + Lisp_Object events = listn (9, Qselect_window, Qhelp_echo, Qmove_frame, + Qiconify_frame, Qmake_frame_visible, + Qfocus_in, Qfocus_out, Qconfig_changed_event, + Qselection_request); + +#ifdef HAVE_DBUS + events = Fcons (Qdbus_event, events); +#endif +#ifdef USE_FILE_NOTIFY + events = Fcons (Qfile_notify, events); +#endif +#ifdef THREADS_ENABLED + events = Fcons (Qthread_event, events); +#endif + + return events; +} + +static bool +is_ignored_event (union buffered_input_event *event) +{ + Lisp_Object ignore_event; + + switch (event->kind) + { + case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break; + case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break; + case HELP_EVENT: ignore_event = Qhelp_echo; break; + case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; + case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; + case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; +#ifdef USE_FILE_NOTIFY + case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break; +#endif +#ifdef HAVE_DBUS + case DBUS_EVENT: ignore_event = Qdbus_event; break; +#endif + default: ignore_event = Qnil; break; + } + + return !NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)); +} + static void syms_of_keyboard_for_pdumper (void); void @@ -12511,7 +12540,29 @@ If nil, Emacs crashes immediately in response to fatal signals. */); DEFVAR_LISP ("while-no-input-ignore-events", Vwhile_no_input_ignore_events, - doc: /* Ignored events from while-no-input. */); + doc: /* Ignored events from `while-no-input'. +Events in this list do not count as pending input while running +`while-no-input' and do not cause any idle timers to get reset when they +occur. */); + Vwhile_no_input_ignore_events = init_while_no_input_ignore_events (); + + DEFVAR_BOOL ("translate-upper-case-key-bindings", + translate_upper_case_key_bindings, + doc: /* If non-nil, interpret upper case keys as lower case (when applicable). +Emacs allows binding both upper and lower case key sequences to +commands. However, if there is a lower case key sequence bound to a +command, and the user enters an upper case key sequence that is not +bound to a command, Emacs will use the lower case binding. Setting +this variable to nil inhibits this behaviour. */); + translate_upper_case_key_bindings = true; + + DEFVAR_BOOL ("input-pending-p-filter-events", + input_pending_p_filter_events, + doc: /* If non-nil, `input-pending-p' ignores some input events. +If this variable is non-nil (the default), `input-pending-p' and +other similar functions ignore input events in `while-no-input-ignore-events'. +This flag may eventually be removed once this behavior is deemed safe. */); + input_pending_p_filter_events = true; pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); } diff --git a/src/keymap.c b/src/keymap.c index 28ff71c01da..29d2ca7ab7e 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -65,6 +65,9 @@ static Lisp_Object exclude_keys; /* Pre-allocated 2-element vector for Fcommand_remapping to use. */ static Lisp_Object command_remapping_vector; +/* Char table for the backwards-compatibility part in Flookup_key. */ +static Lisp_Object unicode_case_table; + /* Hash table used to cache a reverse-map to speed up calls to where-is. */ static Lisp_Object where_is_cache; /* Which keymaps are reverse-stored in the cache. */ @@ -1027,6 +1030,28 @@ is not copied. */) /* Simple Keymap mutators and accessors. */ +static Lisp_Object +possibly_translate_key_sequence (Lisp_Object key, ptrdiff_t *length) +{ + if (VECTORP (key) && ASIZE (key) == 1 && STRINGP (AREF (key, 0))) + { + /* KEY is on the ["C-c"] format, so translate to internal + format. */ + if (NILP (Ffboundp (Qkbd_valid_p))) + xsignal2 (Qerror, + build_string ("`kbd-valid-p' is not defined, so this syntax can't be used: %s"), + key); + if (NILP (call1 (Qkbd_valid_p, AREF (key, 0)))) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + key = call1 (Qkbd, AREF (key, 0)); + *length = CHECK_VECTOR_OR_STRING (key); + if (*length == 0) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + } + + return key; +} + /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, @@ -1050,7 +1075,9 @@ DEF is anything that can be a key's definition: function definition, which should at that time be one of the above, or another symbol whose function definition is used, etc.), a cons (STRING . DEFN), meaning that DEFN is the definition - (DEFN should be a valid definition in its own right), + (DEFN should be a valid definition in its own right) and + STRING is the menu item name (which is used only if the containing + keymap has been created with a menu name, see `make-keymap'), or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP, or an extended menu item definition. (See info node `(elisp)Extended Menu Items'.) @@ -1085,6 +1112,8 @@ binding KEY to DEF is added at the front of KEYMAP. */) def = tmp; } + key = possibly_translate_key_sequence (key, &length); + ptrdiff_t idx = 0; while (1) { @@ -1195,6 +1224,8 @@ lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) if (length == 0) return keymap; + key = possibly_translate_key_sequence (key, &length); + ptrdiff_t idx = 0; while (1) { @@ -1251,39 +1282,126 @@ recognize the default bindings, just as `read-key-sequence' does. */) return found; /* Menu definitions might use mixed case symbols (notably in old - versions of `easy-menu-define'). We accept this variation for - backwards-compatibility. (Bug#50752) */ - ptrdiff_t key_len = VECTORP (key) ? ASIZE (key) : 0; - if (key_len > 0 && EQ (AREF (key, 0), Qmenu_bar)) + versions of `easy-menu-define'), or use " " instead of "-". + The rest of this function is about accepting these variations for + backwards-compatibility. (Bug#50752) */ + + /* Just skip everything below unless this is a menu item. */ + if (!VECTORP (key) || !(ASIZE (key) > 0) + || !EQ (AREF (key, 0), Qmenu_bar)) + return found; + + /* Initialize the unicode case table, if it wasn't already. */ + if (NILP (unicode_case_table)) + { + unicode_case_table = uniprop_table (intern ("lowercase")); + /* uni-lowercase.el might be unavailable during bootstrap. */ + if (NILP (unicode_case_table)) + return found; + staticpro (&unicode_case_table); + } + + ptrdiff_t key_len = ASIZE (key); + Lisp_Object new_key = make_vector (key_len, Qnil); + + /* Try both the Unicode case table, and the buffer local one. + Otherwise, we will fail for e.g. the "Turkish" language + environment where 'I' does not downcase to 'i'. */ + Lisp_Object tables[2] = {unicode_case_table, Fcurrent_case_table ()}; + for (int tbl_num = 0; tbl_num < 2; tbl_num++) { - Lisp_Object new_key = make_vector (key_len, Qnil); - for (int i = 0; i < key_len; ++i) + /* First, let's try converting all symbols like "Foo-Bar-Baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) { Lisp_Object item = AREF (key, i); if (!SYMBOLP (item)) ASET (new_key, i, item); else { - Lisp_Object sym = Fsymbol_name (item); - USE_SAFE_ALLOCA; - unsigned char *dst = SAFE_ALLOCA (SBYTES (sym) + 1); - memcpy (dst, SSDATA (sym), SBYTES (sym)); - /* We can walk the string data byte by byte, because - UTF-8 encoding ensures that no other byte of any - multibyte sequence will ever include a 7-bit byte - equal to an ASCII single-byte character. */ - for (int j = 0; j < SBYTES (sym); ++j) - if (dst[j] >= 'A' && dst[j] <= 'Z') - dst[j] += 'a' - 'A'; /* Convert to lower case. */ - ASET (new_key, i, Fintern (make_multibyte_string ((char *) dst, - SCHARS (sym), - SBYTES (sym)), - Qnil)); - SAFE_FREE (); + Lisp_Object key_item = Fsymbol_name (item); + Lisp_Object new_item; + if (!STRING_MULTIBYTE (key_item)) + new_item = Fdowncase (key_item); + else + { + USE_SAFE_ALLOCA; + ptrdiff_t size = SCHARS (key_item), n; + if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) + n = PTRDIFF_MAX; + unsigned char *dst = SAFE_ALLOCA (n); + unsigned char *p = dst; + ptrdiff_t j_char = 0, j_byte = 0; + + while (j_char < size) + { + int ch = fetch_string_char_advance (key_item, + &j_char, &j_byte); + Lisp_Object ch_conv = CHAR_TABLE_REF (tables[tbl_num], + ch); + if (!NILP (ch_conv)) + CHAR_STRING (XFIXNUM (ch_conv), p); + else + CHAR_STRING (ch, p); + p = dst + j_byte; + } + new_item = make_multibyte_string ((char *) dst, + SCHARS (key_item), + SBYTES (key_item)); + SAFE_FREE (); + } + ASET (new_key, i, Fintern (new_item, Qnil)); } } + + /* Check for match. */ found = lookup_key_1 (keymap, new_key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + break; + + /* If we still don't have a match, let's convert any spaces in + our lowercased string into dashes, e.g. "foo bar baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) + { + if (!SYMBOLP (AREF (new_key, i))) + continue; + + Lisp_Object lc_key = Fsymbol_name (AREF (new_key, i)); + + /* If there are no spaces in this symbol, just skip it. */ + if (!strstr (SSDATA (lc_key), " ")) + continue; + + USE_SAFE_ALLOCA; + ptrdiff_t size = SCHARS (lc_key), n; + if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) + n = PTRDIFF_MAX; + unsigned char *dst = SAFE_ALLOCA (n); + + /* We can walk the string data byte by byte, because UTF-8 + encoding ensures that no other byte of any multibyte + sequence will ever include a 7-bit byte equal to an ASCII + single-byte character. */ + memcpy (dst, SSDATA (lc_key), SBYTES (lc_key)); + for (int i = 0; i < SBYTES (lc_key); ++i) + { + if (dst[i] == ' ') + dst[i] = '-'; + } + Lisp_Object new_it = + make_multibyte_string ((char *) dst, + SCHARS (lc_key), SBYTES (lc_key)); + ASET (new_key, i, Fintern (new_it, Qnil)); + SAFE_FREE (); + } + + /* Check for match. */ + found = lookup_key_1 (keymap, new_key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + break; } + return found; } @@ -2815,7 +2933,10 @@ You type Translation\n\ { if (EQ (start1, BVAR (XBUFFER (buffer), keymap))) { - Lisp_Object msg = build_unibyte_string ("\f\nMajor Mode Bindings"); + Lisp_Object msg = + CALLN (Fformat, + build_unibyte_string ("\f\n`%s' Major Mode Bindings"), + XBUFFER (buffer)->major_mode_); CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, @@ -3308,4 +3429,7 @@ that describe key bindings. That is why the default is nil. */); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_buffer_bindings); + + DEFSYM (Qkbd, "kbd"); + DEFSYM (Qkbd_valid_p, "kbd-valid-p"); } diff --git a/src/lisp.h b/src/lisp.h index 480c389a3bc..31656bb3b1c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3947,7 +3947,8 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); -extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; /* Make an uninitialized vector for SIZE objects. NOTE: you must be sure that GC cannot happen until the vector is completely @@ -3960,7 +3961,8 @@ extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); allocate_vector has a similar problem. */ -extern struct Lisp_Vector *allocate_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; INLINE Lisp_Object make_uninit_vector (ptrdiff_t size) @@ -3992,7 +3994,8 @@ make_nil_vector (ptrdiff_t size) } extern struct Lisp_Vector *allocate_pseudovector (int, int, int, - enum pvec_type); + enum pvec_type) + ATTRIBUTE_RETURNS_NONNULL; /* Allocate uninitialized pseudovector with no Lisp_Object slots. */ @@ -4024,7 +4027,7 @@ extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); -extern struct buffer * allocate_buffer (void); +extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); /* Defined in gmalloc.c. */ @@ -4182,7 +4185,8 @@ extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); -extern struct handler *push_handler (Lisp_Object, enum handlertype); +extern struct handler *push_handler (Lisp_Object, enum handlertype) + ATTRIBUTE_RETURNS_NONNULL; extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); @@ -4323,9 +4327,10 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ -extern char *splice_dir_file (char *, char const *, char const *); +extern char *splice_dir_file (char *, char const *, char const *) + ATTRIBUTE_RETURNS_NONNULL; extern bool file_name_absolute_p (const char *); -extern char const *get_homedir (void); +extern char const *get_homedir (void) ATTRIBUTE_RETURNS_NONNULL; extern Lisp_Object expand_and_dir_to_file (Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, @@ -4479,7 +4484,7 @@ INLINE void fixup_locale (void) {} INLINE void synchronize_system_messages_locale (void) {} INLINE void synchronize_system_time_locale (void) {} #endif -extern char *emacs_strerror (int); +extern char *emacs_strerror (int) ATTRIBUTE_RETURNS_NONNULL; extern void shut_down_emacs (int, Lisp_Object); /* True means don't do interactive redisplay and don't change tty modes. */ @@ -4545,7 +4550,7 @@ extern void setup_process_coding_systems (Lisp_Object); extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, const char *, const sigset_t *); -extern char **make_environment_block (Lisp_Object); +extern char **make_environment_block (Lisp_Object) ATTRIBUTE_RETURNS_NONNULL; extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); @@ -4814,17 +4819,24 @@ extern char my_edata[]; extern char my_endbss[]; extern char *my_endbss_static; -extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); +extern void *xmalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xzalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xrealloc (void *, size_t) + ATTRIBUTE_ALLOC_SIZE ((2)) ATTRIBUTE_RETURNS_NONNULL; extern void xfree (void *); -extern void *xnmalloc (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2)); +extern void *xnmalloc (ptrdiff_t, ptrdiff_t) + ATTRIBUTE_MALLOC_SIZE ((1,2)) ATTRIBUTE_RETURNS_NONNULL; extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t) - ATTRIBUTE_ALLOC_SIZE ((2,3)); -extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t); - -extern char *xstrdup (const char *) ATTRIBUTE_MALLOC; -extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC; + ATTRIBUTE_ALLOC_SIZE ((2,3)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; + +extern char *xstrdup (char const *) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; +extern char *xlispstrdup (Lisp_Object) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; extern void dupstring (char **, char const *); /* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating @@ -4874,7 +4886,8 @@ extern void init_system_name (void); enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; -extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); +extern void *record_xmalloc (size_t) + ATTRIBUTE_ALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; #define USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = MAX_ALLOCA; \ diff --git a/src/macfont.m b/src/macfont.m index 78ed5d53f39..1426cae6dc4 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -613,6 +613,21 @@ get_cgcolor(unsigned long idx, struct frame *f) return cgColor; } +static CGColorRef +get_cgcolor_from_nscolor (NSColor *nsColor, struct frame *f) +{ + [nsColor set]; + CGColorSpaceRef colorSpace = [[nsColor colorSpace] CGColorSpace]; + NSInteger noc = [nsColor numberOfComponents]; + CGFloat *components = xmalloc (sizeof(CGFloat)*(1+noc)); + CGColorRef cgColor; + + [nsColor getComponents: components]; + cgColor = CGColorCreate (colorSpace, components); + xfree (components); + return cgColor; +} + #define CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND(context, face, f) \ do { \ CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face), f); \ @@ -2911,14 +2926,14 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y, if (!CGRectIsNull (background_rect)) { - if (s->hl == DRAW_MOUSE_FACE) + if (s->hl == DRAW_CURSOR) { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + CGColorRef *colorref = get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (f), f); + CGContextSetFillColorWithColor (context, colorref); + CGColorRelease (colorref); } - CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face, f); + else + CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face, f); CGContextFillRects (context, &background_rect, 1); } @@ -2927,7 +2942,14 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y, CGAffineTransform atfm; CGContextScaleCTM (context, 1, -1); - CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face, s->f); + if (s->hl == DRAW_CURSOR) + { + CGColorRef *colorref = get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (f), f); + CGContextSetFillColorWithColor (context, colorref); + CGColorRelease (colorref); + } + else + CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face, s->f); if (macfont_info->synthetic_italic_p) atfm = synthetic_italic_atfm; else diff --git a/src/minibuf.c b/src/minibuf.c index 4b72d3e896b..6c0cd358c50 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1005,7 +1005,7 @@ set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth) if (!NILP (Ffboundp (Qminibuffer_inactive_mode))) call0 (Qminibuffer_inactive_mode); else - Fkill_all_local_variables (); + Fkill_all_local_variables (Qnil); } buf = unbind_to (count, buf); } @@ -1545,6 +1545,27 @@ minibuf_conform_representation (Lisp_Object string, Lisp_Object basis) return Fstring_make_multibyte (string); } +static bool +match_regexps (Lisp_Object string, Lisp_Object regexps, + bool ignore_case) +{ + ptrdiff_t val; + for (; CONSP (regexps); regexps = XCDR (regexps)) + { + CHECK_STRING (XCAR (regexps)); + + val = fast_string_match_internal + (XCAR (regexps), string, + (ignore_case ? BVAR (current_buffer, case_canon_table) : Qnil)); + + if (val == -2) + error ("Stack overflow in regexp matcher"); + if (val < 0) + return false; + } + return true; +} + DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0, doc: /* Return common substring of all completions of STRING in COLLECTION. Test each possible completion specified by COLLECTION @@ -1578,6 +1599,7 @@ Additionally to this predicate, `completion-regexp-list' is used to further constrain the set of candidates. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { + Lisp_Object bestmatch, tail, elt, eltstring; /* Size in bytes of BESTMATCH. */ ptrdiff_t bestmatchsize = 0; @@ -1591,7 +1613,6 @@ is used to further constrain the set of candidates. */) ? list_table : function_table)); ptrdiff_t idx = 0, obsize = 0; int matchcount = 0; - ptrdiff_t bindcount = -1; Lisp_Object bucket, zero, end, tem; CHECK_STRING (string); @@ -1670,27 +1691,10 @@ is used to further constrain the set of candidates. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1701,11 +1705,6 @@ is used to further constrain the set of candidates. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } tem = (type == hash_table ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), @@ -1787,9 +1786,6 @@ is used to further constrain the set of candidates. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - if (NILP (bestmatch)) return Qnil; /* No completions found. */ /* If we are ignoring case, and there is no exact match, @@ -1849,7 +1845,6 @@ with a space are ignored unless STRING itself starts with a space. */) : VECTORP (collection) ? 2 : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); ptrdiff_t idx = 0, obsize = 0; - ptrdiff_t bindcount = -1; Lisp_Object bucket, tem, zero; CHECK_STRING (string); @@ -1934,27 +1929,10 @@ with a space are ignored unless STRING itself starts with a space. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1965,11 +1943,6 @@ with a space are ignored unless STRING itself starts with a space. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } tem = type == 3 ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), idx - 1)) @@ -1982,9 +1955,6 @@ with a space are ignored unless STRING itself starts with a space. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - return Fnreverse (allmatches); } @@ -2068,7 +2038,7 @@ If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { - Lisp_Object regexps, tail, tem = Qnil; + Lisp_Object tail, tem = Qnil; ptrdiff_t i = 0; CHECK_STRING (string); @@ -2154,20 +2124,9 @@ the values STRING, PREDICATE and `lambda'. */) return call3 (collection, string, predicate, Qlambda); /* Reject this element if it fails to match all the regexps. */ - if (CONSP (Vcompletion_regexp_list)) - { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil); - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - /* We can test against STRING, because if we got here, then - the element is equivalent to it. */ - if (NILP (Fstring_match (XCAR (regexps), string, Qnil))) - return unbind_to (count, Qnil); - } - unbind_to (count, Qnil); - } + if (!match_regexps (string, Vcompletion_regexp_list, + completion_ignore_case)) + return Qnil; /* Finally, check the predicate. */ if (!NILP (predicate)) diff --git a/src/module-env-28.h b/src/module-env-28.h index f8820b0606b..bea80a5553a 100644 --- a/src/module-env-28.h +++ b/src/module-env-28.h @@ -1,7 +1,3 @@ - /* Add module environment functions newly added in Emacs 28 here. - Before Emacs 28 is released, remove this comment and start - module-env-29.h on the master branch. */ - void (*(*EMACS_ATTRIBUTE_NONNULL (1) get_function_finalizer) (emacs_env *env, emacs_value arg)) (void *) EMACS_NOEXCEPT; diff --git a/src/module-env-29.h b/src/module-env-29.h new file mode 100644 index 00000000000..6ca03773181 --- /dev/null +++ b/src/module-env-29.h @@ -0,0 +1,3 @@ + /* Add module environment functions newly added in Emacs 29 here. + Before Emacs 29 is released, remove this comment and start + module-env-30.h on the master branch. */ diff --git a/src/msdos.c b/src/msdos.c index 5da01c9e7ca..bf058c8aff9 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1794,7 +1794,7 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_fixnum (28); /* RE Emacs version */ + Vwindow_system_version = make_fixnum (29); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM diff --git a/src/nsfns.m b/src/nsfns.m index 797d0ce7820..f4d81722460 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1236,6 +1236,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, "fontBackend", "FontBackend", RES_TYPE_STRING); { +#ifdef NS_IMPL_COCOA /* use for default font name */ id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */ gui_default_parameter (f, parms, Qfontsize, @@ -1250,6 +1251,11 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, build_string (fontname), "font", "Font", RES_TYPE_STRING); xfree (fontname); +#else + gui_default_parameter (f, parms, Qfont, + build_string ("fixed"), + "font", "Font", RES_TYPE_STRING); +#endif } unblock_input (); diff --git a/src/nsfont.m b/src/nsfont.m index 5a9cdfebc01..b3224629f05 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1,4 +1,4 @@ -/* Font back-end driver for the NeXT/Open/GNUstep and macOS window system. +/* Font back-end driver for the GNUstep window system. See font.h Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -38,47 +38,269 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu) #include "termchar.h" #include "pdumper.h" -/* TODO: Drop once we can assume gnustep-gui 0.17.1. */ +#import <Foundation/NSException.h> #import <AppKit/NSFontDescriptor.h> +#import <AppKit/NSLayoutManager.h> +#import <GNUstepGUI/GSLayoutManager.h> +#import <GNUstepGUI/GSFontInfo.h> #define NSFONT_TRACE 0 -#define LCD_SMOOTHING_MARGIN 2 -/* Font glyph and metrics caching functions, implemented at end. */ -static void ns_uni_to_glyphs (struct nsfont_info *font_info, - unsigned char block); -static void ns_glyph_metrics (struct nsfont_info *font_info, - unsigned char block); +/* Structure used by GS `shape' functions for storing layout + information for each glyph. Borrowed from macfont.h. */ +struct ns_glyph_layout +{ + /* Range of indices of the characters composed into the group of + glyphs that share the cursor position with this glyph. The + members `location' and `length' are in UTF-16 indices. */ + NSRange comp_range; -#define INVALID_GLYPH 0xFFFF + /* UTF-16 index in the source string for the first character + associated with this glyph. */ + NSUInteger string_index; -/* ========================================================================== + /* Horizontal and vertical adjustments of glyph position. The + coordinate space is that of Core Text. So, the `baseline_delta' + value is negative if the glyph should be placed below the + baseline. */ + CGFloat advance_delta, baseline_delta; - Utilities + /* Typographical width of the glyph. */ + CGFloat advance; - ========================================================================== */ + /* Glyph ID of the glyph. */ + NSGlyph glyph_id; +}; + + +enum lgstring_direction + { + DIR_R2L = -1, DIR_UNKNOWN = 0, DIR_L2R = 1 + }; + +enum gs_font_slant + { + GS_FONT_SLANT_ITALIC, + GS_FONT_SLANT_REVERSE_ITALIC, + GS_FONT_SLANT_NORMAL + }; + +enum gs_font_weight + { + GS_FONT_WEIGHT_LIGHT, + GS_FONT_WEIGHT_BOLD, + GS_FONT_WEIGHT_NORMAL + }; + +enum gs_font_width + { + GS_FONT_WIDTH_CONDENSED, + GS_FONT_WIDTH_EXPANDED, + GS_FONT_WIDTH_NORMAL + }; + +enum gs_specified + { + GS_SPECIFIED_SLANT = 1, + GS_SPECIFIED_WEIGHT = 1 << 1, + GS_SPECIFIED_WIDTH = 1 << 2, + GS_SPECIFIED_FAMILY = 1 << 3, + GS_SPECIFIED_SPACING = 1 << 4 + }; +struct gs_font_data +{ + int specified; + enum gs_font_slant slant; + enum gs_font_weight weight; + enum gs_font_width width; + bool monospace_p; + char *family_name; +}; -/* Replace spaces w/another character so emacs core font parsing routines - aren't thrown off. */ static void -ns_escape_name (char *name) +ns_done_font_data (struct gs_font_data *data) { - for (; *name; name++) - if (*name == ' ') - *name = '_'; + if (data->specified & GS_SPECIFIED_FAMILY) + xfree (data->family_name); } - -/* Reconstruct spaces in a font family name passed through emacs. */ static void -ns_unescape_name (char *name) +ns_get_font_data (NSFontDescriptor *desc, struct gs_font_data *dat) { - for (; *name; name++) - if (*name == '_') - *name = ' '; + NSNumber *tem; + NSFontSymbolicTraits traits = [desc symbolicTraits]; + NSDictionary *dict = [desc objectForKey: NSFontTraitsAttribute]; + NSString *family = [desc objectForKey: NSFontFamilyAttribute]; + + dat->specified = 0; + + if (family != nil) + { + dat->specified |= GS_SPECIFIED_FAMILY; + dat->family_name = xstrdup ([family cStringUsingEncoding: NSUTF8StringEncoding]); + } + + tem = [desc objectForKey: NSFontFixedAdvanceAttribute]; + + if ((tem != nil && [tem boolValue] != NO) + || (traits & NSFontMonoSpaceTrait)) + { + dat->specified |= GS_SPECIFIED_SPACING; + dat->monospace_p = true; + } + else if (tem != nil && [tem boolValue] == NO) + { + dat->specified |= GS_SPECIFIED_SPACING; + dat->monospace_p = false; + } + + if (traits & NSFontBoldTrait) + { + dat->specified |= GS_SPECIFIED_WEIGHT; + dat->weight = GS_FONT_WEIGHT_BOLD; + } + + if (traits & NSFontItalicTrait) + { + dat->specified |= GS_SPECIFIED_SLANT; + dat->slant = GS_FONT_SLANT_ITALIC; + } + + if (traits & NSFontCondensedTrait) + { + dat->specified |= GS_SPECIFIED_WIDTH; + dat->width = GS_FONT_WIDTH_CONDENSED; + } + else if (traits & NSFontExpandedTrait) + { + dat->specified |= GS_SPECIFIED_WIDTH; + dat->width = GS_FONT_WIDTH_EXPANDED; + } + + if (dict != nil) + { + tem = [dict objectForKey: NSFontSlantTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_SLANT; + + dat->slant = [tem floatValue] > 0 + ? GS_FONT_SLANT_ITALIC + : ([tem floatValue] < 0 + ? GS_FONT_SLANT_REVERSE_ITALIC + : GS_FONT_SLANT_NORMAL); + } + + tem = [dict objectForKey: NSFontWeightTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_WEIGHT; + + dat->weight = [tem floatValue] > 0 + ? GS_FONT_WEIGHT_BOLD + : ([tem floatValue] < -0.4f + ? GS_FONT_WEIGHT_LIGHT + : GS_FONT_WEIGHT_NORMAL); + } + + tem = [dict objectForKey: NSFontWidthTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_WIDTH; + + dat->width = [tem floatValue] > 0 + ? GS_FONT_WIDTH_EXPANDED + : ([tem floatValue] < 0 + ? GS_FONT_WIDTH_NORMAL + : GS_FONT_WIDTH_CONDENSED); + } + } +} + +static bool +ns_font_descs_match_p (NSFontDescriptor *desc, NSFontDescriptor *target) +{ + struct gs_font_data dat; + struct gs_font_data t; + + ns_get_font_data (desc, &dat); + ns_get_font_data (target, &t); + + if (!(t.specified & GS_SPECIFIED_WIDTH)) + t.width = GS_FONT_WIDTH_NORMAL; + if (!(t.specified & GS_SPECIFIED_WEIGHT)) + t.weight = GS_FONT_WEIGHT_NORMAL; + if (!(t.specified & GS_SPECIFIED_SPACING)) + t.monospace_p = false; + if (!(t.specified & GS_SPECIFIED_SLANT)) + t.slant = GS_FONT_SLANT_NORMAL; + + if (!(t.specified & GS_SPECIFIED_FAMILY)) + emacs_abort (); + + bool match_p = true; + + if (dat.specified & GS_SPECIFIED_WIDTH + && dat.width != t.width) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_WEIGHT + && dat.weight != t.weight) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_SPACING + && dat.monospace_p != t.monospace_p) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_SLANT + && dat.monospace_p != t.monospace_p) + { + if (NSFONT_TRACE) + printf ("Matching monospace for %s: %d %d\n", + t.family_name, dat.monospace_p, + t.monospace_p); + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_FAMILY + && strcmp (dat.family_name, t.family_name)) + match_p = false; + + gout: + ns_done_font_data (&dat); + ns_done_font_data (&t); + + return match_p; } +/* Font glyph and metrics caching functions, implemented at end. */ +static void ns_uni_to_glyphs (struct nsfont_info *font_info, + unsigned char block); +static void ns_glyph_metrics (struct nsfont_info *font_info, + unsigned int block); + +#define INVALID_GLYPH 0xFFFF + +/* ========================================================================== + + Utilities + + ========================================================================== */ + /* Extract family name from a font spec. */ static NSString * @@ -91,66 +313,116 @@ ns_get_family (Lisp_Object font_spec) { char *tmp = xlispstrdup (SYMBOL_NAME (tem)); NSString *family; - ns_unescape_name (tmp); family = [NSString stringWithUTF8String: tmp]; xfree (tmp); return family; } } - -/* Return 0 if attr not set, else value (which might also be 0). - On Leopard 0 gets returned even on descriptors where the attribute - was never set, so there's no way to distinguish between unspecified - and set to not have. Callers should assume 0 means unspecified. */ -static float -ns_attribute_fvalue (NSFontDescriptor *fdesc, NSString *trait) -{ - NSDictionary *tdict = [fdesc objectForKey: NSFontTraitsAttribute]; - NSNumber *val = [tdict objectForKey: trait]; - return val == nil ? 0.0F : [val floatValue]; -} - - /* Converts FONT_WEIGHT, FONT_SLANT, FONT_WIDTH, plus family and script/lang to NSFont descriptor. Information under extra only needed for matching. */ -#define STYLE_REF 100 static NSFontDescriptor * ns_spec_to_descriptor (Lisp_Object font_spec) { NSFontDescriptor *fdesc; NSMutableDictionary *fdAttrs = [NSMutableDictionary new]; - NSMutableDictionary *tdict = [NSMutableDictionary new]; NSString *family = ns_get_family (font_spec); - float n; - - /* Add each attr in font_spec to fdAttrs. */ - n = min (FONT_WEIGHT_NUMERIC (font_spec), 200); - if (n != -1 && n != STYLE_REF) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontWeightTrait]; - n = min (FONT_SLANT_NUMERIC (font_spec), 200); - if (n != -1 && n != STYLE_REF) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontSlantTrait]; - n = min (FONT_WIDTH_NUMERIC (font_spec), 200); - if (n > -1 && (n > STYLE_REF + 10 || n < STYLE_REF - 10)) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontWidthTrait]; - if ([tdict count] > 0) - [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; + NSMutableDictionary *tdict = [NSMutableDictionary new]; - fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] - retain] autorelease]; + Lisp_Object tem; + + tem = FONT_SLANT_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qitalic) || EQ (tem, Qoblique)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontSlantTrait]; + else if (EQ (tem, intern ("reverse-italic")) || + EQ (tem, intern ("reverse-oblique"))) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontSlantTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontSlantTrait]; + } + + tem = FONT_WIDTH_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qcondensed)) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWidthTrait]; + else if (EQ (tem, Qexpanded)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWidthTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWidthTrait]; + } + + tem = FONT_WEIGHT_SYMBOLIC (font_spec); + + if (!NILP (tem)) + { + if (EQ (tem, Qbold)) + { + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWeightTrait]; + } + else if (EQ (tem, Qlight)) + { + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWeightTrait]; + } + else + { + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWeightTrait]; + } + } + + tem = AREF (font_spec, FONT_SPACING_INDEX); if (family != nil) { - NSFontDescriptor *fdesc2 = [fdesc fontDescriptorWithFamily: family]; - fdesc = [[fdesc2 retain] autorelease]; + [fdAttrs setObject: family + forKey: NSFontFamilyAttribute]; } - [fdAttrs release]; + if (FIXNUMP (tem)) + { + if (XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL) + { + [fdAttrs setObject: [NSNumber numberWithBool:YES] + forKey: NSFontFixedAdvanceAttribute]; + } + else + { + [fdAttrs setObject: [NSNumber numberWithBool:NO] + forKey: NSFontFixedAdvanceAttribute]; + } + } + + /* Handle special families such as ``fixed'' or ``Sans Serif''. */ + + if ([family isEqualToString: @"fixed"]) + { + [fdAttrs setObject: [[NSFont userFixedPitchFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; + } + else if ([family isEqualToString: @"Sans Serif"]) + { + [fdAttrs setObject: [[NSFont userFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; + } + + [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; + + fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] + retain] autorelease]; + [tdict release]; + [fdAttrs release]; return fdesc; } @@ -161,61 +433,64 @@ ns_descriptor_to_entity (NSFontDescriptor *desc, Lisp_Object extra, const char *style) { - Lisp_Object font_entity = font_make_entity (); - /* NSString *psName = [desc postscriptName]; */ - NSString *family = [desc objectForKey: NSFontFamilyAttribute]; - unsigned int traits = [desc symbolicTraits]; - char *escapedFamily; - - /* Shouldn't happen, but on Tiger fallback desc gets name but no family. */ - if (family == nil) - family = [desc objectForKey: NSFontNameAttribute]; - if (family == nil) - family = [[NSFont userFixedPitchFontOfSize: 0] familyName]; - - escapedFamily = xstrdup ([family UTF8String]); - ns_escape_name (escapedFamily); - - ASET (font_entity, FONT_TYPE_INDEX, Qns); - ASET (font_entity, FONT_FOUNDRY_INDEX, Qapple); - ASET (font_entity, FONT_FAMILY_INDEX, intern (escapedFamily)); - ASET (font_entity, FONT_ADSTYLE_INDEX, style ? intern (style) : Qnil); - ASET (font_entity, FONT_REGISTRY_INDEX, Qiso10646_1); - - FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, - traits & NSFontBoldTrait ? Qbold : Qmedium); -/* FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontWeightTrait)));*/ - FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, - traits & NSFontItalicTrait ? Qitalic : Qnormal); -/* FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontSlantTrait)));*/ - FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - traits & NSFontCondensedTrait ? Qcondensed : - traits & NSFontExpandedTrait ? Qexpanded : Qnormal); -/* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontWidthTrait)));*/ - - ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0)); - ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); - ASET (font_entity, FONT_SPACING_INDEX, - make_fixnum([desc symbolicTraits] & NSFontMonoSpaceTrait - ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); - - ASET (font_entity, FONT_EXTRA_INDEX, extra); - ASET (font_entity, FONT_OBJLIST_INDEX, Qnil); + Lisp_Object font_entity = font_make_entity (); + struct gs_font_data data; + ns_get_font_data (desc, &data); + + ASET (font_entity, FONT_TYPE_INDEX, Qns); + ASET (font_entity, FONT_FOUNDRY_INDEX, Qns); + if (data.specified & GS_SPECIFIED_FAMILY) + ASET (font_entity, FONT_FAMILY_INDEX, intern (data.family_name)); + ASET (font_entity, FONT_ADSTYLE_INDEX, style ? intern (style) : Qnil); + ASET (font_entity, FONT_REGISTRY_INDEX, Qiso10646_1); + + if (data.specified & GS_SPECIFIED_WEIGHT) + { + FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, + data.weight == GS_FONT_WEIGHT_BOLD + ? Qbold : (data.weight == GS_FONT_WEIGHT_LIGHT + ? Qlight : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, Qnormal); - if (NSFONT_TRACE) - { - fputs ("created font_entity:\n ", stderr); - debug_print (font_entity); - } + if (data.specified & GS_SPECIFIED_SLANT) + { + FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, + data.slant == GS_FONT_SLANT_ITALIC + ? Qitalic : (data.slant == GS_FONT_SLANT_REVERSE_ITALIC + ? intern ("reverse-italic") : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, Qnormal); + + if (data.specified & GS_SPECIFIED_WIDTH) + { + FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, + data.width == GS_FONT_WIDTH_CONDENSED + ? Qcondensed : (data.width == GS_FONT_WIDTH_EXPANDED + ? intern ("expanded") : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, Qnormal); - xfree (escapedFamily); - return font_entity; + ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); + ASET (font_entity, FONT_SPACING_INDEX, + make_fixnum ((data.specified & GS_SPECIFIED_WIDTH && data.monospace_p) + ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); + + ASET (font_entity, FONT_EXTRA_INDEX, extra); + ASET (font_entity, FONT_OBJLIST_INDEX, Qnil); + + if (NSFONT_TRACE) + { + fputs ("created font_entity:\n ", stderr); + debug_print (font_entity); + } + + ns_done_font_data (&data); + return font_entity; } @@ -223,8 +498,7 @@ ns_descriptor_to_entity (NSFontDescriptor *desc, static Lisp_Object ns_fallback_entity (void) { - return ns_descriptor_to_entity ([[NSFont userFixedPitchFontOfSize: 0] - fontDescriptor], Qnil, NULL); + return ns_descriptor_to_entity ([[NSFont userFixedPitchFontOfSize: 1] fontDescriptor], Qnil, NULL); } @@ -510,21 +784,20 @@ static NSSet return families; } +/* GNUstep font matching is very mediocre (it can't even compare + symbolic styles correctly), which is why our own font matching + mechanism must be implemented. */ -/* Implementation for list() and match(). List() can return nil, match() -must return something. Strategy is to drop family name from attribute -matching set for match. */ +/* Implementation for list and match. */ static Lisp_Object ns_findfonts (Lisp_Object font_spec, BOOL isMatch) { Lisp_Object tem, list = Qnil; - NSFontDescriptor *fdesc, *desc; - NSMutableSet *fkeys; - NSArray *matchingDescs; - NSEnumerator *dEnum; - NSString *family; + NSFontDescriptor *fdesc; + NSArray *all_descs; + GSFontEnumerator *enumerator = [GSFontEnumerator sharedEnumerator]; + NSSet *cFamilies; - BOOL foundItal = NO; block_input (); if (NSFONT_TRACE) @@ -537,43 +810,22 @@ ns_findfonts (Lisp_Object font_spec, BOOL isMatch) cFamilies = ns_get_covering_families (ns_get_req_script (font_spec), 0.90); fdesc = ns_spec_to_descriptor (font_spec); - fkeys = [NSMutableSet setWithArray: [[fdesc fontAttributes] allKeys]]; - if (isMatch) - [fkeys removeObject: NSFontFamilyAttribute]; - - matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys]; + all_descs = [enumerator availableFontDescriptors]; - if (NSFONT_TRACE) - NSLog(@"Got desc %@ and found %lu matching fonts from it: ", fdesc, - (unsigned long)[matchingDescs count]); - - for (dEnum = [matchingDescs objectEnumerator]; (desc = [dEnum nextObject]);) + for (NSFontDescriptor *desc in all_descs) { if (![cFamilies containsObject: [desc objectForKey: NSFontFamilyAttribute]]) continue; + if (!ns_font_descs_match_p (fdesc, desc)) + continue; + tem = ns_descriptor_to_entity (desc, - AREF (font_spec, FONT_EXTRA_INDEX), + AREF (font_spec, FONT_EXTRA_INDEX), NULL); if (isMatch) return tem; list = Fcons (tem, list); - if (fabs (ns_attribute_fvalue (desc, NSFontSlantTrait)) > 0.05) - foundItal = YES; - } - - /* Add synthItal member if needed. */ - family = [fdesc objectForKey: NSFontFamilyAttribute]; - if (family != nil && !foundItal && !NILP (list)) - { - NSFontDescriptor *s1 = [NSFontDescriptor new]; - NSFontDescriptor *sDesc - = [[s1 fontDescriptorWithSymbolicTraits: NSFontItalicTrait] - fontDescriptorWithFamily: family]; - list = Fcons (ns_descriptor_to_entity (sDesc, - AREF (font_spec, FONT_EXTRA_INDEX), - "synthItal"), list); - [s1 release]; } unblock_input (); @@ -652,7 +904,6 @@ nsfont_list_family (struct frame *f) objectEnumerator]; while ((family = [families nextObject])) list = Fcons (intern ([family UTF8String]), list); - /* FIXME: escape the name? */ if (NSFONT_TRACE) fprintf (stderr, "nsfont: list families returning %"pD"d entries\n", @@ -668,18 +919,15 @@ nsfont_list_family (struct frame *f) static Lisp_Object nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) { - BOOL synthItal; - unsigned int traits = 0; struct nsfont_info *font_info; struct font *font; NSFontDescriptor *fontDesc = ns_spec_to_descriptor (font_entity); NSFontManager *fontMgr = [NSFontManager sharedFontManager]; NSString *family; NSFont *nsfont, *sfont; - Lisp_Object tem; NSRect brect; Lisp_Object font_object; - int fixLeopardBug; + Lisp_Object tem; block_input (); @@ -692,42 +940,20 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) if (pixel_size <= 0) { /* try to get it out of frame params */ - Lisp_Object tem = get_frame_param (f, Qfontsize); - pixel_size = NILP (tem) ? 0 : XFIXNAT (tem); + tem = get_frame_param (f, Qfontsize); + pixel_size = NILP (tem) ? 0 : XFIXNAT (tem); } tem = AREF (font_entity, FONT_ADSTYLE_INDEX); - synthItal = !NILP (tem) && !strncmp ("synthItal", SSDATA (SYMBOL_NAME (tem)), - 9); family = ns_get_family (font_entity); if (family == nil) family = [[NSFont userFixedPitchFontOfSize: 0] familyName]; - /* Should be > 0.23 as some font descriptors (e.g. Terminus) set to that - when setting family in ns_spec_to_descriptor(). */ - if (ns_attribute_fvalue (fontDesc, NSFontWeightTrait) > 0.50F) - traits |= NSBoldFontMask; - if (ns_attribute_fvalue (fontDesc, NSFontSlantTrait) > 0.05F) - traits |= NSItalicFontMask; - - /* see https://web.archive.org/web/20100201175731/http://cocoadev.com/forums/comments.php?DiscussionID=74 */ - fixLeopardBug = traits & NSBoldFontMask ? 10 : 5; - nsfont = [fontMgr fontWithFamily: family - traits: traits weight: fixLeopardBug - size: pixel_size]; - /* if didn't find, try synthetic italic */ - if (nsfont == nil && synthItal) - { - nsfont = [fontMgr fontWithFamily: family - traits: traits & ~NSItalicFontMask - weight: fixLeopardBug size: pixel_size]; - } + + nsfont = [NSFont fontWithDescriptor: fontDesc + size: pixel_size]; if (nsfont == nil) - { - message_with_string ("*** Warning: font in family `%s' not found", - build_string ([family UTF8String]), 1); - nsfont = [NSFont userFixedPitchFontOfSize: pixel_size]; - } + nsfont = [NSFont userFixedPitchFontOfSize: pixel_size]; if (NSFONT_TRACE) NSLog (@"%@\n", nsfont); @@ -740,7 +966,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) if (!font) { unblock_input (); - return Qnil; /* FIXME: other terms do, but returning Qnil causes segfault. */ + return Qnil; } font_info->glyphs = xzalloc (0x100 * sizeof *font_info->glyphs); @@ -781,7 +1007,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) font_info->name = xstrdup (fontName); font_info->bold = [fontMgr traitsOfFont: nsfont] & NSBoldFontMask; font_info->ital = - synthItal || ([fontMgr traitsOfFont: nsfont] & NSItalicFontMask); + ([fontMgr traitsOfFont: nsfont] & NSItalicFontMask); /* Metrics etc.; some fonts return an unusually large max advance, so we only use it for fonts that have wide characters. */ @@ -808,8 +1034,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) lrint (brect.size.width - (CGFloat) font_info->width); /* set up metrics portion of font struct */ - font->ascent = lrint([sfont ascender]); - font->descent = -lrint(floor(adjusted_descender)); font->space_width = lrint (ns_char_width (sfont, ' ')); font->max_width = lrint (font_info->max_bounds.width); font->min_width = font->space_width; /* Approximate. */ @@ -871,7 +1095,7 @@ nsfont_encode_char (struct font *font, int c) { struct nsfont_info *font_info = (struct nsfont_info *)font; unsigned char high = (c & 0xff00) >> 8, low = c & 0x00ff; - unsigned short g; + unsigned int g; if (c > 0xFFFF) return FONT_INVALID_CODE; @@ -934,51 +1158,23 @@ nsfont_text_extents (struct font *font, const unsigned int *code, static int nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, bool with_background) -/* NOTE: focus and clip must be set. */ { - static unsigned char cbuf[1024]; - unsigned char *c = cbuf; -#if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION > 22 - static CGFloat advances[1024]; - CGFloat *adv = advances; -#else - static float advances[1024]; - float *adv = advances; -#endif + NSGlyph *c = alloca ((to - from) * sizeof *c); + struct face *face; NSRect r; struct nsfont_info *font; - NSColor *col, *bgCol; - unsigned *t = s->char2b; - int i, len, flags; + NSColor *col; + int len = to - from; char isComposite = s->first_glyph->type == COMPOSITE_GLYPH; block_input (); - font = (struct nsfont_info *)s->face->font; + font = (struct nsfont_info *) s->font; if (font == NULL) font = (struct nsfont_info *)FRAME_FONT (s->f); - /* Select face based on input flags. */ - flags = s->hl == DRAW_CURSOR ? NS_DUMPGLYPH_CURSOR : - (s->hl == DRAW_MOUSE_FACE ? NS_DUMPGLYPH_MOUSEFACE : - (s->for_overlaps ? NS_DUMPGLYPH_FOREGROUND : - NS_DUMPGLYPH_NORMAL)); - - switch (flags) - { - case NS_DUMPGLYPH_CURSOR: - face = s->face; - break; - case NS_DUMPGLYPH_MOUSEFACE: - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - break; - default: - face = s->face; - } + face = s->face; r.origin.x = s->x; if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) @@ -987,91 +1183,24 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, r.origin.y = s->y; r.size.height = FONT_HEIGHT (font); - /* Convert UTF-16 (?) to UTF-8 and determine advances. Note if we just ask - NS to render the string, it will come out differently from the individual - character widths added up because of layout processing. */ - { - int cwidth, twidth = 0; - int hi, lo; - /* FIXME: composition: no vertical displacement is considered. */ - t += from; /* advance into composition */ - for (i = from; i < to; i++, t++) - { - hi = (*t & 0xFF00) >> 8; - lo = *t & 0x00FF; - if (isComposite) - { - if (!s->first_glyph->u.cmp.automatic) - cwidth = s->cmp->offsets[i * 2] /* (H offset) */ - twidth; - else - { - Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); - Lisp_Object glyph = LGSTRING_GLYPH (gstring, i); - if (NILP (LGLYPH_ADJUSTMENT (glyph))) - cwidth = LGLYPH_WIDTH (glyph); - else - { - cwidth = LGLYPH_WADJUST (glyph); - *(adv-1) += LGLYPH_XOFF (glyph); - } - } - } - else - { - if (!font->metrics[hi]) /* FIXME: why/how can we need this now? */ - ns_glyph_metrics (font, hi); - cwidth = font->metrics[hi][lo].width; - } - twidth += cwidth; - *adv++ = cwidth; - c += CHAR_STRING (*t, c); /* This converts the char to UTF-8. */ - } - len = adv - advances; - r.size.width = twidth; - *c = 0; - } + for (int i = from; i < to; ++i) + c[i] = s->char2b[i]; /* Fill background if requested. */ if (with_background && !isComposite) { - NSRect br = r; - int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f); - int mbox_line_width = max (s->face->box_vertical_line_width, 0); - - if (s->row->full_width_p) - { - if (br.origin.x <= fibw + 1 + mbox_line_width) - { - br.size.width += br.origin.x - mbox_line_width; - br.origin.x = mbox_line_width; - } - if (FRAME_PIXEL_WIDTH (s->f) - (br.origin.x + br.size.width) - <= fibw+1) - br.size.width += fibw; - } - if (s->face->box == FACE_NO_BOX) - { - /* Expand unboxed top row over internal border. */ - if (br.origin.y <= fibw + 1 + mbox_line_width) - { - br.size.height += br.origin.y; - br.origin.y = 0; - } - } - else - { - int correction = abs (s->face->box_horizontal_line_width)+1; - br.origin.y += correction; - br.size.height -= 2*correction; - correction = abs (s->face->box_vertical_line_width)+1; - br.origin.x += correction; - br.size.width -= 2*correction; - } + NSRect br = NSMakeRect (x, y - FONT_BASE (s->font), + s->width, FONT_HEIGHT (s->font)); if (!s->face->stipple) - [(NS_FACE_BACKGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) - : FRAME_BACKGROUND_COLOR (s->f)) set]; + { + if (s->hl != DRAW_CURSOR) + [(NS_FACE_BACKGROUND (face) != 0 + ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) + : FRAME_BACKGROUND_COLOR (s->f)) set]; + else + [FRAME_CURSOR_COLOR (s->f) set]; + } else { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); @@ -1080,43 +1209,32 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, NSRectFill (br); } - /* set up for character rendering */ r.origin.y = y; - col = (NS_FACE_FOREGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - - bgCol = (flags != NS_DUMPGLYPH_FOREGROUND ? nil - : (NS_FACE_BACKGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) - : FRAME_BACKGROUND_COLOR (s->f))); + if (s->hl == DRAW_CURSOR) + col = FRAME_BACKGROUND_COLOR (s->f); + else + col = (NS_FACE_FOREGROUND (face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f) + : FRAME_FOREGROUND_COLOR (s->f)); /* render under GNUstep using DPS */ { - NSGraphicsContext *context = GSCurrentContext (); - + NSGraphicsContext *context = [NSGraphicsContext currentContext]; DPSgsave (context); - [font->nsfont set]; - - /* do erase if "foreground" mode */ - if (bgCol != nil) + if (s->clip_head) { - [bgCol set]; - DPSmoveto (context, r.origin.x, r.origin.y); -/*[context GSSetTextDrawingMode: GSTextFillStroke]; /// not implemented yet */ - DPSxshow (context, (const char *) cbuf, advances, len); - DPSstroke (context); - [col set]; -/*[context GSSetTextDrawingMode: GSTextFill]; /// not implemented yet */ + DPSrectclip (context, s->clip_head->x, 0, + FRAME_PIXEL_WIDTH (s->f), + FRAME_PIXEL_HEIGHT (s->f)); } + [font->nsfont set]; [col set]; - /* draw with DPSxshow () */ DPSmoveto (context, r.origin.x, r.origin.y); - DPSxshow (context, (const char *) cbuf, advances, len); + GSShowGlyphs (context, c, len); DPSstroke (context); DPSgrestore (context); @@ -1126,6 +1244,360 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, return to-from; } +static NSUInteger +ns_font_shape (NSFont *font, NSString *string, + struct ns_glyph_layout *glyph_layouts, NSUInteger glyph_len, + enum lgstring_direction dir) +{ + NSUInteger i; + NSUInteger result = 0; + NSTextStorage *textStorage; + NSLayoutManager *layoutManager; + NSTextContainer *textContainer; + NSUInteger stringLength; + NSPoint spaceLocation; + /* numberOfGlyphs can't actually be 0, but this pacifies GCC */ + NSUInteger used, numberOfGlyphs = 0; + + textStorage = [[NSTextStorage alloc] initWithString:string]; + layoutManager = [[NSLayoutManager alloc] init]; + textContainer = [[NSTextContainer alloc] init]; + + /* Append a trailing space to measure baseline position. */ + [textStorage appendAttributedString:([[[NSAttributedString alloc] + initWithString:@" "] autorelease])]; + [textStorage setFont:font]; + [textContainer setLineFragmentPadding:0]; + + [layoutManager addTextContainer:textContainer]; + [textContainer release]; + [textStorage addLayoutManager:layoutManager]; + [layoutManager release]; + + if (!(textStorage && layoutManager && textContainer)) + emacs_abort (); + + stringLength = [string length]; + + /* Force layout. */ + (void) [layoutManager glyphRangeForTextContainer:textContainer]; + + spaceLocation = [layoutManager locationForGlyphAtIndex:stringLength]; + + /* Remove the appended trailing space because otherwise it may + generate a wrong result for a right-to-left text. */ + [textStorage beginEditing]; + [textStorage deleteCharactersInRange:(NSMakeRange (stringLength, 1))]; + [textStorage endEditing]; + (void) [layoutManager glyphRangeForTextContainer:textContainer]; + + i = 0; + while (i < stringLength) + { + NSRange range; + NSFont *fontInTextStorage = + [textStorage attribute: NSFontAttributeName + atIndex:i + longestEffectiveRange: &range + inRange: NSMakeRange (0, stringLength)]; + + if (!(fontInTextStorage == font + || [[fontInTextStorage fontName] isEqualToString:[font fontName]])) + break; + i = NSMaxRange (range); + } + if (i < stringLength) + /* Make the test `used <= glyph_len' below fail if textStorage + contained some fonts other than the specified one. */ + used = glyph_len + 1; + else + { + NSRange range = NSMakeRange (0, stringLength); + + range = [layoutManager glyphRangeForCharacterRange:range + actualCharacterRange:NULL]; + numberOfGlyphs = NSMaxRange (range); + used = numberOfGlyphs; + for (i = 0; i < numberOfGlyphs; i++) + if ([layoutManager notShownAttributeForGlyphAtIndex:i]) + used--; + } + + if (0 < used && used <= glyph_len) + { + NSUInteger glyphIndex, prevGlyphIndex; + NSUInteger *permutation; + NSRange compRange, range; + CGFloat totalAdvance; + + glyphIndex = 0; + while ([layoutManager notShownAttributeForGlyphAtIndex:glyphIndex]) + glyphIndex++; + + permutation = NULL; +#define RIGHT_TO_LEFT_P permutation + + /* Fill the `comp_range' member of struct mac_glyph_layout, and + setup a permutation for right-to-left text. */ + compRange = NSMakeRange (0, 0); + for (range = NSMakeRange (0, 0); NSMaxRange (range) < used; + range.length++) + { + struct ns_glyph_layout *gl = glyph_layouts + NSMaxRange (range); + NSUInteger characterIndex = + [layoutManager characterIndexForGlyphAtIndex:glyphIndex]; + + gl->string_index = characterIndex; + + if (characterIndex >= NSMaxRange (compRange)) + { + compRange.location = NSMaxRange (compRange); + do + { + NSRange characterRange = + [string + rangeOfComposedCharacterSequenceAtIndex:characterIndex]; + + compRange.length = + NSMaxRange (characterRange) - compRange.location; + [layoutManager glyphRangeForCharacterRange:compRange + actualCharacterRange:&characterRange]; + characterIndex = NSMaxRange (characterRange) - 1; + } + while (characterIndex >= NSMaxRange (compRange)); + + if (RIGHT_TO_LEFT_P) + for (i = 0; i < range.length; i++) + permutation[range.location + i] = NSMaxRange (range) - i - 1; + + range = NSMakeRange (NSMaxRange (range), 0); + } + + gl->comp_range.location = compRange.location; + gl->comp_range.length = compRange.length; + + while (++glyphIndex < numberOfGlyphs) + if (![layoutManager notShownAttributeForGlyphAtIndex:glyphIndex]) + break; + } + if (RIGHT_TO_LEFT_P) + for (i = 0; i < range.length; i++) + permutation[range.location + i] = NSMaxRange (range) - i - 1; + + /* Then fill the remaining members. */ + glyphIndex = prevGlyphIndex = 0; + while ([layoutManager notShownAttributeForGlyphAtIndex:glyphIndex]) + glyphIndex++; + + if (!RIGHT_TO_LEFT_P) + totalAdvance = 0; + else + { + NSUInteger nrects; + NSRect *glyphRects = + [layoutManager + rectArrayForGlyphRange:(NSMakeRange (0, numberOfGlyphs)) + withinSelectedGlyphRange:(NSMakeRange (NSNotFound, 0)) + inTextContainer:textContainer rectCount:&nrects]; + + totalAdvance = NSMaxX (glyphRects[0]); + } + + for (i = 0; i < used; i++) + { + struct ns_glyph_layout *gl; + NSPoint location; + NSUInteger nextGlyphIndex; + NSRange glyphRange; + NSRect *glyphRects; + NSUInteger nrects; + + if (!RIGHT_TO_LEFT_P) + gl = glyph_layouts + i; + else + { + NSUInteger dest = permutation[i]; + + gl = glyph_layouts + dest; + if (i < dest) + { + NSUInteger tmp = gl->string_index; + + gl->string_index = glyph_layouts[i].string_index; + glyph_layouts[i].string_index = tmp; + } + } + gl->glyph_id = [layoutManager glyphAtIndex: glyphIndex]; + + location = [layoutManager locationForGlyphAtIndex:glyphIndex]; + gl->baseline_delta = spaceLocation.y - location.y; + + for (nextGlyphIndex = glyphIndex + 1; nextGlyphIndex < numberOfGlyphs; + nextGlyphIndex++) + if (![layoutManager + notShownAttributeForGlyphAtIndex:nextGlyphIndex]) + break; + + if (!RIGHT_TO_LEFT_P) + { + CGFloat maxX; + + if (prevGlyphIndex == 0) + glyphRange = NSMakeRange (0, nextGlyphIndex); + else + glyphRange = NSMakeRange (glyphIndex, + nextGlyphIndex - glyphIndex); + glyphRects = + [layoutManager + rectArrayForGlyphRange:glyphRange + withinSelectedGlyphRange:(NSMakeRange (NSNotFound, 0)) + inTextContainer:textContainer rectCount:&nrects]; + maxX = max (NSMaxX (glyphRects[0]), totalAdvance); + gl->advance_delta = location.x - totalAdvance; + gl->advance = maxX - totalAdvance; + totalAdvance = maxX; + } + else + { + CGFloat minX; + + if (nextGlyphIndex == numberOfGlyphs) + glyphRange = NSMakeRange (prevGlyphIndex, + numberOfGlyphs - prevGlyphIndex); + else + glyphRange = NSMakeRange (prevGlyphIndex, + glyphIndex + 1 - prevGlyphIndex); + glyphRects = + [layoutManager + rectArrayForGlyphRange:glyphRange + withinSelectedGlyphRange:(NSMakeRange (NSNotFound, 0)) + inTextContainer:textContainer rectCount:&nrects]; + minX = min (NSMinX (glyphRects[0]), totalAdvance); + gl->advance = totalAdvance - minX; + totalAdvance = minX; + gl->advance_delta = location.x - totalAdvance; + } + + prevGlyphIndex = glyphIndex + 1; + glyphIndex = nextGlyphIndex; + } + + if (RIGHT_TO_LEFT_P) + xfree (permutation); + +#undef RIGHT_TO_LEFT_P + + result = used; + } + [textStorage release]; + + return result; +} + +static Lisp_Object +nsfont_shape (Lisp_Object lgstring, Lisp_Object direction) +{ + struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring)); + struct nsfont_info *font_info = (struct nsfont_info *) font; + struct ns_glyph_layout *glyph_layouts; + NSFont *nsfont = font_info->nsfont; + ptrdiff_t glyph_len, len, i; + Lisp_Object tem; + unichar *mb_buf; + NSUInteger used; + + glyph_len = LGSTRING_GLYPH_LEN (lgstring); + for (i = 0; i < glyph_len; ++i) + { + tem = LGSTRING_GLYPH (lgstring, i); + + if (NILP (tem)) + break; + } + + len = i; + + if (INT_MAX / 2 < len) + memory_full (SIZE_MAX); + + block_input (); + + mb_buf = alloca (len * sizeof *mb_buf); + + for (i = 0; i < len; ++i) + { + uint32_t c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i)); + mb_buf[i] = (unichar) c; + } + + NSString *string = [NSString stringWithCharacters: mb_buf + length: len]; + unblock_input (); + + if (!string) + return Qnil; + + block_input (); + + enum lgstring_direction dir = DIR_UNKNOWN; + + if (EQ (direction, QL2R)) + dir = DIR_L2R; + else if (EQ (direction, QR2L)) + dir = DIR_R2L; + glyph_layouts = alloca (sizeof (struct ns_glyph_layout) * glyph_len); + used = ns_font_shape (nsfont, string, glyph_layouts, glyph_len, dir); + + for (i = 0; i < used; i++) + { + Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, i); + struct ns_glyph_layout *gl = glyph_layouts + i; + EMACS_INT from, to; + struct font_metrics metrics; + + if (NILP (lglyph)) + { + lglyph = LGLYPH_NEW (); + LGSTRING_SET_GLYPH (lgstring, i, lglyph); + } + + from = gl->comp_range.location; + LGLYPH_SET_FROM (lglyph, from); + + to = gl->comp_range.location + gl->comp_range.length; + LGLYPH_SET_TO (lglyph, to - 1); + + /* LGLYPH_CHAR is used in `describe-char' for checking whether + the composition is trivial. */ + { + UTF32Char c; + + if (mb_buf[gl->string_index] >= 0xD800 + && mb_buf[gl->string_index] < 0xDC00) + c = (((mb_buf[gl->string_index] - 0xD800) << 10) + + (mb_buf[gl->string_index + 1] - 0xDC00) + 0x10000); + else + c = mb_buf[gl->string_index]; + + LGLYPH_SET_CHAR (lglyph, c); + } + + { + unsigned long cc = gl->glyph_id; + LGLYPH_SET_CODE (lglyph, cc); + } + + nsfont_text_extents (font, &gl->glyph_id, 1, &metrics); + LGLYPH_SET_WIDTH (lglyph, metrics.width); + LGLYPH_SET_LBEARING (lglyph, metrics.lbearing); + LGLYPH_SET_RBEARING (lglyph, metrics.rbearing); + LGLYPH_SET_ASCENT (lglyph, metrics.ascent); + LGLYPH_SET_DESCENT (lglyph, metrics.descent); + } + unblock_input (); + + return make_fixnum (used); +} /* ========================================================================== @@ -1134,6 +1606,50 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, ========================================================================== */ +static NSGlyph +ns_uni_to_glyphs_1 (struct nsfont_info *info, unsigned int c) +{ + unichar characters[] = { c }; + NSString *string = + [NSString stringWithCharacters: characters + length: 1]; + NSDictionary *attributes = + [NSDictionary dictionaryWithObjectsAndKeys: + info->nsfont, NSFontAttributeName, nil]; + NSTextStorage *storage = [[NSTextStorage alloc] initWithString: string + attributes: attributes]; + NSTextContainer *text_container = [[NSTextContainer alloc] init]; + NSLayoutManager *manager = [[NSLayoutManager alloc] init]; + + [manager addTextContainer: text_container]; + [text_container release]; /* Retained by manager */ + [storage addLayoutManager: manager]; + [manager release]; /* Retained by storage */ + + NSFont *font_in_storage = [storage attribute: NSFontAttributeName + atIndex:0 + effectiveRange: NULL]; + NSGlyph glyph = FONT_INVALID_CODE; + + if ((font_in_storage == info->nsfont + || [[font_in_storage fontName] isEqualToString: [info->nsfont fontName]])) + { + @try + { + glyph = [manager glyphAtIndex: 0]; + } + @catch (NSException *e) + { + /* GNUstep bug? */ + glyph = 'X'; + } + } + + [storage release]; + + return glyph; +} + /* Find and cache corresponding glyph codes for unicode values in given hi-byte block of 256. */ static void @@ -1141,7 +1657,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) { unichar *unichars = xmalloc (0x101 * sizeof (unichar)); unsigned int i, g, idx; - unsigned short *glyphs; + unsigned int *glyphs; if (NSFONT_TRACE) fprintf (stderr, "%p\tFinding glyphs for glyphs in block %d\n", @@ -1149,7 +1665,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) block_input (); - font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned short)); + font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned int)); if (!unichars || !(font_info->glyphs[block])) emacs_abort (); @@ -1166,7 +1682,8 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) for (i = 0; i < 0x100; i++, glyphs++) { g = unichars[i]; - *glyphs = g; + NSGlyph glyph = ns_uni_to_glyphs_1 (font_info, g); + *glyphs = glyph; } } @@ -1175,18 +1692,19 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) } -/* Determine and cache metrics for corresponding glyph codes in given - hi-byte block of 256. */ +/* Determine and cache metrics for glyphs in given hi-byte block of + 256. */ static void -ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) +ns_glyph_metrics (struct nsfont_info *font_info, unsigned int block) { - unsigned int i, g; + unsigned int i; + NSGlyph g; unsigned int numGlyphs = [font_info->nsfont numberOfGlyphs]; NSFont *sfont; struct font_metrics *metrics; if (NSFONT_TRACE) - fprintf (stderr, "%p\tComputing metrics for glyphs in block %d\n", + fprintf (stderr, "%p\tComputing metrics for glyphs in block %u\n", font_info, block); /* not implemented yet (as of startup 0.18), so punt */ @@ -1209,19 +1727,14 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) w = max ([sfont advancementForGlyph: g].width, 2.0); metrics->width = lrint (w); - lb = r.origin.x; - rb = r.size.width - w; - // Add to bearing for LCD smoothing. We don't know if it is there. - if (lb < 0) - metrics->lbearing = round (lb - LCD_SMOOTHING_MARGIN); - if (font_info->ital) - rb += (CGFloat) (0.22F * font_info->height); - metrics->rbearing = lrint (w + rb + LCD_SMOOTHING_MARGIN); - - metrics->descent = r.origin.y < 0 ? -r.origin.y : 0; - /* lrint (hshrink * [sfont ascender] + expand * hd/2); */ - metrics->ascent = r.size.height - metrics->descent; - /* -lrint (hshrink* [sfont descender] - expand * hd/2); */ + lb = NSMinX (r); + rb = NSMaxX (r); + + metrics->rbearing = lrint (rb); + metrics->lbearing = lrint (lb); + + metrics->descent = NSMinY (r); + metrics->ascent = NSMaxY (r); } unblock_input (); } @@ -1257,6 +1770,7 @@ struct font_driver const nsfont_driver = .has_char = nsfont_has_char, .encode_char = nsfont_encode_char, .text_extents = nsfont_text_extents, + .shape = nsfont_shape, .draw = nsfont_draw, }; @@ -1265,7 +1779,6 @@ syms_of_nsfont (void) { DEFSYM (Qcondensed, "condensed"); DEFSYM (Qexpanded, "expanded"); - DEFSYM (Qapple, "apple"); DEFSYM (Qmedium, "medium"); DEFVAR_LISP ("ns-reg-to-script", Vns_reg_to_script, doc: /* Internal use: maps font registry to Unicode script. */); diff --git a/src/nsmenu.m b/src/nsmenu.m index 9b78643d56a..29201e69079 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -101,6 +101,15 @@ popup_activated (void) static void ns_update_menubar (struct frame *f, bool deep_p) { +#ifdef NS_IMPL_GNUSTEP + static int inside = 0; + + if (inside) + return; + + inside++; +#endif + BOOL needsSet = NO; id menu = [NSApp mainMenu]; bool owfi; @@ -120,7 +129,12 @@ ns_update_menubar (struct frame *f, bool deep_p) NSTRACE ("ns_update_menubar"); if (f != SELECTED_FRAME () || FRAME_EXTERNAL_MENU_BAR (f) == 0) + { +#ifdef NS_IMPL_GNUSTEP + inside--; +#endif return; + } XSETFRAME (Vmenu_updating_frame, f); /*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */ @@ -144,10 +158,6 @@ ns_update_menubar (struct frame *f, bool deep_p) t = -(1000*tb.time+tb.millitm); #endif -#ifdef NS_IMPL_GNUSTEP - deep_p = 1; /* See comment in menuNeedsUpdate. */ -#endif - if (deep_p) { /* Make a widget-value tree representing the entire menu trees. */ @@ -275,6 +285,9 @@ ns_update_menubar (struct frame *f, bool deep_p) free_menubar_widget_value_tree (first_wv); discard_menu_items (); unbind_to (specpdl_count, Qnil); +#ifdef NS_IMPL_GNUSTEP + inside--; +#endif return; } @@ -408,6 +421,10 @@ ns_update_menubar (struct frame *f, bool deep_p) if (needsSet) [NSApp setMainMenu: menu]; +#ifdef NS_IMPL_GNUSTEP + inside--; +#endif + unblock_input (); } @@ -452,17 +469,34 @@ set_frame_menubar (struct frame *f, bool deep_p) call to ns_update_menubar. */ - (void)menuNeedsUpdate: (NSMenu *)menu { +#ifdef NS_IMPL_GNUSTEP + static int inside = 0; +#endif + if (!FRAME_LIVE_P (SELECTED_FRAME ())) return; -#ifdef NS_IMPL_COCOA -/* TODO: GNUstep calls this method when the menu is still being built - which results in a recursive stack overflow. One possible solution - is to use menuWillOpen instead, but the Apple docs explicitly warn - against changing the contents of the menu in it. I don't know what - the right thing to do for GNUstep is. */ +#ifdef NS_IMPL_GNUSTEP + /* GNUstep calls this method when the menu is still being built + which results in a recursive stack overflow, which this variable + prevents. */ + + if (!inside) + ++inside; + else + return; +#endif + if (needsUpdate) - ns_update_menubar (SELECTED_FRAME (), true); + { +#ifdef NS_IMPL_GNUSTEP + needsUpdate = NO; +#endif + ns_update_menubar (SELECTED_FRAME (), true); + } + +#ifdef NS_IMPL_GNUSTEP + --inside; #endif } @@ -789,6 +823,9 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, p.x = x; p.y = y; + /* Don't GC due to a mysterious bug. */ + inhibit_garbage_collection (); + /* now parse stage 2 as in ns_update_menubar */ wv = make_widget_value ("contextmenu", NULL, true, Qnil); wv->button_type = BUTTON_TYPE_NONE; @@ -960,15 +997,17 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, pmenu = [[EmacsMenu alloc] initWithTitle: NILP (title) ? @"" : [NSString stringWithLispString: title]]; + /* On GNUstep, this call makes menu_items nil for whatever reason + when displaying a context menu from `context-menu-mode'. */ + Lisp_Object items = menu_items; [pmenu fillWithWidgetValue: first_wv->contents]; + menu_items = items; free_menubar_widget_value_tree (first_wv); - unbind_to (specpdl_count, Qnil); - popup_activated_flag = 1; tem = [pmenu runMenuAt: p forFrame: f keymaps: keymaps]; popup_activated_flag = 0; [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; - + unbind_to (specpdl_count, Qnil); unblock_input (); return tem; } @@ -1019,6 +1058,15 @@ update_frame_tool_bar_1 (struct frame *f, EmacsToolbar *toolbar) [toolbar clearActive]; #else [toolbar clearAll]; + /* It takes at least 3 such adjustments to fix an issue where the + tool bar is 2x too tall when a frame's tool bar is first shown. + This is ugly, but I have no other solution for this problem. */ + if (FRAME_OUTPUT_DATA (f)->tool_bar_adjusted < 3) + { + [toolbar setVisible: NO]; + FRAME_OUTPUT_DATA (f)->tool_bar_adjusted++; + [toolbar setVisible: YES]; + } #endif /* Update EmacsToolbar as in GtkUtils, build items list. */ diff --git a/src/nsterm.h b/src/nsterm.h index 4bbcf43973a..8175f996644 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -820,7 +820,7 @@ struct nsfont_info XCharStruct max_bounds; /* We compute glyph codes and metrics on-demand in blocks of 256 indexed by hibyte, lobyte. */ - unsigned short **glyphs; /* map Unicode index to glyph */ + unsigned int **glyphs; /* map Unicode index to glyph */ struct font_metrics **metrics; }; #endif @@ -978,6 +978,12 @@ struct ns_output /* Non-zero if we are doing an animation, e.g. toggling the tool bar. */ int in_animation; + +#ifdef NS_IMPL_GNUSTEP + /* Zero if this is the first time a toolbar has been updated on this + frame. */ + int tool_bar_adjusted; +#endif }; /* This dummy declaration needed to support TTYs. */ diff --git a/src/nsterm.m b/src/nsterm.m index 19ed750d217..9409697b135 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -65,6 +65,7 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #ifdef NS_IMPL_GNUSTEP #include "process.h" +#import <GNUstepGUI/GSDisplayServer.h> #endif #ifdef NS_IMPL_COCOA @@ -1079,11 +1080,16 @@ ns_focus (struct frame *f, NSRect *r, int n) /* clipping */ if (r) { - [[NSGraphicsContext currentContext] saveGraphicsState]; + NSGraphicsContext *ctx = [NSGraphicsContext currentContext]; + [ctx saveGraphicsState]; +#ifdef NS_IMPL_COCOA if (n == 2) NSRectClipList (r, 2); else NSRectClip (*r); +#else + GSRectClipList (ctx, r, n); +#endif gsaved = YES; } } @@ -2251,13 +2257,19 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) { NSTRACE ("frame_set_mouse_pixel_position"); - /* FIXME: what about GNUstep? */ #ifdef NS_IMPL_COCOA CGPoint mouse_pos = CGPointMake(f->left_pos + pix_x, f->top_pos + pix_y + FRAME_NS_TITLEBAR_HEIGHT(f) + FRAME_TOOLBAR_HEIGHT(f)); CGWarpMouseCursorPosition (mouse_pos); +#else + GSDisplayServer *server = GSServerForWindow ([FRAME_NS_VIEW (f) window]); + [server setMouseLocation: NSMakePoint (f->left_pos + pix_x, + f->top_pos + pix_y + + FRAME_NS_TITLEBAR_HEIGHT(f) + + FRAME_TOOLBAR_HEIGHT(f)) + onScreen: [[[FRAME_NS_VIEW (f) window] screen] screenNumber]]; #endif } @@ -2435,9 +2447,6 @@ ns_define_frame_cursor (struct frame *f, Emacs_Cursor cursor) EmacsView *view = FRAME_NS_VIEW (f); FRAME_POINTER_TYPE (f) = cursor; [[view window] invalidateCursorRectsForView: view]; - /* Redisplay assumes this function also draws the changed frame - cursor, but this function doesn't, so do it explicitly. */ - gui_update_cursor (f, 1); } } @@ -2573,8 +2582,7 @@ ns_get_shifted_character (NSEvent *event) ========================================================================== */ -#if 0 -/* FIXME: Remove this function. */ +#ifdef NS_IMPL_GNUSTEP static void ns_redraw_scroll_bars (struct frame *f) { @@ -2619,10 +2627,9 @@ ns_clear_frame (struct frame *f) NSRectFill (r); ns_unfocus (f); - /* as of 2006/11 or so this is now needed */ - /* FIXME: I don't see any reason for this and removing it makes no - difference here. Do we need it for GNUstep? */ - //ns_redraw_scroll_bars (f); +#ifdef NS_IMPL_GNUSTEP + ns_redraw_scroll_bars (f); +#endif unblock_input (); } @@ -2849,31 +2856,31 @@ ns_compute_glyph_string_overhangs (struct glyph_string *s) External (RIF); compute left/right overhang of whole string and set in s -------------------------------------------------------------------------- */ { - struct font *font = s->font; - - if (s->char2b) + if (s->cmp == NULL + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) { struct font_metrics metrics; - unsigned int codes[2]; - codes[0] = *(s->char2b); - codes[1] = *(s->char2b + s->nchars - 1); - font->driver->text_extents (font, codes, 2, &metrics); - s->left_overhang = -metrics.lbearing; - s->right_overhang - = metrics.rbearing > metrics.width - ? metrics.rbearing - metrics.width : 0; + if (s->first_glyph->type == CHAR_GLYPH) + { + struct font *font = s->font; + font->driver->text_extents (font, s->char2b, s->nchars, &metrics); + } + else + { + Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); + + composition_gstring_width (gstring, s->cmp_from, s->cmp_to, &metrics); + } + s->right_overhang = (metrics.rbearing > metrics.width + ? metrics.rbearing - metrics.width : 0); + s->left_overhang = metrics.lbearing < 0 ? - metrics.lbearing : 0; } - else + else if (s->cmp) { - 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; + s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width; + s->left_overhang = - s->cmp->lbearing; } } @@ -3013,14 +3020,13 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, struct frame *f = WINDOW_XFRAME (w); struct glyph *phys_cursor_glyph; struct glyph *cursor_glyph; - struct face *face; - NSColor *hollow_color = FRAME_BACKGROUND_COLOR (f); /* If cursor is out of bounds, don't draw garbage. This can happen in mini-buffer windows when switching between echo area glyphs and mini-buffer. */ - NSTRACE ("ns_draw_window_cursor"); + NSTRACE ("ns_draw_window_cursor (on = %d, cursor_type = %d)", + on_p, cursor_type); if (!on_p) return; @@ -3036,6 +3042,8 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, if ((phys_cursor_glyph = get_phys_cursor_glyph (w)) == NULL) { + NSTRACE_MSG ("No phys cursor glyph was found!"); + if (glyph_row->exact_window_width_line_p && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]) { @@ -3045,10 +3053,6 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, return; } - /* We draw the cursor (with NSRectFill), then draw the glyph on top - (other terminals do it the other way round). We must set - w->phys_cursor_width to the cursor width. For bar cursors, that - is CURSOR_WIDTH; for box cursors, it is the glyph width. */ get_phys_cursor_geometry (w, glyph_row, phys_cursor_glyph, &fx, &fy, &h); /* The above get_phys_cursor_geometry call set w->phys_cursor_width @@ -3080,17 +3084,17 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, /* Prevent the cursor from being drawn outside the text area. */ r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); - ns_focus (f, &r, 1); + ns_focus (f, NULL, 0); - face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); - if (face && NS_FACE_BACKGROUND (face) - == ns_index_color (FRAME_CURSOR_COLOR (f), f)) - { - [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; - hollow_color = FRAME_CURSOR_COLOR (f); - } - else - [FRAME_CURSOR_COLOR (f) set]; + NSGraphicsContext *ctx = [NSGraphicsContext currentContext]; + [ctx saveGraphicsState]; +#ifdef NS_IMPL_GNUSTEP + GSRectClipList (ctx, &r, 1); +#else + NSRectClip (r); +#endif + + [FRAME_CURSOR_COLOR (f) set]; switch (cursor_type) { @@ -3098,13 +3102,11 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, case NO_CURSOR: break; case FILLED_BOX_CURSOR: - NSRectFill (r); + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); break; case HOLLOW_BOX_CURSOR: - NSRectFill (r); - [hollow_color set]; - NSRectFill (NSInsetRect (r, 1, 1)); - [FRAME_CURSOR_COLOR (f) set]; + draw_phys_cursor_glyph (w, glyph_row, DRAW_NORMAL_TEXT); + [NSBezierPath strokeRect: r]; break; case HBAR_CURSOR: NSRectFill (r); @@ -3120,12 +3122,9 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, NSRectFill (s); break; } - ns_unfocus (f); - /* Draw the character under the cursor. Other terms only draw - the character on top of box cursors, so do the same here. */ - if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR) - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + [ctx restoreGraphicsState]; + ns_unfocus (f); } @@ -3305,16 +3304,18 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, if (s->for_overlaps) return; + if (s->hl == DRAW_CURSOR) + [FRAME_BACKGROUND_COLOR (s->f) set]; + else if (face->underline_defaulted_p) + [defaultCol set]; + else + [ns_lookup_indexed_color (face->underline_color, s->f) set]; + /* Do underline. */ if (face->underline) { if (s->face->underline == FACE_UNDER_WAVE) { - if (face->underline_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->underline_color, s->f) set]; - ns_draw_underwave (s, width, x); } else if (s->face->underline == FACE_UNDER_LINE) @@ -3385,11 +3386,6 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, s->underline_position = position; r = NSMakeRect (x, s->ybase + position, width, thickness); - - if (face->underline_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->underline_color, s->f) set]; NSRectFill (r); } } @@ -3399,11 +3395,6 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, { NSRect r; r = NSMakeRect (x, s->y, width, 1); - - if (face->overline_color_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->overline_color, s->f) set]; NSRectFill (r); } @@ -3426,10 +3417,6 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, dy = lrint ((glyph_height - h) / 2); r = NSMakeRect (x, glyph_y + dy, width, 1); - if (face->strike_through_color_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->strike_through_color, s->f) set]; NSRectFill (r); } } @@ -3577,17 +3564,7 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s) struct glyph *last_glyph; NSRect r; int hthickness, vthickness; - struct face *face; - - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = s->face; + struct face *face = s->face; vthickness = face->box_vertical_line_width; hthickness = face->box_horizontal_line_width; @@ -3661,34 +3638,26 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p) || FONT_TOO_HIGH (s->font) || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) { - struct face *face; - if (s->hl == DRAW_MOUSE_FACE) - { - face - = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); + struct face *face = s->face; if (!face->stipple) - [(NS_FACE_BACKGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) - : FRAME_BACKGROUND_COLOR (s->f)) set]; + { + if (s->hl != DRAW_CURSOR) + [(NS_FACE_BACKGROUND (face) != 0 + ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) + : FRAME_BACKGROUND_COLOR (s->f)) set]; + else + [FRAME_CURSOR_COLOR (s->f) set]; + } else { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set]; } - if (s->hl != DRAW_CURSOR) - { - NSRect r = NSMakeRect (s->x, s->y + box_line_width, - s->background_width, - s->height-2*box_line_width); - NSRectFill (r); - } + NSRect r = NSMakeRect (s->x, s->y + box_line_width, + s->background_width, + s->height-2*box_line_width); + NSRectFill (r); s->background_filled_p = 1; } @@ -3709,7 +3678,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) int th; char raised_p; NSRect br; - struct face *face; + struct face *face = s->face; NSColor *tdCol; NSTRACE ("ns_dumpglyphs_image"); @@ -3730,15 +3699,6 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) /* Draw BG: if we need larger area than image itself cleared, do that, otherwise, since we composite the image under NS (instead of mucking with its background color), we must clear just the image area. */ - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) set]; @@ -3809,16 +3769,8 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) if (s->hl == DRAW_CURSOR) { - [FRAME_CURSOR_COLOR (s->f) set]; - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) + [FRAME_CURSOR_COLOR (s->f) set]; tdCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); - else - /* Currently on NS img->mask is always 0. Since - get_window_cursor_type specifies a hollow box cursor when on - a non-masked image we never reach this clause. But we put it - in, in anticipation of better support for image masks on - NS. */ - tdCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); } else { @@ -3870,66 +3822,35 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) static void ns_dumpglyphs_stretch (struct glyph_string *s) { - NSRect r[2]; NSRect glyphRect; - int n; - struct face *face; + struct face *face = s->face; NSColor *fgCol, *bgCol; if (!s->background_filled_p) { - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); + face = s->face; bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); - glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); - - [bgCol set]; - - /* NOTE: under NS this is NOT used to draw cursors, but we must avoid - overwriting cursor (usually when cursor on a tab) */ if (s->hl == DRAW_CURSOR) - { - CGFloat x, width; + { + fgCol = bgCol; + bgCol = FRAME_CURSOR_COLOR (s->f); + } - /* FIXME: This looks like it will only work for left to - right languages. */ - x = NSMinX (glyphRect); - width = s->w->phys_cursor_width; - glyphRect.size.width -= width; - glyphRect.origin.x += width; + glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); - NSRectFill (glyphRect); + [bgCol set]; - /* Draw overlining, etc. on the cursor. */ - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) - ns_draw_text_decoration (s, face, bgCol, width, x); - else - ns_draw_text_decoration (s, face, fgCol, width, x); - } - else - { - NSRectFill (glyphRect); - } + NSRectFill (glyphRect); /* Draw overlining, etc. on the stretch glyph (or the part of the stretch glyph after the cursor). */ ns_draw_text_decoration (s, face, fgCol, NSWidth (glyphRect), NSMinX (glyphRect)); - ns_unfocus (s->f); s->background_filled_p = 1; } } @@ -3938,7 +3859,7 @@ ns_dumpglyphs_stretch (struct glyph_string *s) static void ns_draw_glyph_string_foreground (struct glyph_string *s) { - int x, flags; + int x; struct font *font = s->font; /* If first glyph of S has a left box line, start drawing the text @@ -3949,15 +3870,9 @@ ns_draw_glyph_string_foreground (struct glyph_string *s) else x = s->x; - flags = s->hl == DRAW_CURSOR ? NS_DUMPGLYPH_CURSOR : - (s->hl == DRAW_MOUSE_FACE ? NS_DUMPGLYPH_MOUSEFACE : - (s->for_overlaps ? NS_DUMPGLYPH_FOREGROUND : - NS_DUMPGLYPH_NORMAL)); - font->driver->draw (s, s->cmp_from, s->nchars, x, s->ybase, - (flags == NS_DUMPGLYPH_NORMAL && !s->background_filled_p) - || flags == NS_DUMPGLYPH_MOUSEFACE); + !s->for_overlaps && !s->background_filled_p); } @@ -4064,9 +3979,9 @@ ns_draw_glyph_string (struct glyph_string *s) struct font *font = s->face->font; if (! font) font = FRAME_FONT (s->f); - NSTRACE_WHEN (NSTRACE_GROUP_GLYPHS, "ns_draw_glyph_string"); + NSTRACE ("ns_draw_glyph_string (hl = %u)", s->hl); - if (s->next && s->right_overhang && !s->for_overlaps/*&&s->hl!=DRAW_CURSOR*/) + if (s->next && s->right_overhang && !s->for_overlaps) { int width; struct glyph_string *next; @@ -4103,14 +4018,21 @@ ns_draw_glyph_string (struct glyph_string *s) box_drawn_p = 1; } + n = ns_get_glyph_string_clip_rect (s, r); + + if (!s->clip_head /* draw_glyphs didn't specify a clip mask. */ + && !s->clip_tail + && ((s->prev && s->prev->hl != s->hl && s->left_overhang) + || (s->next && s->next->hl != s->hl && s->right_overhang))) + r[0] = NSIntersectionRect (r[0], NSMakeRect (s->x, s->y, s->width, s->height)); + + ns_focus (s->f, r, n); + switch (s->first_glyph->type) { case IMAGE_GLYPH: - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); ns_dumpglyphs_image (s, r[0]); - ns_unfocus (s->f); break; case XWIDGET_GLYPH: @@ -4123,57 +4045,36 @@ ns_draw_glyph_string (struct glyph_string *s) case CHAR_GLYPH: case COMPOSITE_GLYPH: - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); - - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } - { - BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + if (s->for_overlaps || (isComposite + && (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic))) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); - if (isComposite) - ns_draw_composite_glyph_string_foreground (s); - else - ns_draw_glyph_string_foreground (s); - } + if (isComposite) + ns_draw_composite_glyph_string_foreground (s); + else + ns_draw_glyph_string_foreground (s); - { - NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), - s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - [col set]; - - /* Draw underline, overline, strike-through. */ - ns_draw_text_decoration (s, s->face, col, s->width, s->x); + { + NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), + s->f) + : FRAME_FOREGROUND_COLOR (s->f)); + [col set]; + + /* Draw underline, overline, strike-through. */ + ns_draw_text_decoration (s, s->face, col, s->width, s->x); + } } - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } - - ns_unfocus (s->f); break; case GLYPHLESS_GLYPH: - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - if (s->for_overlaps || (s->cmp_from > 0 && ! s->first_glyph->u.cmp.automatic)) s->background_filled_p = 1; @@ -4183,7 +4084,6 @@ ns_draw_glyph_string (struct glyph_string *s) /* ... */ /* Not yet implemented. */ /* ... */ - ns_unfocus (s->f); break; default: @@ -4192,13 +4092,92 @@ ns_draw_glyph_string (struct glyph_string *s) /* Draw box if not done already. */ if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX) + ns_dumpglyphs_box_or_relief (s); + + ns_unfocus (s->f); + + /* Draw surrounding overhangs. */ + if (s->prev) { - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_dumpglyphs_box_or_relief (s); + ns_focus (s->f, NULL, 0); + struct glyph_string *prev; + + for (prev = s->prev; prev; prev = prev->prev) + if (prev->hl != s->hl + && prev->x + prev->width + prev->right_overhang > s->x) + { + /* As prev was drawn while clipped to its own area, we + must draw the right_overhang part using s->hl now. */ + enum draw_glyphs_face save = prev->hl; + struct face *save_face = prev->face; + + prev->face = s->face; + NSRect r = NSMakeRect (s->x, s->y, s->width, s->height); + [[NSGraphicsContext currentContext] saveGraphicsState]; + NSRectClip (r); +#ifdef NS_IMPL_GNUSTEP + DPSgsave ([NSGraphicsContext currentContext]); + DPSrectclip ([NSGraphicsContext currentContext], s->x, s->y, + s->width, s->height); +#endif + prev->num_clips = 1; + prev->hl = s->hl; + if (prev->first_glyph->type == CHAR_GLYPH) + ns_draw_glyph_string_foreground (prev); + else + ns_draw_composite_glyph_string_foreground (prev); +#ifdef NS_IMPL_GNUSTEP + DPSgrestore ([NSGraphicsContext currentContext]); +#endif + [[NSGraphicsContext currentContext] restoreGraphicsState]; + prev->hl = save; + prev->face = save_face; + prev->num_clips = 0; + } ns_unfocus (s->f); } + if (s->next) + { + ns_focus (s->f, NULL, 0); + struct glyph_string *next; + + for (next = s->next; next; next = next->next) + if (next->hl != s->hl + && next->x - next->left_overhang < s->x + s->width) + { + /* As next will be drawn while clipped to its own area, + we must draw the left_overhang part using s->hl now. */ + enum draw_glyphs_face save = next->hl; + struct face *save_face = next->face; + + next->hl = s->hl; + next->face = s->face; + NSRect r = NSMakeRect (s->x, s->y, s->width, s->height); + [[NSGraphicsContext currentContext] saveGraphicsState]; + NSRectClip (r); +#ifdef NS_IMPL_GNUSTEP + DPSgsave ([NSGraphicsContext currentContext]); + DPSrectclip ([NSGraphicsContext currentContext], s->x, s->y, + s->width, s->height); +#endif + next->num_clips = 1; + if (next->first_glyph->type == CHAR_GLYPH) + ns_draw_glyph_string_foreground (next); + else + ns_draw_composite_glyph_string_foreground (next); +#ifdef NS_IMPL_GNUSTEP + DPSgrestore ([NSGraphicsContext currentContext]); +#endif + [[NSGraphicsContext currentContext] restoreGraphicsState]; + next->hl = save; + next->num_clips = 0; + next->face = save_face; + next->clip_head = next; + next->background_filled_p = 0; + } + ns_unfocus (s->f); + } s->num_clips = 0; } @@ -4948,6 +4927,17 @@ ns_default_font_parameter (struct frame *f, Lisp_Object parms) { } +#ifdef NS_IMPL_GNUSTEP +static void +ns_update_window_end (struct window *w, bool cursor_on_p, + bool mouse_face_overwritten_p) +{ + NSTRACE ("ns_update_window_end (cursor_on_p = %d)", cursor_on_p); + + ns_redraw_scroll_bars (WINDOW_XFRAME (w)); +} +#endif + /* This and next define (many of the) public functions in this file. */ /* gui_* are generic versions in xdisp.c that we, and other terms, get away with using despite presence in the "system dependent" redisplay @@ -4964,7 +4954,11 @@ static struct redisplay_interface ns_redisplay_interface = ns_scroll_run, ns_after_update_window_line, NULL, /* update_window_begin */ +#ifndef NS_IMPL_GNUSTEP NULL, /* update_window_end */ +#else + ns_update_window_end, +#endif 0, /* flush_display */ gui_clear_window_mouse_face, gui_get_glyph_overhangs, @@ -6191,9 +6185,11 @@ not_in_argv (NSString *arg) Lisp_Object kind = fnKeysym ? QCfunction : QCordinary; emacs_event->modifiers = EV_MODIFIERS2 (flags, kind); +#ifndef NS_IMPL_GNUSTEP if (NS_KEYLOG) fprintf (stderr, "keyDown: code =%x\tfnKey =%x\tflags = %x\tmods = %x\n", code, fnKeysym, flags, emacs_event->modifiers); +#endif /* If it was a function key or had control-like modifiers, pass it directly to Emacs. */ @@ -6706,6 +6702,11 @@ not_in_argv (NSString *arg) emacs_event->code = EV_BUTTON (theEvent); emacs_event->modifiers = EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent); + + if (emacs_event->modifiers & down_modifier) + FRAME_DISPLAY_INFO (emacsframe)->grabbed |= 1 << EV_BUTTON (theEvent); + else + FRAME_DISPLAY_INFO (emacsframe)->grabbed &= ~(1 << EV_BUTTON (theEvent)); } XSETINT (emacs_event->x, lrint (p.x)); @@ -7006,7 +7007,6 @@ not_in_argv (NSString *arg) height = (int)NSHeight (frame); NSTRACE_SIZE ("New size", NSMakeSize (width, height)); - NSTRACE_SIZE ("Original size", size); /* Reset the frame size to match the bounds of the superview (the NSWindow's contentView). We need to do this as sometimes the @@ -7075,6 +7075,7 @@ not_in_argv (NSString *arg) XSETFRAME (frame, emacsframe); help_echo_string = Qnil; gen_help_event (Qnil, frame, Qnil, Qnil, 0); + any_help_event_p = NO; } if (emacs_event && is_focus_frame) diff --git a/src/pdumper.c b/src/pdumper.c index a8f8d6fa00b..9eff5c48d09 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -312,14 +312,15 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset) error ("dump relocation out of range"); } -static void -dump_fingerprint (char const *label, +void +dump_fingerprint (FILE *output, char const *label, unsigned char const xfingerprint[sizeof fingerprint]) { enum { hexbuf_size = 2 * sizeof fingerprint }; char hexbuf[hexbuf_size]; hexbuf_digest (hexbuf, xfingerprint, sizeof fingerprint); - fprintf (stderr, "%s: %.*s\n", label, hexbuf_size, hexbuf); + fprintf (output, "%s%s%.*s\n", label, *label ? ": " : "", + hexbuf_size, hexbuf); } /* To be used if some order in the relocation process has to be enforced. */ @@ -4127,7 +4128,7 @@ types. */) ctx->header.fingerprint[i] = fingerprint[i]; const dump_off header_start = ctx->offset; - dump_fingerprint ("Dumping fingerprint", ctx->header.fingerprint); + dump_fingerprint (stderr, "Dumping fingerprint", ctx->header.fingerprint); dump_write (ctx, &ctx->header, sizeof (ctx->header)); const dump_off header_end = ctx->offset; @@ -5599,8 +5600,8 @@ pdumper_load (const char *dump_filename, char *argv0) desired[i] = fingerprint[i]; if (memcmp (header->fingerprint, desired, sizeof desired) != 0) { - dump_fingerprint ("desired fingerprint", desired); - dump_fingerprint ("found fingerprint", header->fingerprint); + dump_fingerprint (stderr, "desired fingerprint", desired); + dump_fingerprint (stderr, "found fingerprint", header->fingerprint); goto out; } @@ -5708,6 +5709,7 @@ pdumper_load (const char *dump_filename, char *argv0) dump_mmap_release (§ions[i]); if (dump_fd >= 0) emacs_close (dump_fd); + return err; } @@ -5792,6 +5794,7 @@ syms_of_pdumper (void) DEFSYM (Qdumped_with_pdumper, "dumped-with-pdumper"); DEFSYM (Qload_time, "load-time"); DEFSYM (Qdump_file_name, "dump-file-name"); + DEFSYM (Qafter_pdump_load_hook, "after-pdump-load-hook"); defsubr (&Spdumper_stats); #endif /* HAVE_PDUMPER */ } diff --git a/src/pdumper.h b/src/pdumper.h index deec9af046d..7f1f5e46ad9 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -20,6 +20,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef EMACS_PDUMPER_H #define EMACS_PDUMPER_H +#include <stdio.h> +#include "fingerprint.h" #include "lisp.h" INLINE_HEADER_BEGIN @@ -50,6 +52,9 @@ enum { PDUMPER_NO_OBJECT = -1 }; #define PDUMPER_REMEMBER_SCALAR(thing) \ pdumper_remember_scalar (&(thing), sizeof (thing)) +extern void dump_fingerprint (FILE *output, const char *label, + unsigned char const fingerp[sizeof fingerprint]); + extern void pdumper_remember_scalar_impl (void *data, ptrdiff_t nbytes); INLINE void diff --git a/src/print.c b/src/print.c index 9f684bbeb53..c13294c8e62 100644 --- a/src/print.c +++ b/src/print.c @@ -564,7 +564,7 @@ temp_output_buffer_setup (const char *bufname) Fset_buffer (Fget_buffer_create (build_string (bufname), Qnil)); - Fkill_all_local_variables (); + Fkill_all_local_variables (Qnil); delete_all_overlays (current_buffer); bset_directory (current_buffer, BVAR (old, directory)); bset_read_only (current_buffer, Qnil); diff --git a/src/process.c b/src/process.c index 6731f8808f5..f923aff1cb3 100644 --- a/src/process.c +++ b/src/process.c @@ -2167,7 +2167,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) p->pty_flag = pty_flag; pset_status (p, Qrun); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (inchannel); ptrdiff_t count = SPECPDL_INDEX (); @@ -2285,7 +2286,8 @@ create_pty (Lisp_Object process) pset_status (p, Qrun); setup_process_coding_systems (process); - add_process_read_fd (pty_fd); + if (!EQ (p->filter, Qt)) + add_process_read_fd (pty_fd); pset_tty_name (p, build_string (pty_name)); } @@ -2394,7 +2396,8 @@ usage: (make-pipe-process &rest ARGS) */) pset_command (p, Qt); eassert (! p->pty_flag); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (inchannel); p->adaptive_read_buffering = (NILP (Vprocess_adaptive_read_buffering) ? 0 @@ -3129,7 +3132,8 @@ usage: (make-serial-process &rest ARGS) */) pset_command (p, Qt); eassert (! p->pty_flag); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (fd); update_process_mark (p); diff --git a/src/search.c b/src/search.c index 08f1e9474f1..66e77d42b4a 100644 --- a/src/search.c +++ b/src/search.c @@ -260,7 +260,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, static Lisp_Object -looking_at_1 (Lisp_Object string, bool posix) +looking_at_1 (Lisp_Object string, bool posix, bool modify_data) { Lisp_Object val; unsigned char *p1, *p2; @@ -278,11 +278,11 @@ looking_at_1 (Lisp_Object string, bool posix) CHECK_STRING (string); /* Snapshot in case Lisp changes the value. */ - bool preserve_match_data = NILP (Vinhibit_changing_match_data); + bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data; struct regexp_cache *cache_entry = compile_pattern ( string, - preserve_match_data ? &search_regs : NULL, + modify_match_data ? &search_regs : NULL, (!NILP (BVAR (current_buffer, case_fold_search)) ? BVAR (current_buffer, case_canon_table) : Qnil), posix, @@ -316,7 +316,7 @@ looking_at_1 (Lisp_Object string, bool posix) re_match_object = Qnil; i = re_match_2 (&cache_entry->buf, (char *) p1, s1, (char *) p2, s2, PT_BYTE - BEGV_BYTE, - preserve_match_data ? &search_regs : NULL, + modify_match_data ? &search_regs : NULL, ZV_BYTE - BEGV_BYTE); if (i == -2) @@ -326,7 +326,7 @@ looking_at_1 (Lisp_Object string, bool posix) } val = (i >= 0 ? Qt : Qnil); - if (preserve_match_data && i >= 0) + if (modify_match_data && i >= 0) { for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) @@ -343,35 +343,37 @@ looking_at_1 (Lisp_Object string, bool posix) return unbind_to (count, val); } -DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, +DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 2, 0, doc: /* Return t if text after point matches regular expression REGEXP. -This function modifies the match data that `match-beginning', -`match-end' and `match-data' access; save and restore the match -data if you want to preserve them. */) - (Lisp_Object regexp) +By default, this function modifies the match data that +`match-beginning', `match-end' and `match-data' access. If +INHIBIT-MODIFY is non-nil, don't modify the match data. */) + (Lisp_Object regexp, Lisp_Object inhibit_modify) { - return looking_at_1 (regexp, 0); + return looking_at_1 (regexp, 0, NILP (inhibit_modify)); } -DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0, +DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 2, 0, doc: /* Return t if text after point matches REGEXP according to Posix rules. Find the longest match, in accordance with Posix regular expression rules. -This function modifies the match data that `match-beginning', -`match-end' and `match-data' access; save and restore the match -data if you want to preserve them. */) - (Lisp_Object regexp) + +By default, this function modifies the match data that +`match-beginning', `match-end' and `match-data' access. If +INHIBIT-MODIFY is non-nil, don't modify the match data. */) + (Lisp_Object regexp, Lisp_Object inhibit_modify) { - return looking_at_1 (regexp, 1); + return looking_at_1 (regexp, 1, NILP (inhibit_modify)); } static Lisp_Object string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, - bool posix) + bool posix, bool modify_data) { ptrdiff_t val; struct re_pattern_buffer *bufp; EMACS_INT pos; ptrdiff_t pos_byte, i; + bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data; if (running_asynch_code) save_search_regs (); @@ -400,8 +402,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, BVAR (current_buffer, case_eqv_table)); bufp = &compile_pattern (regexp, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL), + (modify_match_data ? &search_regs : NULL), (!NILP (BVAR (current_buffer, case_fold_search)) ? BVAR (current_buffer, case_canon_table) : Qnil), posix, @@ -410,18 +411,17 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, val = re_search (bufp, SSDATA (string), SBYTES (string), pos_byte, SBYTES (string) - pos_byte, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL)); + (modify_match_data ? &search_regs : NULL)); /* Set last_thing_searched only when match data is changed. */ - if (NILP (Vinhibit_changing_match_data)) + if (modify_match_data) last_thing_searched = Qt; if (val == -2) matcher_overflow (); if (val < 0) return Qnil; - if (NILP (Vinhibit_changing_match_data)) + if (modify_match_data) for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) { @@ -434,32 +434,42 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, return make_fixnum (string_byte_to_char (string, val)); } -DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0, +DEFUN ("string-match", Fstring_match, Sstring_match, 2, 4, 0, doc: /* Return index of start of first match for REGEXP in STRING, or nil. Matching ignores case if `case-fold-search' is non-nil. If third arg START is non-nil, start search at that index in STRING. -For index of first char beyond the match, do (match-end 0). -`match-end' and `match-beginning' also give indices of substrings -matched by parenthesis constructs in the pattern. -You can use the function `match-string' to extract the substrings -matched by the parenthesis constructions in REGEXP. */) - (Lisp_Object regexp, Lisp_Object string, Lisp_Object start) +If INHIBIT-MODIFY is non-nil, match data is not changed. + +If INHIBIT-MODIFY is nil or missing, match data is changed, and +`match-end' and `match-beginning' give indices of substrings matched +by parenthesis constructs in the pattern. You can use the function +`match-string' to extract the substrings matched by the parenthesis +constructions in REGEXP. For index of first char beyond the match, do +(match-end 0). */) + (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, + Lisp_Object inhibit_modify) { - return string_match_1 (regexp, string, start, 0); + return string_match_1 (regexp, string, start, 0, NILP (inhibit_modify)); } -DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0, +DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 4, 0, doc: /* Return index of start of first match for Posix REGEXP in STRING, or nil. Find the longest match, in accord with Posix regular expression rules. Case is ignored if `case-fold-search' is non-nil in the current buffer. -If third arg START is non-nil, start search at that index in STRING. -For index of first char beyond the match, do (match-end 0). -`match-end' and `match-beginning' also give indices of substrings -matched by parenthesis constructs in the pattern. */) - (Lisp_Object regexp, Lisp_Object string, Lisp_Object start) + +If INHIBIT-MODIFY is non-nil, match data is not changed. + +If INHIBIT-MODIFY is nil or missing, match data is changed, and +`match-end' and `match-beginning' give indices of substrings matched +by parenthesis constructs in the pattern. You can use the function +`match-string' to extract the substrings matched by the parenthesis +constructions in REGEXP. For index of first char beyond the match, do +(match-end 0). */) + (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, + Lisp_Object inhibit_modify) { - return string_match_1 (regexp, string, start, 1); + return string_match_1 (regexp, string, start, 1, NILP (inhibit_modify)); } /* Match REGEXP against STRING using translation table TABLE, diff --git a/src/sysstdio.h b/src/sysstdio.h index d4df3d74567..d6ebfb455f5 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -26,7 +26,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdio.h> #include "unlocked-io.h" -extern FILE *emacs_fopen (char const *, char const *); +extern FILE *emacs_fopen (char const *, char const *) ATTRIBUTE_MALLOC; extern void errputc (int); extern void errwrite (void const *, ptrdiff_t); extern void close_output_streams (void); diff --git a/src/w32.c b/src/w32.c index 9fe698d28d7..e4b7ef3b95d 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2820,53 +2820,6 @@ sys_putenv (char *str) #define REG_ROOT "SOFTWARE\\GNU\\Emacs" -LPBYTE -w32_get_resource (const char *key, LPDWORD lpdwtype) -{ - LPBYTE lpvalue; - HKEY hrootkey = NULL; - DWORD cbData; - - /* Check both the current user and the local machine to see if - we have any resources. */ - - if (RegOpenKeyEx (HKEY_CURRENT_USER, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) - { - lpvalue = NULL; - - if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS - && (lpvalue = xmalloc (cbData)) != NULL - && RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) - { - RegCloseKey (hrootkey); - return (lpvalue); - } - - xfree (lpvalue); - - RegCloseKey (hrootkey); - } - - if (RegOpenKeyEx (HKEY_LOCAL_MACHINE, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) - { - lpvalue = NULL; - - if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS - && (lpvalue = xmalloc (cbData)) != NULL - && RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) - { - RegCloseKey (hrootkey); - return (lpvalue); - } - - xfree (lpvalue); - - RegCloseKey (hrootkey); - } - - return (NULL); -} - /* The argv[] array holds ANSI-encoded strings, and so this function works with ANS_encoded strings. */ void @@ -3077,7 +3030,7 @@ init_environment (char ** argv) int dont_free = 0; char bufc[SET_ENV_BUF_SIZE]; - if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL + if ((lpval = w32_get_resource (REG_ROOT, env_vars[i].name, &dwType)) == NULL /* Also ignore empty environment variables. */ || *lpval == 0) { diff --git a/src/w32.h b/src/w32.h index ffa145b1484..ec0f37123e8 100644 --- a/src/w32.h +++ b/src/w32.h @@ -161,8 +161,9 @@ extern void prepare_standard_handles (int in, int out, extern void reset_standard_handles (int in, int out, int err, HANDLE handles[4]); -/* Return the string resource associated with KEY of type TYPE. */ -extern LPBYTE w32_get_resource (const char * key, LPDWORD type); +/* Query Windows Registry and return the resource associated + associated with KEY and NAME of type TYPE. */ +extern LPBYTE w32_get_resource (const char * key, const char * name, LPDWORD type); extern void release_listen_threads (void); extern void init_ntproc (int); diff --git a/src/w32fns.c b/src/w32fns.c index 14d1154a2bc..c1686beaaa9 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -73,6 +73,20 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <imm.h> #include <windowsx.h> +/* + Internal/undocumented constants for Windows Dark mode. + See: https://github.com/microsoft/WindowsAppSDK/issues/41 +*/ +#define DARK_MODE_APP_NAME L"DarkMode_Explorer" +/* For Windows 10 version 1809, 1903, 1909. */ +#ifndef DWMWA_USE_IMMERSIVE_DARK_MODE_OLD +#define DWMWA_USE_IMMERSIVE_DARK_MODE_OLD 19 +#endif +/* For Windows 10 version 2004 and higher, and Windows 11. */ +#ifndef DWMWA_USE_IMMERSIVE_DARK_MODE +#define DWMWA_USE_IMMERSIVE_DARK_MODE 20 +#endif + #ifndef FOF_NO_CONNECTED_ELEMENTS #define FOF_NO_CONNECTED_ELEMENTS 0x2000 #endif @@ -185,6 +199,11 @@ typedef BOOL (WINAPI *IsDebuggerPresent_Proc) (void); typedef HRESULT (WINAPI *SetThreadDescription_Proc) (HANDLE hThread, PCWSTR lpThreadDescription); +typedef HRESULT (WINAPI * SetWindowTheme_Proc) + (IN HWND hwnd, IN LPCWSTR pszSubAppName, IN LPCWSTR pszSubIdList); +typedef HRESULT (WINAPI * DwmSetWindowAttribute_Proc) + (HWND hwnd, DWORD dwAttribute, IN LPCVOID pvAttribute, DWORD cbAttribute); + TrackMouseEvent_Proc track_mouse_event_fn = NULL; ImmGetCompositionString_Proc get_composition_string_fn = NULL; ImmGetContext_Proc get_ime_context_fn = NULL; @@ -199,6 +218,8 @@ EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL; GetTitleBarInfo_Proc get_title_bar_info_fn = NULL; IsDebuggerPresent_Proc is_debugger_present = NULL; SetThreadDescription_Proc set_thread_description = NULL; +SetWindowTheme_Proc SetWindowTheme_fn = NULL; +DwmSetWindowAttribute_Proc DwmSetWindowAttribute_fn = NULL; extern AppendMenuW_Proc unicode_append_menu; @@ -252,6 +273,9 @@ int w32_major_version; int w32_minor_version; int w32_build_number; +/* If the OS is set to use dark mode. */ +BOOL w32_darkmode = FALSE; + /* Distinguish between Windows NT and Windows 95. */ int os_subtype; @@ -2279,10 +2303,36 @@ w32_init_class (HINSTANCE hinst) } } +/* Applies the Windows system theme (light or dark) to the window + handle HWND. */ +static void +w32_applytheme (HWND hwnd) +{ + if (w32_darkmode) + { + /* Set window theme to that of a built-in Windows app (Explorer), + because it has dark scroll bars and other UI elements. */ + if (SetWindowTheme_fn) + SetWindowTheme_fn (hwnd, DARK_MODE_APP_NAME, NULL); + + /* Set the titlebar to system dark mode. */ + if (DwmSetWindowAttribute_fn) + { + /* Windows 10 version 2004 and up, Windows 11. */ + DWORD attr = DWMWA_USE_IMMERSIVE_DARK_MODE; + /* Windows 10 older than 2004. */ + if (w32_build_number < 19041) + attr = DWMWA_USE_IMMERSIVE_DARK_MODE_OLD; + DwmSetWindowAttribute_fn (hwnd, attr, + &w32_darkmode, sizeof (w32_darkmode)); + } + } +} + static HWND w32_createvscrollbar (struct frame *f, struct scroll_bar * bar) { - return CreateWindow ("SCROLLBAR", "", + HWND hwnd = CreateWindow ("SCROLLBAR", "", /* Clip siblings so we don't draw over child frames. Apparently this is not always sufficient so we also try to make bar windows @@ -2291,12 +2341,15 @@ w32_createvscrollbar (struct frame *f, struct scroll_bar * bar) /* Position and size of scroll bar. */ bar->left, bar->top, bar->width, bar->height, FRAME_W32_WINDOW (f), NULL, hinst, NULL); + if (hwnd) + w32_applytheme (hwnd); + return hwnd; } static HWND w32_createhscrollbar (struct frame *f, struct scroll_bar * bar) { - return CreateWindow ("SCROLLBAR", "", + HWND hwnd = CreateWindow ("SCROLLBAR", "", /* Clip siblings so we don't draw over child frames. Apparently this is not always sufficient so we also try to make bar windows @@ -2305,6 +2358,9 @@ w32_createhscrollbar (struct frame *f, struct scroll_bar * bar) /* Position and size of scroll bar. */ bar->left, bar->top, bar->width, bar->height, FRAME_W32_WINDOW (f), NULL, hinst, NULL); + if (hwnd) + w32_applytheme (hwnd); + return hwnd; } static void @@ -2390,6 +2446,9 @@ w32_createwindow (struct frame *f, int *coords) /* Enable drag-n-drop. */ DragAcceptFiles (hwnd, TRUE); + /* Enable system light/dark theme. */ + w32_applytheme (hwnd); + /* Do this to discard the default setting specified by our parent. */ ShowWindow (hwnd, SW_HIDE); @@ -10257,6 +10316,60 @@ to be converted to forward slashes by the caller. */) } #endif /* WINDOWSNT */ + +/* Query a value from the Windows Registry (under HKCU and HKLM), + where `key` is the registry key, `name` is the name, and `lpdwtype` + is a pointer to the return value's type. `lpwdtype` can be NULL if + you do not care about the type. + + Returns: pointer to the value, or null pointer if the key/name does + not exist. */ +LPBYTE +w32_get_resource (const char *key, const char *name, LPDWORD lpdwtype) +{ + LPBYTE lpvalue; + HKEY hrootkey = NULL; + DWORD cbData; + + /* Check both the current user and the local machine to see if + we have any resources. */ + + if (RegOpenKeyEx (HKEY_CURRENT_USER, key, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) + { + lpvalue = NULL; + + if (RegQueryValueEx (hrootkey, name, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS + && (lpvalue = xmalloc (cbData)) != NULL + && RegQueryValueEx (hrootkey, name, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) + { + RegCloseKey (hrootkey); + return (lpvalue); + } + + xfree (lpvalue); + + RegCloseKey (hrootkey); + } + + if (RegOpenKeyEx (HKEY_LOCAL_MACHINE, key, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) + { + lpvalue = NULL; + + if (RegQueryValueEx (hrootkey, name, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS + && (lpvalue = xmalloc (cbData)) != NULL + && RegQueryValueEx (hrootkey, name, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) + { + RegCloseKey (hrootkey); + return (lpvalue); + } + + xfree (lpvalue); + + RegCloseKey (hrootkey); + } + + return (NULL); +} /*********************************************************************** Initialization @@ -11028,6 +11141,37 @@ globals_of_w32fns (void) set_thread_description = (SetThreadDescription_Proc) get_proc_addr (hm_kernel32, "SetThreadDescription"); + /* Support OS dark mode on Windows 10 version 1809 and higher. + See `w32_applytheme` which uses appropriate APIs per version of Windows. + For future wretches who may need to understand Windows build numbers: + https://docs.microsoft.com/en-us/windows/release-health/release-information + */ + if (os_subtype == OS_SUBTYPE_NT + && w32_major_version >= 10 && w32_build_number >= 17763) + { + /* Load dwmapi.dll and uxtheme.dll, which will be needed to set + window themes. */ + HMODULE dwmapi_lib = LoadLibrary("dwmapi.dll"); + DwmSetWindowAttribute_fn = (DwmSetWindowAttribute_Proc) + get_proc_addr (dwmapi_lib, "DwmSetWindowAttribute"); + HMODULE uxtheme_lib = LoadLibrary("uxtheme.dll"); + SetWindowTheme_fn = (SetWindowTheme_Proc) + get_proc_addr (uxtheme_lib, "SetWindowTheme"); + + /* Check Windows Registry for system theme and set w32_darkmode. + TODO: "Nice to have" would be to create a lisp setting (which + defaults to this Windows Registry value), then read that lisp + value here instead. This would allow the user to forcibly + override the system theme (which is also user-configurable in + Windows settings; see MS-Windows section in Emacs manual). */ + LPBYTE val = + w32_get_resource ("Software\\Microsoft\\Windows\\CurrentVersion\\Themes\\Personalize", + "AppsUseLightTheme", + NULL); + if (val && *val == 0) + w32_darkmode = TRUE; + } + except_code = 0; except_addr = 0; #ifndef CYGWIN diff --git a/src/w32font.c b/src/w32font.c index 6b9ab0468cd..4ceb4302cee 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2000,11 +2000,11 @@ w32_encode_weight (int n) static Lisp_Object w32_to_fc_weight (int n) { - if (n >= FW_HEAVY) return intern ("black"); + if (n >= FW_HEAVY) return Qblack; if (n >= FW_EXTRABOLD) return Qextra_bold; if (n >= FW_BOLD) return Qbold; if (n >= FW_SEMIBOLD) return intern ("demibold"); - if (n >= FW_NORMAL) return intern ("medium"); + if (n >= FW_NORMAL) return Qmedium; if (n >= FW_LIGHT) return Qlight; if (n >= FW_EXTRALIGHT) return Qextra_light; return intern ("thin"); diff --git a/src/w32term.c b/src/w32term.c index 9cf250cd73f..07a5cd35649 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -954,22 +954,6 @@ w32_set_cursor_gc (struct glyph_string *s) static void w32_set_mouse_face_gc (struct glyph_string *s) { - int face_id; - struct face *face; - - /* What face has to be used last for the mouse face? */ - face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; - face = FACE_FROM_ID_OR_NULL (s->f, face_id); - if (face == NULL) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - - if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); - else - face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); - s->face = FACE_FROM_ID (s->f, face_id); - prepare_face_for_display (s->f, s->face); - /* If font in this face is same as S->font, use it. */ if (s->font == s->face->font) s->gc = s->face->gc; diff --git a/src/xdisp.c b/src/xdisp.c index c05e7edbc97..86c4e704d52 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1179,7 +1179,13 @@ static void append_stretch_glyph (struct it *, Lisp_Object, static Lisp_Object get_it_property (struct it *, Lisp_Object); static Lisp_Object calc_line_height_property (struct it *, Lisp_Object, struct font *, int, bool); - +static int adjust_glyph_width_for_mouse_face (struct glyph *, + struct glyph_row *, + struct window *, struct face *, + struct face *); +static void get_cursor_offset_for_mouse_face (struct window *w, + struct glyph_row *row, + int *offset); #endif /* HAVE_WINDOW_SYSTEM */ static void produce_special_glyphs (struct it *, enum display_element_type); @@ -10622,10 +10628,12 @@ in_display_vector_p (struct it *it) DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 6, 0, doc: /* Return the size of the text of WINDOW's buffer in pixels. -WINDOW must be a live window and defaults to the selected one. The +WINDOW can be any live window and defaults to the selected one. The return value is a cons of the maximum pixel-width of any text line and the pixel-height of all the text lines in the accessible portion of buffer text. +WINDOW can also be a buffer, in which case the selected window is used, +and the function behaves as if that window was displaying this buffer. This function exists to allow Lisp programs to adjust the dimensions of WINDOW to the buffer text it needs to display. @@ -10669,8 +10677,9 @@ include the height of any of these, if present, in the return value. */) (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, Lisp_Object y_limit, Lisp_Object mode_lines) { - struct window *w = decode_live_window (window); - Lisp_Object buffer = w->contents; + struct window *w = BUFFERP (window) ? XWINDOW (selected_window) + : decode_live_window (window); + Lisp_Object buffer = BUFFERP (window) ? window : w->contents; struct buffer *b; struct it it; struct buffer *old_b = NULL; @@ -10841,17 +10850,42 @@ include the height of any of these, if present, in the return value. */) if (y > max_y) y = max_y; - if (EQ (mode_lines, Qtab_line) || EQ (mode_lines, Qt)) - /* Re-add height of tab-line as requested. */ - y = y + WINDOW_TAB_LINE_HEIGHT (w); + if ((EQ (mode_lines, Qtab_line) || EQ (mode_lines, Qt)) + && window_wants_tab_line (w)) + /* Add height of tab-line as requested. */ + { + Lisp_Object window_tab_line_format + = window_parameter (w, Qtab_line_format); - if (EQ (mode_lines, Qheader_line) || EQ (mode_lines, Qt)) - /* Re-add height of header-line as requested. */ - y = y + WINDOW_HEADER_LINE_HEIGHT (w); + y = y + display_mode_line (w, TAB_LINE_FACE_ID, + NILP (window_tab_line_format) + ? BVAR (current_buffer, tab_line_format) + : window_tab_line_format); + } - if (EQ (mode_lines, Qmode_line) || EQ (mode_lines, Qt)) - /* Add height of mode-line as requested. */ - y = y + WINDOW_MODE_LINE_HEIGHT (w); + if ((EQ (mode_lines, Qheader_line) || EQ (mode_lines, Qt)) + && window_wants_header_line (w)) + { + Lisp_Object window_header_line_format + = window_parameter (w, Qheader_line_format); + + y = y + display_mode_line (w, HEADER_LINE_FACE_ID, + NILP (window_header_line_format) + ? BVAR (current_buffer, header_line_format) + : window_header_line_format); + } + + if ((EQ (mode_lines, Qmode_line) || EQ (mode_lines, Qt)) + && window_wants_mode_line (w)) + { + Lisp_Object window_mode_line_format + = window_parameter (w, Qmode_line_format); + + y = y + display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), + NILP (window_mode_line_format) + ? BVAR (current_buffer, mode_line_format) + : window_mode_line_format); + } bidi_unshelve_cache (itdata, false); @@ -13860,7 +13894,6 @@ note_tab_bar_highlight (struct frame *f, int x, int y) clear_mouse_face (hlinfo); bool mouse_down_p = false; -#ifndef HAVE_NS /* Mouse is down, but on different tab-bar item? Or alternatively, the mouse might've been pressed somewhere we don't know about, and then have moved onto the tab bar. In this case, @@ -13873,7 +13906,6 @@ note_tab_bar_highlight (struct frame *f, int x, int y) if (mouse_down_p && f->last_tab_bar_item != prop_idx && f->last_tab_bar_item != -1) return; -#endif draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED; /* If tab-bar item is not enabled, don't highlight it. */ @@ -24477,7 +24509,7 @@ See also `bidi-paragraph-direction'. */) DEFUN ("bidi-find-overridden-directionality", Fbidi_find_overridden_directionality, - Sbidi_find_overridden_directionality, 2, 3, 0, + Sbidi_find_overridden_directionality, 3, 4, 0, doc: /* Return position between FROM and TO where directionality was overridden. This function returns the first character position in the specified @@ -24496,12 +24528,18 @@ a buffer is preferable when the buffer is displayed in some window, because this function will then be able to correctly account for window-specific overlays, which can affect the results. +Optional argument BASE-DIR specifies the base paragraph directory +of the text. It should be a symbol, either `left-to-right' +or `right-to-left', and defaults to `left-to-right'. + Strong directional characters `L', `R', and `AL' can have their intrinsic directionality overridden by directional override -control characters RLO (u+202e) and LRO (u+202d). See the -function `get-char-code-property' for a way to inquire about +control characters RLO (u+202E) and LRO (u+202D). They can also +have their directionality affected by other formatting control +characters: LRE (u+202A), RLE (u+202B), LRI (u+2066), and RLI (u+2067). +See the function `get-char-code-property' for a way to inquire about the `bidi-class' property of a character. */) - (Lisp_Object from, Lisp_Object to, Lisp_Object object) + (Lisp_Object from, Lisp_Object to, Lisp_Object object, Lisp_Object base_dir) { struct buffer *buf = current_buffer; struct buffer *old = buf; @@ -24598,10 +24636,9 @@ the `bidi-class' property of a character. */) } ptrdiff_t found; + bidi_dir_t bdir = EQ (base_dir, Qright_to_left) ? R2L : L2R; do { - /* For the purposes of this function, the actual base direction of - the paragraph doesn't matter, so just set it to L2R. */ - bidi_paragraph_init (L2R, &itb, false); + bidi_paragraph_init (bdir, &itb, false); while ((found = bidi_find_first_overridden (&itb)) < from_pos) ; } while (found == ZV && itb.ch == '\n' && itb.charpos < to_pos); @@ -28129,6 +28166,19 @@ fill_composite_glyph_string (struct glyph_string *s, struct face *base_face, s->font = s->face->font; } + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + int c = COMPOSITION_GLYPH (s->cmp, 0); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + + s->face = FACE_FROM_ID (s->f, FACE_FOR_CHAR (s->f, s->face, c, -1, Qnil)); + prepare_face_for_display (s->f, s->face); + } + /* All glyph strings for the same composition has the same width, i.e. the width set for the first component of the composition. */ s->width = s->first_glyph->pixel_width; @@ -28165,7 +28215,17 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, s->cmp_id = glyph->u.cmp.id; s->cmp_from = glyph->slice.cmp.from; s->cmp_to = glyph->slice.cmp.to + 1; - s->face = FACE_FROM_ID (s->f, face_id); + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } + else + s->face = FACE_FROM_ID (s->f, face_id); lgstring = composition_gstring_from_id (s->cmp_id); s->font = XFONT_OBJECT (LGSTRING_FONT (lgstring)); /* The width of a composition glyph string is the sum of the @@ -28221,6 +28281,15 @@ fill_glyphless_glyph_string (struct glyph_string *s, int face_id, voffset = glyph->voffset; s->face = FACE_FROM_ID (s->f, face_id); s->font = s->face->font ? s->face->font : FRAME_FONT (s->f); + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->nchars = 1; s->width = glyph->pixel_width; glyph++; @@ -28284,6 +28353,19 @@ fill_glyph_string (struct glyph_string *s, int face_id, s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + s->face + = FACE_FROM_ID (s->f, FACE_FOR_CHAR (s->f, s->face, + s->first_glyph->u.ch, -1, Qnil)); + prepare_face_for_display (s->f, s->face); + } + /* If the specified font could not be loaded, use the frame's font, but record the fact that we couldn't load it in S->font_not_found_p so that we can draw rectangles for the @@ -28313,6 +28395,15 @@ fill_image_glyph_string (struct glyph_string *s) s->slice = s->first_glyph->slice.img; s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = s->first_glyph->pixel_width; /* Adjust base line for subscript/superscript text. */ @@ -28327,6 +28418,15 @@ fill_xwidget_glyph_string (struct glyph_string *s) eassert (s->first_glyph->type == XWIDGET_GLYPH); s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = s->first_glyph->pixel_width; s->ybase += s->first_glyph->voffset; s->xwidget = s->first_glyph->u.xwidget; @@ -28352,6 +28452,15 @@ fill_stretch_glyph_string (struct glyph_string *s, int start, int end) face_id = glyph->face_id; s->face = FACE_FROM_ID (s->f, face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = glyph->pixel_width; s->nchars = 1; voffset = glyph->voffset; @@ -28599,7 +28708,12 @@ right_overwriting (struct glyph_string *s) /* Set background width of glyph string S. START is the index of the first glyph following S. LAST_X is the right-most x-position + 1 - in the drawing area. */ + in the drawing area. + + If S->hl is DRAW_CURSOR, S->f is a window system frame, and the + cursor in S's window is currently inside mouse face, also update + S->width to take into account potentially differing :box + properties between the original face and the mouse face. */ static void set_glyph_string_background_width (struct glyph_string *s, int start, int last_x) @@ -28621,7 +28735,27 @@ set_glyph_string_background_width (struct glyph_string *s, int start, int last_x if (s->extends_to_end_of_line_p) s->background_width = last_x - s->x + 1; else - s->background_width = s->width; + { + s->background_width = s->width; +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (s->f) + && s->hl == DRAW_CURSOR + && cursor_in_mouse_face_p (s->w)) + { + /* Adjust the background width of the glyph string, because + if the glyph's face has the :box attribute, its + pixel_width might be different when it's displayed in the + mouse-face, if that also has the :box attribute. */ + struct glyph *g = s->first_glyph; + struct face *regular_face = FACE_FROM_ID (s->f, g->face_id); + s->background_width += + adjust_glyph_width_for_mouse_face (g, s->row, s->w, + regular_face, s->face); + /* S->width is probably worth adjusting here as well. */ + s->width = s->background_width; + } +#endif + } } @@ -29170,7 +29304,6 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, for (s = head; s; s = s->next) FRAME_RIF (f)->draw_glyph_string (s); -#ifndef HAVE_NS /* When focus a sole frame and move horizontally, this clears on_p causing a failure to erase prev cursor position. */ if (area == TEXT_AREA @@ -29189,7 +29322,6 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, notice_overwritten_cursor (w, TEXT_AREA, x0, x1, row->y, MATRIX_ROW_BOTTOM_Y (row)); } -#endif /* Value is the x-position up to which drawn, relative to AREA of W. This doesn't include parts drawn because of overhangs. */ @@ -29522,6 +29654,8 @@ produce_image_glyph (struct it *it) if (face->box != FACE_NO_BOX) { + /* If you change the logic here, please change it in + get_cursor_offset_for_mouse_face as well. */ if (face->box_horizontal_line_width > 0) { if (slice.y == 0) @@ -31823,6 +31957,20 @@ erase_phys_cursor (struct window *w) && cursor_row->used[TEXT_AREA] > hpos && hpos >= 0) mouse_face_here_p = true; +#ifdef HAVE_WINDOW_SYSTEM + /* Since erasing the phys cursor will probably lead to corruption of + the mouse face display if the glyph's pixel_width is not kept up + to date with the :box property of the mouse face, just redraw the + mouse face. */ + if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) && mouse_face_here_p) + { + w->phys_cursor_on_p = false; + w->phys_cursor_type = NO_CURSOR; + show_mouse_face (MOUSE_HL_INFO (WINDOW_XFRAME (w)), DRAW_MOUSE_FACE); + return; + } +#endif + /* Maybe clear the display under the cursor. */ if (w->phys_cursor_type == HOLLOW_BOX_CURSOR) { @@ -32094,6 +32242,9 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) && hlinfo->mouse_face_end_row < w->current_matrix->nrows) { bool phys_cursor_on_p = w->phys_cursor_on_p; +#ifdef HAVE_WINDOW_SYSTEM + int mouse_off = 0; +#endif struct glyph_row *row, *first, *last; first = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_beg_row); @@ -32167,6 +32318,15 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) row->mouse_face_p = draw == DRAW_MOUSE_FACE || draw == DRAW_IMAGE_RAISED; } +#ifdef HAVE_WINDOW_SYSTEM + /* Compute the cursor offset due to mouse-highlight. */ + if ((MATRIX_ROW_VPOS (row, w->current_matrix) == w->phys_cursor.vpos) + /* But not when highlighting a pseudo window, such as + the toolbar, which can't have a cursor anyway. */ + && !w->pseudo_window_p + && draw == DRAW_MOUSE_FACE) + get_cursor_offset_for_mouse_face (w, row, &mouse_off); +#endif } /* When we've written over the cursor, arrange for it to @@ -32176,6 +32336,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) { #ifdef HAVE_WINDOW_SYSTEM int hpos = w->phys_cursor.hpos; + int old_phys_cursor_x = w->phys_cursor.x; /* When the window is hscrolled, cursor hpos can legitimately be out of bounds, but we draw the cursor at the corresponding @@ -32187,7 +32348,11 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) block_input (); display_and_set_cursor (w, true, hpos, w->phys_cursor.vpos, - w->phys_cursor.x, w->phys_cursor.y); + w->phys_cursor.x + mouse_off, + w->phys_cursor.y); + /* Restore the original cursor coordinates, perhaps modified + to account for mouse-highlight. */ + w->phys_cursor.x = old_phys_cursor_x; unblock_input (); #endif /* HAVE_WINDOW_SYSTEM */ } @@ -35977,4 +36142,121 @@ cancel_hourglass (void) } } +/* Return a correction to be applied to G->pixel_width when it is + displayed in MOUSE_FACE. This is needed for the first and the last + glyphs of text inside a face with :box when it is displayed with + MOUSE_FACE that has a different or no :box attribute. + ORIGINAL_FACE is the face G was originally drawn in, and MOUSE_FACE + is the face it will be drawn in now. ROW is the G's glyph row and + W is its window. */ +static int +adjust_glyph_width_for_mouse_face (struct glyph *g, struct glyph_row *row, + struct window *w, + struct face *original_face, + struct face *mouse_face) +{ + int sum = 0; + + bool do_left_box_p = g->left_box_line_p; + bool do_right_box_p = g->right_box_line_p; + + /* This is required because we test some parameters of the image + slice before applying the box in produce_image_glyph. */ + if (g->type == IMAGE_GLYPH) + { + if (!row->reversed_p) + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x == 0; + do_right_box_p = g->right_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + } + else + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + do_right_box_p = g->right_box_line_p && + g->slice.img.x == 0; + } + } + + /* If the glyph has a left box line, subtract it from the offset. */ + if (do_left_box_p) + sum -= max (0, original_face->box_vertical_line_width); + /* Likewise with the right box line, as there may be a + box there as well. */ + if (do_right_box_p) + sum -= max (0, original_face->box_vertical_line_width); + /* Now add the line widths from the new face. */ + if (g->left_box_line_p) + sum += max (0, mouse_face->box_vertical_line_width); + if (g->right_box_line_p) + sum += max (0, mouse_face->box_vertical_line_width); + + return sum; +} + +/* Get the offset due to mouse-highlight to apply before drawing + phys_cursor, and return it in OFFSET. ROW should be the row that + is under mouse face and contains the phys cursor. + + This is required because the produce_XXX_glyph series of functions + add the width of the various vertical box lines to the total width + of the glyphs, but that must be updated when the row is put under + mouse face, which can have different box dimensions. */ +static void +get_cursor_offset_for_mouse_face (struct window *w, struct glyph_row *row, + int *offset) +{ + int sum = 0; + /* Return because the mode line can't possibly have a cursor. */ + if (row->mode_line_p) + return; + + block_input (); + + struct frame *f = WINDOW_XFRAME (w); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + struct glyph *start, *end; + struct face *mouse_face = FACE_FROM_ID (f, hlinfo->mouse_face_face_id); + int hpos = w->phys_cursor.hpos; + end = &row->glyphs[TEXT_AREA][hpos]; + + if (!row->reversed_p) + { + if (MATRIX_ROW_VPOS (row, w->current_matrix) == + hlinfo->mouse_face_beg_row) + start = &row->glyphs[TEXT_AREA][hlinfo->mouse_face_beg_col]; + else + start = row->glyphs[TEXT_AREA]; + } + else + { + if (MATRIX_ROW_VPOS (row, w->current_matrix) == + hlinfo->mouse_face_end_row) + start = &row->glyphs[TEXT_AREA][hlinfo->mouse_face_end_col]; + else + start = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; + } + + /* Calculate the offset by which to correct phys_cursor x if we are + drawing the cursor inside mouse-face highlighted text. */ + + for ( ; row->reversed_p ? start > end : start < end; + row->reversed_p ? --start : ++start) + sum += adjust_glyph_width_for_mouse_face (start, row, w, + FACE_FROM_ID (f, start->face_id), + mouse_face); + + if (row->reversed_p) + sum = -sum; + + *offset = sum; + + unblock_input (); +} #endif /* HAVE_WINDOW_SYSTEM */ diff --git a/src/xfaces.c b/src/xfaces.c index 5e63e87d751..22f37222c38 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6933,13 +6933,20 @@ syms_of_xfaces (void) DEFSYM (Qpressed_button, "pressed-button"); DEFSYM (Qflat_button, "flat-button"); DEFSYM (Qnormal, "normal"); + DEFSYM (Qthin, "thin"); DEFSYM (Qextra_light, "extra-light"); + DEFSYM (Qultra_light, "ultra-light"); DEFSYM (Qlight, "light"); DEFSYM (Qsemi_light, "semi-light"); + DEFSYM (Qmedium, "medium"); DEFSYM (Qsemi_bold, "semi-bold"); + DEFSYM (Qbook, "book"); DEFSYM (Qbold, "bold"); DEFSYM (Qextra_bold, "extra-bold"); DEFSYM (Qultra_bold, "ultra-bold"); + DEFSYM (Qheavy, "heavy"); + DEFSYM (Qultra_heavy, "ultra-heavy"); + DEFSYM (Qblack, "black"); DEFSYM (Qoblique, "oblique"); DEFSYM (Qitalic, "italic"); diff --git a/src/xterm.c b/src/xterm.c index 89885e0d889..aa1a1a5eed3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1563,22 +1563,6 @@ x_set_cursor_gc (struct glyph_string *s) static void x_set_mouse_face_gc (struct glyph_string *s) { - int face_id; - struct face *face; - - /* What face has to be used last for the mouse face? */ - face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; - face = FACE_FROM_ID_OR_NULL (s->f, face_id); - if (face == NULL) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - - if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); - else - face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); - s->face = FACE_FROM_ID (s->f, face_id); - prepare_face_for_display (s->f, s->face); - if (s->font == s->face->font) s->gc = s->face->gc; else @@ -4142,6 +4126,7 @@ x_show_hourglass (struct frame *f) XMapRaised (dpy, x->hourglass_window); XFlush (dpy); + redisplay_preserve_echo_area (21); } } } diff --git a/test/Makefile.in b/test/Makefile.in index d82f53157b0..7bef1c36605 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -77,9 +77,14 @@ EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS XDG_CONFIG_HOME -## To run tests under a debugger, set this to eg: "gdb --args". +# To run tests under a debugger, set this to eg: "gdb --args". GDB = +# Whether a timeout shall be given, writing possibly a core dump. +ifneq (${EMACS_TEST_TIMEOUT},) +TEST_TIMEOUT = timeout -s ABRT ${EMACS_TEST_TIMEOUT} +endif + # Set this to 'yes' to run the tests in an interactive instance. TEST_INTERACTIVE ?= no @@ -117,7 +122,7 @@ endif # and prevent locals to influence the text of the errors we expect to receive. emacs = LANG=C EMACSLOADPATH= \ EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \ - $(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT) + $(GDB) $(TEST_TIMEOUT) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT) # Set HOME to a nonexistent directory to prevent tests from accessing # it accidentally (e.g., popping up a gnupg dialog if ~/.authinfo.gpg @@ -167,7 +172,7 @@ lisp/net/tramp-tests.log \ : WRITE_LOG = 2>&1 | tee $@ endif ifdef EMACS_EMBA_CI -lisp/filenotify-tests.log lisp/net/tramp-tests.log src/emacs-module-tests.el \ +lisp/filenotify-tests.log lisp/net/tramp-tests.log src/emacs-module-tests.log \ : WRITE_LOG = 2>&1 | tee $@ endif diff --git a/test/README b/test/README index a0961249cfa..4d447c9bf15 100644 --- a/test/README +++ b/test/README @@ -140,6 +140,11 @@ these test environments. $EMACS_HYDRA_CI indicates the hydra environment, and $EMACS_EMBA_CI indicates the emba environment, respectively. +If tests on these premises take too long, and it is needed to create a +core dump for further analysis, the environment variable +$EMACS_TEST_TIMEOUT could set a limit (in seconds) when this shall +happen. + (Also, see etc/compilation.txt for compilation mode font lock tests and etc/grep.txt for grep mode font lock tests.) diff --git a/test/data/image/black.gif b/test/data/image/black.gif Binary files differnew file mode 100644 index 00000000000..6ab623e367e --- /dev/null +++ b/test/data/image/black.gif diff --git a/test/data/image/black.webp b/test/data/image/black.webp Binary files differnew file mode 100644 index 00000000000..5dbe716415b --- /dev/null +++ b/test/data/image/black.webp diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 71b4e76865f..aef68c6e81e 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -29,7 +29,7 @@ FROM debian:stretch as emacs-base RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \ - libdbus-1-dev libacl1-dev acl git texinfo \ + libdbus-1-dev libacl1-dev acl git texinfo gdb \ && rm -rf /var/lib/apt/lists/* FROM emacs-base as emacs-inotify @@ -72,14 +72,14 @@ RUN ./autogen.sh autoconf RUN ./configure --with-ns RUN make bootstrap -FROM emacs-base as emacs-native-comp-speed0 +FROM emacs-base as emacs-native-comp RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ libgccjit-6-dev \ && rm -rf /var/lib/apt/lists/* -ARG make_bootstrap_params="" +FROM emacs-native-comp as emacs-native-comp-speed0 COPY . /checkout WORKDIR /checkout @@ -87,3 +87,19 @@ RUN ./autogen.sh autoconf RUN ./configure --with-native-compilation RUN make bootstrap -j2 \ NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"' + +FROM emacs-native-comp as emacs-native-comp-speed1 + +COPY . /checkout +WORKDIR /checkout +RUN ./autogen.sh autoconf +RUN ./configure --with-native-compilation +RUN make bootstrap -j2 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"' + +FROM emacs-native-comp as emacs-native-comp-speed2 + +COPY . /checkout +WORKDIR /checkout +RUN ./autogen.sh autoconf +RUN ./configure --with-native-compilation +RUN make bootstrap -j2 diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index b233c0fbc54..001c7795725 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -44,6 +44,8 @@ workflow: variables: GIT_STRATEGY: fetch EMACS_EMBA_CI: 1 + # Three hours, see below. + EMACS_TEST_TIMEOUT: 10800 EMACS_TEST_VERBOSE: 1 # # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled # DOCKER_HOST: tcp://docker:2376 @@ -69,24 +71,25 @@ default: test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA} rules: - changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - aclocal.m4 - autogen.sh - configure.ac - lib/*.{h,c} - - lisp/**/*.el + - lisp/**.el - src/*.{h,c} - test/infra/* - test/lib-src/*.el - - test/lisp/**/*.el + - test/lisp/**.el + - test/misc/*.el - test/src/*.el - changes: # gfilemonitor, kqueue - src/gfilenotify.c - src/kqueue.c # MS Windows - - "**/w32*" + - "**w32*" # GNUstep - lisp/term/ns-win.el - src/ns*.{h,m} @@ -107,20 +110,22 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' after_script: # - docker ps -a # - printenv # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} + # - ls -alR ${test_name} .build-template: + needs: [] rules: - if: '$CI_PIPELINE_SOURCE == "web"' when: always - changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - aclocal.m4 - autogen.sh @@ -134,7 +139,7 @@ default: - src/gfilenotify.c - src/kqueue.c # MS Windows - - "**/w32*" + - "**w32*" # GNUstep - lisp/term/ns-win.el - src/ns*.{h,m} @@ -145,8 +150,6 @@ default: - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} .test-template: - # Do not block later stages. - allow_failure: true # Do not run fast and normal test jobs when scheduled. rules: - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' @@ -157,20 +160,23 @@ default: public: true expire_in: 1 week paths: - - "${test_name}/**/*.log" + - ${test_name}/**/*.log + - ${test_name}/**/core + - ${test_name}/core + when: always .gnustep-template: rules: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - configure.ac - src/ns*.{h,m} - src/macfont.{h,m} - lisp/term/ns-win.el - - nextstep/**/* + - nextstep/** - test/infra/* .filenotify-gio-template: @@ -178,7 +184,7 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - lisp/autorevert.el - lisp/filenotify.el @@ -193,7 +199,7 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - lisp/emacs-lisp/comp.el - lisp/emacs-lisp/comp-cstr.el @@ -218,6 +224,8 @@ build-image-inotify: extends: [.job-template, .build-template] variables: target: emacs-inotify +# Temporarily. + timeout: 8 hours # test-fast-inotify: # stage: fast @@ -270,43 +278,33 @@ test-gnustep: target: emacs-gnustep make_params: install -build-native-bootstrap-speed0: +build-native-comp-speed0: stage: native-comp-images extends: [.job-template, .build-template, .native-comp-template] variables: target: emacs-native-comp-speed0 -# build-native-bootstrap-speed0: -# # Test a full native bootstrap -# # Run for now only speed 0 to limit memory usage and compilation time. -# stage: native-comp-images -# # Uncomment the following to run it only when scheduled. -# # only: -# # - schedules -# script: -# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev -# - ./autogen.sh autoconf -# - ./configure --with-native-compilation -# - make bootstrap NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"' -j2 -# timeout: 8 hours +build-native-comp-speed1: + stage: native-comp-images + extends: [.job-template, .build-template, .native-comp-template] + variables: + target: emacs-native-comp-speed1 -# build-native-bootstrap-speed1: -# stage: native-comp-images -# script: -# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev -# - ./autogen.sh autoconf -# - ./configure --with-native-compilation -# - make bootstrap BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"' -# timeout: 8 hours +build-native-comp-speed2: + stage: native-comp-images + extends: [.job-template, .build-template, .native-comp-template] + variables: + target: emacs-native-comp-speed2 -# build-native-bootstrap-speed2: -# stage: native-comp-images -# script: -# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev -# - ./autogen.sh autoconf -# - ./configure --with-native-compilation -# - make bootstrap -# timeout: 8 hours +test-native-comp-speed0: + stage: native-comp + needs: [build-native-comp-speed0] + extends: [.job-template, .test-template, .native-comp-template] + variables: + target: emacs-native-comp-speed0 + make_params: >- + -C test check EXCLUDE_TESTS=%emacs-module-tests.el + SELECTOR='(not (tag :unstable))' test-all-inotify: # This tests also file monitor libraries inotify and inotifywatch. @@ -319,7 +317,9 @@ test-all-inotify: - if: '$CI_PIPELINE_SOURCE == "schedule"' variables: target: emacs-inotify - make_params: check-expensive + make_params: check-expensive EXCLUDE_TESTS=%emacs-module-tests.el + # Two hours. + EMACS_TEST_TIMEOUT: 7200 # Local Variables: # add-log-current-defun-header-regexp: "^\\([-_.[:alnum:]]+\\)[ \t]*:" diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el index 953fdff8933..14a14ca4f06 100644 --- a/test/lisp/ansi-color-tests.el +++ b/test/lisp/ansi-color-tests.el @@ -24,10 +24,12 @@ ;;; Code: (require 'ansi-color) +(eval-when-compile (require 'cl-lib)) (defvar ansi-color-tests--strings (let ((bright-yellow (face-foreground 'ansi-color-bright-yellow nil 'default)) - (yellow (face-foreground 'ansi-color-yellow nil 'default))) + (yellow (face-foreground 'ansi-color-yellow nil 'default)) + (custom-color "#87FFFF")) `(("Hello World" "Hello World") ("\e[33mHello World\e[0m" "Hello World" (:foreground ,yellow)) @@ -51,7 +53,25 @@ (ansi-color-bold (:foreground ,bright-yellow))) ("\e[1m\e[3m\e[5mbold italics blink\e[0m" "bold italics blink" (ansi-color-bold ansi-color-italic ansi-color-slow-blink)) - ("\e[10munrecognized\e[0m" "unrecognized")))) + ("\e[10munrecognized\e[0m" "unrecognized") + ("\e[38;5;3;1mHello World\e[0m" "Hello World" + (ansi-color-bold (:foreground ,yellow)) + (ansi-color-bold (:foreground ,bright-yellow))) + ("\e[48;5;123;1mHello World\e[0m" "Hello World" + (ansi-color-bold (:background ,custom-color))) + ("\e[48;2;135;255;255;1mHello World\e[0m" "Hello World" + (ansi-color-bold (:background ,custom-color)))))) + +(defun ansi-color-tests-equal-props (o1 o2) + "Return t if two Lisp objects have similar structure and contents. +While `equal-including-properties' compares text properties of +strings with `eq', this function compares them with `equal'." + (or (equal-including-properties o1 o2) + (and (stringp o1) + (equal o1 o2) + (cl-loop for i below (length o1) + always (equal (text-properties-at i o1) + (text-properties-at i o2)))))) (ert-deftest ansi-color-apply-on-region-test () (pcase-dolist (`(,input ,text ,face) ansi-color-tests--strings) @@ -83,6 +103,76 @@ (ansi-color-apply-on-region (point-min) (point-max) t) (should (equal (buffer-string) (car pair)))))) +(ert-deftest ansi-color-incomplete-sequences-test () + (let* ((strs (list "\e[" "2;31m Hello World " + "\e" "[108;5;12" "3m" "Greetings" + "\e[0m\e[35;6m" "Hello")) + (complete-str (apply #'concat strs)) + (filtered-str) + (propertized-str) + (ansi-color-apply-face-function + #'ansi-color-apply-text-property-face) + (ansi-filt (lambda (str) (ansi-color-filter-apply + (copy-sequence str)))) + (ansi-app (lambda (str) (ansi-color-apply + (copy-sequence str))))) + + (with-temp-buffer + (setq filtered-str + (replace-regexp-in-string "\e\\[.*?m" "" complete-str)) + (setq propertized-str (funcall ansi-app complete-str)) + + (should-not (ansi-color-tests-equal-props + filtered-str propertized-str)) + (should (equal filtered-str propertized-str))) + + ;; Tests for `ansi-color-filter-apply' + (with-temp-buffer + (should (equal-including-properties + filtered-str + (funcall ansi-filt complete-str)))) + + (with-temp-buffer + (should (equal-including-properties + filtered-str + (mapconcat ansi-filt strs "")))) + + ;; Tests for `ansi-color-filter-region' + (with-temp-buffer + (insert complete-str) + (ansi-color-filter-region (point-min) (point-max)) + (should (equal-including-properties + filtered-str (buffer-string)))) + + (with-temp-buffer + (dolist (str strs) + (let ((opoint (point))) + (insert str) + (ansi-color-filter-region opoint (point)))) + (should (equal-including-properties + filtered-str (buffer-string)))) + + ;; Test for `ansi-color-apply' + (with-temp-buffer + (should (ansi-color-tests-equal-props + propertized-str + (mapconcat ansi-app strs "")))) + + ;; Tests for `ansi-color-apply-on-region' + (with-temp-buffer + (insert complete-str) + (ansi-color-apply-on-region (point-min) (point-max)) + (should (ansi-color-tests-equal-props + propertized-str (buffer-string)))) + + (with-temp-buffer + (dolist (str strs) + (let ((opoint (point))) + (insert str) + (ansi-color-apply-on-region opoint (point)))) + (should (ansi-color-tests-equal-props + propertized-str (buffer-string)))))) + (provide 'ansi-color-tests) ;;; ansi-color-tests.el ends here diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index 8a78a068242..3eb6b34c132 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -810,6 +810,12 @@ An existing calc stack is reused, otherwise a new one is created." (should (equal (calcFunc-test6 3) (* (* 3 2) (- 3 1)))) (should (equal (calcFunc-test7 3) (* 3 2)))) +(ert-deftest calc-nth-root () + ;; bug#51209 + (let* ((calc-display-working-message nil) + (x (calc-tests--calc-to-number (math-pow 8 '(frac 1 6))))) + (should (< (abs (- x (sqrt 2.0))) 1.0e-10)))) + (provide 'calc-tests) ;;; calc-tests.el ends here diff --git a/test/lisp/edmacro-tests.el b/test/lisp/edmacro-tests.el new file mode 100644 index 00000000000..974f506a367 --- /dev/null +++ b/test/lisp/edmacro-tests.el @@ -0,0 +1,47 @@ +;;; edmacro-tests.el --- Tests for edmacro.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021 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 'edmacro) + +(ert-deftest edmacro-test-edmacro-parse-keys () + (should (equal (edmacro-parse-keys "") "")) + (should (equal (edmacro-parse-keys "x") "x")) + (should (equal (edmacro-parse-keys "C-a") "\C-a")) + + ;; comments + (should (equal (edmacro-parse-keys ";; foobar") "")) + (should (equal (edmacro-parse-keys ";;;") "")) + (should (equal (edmacro-parse-keys "; ; ;") ";;;")) + (should (equal (edmacro-parse-keys "REM foobar") "")) + (should (equal (edmacro-parse-keys "x ;; foobar") "x")) + (should (equal (edmacro-parse-keys "x REM foobar") "x")) + (should (equal (edmacro-parse-keys "<<goto-line>>") + [134217848 103 111 116 111 45 108 105 110 101 13])) + + ;; repetitions + (should (equal (edmacro-parse-keys "3*x") "xxx")) + (should (equal (edmacro-parse-keys "3*C-m") "\C-m\C-m\C-m")) + (should (equal (edmacro-parse-keys "10*foo") "foofoofoofoofoofoofoofoofoofoo"))) + +;;; edmacro-tests.el ends here diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index f59f9d9ccac..686641c1b33 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -32,6 +32,9 @@ (require 'elec-pair) (require 'cl-lib) +;; When running tests in c-mode, use single-line comments (//). +(add-hook 'c-mode-hook (lambda () (c-toggle-comment-style -1))) + (defun call-with-saved-electric-modes (fn) (let ((saved-electric (if electric-pair-mode 1 -1)) (saved-layout (if electric-layout-mode 1 -1)) @@ -176,7 +179,7 @@ The buffer's contents should %s: expected-string expected-point bindings - (modes '(quote (ruby-mode js-mode python-mode))) + (modes '(quote (ruby-mode js-mode python-mode c-mode))) (test-in-comments t) (test-in-strings t) (test-in-code t) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a6e224b3d2c..41edc1f8289 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -640,6 +640,9 @@ inner loops respectively." (f (list (lambda (x) (setq a x))))) (funcall (car f) 3) (list a b)) + + (cond) + (mapcar (lambda (x) (cond ((= x 0)))) '(0 1)) ) "List of expressions for cross-testing interpreted and compiled code.") diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index f4e2e46a019..033764a7f98 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -637,17 +637,26 @@ collection clause." (/ 1 (logand n 1)) (arith-error (len3 (cdr xs) (1+ n))) (:success (len3 (cdr xs) (+ n k)))) - n))) + n)) + + ;; Tail calls in `cond'. + (len4 (xs n) + (cond (xs (cond (nil 'nevertrue) + ((len4 (cdr xs) (1+ n))))) + (t n)))) (should (equal (len nil 0) 0)) (should (equal (len2 nil 0) 0)) (should (equal (len3 nil 0) 0)) + (should (equal (len4 nil 0) 0)) (should (equal (len list-42 0) 42)) (should (equal (len2 list-42 0) 42)) (should (equal (len3 list-42 0) 42)) + (should (equal (len4 list-42 0) 42)) ;; Should not bump into stack depth limits. (should (equal (len list-42k 0) 42000)) (should (equal (len2 list-42k 0) 42000)) - (should (equal (len3 list-42k 0) 42000)))) + (should (equal (len3 list-42k 0) 42000)) + (should (equal (len4 list-42k 0) 42000)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 9eb7fb02230..ba2e5f7be4a 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -969,6 +969,18 @@ Subclasses to override slot attributes.") (should (eieio-instance-inheritor-slot-boundp C :b)) (should-not (eieio-instance-inheritor-slot-boundp C :c)))) +;;;; Interaction with defstruct + +(cl-defstruct eieio-test--struct a b c) + +(ert-deftest eieio-test-defstruct-slot-value () + (let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C))) + (should (eq (eieio-test--struct-a x) + (slot-value x 'a))) + (should (eq (eieio-test--struct-b x) + (slot-value x 'b))) + (should (eq (eieio-test--struct-c x) + (slot-value x 'c))))) (provide 'eieio-tests) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index a18664bba3b..79576d24032 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -695,49 +695,40 @@ This macro is used to test if macroexpansion in `should' works." (should (equal (ert--abbreviate-string "bar" 0 t) ""))) (ert-deftest ert-test-explain-equal-string-properties () - (should - (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b)) - "foo") - '(char 0 "f" - (different-properties-for-key a (different-atoms b nil)) - context-before "" - context-after "oo"))) - (should (equal (ert--explain-equal-including-properties + (should-not (ert--explain-equal-including-properties-rec "foo" "foo")) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd)) + '(char 0 "f" (different-properties-for-key c (different-atoms e d)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b)) + "foo") + '(char 0 "f" + (different-properties-for-key a (different-atoms b nil)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec #("foo" 1 3 (a b)) #("goo" 0 1 (c d))) '(array-elt 0 (different-atoms (?f "#x66" "?f") (?g "#x67" "?g"))))) - (should - (equal (ert--explain-equal-including-properties - #("foo" 0 1 (a b c d) 1 3 (a b)) - #("foo" 0 1 (c d a b) 1 2 (a foo))) - '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) - context-before "f" context-after "o")))) - -(ert-deftest ert-test-equal-including-properties () - (should (equal-including-properties "foo" "foo")) - (should (ert-equal-including-properties "foo" "foo")) - - (should (equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - (should (ert-equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - - (should (equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - - (should-not (equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - - ;; This is bug 6581. - (should-not (equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t)))) - (should (ert-equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t))))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b c d) 1 3 (a b)) + #("foo" 0 1 (c d a b) 1 2 (a foo))) + '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) + context-before "f" context-after "o")))) (ert-deftest ert-test-stats-set-test-and-result () (let* ((test-1 (make-ert-test :name 'test-1 diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 9f40a18d343..1784934acb3 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -90,10 +90,10 @@ "foo baz"))) (ert-deftest ert-propertized-string () - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "a" '(a b) "b" '(c t) "cd") #("abcd" 1 2 (a b) 2 4 (c t)))) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "foo " '(face italic) "bar" " baz" nil " quux") #("foo bar baz quux" 4 11 (face italic))))) @@ -166,7 +166,7 @@ "1 skipped")))) (with-current-buffer buffer-name (font-lock-mode 0) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) @@ -175,7 +175,7 @@ ;; pretend we are. (let ((noninteractive nil)) (font-lock-mode 1)) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) diff --git a/test/lisp/emacs-lisp/pp-resources/code-formats.erts b/test/lisp/emacs-lisp/pp-resources/code-formats.erts new file mode 100644 index 00000000000..2b2001d0964 --- /dev/null +++ b/test/lisp/emacs-lisp/pp-resources/code-formats.erts @@ -0,0 +1,124 @@ +Code: + (lambda () + (emacs-lisp-mode) + (let ((code (read (current-buffer)))) + (erase-buffer) + (pp-emacs-lisp-code code) + (untabify (point-min) (point-max)))) + +Name: code-formats1 + +=-= +(defun foo (bar) + "Yes." + (let ((a 1) + (b 2)) + (zot 1 2 (funcall bar 2)))) +=-=-= + + +Name: code-formats2 + +=-= +(defun pp-emacs-lisp-code (sexp) + "Insert SEXP into the current buffer, formatted as Emacs Lisp code." + (require 'edebug) + (let ((start (point)) + (standard-output (current-buffer))) + (pp--insert-lisp sexp) + (insert "\n") + (goto-char start) + (indent-sexp))) +=-=-= + + +Name: code-formats3 + +=-= +(defun foo (bar) + "Yes." + (let ((a 1) + (b 2)) + (zot-zot-zot-zot-zot-zot 1 2 (funcall + bar-bar-bar-bar-bar-bar-bar-bar-bar-bar + 2)))) +=-=-= + + +Name: code-formats4 + +=-= +(defun foo (bar) + "Yes." + (let ((a 1) + (b 2) + foo bar zotfoo bar zotfoo bar zotfoo bar zotfoo bar zotfoo bar zotfoo + bar zot) + (zot 1 2 (funcall bar 2)))) +=-=-= + + +Name: code-formats5 + +=-= +(defgroup pp () + "Pretty printer for Emacs Lisp." + :prefix "pp-" + :group 'lisp) +=-=-= + +Name: code-formats6 + +=-= +(defcustom pp-escape-newlines t + "Value of `print-escape-newlines' used by pp-* functions." + :type 'boolean + :group 'pp) +=-=-= + +Name: code-formats7 + +=-= +(defun pp (object &optional stream) + (princ (pp-to-string object) (or stream standard-output))) +=-=-= + + +Name: code-formats8 + +=-= +(defun pp-eval-expression (expression) + "Evaluate EXPRESSION and pretty-print its value. +Also add the value to the front of the list in the variable `values'." + (interactive (list (read--expression "Eval: "))) + (message "Evaluating...") + (let ((result (eval expression lexical-binding))) + (values--store-value result) + (pp-display-expression result "*Pp Eval Output*"))) +=-=-= + +Name: code-formats9 + +=-= +(lambda () + (interactive) + 1) +=-=-= + + +Name: code-formats10 + +=-= +(funcall foo (concat "zot" (if (length> site 0) site + "bar") + "+" + (string-replace " " "+" query))) +=-=-= + + +Name: code-formats11 + +=-= +(lambda () + [(foo bar) (foo bar)]) +=-=-= diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index b04030cc432..4cae1a73775 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'pp) +(require 'ert-x) (ert-deftest pp-print-quote () (should (string= (pp-to-string 'quote) "quote")) @@ -32,4 +33,7 @@ (should (string= (pp-to-string '(quotefoo)) "(quotefoo)\n")) (should (string= (pp-to-string '(a b)) "(a b)\n"))) +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "code-formats.erts"))) + ;;; pp-tests.el ends here. diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 1d19496ba44..f9cfea888c7 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -638,5 +638,43 @@ (should (equal (string-chop-newline "foo\nbar\n") "foo\nbar")) (should (equal (string-chop-newline "foo\nbar") "foo\nbar"))) +(ert-deftest subr-ensure-empty-lines () + (should + (equal + (with-temp-buffer + (insert "foo") + (goto-char (point-min)) + (ensure-empty-lines 2) + (buffer-string)) + "\n\nfoo")) + (should + (equal + (with-temp-buffer + (insert "foo") + (ensure-empty-lines 2) + (buffer-string)) + "foo\n\n\n")) + (should + (equal + (with-temp-buffer + (insert "foo\n") + (ensure-empty-lines 2) + (buffer-string)) + "foo\n\n\n")) + (should + (equal + (with-temp-buffer + (insert "foo\n\n\n\n\n") + (ensure-empty-lines 2) + (buffer-string)) + "foo\n\n\n")) + (should + (equal + (with-temp-buffer + (insert "foo\n\n\n") + (ensure-empty-lines 0) + (buffer-string)) + "foo\n"))) + (provide 'subr-x-tests) ;;; subr-x-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 6ed26f68289..685f4e2bea2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -228,4 +228,66 @@ (kill-buffer "*erc-protocol*") (should-not erc-debug-irc-protocol))) + +;; The point of this test is to ensure output is handled identically +;; regardless of whether a command handler is summoned. + +(ert-deftest erc-process-input-line () + (let (erc-server-last-sent-time + erc-server-flood-queue + (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) + calls) + (with-temp-buffer + (cl-letf (((symbol-function 'erc-cmd-MSG) + (lambda (line) + (push line calls) + (funcall orig-erc-cmd-MSG line))) + ((symbol-function 'erc-server-buffer) + (lambda () (current-buffer))) + ((symbol-function 'erc-server-process-alive) + (lambda () t)) + ((symbol-function 'erc-server-send-queue) + #'ignore) + ((symbol-function 'erc-default-target) + (lambda () "" "#chan"))) + + (ert-info ("Dispatch to user command handler") + + (ert-info ("Baseline") + (erc-process-input-line "/msg #chan hi\n") + (should (equal (pop calls) " #chan hi")) + (should (equal (pop erc-server-flood-queue) + '("PRIVMSG #chan :hi\r\n" . utf-8)))) + + (ert-info ("Spaces preserved") + (erc-process-input-line "/msg #chan hi you\n") + (should (equal (pop calls) " #chan hi you")) + (should (equal (pop erc-server-flood-queue) + '("PRIVMSG #chan :hi you\r\n" . utf-8)))) + + (ert-info ("Empty line honored") + (erc-process-input-line "/msg #chan\n") + (should (equal (pop calls) " #chan")) + (should (equal (pop erc-server-flood-queue) + '("PRIVMSG #chan :\r\n" . utf-8))))) + + (ert-info ("Implicit cmd via `erc-send-input-line-function'") + + (ert-info ("Baseline") + (erc-process-input-line "hi") + (should (equal (pop erc-server-flood-queue) + '("PRIVMSG #chan :hi\r\n" . utf-8)))) + + (ert-info ("Spaces preserved") + (erc-process-input-line "hi you") + (should (equal (pop erc-server-flood-queue) + '("PRIVMSG #chan :hi you\r\n" . utf-8)))) + + (ert-info ("Empty line transmitted without injected-space kludge") + (erc-process-input-line "") + (should (equal (pop erc-server-flood-queue) + '("PRIVMSG #chan :\r\n" . utf-8)))) + + (should-not calls)))))) + ;;; erc-tests.el ends here diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 9be515ab176..0fe72f278dc 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -162,9 +162,7 @@ Return nil when any other file notification watch is still active." (defun file-notify--test-cleanup () "Cleanup after a test." - (file-notify-rm-watch file-notify--test-desc) - (file-notify-rm-watch file-notify--test-desc1) - (file-notify-rm-watch file-notify--test-desc2) + (file-notify-rm-all-watches) (ignore-errors (delete-file (file-newest-backup file-notify--test-tmpfile))) @@ -421,7 +419,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; This test is inspired by Bug#26126 and Bug#26127. (ert-deftest file-notify-test02-rm-watch () - "Check `file-notify-rm-watch'." + "Check `file-notify-rm-watch' and `file-notify-rm-all-watches'." (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -517,6 +515,31 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (file-notify--test-cleanup-p)))) ;; Cleanup. + (file-notify--test-cleanup)) + + (unwind-protect + ;; Check `file-notify-rm-all-watches'. + (progn + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 (file-notify--test-make-temp-name)) + (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (write-region "any text" nil file-notify--test-tmpfile1 nil 'no-message) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile '(change) #'ignore))) + (should + (setq file-notify--test-desc1 + (file-notify-add-watch + file-notify--test-tmpfile1 '(change) #'ignore))) + (file-notify-rm-all-watches) + (delete-file file-notify--test-tmpfile) + (delete-file file-notify--test-tmpfile1) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) + + ;; Cleanup. (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test02-rm-watch diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index b283a512a42..4b9d4e45164 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1551,6 +1551,14 @@ The door of all subtleties! (should-error (file-name-with-extension "Jack" ".")) (should-error (file-name-with-extension "/is/a/directory/" "css"))) +(ert-deftest files-tests-file-name-base () + (should (equal (file-name-base "") "")) + (should (equal (file-name-base "/foo/") "")) + (should (equal (file-name-base "/foo") "foo")) + (should (equal (file-name-base "/foo/bar") "bar")) + (should (equal (file-name-base "foo") "foo")) + (should (equal (file-name-base "foo/bar") "bar"))) + (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" (find-file (ert-resource-file "whatever.quux")) diff --git a/test/lisp/gnus/gnus-group-tests.el b/test/lisp/gnus/gnus-group-tests.el new file mode 100644 index 00000000000..ee1e01be4b2 --- /dev/null +++ b/test/lisp/gnus/gnus-group-tests.el @@ -0,0 +1,52 @@ +;;; gnus-group-tests.el --- Tests for gnus-group.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 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 'gnus-group) +(require 'ert) + +(ert-deftest gnus-short-group-name () + (map-apply + (lambda (input expected) + (should (string-equal (gnus-short-group-name input) expected))) + '(("nnimap+email@example.com:archives/2020/03" . "email@example:a/2/03") + ("nndiary+diary:birthdays" . "diary:birthdays") + ("nnimap+email@example.com:test" . "email@example:test") + ("nnimap+email@example.com:234" . "email@example:234") + + ;; This is a very aggressive shortening of the left hand side. + ("nnimap+email@banana.salesman.example.com:234" . "email@banana:234") + ("nntp+some.where.edu:soc.motss" . "some:s.motss") + ("nntp+news.gmane.org:gmane.emacs.gnus.general" . "news:g.e.g.general") + ("nntp+news.gnus.org:gmane.text.docbook.apps" . "news:g.t.d.apps") + + ;; nnimap groups. + ("nnimap+email@example.com:[Invoices]/Bananas" . "email@example:I/Bananas") + ("nnimap+email@banana.salesman.example.com:[Invoices]/Bananas" + . "email@banana:I/Bananas") + + ;; The "n" from "nnspool" is perhaps not optimal. + ("nnspool+alt.binaries.pictures.furniture" . "n.b.p.furniture")))) + +;;; gnus-group-tests.el ends here diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el index 90c3a34a5c0..1206a976f6e 100644 --- a/test/lisp/gnus/gnus-icalendar-tests.el +++ b/test/lisp/gnus/gnus-icalendar-tests.el @@ -216,7 +216,7 @@ 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 +ATTENDEE;CUTYPE=INDIVIDUAL;PARTSTAT=ACCEPTED;RSVP=TRUE ;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com CREATED:20200325T095723Z DESCRIPTION:Coffee talk diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 513a0c2daea..24a42290a3f 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -148,7 +148,7 @@ Return first line of the output of (describe-function-1 FUNC)." (ert-deftest help-fns-test-describe-keymap/value () (describe-keymap minibuffer-local-must-match-map) (with-current-buffer "*Help*" - (should (looking-at "^key")))) + (should (looking-at "\nKey")))) (ert-deftest help-fns-test-describe-keymap/not-keymap () (should-error (describe-keymap nil)) @@ -158,7 +158,7 @@ Return first line of the output of (describe-function-1 FUNC)." (let ((foobar minibuffer-local-must-match-map)) (describe-keymap foobar) (with-current-buffer "*Help*" - (should (looking-at "^key"))))) + (should (looking-at "\nKey"))))) (ert-deftest help-fns-test-describe-keymap/dynamically-bound-no-file () (setq help-fns-test--describe-keymap-foo minibuffer-local-must-match-map) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 871417da3d2..6bafd8e7ddc 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -91,15 +91,13 @@ (ert-deftest help-tests-substitute-command-keys/keymaps () (with-substitute-command-keys-test (test "\\{minibuffer-local-must-match-map}" - "\ -key binding ---- ------- + " +Key Binding C-g abort-minibuffers 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 @@ -110,11 +108,8 @@ C-<tab> file-cache-minibuffer-complete <prior> switch-to-completions <up> previous-line-or-history-element -M-g Prefix Command M-v switch-to-completions -M-g ESC Prefix Command - M-< minibuffer-beginning-of-buffer M-n next-history-element M-p previous-history-element @@ -122,7 +117,6 @@ M-r previous-matching-history-element M-s next-matching-history-element M-g M-c switch-to-completions - "))) (ert-deftest help-tests-substitute-command-keys/keymap-change () @@ -250,9 +244,8 @@ M-g M-c switch-to-completions (with-temp-buffer (help-tests-major-mode) (test "\\{help-tests-major-mode-map}" - "\ -key binding ---- ------- + " +Key Binding ( .. ) short-range 1 .. 4 foo-range @@ -261,7 +254,6 @@ a .. c foo-other-range C-e foo-something x foo-original <F1> foo-function-key1 - ")))) (ert-deftest help-tests-substitute-command-keys/shadow () @@ -270,9 +262,8 @@ x foo-original (help-tests-major-mode) (help-tests-minor-mode) (test "\\{help-tests-major-mode-map}" - "\ -key binding ---- ------- + " +Key Binding ( .. ) short-range 1 .. 4 foo-range @@ -283,7 +274,6 @@ C-e foo-something x foo-original (this binding is currently shadowed) <F1> foo-function-key1 - ")))) (ert-deftest help-tests-substitute-command-keys/command-remap () @@ -293,14 +283,10 @@ x foo-original (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 + " +Key Binding <remap> <foo> bar - "))))) (ert-deftest help-tests-describe-map-tree/no-menu-t () @@ -312,11 +298,10 @@ key binding :enable mark-active :help "Help text")))))) (describe-map-tree map nil nil nil nil t nil nil nil) - (should (equal (buffer-string) "key binding ---- ------- + (should (equal (buffer-string) " +Key Binding C-a foo - "))))) (ert-deftest help-tests-describe-map-tree/no-menu-nil () @@ -328,14 +313,12 @@ C-a 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 ---- ------- + (should (equal (buffer-string) " +Key Binding C-a foo -<menu-bar> Prefix Command - -<menu-bar> <foo> foo +<menu-bar> <foo> foo "))))) (ert-deftest help-tests-describe-map-tree/mention-shadow-t () @@ -345,13 +328,12 @@ C-a 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 ---- ------- + (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 () @@ -361,11 +343,10 @@ C-b bar (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 ---- ------- + (should (equal (buffer-string) " +Key Binding C-b bar - "))))) (ert-deftest help-tests-describe-map-tree/partial-t () @@ -374,11 +355,10 @@ C-b bar (map '(keymap . ((1 . foo) (2 . undefined))))) (describe-map-tree map t nil nil nil nil nil nil nil) - (should (equal (buffer-string) "key binding ---- ------- + (should (equal (buffer-string) " +Key Binding C-a foo - "))))) (ert-deftest help-tests-describe-map-tree/partial-nil () @@ -387,12 +367,11 @@ C-a foo (map '(keymap . ((1 . foo) (2 . undefined))))) (describe-map-tree map nil nil nil nil nil nil nil nil) - (should (equal (buffer-string) "key binding ---- ------- + (should (equal (buffer-string) " +Key Binding C-a foo C-b undefined - "))))) (defvar help-tests--was-in-buffer nil) diff --git a/test/lisp/image-dired-tests.el b/test/lisp/image-dired-tests.el new file mode 100644 index 00000000000..3f0304ee405 --- /dev/null +++ b/test/lisp/image-dired-tests.el @@ -0,0 +1,37 @@ +;;; image-dired-tests.el --- Tests for image-dired.el -*- lexical-binding: t -*- + +;; Copyright (C) 2021 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 'image-dired) + +(defun image-dired-test-image-file (name) + (expand-file-name + name (expand-file-name "data/image" + (or (getenv "EMACS_TEST_DIRECTORY") + "../")))) + +(ert-deftest image-dired-tests-get-exif-file-name () + (skip-unless (image-type-available-p 'jpeg)) + (let ((img (image-dired-test-image-file "black.jpg"))) + (should (equal (image-dired-get-exif-file-name img) + "2019_09_21_16_22_13_black.jpg")))) + +;;; image-dired-tests.el ends here diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index aa8600609c4..79b0014f60a 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -28,6 +28,27 @@ (expand-file-name "images" data-directory) "Directory containing Emacs images.") +(defconst image-tests--files + `((gif . ,(expand-file-name "test/data/image/black.gif" + source-directory)) + (jpeg . ,(expand-file-name "test/data/image/black.jpg" + source-directory)) + (pbm . ,(expand-file-name "splash.pbm" + image-tests--emacs-images-directory)) + (png . ,(expand-file-name "splash.png" + image-tests--emacs-images-directory)) + (svg . ,(expand-file-name "splash.svg" + image-tests--emacs-images-directory)) + (tiff . ,(expand-file-name + "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" + source-directory)) + (webp . ,(expand-file-name "test/data/image/black.webp" + source-directory)) + (xbm . ,(expand-file-name "gnus/gnus.xbm" + image-tests--emacs-images-directory)) + (xpm . ,(expand-file-name "splash.xpm" + image-tests--emacs-images-directory)))) + (ert-deftest image--set-property () "Test `image--set-property' behavior." (let ((image (list 'image))) @@ -49,12 +70,14 @@ (should (equal image '(image))))) (ert-deftest image-find-image () - (find-image '((:type xpm :file "undo.xpm"))) - (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center)))) + (should (listp (find-image '((:type xpm :file "undo.xpm"))))) + (should (listp (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center))))) + (should-not (find-image '((:type png :file "does-not-exist-foo-bar.png"))))) (ert-deftest image-type-from-file-name () (should (eq (image-type-from-file-name "foo.jpg") 'jpeg)) - (should (eq (image-type-from-file-name "foo.png") 'png))) + (should (eq (image-type-from-file-name "foo.png") 'png)) + (should (eq (image-type-from-file-name "foo.webp") 'webp))) (ert-deftest image-type/from-filename () ;; On emba, `image-types' and `image-load-path' do not exist. @@ -62,12 +85,37 @@ (bound-and-true-p image-load-path))) (should (eq (image-type "foo.jpg") 'jpeg))) -(ert-deftest image-type-from-file-header-test () +(defun image-tests--type-from-file-header (type) "Test image-type-from-file-header." - (should (eq (if (image-type-available-p 'svg) 'svg) - (image-type-from-file-header - (expand-file-name "splash.svg" - image-tests--emacs-images-directory))))) + (should (eq (if (image-type-available-p type) type) + (image-type-from-file-header (cdr (assq type image-tests--files)))))) + +(ert-deftest image-type-from-file-header-test/gif () + (image-tests--type-from-file-header 'gif)) + +(ert-deftest image-type-from-file-header-test/jpeg () + (image-tests--type-from-file-header 'jpeg)) + +(ert-deftest image-type-from-file-header-test/pbm () + (image-tests--type-from-file-header 'pbm)) + +(ert-deftest image-type-from-file-header-test/png () + (image-tests--type-from-file-header 'png)) + +(ert-deftest image-type-from-file-header-test/svg () + (image-tests--type-from-file-header 'svg)) + +(ert-deftest image-type-from-file-header-test/tiff () + (image-tests--type-from-file-header 'tiff)) + +(ert-deftest image-type-from-file-header-test/webp () + (image-tests--type-from-file-header 'webp)) + +(ert-deftest image-type-from-file-header-test/xbm () + (image-tests--type-from-file-header 'xbm)) + +(ert-deftest image-type-from-file-header-test/xpm () + (image-tests--type-from-file-header 'xpm)) (ert-deftest image-rotate () "Test `image-rotate'." diff --git a/test/lisp/image/exif-tests.el b/test/lisp/image/exif-tests.el index ddbee75467e..2357113f630 100644 --- a/test/lisp/image/exif-tests.el +++ b/test/lisp/image/exif-tests.el @@ -28,24 +28,19 @@ (or (getenv "EMACS_TEST_DIRECTORY") "../../")))) -(defun exif-elem (exif elem) - (plist-get (seq-find (lambda (e) - (eq elem (plist-get e :tag-name))) - exif) - :value)) - (ert-deftest test-exif-parse () (let ((exif (exif-parse-file (test-image-file "black.jpg")))) - (should (equal (exif-elem exif 'make) "Panasonic")) - (should (equal (exif-elem exif 'orientation) 1)) - (should (equal (exif-elem exif 'x-resolution) '(180 . 1))))) + (should (equal (exif-field 'make exif) "Panasonic")) + (should (equal (exif-field 'orientation exif) 1)) + (should (equal (exif-field 'x-resolution exif) '(180 . 1))) + (should (equal (exif-field 'date-time exif) "2019:09:21 16:22:13")))) (ert-deftest test-exif-parse-short () (let ((exif (exif-parse-file (test-image-file "black-short.jpg")))) - (should (equal (exif-elem exif 'make) "thr")) - (should (equal (exif-elem exif 'model) "four")) - (should (equal (exif-elem exif 'software) "em")) - (should (equal (exif-elem exif 'artist) "z")))) + (should (equal (exif-field 'make exif) "thr")) + (should (equal (exif-field 'model exif) "four")) + (should (equal (exif-field 'software exif) "em")) + (should (equal (exif-field 'artist exif) "z")))) (ert-deftest test-exit-direct-ascii-value () (should (equal (exif--direct-ascii-value 28005 2 t) (string ?e ?m 0))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 47ef46f8ec0..737e2209cc8 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -62,6 +62,7 @@ (declare-function tramp-list-tramp-buffers "tramp-cmds") (declare-function tramp-method-out-of-band-p "tramp-sh") (declare-function tramp-smb-get-localname "tramp-smb") +(declare-function dired-compress "dired-aux") (defvar ange-ftp-make-backup-files) (defvar auto-save-file-name-transforms) (defvar lock-file-name-transforms) @@ -7168,6 +7169,38 @@ Since it unloads Tramp, it shall be the last test to run." (ignore-errors (all-completions "tramp" (symbol-value x))) (ert-fail (format "Hook `%s' still contains Tramp function" x)))))) +(ert-deftest tramp-test44-dired-compress-file () + "Check that Tramp (un)compresses normal files." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (let ((default-directory tramp-test-temporary-file-directory) + (tmp-name (tramp--test-make-temp-name))) + (write-region "foo" nil tmp-name) + (dired default-directory) + (dired-revert) + (dired-goto-file tmp-name) + (should-not (dired-compress)) + (should (string= (concat tmp-name ".gz") (dired-get-filename))) + (should-not (dired-compress)) + (should (string= tmp-name (dired-get-filename))) + (delete-file tmp-name))) + +(ert-deftest tramp-test44-dired-compress-dir () + "Check that Tramp (un)compresses directories." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (let ((default-directory tramp-test-temporary-file-directory) + (tmp-name (tramp--test-make-temp-name))) + (make-directory tmp-name) + (dired default-directory) + (dired-revert) + (dired-goto-file tmp-name) + (should-not (dired-compress)) + (should (string= (concat tmp-name ".tar.gz") (dired-get-filename))) + (should-not (dired-compress)) + (should (string= tmp-name (dired-get-filename))) + (delete-directory tmp-name))) + (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]. If INTERACTIVE is non-nil, the tests are run interactively." diff --git a/test/lisp/paren-tests.el b/test/lisp/paren-tests.el index c4bec5d86de..11249ee9bc1 100644 --- a/test/lisp/paren-tests.el +++ b/test/lisp/paren-tests.el @@ -117,5 +117,36 @@ (- (point-max) 1) (point-max) nil))))) +(ert-deftest paren-tests-open-paren-line () + (cl-flet ((open-paren-line () + (let* ((data (show-paren--default)) + (here-beg (nth 0 data)) + (there-beg (nth 2 data))) + (blink-paren-open-paren-line-string + (min here-beg there-beg))))) + ;; Lisp-like + (with-temp-buffer + (insert "(defun foo () + (dummy))") + (goto-char (point-max)) + (should (string= "(defun foo ()" (open-paren-line)))) + + ;; C-like + (with-temp-buffer + (insert "int foo() { + int blah; + }") + (goto-char (point-max)) + (should (string= "int foo() {" (open-paren-line)))) + + ;; C-like with hanging { + (with-temp-buffer + (insert "int foo() + { + int blah; + }") + (goto-char (point-max)) + (should (string= "int foo()...{" (open-paren-line)))))) + (provide 'paren-tests) ;;; paren-tests.el ends here diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el new file mode 100644 index 00000000000..7a3ab5fbda0 --- /dev/null +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -0,0 +1,128 @@ +;;; bug-reference-tests.el --- Tests for bug-reference.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 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 'bug-reference) +(require 'ert) + +(defun test--get-github-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "github.com" 'github "https")) + url) + (match-string 1 url))) + +(defun test--get-gitlab-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitlab.com" 'gitlab "https")) + url) + (match-string 1 url))) + +(defun test--get-gitea-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitea.com" 'gitea "https")) + url) + (match-string 1 url))) + +(ert-deftest test-github-entry () + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit/") + "magit/magit"))) + +(ert-deftest test-gitlab-entry () + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit/") + "magit/magit"))) + +(ert-deftest test-gitea-entry () + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit/") + "magit/magit"))) + +;;; bug-reference-tests.el ends here diff --git a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts new file mode 100644 index 00000000000..2c0d51edae8 --- /dev/null +++ b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts @@ -0,0 +1,88 @@ +Code: + (lambda () + (emacs-lisp-mode) + (indent-region (point-min) (point-max))) + +Name: defun + +=-= +(defun foo () +"doc" +(+ 1 2)) +=-= +(defun foo () + "doc" + (+ 1 2)) +=-=-= + +Name: function call + +=-= +(foo zot +bar +(zot bar)) +=-= +(foo zot + bar + (zot bar)) +=-=-= + +Name: lisp data + +=-= +( foo zot +bar +(zot bar)) +=-= +( foo zot + bar + (zot bar)) +=-=-= + +Name: defun-space + +=-= +(defun x () + (print (quote ( thingy great + stuff))) + (print (quote (thingy great + stuff)))) +=-=-= + +Name: defvar-keymap + +=-= +(defvar-keymap eww-link-keymap + :copy shr-map + :foo bar + "\r" #'eww-follow-link) +=-=-= + +Name: def-indent1 + +=-= +(defzot-does-not-exist 1 + 2 3) +=-=-= + +Name: def-indent2 + +=-= +(define-keymap 1 + 2 3) +=-=-= + +Name: elisp-indents1 + +=-= +(defvar foo + () + "bar") +=-=-= + +Name: elisp-indents2 + +=-= +(defvar foo () + "bar") +=-=-= diff --git a/test/lisp/progmodes/elisp-mode-resources/flet.erts b/test/lisp/progmodes/elisp-mode-resources/flet.erts new file mode 100644 index 00000000000..7c4a0f304e9 --- /dev/null +++ b/test/lisp/progmodes/elisp-mode-resources/flet.erts @@ -0,0 +1,343 @@ +Name: flet1 + +=-= +(cl-flet () + (a (dangerous-position + b))) +=-=-= + +Name: flet2 + +=-= +(cl-flet wrong-syntax-but-should-not-obstruct-indentation + (a (dangerous-position + b))) +=-=-= + +Name: flet3 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c))) +=-=-= + +Name: flet4 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet5 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet6 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (irregular-local-def (form returning + lambda)) + wrong-syntax-but-should-not-osbtruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet7 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + wrong-syntax-but-should-not-osbtruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet8 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +;; (setf _) not yet supported but looks like it will be +Name: flet9 + +=-= +(cl-flet (((setf a) (new value) + stuff) + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet10 + +=-= +(cl-flet ( (a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet11 + +=-= +(cl-flet ( wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet12 + +=-= +(cl-flet ( wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet13 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i) + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i))) +=-=-= + +Name: flet14 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i) + wrong-syntax-but-should-not-obstruct-indentation)) +=-=-= + +Name: flet15 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + wrong-syntax-but-should-not-obstruct-indentation + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i))) +=-=-= + +Name: flet-indentation-incomplete-sexp-no-side-effects-1 +Code: (lambda () (emacs-lisp-mode) (setq indent-tabs-mode nil) (newline nil t)) +Point-Char: | + +=-= +(let ((x (and y| +=-= +(let ((x (and y + | +=-=-= + +Name: flet-indentation-incomplete-sexp-no-side-effects-2 + +=-= +(let ((x| +=-= +(let ((x + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-1 +Point-Char: | + +=-= +(cl-flet((f (x)| +=-= +(cl-flet((f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-2 +Point-Char: | + +=-= +(cl-flet((f(x)| +=-= +(cl-flet((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-3 + +=-= +(cl-flet ((f(x)| +=-= +(cl-flet ((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-4 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-5 + +=-= +(cl-flet( (f(x)| +=-= +(cl-flet( (f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-1 + +=-= +(cl-flet((f (x)| +=-= +(cl-flet((f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-2 + +=-= +(cl-flet ((f(x)| +=-= +(cl-flet ((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-3 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-4 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-5 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-6 + +=-= +(cl-flet( (f(x)| +=-= +(cl-flet( (f(x) + | +=-=-= diff --git a/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el b/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el index 14c8e845d11..9b41fb5426c 100644 --- a/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el +++ b/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el @@ -1,3 +1,5 @@ +;;; simple-shorthand-test.el --- -*- lexical-binding: t; -*- + (defun f-test () (let ((read-symbol-shorthands '(("foo-" . "bar-")))) (with-temp-buffer diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index f887bb1dca5..9516687f5b0 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -26,6 +26,7 @@ (require 'ert-x) (require 'xref) (eval-when-compile (require 'cl-lib)) +(require 'ert-x) ;;; Completion @@ -781,11 +782,11 @@ to (xref-elisp-test-descr-to-target xref)." )) (xref-elisp-deftest find-defs-defvar-el - (elisp--xref-find-definitions 'xref--marker-ring) + (elisp--xref-find-definitions 'xref--history) (list - (xref-make "(defvar xref--marker-ring)" + (xref-make "(defvar xref--history)" (xref-make-elisp-location - 'xref--marker-ring 'defvar + 'xref--history 'defvar (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) )) @@ -841,18 +842,6 @@ 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))))) - (defun test--font (form search) (with-temp-buffer (emacs-lisp-mode) @@ -1115,17 +1104,12 @@ evaluation of BODY." (buffer-string))))))) (should (equal observed expected-longhand-form)))) -(ert-deftest test-cl-flet-indentation () - :expected-result :failed ; FIXME: bug#9622 - (should (equal - (with-temp-buffer - (emacs-lisp-mode) - (insert "(cl-flet ((bla (x)\n(* x x)))\n(bla 42))") - (indent-region (point-min) (point-max)) - (buffer-string)) - "(cl-flet ((bla (x) - (* x x))) - (bla 42))"))) +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "elisp-indents.erts")) + (ert-test-erts-file (ert-resource-file "flet.erts") + (lambda () + (emacs-lisp-mode) + (indent-region (point-min) (point-max))))) (provide 'elisp-mode-tests) ;;; elisp-mode-tests.el ends here diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 99b79b61d65..aed82b18825 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -416,6 +416,16 @@ The ACTION will be tested after set-up of PRODUCT." (kill-buffer "*SQL: exist*"))) +(ert-deftest sql-tests-comint-automatic-password () + (let ((sql-password nil)) + (should-not (sql-comint-automatic-password "Password: "))) + (let ((sql-password "")) + (should-not (sql-comint-automatic-password "Password: "))) + (let ((sql-password "password")) + (should (equal "password" (sql-comint-automatic-password "Password: ")))) + ;; Also, we shouldn't care what the password is - we rely on comint for that. + (let ((sql-password "password")) + (should (equal "password" (sql-comint-automatic-password ""))))) (provide 'sql-tests) ;;; sql-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 0da1ae96873..238c9be1ab0 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -84,16 +84,237 @@ ;;;; Keymap support. (ert-deftest subr-test-kbd () + (should (equal (kbd "") "")) (should (equal (kbd "f") "f")) + (should (equal (kbd "X") "X")) + (should (equal (kbd "foobar") "foobar")) ; 6 characters + (should (equal (kbd "return") "return")) ; 6 characters + + (should (equal (kbd "<F2>") [F2])) + (should (equal (kbd "<f1> <f2> TAB") [f1 f2 ?\t])) + (should (equal (kbd "<f1> RET") [f1 ?\r])) + (should (equal (kbd "<f1> SPC") [f1 ? ])) (should (equal (kbd "<f1>") [f1])) - (should (equal (kbd "RET") "\C-m")) + (should (equal (kbd "<f1>") [f1])) + (should (equal (kbd "[f1]") "[f1]")) + (should (equal (kbd "<return>") [return])) + (should (equal (kbd "< right >") "<right>")) ; 7 characters + + ;; Modifiers: + (should (equal (kbd "C-x") "\C-x")) (should (equal (kbd "C-x a") "\C-xa")) - ;; Check that kbd handles both new and old style key descriptions - ;; (bug#45536). + (should (equal (kbd "C-;") [?\C-\;])) + (should (equal (kbd "C-a") "\C-a")) + (should (equal (kbd "C-c SPC") "\C-c ")) + (should (equal (kbd "C-c TAB") "\C-c\t")) + (should (equal (kbd "C-c c") "\C-cc")) + (should (equal (kbd "C-x 4 C-f") "\C-x4\C-f")) + (should (equal (kbd "C-x C-f") "\C-x\C-f")) + (should (equal (kbd "C-M-<down>") [C-M-down])) + (should (equal (kbd "<C-M-down>") [C-M-down])) + (should (equal (kbd "C-RET") [?\C-\C-m])) + (should (equal (kbd "C-SPC") [?\C- ])) + (should (equal (kbd "C-TAB") [?\C-\t])) + (should (equal (kbd "C-<down>") [C-down])) + (should (equal (kbd "C-c C-c C-c") "\C-c\C-c\C-c")) + + (should (equal (kbd "M-a") [?\M-a])) + (should (equal (kbd "M-<DEL>") [?\M-\d])) + (should (equal (kbd "M-C-a") [?\M-\C-a])) + (should (equal (kbd "M-ESC") [?\M-\e])) + (should (equal (kbd "M-RET") [?\M-\r])) + (should (equal (kbd "M-SPC") [?\M- ])) + (should (equal (kbd "M-TAB") [?\M-\t])) + (should (equal (kbd "M-x a") [?\M-x ?a])) + (should (equal (kbd "M-<up>") [M-up])) + (should (equal (kbd "M-c M-c M-c") [?\M-c ?\M-c ?\M-c])) + + (should (equal (kbd "s-SPC") [?\s- ])) + (should (equal (kbd "s-a") [?\s-a])) + (should (equal (kbd "s-x a") [?\s-x ?a])) + (should (equal (kbd "s-c s-c s-c") [?\s-c ?\s-c ?\s-c])) + + (should (equal (kbd "S-H-a") [?\S-\H-a])) + (should (equal (kbd "S-a") [?\S-a])) + (should (equal (kbd "S-x a") [?\S-x ?a])) + (should (equal (kbd "S-c S-c S-c") [?\S-c ?\S-c ?\S-c])) + + (should (equal (kbd "H-<RET>") [?\H-\r])) + (should (equal (kbd "H-DEL") [?\H-\d])) + (should (equal (kbd "H-a") [?\H-a])) + (should (equal (kbd "H-x a") [?\H-x ?a])) + (should (equal (kbd "H-c H-c H-c") [?\H-c ?\H-c ?\H-c])) + + (should (equal (kbd "A-H-a") [?\A-\H-a])) + (should (equal (kbd "A-SPC") [?\A- ])) + (should (equal (kbd "A-TAB") [?\A-\t])) + (should (equal (kbd "A-a") [?\A-a])) + (should (equal (kbd "A-c A-c A-c") [?\A-c ?\A-c ?\A-c])) + + (should (equal (kbd "C-M-a") [?\C-\M-a])) + (should (equal (kbd "C-M-<up>") [C-M-up])) + + ;; Special characters. + (should (equal (kbd "DEL") "\d")) + (should (equal (kbd "ESC C-a") "\e\C-a")) + (should (equal (kbd "ESC") "\e")) + (should (equal (kbd "LFD") "\n")) + (should (equal (kbd "NUL") "\0")) + (should (equal (kbd "RET") "\C-m")) + (should (equal (kbd "SPC") "\s")) + (should (equal (kbd "TAB") "\t")) + (should (equal (kbd "\^i") "")) + (should (equal (kbd "^M") "\^M")) + + ;; With numbers. + (should (equal (kbd "\177") "\^?")) + (should (equal (kbd "\000") "\0")) + (should (equal (kbd "\\177") "\^?")) + (should (equal (kbd "\\000") "\0")) + (should (equal (kbd "C-x \\150") "\C-xh")) + + ;; Multibyte + (should (equal (kbd "ñ") [?ñ])) + (should (equal (kbd "ü") [?ü])) + (should (equal (kbd "ö") [?ö])) + (should (equal (kbd "ğ") [?ğ])) + (should (equal (kbd "ա") [?ա])) + (should (equal (kbd "üüöö") [?ü ?ü ?ö ?ö])) + (should (equal (kbd "C-ü") [?\C-ü])) + (should (equal (kbd "M-ü") [?\M-ü])) + (should (equal (kbd "H-ü") [?\H-ü])) + + ;; Handle both new and old style key descriptions (bug#45536). (should (equal (kbd "s-<return>") [s-return])) (should (equal (kbd "<s-return>") [s-return])) (should (equal (kbd "C-M-<return>") [C-M-return])) - (should (equal (kbd "<C-M-return>") [C-M-return]))) + (should (equal (kbd "<C-M-return>") [C-M-return])) + + ;; Error. + (should-error (kbd "C-xx")) + (should-error (kbd "M-xx")) + (should-error (kbd "M-x<TAB>")) + + ;; These should be equivalent: + (should (equal (kbd "\C-xf") (kbd "C-x f")))) + +(ert-deftest subr-test-kbd-valid-p () + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "f")) + (should (kbd-valid-p "X")) + (should (not (kbd-valid-p " X"))) + (should (kbd-valid-p "X f")) + (should (not (kbd-valid-p "a b"))) + (should (not (kbd-valid-p "foobar"))) + (should (not (kbd-valid-p "return"))) + + (should (kbd-valid-p "<F2>")) + (should (kbd-valid-p "<f1> <f2> TAB")) + (should (kbd-valid-p "<f1> RET")) + (should (kbd-valid-p "<f1> SPC")) + (should (kbd-valid-p "<f1>")) + (should (not (kbd-valid-p "[f1]"))) + (should (kbd-valid-p "<return>")) + (should (not (kbd-valid-p "< right >"))) + + ;; Modifiers: + (should (kbd-valid-p "C-x")) + (should (kbd-valid-p "C-x a")) + (should (kbd-valid-p "C-;")) + (should (kbd-valid-p "C-a")) + (should (kbd-valid-p "C-c SPC")) + (should (kbd-valid-p "C-c TAB")) + (should (kbd-valid-p "C-c c")) + (should (kbd-valid-p "C-x 4 C-f")) + (should (kbd-valid-p "C-x C-f")) + (should (kbd-valid-p "C-M-<down>")) + (should (not (kbd-valid-p "<C-M-down>"))) + (should (kbd-valid-p "C-RET")) + (should (kbd-valid-p "C-SPC")) + (should (kbd-valid-p "C-TAB")) + (should (kbd-valid-p "C-<down>")) + (should (kbd-valid-p "C-c C-c C-c")) + + (should (kbd-valid-p "M-a")) + (should (kbd-valid-p "M-<DEL>")) + (should (not (kbd-valid-p "M-C-a"))) + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "M-ESC")) + (should (kbd-valid-p "M-RET")) + (should (kbd-valid-p "M-SPC")) + (should (kbd-valid-p "M-TAB")) + (should (kbd-valid-p "M-x a")) + (should (kbd-valid-p "M-<up>")) + (should (kbd-valid-p "M-c M-c M-c")) + + (should (kbd-valid-p "s-SPC")) + (should (kbd-valid-p "s-a")) + (should (kbd-valid-p "s-x a")) + (should (kbd-valid-p "s-c s-c s-c")) + + (should (not (kbd-valid-p "S-H-a"))) + (should (kbd-valid-p "S-a")) + (should (kbd-valid-p "S-x a")) + (should (kbd-valid-p "S-c S-c S-c")) + + (should (kbd-valid-p "H-<RET>")) + (should (kbd-valid-p "H-DEL")) + (should (kbd-valid-p "H-a")) + (should (kbd-valid-p "H-x a")) + (should (kbd-valid-p "H-c H-c H-c")) + + (should (kbd-valid-p "A-H-a")) + (should (kbd-valid-p "A-SPC")) + (should (kbd-valid-p "A-TAB")) + (should (kbd-valid-p "A-a")) + (should (kbd-valid-p "A-c A-c A-c")) + + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "C-M-<up>")) + + ;; Special characters. + (should (kbd-valid-p "DEL")) + (should (kbd-valid-p "ESC C-a")) + (should (kbd-valid-p "ESC")) + (should (kbd-valid-p "LFD")) + (should (kbd-valid-p "NUL")) + (should (kbd-valid-p "RET")) + (should (kbd-valid-p "SPC")) + (should (kbd-valid-p "TAB")) + (should (not (kbd-valid-p "\^i"))) + (should (not (kbd-valid-p "^M"))) + + ;; With numbers. + (should (not (kbd-valid-p "\177"))) + (should (not (kbd-valid-p "\000"))) + (should (not (kbd-valid-p "\\177"))) + (should (not (kbd-valid-p "\\000"))) + (should (not (kbd-valid-p "C-x \\150"))) + + ;; Multibyte + (should (kbd-valid-p "ñ")) + (should (kbd-valid-p "ü")) + (should (kbd-valid-p "ö")) + (should (kbd-valid-p "ğ")) + (should (kbd-valid-p "ա")) + (should (not (kbd-valid-p "üüöö"))) + (should (kbd-valid-p "C-ü")) + (should (kbd-valid-p "M-ü")) + (should (kbd-valid-p "H-ü")) + + ;; Handle both new and old style key descriptions (bug#45536). + (should (kbd-valid-p "s-<return>")) + (should (not (kbd-valid-p "<s-return>"))) + (should (kbd-valid-p "C-M-<return>")) + (should (not (kbd-valid-p "<C-M-return>"))) + + (should (kbd-valid-p "<mouse-1>")) + (should (kbd-valid-p "<Scroll_Lock>")) + + (should (not (kbd-valid-p "c-x"))) + (should (not (kbd-valid-p "C-xx"))) + (should (not (kbd-valid-p "M-xx"))) + (should (not (kbd-valid-p "M-x<TAB>")))) (ert-deftest subr-test-define-prefix-command () (define-prefix-command 'foo-prefix-map) @@ -776,7 +997,8 @@ mode runs the hook ‘foo-bar-baz-very-long-name-indeed-mode-hook’, as the fin or penultimate step during initialization.")) "In addition to any hooks its parent mode might have run, this mode runs the hook ‘foo-bar-baz-very-long-name-indeed-mode-hook’, as the -final or penultimate step during initialization."))) +final or penultimate step during initialization.")) + (should-error (internal--format-docstring-line "foo\nbar"))) (ert-deftest test-ensure-list () (should (equal (ensure-list nil) nil)) diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el index 96b6d734882..73d39cf3b66 100644 --- a/test/lisp/term-tests.el +++ b/test/lisp/term-tests.el @@ -42,36 +42,50 @@ `( :foreground "unspecified-fg" :background ,(face-background 'term-color-bright-yellow nil 'default) :inverse-video nil)) +(defvar custom-color-fg-props + `( :foreground "#87FFFF" + :background "unspecified-bg" :inverse-video nil)) (defvar ansi-test-strings `(("\e[33mHello World\e[0m" - ,(propertize "Hello World" 'font-lock-face yellow-fg-props)) + ,(propertize "Hello World" 'font-lock-face `(,yellow-fg-props))) ("\e[43mHello World\e[0m" - ,(propertize "Hello World" 'font-lock-face yellow-bg-props)) + ,(propertize "Hello World" 'font-lock-face `(,yellow-bg-props))) ("\e[93mHello World\e[0m" - ,(propertize "Hello World" 'font-lock-face bright-yellow-fg-props)) + ,(propertize "Hello World" 'font-lock-face `(,bright-yellow-fg-props))) ("\e[103mHello World\e[0m" - ,(propertize "Hello World" 'font-lock-face bright-yellow-bg-props)) + ,(propertize "Hello World" 'font-lock-face `(,bright-yellow-bg-props))) ("\e[1;33mHello World\e[0m" ,(propertize "Hello World" 'font-lock-face - `(,yellow-fg-props :inherit term-bold)) + `(,yellow-fg-props term-bold)) ,(propertize "Hello World" 'font-lock-face - `(,bright-yellow-fg-props :inherit term-bold))) + `(,bright-yellow-fg-props term-bold))) ("\e[33;1mHello World\e[0m" ,(propertize "Hello World" 'font-lock-face - `(,yellow-fg-props :inherit term-bold)) + `(,yellow-fg-props term-bold)) ,(propertize "Hello World" 'font-lock-face - `(,bright-yellow-fg-props :inherit term-bold))) + `(,bright-yellow-fg-props term-bold))) ("\e[1m\e[33mHello World\e[0m" ,(propertize "Hello World" 'font-lock-face - `(,yellow-fg-props :inherit term-bold)) + `(,yellow-fg-props term-bold)) ,(propertize "Hello World" 'font-lock-face - `(,bright-yellow-fg-props :inherit term-bold))) + `(,bright-yellow-fg-props term-bold))) ("\e[33m\e[1mHello World\e[0m" ,(propertize "Hello World" 'font-lock-face - `(,yellow-fg-props :inherit term-bold)) + `(,yellow-fg-props term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props term-bold))) + ("\e[38;5;3;1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props term-bold))) + ("\e[38;5;123;1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,custom-color-fg-props term-bold))) + ("\e[38;2;135;255;255;1mHello World\e[0m" ,(propertize "Hello World" 'font-lock-face - `(,bright-yellow-fg-props :inherit term-bold))))) + `(,custom-color-fg-props term-bold))))) (defun term-test-screen-from-input (width height input &optional return-var) (with-temp-buffer diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el index fcc2c757091..2a1195b87ea 100644 --- a/test/lisp/textmodes/fill-tests.el +++ b/test/lisp/textmodes/fill-tests.el @@ -76,6 +76,28 @@ (buffer-string) "aaa = baaaaaaaa aaaaaaaaaa\n aaaaaaaaaa\n"))))) +(ert-deftest test-fill-end-period () + (should + (equal + (with-temp-buffer + (text-mode) + (auto-fill-mode) + (insert "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eius.") + (self-insert-command 1 ?\s) + (buffer-string)) + "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eius. ")) + (should + (equal + (with-temp-buffer + (text-mode) + (auto-fill-mode) + (insert "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eius.Foo") + (forward-char -3) + (self-insert-command 1 ?\s) + (buffer-string)) + "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do +eius. Foo"))) + (provide 'fill-tests) ;;; fill-tests.el ends here diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el index 9fa54dcaf43..dbbe9f30925 100644 --- a/test/src/casefiddle-tests.el +++ b/test/src/casefiddle-tests.el @@ -278,4 +278,20 @@ (with-temp-buffer (should-error (upcase-region nil nil t))))) +(ert-deftest casefiddle-turkish () + (skip-unless (member "tr_TR.utf8" (get-locale-names))) + ;; See bug#50752. The point is that unibyte and multibyte strings + ;; are upcased differently in the "dotless i" case in Turkish, + ;; turning ASCII into non-ASCII, which is very unusual. + (with-locale-environment "tr_TR.utf8" + (should (string-equal (downcase "I ı") "ı ı")) + (should (string-equal (downcase "İ i") "i̇ i")) + (should (string-equal (downcase "I") "i")) + (should (string-equal (capitalize "bIte") "Bite")) + (should (string-equal (capitalize "bIté") "Bıté")) + (should (string-equal (capitalize "indIa") "India")) + ;; This does not work -- it produces "Indıa". + ;;(should (string-equal (capitalize "indIá") "İndıa")) + )) + ;;; casefiddle-tests.el ends here diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index a731a95ccf0..e83dd7c857b 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -23,16 +23,16 @@ (ert-deftest format-properties () ;; Bug #23730 - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%d" 'face '(:background "red")) 1) #("1" 0 1 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%2d" 'face '(:background "red")) 1) #(" 1" 0 2 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%02d" 'face '(:background "red")) 1) #("01" 0 2 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat (propertize "%2d" 'x 'X) (propertize "a" 'a 'A) (propertize "b" 'b 'B)) @@ -40,27 +40,27 @@ #(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B)))) ;; Bug #5306 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%.10s" (concat "1234567890aaaa" (propertize "12345678901234567890" 'xxx 25))) "1234567890")) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%.10s" (concat "123456789" (propertize "12345678901234567890" 'xxx 25))) #("1234567891" 9 10 (xxx 25)))) ;; Bug #23859 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%4s" (propertize "hi" 'face 'bold)) #(" hi" 2 4 (face bold)))) ;; Bug #23897 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%s" (concat (propertize "01234" 'face 'bold) "56789")) #("0123456789" 0 5 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) @@ -68,63 +68,63 @@ ;; The last property range is extended to include padding on the ;; right, but the first range is not extended to the left to include ;; padding on the left! - (should (ert-equal-including-properties + (should (equal-including-properties (format "%12s" (concat (propertize "01234" 'face 'bold) "56789")) #(" 0123456789" 2 7 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-12s" (concat (propertize "01234" 'face 'bold) "56789")) #("0123456789 " 0 5 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) #(" 012345" 4 6 (face bold) 6 8 (face underline)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) #("012345 " 0 2 (face bold) 2 4 (face underline)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) (propertize "45" 'face 'italic))) #("012345 " 0 2 (face bold) 2 4 (face underline) 4 10 (face italic)))) ;; Bug #38191 - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "‘foo’ %s bar" 'face 'bold) "xxx") #("‘foo’ xxx bar" 0 13 (face bold)))) ;; Bug #32404 - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat (propertize "%s" 'face 'bold) "" (propertize "%s" 'face 'error)) "foo" "bar") #("foobar" 0 3 (face bold) 3 6 (face error)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%s" (propertize "%s" 'face 'error)) "foo" "bar") #("foobar" 3 6 (face error)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar") #("foo bar" 4 7 (face error)))) ;; Bug #46317 (let ((s (propertize "X" 'prop "val"))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3s/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3S/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3d/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3s/" s) 12) #("12 /X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3S/" s) 12) #("12 /X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3d/" s) 12) #("12 /X" 4 5 (prop "val")))))) diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 646c7bb2705..9765bb109f6 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -32,6 +32,11 @@ (require 'help-fns) (require 'subr-x) +;; Catch information for bug#50902. +(when (getenv "EMACS_EMBA_CI") + (start-process-shell-command + "*timeout*" nil (format "sleep 60; kill -ABRT %d" (emacs-pid)))) + (defconst mod-test-emacs (expand-file-name invocation-name invocation-directory) "File name of the Emacs binary currently running.") diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 47fa1941626..a066d2e15e2 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -21,6 +21,68 @@ (require 'ert) +(ert-deftest floatfns-tests-cos () + (should (= (cos 0) 1.0)) + (should (= (cos float-pi) -1.0))) + +(ert-deftest floatfns-tests-sin () + (should (= (sin 0) 0.0))) + +(ert-deftest floatfns-tests-tan () + (should (= (tan 0) 0.0))) + +(ert-deftest floatfns-tests-isnan () + (should (isnan 0.0e+NaN)) + (should (isnan -0.0e+NaN)) + (should-error (isnan "foo") :type 'wrong-type-argument)) + +(ert-deftest floatfns-tests-exp () + (should (= (exp 0) 1.0))) + +(ert-deftest floatfns-tests-expt () + (should (= (expt 2 8) 256))) + +(ert-deftest floatfns-tests-log () + (should (= (log 1000 10) 3.0))) + +(ert-deftest floatfns-tests-sqrt () + (should (= (sqrt 25) 5))) + +(ert-deftest floatfns-tests-abs () + (should (= (abs 10) 10)) + (should (= (abs -10) 10))) + +(ert-deftest floatfns-tests-logb () + (should (= (logb 10000) 13))) + +(ert-deftest floatfns-tests-ceiling () + (should (= (ceiling 0.5) 1))) + +(ert-deftest floatfns-tests-floor () + (should (= (floor 1.5) 1))) + +(ert-deftest floatfns-tests-round () + (should (= (round 1.49999999999) 1)) + (should (= (round 1.50000000000) 2)) + (should (= (round 1.50000000001) 2))) + +(ert-deftest floatfns-tests-truncate () + (should (= (truncate float-pi) 3))) + +(ert-deftest floatfns-tests-fceiling () + (should (= (fceiling 0.5) 1.0))) + +(ert-deftest floatfns-tests-ffloor () + (should (= (ffloor 1.5) 1.0))) + +(ert-deftest floatfns-tests-fround () + (should (= (fround 1.49999999999) 1.0)) + (should (= (fround 1.50000000000) 2.0)) + (should (= (fround 1.50000000001) 2.0))) + +(ert-deftest floatfns-tests-ftruncate () + (should (= (ftruncate float-pi) 3.0))) + (ert-deftest divide-extreme-sign () (should (= (ceiling most-negative-fixnum -1.0) (- most-negative-fixnum))) (should (= (floor most-negative-fixnum -1.0) (- most-negative-fixnum))) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 57594572094..bec5c03f9e7 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -23,6 +23,29 @@ (require 'cl-lib) +(ert-deftest fns-tests-identity () + (let ((num 12345)) (should (eq (identity num) num))) + (let ((str "foo")) (should (eq (identity str) str))) + (let ((lst '(11))) (should (eq (identity lst) lst)))) + +(ert-deftest fns-tests-random () + (should (integerp (random))) + (should (>= (random 10) 0)) + (should (< (random 10) 10))) + +(ert-deftest fns-tests-length () + (should (= (length nil) 0)) + (should (= (length '(1 2 3)) 3)) + (should (= (length '[1 2 3]) 3)) + (should (= (length "foo") 3)) + (should-error (length t))) + +(ert-deftest fns-tests-safe-length () + (should (= (safe-length '(1 2 3)) 3))) + +(ert-deftest fns-tests-string-bytes () + (should (= (string-bytes "abc") 3))) + ;; Test that equality predicates work correctly on NaNs when combined ;; with hash tables based on those predicates. This was not the case ;; for eql in Emacs 26. @@ -34,6 +57,33 @@ (puthash nan t h) (should (eq (funcall test nan -nan) (gethash -nan h)))))) +(ert-deftest fns-tests-equal-including-properties () + (should (equal-including-properties "" "")) + (should (equal-including-properties "foo" "foo")) + (should (equal-including-properties #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should (equal-including-properties #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should (equal-including-properties #("a" 0 1 (k v)) + #("a" 0 1 (k v)))) + (should-not (equal-including-properties #("a" 0 1 (k v)) + #("a" 0 1 (k x)))) + (should-not (equal-including-properties #("a" 0 1 (k v)) + #("b" 0 1 (k v)))) + (should-not (equal-including-properties #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd)))) + +(ert-deftest fns-tests-equal-including-properties/string-prop-vals () + "Handle string property values. (Bug#6581)" + (should (equal-including-properties #("a" 0 1 (k "v")) + #("a" 0 1 (k "v")))) + (should (equal-including-properties #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + (should-not (equal-including-properties #("a" 0 1 (k "v")) + #("a" 0 1 (k "x")))) + (should-not (equal-including-properties #("a" 0 1 (k "v")) + #("b" 0 1 (k "v"))))) + (ert-deftest fns-tests-reverse () (should-error (reverse)) (should-error (reverse 1)) @@ -430,6 +480,23 @@ (buffer-hash)) (sha1 "foo")))) +(ert-deftest fns-tests-mapconcat () + (should (string= (mapconcat #'identity '()) "")) + (should (string= (mapconcat #'identity '("a" "b")) "ab")) + (should (string= (mapconcat #'identity '() "_") "")) + (should (string= (mapconcat #'identity '("A") "_") "A")) + (should (string= (mapconcat #'identity '("A" "B") "_") "A_B")) + (should (string= (mapconcat #'identity '("A" "B" "C") "_") "A_B_C")) + ;; non-ASCII strings + (should (string= (mapconcat #'identity '("Ä" "ø" "☭" "தமிழ்") "_漢字_") + "Ä_漢字_ø_漢字_☭_漢字_தமிழ்")) + ;; vector + (should (string= (mapconcat #'identity ["a" "b"] "") "ab")) + ;; bool-vector + (should (string= (mapconcat #'identity [nil nil] "") "")) + (should-error (mapconcat #'identity [nil nil t]) + :type 'wrong-type-argument)) + (ert-deftest fns-tests-mapcan () (should-error (mapcan)) (should-error (mapcan #'identity)) diff --git a/test/src/image-tests.el b/test/src/image-tests.el new file mode 100644 index 00000000000..2b236086b6f --- /dev/null +++ b/test/src/image-tests.el @@ -0,0 +1,245 @@ +;;; image-tests.el --- Tests for image.c -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Stefan Kangas <stefan@marxist.se> + +;; 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: + +;; Most of these tests will only run in a GUI session, and not with +;; "make check". Run them manually in an interactive session with +;; `M-x eval-buffer' followed by `M-x ert'. + +;;; Code: + +(require 'ert) + +(defmacro image-skip-unless (format) + `(skip-unless (and (display-images-p) + (image-type-available-p ,format)))) + +;;;; Images + +(defconst image-tests--images + `((gif . ,(expand-file-name "test/data/image/black.gif" + source-directory)) + (jpeg . ,(expand-file-name "test/data/image/black.jpg" + source-directory)) + (pbm . ,(find-image '((:file "splash.svg" :type svg)))) + (png . ,(find-image '((:file "splash.png" :type png)))) + (svg . ,(find-image '((:file "splash.pbm" :type pbm)))) + (tiff . ,(expand-file-name + "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" + source-directory)) + (webp . ,(expand-file-name "test/data/image/black.webp" + source-directory)) + (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm)))) + (xpm . ,(find-image '((:file "splash.xpm" :type xpm)))))) + +;;;; image-test-size + +(ert-deftest image-tests-image-size/gif () + (image-skip-unless 'gif) + (pcase (image-size (create-image (cdr (assq 'gif image-tests--images)))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/jpeg () + (image-skip-unless 'jpeg) + (pcase (image-size (create-image (cdr (assq 'jpeg image-tests--images)))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/pbm () + (image-skip-unless 'pbm) + (pcase (image-size (cdr (assq 'pbm image-tests--images))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/png () + (image-skip-unless 'png) + (pcase (image-size (cdr (assq 'png image-tests--images))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/svg () + (image-skip-unless 'svg) + (pcase (image-size (cdr (assq 'svg image-tests--images))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/tiff () + (image-skip-unless 'tiff) + (pcase (image-size (create-image (cdr (assq 'tiff image-tests--images)))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/webp () + (image-skip-unless 'webp) + (pcase (image-size (create-image (cdr (assq 'webp image-tests--images)))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/xbm () + (image-skip-unless 'xbm) + (pcase (image-size (cdr (assq 'xbm image-tests--images))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/xpm () + (image-skip-unless 'xpm) + (pcase (image-size (cdr (assq 'xpm image-tests--images))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/error-on-invalid-spec () + (skip-unless (display-images-p)) + (should-error (image-size 'invalid-spec))) + +(ert-deftest image-tests-image-size/error-on-nongraphical-display () + (skip-unless (not (display-images-p))) + (should-error (image-size 'invalid-spec))) + +;;;; image-mask-p + +(ert-deftest image-tests-image-mask-p/gif () + (image-skip-unless 'gif) + (should-not (image-mask-p (create-image + (cdr (assq 'gif image-tests--images)))))) + +(ert-deftest image-tests-image-mask-p/jpeg () + (image-skip-unless 'jpeg) + (should-not (image-mask-p (create-image + (cdr (assq 'jpeg image-tests--images)))))) + +(ert-deftest image-tests-image-mask-p/pbm () + (image-skip-unless 'pbm) + (should-not (image-mask-p (cdr (assq 'pbm image-tests--images))))) + +(ert-deftest image-tests-image-mask-p/png () + (image-skip-unless 'png) + (should-not (image-mask-p (cdr (assq 'png image-tests--images))))) + +(ert-deftest image-tests-image-mask-p/svg () + (image-skip-unless 'svg) + (should-not (image-mask-p (cdr (assq 'svg image-tests--images))))) + +(ert-deftest image-tests-image-mask-p/tiff () + (image-skip-unless 'tiff) + (should-not (image-mask-p (create-image + (cdr (assq 'tiff image-tests--images)))))) + +(ert-deftest image-tests-image-mask-p/webp () + (image-skip-unless 'webp) + (should-not (image-mask-p (create-image + (cdr (assq 'webp image-tests--images)))))) + +(ert-deftest image-tests-image-mask-p/xbm () + (image-skip-unless 'xbm) + (should-not (image-mask-p (cdr (assq 'xbm image-tests--images))))) + +(ert-deftest image-tests-image-mask-p/xpm () + (image-skip-unless 'xpm) + (should-not (image-mask-p (cdr (assq 'xpm image-tests--images))))) + +(ert-deftest image-tests-image-mask-p/error-on-invalid-spec () + (skip-unless (display-images-p)) + (should-error (image-mask-p 'invalid-spec))) + +(ert-deftest image-tests-image-mask-p/error-on-nongraphical-display () + (skip-unless (not (display-images-p))) + (should-error (image-mask-p (cdr (assq 'xpm image-tests--images))))) + +;;;; image-metadata + +;; TODO: These tests could be expanded with files that actually +;; contain metadata. + +(ert-deftest image-tests-image-metadata/gif () + (image-skip-unless 'gif) + (should-not (image-metadata + (create-image (cdr (assq 'gif image-tests--images)))))) + +(ert-deftest image-tests-image-metadata/jpeg () + (image-skip-unless 'jpeg) + (should-not (image-metadata + (create-image (cdr (assq 'jpeg image-tests--images)))))) + +(ert-deftest image-tests-image-metadata/pbm () + (image-skip-unless 'pbm) + (should-not (image-metadata (cdr (assq 'pbm image-tests--images))))) + +(ert-deftest image-tests-image-metadata/png () + (image-skip-unless 'png) + (should-not (image-metadata (cdr (assq 'png image-tests--images))))) + +(ert-deftest image-tests-image-metadata/svg () + (image-skip-unless 'svg) + (should-not (image-metadata (cdr (assq 'svg image-tests--images))))) + +(ert-deftest image-tests-image-metadata/tiff () + (image-skip-unless 'tiff) + (should-not (image-metadata + (create-image (cdr (assq 'tiff image-tests--images)))))) + +(ert-deftest image-tests-image-metadata/webp () + (image-skip-unless 'webp) + (should-not (image-metadata + (create-image (cdr (assq 'webp image-tests--images)))))) + +(ert-deftest image-tests-image-metadata/xbm () + (image-skip-unless 'xbm) + (should-not (image-metadata (cdr (assq 'xbm image-tests--images))))) + +(ert-deftest image-tests-image-metadata/xpm () + (image-skip-unless 'xpm) + (should-not (image-metadata (cdr (assq 'xpm image-tests--images))))) + +(ert-deftest image-tests-image-metadata/nil-on-invalid-spec () + (skip-unless (display-images-p)) + (should-not (image-metadata 'invalid-spec))) + +(ert-deftest image-tests-image-metadata/error-on-nongraphical-display () + (skip-unless (not (display-images-p))) + (should-error (image-metadata (cdr (assq 'xpm image-tests--images))))) + +;;;; ImageMagick + +(ert-deftest image-tests-imagemagick-types () + (skip-unless (fboundp 'imagemagick-types)) + (when (fboundp 'imagemagick-types) + (should (listp (imagemagick-types))))) + +;;;; Initialization + +(ert-deftest image-tests-init-image-library () + (skip-unless (fboundp 'init-image-library)) + (should (init-image-library 'pbm)) ; built-in + (should (init-image-library 'xpm)) ; built-in + (should-not (init-image-library 'invalid-image-type))) + +;;; image-tests.el ends here diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 1943e719ab2..8e28faf2b26 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -134,6 +134,45 @@ (define-key map [menu-bar i-bar] 'foo) (should (eq (lookup-key map [menu-bar I-bar]) 'foo)))) +(ert-deftest keymap-lookup-key/mixed-case-multibyte () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + ;; (downcase "Åäö") => "åäö" + (define-key map [menu-bar åäö bar] 'foo) + (should (eq (lookup-key map [menu-bar åäö bar]) 'foo)) + (should (eq (lookup-key map [menu-bar Åäö Bar]) 'foo)) + ;; (downcase "Γ") => "γ" + (define-key map [menu-bar γ bar] 'baz) + (should (eq (lookup-key map [menu-bar γ bar]) 'baz)) + (should (eq (lookup-key map [menu-bar Γ Bar]) 'baz)))) + +(ert-deftest keymap-lookup-key/menu-non-symbol () + "Test for Bug#51527." + (let ((map (make-keymap))) + (define-key map [menu-bar buffer 1] 'foo) + (should (eq (lookup-key map [menu-bar buffer 1]) 'foo)))) + +(ert-deftest keymap-lookup-keymap/with-spaces () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar foo-bar] 'foo) + (should (eq (lookup-key map [menu-bar Foo\ Bar]) 'foo)))) + +(ert-deftest keymap-lookup-keymap/with-spaces-multibyte () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar åäö-bar] 'foo) + (should (eq (lookup-key map [menu-bar Åäö\ Bar]) 'foo)))) + +(ert-deftest keymap-lookup-keymap/with-spaces-multibyte-lang-env () + "Backwards compatibility behaviour (Bug#50752)." + (let ((lang-env current-language-environment)) + (set-language-environment "Turkish") + (let ((map (make-keymap))) + (define-key map [menu-bar i-bar] 'foo) + (should (eq (lookup-key map [menu-bar I-bar]) 'foo))) + (set-language-environment lang-env))) + (ert-deftest describe-buffer-bindings/header-in-current-buffer () "Header should be inserted into the current buffer. https://debbugs.gnu.org/39149#31" @@ -284,12 +323,12 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046." (with-temp-buffer (help--describe-vector (cadr orig-map) nil #'help--describe-command t shadow-map orig-map t) - (should (equal (buffer-string) - " + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + (string-replace "\t" "" " e foo f foo (currently shadowed by `bar') g .. h foo -"))))) +")))))) (ert-deftest help--describe-vector/bug-9293-same-command-does-not-shadow () "Check that a command can't be shadowed by the same command." @@ -310,10 +349,10 @@ g .. h foo (with-temp-buffer (help--describe-vector (cadr range-map) nil #'help--describe-command t shadow-map range-map t) - (should (equal (buffer-string) - " + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + (string-replace "\t" "" " 0 .. 3 foo -"))))) +")))))) (ert-deftest keymap--key-description () (should (equal (key-description [right] [?\C-x]) @@ -327,6 +366,13 @@ g .. h foo (should (equal (single-key-description 'C-s-home) "C-s-<home>"))) +(ert-deftest keymap-test-lookups () + (should (eq (lookup-key (current-global-map) "\C-x\C-f") 'find-file)) + (should (eq (lookup-key (current-global-map) [(control x) (control f)]) + 'find-file)) + (should (eq (lookup-key (current-global-map) ["C-x C-f"]) 'find-file)) + (should (eq (lookup-key (current-global-map) [?\C-x ?\C-f]) 'find-file))) + (provide 'keymap-tests) ;;; keymap-tests.el ends here diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index 4e7d2ad8ab2..4a87f19cabb 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -99,4 +99,39 @@ (width-in-chars (/ (car size) char-width))) (should (equal width-in-chars 3))))) +(ert-deftest xdisp-tests--find-directional-overrides-case-1 () + (with-temp-buffer + (insert "\ +int main() { + bool isAdmin = false; + /* }if (isAdmin) begin admins only */ + printf(\"You are an admin.\\n\"); + /* end admins only { */ + return 0; +}") + (goto-char (point-min)) + (should (eq (bidi-find-overridden-directionality (point-min) (point-max) + nil) + 46)))) + +(ert-deftest xdisp-tests--find-directional-overrides-case-2 () + (with-temp-buffer + (insert "\ +#define is_restricted_user(user) \\ + !strcmp (user, \"root\") ? 0 : \\ + !strcmp (user, \"admin\") ? 0 : \\ + !strcmp (user, \"superuser? 0 : 1 \") + +int main () { + printf (\"root: %d\\n\", is_restricted_user (\"root\")); + printf (\"admin: %d\\n\", is_restricted_user (\"admin\")); + printf (\"superuser: %d\\n\", is_restricted_user (\"superuser\")); + printf (\"luser: %d\\n\", is_restricted_user (\"luser\")); + printf (\"nobody: %d\\n\", is_restricted_user (\"nobody\")); +}") + (goto-char (point-min)) + (should (eq (bidi-find-overridden-directionality (point-min) (point-max) + nil) + 140)))) + ;;; xdisp-tests.el ends here |
