commit eac4e34a2c0fd3b7a7e2c1205f452dc65db3fd9d (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Wed Sep 28 13:27:05 2022 +0200 Simplify eww--rescale-images code * lisp/net/eww.el (eww--rescale-images): Simplify code. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 624958915a..414de931c4 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1189,18 +1189,17 @@ the like." (defun eww--rescale-images () (let ((scaling (if text-scale-mode (+ 1 (* text-scale-mode-amount 0.1)) - 1)) - match) + 1))) (save-excursion (goto-char (point-min)) - (while (setq match (text-property-search-forward 'display)) + (while-let ((match (text-property-search-forward + 'display nil (lambda (_ value) (imagep value))))) (let ((image (prop-match-value match))) - (when (imagep image) - (unless (image-property image :original-scale) - (setf (image-property image :original-scale) - (or (image-property image :scale) 1))) - (setf (image-property image :scale) - (* (image-property image :original-scale) scaling)))))))) + (unless (image-property image :original-scale) + (setf (image-property image :original-scale) + (or (image-property image :scale) 1))) + (setf (image-property image :scale) + (* (image-property image :original-scale) scaling))))))) (defun eww--url-at-point () "`thing-at-point' provider function." commit 12f63c18f6d5a886f62f10b4c8de8de3509e52df Author: Lars Ingebrigtsen Date: Wed Sep 28 13:19:08 2022 +0200 Add new macro 'while-let' * doc/lispref/control.texi (Conditionals): Document when-let/if-let/while-let. * lisp/subr.el (while-let): New macro. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index ee2acdb002..9635b335bc 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -294,6 +294,48 @@ For example: @end group @end example +If can be convenient to bind variables in conjunction with using a +conditional. It's often the case that you do a computation, and then +want to do something with that computation if it's non-@code{nil}. +The straightforward way to do that is to just write, for instance: + +@example +(let ((result1 (do-computation))) + (when result1 + (let ((result2 (do-more result1))) + (when result2 + (do-something result2))))) +@end example + +Since this is a very common pattern, Emacs provides a number of macros +to make this easier and more readable. The above can be written the +following way instead: + +@example +(when-let ((result1 (do-computation)) + (result2 (do-more result1))) + (do-something result2)) +@end example + +There's a number of variations on this theme, and they're briefly +described below. + +@defmac if-let spec then-form else-forms... +Evaluate each binding in @var{spec} in turn, like in @code{let*} +(@pxref{Local Variables}, stopping if a binding value is @code{nil}. +If all are non-@code{nil}, return the value of @var{then-form}, +otherwise the last form in @var{else-forms}. +@end defmac + +@defmac when-let spec then-forms... +Like @code{if-let}, but without @var{else-forms}. +@end defmac + +@defmac while-let spec then-forms... +Like @code{when-let}, but repeat until a binding in @var{spec} is +@code{nil}. The return value is always @code{nil}. +@end defmac + @node Combining Conditions @section Constructs for Combining Conditions @cindex combining conditions diff --git a/etc/NEWS b/etc/NEWS index b85975944a..e70f9be546 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3012,6 +3012,10 @@ The following generalized variables have been made obsolete: * Lisp Changes in Emacs 29.1 ++++ +** New macro 'while-let'. +This is like 'when-let', but repeats until a binding form is nil. + +++ ** New function 'make-obsolete-generalized-variable'. This can be used to mark setters used by 'setf' as obsolete, and the diff --git a/lisp/subr.el b/lisp/subr.el index 26fba4771b..2a8fc46a9f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2514,7 +2514,20 @@ The variable list SPEC is the same as in `if-let'." (declare (indent 1) (debug if-let)) (list 'if-let spec (macroexp-progn body))) +(defmacro while-let (spec &rest body) + "Bind variables according to SPEC and conditionally evaluate BODY. +Evaluate each binding in turn, stopping if a binding value is nil. +If all bindings are non-nil, eval BODY and repeat. +The variable list SPEC is the same as in `if-let'." + (declare (indent 1) (debug if-let)) + (let ((done (gensym "done"))) + `(catch ',done + (while t + (if-let ,spec + (progn + ,@body) + (throw ',done nil)))))) ;; PUBLIC: find if the current mode derives from another. commit fe002cc8ce38efb256a2a60660ee626c2b2cdf81 Author: Jose A. Ortega Ruiz Date: Wed Sep 28 13:06:38 2022 +0200 docview: new customization options for imenu * doc/emacs/misc.texi (DocView Navigation): * lisp/doc-view.el (doc-view-imenu-title-format, doc-view-imenu-flatten): (doc-view--imenu-subtree): customizable format for imenu entry titles, and flag to disable nested submenus. * lisp/doc-view.el (doc-view--pdf-outline): clean up whitespace markers '\r' and '\t' in imenu item titles (bug#58131). diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 04f7f2e921..cef2580f3b 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -585,11 +585,16 @@ default size for DocView, customize the variable @code{doc-view-resolution}. @vindex doc-view-imenu-enabled +@vindex doc-view-imenu-flatten +@vindex doc-view-imenu-format When the @command{mutool} program is available, DocView will use it to generate entries for an outline menu, making it accessible via the @code{imenu} facility (@pxref{Imenu}). To disable this functionality -even when @command{mutool} can be found on your system, customize -the variable @code{doc-view-imenu-enabled} to the @code{nil} value. +even when @command{mutool} can be found on your system, customize the +variable @code{doc-view-imenu-enabled} to the @code{nil} value. You +can further customize how @code{imenu} items are formatted and +displayed using the variables @code{doc-view-imenu-format} and +@code{doc-view-flatten}. @node DocView Searching @subsection DocView Searching diff --git a/lisp/doc-view.el b/lisp/doc-view.el index fa583df12b..9e3bb6e46c 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -219,6 +219,23 @@ are available (see Info node `(emacs)Document View')." :type 'boolean :version "29.1") +(defcustom doc-view-imenu-title-format "%t (%p)" + "Format string for document section titles in imenu. + +The special markers '%t' and '%p' are replaced by the section +title and page number in this format string, which uses +`format-spec'. + +For instance, setting this variable to \"%t\" will produce items +showing only titles and no page number." + :type 'string + :version "29.1") + +(defcustom doc-view-imenu-flatten nil + "Whether to generate a flat list of sections instead of a nested tree." + :type 'boolean + :version "29.1") + (defcustom doc-view-svg-background "white" "Background color for svg images. See `doc-view-mupdf-use-svg'." @@ -1898,7 +1915,8 @@ structure is extracted by `doc-view--imenu-subtree'." (goto-char (point-min)) (while (re-search-forward doc-view--outline-rx nil t) (push `((level . ,(length (match-string 1))) - (title . ,(match-string 2)) + (title . ,(replace-regexp-in-string "\\\\[rt]" " " + (match-string 2))) (page . ,(string-to-number (match-string 3)))) outline))) (nreverse outline))) @@ -1911,11 +1929,14 @@ the first node in the outline and all its siblings at the same level. Returns that imenu alist together with any other pending outline entries at an upper level." (let ((level (alist-get 'level (car outline))) + (nested (not doc-view-imenu-flatten)) (index nil)) - (while (and (car outline) (<= level (alist-get 'level (car outline)))) + (while (and (car outline) + (or nested (<= level (alist-get 'level (car outline))))) (let-alist (car outline) - (let ((title (format "%s (%s)" .title .page))) - (if (> .level level) + (let ((title (format-spec doc-view-imenu-title-format + `((?t . ,.title) (?p . ,.page))))) + (if (and nested (> .level level)) (let ((sub (doc-view--imenu-subtree outline act)) (fst (car index))) (setq index (cdr index)) commit ec121e035bfed692634faf3a67e97de68c991ea3 Author: Lin Sun Date: Wed Sep 28 13:05:26 2022 +0200 package-update would always re-install package * lisp/emacs-lisp/package.el (package--updateable-packages): fix version comparison between available packages and archived packages (bug#58129). diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 70c15d2793..4abee9d053 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2189,8 +2189,8 @@ to install it but still mark it as selected." (assq (car elt) package-archive-contents))) (and available (version-list-< - (package-desc-priority-version (cadr elt)) - (package-desc-priority-version (cadr available)))))) + (package-desc-version (cadr elt)) + (package-desc-version (cadr available)))))) package-alist))) ;;;###autoload commit c2b9e74686282706e8c2784048616479280b7214 Author: Visuwesh Date: Wed Sep 28 12:59:04 2022 +0200 Follow #target links in eww without re-rendering * lisp/net/eww.el (eww-follow-link): Do a text property search instead of re-rendering to follow #target links in the same page. (bug#58118) (eww-link-keymap): Bind to eww-follow-link as well. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 61b1b75068..624958915a 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -315,7 +315,8 @@ parameter, and should return the (possibly) transformed URL." (defvar-keymap eww-link-keymap :parent shr-map - "RET" #'eww-follow-link) + "RET" #'eww-follow-link + "" #'eww-follow-link) (defvar-keymap eww-image-link-keymap :parent shr-map @@ -1901,7 +1902,8 @@ If EXTERNAL is double prefix, browse in new buffer." eww-mode) (mouse-set-point mouse-event) (let* ((orig-url (get-text-property (point) 'shr-url)) - (url (eww--transform-url orig-url))) + (url (eww--transform-url orig-url)) + target) (cond ((not url) (message "No link under point")) @@ -1913,12 +1915,17 @@ If EXTERNAL is double prefix, browse in new buffer." (funcall browse-url-secondary-browser-function url) (shr--blink-link)) ;; This is a #target url in the same page as the current one. - ((and (url-target (url-generic-parse-url url)) + ((and (setq target (url-target (url-generic-parse-url url))) (eww-same-page-p url (plist-get eww-data :url))) - (let ((dom (plist-get eww-data :dom))) + (let ((point (point))) (eww-save-history) (plist-put eww-data :url url) - (eww-display-html 'utf-8 url dom nil (current-buffer)))) + (goto-char (point-min)) + (if-let ((match (text-property-search-forward 'shr-target-id target #'member))) + (goto-char (prop-match-beginning match)) + (goto-char (if (equal target "top") + (point-min) + point))))) (t (eww-browse-url orig-url external))))) commit ca043773db1e72a765ef8984bf70b0322eff46e2 Author: Stefan Kangas Date: Wed Sep 28 12:23:29 2022 +0200 ; Fix debugging image-dired-dired-toggle-marked-thumbs * lisp/image/image-dired-dired.el (image-dired-dired-toggle-marked-thumbs): Fix debugging. diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index d03c1629da..46adf3f26f 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -63,6 +63,7 @@ current line. ARG, if non-nil, specifies the files to use instead of the marked files. If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0) files." (interactive "P" dired-mode) + (setq image-dired--generate-thumbs-start (current-time)) (dired-map-over-marks (let ((image-pos (dired-move-to-filename)) (image-file (dired-get-filename nil t)) commit 6cffaa3b6daf767808a9d9ae549fc2aea5c5c07e Author: Stefan Kangas Date: Wed Sep 28 00:41:01 2022 +0200 image-dired: End thumbnail file names with ".jpg" * lisp/image/image-dired-util.el (image-dired-thumb-name): Always end thumbnail name in ".jpg" and simplify naming to just use the SHA-1 hash. (Bug#57961) * test/lisp/image/image-dired-util-tests.el (image-dired-thumb-name/image-dired): Adjust test for the above change. * etc/NEWS: Announce the above change. diff --git a/etc/NEWS b/etc/NEWS index 99243481a0..b85975944a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2218,6 +2218,15 @@ nil to disable this confirmation completely. +++ *** 'image-dired-db-file' renamed to 'image-dired-tags-db-file'. +--- +*** Naming of thumbnail files has changed. +Thumbnail files generated when 'image-dired-thumbnail-storage' is +'image-dired' now always end in ".jpg". This fixes various issues on +different platforms, but means that thumbnails generated in Emacs 28 +will not be used in Emacs 29, and vice-versa. If disk space is an +issue, consider deleting the directory 'image-dired-dir' after +upgrading (usually "~/.emacs.d/image-dired/"). + --- *** 'image-dired-thumb-{height,width}' are now obsolete. Customize 'image-dired-thumb-size' instead, which will set both the diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el index e7d116d90b..dd746886a4 100644 --- a/lisp/image/image-dired-util.el +++ b/lisp/image/image-dired-util.el @@ -70,37 +70,28 @@ file name of the thumbnail will vary: 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 (xdg-cache-home))))) - ((or (eq 'image-dired image-dired-thumbnail-storage) - ;; Maintained for backwards compatibility: - (eq 'use-image-dired-dir image-dired-thumbnail-storage)) - (let* ((f (expand-file-name file)) - (hash (md5 (file-name-as-directory (file-name-directory f))))) - (expand-file-name - (format "%s%s.thumb.%s" - (file-name-base f) - (if hash (concat "_" hash) "") - (file-name-extension f)) - (image-dired-dir)))) - ((eq 'per-directory image-dired-thumbnail-storage) - (let ((f (expand-file-name file))) - (expand-file-name - (format "%s.thumb.%s" - (file-name-base f) - (file-name-extension f)) - (expand-file-name - ".image-dired" - (file-name-directory f))))))) + (let ((file (expand-file-name file))) + (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://" file)) ".png") + (expand-file-name thumbdir (xdg-cache-home))))) + ((or (eq 'image-dired image-dired-thumbnail-storage) + ;; Maintained for backwards compatibility: + (eq 'use-image-dired-dir image-dired-thumbnail-storage)) + (expand-file-name (format "%s.jpg" (sha1 file)) + (image-dired-dir))) + ((eq 'per-directory image-dired-thumbnail-storage) + (expand-file-name (format "%s.thumb.jpg" file) + (expand-file-name + ".image-dired" + (file-name-directory file))))))) (defvar image-dired-thumbnail-buffer "*image-dired*" "Image-Dired's thumbnail buffer.") diff --git a/test/lisp/image/image-dired-util-tests.el b/test/lisp/image/image-dired-util-tests.el index 9fb457dd36..cd371ef61a 100644 --- a/test/lisp/image/image-dired-util-tests.el +++ b/test/lisp/image/image-dired-util-tests.el @@ -48,9 +48,12 @@ (file-name-directory (image-dired-thumb-name "foo.jpg")) (file-name-directory (image-dired-thumb-name "/tmp/foo.jpg")))) (should (equal (file-name-nondirectory - ;; The checksum is based on the directory name. + ;; The checksum is based on the file name. (image-dired-thumb-name "/some/path/foo.jpg")) - "foo_45fff7fcc4a0945679b7b11dec36a82d.thumb.jpg"))))) + "dc4e6f7068157023e7f2e8362d15bdd2e3ca89e4.jpg")) + (should (equal (file-name-extension + (image-dired-thumb-name "foo.gif")) + "jpg"))))) (ert-deftest image-dired-thumb-name/per-directory () (let ((image-dired-thumbnail-storage 'per-directory)) commit b5b59d1b8afe1e13f63190b9688ddfd9605f2945 Author: Stefan Kangas Date: Tue Sep 27 23:51:21 2022 +0200 Standardize XPM files These headers make GraphicsMagick croak with "Improper image header". Note that the copyright information is already in README. * etc/images/checked.xpm: * etc/images/gnus/gnus.xpm: * etc/images/gnus/gnus-pointer.xpm: * etc/images/mh-logo.xpm: * etc/images/unchecked.xpm: Normalize file headers. diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm index aefa9dd5da..4dbcb9e6fd 100644 --- a/etc/images/checked.xpm +++ b/etc/images/checked.xpm @@ -1,23 +1,4 @@ /* XPM */ -/* Copyright (C) 2010-2022 Free Software Foundation, Inc. - * - * Author: Chong Yidong - * - * 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 . - */ static char * checked_xpm[] = { "12 12 5 1", " c None", diff --git a/etc/images/gnus/gnus-pointer.xpm b/etc/images/gnus/gnus-pointer.xpm index c47443dbb7..5328b15bed 100644 --- a/etc/images/gnus/gnus-pointer.xpm +++ b/etc/images/gnus/gnus-pointer.xpm @@ -1,7 +1,7 @@ /* XPM */ -static char *gnus-pointer[] = { +static char *gnus_pointer_xpm[] = { /* width height num_colors chars_per_pixel */ -" 18 13 2 1", +"18 13 2 1", /* colors */ ". c #0000ff", "# c None s None", @@ -19,4 +19,4 @@ static char *gnus-pointer[] = { "###....####.######", "###..######.######", "###########.######" -}; \ No newline at end of file +}; diff --git a/etc/images/gnus/gnus.xpm b/etc/images/gnus/gnus.xpm index b6ee4d0d73..4f46eca4fa 100644 --- a/etc/images/gnus/gnus.xpm +++ b/etc/images/gnus/gnus.xpm @@ -1,7 +1,7 @@ /* XPM */ -static char *gnus[] = { +static char *gnus_xpm[] = { /* width height num_colors chars_per_pixel */ -" 271 273 3 1", +"271 273 3 1", /* colors */ ". s thing c #bf9900", "# s shadow c #ffcc00", diff --git a/etc/images/mh-logo.xpm b/etc/images/mh-logo.xpm index 846859e058..637c456964 100644 --- a/etc/images/mh-logo.xpm +++ b/etc/images/mh-logo.xpm @@ -1,32 +1,8 @@ /* XPM */ -/* MH-E Logo - * - * Copyright (C) 2003-2022 Free Software Foundation, Inc. - * - * Author: Satyaki Das - * - * 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 . - */ -static char *mh-e[] = { -/* width height num_colors chars_per_pixel */ -" 18 13 2 1", -/* colors */ +static char *mh_logo_xpm[] = { +"18 13 2 1", "# c #666699", ". c None s None", -/* pixels */ "........##........", ".......####.......", "......######......", diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm index b758346b96..85eec75230 100644 --- a/etc/images/unchecked.xpm +++ b/etc/images/unchecked.xpm @@ -1,23 +1,4 @@ /* XPM */ -/* Copyright (C) 2010-2022 Free Software Foundation, Inc. - * - * Author: Chong Yidong - * - * 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 . - */ static char * unchecked_xpm[] = { "12 12 5 1", " c None", commit f6fb2b9e1f94917601201f5d43c15e92e99b2a2f Author: Paul Eggert Date: Wed Sep 28 01:06:10 2022 -0700 Port better to C23 bool+true+false keywords C23 is adding the C++ keywords bool, true, and false; prefer them to if they are available. * admin/merge-gnulib (GNULIB_MODULES): Add stdbool, which emulates C23 on pre-C23 platforms. (AVOIDED_MODULES): Remove stdbool; Gnulib has renamed this module to stdbool-c99 and nobody uses it so it does not need to be avoided. * m4/c-bool.m4: New file, from Gnulib stdbool module. * lib-src/seccomp-filter.c, src/conf_post.h, src/dynlib.h: * src/emacs-module.c, src/nsterm.m, src/systhread.h: * test/src/emacs-module-resources/mod-test.c: Use the C23 style and use bool without including . The Gnulib stdbool module causes config.h to include stdbool.h on pre-C23 platforms. * src/emacs-module.h.in: Don’t include if C23 or later, or if it has already been included. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 4dd6a4d222..d3c5520ad0 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -43,7 +43,7 @@ GNULIB_MODULES=' nanosleep nproc nstrftime pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex - sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stddef stdio + sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stdbool stddef stdio stpcpy strnlen strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright unlocked-io utimensat @@ -54,7 +54,7 @@ AVOIDED_MODULES=' btowc chmod close crypto/af_alg dup fchdir fstat langinfo lock mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir pthread-h raise - save-cwd select setenv sigprocmask stat stdarg stdbool + save-cwd select setenv sigprocmask stat stdarg threadlib tzset unsetenv utime utime-h wchar wcrtomb wctype-h ' diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 8d2089bad8..ea1679f693 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -3004,8 +3004,8 @@ Using @code{bool} can make programs easier to read and a bit faster than using @code{int}. Although it is also OK to use @code{int}, @code{0} and @code{1}, this older style is gradually being phased out. When using @code{bool}, respect the limitations of the replacement -implementation of @code{bool}, as documented in the source file -@file{lib/stdbool.in.h}. In particular, boolean bitfields should be of type +implementation of @code{bool}. In particular, +boolean bitfields should be of type @code{bool_bf}, not @code{bool}, so that they work correctly even when compiling Objective C with standard GCC. diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index 9f0de7d64f..4bd2816dfc 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -39,7 +39,6 @@ variants of those files that can be used to sandbox Emacs before #include #include #include -#include #include #include #include diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 7eca66a609..04644bdabe 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -60,7 +60,6 @@ # --avoid=sigprocmask \ # --avoid=stat \ # --avoid=stdarg \ -# --avoid=stdbool \ # --avoid=threadlib \ # --avoid=tzset \ # --avoid=unsetenv \ @@ -147,6 +146,7 @@ # stat-time \ # std-gnu11 \ # stdalign \ +# stdbool \ # stddef \ # stdio \ # stpcpy \ @@ -953,6 +953,8 @@ MKDIR_P = @MKDIR_P@ MODULES_OBJ = @MODULES_OBJ@ MODULES_SECONDARY_SUFFIX = @MODULES_SECONDARY_SUFFIX@ MODULES_SUFFIX = @MODULES_SUFFIX@ +NEXT_ASSERT_H = @NEXT_ASSERT_H@ +NEXT_AS_FIRST_DIRECTIVE_ASSERT_H = @NEXT_AS_FIRST_DIRECTIVE_ASSERT_H@ NEXT_AS_FIRST_DIRECTIVE_DIRENT_H = @NEXT_AS_FIRST_DIRECTIVE_DIRENT_H@ NEXT_AS_FIRST_DIRECTIVE_ERRNO_H = @NEXT_AS_FIRST_DIRECTIVE_ERRNO_H@ NEXT_AS_FIRST_DIRECTIVE_FCNTL_H = @NEXT_AS_FIRST_DIRECTIVE_FCNTL_H@ diff --git a/m4/c-bool.m4 b/m4/c-bool.m4 new file mode 100644 index 0000000000..bb109b7796 --- /dev/null +++ b/m4/c-bool.m4 @@ -0,0 +1,51 @@ +# Check for bool that conforms to C2023. + +dnl Copyright 2022 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_C_BOOL], +[ + AC_CACHE_CHECK([for bool, true, false], [gl_cv_c_bool], + [AC_COMPILE_IFELSE( + [AC_LANG_SOURCE([[ + #if true == false + #error "true == false" + #endif + extern bool b; + bool b = true == false;]])], + [gl_cv_c_bool=yes], + [gl_cv_c_bool=no])]) + if test "$gl_cv_c_bool" = yes; then + AC_DEFINE([HAVE_C_BOOL], [1], + [Define to 1 if bool, true and false work as per C2023.]) + fi + + AC_CHECK_HEADERS_ONCE([stdbool.h]) + + dnl The "zz" puts this toward config.h's end, to avoid potential + dnl collisions with other definitions. + dnl If 'bool', 'true' and 'false' do not work, arrange for them to work. + dnl In C, this means including if it is not already included. + dnl However, if the preprocessor mistakenly treats 'true' as 0, + dnl define it to a bool expression equal to 1; this is needed in + dnl Sun C++ 5.11 (Oracle Solaris Studio 12.2, 2010) and older. + AH_VERBATIM([zzbool], +[#ifndef HAVE_C_BOOL +# if !defined __cplusplus && !defined __bool_true_false_are_defined +# if HAVE_STDBOOL_H +# include +# else +# if defined __SUNPRO_C +# error " is not usable with this configuration. To make it usable, add -D_STDC_C99= to $CC." +# else +# error " does not exist on this platform. Use gnulib module 'stdbool-c99' instead of gnulib module 'stdbool'." +# endif +# endif +# endif +# if !true +# define true (!false) +# endif +#endif]) +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 6a5f300678..f1ac499132 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -172,6 +172,7 @@ AC_DEFUN([gl_EARLY], # Code from module stat-time: # Code from module std-gnu11: # Code from module stdalign: + # Code from module stdbool: # Code from module stdckdint: # Code from module stddef: # Code from module stdint: @@ -490,6 +491,7 @@ AC_DEFUN([gl_INIT], gl_STDALIGN_H gl_CONDITIONAL_HEADER([stdalign.h]) AC_PROG_MKDIR_P + gl_C_BOOL gl_STDDEF_H gl_STDDEF_H_REQUIRE_DEFAULTS gl_CONDITIONAL_HEADER([stddef.h]) @@ -1428,6 +1430,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/assert_h.m4 m4/builtin-expect.m4 m4/byteswap.m4 + m4/c-bool.m4 m4/canonicalize.m4 m4/clock_time.m4 m4/copy-file-range.m4 diff --git a/src/conf_post.h b/src/conf_post.h index 6ecebf36ab..fb8d2e5d96 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -30,14 +30,10 @@ along with GNU Emacs. If not, see . */ #endif /* To help make dependencies clearer elsewhere, this file typically - does not #include other files. The exceptions are stdbool.h - because it is unlikely to interfere with configuration and bool is - such a core part of the C language, and ms-w32.h (DOS_NT + does not #include other files. The exception is ms-w32.h (DOS_NT only) because it historically was included here and changing that would take some work. */ -#include - #if defined WINDOWSNT && !defined DEFER_MS_W32_H # include #endif diff --git a/src/dynlib.h b/src/dynlib.h index 03b8f98356..9a11c12898 100644 --- a/src/dynlib.h +++ b/src/dynlib.h @@ -21,7 +21,6 @@ along with GNU Emacs. If not, see . */ #define DYNLIB_H #include -#include typedef void *dynlib_handle_ptr; dynlib_handle_ptr dynlib_open (const char *path); diff --git a/src/emacs-module.c b/src/emacs-module.c index 1c392d65df..fcdf103c19 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -78,7 +78,6 @@ To add a new module function, proceed as follows: #include "emacs-module.h" #include -#include #include #include #include diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 6642b55d93..bef89b059f 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -30,7 +30,8 @@ information how to write modules and use this header file. #include #include -#ifndef __cplusplus +#if ((defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 202311 \ + && !defined __bool_true_false_are_defined && !defined __cplusplus) #include #endif diff --git a/src/nsterm.m b/src/nsterm.m index 44979c7c04..b68a6f8ec1 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -37,7 +37,6 @@ Updated by Christian Limpach (chris@nice.ch) #include #include #include -#include #include #include diff --git a/src/systhread.h b/src/systhread.h index bf4e0306cd..10d6237f27 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -19,8 +19,6 @@ along with GNU Emacs. If not, see . */ #ifndef SYSTHREAD_H #define SYSTHREAD_H -#include - #include #ifdef THREADS_ENABLED diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 187af821c2..b47a0b7a39 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -24,7 +24,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include #include #include #include commit a9b29ee4a0ffa4878d67eaf518dbeed098844b9e Author: Paul Eggert Date: Wed Sep 28 00:29:09 2022 -0700 Update from Gnulib by running admin/merge-gnulib diff --git a/build-aux/config.guess b/build-aux/config.guess index 1817bdce90..a419d8643b 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-05-25' +timestamp='2022-08-01' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1036,7 +1036,7 @@ EOF k1om:Linux:*:*) GUESS=$UNAME_MACHINE-unknown-linux-$LIBC ;; - loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*) + loongarch32:Linux:*:* | loongarch64:Linux:*:*) GUESS=$UNAME_MACHINE-unknown-linux-$LIBC ;; m32r*:Linux:*:*) diff --git a/build-aux/config.sub b/build-aux/config.sub index dba16e84c7..fbaa37f235 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-01-03' +timestamp='2022-08-01' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1207,7 +1207,7 @@ case $cpu-$vendor in | k1om \ | le32 | le64 \ | lm32 \ - | loongarch32 | loongarch64 | loongarchx32 \ + | loongarch32 | loongarch64 \ | m32c | m32r | m32rle \ | m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k \ | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \ diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index f86af0db3e..09f2d28c2f 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2022-08-20.19} +\def\texinfoversion{2022-09-21.15} % % Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc. % @@ -241,9 +241,6 @@ % \def\finalout{\overfullrule=0pt } -\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines -\newdimen\topandbottommargin \topandbottommargin=.75in - % Output a mark which sets \thischapter, \thissection and \thiscolor. % We dump everything together because we only have one kind of mark. % This works because we only use \botmark / \topmark, not \firstmark. @@ -317,16 +314,8 @@ \newbox\footlinebox % When outputting the double column layout for indices, an output routine -% is run several times, which hides the original value of \topmark. This -% can lead to a page heading being output and duplicating the chapter heading -% of the index. Hence, save the contents of \topmark at the beginning of -% the output routine. The saved contents are valid until we actually -% \shipout a page. -% -% (We used to run a short output routine to actually set \topmark and -% \firstmark to the right values, but if this was called with an empty page -% containing whatsits for writing index entries, the whatsits would be thrown -% away and the index auxiliary file would remain empty.) +% is run several times, hiding the original value of \topmark. Hence, save +% \topmark at the beginning. % \newtoks\savedtopmark \newif\iftopmarksaved @@ -351,15 +340,9 @@ % \checkchapterpage % - % Retrieve the information for the headings from the marks in the page, - % and call Plain TeX's \makeheadline and \makefootline, which use the - % values in \headline and \footline. - % - % Common context changes for both heading and footing. - % Do this outside of the \shipout so @code etc. will be expanded in - % the headline as they should be, not taken literally (outputting ''code). + % Make the heading and footing. \makeheadline and \makefootline + % use the contents of \headline and \footline. \def\commonheadfootline{\let\hsize=\txipagewidth \texinfochars} - % \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi \global\setbox\headlinebox = \vbox{\commonheadfootline \makeheadline}% \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi @@ -617,21 +600,6 @@ % @? is an end-of-sentence query. \def\?{?\spacefactor=\endofsentencespacefactor\space} -% @frenchspacing on|off says whether to put extra space after punctuation. -% -\def\onword{on} -\def\offword{off} -% -\parseargdef\frenchspacing{% - \def\temp{#1}% - \ifx\temp\onword \plainfrenchspacing - \else\ifx\temp\offword \plainnonfrenchspacing - \else - \errhelp = \EMsimple - \errmessage{Unknown @frenchspacing option `\temp', must be on|off}% - \fi\fi -} - % @w prevents a word break. Without the \leavevmode, @w at the % beginning of a paragraph, when TeX is still in vertical mode, would % produce a whole line of output instead of starting the paragraph. @@ -2803,14 +2771,22 @@ % @var unconditionally uses \sl. This gives consistency for % parameter names whether they are in @def, @table @code or a % regular paragraph. +% To get ttsl font for @var when used in code context, @set txicodevaristt. % The \null is to reset \spacefactor. \def\aftersmartic{} \def\var#1{% \let\saveaftersmartic = \aftersmartic \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}% - {\sl #1}\smartitaliccorrection + % + \ifflagclear{txicodevaristt}% + {\def\varnext{{{\sl #1}}\smartitaliccorrection}}% + {\def\varnext{\smartslanted{#1}}}% + \varnext } +% To be removed after next release +\def\SETtxicodevaristt{}% @set txicodevaristt + \let\i=\smartitalic \let\slanted=\smartslanted \let\dfn=\smartslanted @@ -2859,6 +2835,24 @@ \catcode`@=\other \def\endofsentencespacefactor{3000}% default +% @frenchspacing on|off says whether to put extra space after punctuation. +% +\def\onword{on} +\def\offword{off} +% +\let\frenchspacingsetting\plainnonfrenchspacing % used in output routine +\parseargdef\frenchspacing{% + \def\temp{#1}% + \ifx\temp\onword \let\frenchspacingsetting\plainfrenchspacing + \else\ifx\temp\offword \let\frenchspacingsetting\plainnonfrenchspacing + \else + \errhelp = \EMsimple + \errmessage{Unknown @frenchspacing option `\temp', must be on|off}% + \fi\fi + \frenchspacingsetting +} + + % @t, explicit typewriter. \def\t#1{% {\tt \defcharsdefault \plainfrenchspacing #1}% @@ -3450,8 +3444,13 @@ % Revert to plain's \scriptsize, which is 7pt. \count255=\the\fam $\fam\count255 \scriptstyle A$% \else - % For 11pt, we can use our lllsize. - \switchtolllsize A% + \ifx\curfontsize\smallword + % For footnotes and indices + \count255=\the\fam $\fam\count255 \scriptstyle A$% + \else + % For 11pt, we can use our lllsize. + \switchtolllsize A% + \fi \fi }% \vss @@ -3459,6 +3458,7 @@ \kern-.15em \TeX } +\def\smallword{small} % Some math mode symbols. Define \ensuremath to switch into math mode % unless we are already there. Expansion tricks may not be needed here, @@ -3829,15 +3829,16 @@ \newtoks\oddfootline % footline on odd pages % Now make \makeheadline and \makefootline in Plain TeX use those variables -\headline={{\textfonts\rm +\headline={{\textfonts\rm\frenchspacingsetting \ifchapterpage \ifodd\pageno\the\oddchapheadline\else\the\evenchapheadline\fi \else \ifodd\pageno\the\oddheadline\else\the\evenheadline\fi \fi}} -\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline - \else \the\evenfootline \fi}\HEADINGShook} +\footline={{\textfonts\rm\frenchspacingsetting + \ifodd\pageno \the\oddfootline \else \the\evenfootline \fi}% + \HEADINGShook} \let\HEADINGShook=\relax % Commands to set those variables. @@ -3963,7 +3964,7 @@ \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} \global\oddheadline={\line{\thischapter\hfil\folio}} -\global\evenchapheadline={\line{\folio\hfil}} +\global\evenchapheadline={\line{\folio\hfil\thistitle}} \global\oddchapheadline={\line{\hfil\folio}} \global\let\contentsalignmacro = \chapoddpage } @@ -4351,8 +4352,7 @@ % undo it ourselves. \def\headitemfont{\b}% for people to use in the template row; not changeable \def\headitem{% - \checkenv\multitable - \crcr + \crcr % must appear first \gdef\headitemcrhook{\nobreak}% attempt to avoid page break after headings \global\everytab={\bf}% can't use \headitemfont since the parsing differs \the\everytab % for the first item @@ -6755,6 +6755,11 @@ \ifnum\romancount=0 \global\romancount=\pagecount \fi } +% \raggedbottom in plain.tex hardcodes \topskip so override it +\catcode`\@=11 +\def\raggedbottom{\advance\topskip by 0pt plus60pt \r@ggedbottomtrue} +\catcode`\@=\other + % redefined for the two-volume lispref. We always output on % \jobname.toc even if this is redefined. % @@ -7115,7 +7120,7 @@ % collide with the section heading. \ifnum\lastpenalty>10000 \vskip\parskip \penalty\lastpenalty \fi % - \setbox\groupbox=\vbox\bgroup + \setbox\groupbox=\vtop\bgroup \baselineskip=0pt\parskip=0pt\lineskip=0pt \carttop \hbox\bgroup @@ -7801,6 +7806,8 @@ % Print arguments. Use slanted for @def*, typewriter for @deftype*. \def\defunargs#1{% \df \ifdoingtypefn \tt \else \sl \fi + \ifflagclear{txicodevaristt}{}% + {\def\var##1{{\setregularquotes \ttsl ##1}}}% #1% } @@ -9311,6 +9318,12 @@ \imagexxx #1,,,,,\finish \fi } + +% Approximate height of a line in the standard text font. +\newdimen\capheight +\setbox0=\vbox{\tenrm H} +\capheight=\ht0 + % % Arguments to @image: % #1 is (mandatory) image filename; we tack on .eps extension. @@ -9340,7 +9353,7 @@ % % Place image in a \vtop for a top page margin that is (close to) correct, % as \topskip glue is relative to the first baseline. - \vtop\bgroup\hrule height 0pt\vskip-\parskip + \vtop\bgroup \kern -\capheight \vskip-\parskip \fi % % Enter horizontal mode so that indentation from an enclosing @@ -11217,13 +11230,9 @@ % \vsize = #1\relax \advance\vsize by \topskip - \outervsize = \vsize - \advance\outervsize by 2\topandbottommargin \txipageheight = \vsize % \hsize = #2\relax - \outerhsize = \hsize - \advance\outerhsize by 0.5in \txipagewidth = \hsize % \normaloffset = #4\relax diff --git a/lib/acl-internal.h b/lib/acl-internal.h index 93533762dd..94553fab25 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -19,7 +19,6 @@ #include "acl.h" -#include #include /* All systems define the ACL related API in . */ diff --git a/lib/acl.h b/lib/acl.h index f4d0df8061..0be6ef1cea 100644 --- a/lib/acl.h +++ b/lib/acl.h @@ -20,7 +20,6 @@ #ifndef _GL_ACL_H #define _GL_ACL_H 1 -#include #include #include diff --git a/lib/assert.in.h b/lib/assert.in.h new file mode 100644 index 0000000000..2c358ba62e --- /dev/null +++ b/lib/assert.in.h @@ -0,0 +1,27 @@ +/* Substitute for and wrapper around + Copyright (C) 2011-2022 Free Software Foundation, Inc. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation; either version 2.1 of the + License, or (at your option) any later version. + + This file 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 Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +/* Do not guard the include, since is supposed to define + the assert macro each time it is included. */ + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +#@INCLUDE_NEXT@ @NEXT_ASSERT_H@ + +/* The definition of static_assert is copied here. */ diff --git a/lib/c-ctype.h b/lib/c-ctype.h index 1a4f603898..1202ff8a36 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -23,8 +23,6 @@ #ifndef C_CTYPE_H #define C_CTYPE_H -#include - #ifndef _GL_INLINE_HEADER_BEGIN #error "Please include config.h first." #endif diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c index a7fa7feb62..8c3d7f7cf8 100644 --- a/lib/canonicalize-lgpl.c +++ b/lib/canonicalize-lgpl.c @@ -30,7 +30,6 @@ #include #include #include -#include #include #include #include diff --git a/lib/cloexec.h b/lib/cloexec.h index 7a22d77532..15d2d5efe2 100644 --- a/lib/cloexec.h +++ b/lib/cloexec.h @@ -15,8 +15,6 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . */ -#include - /* Set the 'FD_CLOEXEC' flag of DESC if VALUE is true, or clear the flag if VALUE is false. Return 0 on success, or -1 on error with 'errno' set. diff --git a/lib/close-stream.c b/lib/close-stream.c index 9b0e97b271..0fdca79bf8 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -20,7 +20,6 @@ #include "close-stream.h" #include -#include #include "fpending.h" diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index 354641af0a..4b4f5d4f9a 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h @@ -43,13 +43,17 @@ extern "C" { # define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ return x ? BUILTIN (x) : CHAR_BIT * sizeof x; #elif _MSC_VER -# pragma intrinsic _BitScanReverse -# pragma intrinsic _BitScanReverse64 +# pragma intrinsic (_BitScanReverse) +# if defined _M_X64 +# pragma intrinsic (_BitScanReverse64) +# endif # define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ do \ { \ unsigned long result; \ - return MSC_BUILTIN (&result, x) ? result : CHAR_BIT * sizeof x; \ + if (MSC_BUILTIN (&result, x)) \ + return CHAR_BIT * sizeof x - 1 - result; \ + return CHAR_BIT * sizeof x; \ } \ while (0) #else @@ -109,8 +113,18 @@ count_leading_zeros_l (unsigned long int x) COUNT_LEADING_ZEROS_INLINE int count_leading_zeros_ll (unsigned long long int x) { +#if (defined _MSC_VER && !defined __clang__) && !defined _M_X64 + /* 32-bit MSVC does not have _BitScanReverse64, only _BitScanReverse. */ + unsigned long result; + if (_BitScanReverse (&result, (unsigned long) (x >> 32))) + return CHAR_BIT * sizeof x - 1 - 32 - result; + if (_BitScanReverse (&result, (unsigned long) x)) + return CHAR_BIT * sizeof x - 1 - result; + return CHAR_BIT * sizeof x; +#else COUNT_LEADING_ZEROS (__builtin_clzll, _BitScanReverse64, unsigned long long int); +#endif } #ifdef __cplusplus diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index 9a989a4324..61fbdf2980 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h @@ -43,8 +43,10 @@ extern "C" { # define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ return x ? BUILTIN (x) : CHAR_BIT * sizeof x; #elif _MSC_VER -# pragma intrinsic _BitScanForward -# pragma intrinsic _BitScanForward64 +# pragma intrinsic (_BitScanForward) +# if defined _M_X64 +# pragma intrinsic (_BitScanForward64) +# endif # define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ do \ { \ @@ -101,8 +103,18 @@ count_trailing_zeros_l (unsigned long int x) COUNT_TRAILING_ZEROS_INLINE int count_trailing_zeros_ll (unsigned long long int x) { +#if (defined _MSC_VER && !defined __clang__) && !defined _M_X64 + /* 32-bit MSVC does not have _BitScanForward64, only _BitScanForward. */ + unsigned long result; + if (_BitScanForward (&result, (unsigned long) x)) + return result; + if (_BitScanForward (&result, (unsigned long) (x >> 32))) + return result + 32; + return CHAR_BIT * sizeof x; +#else COUNT_TRAILING_ZEROS (__builtin_ctzll, _BitScanForward64, unsigned long long int); +#endif } #ifdef __cplusplus diff --git a/lib/diffseq.h b/lib/diffseq.h index 0f76ea1d5a..a8b0e7bd40 100644 --- a/lib/diffseq.h +++ b/lib/diffseq.h @@ -70,7 +70,6 @@ Before including this file, you also need to include: #include - #include #include "minmax.h" */ diff --git a/lib/filevercmp.c b/lib/filevercmp.c index 7e54793e61..844505a6bf 100644 --- a/lib/filevercmp.c +++ b/lib/filevercmp.c @@ -20,11 +20,9 @@ #include #include "filevercmp.h" -#include #include #include #include -#include /* Return the length of a prefix of S that corresponds to the suffix defined by this extended regular expression in the C locale: @@ -75,7 +73,7 @@ order (char const *s, idx_t pos, idx_t len) return -2; else { - verify (UCHAR_MAX <= (INT_MAX - 1 - 2) / 2); + static_assert (UCHAR_MAX <= (INT_MAX - 1 - 2) / 2); return c + UCHAR_MAX + 1; } } diff --git a/lib/fsusage.h b/lib/fsusage.h index 0443d19f92..27085b7b41 100644 --- a/lib/fsusage.h +++ b/lib/fsusage.h @@ -22,7 +22,6 @@ # define FSUSAGE_H_ # include -# include struct fs_usage { diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 37e8280867..1fddee97af 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -82,7 +82,6 @@ #include #include -#include #include # include diff --git a/lib/getrandom.c b/lib/getrandom.c index e146873093..c05a48167e 100644 --- a/lib/getrandom.c +++ b/lib/getrandom.c @@ -23,7 +23,6 @@ #include #include -#include #include #if defined _WIN32 && ! defined __CYGWIN__ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 5bb78740d6..7eca66a609 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -180,6 +180,7 @@ AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ APPLE_UNIVERSAL_BUILD = @APPLE_UNIVERSAL_BUILD@ AR = @AR@ ARFLAGS = @ARFLAGS@ +ASSERT_H = @ASSERT_H@ AUTO_DEPEND = @AUTO_DEPEND@ AWK = @AWK@ BITSIZEOF_PTRDIFF_T = @BITSIZEOF_PTRDIFF_T@ @@ -307,6 +308,7 @@ GL_COND_OBJ_TIME_RZ_CONDITION = @GL_COND_OBJ_TIME_RZ_CONDITION@ GL_COND_OBJ_TIME_R_CONDITION = @GL_COND_OBJ_TIME_R_CONDITION@ GL_COND_OBJ_UTIMENSAT_CONDITION = @GL_COND_OBJ_UTIMENSAT_CONDITION@ GL_GENERATE_ALLOCA_H_CONDITION = @GL_GENERATE_ALLOCA_H_CONDITION@ +GL_GENERATE_ASSERT_H_CONDITION = @GL_GENERATE_ASSERT_H_CONDITION@ GL_GENERATE_BYTESWAP_H_CONDITION = @GL_GENERATE_BYTESWAP_H_CONDITION@ GL_GENERATE_ERRNO_H_CONDITION = @GL_GENERATE_ERRNO_H_CONDITION@ GL_GENERATE_EXECINFO_H_CONDITION = @GL_GENERATE_EXECINFO_H_CONDITION@ @@ -1440,6 +1442,39 @@ EXTRA_DIST += allocator.h endif ## end gnulib module allocator +## begin gnulib module assert-h +ifeq (,$(OMIT_GNULIB_MODULE_assert-h)) + +BUILT_SOURCES += $(ASSERT_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +ifneq (,$(GL_GENERATE_ASSERT_H_CONDITION)) +assert.h: assert.in.h verify.h $(top_builddir)/config.status + $(gl_V_at){ $(SED_HEADER_STDOUT) \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_ASSERT_H''@|$(NEXT_ASSERT_H)|g' \ + < $(srcdir)/assert.in.h && \ + sed -e '/@assert.h omit start@/,/@assert.h omit end@/d' \ + -e 's|_gl_verify|_gl_static_assert|g' \ + -e 's|_GL_VERIFY|_GL_STATIC_ASSERT|g' \ + -e 's|_GL\(_STATIC_ASSERT_H\)|_GL\1|g' \ + < $(srcdir)/verify.h; \ + } > $@-t + $(AM_V_at)mv $@-t $@ +else +assert.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += assert.h assert.h-t + +EXTRA_DIST += assert.in.h verify.h + +endif +## end gnulib module assert-h + ## begin gnulib module at-internal ifeq (,$(OMIT_GNULIB_MODULE_at-internal)) diff --git a/lib/malloc/dynarray.h b/lib/malloc/dynarray.h index f16fd950df..df1aa4167d 100644 --- a/lib/malloc/dynarray.h +++ b/lib/malloc/dynarray.h @@ -94,7 +94,6 @@ #ifndef _DYNARRAY_H #define _DYNARRAY_H -#include #include #include diff --git a/lib/md5.c b/lib/md5.c index 57489ed74c..c16ac4a93a 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -27,7 +27,6 @@ #endif #include "md5.h" -#include #include #include #include diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c index 95f067f82d..ea037b801d 100644 --- a/lib/mini-gmp.c +++ b/lib/mini-gmp.c @@ -1,8 +1,9 @@ /* mini-gmp, a minimalistic implementation of a GNU GMP subset. Contributed to the GNU project by Niels Möller + Additional functionalities and improvements by Marco Bodrato. -Copyright 1991-1997, 1999-2021 Free Software Foundation, Inc. +Copyright 1991-1997, 1999-2022 Free Software Foundation, Inc. This file is part of the GNU MP Library. @@ -3098,7 +3099,7 @@ mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m) if (en == 0) { - mpz_set_ui (r, 1); + mpz_set_ui (r, mpz_cmpabs_ui (m, 1)); return; } diff --git a/lib/nanosleep.c b/lib/nanosleep.c index 446794edc0..55d6fa650e 100644 --- a/lib/nanosleep.c +++ b/lib/nanosleep.c @@ -23,9 +23,7 @@ #include #include "intprops.h" -#include "verify.h" -#include #include #include #include @@ -59,7 +57,7 @@ nanosleep (const struct timespec *requested_delay, { /* Verify that time_t is large enough. */ - verify (TYPE_MAXIMUM (time_t) / 24 / 24 / 60 / 60); + static_assert (TYPE_MAXIMUM (time_t) / 24 / 24 / 60 / 60); const time_t limit = 24 * 24 * 60 * 60; time_t seconds = requested_delay->tv_sec; struct timespec intermediate; diff --git a/lib/nstrftime.c b/lib/nstrftime.c index c1dd554247..37034eb9fb 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -65,7 +65,6 @@ extern char *tzname[]; #include #include #include -#include #include "attribute.h" #include diff --git a/lib/openat.h b/lib/openat.h index 56919ef8dc..c2f64ff50e 100644 --- a/lib/openat.h +++ b/lib/openat.h @@ -24,7 +24,6 @@ #include #include #include -#include #ifndef _GL_INLINE_HEADER_BEGIN #error "Please include config.h first." diff --git a/lib/pipe2.c b/lib/pipe2.c index 400aff001a..a3cbb7f261 100644 --- a/lib/pipe2.c +++ b/lib/pipe2.c @@ -23,7 +23,6 @@ #include #include "binary-io.h" -#include "verify.h" #if GNULIB_defined_O_NONBLOCK # include "nonblocking.h" @@ -95,7 +94,7 @@ pipe2 (int fd[2], int flags) } # else { - verify (O_NONBLOCK == 0); + static_assert (O_NONBLOCK == 0); } # endif diff --git a/lib/rawmemchr.c b/lib/rawmemchr.c index ea68c1bfc6..bdd7307de4 100644 --- a/lib/rawmemchr.c +++ b/lib/rawmemchr.c @@ -23,10 +23,8 @@ #if !HAVE_RAWMEMCHR # include -# include # include -# include "verify.h" /* Find the first occurrence of C in S. */ void * @@ -36,7 +34,7 @@ rawmemchr (const void *s, int c_in) typedef uintptr_t longword; /* If you change the "uintptr_t", you should change UINTPTR_WIDTH to match. This verifies that the type does not have padding bits. */ - verify (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (longword)); + static_assert (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (longword)); const unsigned char *char_ptr; unsigned char c = c_in; diff --git a/lib/regex_internal.h b/lib/regex_internal.h index 57a455b1f4..784d2d4586 100644 --- a/lib/regex_internal.h +++ b/lib/regex_internal.h @@ -29,7 +29,6 @@ #include #include #include -#include #include #ifndef _LIBC diff --git a/lib/sha1.c b/lib/sha1.c index 79e50ba0b0..5a18213edc 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -29,7 +29,6 @@ #endif #include "sha1.h" -#include #include #include diff --git a/lib/sha256.c b/lib/sha256.c index c9ca618c67..60cd763612 100644 --- a/lib/sha256.c +++ b/lib/sha256.c @@ -28,7 +28,6 @@ #endif #include "sha256.h" -#include #include #include diff --git a/lib/sha512.c b/lib/sha512.c index 6776bb464d..fd17a7dc76 100644 --- a/lib/sha512.c +++ b/lib/sha512.c @@ -28,7 +28,6 @@ #endif #include "sha512.h" -#include #include #include diff --git a/lib/signal.in.h b/lib/signal.in.h index 640b5022f5..c0d4848db0 100644 --- a/lib/signal.in.h +++ b/lib/signal.in.h @@ -55,13 +55,21 @@ #ifndef _@GUARD_PREFIX@_SIGNAL_H #define _@GUARD_PREFIX@_SIGNAL_H -/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6, Android, +/* For testing the OpenBSD version. */ +#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \ + && defined __OpenBSD__ +# include +#endif + +/* Mac OS X 10.3, FreeBSD < 8.0, OpenBSD < 5.1, OSF/1 4.0, Solaris 2.6, Android, OS/2 kLIBC declare pthread_sigmask in , not in . But avoid namespace pollution on glibc systems.*/ #if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \ && ((defined __APPLE__ && defined __MACH__) \ - || defined __FreeBSD__ || defined __OpenBSD__ || defined __osf__ \ - || defined __sun || defined __ANDROID__ || defined __KLIBC__) \ + || (defined __FreeBSD__ && __FreeBSD__ < 8) \ + || (defined __OpenBSD__ && OpenBSD < 201205) \ + || defined __osf__ || defined __sun || defined __ANDROID__ \ + || defined __KLIBC__) \ && ! defined __GLIBC__ # include #endif diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h index 3b117df11f..58fd245c62 100644 --- a/lib/stdalign.in.h +++ b/lib/stdalign.in.h @@ -42,10 +42,7 @@ '-malign-double' is used. The result cannot be used as a value for an 'enum' constant, if you - want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. - - Include for offsetof. */ -#include + want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ /* FreeBSD 9.1 , included by and lots of other standard headers, defines conflicting implementations of _Alignas @@ -61,17 +58,19 @@ && !defined __clang__) \ || (defined __clang__ && __clang_major__ < 8)) # ifdef __cplusplus -# if 201103 <= __cplusplus +# if (201103 <= __cplusplus || defined _MSC_VER) # define _Alignof(type) alignof (type) # else template struct __alignof_helper { char __a; __t __b; }; # define _Alignof(type) offsetof (__alignof_helper, __b) +# define _GL_STDALIGN_NEEDS_STDDEF 1 # endif # else # define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) +# define _GL_STDALIGN_NEEDS_STDDEF 1 # endif #endif -#if ! (defined __cplusplus && 201103 <= __cplusplus) +#if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) # define alignof _Alignof #endif #define __alignof_is_defined 1 @@ -102,7 +101,7 @@ */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 -# if defined __cplusplus && 201103 <= __cplusplus +# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) # define _Alignas(a) alignas (a) # elif (!defined __attribute__ \ && ((defined __APPLE__ && defined __MACH__ \ @@ -116,12 +115,19 @@ # define _Alignas(a) __declspec (align (a)) # endif #endif -#if ((defined _Alignas && ! (defined __cplusplus && 201103 <= __cplusplus)) \ +#if ((defined _Alignas \ + && !(defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) \ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) # define alignas _Alignas #endif -#if defined alignas || (defined __cplusplus && 201103 <= __cplusplus) +#if (defined alignas \ + || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) # define __alignas_is_defined 1 #endif +/* Include if needed for offsetof. */ +#if _GL_STDALIGN_NEEDS_STDDEF +# include +#endif + #endif /* _GL_STDALIGN_H */ diff --git a/lib/stdckdint.in.h b/lib/stdckdint.in.h index 90fa62e596..762d3fdb79 100644 --- a/lib/stdckdint.in.h +++ b/lib/stdckdint.in.h @@ -20,8 +20,6 @@ #include "intprops-internal.h" -#include - /* Store into *R the low-order bits of A + B, A - B, A * B, respectively. Return 1 if the result overflows, 0 otherwise. A, B, and *R can have any integer type other than char, bool, a diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index a86643c3ca..8e0a609f1f 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -226,7 +226,7 @@ _GL_FUNCDECL_SYS (aligned_alloc, void *, _GL_CXXALIAS_SYS (aligned_alloc, void *, (size_t alignment, size_t size)); # endif # endif -# if @HAVE_ALIGNED_ALLOC@ +# if (__GLIBC__ >= 2) && @HAVE_ALIGNED_ALLOC@ _GL_CXXALIASWARN (aligned_alloc); # endif #else @@ -1363,7 +1363,9 @@ _GL_CXXALIAS_SYS (strtol, long, (const char *restrict string, char **restrict endptr, int base)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (strtol); +# endif #elif defined GNULIB_POSIXCHECK # undef strtol # if HAVE_RAW_DECL_STRTOL @@ -1444,7 +1446,9 @@ _GL_CXXALIAS_SYS (strtoul, unsigned long, (const char *restrict string, char **restrict endptr, int base)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (strtoul); +# endif #elif defined GNULIB_POSIXCHECK # undef strtoul # if HAVE_RAW_DECL_STRTOUL diff --git a/lib/string.in.h b/lib/string.in.h index 3996da9fcb..e56f6db0c9 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -943,7 +943,9 @@ _GL_FUNCDECL_SYS (mbslen, size_t, (const char *string) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_SYS (mbslen, size_t, (const char *string)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mbslen); +# endif #endif #if @GNULIB_MBSNLEN@ diff --git a/lib/strtoimax.c b/lib/strtoimax.c index cad12d0d9b..29d16d29ce 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -25,8 +25,6 @@ #include -#include "verify.h" - #ifdef UNSIGNED # ifndef HAVE_DECL_STRTOULL "this configure-time declaration test was not run" @@ -62,8 +60,8 @@ long long int strtoll (char const *, char **, int); Int Strtoimax (char const *ptr, char **endptr, int base) { - verify (sizeof (Int) == sizeof (Unsigned long int) - || sizeof (Int) == sizeof (Unsigned long long int)); + static_assert (sizeof (Int) == sizeof (Unsigned long int) + || sizeof (Int) == sizeof (Unsigned long long int)); if (sizeof (Int) != sizeof (Unsigned long int)) return Strtoll (ptr, endptr, base); diff --git a/lib/sys_random.in.h b/lib/sys_random.in.h index e730e6139f..c91bcd2cd0 100644 --- a/lib/sys_random.in.h +++ b/lib/sys_random.in.h @@ -84,7 +84,9 @@ _GL_FUNCDECL_SYS (getrandom, ssize_t, _GL_CXXALIAS_SYS (getrandom, ssize_t, (void *buffer, size_t length, unsigned int flags)); # endif +# if __GLIBC__ + (__GLIBC_MINOR__ >= 25) > 2 _GL_CXXALIASWARN (getrandom); +# endif #elif defined GNULIB_POSIXCHECK # undef getrandom # if HAVE_RAW_DECL_GETRANDOM diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h index 2bd0e0f79a..860e957fe0 100644 --- a/lib/sys_select.in.h +++ b/lib/sys_select.in.h @@ -82,9 +82,10 @@ of 'struct timeval', and no definition of this type. Also, Mac OS X, AIX, HP-UX, IRIX, Solaris, Interix declare select() in . - But avoid namespace pollution on glibc systems and "unknown type - name" problems on Cygwin. */ -# if !(defined __GLIBC__ || defined __CYGWIN__) + But avoid namespace pollution on glibc systems, a circular include + -> -> on FreeBSD 13.1, and + "unknown type name" problems on Cygwin. */ +# if !(defined __GLIBC__ || defined __FreeBSD__ || defined __CYGWIN__) # include # endif @@ -287,7 +288,9 @@ _GL_CXXALIAS_SYS_CAST (pselect, int, struct timespec const *restrict, const sigset_t *restrict)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (pselect); +# endif #elif defined GNULIB_POSIXCHECK # undef pselect # if HAVE_RAW_DECL_PSELECT diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 714c3cb189..0ec320f58c 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -596,44 +596,6 @@ _GL_WARN_ON_USE (lchmod, "lchmod is unportable - " #endif -#if @GNULIB_LSTAT@ -# if ! @HAVE_LSTAT@ -/* mingw does not support symlinks, therefore it does not have lstat. But - without links, stat does just fine. */ -# if !(defined __cplusplus && defined GNULIB_NAMESPACE) -# define lstat stat -# endif -_GL_CXXALIAS_RPL_1 (lstat, stat, int, - (const char *restrict name, struct stat *restrict buf)); -# elif @REPLACE_LSTAT@ -# if !(defined __cplusplus && defined GNULIB_NAMESPACE) -# undef lstat -# define lstat rpl_lstat -# endif -_GL_FUNCDECL_RPL (lstat, int, - (const char *restrict name, struct stat *restrict buf) - _GL_ARG_NONNULL ((1, 2))); -_GL_CXXALIAS_RPL (lstat, int, - (const char *restrict name, struct stat *restrict buf)); -# else -_GL_CXXALIAS_SYS (lstat, int, - (const char *restrict name, struct stat *restrict buf)); -# endif -# if @HAVE_LSTAT@ -_GL_CXXALIASWARN (lstat); -# endif -#elif @GNULIB_OVERRIDES_STRUCT_STAT@ -# undef lstat -# define lstat lstat_used_without_requesting_gnulib_module_lstat -#elif defined GNULIB_POSIXCHECK -# undef lstat -# if HAVE_RAW_DECL_LSTAT -_GL_WARN_ON_USE (lstat, "lstat is unportable - " - "use gnulib module lstat for portability"); -# endif -#endif - - #if @GNULIB_MKDIR@ # if @REPLACE_MKDIR@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -895,6 +857,44 @@ _GL_WARN_ON_USE (stat, "stat is unportable - " #endif +#if @GNULIB_LSTAT@ +# if ! @HAVE_LSTAT@ +/* mingw does not support symlinks, therefore it does not have lstat. But + without links, stat does just fine. */ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define lstat stat +# endif +_GL_CXXALIAS_RPL_1 (lstat, stat, int, + (const char *restrict name, struct stat *restrict buf)); +# elif @REPLACE_LSTAT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef lstat +# define lstat rpl_lstat +# endif +_GL_FUNCDECL_RPL (lstat, int, + (const char *restrict name, struct stat *restrict buf) + _GL_ARG_NONNULL ((1, 2))); +_GL_CXXALIAS_RPL (lstat, int, + (const char *restrict name, struct stat *restrict buf)); +# else +_GL_CXXALIAS_SYS (lstat, int, + (const char *restrict name, struct stat *restrict buf)); +# endif +# if @HAVE_LSTAT@ +_GL_CXXALIASWARN (lstat); +# endif +#elif @GNULIB_OVERRIDES_STRUCT_STAT@ +# undef lstat +# define lstat lstat_used_without_requesting_gnulib_module_lstat +#elif defined GNULIB_POSIXCHECK +# undef lstat +# if HAVE_RAW_DECL_LSTAT +_GL_WARN_ON_USE (lstat, "lstat is unportable - " + "use gnulib module lstat for portability"); +# endif +#endif + + #if @GNULIB_MDA_UMASK@ /* On native Windows, map 'umask' to '_umask', so that -loldnames is not required. In C++ with GNULIB_NAMESPACE, avoid differences between diff --git a/lib/tempname.c b/lib/tempname.c index 11b4796b34..dbff638f70 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -20,7 +20,6 @@ # include "tempname.h" #endif -#include #include #include diff --git a/lib/time.in.h b/lib/time.in.h index 6d4c771963..6aa67498f5 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -435,8 +435,10 @@ _GL_WARN_ON_USE (asctime, "asctime can overrun buffers in some cases - " # endif # if defined GNULIB_POSIXCHECK # undef asctime_r +# if HAVE_RAW_DECL_ASCTIME_R _GL_WARN_ON_USE (asctime_r, "asctime_r can overrun buffers in some cases - " "better use strftime (or even sprintf) instead"); +# endif # endif # if defined GNULIB_POSIXCHECK # undef ctime @@ -445,8 +447,10 @@ _GL_WARN_ON_USE (ctime, "ctime can overrun buffers in some cases - " # endif # if defined GNULIB_POSIXCHECK # undef ctime_r +# if HAVE_RAW_DECL_CTIME_R _GL_WARN_ON_USE (ctime_r, "ctime_r can overrun buffers in some cases - " "better use strftime (or even sprintf) instead"); +# endif # endif #endif diff --git a/lib/time_rz.c b/lib/time_rz.c index 1a91d3778e..601ce5950e 100644 --- a/lib/time_rz.c +++ b/lib/time_rz.c @@ -27,7 +27,6 @@ #include #include -#include #include #include #include diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 57df09ecdf..50f6e56550 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -1143,7 +1143,9 @@ _GL_FUNCDECL_SYS (getdomainname, int, (char *name, size_t len) # endif _GL_CXXALIAS_SYS (getdomainname, int, (char *name, size_t len)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getdomainname); +# endif #elif defined GNULIB_POSIXCHECK # undef getdomainname # if HAVE_RAW_DECL_GETDOMAINNAME @@ -2055,7 +2057,7 @@ _GL_CXXALIAS_MDA_CAST (swab, void, (char *from, char *to, int n)); # else # if defined __hpux /* HP-UX */ _GL_CXXALIAS_SYS (swab, void, (const char *from, char *to, int n)); -# elif defined __sun && !defined _XPG4 /* Solaris */ +# elif defined __sun && (defined __SunOS_5_10 || defined __XOPEN_OR_POSIX) && !defined _XPG4 /* Solaris */ _GL_CXXALIAS_SYS (swab, void, (const char *from, char *to, ssize_t n)); # else _GL_CXXALIAS_SYS (swab, void, (const void *from, void *to, ssize_t n)); diff --git a/lib/utimens.c b/lib/utimens.c index 2fa1251850..23b9180935 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -26,7 +26,6 @@ #include #include -#include #include #include #include diff --git a/lib/verify.h b/lib/verify.h index 47b6ee661b..99af802993 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -25,19 +25,19 @@ works as per C11. This is supported by GCC 4.6.0+ and by clang 4+. Define _GL_HAVE__STATIC_ASSERT1 to 1 if _Static_assert (R) works as - per C2x. This is supported by GCC 9.1+. + per C23. This is supported by GCC 9.1+. Support compilers claiming conformance to the relevant standard, and also support GCC when not pedantic. If we were willing to slow 'configure' down we could also use it with other compilers, but since this affects only the quality of diagnostics, why bother? */ #ifndef __cplusplus -# if (201112L <= __STDC_VERSION__ \ +# if (201112 <= __STDC_VERSION__ \ || (!defined __STRICT_ANSI__ \ && (4 < __GNUC__ + (6 <= __GNUC_MINOR__) || 5 <= __clang_major__))) # define _GL_HAVE__STATIC_ASSERT 1 # endif -# if (202000L <= __STDC_VERSION__ \ +# if (202000 <= __STDC_VERSION__ \ || (!defined __STRICT_ANSI__ && 9 <= __GNUC__)) # define _GL_HAVE__STATIC_ASSERT1 1 # endif @@ -202,12 +202,12 @@ template This macro requires three or more arguments but uses at most the first two, so that the _Static_assert macro optionally defined below supports - both the C11 two-argument syntax and the C2x one-argument syntax. + both the C11 two-argument syntax and the C23 one-argument syntax. Unfortunately, unlike C11, this implementation must appear as an ordinary declaration, and cannot appear inside struct { ... }. */ -#if 200410 <= __cpp_static_assert +#if 202311 <= __STDC_VERSION__ || 200410 <= __cpp_static_assert # define _GL_VERIFY(R, DIAGNOSTIC, ...) static_assert (R, DIAGNOSTIC) #elif defined _GL_HAVE__STATIC_ASSERT # define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC) @@ -223,11 +223,30 @@ template /* _GL_STATIC_ASSERT_H is defined if this code is copied into assert.h. */ #ifdef _GL_STATIC_ASSERT_H # if !defined _GL_HAVE__STATIC_ASSERT1 && !defined _Static_assert -# define _Static_assert(...) \ - _GL_VERIFY (__VA_ARGS__, "static assertion failed", -) +# define _Static_assert(R, ...) \ + _GL_VERIFY ((R), "static assertion failed", -) # endif -# if __cpp_static_assert < 201411 && !defined static_assert -# define static_assert _Static_assert /* C11 requires this #define. */ +# if (!defined static_assert \ + && __STDC_VERSION__ < 202311 \ + && (!defined __cplusplus \ + || (__cpp_static_assert < 201411 \ + && __GNUG__ < 6 && __clang_major__ < 6))) +# if defined __cplusplus && _MSC_VER >= 1900 && !defined __clang__ +/* MSVC 14 in C++ mode supports the two-arguments static_assert but not + the one-argument static_assert, and it does not support _Static_assert. + We have to play preprocessor tricks to distinguish the two cases. + Since the MSVC preprocessor is not ISO C compliant (cf. + ), the solution is specific + to MSVC. */ +# define _GL_EXPAND(x) x +# define _GL_SA1(a1) static_assert ((a1), "static assertion failed") +# define _GL_SA2 static_assert +# define _GL_SA3 static_assert +# define _GL_SA_PICK(x1,x2,x3,x4,...) x4 +# define static_assert(...) _GL_EXPAND(_GL_SA_PICK(__VA_ARGS__,_GL_SA3,_GL_SA2,_GL_SA1)) (__VA_ARGS__) +# else +# define static_assert _Static_assert /* C11 requires this #define. */ +# endif # endif #endif @@ -303,7 +322,7 @@ template # define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) #elif 1200 <= _MSC_VER # define assume(R) __assume (R) -#elif 202311L <= __STDC_VERSION__ +#elif 202311 <= __STDC_VERSION__ # include # define assume(R) ((R) ? (void) 0 : unreachable ()) #elif (defined GCC_LINT || defined lint) && _GL_HAS_BUILTIN_TRAP diff --git a/m4/assert_h.m4 b/m4/assert_h.m4 new file mode 100644 index 0000000000..c411a34aa7 --- /dev/null +++ b/m4/assert_h.m4 @@ -0,0 +1,60 @@ +# assert-h.m4 +dnl Copyright (C) 2011-2022 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl From Paul Eggert. + +AC_DEFUN([gl_ASSERT_H], +[ + AC_CACHE_CHECK([for static_assert], [gl_cv_static_assert], + [gl_save_CFLAGS=$CFLAGS + for gl_working in "yes, a keyword" "yes, an macro"; do + AS_CASE([$gl_working], + [*assert.h*], [CFLAGS="$gl_save_CFLAGS -DINCLUDE_ASSERT_H"]) + + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#if defined __clang__ && __STDC_VERSION__ < 202311 + #pragma clang diagnostic error "-Wc2x-extensions" + #endif + #ifdef INCLUDE_ASSERT_H + #include + #endif + static_assert (2 + 2 == 4, "arithmetic does not work"); + static_assert (2 + 2 == 4); + ]], + [[ + static_assert (sizeof (char) == 1, "sizeof does not work"); + static_assert (sizeof (char) == 1); + ]])], + [gl_cv_static_assert=$gl_working], + [gl_cv_static_assert=no]) + CFLAGS=$gl_save_CFLAGS + test "$gl_cv_static_assert" != no && break + done]) + + GL_GENERATE_ASSERT_H=false + AS_CASE([$gl_cv_static_assert], + [yes*keyword*], + [AC_DEFINE([HAVE_C_STATIC_ASSERT], [1], + [Define to 1 if the static_assert keyword works.])], + [no], + [GL_GENERATE_ASSERT_H=true + gl_NEXT_HEADERS([assert.h])]) + + dnl The "zz" puts this toward config.h's end, to avoid potential + dnl collisions with other definitions. #undef assert so that + dnl programs are not tempted to use it without specifically + dnl including assert.h. Break the #undef apart with a comment + dnl so that 'configure' does not comment it out. + AH_VERBATIM([zzstatic_assert], +[#if (!defined HAVE_C_STATIC_ASSERT && !defined assert \ + && (!defined __cplusplus \ + || (__cpp_static_assert < 201411 \ + && __GNUG__ < 6 && __clang_major__ < 6))) + #include + #undef/**/assert +#endif]) +]) diff --git a/m4/gettime.m4 b/m4/gettime.m4 index f0aeb4d0e4..c3e0713b57 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,4 +1,4 @@ -# gettime.m4 serial 11 +# gettime.m4 serial 12 dnl Copyright (C) 2002, 2004-2006, 2009-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -9,7 +9,34 @@ AC_DEFUN([gl_GETTIME], dnl Prerequisites of lib/gettime.c. AC_REQUIRE([gl_CLOCK_TIME]) AC_REQUIRE([gl_TIMESPEC]) - AC_CHECK_FUNCS_ONCE([timespec_get]) + + AC_REQUIRE([gl_CHECK_FUNC_TIMESPEC_GET]) + if test $gl_cv_func_timespec_get = yes; then + AC_DEFINE([HAVE_TIMESPEC_GET], [1], + [Define if you have the timespec_get function.]) + fi +]) + +dnl Tests whether the function timespec_get exists. +dnl Sets gl_cv_func_timespec_get. +AC_DEFUN([gl_CHECK_FUNC_TIMESPEC_GET], +[ + dnl Persuade OpenBSD to declare timespec_get(). + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + + dnl We can't use AC_CHECK_FUNC here, because timespec_get() is defined as a + dnl static inline function in on MSVC 14. + AC_CACHE_CHECK([for timespec_get], [gl_cv_func_timespec_get], + [AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + struct timespec ts; + ]], + [[return timespec_get (&ts, 0);]]) + ], + [gl_cv_func_timespec_get=yes], + [gl_cv_func_timespec_get=no]) + ]) ]) AC_DEFUN([gl_GETTIME_RES], diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 8a5daa230e..d17cbec58c 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 73 +# gnulib-common.m4 serial 74 dnl Copyright (C) 2007-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -115,7 +115,7 @@ AC_DEFUN([gl_COMMON_BODY], [ # define _GL_HAS_C_ATTRIBUTE(attr) 0 #endif -]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's _Alignas instead. +]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's alignas instead. [ /* _GL_ATTRIBUTE_ALLOC_SIZE ((N)) declares that the Nth argument of the function is the size of the returned memory block. diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 0c43dde716..6a5f300678 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -46,6 +46,7 @@ AC_DEFUN([gl_EARLY], # Code from module acl-permissions: # Code from module alloca-opt: # Code from module allocator: + # Code from module assert-h: # Code from module at-internal: # Code from module attribute: # Code from module binary-io: @@ -122,8 +123,8 @@ AC_DEFUN([gl_EARLY], # Code from module intprops: # Code from module inttypes-incomplete: # Code from module largefile: - AC_REQUIRE([AC_SYS_LARGEFILE]) AC_REQUIRE([gl_YEAR2038_EARLY]) + AC_REQUIRE([AC_SYS_LARGEFILE]) # Code from module lchmod: # Code from module libc-config: # Code from module libgmp: @@ -233,6 +234,9 @@ AC_DEFUN([gl_INIT], gl_FUNC_ALLOCA gl_CONDITIONAL_HEADER([alloca.h]) AC_PROG_MKDIR_P + gl_ASSERT_H + gl_CONDITIONAL_HEADER([assert.h]) + AC_PROG_MKDIR_P gl___BUILTIN_EXPECT gl_BYTESWAP gl_CONDITIONAL_HEADER([byteswap.h]) @@ -1214,6 +1218,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/allocator.c lib/allocator.h lib/arg-nonnull.h + lib/assert.in.h lib/at-func.c lib/attribute.h lib/binary-io.c @@ -1420,6 +1425,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/absolute-header.m4 m4/acl.m4 m4/alloca.m4 + m4/assert_h.m4 m4/builtin-expect.m4 m4/byteswap.m4 m4/canonicalize.m4 diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4 index 1964b1ea47..dfe21f56d5 100644 --- a/m4/nanosleep.m4 +++ b/m4/nanosleep.m4 @@ -1,4 +1,4 @@ -# serial 41 +# serial 42 dnl From Jim Meyering. dnl Check for the nanosleep function. @@ -100,15 +100,22 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], #else /* A simpler test for native Windows. */ if (nanosleep (&ts_sleep, &ts_remaining) < 0) return 3; + /* Test for 32-bit mingw bug: negative nanosecond values do not + cause failure. */ + ts_sleep.tv_sec = 1; + ts_sleep.tv_nsec = -1; + if (nanosleep (&ts_sleep, &ts_remaining) != -1) + return 7; #endif return 0; }]])], [gl_cv_func_nanosleep=yes], - [case $? in dnl ( - 4|5|6) gl_cv_func_nanosleep='no (mishandles large arguments)';; dnl ( - *) gl_cv_func_nanosleep=no;; + [case $? in + 4|5|6) gl_cv_func_nanosleep='no (mishandles large arguments)' ;; + 7) gl_cv_func_nanosleep='no (mishandles negative tv_nsec)' ;; + *) gl_cv_func_nanosleep=no ;; esac], - [case "$host_os" in dnl (( + [case "$host_os" in linux*) # Guess it halfway works when the kernel is Linux. gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;; mingw*) # Guess no on native Windows. diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index 78577cb2ac..324e91dae2 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -1,4 +1,4 @@ -# Check for stdalign.h that conforms to C11. +# Check for alignas and alignof that conform to C23. dnl Copyright 2011-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -9,12 +9,18 @@ dnl with or without modifications, as long as this notice is preserved. AC_DEFUN([gl_STDALIGN_H], [ - AC_CACHE_CHECK([for working stdalign.h], + AC_CACHE_CHECK([for alignas and alignof], [gl_cv_header_working_stdalign_h], - [AC_COMPILE_IFELSE( + [gl_save_CFLAGS=$CFLAGS + for gl_working in "yes, keywords" "yes, macros"; do + AS_CASE([$gl_working], + [*stdalign.h*], [CFLAGS="$gl_save_CFLAGS -DINCLUDE_STDALIGN_H"]) + AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( [[#include - #include + #ifdef INCLUDE_STDALIGN_H + #include + #endif #include /* Test that alignof yields a result consistent with offsetof. @@ -30,7 +36,7 @@ AC_DEFUN([gl_STDALIGN_H], char test_long[ao (long int) % _Alignof (long int) == 0 ? 1 : -1]; char test_alignof[alignof (double) == _Alignof (double) ? 1 : -1]; - /* Test _Alignas only on platforms where gnulib can help. */ + /* Test alignas only on platforms where gnulib can help. */ #if \ ((defined __cplusplus && 201103 <= __cplusplus) \ || (__TINYC__ && defined __attribute__) \ @@ -45,12 +51,84 @@ AC_DEFUN([gl_STDALIGN_H], ? 1 : -1]; #endif ]])], - [gl_cv_header_working_stdalign_h=yes], - [gl_cv_header_working_stdalign_h=no])]) - - if test $gl_cv_header_working_stdalign_h = yes; then - GL_GENERATE_STDALIGN_H=false - else - GL_GENERATE_STDALIGN_H=true - fi + [gl_cv_header_working_stdalign_h=$gl_working], + [gl_cv_header_working_stdalign_h=no]) + + CFLAGS=$gl_save_CFLAGS + test "$gl_cv_header_working_stdalign_h" != no && break + done]) + + GL_GENERATE_STDALIGN_H=false + AS_CASE([$gl_cv_header_working_stdalign_h], + [no], + [GL_GENERATE_STDALIGN_H=true], + [yes*keyword*], + [AC_DEFINE([HAVE_C_ALIGNASOF], [1], + [Define to 1 if the alignas and alignof keywords work.])]) + + AC_CHECK_HEADERS_ONCE([stdalign.h]) + + dnl The "zz" puts this toward config.h's end, to avoid potential + dnl collisions with other definitions. + AH_VERBATIM([zzalignas], +[#if !defined HAVE_C_ALIGNASOF && __cplusplus < 201103 && !defined alignof +# if HAVE_STDALIGN_H +# include +# else + /* Substitute. Keep consistent with gnulib/lib/stdalign.in.h. */ +# ifndef _GL_STDALIGN_H +# define _GL_STDALIGN_H +# undef _Alignas +# undef _Alignof +# if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ + || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ + && !defined __clang__) \ + || (defined __clang__ && __clang_major__ < 8)) +# ifdef __cplusplus +# if (201103 <= __cplusplus || defined _MSC_VER) +# define _Alignof(type) alignof (type) +# else + template struct __alignof_helper { char __a; __t __b; }; +# define _Alignof(type) offsetof (__alignof_helper, __b) +# define _GL_STDALIGN_NEEDS_STDDEF 1 +# endif +# else +# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) +# define _GL_STDALIGN_NEEDS_STDDEF 1 +# endif +# endif +# if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) +# define alignof _Alignof +# endif +# define __alignof_is_defined 1 +# if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 +# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) +# define _Alignas(a) alignas (a) +# elif (!defined __attribute__ \ + && ((defined __APPLE__ && defined __MACH__ \ + ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ + : __GNUC__ && !defined __ibmxl__) \ + || (4 <= __clang_major__) \ + || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ + || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)) +# define _Alignas(a) __attribute__ ((__aligned__ (a))) +# elif 1300 <= _MSC_VER +# define _Alignas(a) __declspec (align (a)) +# endif +# endif +# if ((defined _Alignas \ + && !(defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) \ + || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) +# define alignas _Alignas +# endif +# if (defined alignas \ + || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) +# define __alignas_is_defined 1 +# endif +# if _GL_STDALIGN_NEEDS_STDDEF +# include +# endif +# endif /* _GL_STDALIGN_H */ +# endif +#endif]) ]) diff --git a/m4/time_h.m4 b/m4/time_h.m4 index 98d7b6e01b..4ac8fd0075 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -2,7 +2,7 @@ # Copyright (C) 2000-2001, 2003-2007, 2009-2022 Free Software Foundation, Inc. -# serial 19 +# serial 20 # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, @@ -19,6 +19,12 @@ AC_DEFUN_ONCE([gl_TIME_H], gl_NEXT_HEADERS([time.h]) AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC]) + dnl Check for declarations of anything we want to poison if the + dnl corresponding gnulib module is not in use. + gl_WARN_ON_USE_PREPARE([[ +#include + ]], [asctime_r ctime_r]) + AC_REQUIRE([AC_C_RESTRICT]) AC_CACHE_CHECK([for TIME_UTC in ], commit c1eb13b32676b288a3ab3826501caf7bcd376b7f Author: Sean Whitton Date: Tue Sep 27 17:49:05 2022 -0700 Maintaining ChangeLog history: add more details * admin/notes/repo (Maintaining ChangeLog history): Add more details. See . diff --git a/admin/notes/repo b/admin/notes/repo index f6004a97db..c2d7f993a0 100644 --- a/admin/notes/repo +++ b/admin/notes/repo @@ -124,6 +124,11 @@ This ChangeLog file is not put into the repository. 'make change-history' copies all newer ChangeLog entries into the start of the newest ChangeLog history file. These ChangeLog entries are thereafter considered to be old, so later uses of 'make ChangeLog' -and/or 'make change-history' will no longer copy the entries. To -alter ChangeLog history, run 'make change-history', then edit -the ChangeLog history files manually and commit your changes. +and/or 'make change-history' will no longer copy the entries. + +To alter ChangeLog history, run 'make change-history' and commit the +changes made by that command. Then edit the ChangeLog history files +manually and commit those changes in a second, distinct commit. +Altering ChangeLog history like this can make things harder for those +who handle merging branches and Emacs releases, so reserve it for +correcting more serious mistakes. commit adaa2fc90e5c5da4d2469bc20614328ec2ddca78 Author: Stefan Kangas Date: Tue Sep 27 23:28:26 2022 +0200 ; * lisp/image/image-dired.el: Fix typo. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 2c2f24be64..f4ae6e9bfd 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -361,7 +361,7 @@ This affects the following commands: "Face for the directory name in the header line of the thumbnail buffer." :version "29.1") -(defface -image-dired-thumb-header-file-size +(defface image-dired-thumb-header-file-size '((((class color) (min-colors 88)) :foreground "cadet blue") (((class color) (min-colors 16)) :foreground "black") (default :inherit header-line)) commit 9e0c21ea73e41916322cbeef5751400c5353bd5a Author: Stefan Kangas Date: Tue Sep 27 23:26:07 2022 +0200 Make image-dired-dired-toggle-marked-thumbs faster * lisp/image/image-dired-dired.el (image-dired-dired-toggle-marked-thumbs): Don't show progress, since it makes things slower. diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index 94367b566e..d03c1629da 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -83,8 +83,8 @@ previous -ARG, if ARG<0) files." if (overlay-get ov 'put-image) return ov)) (overlay-put overlay 'image-file image-file) (overlay-put overlay 'thumb-file thumb-file))))) - arg ; Show or hide image on ARG next files. - 'show-progress) ; Update dired display after each image is updated. + ;; Show or hide thumbnail on ARG next files. + arg) (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)) commit a438e95c105f49492c9b9b4bb8ecc4c6e714a0cf Author: Lin Sun Date: Tue Sep 27 23:14:52 2022 +0200 Load compiled "calc-loaddefs", if any * lisp/calc/calc.el ("calc-loaddefs"): Load the .elc file (if it exists) (bug#58127). diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index c0f87ad3d4..6ea8a4202f 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1162,7 +1162,7 @@ Used by `calc-user-invocation'.") ;;;; (Autoloads here) -(load "calc-loaddefs.el" nil t) +(load "calc-loaddefs" nil t) ;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch) commit 42290bf8231159f5188d4b3c5861aa02f0489c61 Author: Stefan Kangas Date: Tue Sep 27 22:58:31 2022 +0200 image-dired: Fix header line when file is missing * lisp/image/image-dired.el (image-dired-format-properties-string): Don't error when file has been deleted. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 98bb6b3c5a..2c2f24be64 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -768,9 +768,11 @@ comment." 'face 'image-dired-thumb-header-file-name)) (?n . ,(propertize image-count 'face 'image-dired-thumb-header-image-count)) - (?s . ,(propertize (file-size-human-readable - (file-attribute-size - (file-attributes file))) + (?s . ,(propertize (if (file-exists-p file) + (file-size-human-readable + (file-attribute-size + (file-attributes file))) + "") 'face 'image-dired-thumb-header-file-size)) (?t . ,(or props "")) (?c . ,(or comment ""))))) commit e638aaf6e82aa9eeb5e5723b995d3295b53fa6c9 Author: Stefan Monnier Date: Tue Sep 27 15:10:47 2022 -0400 * lisp/files.el (file-backup-file-names): Don't burp if dir doesn't exist diff --git a/lisp/files.el b/lisp/files.el index 1e1ec6127d..b953961aa1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6127,16 +6127,17 @@ recent files are first." (let* ((filename (file-name-sans-versions (make-backup-file-name (expand-file-name filename)))) (dir (file-name-directory filename))) - (sort - (seq-filter - (lambda (candidate) - (and (backup-file-name-p candidate) - (string= (file-name-sans-versions candidate) filename))) - (mapcar - (lambda (file) - (concat dir file)) - (file-name-all-completions (file-name-nondirectory filename) dir))) - #'file-newer-than-file-p))) + (when (file-directory-p dir) + (sort + (seq-filter + (lambda (candidate) + (and (backup-file-name-p candidate) + (string= (file-name-sans-versions candidate) filename))) + (mapcar + (lambda (file) + (concat dir file)) + (file-name-all-completions (file-name-nondirectory filename) dir))) + #'file-newer-than-file-p)))) (defun rename-uniquely () "Rename current buffer to a similar name not already taken. commit d322adabf240a2b39f1b937b8e86009c32be9620 Author: Stefan Kangas Date: Tue Sep 27 20:01:38 2022 +0200 Add back useful information from gnus-coding.texi * lisp/international/rfc1843.el: * lisp/net/pop3.el: Improve Commentary by adding back text from deleted file gnus-coding.texi. diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el index 5050b7c030..73b610c034 100644 --- a/lisp/international/rfc1843.el +++ b/lisp/international/rfc1843.el @@ -1,4 +1,4 @@ -;;; rfc1843.el --- HZ (rfc1843) decoding -*- lexical-binding:t -*- +;;; rfc1843.el --- HZ (RFC 1843) decoding -*- lexical-binding:t -*- ;; Copyright (C) 1998-2022 Free Software Foundation, Inc. @@ -22,6 +22,9 @@ ;;; Commentary: +;; HZ (RFC 1843) decoding. HZ is a data format for exchanging files +;; of arbitrarily mixed Chinese and ASCII characters. +;; ;; Test: ;; (rfc1843-decode-string "~{<:Ky2;S{#,NpJ)l6HK!#~}") diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index 9d59ddf978..1bd52c7a56 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -23,6 +23,8 @@ ;;; Commentary: +;; Post Office Protocol version 3 (RFC 1460) interface. +;; ;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands ;; are implemented. The LIST command has not been implemented due to lack ;; of actual usefulness. commit 9f84d318b04a30532dfe9712500c22b908f08cfa Author: Lars Ingebrigtsen Date: Tue Sep 27 19:31:35 2022 +0200 Remove gnus-coding.text (bug#58119) diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi deleted file mode 100644 index 0858432acf..0000000000 --- a/doc/misc/gnus-coding.texi +++ /dev/null @@ -1,227 +0,0 @@ -\input texinfo - -@setfilename gnus-coding.info -@settitle Gnus Coding Style and Maintenance Guide -@include docstyle.texi -@syncodeindex fn cp -@syncodeindex vr cp -@syncodeindex pg cp - -@copying -Copyright @copyright{} 2004--2005, 2007--2022 Free Software Foundation, -Inc. - -@quotation -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with no -Invariant Sections, with the Front-Cover Texts being ``A GNU Manual'', -and with the Back-Cover Texts as in (a) below. A copy of the license -is included in the section entitled ``GNU Free Documentation License''. - -(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and -modify this GNU manual.'' -@end quotation -@end copying - - -@titlepage -@title Gnus Coding Style and Maintenance Guide - -@author by Reiner Steib - -@insertcopying -@end titlepage - -@c Obviously this is only a very rudimentary draft. We put it in the -@c repository anyway hoping that it might annoy someone enough to fix -@c it. ;-) Fixing only a paragraph also is appreciated. - -@ifnottex -@node Top -@top Gnus Coding Style and Maintenance Guide -This manual describes @dots{} - -@insertcopying -@end ifnottex - -@menu -* Gnus Coding Style:: Gnus Coding Style -* Gnus Maintenance Guide:: Gnus Maintenance Guide -* GNU Free Documentation License:: The license for this documentation. -@end menu - -@c @ref{Gnus Reference Guide, ,Gnus Reference Guide, gnus, The Gnus Newsreader} - -@node Gnus Coding Style -@chapter Gnus Coding Style -@section Dependencies - -The Gnus distribution contains a lot of libraries that have been written -for Gnus and used intensively for Gnus. But many of those libraries are -useful on their own. E.g., other Emacs Lisp packages might use the -@acronym{MIME} library @xref{Top, ,Top, emacs-mime, The Emacs MIME -Manual}. - -@subsection General purpose libraries - -@table @file - -@item netrc.el -@file{.netrc} parsing functionality. -@c As of 2005-10-21... -There are no Gnus dependencies in this file. - -@item format-spec.el -Functions for formatting arbitrary formatting strings. -@c As of 2005-10-21... -There are no Gnus dependencies in this file. - -@item hex-util.el -Functions to encode/decode hexadecimal string. -@c As of 2007-08-25... -There are no Gnus dependencies in these files. -@end table - -@subsection Encryption and security - -@table @file -@item encrypt.el -File encryption routines -@c As of 2005-10-25... -There are no Gnus dependencies in this file. - -@item password.el -Read passwords from user, possibly using a password cache. -@c As of 2005-10-21... -There are no Gnus dependencies in this file. - -@item sha1.el -SHA1 Secure Hash Algorithm. -@c As of 2007-08-25... -There are no Gnus dependencies in these files. -@end table - -@subsection Networking - -@table @file -@item dig.el -Domain Name System dig interface. -@c As of 2005-10-21... -There are no serious Gnus dependencies in this file. Uses -@code{gnus-run-mode-hooks} (a wrapper function). - -@item dns.el, dns-mode.el -Domain Name Service lookups. -@c As of 2005-10-21... -There are no Gnus dependencies in these files. -@end table - -@subsection Mail and News related RFCs - -@table @file -@item pop3.el -Post Office Protocol (RFC 1460) interface. -@c As of 2005-10-21... -There are no Gnus dependencies in this file. - -@item imap.el -@acronym{IMAP} library. -@c As of 2005-10-21... -There are no Gnus dependencies in this file. - -@item ietf-drums.el -Functions for parsing RFC 2822 headers. -@c As of 2005-10-21... -There are no Gnus dependencies in this file. - -@item rfc1843.el -HZ (rfc1843) decoding. HZ is a data format for exchanging files of -arbitrarily mixed Chinese and @acronym{ASCII} characters. -@c As of 2005-10-21... -@code{rfc1843-gnus-setup} seem to be useful only for Gnus. Maybe this -function should be relocated to remove dependencies on Gnus. Other -minor dependencies: @code{gnus-newsgroup-name} could be eliminated by -using an optional argument to @code{rfc1843-decode-article-body}. - -@item rfc2045.el -Functions for decoding rfc2045 headers -@c As of 2007-08-25... -There are no Gnus dependencies in these files. - -@item rfc2047.el -Functions for encoding and decoding rfc2047 messages -@c As of 2007-08-25... -There are no Gnus dependencies in these files. -@c -Only a couple of tests for gnusy symbols. - -@item rfc2104.el -RFC2104 Hashed Message Authentication Codes -@c As of 2007-08-25... -There are no Gnus dependencies in these files. - -@item rfc2231.el -Functions for decoding rfc2231 headers -@c As of 2007-08-25... -There are no Gnus dependencies in these files. - -@item flow-fill.el -Interpret RFC2646 "flowed" text. -@c As of 2005-10-27... -There are no Gnus dependencies in this file. - -@item uudecode.el -Elisp native uudecode. -@c As of 2005-12-06... -There are no Gnus dependencies in this file. -@c ... but the custom group is gnus-extract. - -@item canlock.el -Functions for Cancel-Lock feature -@c Cf. draft-ietf-usefor-cancel-lock-01.txt -@c Although this draft has expired, Canlock-Lock revived in 2007 when -@c major news providers (e.g., news.individual.org) started to use it. -@c As of 2007-08-25... -There are no Gnus dependencies in these files. - -@end table - -@subsection message - -All message composition from Gnus (both mail and news) takes place in -Message mode buffers. Message mode is intended to be a replacement for -Emacs mail mode. There should be no Gnus dependencies in -@file{message.el}. Alas it is not anymore. Patches and suggestions to -remove the dependencies are welcome. - -@c message.el requires nnheader which requires gnus-util. - -@subsection Emacs @acronym{MIME} - -The files @file{mml*.el} and @file{mm-*.el} provide @acronym{MIME} -functionality for Emacs. - -@acronym{MML} (@acronym{MIME} Meta Language) is supposed to be -independent from Gnus. Alas it is not anymore. Patches and suggestions -to remove the dependencies are welcome. - -@subsection Gnus backends - -The files @file{nn*.el} provide functionality for accessing NNTP -(@file{nntp.el}), IMAP (@file{nnimap.el}) and several other Mail back -ends (probably @file{nnml.el}, @file{nnfolder.el} and -@file{nnmaildir.el} are the most widely used mail back ends). - -@c mm-uu requires nnheader which requires gnus-util. message.el also -@c requires nnheader. - - -@node GNU Free Documentation License -@appendix GNU Free Documentation License -@include doclicense.texi - -@c Local Variables: -@c mode: texinfo -@c coding: utf-8 -@c End: commit c273e26af58aab340b470595874893b23dab208d Author: Michael Albinus Date: Tue Sep 27 18:46:28 2022 +0200 Some tramp-docker.el adaptions * lisp/net/tramp-docker.el (tramp-docker--completion-function): Add ;;;###tramp-autoload cookie. Make implementation more robust. (tramp-methods) Use `tramp-default-remote-shell'. diff --git a/lisp/net/tramp-docker.el b/lisp/net/tramp-docker.el index 40257a4a12..918469908a 100644 --- a/lisp/net/tramp-docker.el +++ b/lisp/net/tramp-docker.el @@ -53,23 +53,26 @@ (defconst tramp-docker-method "docker" "Tramp method name to use to connect to Docker containers.") +;;;###tramp-autoload (defun tramp-docker--completion-function (&rest _args) "List Docker containers available for connection. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." - (let* ((raw-list (shell-command-to-string - (concat tramp-docker-program - " ps --format '{{.ID}}\t{{.Names}}'"))) - (lines (split-string raw-list "\n")) - (names (mapcar (lambda (line) - (let ((words (split-string line "\t"))) - (or (nth 1 words) (nth 0 words)))) - lines)) - (machines (seq-take-while (lambda (name) name) names))) - (mapcar (lambda (m) (list nil m)) machines))) - -;; todo: check tramp-async-args and tramp-direct-async + (when-let ((raw-list (shell-command-to-string + (concat tramp-docker-program + " ps --format '{{.ID}}\t{{.Names}}'"))) + (lines (split-string raw-list "\n" 'omit)) + (names (mapcar + (lambda (line) + (when (string-match + (rx bol (group (1+ nonl)) + "\t" (? (group (1+ nonl))) eol) + line) + (or (match-string 2 line) (match-string 1 line)))) + lines))) + (mapcar (lambda (m) (list nil m)) (delq nil names)))) + ;;;###tramp-autoload (tramp--with-startup (push `(,tramp-docker-method @@ -78,8 +81,8 @@ see its function help for a description of the format." ("-it") ("-u" "%u") ("%h") - ("/bin/sh"))) - (tramp-remote-shell "/bin/sh") + ("%l"))) + (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c"))) tramp-methods) commit 49d40cd95320d5f4de4362b32c8ed203a6ef573e Author: Stefan Kangas Date: Tue Sep 27 15:56:22 2022 +0200 ; Simplify wallpaper--format-arg with let-alist * lisp/image/wallpaper.el (wallpaper--format-arg): Use let-alist. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 4ad09e893c..0a891f9012 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -422,11 +422,9 @@ FILE is the image file name." (match-string 1 display) "0"))) ;; monitor name - (?M . ,(let* ((attrs (car (display-monitor-attributes-list))) - (source (cdr (assq 'source attrs))) - (monitor (cdr (assq 'name attrs)))) - (if (and monitor (member source '("XRandr" "XRandR 1.5" "Gdk"))) - monitor + (?M . ,(let-alist (car (display-monitor-attributes-list)) + (if (and .name (member .source '("XRandr" "XRandR 1.5" "Gdk"))) + .name "0"))) ;; workspace (?W . ,(or (and (fboundp 'x-window-property) commit 071d811c0ff507e46dcbc53eb4614fe01e519e28 Author: Stefan Kangas Date: Tue Sep 27 15:42:30 2022 +0200 * etc/NEWS.23: Belatedly announce 'format-spec'. diff --git a/etc/NEWS.23 b/etc/NEWS.23 index ef87db79d9..5f13845dcb 100644 --- a/etc/NEWS.23 +++ b/etc/NEWS.23 @@ -2543,6 +2543,8 @@ a list of buffers/files to search for a string/regexp. ** The new major mode 'special-mode' is intended as a parent for major modes such as those that set the "'mode-class 'special" property. +** New package format-spec.el provides 'format-spec'. + ---------------------------------------------------------------------- This file is part of GNU Emacs. commit 1e4f40db3ac4ab46ff22c1a3aaed9053787847af Author: Stefan Kangas Date: Tue Sep 27 15:33:05 2022 +0200 ; * lisp/image/wallpaper.el (wallpaper--format-arg): Fix typo. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 36bc7e91a6..4ad09e893c 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -425,7 +425,7 @@ FILE is the image file name." (?M . ,(let* ((attrs (car (display-monitor-attributes-list))) (source (cdr (assq 'source attrs))) (monitor (cdr (assq 'name attrs)))) - (if (and monitor (member source '("XRandr" "XRandr 1.5" "Gdk"))) + (if (and monitor (member source '("XRandr" "XRandR 1.5" "Gdk"))) monitor "0"))) ;; workspace commit 327890dd6c96d55a9471a80ac53c36c2e51ec5d7 Author: Stefan Kangas Date: Tue Sep 27 15:29:33 2022 +0200 Document the new "XRandR 1.5" value * src/xfns.c (Fx_display_monitor_attributes_list): * lisp/frame.el (display-monitor-attributes-list): * doc/lispref/frames.texi (Multiple Terminals): Document the new "XRandR 1.5" value. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index e38a81d3e7..8db6ad0fd3 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -407,7 +407,7 @@ Name of the physical monitor as @var{string}. @item source Source of the multi-monitor information as @var{string}; -e.g., @samp{XRandr} or @samp{Xinerama}. +e.g., @samp{XRandR 1.5}, @samp{XRandr} or @samp{Xinerama}. @end table @var{x}, @var{y}, @var{width}, and @var{height} are integers. diff --git a/lisp/frame.el b/lisp/frame.el index 1d7784dc76..400f8a44ee 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2425,9 +2425,9 @@ It may be less than the total screen size, owing to space taken up by window manager features (docks, taskbars, etc.). The precise details depend on the platform and environment. -The `source' attribute describes the source from which the information -was obtained. On X, this may be one of: \"Gdk\", \"XRandr\", \"Xinerama\", -or \"fallback\". +The `source' attribute describes the source from which the +information was obtained. On X, this may be one of: \"Gdk\", +\"XRandR 1.5\", \"XRandr\", \"Xinerama\", or \"fallback\". A frame is dominated by a physical monitor when either the largest area of the frame resides in the monitor, or the monitor diff --git a/src/xfns.c b/src/xfns.c index 1d0210cb9e..bb75ca5ad1 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6244,8 +6244,8 @@ In addition to the standard attribute keys listed in the attributes: source -- String describing the source from which multi-monitor - information is obtained, one of \"Gdk\", \"XRandr\", - \"Xinerama\", or \"fallback\" + information is obtained, one of \"Gdk\", \"XRandR 1.5\", + \"XRandr\", \"Xinerama\", or \"fallback\" Internal use only, use `display-monitor-attributes-list' instead. */) (Lisp_Object terminal) commit 37fe62a3bda82d21aa6fa30d28f1c51e4bd8e6b4 Author: Eli Zaretskii Date: Tue Sep 27 16:01:50 2022 +0300 ; Fix documentation of imenu access in DocView * lisp/doc-view.el (doc-view-imenu-enabled) (doc-view--pdf-outline, doc-view-imenu-index): Doc fixes. * doc/emacs/misc.texi (DocView Navigation): Fix typo and wording. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index f3a6e6c33b..04f7f2e921 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -585,11 +585,11 @@ default size for DocView, customize the variable @code{doc-view-resolution}. @vindex doc-view-imenu-enabled - When the @command{mutool} executable is available, DocView will use + When the @command{mutool} program is available, DocView will use it to generate entries for an outline menu, making it accessible via the -imenu facility (@pxref{Imenu}). To disable this functionality even -when @command{mutool} can be found in your @code{exec-path}, customize -the variable @code{doc-view-imenu-enabled}. +@code{imenu} facility (@pxref{Imenu}). To disable this functionality +even when @command{mutool} can be found on your system, customize +the variable @code{doc-view-imenu-enabled} to the @code{nil} value. @node DocView Searching @subsection DocView Searching diff --git a/lisp/doc-view.el b/lisp/doc-view.el index fe772efcfc..fa583df12b 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -215,7 +215,7 @@ are available (see Info node `(emacs)Document View')." :version "29.1") (defcustom doc-view-imenu-enabled (and (executable-find "mutool") t) - "Whether to generate an imenu outline when mutool is available." + "Whether to generate an imenu outline when \"mutool\" is available." :type 'boolean :version "29.1") @@ -1884,9 +1884,10 @@ If BACKWARD is non-nil, jump to the previous match." "[^\t]+\\(\t+\\)\"\\(.+\\)\"\t#\\(?:page=\\)?\\([0-9]+\\)") (defun doc-view--pdf-outline (&optional file-name) - "Return a describing the outline of FILE-NAME (or current if nil). + "Return a list describing the outline of FILE-NAME. +Return a list describing the current file if FILE-NAME is nil. -Each element in the list contains information about a section's +Each element in the returned list contains information about a section's title, nesting level and page number. The list is flat: its tree structure is extracted by `doc-view--imenu-subtree'." (let* ((outline nil) @@ -1925,11 +1926,11 @@ entries at an upper level." (cons (nreverse index) outline))) (defun doc-view-imenu-index (&optional file-name goto-page-fn) - "Create an imenu index using mutool to extract its outline. + "Create an imenu index using \"mutool\" to extract its outline. -For extensibility, a FILE-NAME other than the current buffer and -a jumping function, GOTO-PAGE-FN other than `doc-view-goto-page' -can be specified." +For extensibility, callers can specify a FILE-NAME to indicate +the buffer other than the current buffer, and a jumping function +GOTO-PAGE-FN other than `doc-view-goto-page'." (let* ((goto (or goto-page-fn 'doc-view-goto-page)) (act (lambda (_name _pos page) (funcall goto page)))) (car (doc-view--imenu-subtree (doc-view--pdf-outline file-name) act)))) commit fe215074392d7cdd965b97119892fa4e5366a051 Author: Po Lu Date: Tue Sep 27 20:04:11 2022 +0800 ; * src/xfns.c (Fx_window_property): Fix markup. diff --git a/src/xfns.c b/src/xfns.c index 539e8c6dbe..1d0210cb9e 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7739,7 +7739,7 @@ properties are specified as part of the Extended Window Manager Hints and the Inter-Client Communication Conventions Manual, which are located here: - https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html + https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html and commit 60b4fe92c81c4e6a533fb05cfa706a155472fb37 Author: Po Lu Date: Tue Sep 27 20:03:08 2022 +0800 Improve doc of `x-window-property' * src/xfns.c (Fx_window_property): Fix errors in doc string and document where to obtain documentation for standardized window properties. diff --git a/src/xfns.c b/src/xfns.c index 4df5ad890e..539e8c6dbe 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7711,17 +7711,40 @@ DEFUN ("x-window-property", Fx_window_property, Sx_window_property, doc: /* Value is the value of window property PROP on FRAME. If FRAME is nil or omitted, use the selected frame. -On X Windows, the following optional arguments are also accepted: -If TYPE is nil or omitted, get the property as a string. - Otherwise TYPE is the name of the atom that denotes the expected type. +On X Windows, the following optional arguments are also accepted: If +TYPE is nil or omitted, get the property as a string. Otherwise TYPE +is the name of the atom that denotes the expected type. + +If TYPE is the string "AnyPropertyType", decode and return the data +regardless of what the type really is. + +The format of the data returned is the same as a selection conversion +to the given type. For example, if `x-get-selection-internal' returns +an integer when the selection data is a given type, +`x-window-property' will do the same for that type. + If WINDOW-ID is non-nil, get the property of that window instead of - FRAME's X window; the number 0 denotes the root window. This argument - is separate from FRAME because window IDs are not unique across X - displays or screens on the same display, so FRAME provides context - for the window ID. +FRAME's X window; the number 0 denotes the root window. This argument +is separate from FRAME because window IDs are not unique across X +displays, so FRAME provides context for the window ID. + If DELETE-P is non-nil, delete the property after retrieving it. If VECTOR-RET-P is non-nil, return a vector of values instead of a string. +X allows an arbitrary number of properties to be set on any window. +However, properties are most often set by the window manager or other +programs on the root window or FRAME's X window in order to +communicate information to Emacs and other programs. Most of these +properties are specified as part of the Extended Window Manager Hints +and the Inter-Client Communication Conventions Manual, which are +located here: + + https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html + +and + + https://x.org/releases/X11R7.6/doc/xorg-docs/specs/ICCCM/icccm.html + Return value is nil if FRAME doesn't have a property with name PROP or if PROP has no value of TYPE (always a string in the MS Windows case). */) (Lisp_Object prop, Lisp_Object frame, Lisp_Object type, commit b1c1ff9ee110a9fe739dc4407468f3e9b819484c Author: Jose A. Ortega Ruiz Date: Tue Sep 27 13:53:24 2022 +0200 docview: imenu access to table of contents * lisp/doc-view.el (doc-view-imenu-enabled): user option to disable imenu generation. * lisp/doc-view.el (doc-view--outline-rx): (doc-view--pdf-outline, doc-view--imenu-subtree, doc-view-imenu-index): functions implementing the imenu index generation via mutool. * lisp/doc-view.el (doc-view-imenu-setup, doc-view-mode): setup of the new functionality in doc-view mode. * lisp/imenu.el (imenu-submenus-on-top): (imenu--split-menu): new local variable to optionally inhibit grouping of entries with children at the top of imenu menus. * doc/emacs/misc.texi: documentation for the new functionality (bug#58103). diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 10b44028bb..f3a6e6c33b 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -584,6 +584,13 @@ you instead want the image to be re-rendered at the new size, set default size for DocView, customize the variable @code{doc-view-resolution}. +@vindex doc-view-imenu-enabled + When the @command{mutool} executable is available, DocView will use +to generate entries for an outline menu, making it accessible via the +imenu facility (@pxref{Imenu}). To disable this functionality even +when @command{mutool} can be found in your @code{exec-path}, customize +the variable @code{doc-view-imenu-enabled}. + @node DocView Searching @subsection DocView Searching diff --git a/lisp/doc-view.el b/lisp/doc-view.el index fbd1427946..fe772efcfc 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -214,6 +214,11 @@ are available (see Info node `(emacs)Document View')." :type 'boolean :version "29.1") +(defcustom doc-view-imenu-enabled (and (executable-find "mutool") t) + "Whether to generate an imenu outline when mutool is available." + :type 'boolean + :version "29.1") + (defcustom doc-view-svg-background "white" "Background color for svg images. See `doc-view-mupdf-use-svg'." @@ -1874,6 +1879,69 @@ If BACKWARD is non-nil, jump to the previous match." (y-or-n-p "No more matches before current page. Wrap to last match? ")) (doc-view-goto-page (caar (last doc-view--current-search-matches))))))) +;;;; Imenu support +(defconst doc-view--outline-rx + "[^\t]+\\(\t+\\)\"\\(.+\\)\"\t#\\(?:page=\\)?\\([0-9]+\\)") + +(defun doc-view--pdf-outline (&optional file-name) + "Return a describing the outline of FILE-NAME (or current if nil). + +Each element in the list contains information about a section's +title, nesting level and page number. The list is flat: its tree +structure is extracted by `doc-view--imenu-subtree'." + (let* ((outline nil) + (fn (or file-name (buffer-file-name))) + (fn (shell-quote-argument (expand-file-name fn)))) + (with-temp-buffer + (insert (shell-command-to-string (format "mutool show %s outline" fn))) + (goto-char (point-min)) + (while (re-search-forward doc-view--outline-rx nil t) + (push `((level . ,(length (match-string 1))) + (title . ,(match-string 2)) + (page . ,(string-to-number (match-string 3)))) + outline))) + (nreverse outline))) + +(defun doc-view--imenu-subtree (outline act) + "Construct a tree of imenu items for the given outline list and action. + +This auxliary function constructs recursively all the items for +the first node in the outline and all its siblings at the same +level. Returns that imenu alist together with any other pending outline +entries at an upper level." + (let ((level (alist-get 'level (car outline))) + (index nil)) + (while (and (car outline) (<= level (alist-get 'level (car outline)))) + (let-alist (car outline) + (let ((title (format "%s (%s)" .title .page))) + (if (> .level level) + (let ((sub (doc-view--imenu-subtree outline act)) + (fst (car index))) + (setq index (cdr index)) + (push (cons (car fst) (cons fst (car sub))) index) + (setq outline (cdr sub))) + (push `(,title 0 ,act ,.page) index) + (setq outline (cdr outline)))))) + (cons (nreverse index) outline))) + +(defun doc-view-imenu-index (&optional file-name goto-page-fn) + "Create an imenu index using mutool to extract its outline. + +For extensibility, a FILE-NAME other than the current buffer and +a jumping function, GOTO-PAGE-FN other than `doc-view-goto-page' +can be specified." + (let* ((goto (or goto-page-fn 'doc-view-goto-page)) + (act (lambda (_name _pos page) (funcall goto page)))) + (car (doc-view--imenu-subtree (doc-view--pdf-outline file-name) act)))) + +(defun doc-view-imenu-setup () + "Set up local state in the current buffer for imenu, if needed." + (when (and doc-view-imenu-enabled (executable-find "mutool")) + (setq-local imenu-create-index-function #'doc-view-imenu-index + imenu-submenus-on-top nil + imenu-sort-function nil) + (imenu-add-to-menubar "Outline"))) + ;;;; User interface commands and the mode (put 'doc-view-mode 'mode-class 'special) @@ -2047,7 +2115,7 @@ If BACKWARD is non-nil, jump to the previous match." "Major mode in DocView buffers. DocView Mode is an Emacs document viewer. It displays PDF, PS -and DVI files (as PNG images) in Emacs buffers. +and DVI files (as PNG or SVG images) in Emacs buffers. You can use \\\\[doc-view-toggle-display] to toggle between displaying the document or editing it as text. @@ -2142,6 +2210,7 @@ toggle between displaying the document or editing it as text. (setq mode-name "DocView" buffer-read-only t major-mode 'doc-view-mode) + (doc-view-imenu-setup) (doc-view-initiate-display) ;; Switch off view-mode explicitly, because doc-view-mode is the ;; canonical view mode for PDF/PS/DVI files. This could be diff --git a/lisp/imenu.el b/lisp/imenu.el index c407f501d6..bfc2429100 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -208,6 +208,13 @@ called within a `save-excursion'. See `imenu--index-alist' for the format of the buffer index alist.") +;;;###autoload +(defvar-local imenu-submenus-on-top t + "Flag specifiying whether items with sublists should be kept at top. + +For some indexes, such as those describing sections in a document, it +makes sense to keep their original order even in the menubar.") + ;;;###autoload (defvar-local imenu-prev-index-position-function 'beginning-of-defun "Function for finding the next index position. @@ -373,10 +380,11 @@ The returned alist DOES NOT share structure with MENULIST." (if (memq imenu--rescan-item menulist) (setq keep-at-top (list imenu--rescan-item) menulist (delq imenu--rescan-item menulist))) - (dolist (item menulist) - (when (imenu--subalist-p item) - (push item keep-at-top) - (setq menulist (delq item menulist)))) + (if imenu-submenus-on-top + (dolist (item menulist) + (when (imenu--subalist-p item) + (push item keep-at-top) + (setq menulist (delq item menulist))))) (if imenu-sort-function (setq menulist (sort menulist imenu-sort-function))) (if (> (length menulist) imenu-max-items) commit fd653f5208e8600166003af41660ce2ad0b6362f Author: Richard Hansen Date: Mon Sep 26 02:12:41 2022 -0400 ; whitespace: Add test case for read-only buffers (bug#58082) diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index 97c30c4d62..fb53543c9e 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -27,7 +27,8 @@ (defmacro whitespace-tests--with-test-buffer (style &rest body) "Run BODY in a buffer with `whitespace-mode' style STYLE. The buffer is displayed in `selected-window', and -`noninteractive' is set to nil even in batch mode." +`noninteractive' is set to nil even in batch mode. If STYLE is +nil, `whitespace-mode' is left disabled." (declare (debug ((style form) def-body)) (indent 1)) `(ert-with-test-buffer-selected () @@ -37,7 +38,8 @@ The buffer is displayed in `selected-window', and (let ((noninteractive nil) (whitespace-style ,style)) (font-lock-mode 1) - (whitespace-mode 1) + ,(when style + '(whitespace-mode 1)) ,@body))) (defun whitespace-tests--faceup (&rest lines) @@ -310,6 +312,21 @@ buffer's content." "\t\n" " »")))) +(ert-deftest whitespace-tests--empty-bob-eob-read-only-buffer () + (whitespace-tests--with-test-buffer '() + (insert "\nx\n\n") + (should (equal (buffer-string) "\nx\n\n")) + (setq-local buffer-read-only t) + (goto-char 2) + (should (equal (line-number-at-pos) 2)) + (should (equal (- (point) (line-beginning-position)) 0)) + (let ((whitespace-style '(face empty))) + (whitespace-mode 1) + (should (whitespace-tests--faceup "«:whitespace-empty:\n" + "»x\n" + "«:whitespace-empty:\n" + "»"))))) + (provide 'whitespace-tests) ;;; whitespace-tests.el ends here commit 29b7d740006fe2190a729bd1c30ccab9356cee36 Author: Richard Hansen Date: Mon Sep 26 17:07:52 2022 -0400 ert-x: Improve realism of `ert-with-test-buffer-selected' * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer-selected): Set `inhibit-read-only' and `buffer-read-only' to nil when executing the body to provide a more realistic test environment. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index f00f1b33d7..bfd796586d 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -126,7 +126,15 @@ value is the last form in BODY." (body-function . ,(lambda (window) (select-window window t) - (let ((inhibit-modification-hooks nil)) + ;; body-function is intended to initialize the + ;; contents of a temporary read-only buffer, so + ;; it is executed with some convenience + ;; changes. Undo those changes so that the + ;; test buffer behaves more like an ordinary + ;; buffer while the body executes. + (let ((inhibit-modification-hooks nil) + (inhibit-read-only nil) + (buffer-read-only nil)) (setq ,ret (progn ,@body)))))) nil)) ,ret)))) commit 0b1e3713fea9b7c28891ec094689f40c0dc996c4 Author: Alan Mackenzie Date: Tue Sep 27 10:02:27 2022 +0000 * lisp/progmodes/cc-defs.el (c-let*-maybe-max-specpdl-size): Fix glitches diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 59927f0f2c..77aa3e62bb 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2633,7 +2633,7 @@ fallback definition for all modes, to break the cycle).") ;; Like let*, but doesn't bind `max-specpdl-size' if that variable ;; is in the bindings list and either doesn't exist or is obsolete. (declare (debug let*) (indent 1)) - (let ((-varlist- varlist) msp-binding) + (let ((-varlist- (copy-sequence varlist)) msp-binding) (if (or (not (boundp 'max-specpdl-size)) (get 'max-specpdl-size 'byte-obsolete-variable)) (cond @@ -2641,7 +2641,7 @@ fallback definition for all modes, to break the cycle).") (setq -varlist- (delq 'max-specpdl-size -varlist-))) ((setq msp-binding (assq 'max-specpdl-size -varlist-)) (setq -varlist- (delq msp-binding -varlist-))))) - `(let* ,varlist ,@body))) + `(let* ,-varlist- ,@body))) (defun c-get-lang-constant (name &optional source-files mode) ;; Used by `c-lang-const'. commit a889977e0bfc6888cc8201133aa65b8a2b773def Author: Alan Mackenzie Date: Tue Sep 27 08:39:05 2022 +0000 CC Mode: Don't bind max-specpdl-size when it doesn't exist or is obsolete This is part of the changes for bug #57911. * lisp/progmodes/cc-defs.el (c-let*-maybe-max-specpdl-size): New macro. (c-get-lang-constant): Use the new macro in place of let*. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f867625480..59927f0f2c 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2629,6 +2629,20 @@ fallback definition for all modes, to break the cycle).") (defconst c-lang--novalue "novalue") +(defmacro c-let*-maybe-max-specpdl-size (varlist &rest body) + ;; Like let*, but doesn't bind `max-specpdl-size' if that variable + ;; is in the bindings list and either doesn't exist or is obsolete. + (declare (debug let*) (indent 1)) + (let ((-varlist- varlist) msp-binding) + (if (or (not (boundp 'max-specpdl-size)) + (get 'max-specpdl-size 'byte-obsolete-variable)) + (cond + ((memq 'max-specpdl-size -varlist-) + (setq -varlist- (delq 'max-specpdl-size -varlist-))) + ((setq msp-binding (assq 'max-specpdl-size -varlist-)) + (setq -varlist- (delq msp-binding -varlist-))))) + `(let* ,varlist ,@body))) + (defun c-get-lang-constant (name &optional source-files mode) ;; Used by `c-lang-const'. @@ -2669,21 +2683,22 @@ fallback definition for all modes, to break the cycle).") ;; In that case we just continue with the "assignment" before ;; the one currently being evaluated, thereby creating the ;; illusion if a `setq'-like sequence of assignments. - (let* ((c-buffer-is-cc-mode mode) - (source-pos - (or (assq sym c-lang-constants-under-evaluation) - (cons sym (vector source nil)))) - ;; Append `c-lang-constants-under-evaluation' even if an - ;; earlier entry is found. It's only necessary to get - ;; the recording of dependencies above correct. - (c-lang-constants-under-evaluation - (cons source-pos c-lang-constants-under-evaluation)) - (fallback (get mode 'c-fallback-mode)) - value - ;; Make sure the recursion limits aren't very low - ;; since the `c-lang-const' dependencies can go deep. - (max-specpdl-size (max max-specpdl-size 3000)) - (max-lisp-eval-depth (max max-lisp-eval-depth 1000))) + (c-let*-maybe-max-specpdl-size + ((c-buffer-is-cc-mode mode) + (source-pos + (or (assq sym c-lang-constants-under-evaluation) + (cons sym (vector source nil)))) + ;; Append `c-lang-constants-under-evaluation' even if an + ;; earlier entry is found. It's only necessary to get + ;; the recording of dependencies above correct. + (c-lang-constants-under-evaluation + (cons source-pos c-lang-constants-under-evaluation)) + (fallback (get mode 'c-fallback-mode)) + value + ;; Make sure the recursion limits aren't very low + ;; since the `c-lang-const' dependencies can go deep. + (max-specpdl-size (max max-specpdl-size 3000)) + (max-lisp-eval-depth (max max-lisp-eval-depth 1000))) (if (if fallback (let ((backup-source-pos (copy-sequence (cdr source-pos)))) commit 604b541d5ce394a1e4f157a81a0cf77df98d61d0 Author: YAMAMOTO Mitsuharu Date: Tue Sep 27 12:39:31 2022 +0900 Avoid uninitialized variable warning * src/composite.c (composition_gstring_adjust_zero_width): Simplify last change with respect to an exit condition. diff --git a/src/composite.c b/src/composite.c index 0417bc866d..6b256171ac 100644 --- a/src/composite.c +++ b/src/composite.c @@ -815,9 +815,12 @@ composition_gstring_adjust_zero_width (Lisp_Object gstring) { Lisp_Object glyph; - if (i == LGSTRING_GLYPH_LEN (gstring) - || (glyph = LGSTRING_GLYPH (gstring, i), - (NILP (glyph) || from != LGLYPH_FROM (glyph)))) + if (i < LGSTRING_GLYPH_LEN (gstring)) + glyph = LGSTRING_GLYPH (gstring, i); + else + glyph = Qnil; + + if (NILP (glyph) || from != LGLYPH_FROM (glyph)) { eassert (i > 0); Lisp_Object last = LGSTRING_GLYPH (gstring, i - 1); @@ -834,7 +837,7 @@ composition_gstring_adjust_zero_width (Lisp_Object gstring) ASET (LGLYPH_ADJUSTMENT (last), 2, make_fixnum (LGLYPH_WADJUST (last) + 1)); } - if (i == LGSTRING_GLYPH_LEN (gstring) || NILP (glyph)) + if (NILP (glyph)) break; from = LGLYPH_FROM (glyph); width = 0; commit 51ec68b3182914c6c95d6ddcd88ae75239ec2904 Author: Po Lu Date: Tue Sep 27 10:50:34 2022 +0800 Optimize coordinate translation during event handling These changes noticeably improve turning the mouse wheel on top of scroll bars etc over slow network connections. * src/xterm.c (x_dnd_note_self_position, x_dnd_note_self_wheel) (x_dnd_note_self_drop): Use x_translate_coordinates. (x_compute_root_window_offset): New function for calculating and caching root window offsets of edit window. (x_translate_coordinates): New function. Use cached values whenever possible. (xi_compute_root_window_offset) (xi_compute_root_window_offset_pinch): New wrappers for XI2 events. (x_construct_mouse_click, handle_one_xevent): Use x_translate_coordinates wherever appropriate. * src/xterm.h (struct x_output): New fields for keeping track of the root window offset of the edit window. diff --git a/src/xterm.c b/src/xterm.c index 527c26f0da..d7ea63bb4f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1143,6 +1143,7 @@ static Window x_get_window_below (Display *, Window, int, int, int *, int *); #ifndef USE_TOOLKIT_SCROLL_BARS static void x_scroll_bar_redraw (struct scroll_bar *); #endif +static void x_translate_coordinates (struct frame *, int, int, int *, int *); /* Global state maintained during a drag-and-drop operation. */ @@ -4852,16 +4853,13 @@ x_dnd_note_self_position (struct x_display_info *dpyinfo, Window target, { struct frame *f; int dest_x, dest_y; - Window child_return; f = x_top_window_to_frame (dpyinfo, target); - if (f && XTranslateCoordinates (dpyinfo->display, - dpyinfo->root_window, - FRAME_X_WINDOW (f), - root_x, root_y, &dest_x, - &dest_y, &child_return)) + if (f) { + x_translate_coordinates (f, root_x, root_y, &dest_x, &dest_y); + x_dnd_movement_frame = f; x_dnd_movement_x = dest_x; x_dnd_movement_y = dest_y; @@ -4877,19 +4875,16 @@ x_dnd_note_self_wheel (struct x_display_info *dpyinfo, Window target, { struct frame *f; int dest_x, dest_y; - Window child_return; if (button < 4 || button > 7) return; f = x_top_window_to_frame (dpyinfo, target); - if (f && XTranslateCoordinates (dpyinfo->display, - dpyinfo->root_window, - FRAME_X_WINDOW (f), - root_x, root_y, &dest_x, - &dest_y, &child_return)) + if (f) { + x_translate_coordinates (f, root_x, root_y, &dest_x, &dest_y); + x_dnd_wheel_frame = f; x_dnd_wheel_x = dest_x; x_dnd_wheel_y = dest_y; @@ -4912,7 +4907,6 @@ x_dnd_note_self_drop (struct x_display_info *dpyinfo, Window target, char **atom_names; char *name; int win_x, win_y, i; - Window dummy; if (!x_dnd_allow_current_frame && (FRAME_OUTER_WINDOW (x_dnd_frame) @@ -4927,10 +4921,7 @@ x_dnd_note_self_drop (struct x_display_info *dpyinfo, Window target, if (NILP (Vx_dnd_native_test_function)) return; - if (!XTranslateCoordinates (dpyinfo->display, dpyinfo->root_window, - FRAME_X_WINDOW (f), root_x, root_y, - &win_x, &win_y, &dummy)) - return; + x_translate_coordinates (f, root_x, root_y, &win_x, &win_y); /* Emacs can't respond to DND events inside the nested event loop, so when dragging items to itself, call the test function @@ -13523,6 +13514,91 @@ get_keysym_name (int keysym) return value; } +/* Given the root and event coordinates of an X event destined for F's + edit window, compute the offset between that window and F's root + window. This information is then used as an optimization to avoid + synchronizing when converting coordinates from some other event to + F's edit window. */ + +static void +x_compute_root_window_offset (struct frame *f, int root_x, int root_y, + int event_x, int event_y) +{ + FRAME_X_OUTPUT (f)->window_offset_certain_p = true; + FRAME_X_OUTPUT (f)->root_x = root_x - event_x; + FRAME_X_OUTPUT (f)->root_y = root_y - event_y; +} + +/* Translate the given coordinates from the root window to the edit + window of FRAME, taking into account any cached root window + offsets. This allows Emacs to avoid excessive calls to _XReply in + many cases while handling events, which would otherwise result in + slowdowns over slow network connections. */ + +static void +x_translate_coordinates (struct frame *f, int root_x, int root_y, + int *x_out, int *y_out) +{ + struct x_output *output; + Window dummy; + + output = FRAME_X_OUTPUT (f); + + if (output->window_offset_certain_p) + { + /* Use the cached root window offset. */ + *x_out = root_x - output->root_x; + *y_out = root_y - output->root_y; + + return; + } + + /* Otherwise, do the transformation manually. Then, cache the root + window position. */ + if (!XTranslateCoordinates (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_X_WINDOW (f), root_x, root_y, + x_out, y_out, &dummy)) + /* Use some dummy values. This is not supposed to be called with + coordinates out of the screen. */ + *x_out = 0, *y_out = 0; + else + { + /* Cache the root window offset of the edit window. */ + output->window_offset_certain_p = true; + output->root_x = root_x - *x_out; + output->root_y = root_y - *y_out; + } +} + +/* The same, but for an XIDeviceEvent. */ + +#ifdef HAVE_XINPUT2 + +static void +xi_compute_root_window_offset (struct frame *f, XIDeviceEvent *xev) +{ + /* Truncate coordinates instead of rounding them, because that is + how the X server handles window hierarchy. */ + x_compute_root_window_offset (f, xev->root_x, xev->root_y, + xev->event_x, xev->event_y); +} + +#ifdef HAVE_XINPUT2_4 + +static void +xi_compute_root_window_offset_pinch (struct frame *f, XIGesturePinchEvent *pev) +{ + /* Truncate coordinates instead of rounding them, because that is + how the X server handles window hierarchy. */ + x_compute_root_window_offset (f, pev->root_x, pev->root_y, + pev->event_x, pev->event_y); +} + +#endif + +#endif + static Bool x_query_pointer_1 (struct x_display_info *dpyinfo, int client_pointer_device, Window w, @@ -13651,10 +13727,10 @@ x_query_pointer (Display *dpy, Window w, Window *root_return, X server, and instead be artificially constructed from input extension events. In these special events, the only fields that are initialized are `time', `button', `state', `type', `window' and - `x' and `y'. This function should not access any other fields in - EVENT without also initializing the corresponding fields in `bv' - under the XI_ButtonPress and XI_ButtonRelease labels inside - `handle_one_xevent'. */ + `x', `y', `x_root' and `y_root'. This function should not access + any other fields in EVENT without also initializing the + corresponding fields in `bv' under the XI_ButtonPress and + XI_ButtonRelease labels inside `handle_one_xevent'. */ static Lisp_Object x_construct_mouse_click (struct input_event *result, @@ -13663,7 +13739,6 @@ x_construct_mouse_click (struct input_event *result, { int x = event->x; int y = event->y; - Window dummy; /* Make the event type NO_EVENT; we'll change that when we decide otherwise. */ @@ -13680,9 +13755,8 @@ x_construct_mouse_click (struct input_event *result, happen with GTK+ scroll bars, for example), translate the coordinates so they appear at the correct position. */ if (event->window != FRAME_X_WINDOW (f)) - XTranslateCoordinates (FRAME_X_DISPLAY (f), - event->window, FRAME_X_WINDOW (f), - x, y, &x, &y, &dummy); + x_translate_coordinates (f, event->x_root, event->y_root, + &x, &y); XSETINT (result->x, x); XSETINT (result->y, y); @@ -18968,6 +19042,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, `event' itself. */ XKeyEvent xkey = event->xkey; + if (event->xkey.window == FRAME_X_WINDOW (f)) + /* See the comment above x_compute_root_window_offset for + why this optimization is performed. */ + x_compute_root_window_offset (f, event->xkey.x_root, + event->xkey.y_root, + event->xkey.x, event->xkey.y); + #ifdef HAVE_XINPUT2 Time pending_keystroke_time; struct xi_device_t *source; @@ -19601,6 +19682,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); + if (f && event->xmotion.window == FRAME_X_WINDOW (f)) + /* See the comment above x_compute_root_window_offset for + why this optimization is performed. */ + x_compute_root_window_offset (f, event->xmotion.x_root, + event->xmotion.y_root, + event->xmotion.x, + event->xmotion.y); + if (x_dnd_in_progress /* Handle these events normally if the recursion level is higher than when the drag-and-drop @@ -19865,10 +19954,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (xmotion.window != FRAME_X_WINDOW (f)) { - XTranslateCoordinates (FRAME_X_DISPLAY (f), - xmotion.window, FRAME_X_WINDOW (f), - xmotion.x, xmotion.y, &xmotion.x, - &xmotion.y, &xmotion.subwindow); + x_translate_coordinates (f, xmotion.x_root, xmotion.y_root, + &xmotion.x, &xmotion.y); xmotion.window = FRAME_X_WINDOW (f); } @@ -20091,6 +20178,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window); + + /* This means we can no longer be certain of the root window + coordinates of any's edit window. */ + if (any) + FRAME_X_OUTPUT (any)->window_offset_certain_p = false; + /* Unfortunately, we need to call x_drop_xrender_surfaces for _all_ ConfigureNotify events, otherwise we miss some and flicker. Don't try to optimize these calls by looking only @@ -20320,6 +20413,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, { f = mouse_or_wdesc_frame (dpyinfo, event->xbutton.window); + if (f && event->xbutton.window == FRAME_X_WINDOW (f)) + /* See the comment above x_compute_root_window_offset + for why this optimization is performed. */ + x_compute_root_window_offset (f, event->xbutton.x_root, + event->xbutton.y_root, + event->xbutton.x, + event->xbutton.y); + if (event->type == ButtonPress) { x_display_set_last_user_time (dpyinfo, event->xbutton.time, @@ -20493,6 +20594,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, dpyinfo->last_mouse_glyph_frame = NULL; f = mouse_or_wdesc_frame (dpyinfo, event->xbutton.window); + + if (f && event->xbutton.window == FRAME_X_WINDOW (f)) + /* See the comment above x_compute_root_window_offset + for why this optimization is performed. */ + x_compute_root_window_offset (f, event->xbutton.x_root, + event->xbutton.y_root, + event->xbutton.x, + event->xbutton.y); + if (f && event->xbutton.type == ButtonPress && !popup_activated () && !x_window_to_scroll_bar (event->xbutton.display, @@ -21178,8 +21288,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; #endif - Window dummy; - #ifdef HAVE_XINPUT2_1 #ifdef HAVE_XWIDGETS struct xwidget_view *xv = xwidget_view_from_window (xev->event); @@ -21257,11 +21365,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, real_y = lrint (xev->event_y + bar->top); } else - XTranslateCoordinates (dpyinfo->display, - xev->event, FRAME_X_WINDOW (f), - lrint (xev->event_x), - lrint (xev->event_y), - &real_x, &real_y, &dummy); + x_translate_coordinates (f, + lrint (xev->root_x), + lrint (xev->root_y), + &real_x, &real_y); } else { @@ -21463,6 +21570,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = mouse_or_wdesc_frame (dpyinfo, xev->event); + if (f && xev->event == FRAME_X_WINDOW (f)) + /* See the comment above x_compute_root_window_offset + for why this optimization is performed. */ + xi_compute_root_window_offset (f, xev); + if (x_dnd_in_progress /* Handle these events normally if the recursion level is higher than when the drag-and-drop @@ -21711,9 +21823,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, { if (xev->event != FRAME_X_WINDOW (f)) { - XTranslateCoordinates (FRAME_X_DISPLAY (f), - xev->event, FRAME_X_WINDOW (f), - ev.x, ev.y, &ev.x, &ev.y, &dummy); + x_translate_coordinates (f, lrint (xev->root_x), + lrint (xev->root_y), + &ev.x, &ev.y); ev.window = FRAME_X_WINDOW (f); } @@ -21819,6 +21931,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = mouse_or_wdesc_frame (dpyinfo, xev->event); device = xi_device_from_id (dpyinfo, xev->deviceid); + if (f && xev->event == FRAME_X_WINDOW (f)) + /* See the comment above + x_compute_root_window_offset for why this + optimization is performed. */ + xi_compute_root_window_offset (f, xev); + /* Don't track grab status for emulated pointer events, because they are ignored by the regular mouse click processing code. */ @@ -22150,6 +22268,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, bv.type = xev->evtype == XI_ButtonPress ? ButtonPress : ButtonRelease; bv.x = lrint (xev->event_x); bv.y = lrint (xev->event_y); + bv.x_root = lrint (xev->root_x); + bv.y_root = lrint (xev->root_y); bv.window = xev->event; bv.state = xi_convert_event_state (xev); bv.time = xev->time; @@ -22158,6 +22278,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = mouse_or_wdesc_frame (dpyinfo, xev->event); + if (f && xev->event == FRAME_X_WINDOW (f)) + /* See the comment above x_compute_root_window_offset + for why this optimization is performed. */ + xi_compute_root_window_offset (f, xev); + if (f && xev->evtype == XI_ButtonPress && !popup_activated () && !x_window_to_scroll_bar (dpyinfo->display, xev->event, 2) @@ -22209,9 +22334,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK if (!f) { - int real_x = lrint (xev->event_x); - int real_y = lrint (xev->event_y); - Window child; + int real_x = lrint (xev->root_x); + int real_y = lrint (xev->root_y); f = x_any_window_to_frame (dpyinfo, xev->event); @@ -22220,9 +22344,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (xev->evtype == XI_ButtonRelease) { if (FRAME_X_WINDOW (f) != xev->event) - XTranslateCoordinates (dpyinfo->display, xev->event, - FRAME_X_WINDOW (f), real_x, - real_y, &real_x, &real_y, &child); + x_translate_coordinates (f, real_x, real_y, + &real_x, &real_y); if (xev->detail <= 5) inev.ie.kind = WHEEL_EVENT; @@ -22487,6 +22610,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = x_any_window_to_frame (dpyinfo, xev->event); + if (f && xev->event == FRAME_X_WINDOW (f)) + /* See the comment above x_compute_root_window_offset + for why this optimization is performed. */ + xi_compute_root_window_offset (f, xev); + /* GTK handles TAB events in an undesirable manner, so keyboard events are always dropped. But as a side effect, the user time will no longer be set by GDK, @@ -23126,6 +23254,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = x_window_to_frame (dpyinfo, xev->event); + if (f) + /* See the comment above x_compute_root_window_offset + for why this optimization is performed. */ + xi_compute_root_window_offset (f, xev); + #ifdef HAVE_GTK3 menu_bar_p = (f && FRAME_X_OUTPUT (f)->menubar_widget && xg_event_is_for_menubar (f, event)); @@ -23314,8 +23447,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif any = x_window_to_frame (dpyinfo, pev->event); + if (any) { + if (pev->event == FRAME_X_WINDOW (any)) + xi_compute_root_window_offset_pinch (any, pev); + inev.ie.kind = PINCH_EVENT; inev.ie.modifiers = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (any), pev->mods.effective); diff --git a/src/xterm.h b/src/xterm.h index d6ff15e40f..f3791aa8df 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1196,6 +1196,15 @@ struct x_output XIEventMask *xi_masks; int num_xi_masks; #endif + + /* Whether or not we are certain we know the offset from the root + window to this frame. */ + bool window_offset_certain_p; + + /* The offset of the edit window from the root window. This is + strictly an optimization to avoid extraneous synchronizing in + some cases. */ + int root_x, root_y; }; enum commit cd88f6de4be1f8eba1db038b371d769f584be53b Author: YAMAMOTO Mitsuharu Date: Tue Sep 27 09:20:58 2022 +0900 Adjust zero-width grapheme clusters so they are displayed (Bug#50951) * src/composite.c (composition_gstring_adjust_zero_width): New function. * src/composite.h: Declare it. * src/font.c (Ffont_shape_gstring): Use it before putting gstring to cache. diff --git a/src/composite.c b/src/composite.c index 249d7587f6..0417bc866d 100644 --- a/src/composite.c +++ b/src/composite.c @@ -800,6 +800,50 @@ composition_gstring_width (Lisp_Object gstring, ptrdiff_t from, ptrdiff_t to, return width; } +/* Adjust the width of each grapheme cluster of GSTRING because + zero-width grapheme clusters are not displayed. If the width is + zero, then the width of the last glyph in the cluster is + incremented. */ + +void +composition_gstring_adjust_zero_width (Lisp_Object gstring) +{ + ptrdiff_t from = 0; + int width = 0; + + for (ptrdiff_t i = 0; ; i++) + { + Lisp_Object glyph; + + if (i == LGSTRING_GLYPH_LEN (gstring) + || (glyph = LGSTRING_GLYPH (gstring, i), + (NILP (glyph) || from != LGLYPH_FROM (glyph)))) + { + eassert (i > 0); + Lisp_Object last = LGSTRING_GLYPH (gstring, i - 1); + + if (width == 0) + { + if (NILP (LGLYPH_ADJUSTMENT (last))) + LGLYPH_SET_ADJUSTMENT (last, + CALLN (Fvector, + make_fixnum (0), make_fixnum (0), + make_fixnum (LGLYPH_WIDTH (last) + + 1))); + else + ASET (LGLYPH_ADJUSTMENT (last), 2, + make_fixnum (LGLYPH_WADJUST (last) + 1)); + } + if (i == LGSTRING_GLYPH_LEN (gstring) || NILP (glyph)) + break; + from = LGLYPH_FROM (glyph); + width = 0; + } + width += (NILP (LGLYPH_ADJUSTMENT (glyph)) + ? LGLYPH_WIDTH (glyph) : LGLYPH_WADJUST (glyph)); + } +} + static Lisp_Object gstring_work; static Lisp_Object gstring_work_headers; diff --git a/src/composite.h b/src/composite.h index d77dd0d506..8a6fd203d0 100644 --- a/src/composite.h +++ b/src/composite.h @@ -340,6 +340,7 @@ extern Lisp_Object composition_gstring_from_id (ptrdiff_t); extern bool composition_gstring_p (Lisp_Object); extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t, struct font_metrics *); +extern void composition_gstring_adjust_zero_width (Lisp_Object); extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t *, ptrdiff_t *, diff --git a/src/font.c b/src/font.c index 413cb381ee..defbb5084b 100644 --- a/src/font.c +++ b/src/font.c @@ -4678,6 +4678,7 @@ GSTRING. */) from = LGLYPH_FROM (glyph); to = LGLYPH_TO (glyph); } + composition_gstring_adjust_zero_width (gstring); return composition_gstring_put_cache (gstring, XFIXNUM (n)); shaper_error: commit a27e4832131bbc02ab21d0d5febffc5fe6339906 Author: Stefan Kangas Date: Tue Sep 27 02:14:54 2022 +0200 Fix OBOE in image-dired--with-marked * lisp/image/image-dired.el (image-dired--with-marked): Fix off-by-one error. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 528348d8d4..98bb6b3c5a 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -469,7 +469,7 @@ thumbnail." (when (image-dired-thumb-file-marked-p) (setq found t) ,@body) - (forward-char))) + (forward-char 2))) (unless found ,@body)))) commit 6aaf07bdd5a760089a21d9bb47ae9ab01f398bc4 Author: Sean Whitton Date: Mon Sep 26 15:15:02 2022 -0700 vc-filter-command-function: Abbreviate default value * lisp/vc/vc-dispatcher.el (vc-filter-command-function): Abbreviate `(lambda (&rest args) args)' as just `list'. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 89bf79622e..dc3ed52650 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -269,7 +269,7 @@ SUCCESS process has a zero exit code." (declare (indent 0) (debug (def-body))) `(vc-exec-after (lambda () ,@body))) -(defvar vc-filter-command-function (lambda (&rest args) args) +(defvar vc-filter-command-function #'list "Function called to transform VC commands before execution. The function is called inside the buffer in which the command will be run and is passed the COMMAND, FILE-OR-LIST and FLAGS commit 93b9cf41846b40cd050b56f6e83b590330be255e Author: Stefan Kangas Date: Mon Sep 26 21:32:55 2022 +0200 Get rid of default wallpaper-setter constructor * lisp/image/wallpaper.el (wallpaper-setter): Actually get rid of the default constructor. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index de650a7318..36bc7e91a6 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -84,7 +84,8 @@ the image file to set the wallpaper to.") ;;; Finding the wallpaper command (cl-defstruct (wallpaper-setter - ;; Rename the default constructor from `make-wallpaper-cmd'. + ;; Get rid of the default constructor (`make-wallpaper-cmd'). + (:constructor nil) (:constructor wallpaper-setter-create ( name command args-raw commit bb9df76dc96afa046e8a576708f39881f0535235 Author: Stefan Kangas Date: Mon Sep 26 21:26:50 2022 +0200 Set XFCE wallpaper also in single-workspace-mode This fixes setting the wallpaper on XFCE whether or not the "/backdrop/single-workspace-mode" setting is true or false. That XFCE setting controls whether or not the same wallpaper is used on all workspaces or not. * lisp/image/wallpaper.el (wallpaper-setter) (wallpaper-command-args, wallpaper-default-set-function): Allow using a function for getting the command line arguments. (wallpaper-xfce-command-args): New function. (wallpaper--default-setters): Use above new function for XFCE. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index b2a36e98a4..de650a7318 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -90,7 +90,7 @@ the image file to set the wallpaper to.") ( name command args-raw &rest rest-plist &aux - (args (if (listp args-raw) + (args (if (or (listp args-raw) (symbolp args-raw)) args-raw (string-split args-raw))) (predicate (plist-get rest-plist :predicate)))) @@ -153,9 +153,7 @@ and returns non-nil if this setter should be used." (member "KDE" (xdg-current-desktop)))) ("XFCE" - "xfconf-query" '("-c" "xfce4-desktop" - "-p" "/backdrop/screen%S/monitor%M/workspace%W/last-image" - "-s" "%f") + "xfconf-query" #'wallpaper-xfce-command-args :predicate (lambda () (or (and (getenv "DESKTOP_SESSION") (member (downcase (getenv "DESKTOP_SESSION")) @@ -240,6 +238,20 @@ This is used by `wallpaper--find-command' to automatically set `wallpaper-command-args'. The setters will be tested in the order in which they appear.") +(defun wallpaper-xfce-command-args () + (let ((info + (with-temp-buffer + (call-process "xfconf-query" nil t nil + "-c" "xfce4-desktop" + "-p" "/backdrop/single-workspace-mode") + (buffer-string)))) + (list "-c" "xfce4-desktop" + "-p" (format "/backdrop/screen%%S/monitor%%M/workspace%s/last-image" + (if (equal info "true") + "0" + "%W")) + "-s" "%f"))) + (defvar wallpaper--current-setter nil) (defun wallpaper--find-setter () @@ -321,6 +333,9 @@ automatically, so there is usually no need to customize this. However, if you do need to change this, you might also want to customize `wallpaper-command' to match. +The value is a list of command list arguments to use, or a +function that returns a list of command line arguments. + In each command line argument, these specifiers will be replaced: %f full file name @@ -338,7 +353,8 @@ height and width to use for %h and %w. The value of this variable is ignored on MS-Windows and Haiku systems, where a native API is used instead." - :type '(repeat string) + :type '(choice (repeat string) + function) :group 'image :version "29.1") @@ -424,8 +440,11 @@ FILE is the image file name." This is the default function for `wallpaper-set-function'." (unless wallpaper-command (error "Couldn't find a command to set the wallpaper with")) - (let* ((real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file)) - wallpaper-command-args)) + (let* ((args (if (functionp wallpaper-command-args) + (funcall wallpaper-command-args) + wallpaper-command-args)) + (real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file)) + args)) (bufname (format " *wallpaper-%s*" (random))) (process (and wallpaper-command @@ -434,7 +453,7 @@ This is the default function for `wallpaper-set-function'." (unless wallpaper-command (error "Couldn't find a suitable command for setting the wallpaper")) (wallpaper-debug "Using command: \"%s %s\"" - wallpaper-command (string-join wallpaper-command-args " ")) + wallpaper-command (string-join args " ")) (wallpaper-debug (wallpaper--format-arg "f=%f w=%w h=%h S=%S M=%M W=%W" file)) (setf (process-sentinel process) commit 07e6bbb9bc68f76773e9bdf8846d64d83f50b0ea Author: Alan Mackenzie Date: Mon Sep 26 19:16:33 2022 +0000 CC Mode: Handle C++20 concepts * lisp/progmodes/cc-align.el (c-lineup-topmost-intro-cont): Amend so as not to indent lines following a requires line. * lisp/progmodes/cc-engine.el (c-forward-primary-expression) (c-forward-c++-requires-clause): New functions. (c-forward-declarator): Skip forward over any trailing requires clause. (c-forward-decl-or-cast-1): Skip requires clauses before and after the type. Amend the second element of the return list to include information on two consecutive identifiers in <...>. (c-looking-at-or-maybe-in-bracelist): Don't recognize braces in requires expressions as brace lists. (c-guess-basic-syntax): CASE 5D.7: New case to handle the continuation of a "concept foo = " line. * lisp/progmodes/cc-fonts.el (c-basic-matchers-before): Add a new clause to handle the declaration of a concept. (c-get-fontification-context): Treat the arglist of a requires construct as a declaration arglist. * lisp/progmodes/cc-langs.el (c-equals-nontype-decl-kwds/key) (c-fun-name-substitute-kwds/key, c-pre-concept-<>-kwds/key): New c-lang-consts/vars. (c-constant-key): New c-lang-var. (c-type-decl-suffix-key): Include "requires" in the keywords matched. * lisp/progmodes/cc-mode.el (c-fl-decl-start): Fix an off by one error. Use equal rather than eq to compare two syntax contexts. diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index e14f5b9058..7b45be3c5c 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -85,11 +85,14 @@ statement-cont.) Works with: topmost-intro-cont." (save-excursion (beginning-of-line) - (c-backward-syntactic-ws (c-langelem-pos langelem)) - (if (and (memq (char-before) '(?} ?,)) - (not (and c-overloadable-operators-regexp - (c-after-special-operator-id)))) - c-basic-offset))) + (unless (re-search-forward c-fun-name-substitute-key + (c-point 'eol) t) + (beginning-of-line) + (c-backward-syntactic-ws (c-langelem-pos langelem)) + (if (and (memq (char-before) '(?} ?,)) + (not (and c-overloadable-operators-regexp + (c-after-special-operator-id)))) + c-basic-offset)))) (defun c-lineup-gnu-DEFUN-intro-cont (langelem) "Line up the continuation lines of a DEFUN macro in the Emacs C source. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 1127ffe249..e0aef2b2ee 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9512,6 +9512,84 @@ point unchanged and return nil." ;; Handling of large scale constructs like statements and declarations. +(defun c-forward-primary-expression (&optional limit) + ;; Go over the primary expression (if any) at point, moving to the next + ;; token and return non-nil. If we're not at a primary expression leave + ;; point unchanged and return nil. + ;; + ;; Note that this function is incomplete, handling only those cases expected + ;; to be common in a C++20 requires clause. + (let ((here (point)) + (c-restricted-<>-arglists t) + (c-parse-and-markup-<>-arglists nil) + ) + (if (cond + ((looking-at c-constant-key) + (goto-char (match-end 1)) + (c-forward-syntactic-ws limit) + t) + ((eq (char-after) ?\() + (and (c-go-list-forward (point) limit) + (eq (char-before) ?\)) + (progn (c-forward-syntactic-ws limit) + t))) + ((c-forward-over-compound-identifier) + (c-forward-syntactic-ws limit) + (while (cond + ((looking-at "<") + (prog1 + (c-forward-<>-arglist nil) + (c-forward-syntactic-ws limit))) + ((looking-at c-opt-identifier-concat-key) + (and + (zerop (c-forward-token-2 1 nil limit)) + (prog1 + (c-forward-over-compound-identifier) + (c-forward-syntactic-ws limit)))))) + t) + ((looking-at c-fun-name-substitute-key) ; "requires" + (goto-char (match-end 1)) + (c-forward-syntactic-ws limit) + (and + (or (not (eq (char-after) ?\()) + (prog1 + (and (c-go-list-forward (point) limit) + (eq (char-before) ?\))) + (c-forward-syntactic-ws))) + (eq (char-after) ?{) + (and (c-go-list-forward (point) limit) + (eq (char-before) ?})) + (progn + (c-forward-syntactic-ws limit) + t)))) + t + (goto-char here) + nil))) + +(defun c-forward-c++-requires-clause (&optional limit) + ;; Point is at the keyword "requires". Move forward over the requires + ;; clause to the next token after it and return non-nil. If there is no + ;; valid requires clause at point, leave point unmoved and return nil. + (let ((here (point)) + final-point) + (or limit (setq limit (point-max))) + (if (and + (zerop (c-forward-token-2 1 nil limit)) ; over "requires". + (prog1 + (c-forward-primary-expression limit) + (setq final-point (point)) + (while + (and (looking-at "\\(?:&&\\|||\\)") + (progn (goto-char (match-end 0)) + (c-forward-syntactic-ws limit) + (and (< (point) limit) + (c-forward-primary-expression limit)))) + (setq final-point (point))))) + (progn (goto-char final-point) + t) + (goto-char here) + nil))) + (defun c-forward-declarator (&optional limit accept-anon) ;; Assuming point is at the start of a declarator, move forward over it, ;; leaving point at the next token after it (e.g. a ) or a ; or a ,), or at @@ -9565,7 +9643,7 @@ point unchanged and return nil." ((and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) (match-beginning 4)) ; Was 3 - 2021-01-01 - ;; If the third submatch matches in C++ then + ;; If the fourth submatch matches in C++ then ;; we're looking at an identifier that's a ;; prefix only if it specifies a member pointer. (progn @@ -9621,6 +9699,11 @@ point unchanged and return nil." (while (cond ((looking-at c-decl-hangon-key) (c-forward-keyword-clause 1)) + ((looking-at c-type-decl-suffix-key) + (if (save-match-data + (looking-at c-fun-name-substitute-key)) + (c-forward-c++-requires-clause) + (c-forward-keyword-clause 1))) ((and c-opt-cpp-prefix (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)))) @@ -9890,13 +9973,13 @@ This function might do hidden buffer changes." ;; ;; ;; - ;; The second element of the return value is non-nil when a - ;; `c-typedef-decl-kwds' specifier is found in the declaration. - ;; Specifically it is a dotted pair (A . B) where B is t when a - ;; `c-typedef-kwds' ("typedef") is present, and A is t when some - ;; other `c-typedef-decl-kwds' (e.g. class, struct, enum) - ;; specifier is present. I.e., (some of) the declared - ;; identifier(s) are types. + ;; The second element of the return value is non-nil when something + ;; indicating the identifier is a type occurs in the declaration. + ;; Specifically it is nil, or a three element list (A B C) where C is t + ;; when context is '<> and the "identifier" is a found type, B is t when a + ;; `c-typedef-kwds' ("typedef") is present, and A is t when some other + ;; `c-typedef-declkwds' (e.g. class, struct, enum) specifier is present. + ;; I.e., (some of) the declared identifier(s) are types. ;; ;; The third element of the return value is non-nil when the declaration ;; parsed might be an expression. The fourth element is the position of @@ -9972,6 +10055,9 @@ This function might do hidden buffer changes." at-type-decl ;; Set if we've a "typedef" keyword. at-typedef + ;; Set if `context' is '<> and the identifier is definitely a type, or + ;; has already been recorded as a found type. + at-<>-type ;; Set if we've found a specifier that can start a declaration ;; where there's no type. maybe-typeless @@ -10050,6 +10136,11 @@ This function might do hidden buffer changes." (setq kwd-sym (c-keyword-sym (match-string 1))) (save-excursion (c-forward-keyword-clause 1) + (when (and (c-major-mode-is 'c++-mode) + (c-keyword-member kwd-sym 'c-<>-sexp-kwds) + (save-match-data + (looking-at c-fun-name-substitute-key))) + (c-forward-c++-requires-clause)) (setq kwd-clause-end (point)))) ((and c-opt-cpp-prefix (looking-at c-noise-macro-with-parens-name-re)) @@ -10089,6 +10180,11 @@ This function might do hidden buffer changes." (point)))) found-type-list)) + ;; Might we have a C++20 concept? i.e. template? + (setq at-<>-type + (and (eq context '<>) + (memq found-type '(t known prefix found)))) + ;; Signal a type declaration for "struct foo {". (when (and backup-at-type-decl (eq (char-after) ?{)) @@ -10377,8 +10473,11 @@ This function might do hidden buffer changes." t) (when (if (save-match-data (looking-at "\\s(")) (c-safe (c-forward-sexp 1) t) - (goto-char (match-end 1)) - t) + (if (save-match-data + (looking-at c-fun-name-substitute-key)) ; requires + (c-forward-c++-requires-clause) + (goto-char (match-end 1)) + t)) (when (and (not got-suffix-after-parens) (= paren-depth 0)) (setq got-suffix-after-parens (match-beginning 0))) @@ -10971,8 +11070,8 @@ This function might do hidden buffer changes." (c-forward-type)))) (list id-start - (and (or at-type-decl at-typedef) - (cons at-type-decl at-typedef)) + (and (or at-type-decl at-typedef at-<>-type) + (list at-type-decl at-typedef at-<>-type)) maybe-expression type-start (or (eq context 'top) make-top))) @@ -12429,6 +12528,8 @@ comment at the start of cc-engine.el for more info." in-paren 'in-paren)) ((looking-at c-pre-brace-non-bracelist-key) (setq braceassignp nil)) + ((looking-at c-fun-name-substitute-key) + (setq braceassignp nil)) ((looking-at c-return-key)) ((and (looking-at c-symbol-start) (not (looking-at c-keywords-regexp))) @@ -12439,6 +12540,11 @@ comment at the start of cc-engine.el for more info." (setq after-type-id-pos (point)))) ((eq (char-after) ?\() (setq parens-before-brace t) + ;; Have we a requires with a parenthesis list? + (when (save-excursion + (and (zerop (c-backward-token-2 1 nil lim)) + (looking-at c-fun-name-substitute-key))) + (setq braceassignp nil)) nil) (t nil)) (save-excursion @@ -14201,6 +14307,25 @@ comment at the start of cc-engine.el for more info." (goto-char placeholder) (c-add-syntax 'inher-cont (c-point 'boi))) + ;; CASE 5D.7: Continuation of a "concept foo =" line in C++20 (or + ;; similar). + ((and c-equals-nontype-decl-key + (save-excursion + (prog1 + (and (zerop (c-backward-token-2 1 nil lim)) + (looking-at c-operator-re) + (equal (match-string 0) "=") + (zerop (c-backward-token-2 1 nil lim)) + (looking-at c-symbol-start) + (not (looking-at c-keywords-regexp)) + (zerop (c-backward-token-2 1 nil lim)) + (looking-at c-equals-nontype-decl-key) + (eq (c-beginning-of-statement-1 lim) 'same)) + (setq placeholder (point))))) + (goto-char placeholder) + (c-add-stmt-syntax 'topmost-intro-cont nil nil containing-sexp + paren-state)) + ;; CASE 5D.5: Continuation of the "expression part" of a ;; top level construct. Or, perhaps, an unrecognized construct. (t diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 5d80eb58e3..753ae48087 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -887,6 +887,23 @@ casts and declarations are fontified. Used on level 2 and higher." ,@(when (c-major-mode-is 'c++-mode) '(c-font-lock-c++-modules)) + ;; The next regexp is highlighted with narrowing. This is so that the + ;; final "context" bit of the regexp, "\\(?:[^=]\\|$\\)", which cannot + ;; match anything non-empty at LIMIT, will match "$" instead. + ,@(when (c-lang-const c-equals-nontype-decl-kwds) + `((,(byte-compile + `(lambda (limit) + (save-restriction + (narrow-to-region (point-min) limit) + ,(c-make-font-lock-search-form + (concat (c-lang-const c-equals-nontype-decl-key) ;no \\( + (c-lang-const c-simple-ws) "+\\(" + (c-lang-const c-symbol-key) "\\)" + (c-lang-const c-simple-ws) "*" + "=\\(?:[^=]\\|$\\)") + `((,(+ 1 (c-lang-const c-simple-ws-depth)) + font-lock-type-face t))))))))) + ;; Fontify the special declarations in Objective-C. ,@(when (c-major-mode-is 'objc-mode) `(;; Fontify class names in the beginning of message expressions. @@ -1278,15 +1295,19 @@ casts and declarations are fontified. Used on level 2 and higher." (or (memq type '(c-decl-arg-start c-decl-type-start)) (and (progn (c-backward-syntactic-ws) t) - (c-back-over-compound-identifier) - (progn - (c-backward-syntactic-ws) - (or (bobp) - (progn - (setq type (c-get-char-property (1- (point)) - 'c-type)) - (memq type '(c-decl-arg-start - c-decl-type-start)))))))))) + (or + (and + (c-back-over-compound-identifier) + (progn + (c-backward-syntactic-ws) + (or (bobp) + (progn + (setq type (c-get-char-property (1- (point)) + 'c-type)) + (memq type '(c-decl-arg-start + c-decl-type-start)))))) + (and (zerop (c-backward-token-2)) + (looking-at c-fun-name-substitute-key)))))))) (cons 'decl nil)) (t (cons 'arglist t))))) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index d33ed4bcda..85f43d6a26 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2593,6 +2593,35 @@ will be handled." t (c-make-keywords-re t (c-lang-const c-equals-type-clause-kwds))) (c-lang-defvar c-equals-type-clause-key (c-lang-const c-equals-type-clause-key)) +(c-lang-defconst c-equals-nontype-decl-kwds + "Keywords which are followed by an identifier then an \"=\" +sign, which declares the identifier to be something other than a +type." + t nil + c++ '("concept")) + +(c-lang-defconst c-equals-nontype-decl-key + ;; An unadorned regular expression which matches any member of + ;; `c-equals-decl-kwds', or nil if such don't exist in the current language. + t (when (c-lang-const c-equals-nontype-decl-kwds) + (c-make-keywords-re nil (c-lang-const c-equals-nontype-decl-kwds)))) +(c-lang-defvar c-equals-nontype-decl-key + (c-lang-const c-equals-nontype-decl-key)) + +(c-lang-defconst c-fun-name-substitute-kwds + "Keywords which take the place of type+declarator at the beginning +of a function-like structure, such as a C++20 \"requires\" +clause. An arglist may or may not follow such a keyword." + t nil + c++ '("requires")) + +(c-lang-defconst c-fun-name-substitute-key + ;; An adorned regular expression which matches any member of + ;; `c-fun-name-substitute-kwds'. + t (c-make-keywords-re t (c-lang-const c-fun-name-substitute-kwds))) +(c-lang-defvar c-fun-name-substitute-key + (c-lang-const c-fun-name-substitute-key)) + (c-lang-defconst c-modifier-kwds "Keywords that can prefix normal declarations of identifiers \(and typically act as flags). Things like argument declarations @@ -2938,6 +2967,17 @@ if this isn't nil." ;; In CORBA PSDL: "ref")) +(c-lang-defconst c-pre-concept-<>-kwds + "Keywords that may be followed by an angle bracket expression containing +uses of \"concepts\". This is currently (2022-09) used only by C++." + t nil + c++ '("template")) + +(c-lang-defconst c-pre-concept-<>-key + ;; Regexp matching any element of `c-pre-concept-<>-kwds'. + t (c-make-keywords-re t (c-lang-const c-pre-concept-<>-kwds))) +(c-lang-defvar c-pre-concept-<>-key (c-lang-const c-pre-concept-<>-key)) + (c-lang-defconst c-<>-arglist-kwds "Keywords that can be followed by a C++ style template arglist; see `c-recognize-<>-arglists' for details. That language constant is @@ -3146,6 +3186,10 @@ not really template operators." java '("true" "false" "null") ; technically "literals", not keywords pike '("UNDEFINED")) ;; Not a keyword, but practically works as one. +(c-lang-defconst c-constant-key + t (c-make-keywords-re t (c-lang-const c-constant-kwds))) +(c-lang-defvar c-constant-key (c-lang-const c-constant-key)) + (c-lang-defconst c-primary-expr-kwds "Keywords besides constants and operators that start primary expressions." t nil @@ -3781,7 +3825,10 @@ is in effect when this is matched (see `c-identifier-syntax-table')." ;; "throw" in `c-type-modifier-kwds' is followed ;; by a parenthesis list, but no extra measures ;; are necessary to handle that. - (regexp-opt (c-lang-const c-type-modifier-kwds) t) + (regexp-opt + (append (c-lang-const c-fun-name-substitute-kwds) + (c-lang-const c-type-modifier-kwds)) + t) "\\>") "") "\\)") diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 15dfdc4b0e..9dd5ddb465 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2403,7 +2403,7 @@ with // and /*, not more generic line and block comments." (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state))))))) (goto-char pseudo)) t) - (> (point) bod-lim) + (>= (point) bod-lim) (progn (c-forward-syntactic-ws) ;; Have we got stuck in a comment at EOB? (not (and (eobp) @@ -2427,7 +2427,8 @@ with // and /*, not more generic line and block comments." (and (> (point) bod-lim) (or (memq (char-before) '(?\( ?\[)) (and (eq (char-before) ?\<) - (eq (c-get-char-property + (equal + (c-get-char-property (1- (point)) 'syntax-table) c-<-as-paren-syntax)) (and (eq (char-before) ?{) commit bb83fb5f62aa4b27a5598f4a0a9b22efdd94cf14 Author: Stefan Kangas Date: Mon Sep 26 21:10:58 2022 +0200 Don't auto-resize image if echo area is non-empty * lisp/image-mode.el (image-fit-to-window): Don't auto-resize image if there's a message in the echo area. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index eee4be6a10..bd208fbad4 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1061,7 +1061,9 @@ Otherwise, display the image by calling `image-mode'." ;; Don't resize anything if we're in the minibuffer ;; (which may transitively change the window sizes if you ;; hit TAB, for instance). - (not (minibuffer-window-active-p (selected-window)))) + (not (minibuffer-window-active-p (selected-window))) + ;; Don't resize if there's a message in the echo area. + (not (current-message))) (with-current-buffer (window-buffer window) (when (derived-mode-p 'image-mode) (let ((spec (image-get-display-property))) commit 6d0fec5ae084f8b0b8564d66f61f2ea742ee1d8b Author: Eli Zaretskii Date: Mon Sep 26 19:29:47 2022 +0300 ; * lisp/image/wallpaper.el (cl-macs): Require, to avoid warnings. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 19dc20d90b..b2a36e98a4 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -55,6 +55,7 @@ (eval-when-compile (require 'subr-x)) (require 'xdg) +(require 'cl-macs) (defvar wallpaper-debug nil "If non-nil, display debug messages.") commit 2ec061bf9c8a2caf8eaf57dba001c130d3a3ecd6 Author: Stefan Kangas Date: Mon Sep 26 17:41:11 2022 +0200 Display a message when wallpaper was set * lisp/image/wallpaper.el (wallpaper-default-set-function): Display a message when the wallpaper was successfully set. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 31cc2b4eec..19dc20d90b 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -439,8 +439,10 @@ This is the default function for `wallpaper-set-function'." (setf (process-sentinel process) (lambda (process status) (unwind-protect - (unless (and (eq (process-status process) 'exit) - (zerop (process-exit-status process))) + (if (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (message "Desktop wallpaper changed to %s" + (abbreviate-file-name file)) (message "command \"%s %s\": %S" (string-join (process-command process) " ") (string-replace "\n" "" status) commit b0289e7f6ddebdd2bdefa63e2b4afcb29733b3b7 Author: Stefan Kangas Date: Mon Sep 26 14:38:25 2022 +0200 Fix setting the wallpaper in XFCE * lisp/image/wallpaper.el (wallpaper-command-args) (wallpaper-default-set-function): Support new format specifiers %S for screen, %W for workspace, and %M for monitor. (wallpaper--default-setters): Use above new specifiers for XFCE. (wallpaper--format-arg): New defun broken out from... (wallpaper-default-set-function): ...here. (wallpaper--get-height-or-width): Support noninteractive use. * test/lisp/image/wallpaper-tests.el (wallpaper--format-arg/filename) (wallpaper--format-arg/filename-hex) (wallpaper--format-arg/width, wallpaper--format-arg/screen) (wallpaper--format-arg/monitor, wallpaper--format-arg/workspace): New tests. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index bdaa148e2b..31cc2b4eec 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -153,7 +153,7 @@ and returns non-nil if this setter should be used." ("XFCE" "xfconf-query" '("-c" "xfce4-desktop" - "-p" "/backdrop/screen0/monitoreDP/workspace0/last-image" + "-p" "/backdrop/screen%S/monitor%M/workspace%W/last-image" "-s" "%f") :predicate (lambda () (or (and (getenv "DESKTOP_SESSION") @@ -320,15 +320,20 @@ automatically, so there is usually no need to customize this. However, if you do need to change this, you might also want to customize `wallpaper-command' to match. -In each of the command line arguments, \"%f\" will be replaced -with the full file name, \"%F\" with the full file name -URI-encoded, \"%h\" with the height of the selected frame's -display (as returned by `display-pixel-height'), and \"%w\" with -the width of the selected frame's display (as returned by -`display-pixel-width'). +In each command line argument, these specifiers will be replaced: -If `wallpaper-set' is run from a TTY frame, it will prompt for a -height and width for \"%h\" and \"%w\" instead. + %f full file name + %h height of the selected frame's display (as returned + by `display-pixel-height') + %w the width of the selected frame's display (as returned + by `display-pixel-width'). + %F full file name URI-encoded + %S current X screen (e.g. \"0\") + %W current workspace (e.g., \"0\") + %M name of the monitor (e.g., \"0\" or \"LVDS\") + +If `wallpaper-set' is run from a TTY frame, instead prompt for a +height and width to use for %h and %w. The value of this variable is ignored on MS-Windows and Haiku systems, where a native API is used instead." @@ -350,9 +355,9 @@ This is only used when it can't be detected automatically. See also `wallpaper-default-width'.") (defun wallpaper--get-height-or-width (desc fun default) - (if (display-graphic-p) - (funcall fun) - (read-number (format "Wallpaper %s in pixels: " desc) default))) + (cond ((display-graphic-p) (funcall fun)) + (noninteractive default) + ((read-number (format "Wallpaper %s in pixels: " desc) default)))) (autoload 'ffap-file-at-point "ffap") @@ -373,41 +378,70 @@ See also `wallpaper-default-width'.") ;;; wallpaper-set +(defun wallpaper--format-arg (format file) + "Format a `wallpaper-command-args' argument ARG. +FILE is the image file name." + (format-spec + format + `((?f . ,(expand-file-name file)) + (?F . ,(mapconcat #'url-hexify-string + (file-name-split file) + "/")) + (?h . ,(wallpaper--get-height-or-width + "height" + #'display-pixel-height + wallpaper-default-height)) + (?w . ,(wallpaper--get-height-or-width + "width" + #'display-pixel-width + wallpaper-default-width)) + ;; screen number + (?S . ,(let ((display (frame-parameter (selected-frame) 'display))) + (if (and display + (string-match (rx ":" (+ (in "0-9")) "." + (group (+ (in "0-9"))) eos) + display)) + (match-string 1 display) + "0"))) + ;; monitor name + (?M . ,(let* ((attrs (car (display-monitor-attributes-list))) + (source (cdr (assq 'source attrs))) + (monitor (cdr (assq 'name attrs)))) + (if (and monitor (member source '("XRandr" "XRandr 1.5" "Gdk"))) + monitor + "0"))) + ;; workspace + (?W . ,(or (and (fboundp 'x-window-property) + (display-graphic-p) + (number-to-string + (or (x-window-property "_NET_CURRENT_DESKTOP" nil "CARDINAL" 0 nil t) + (x-window-property "WIN_WORKSPACE" nil "CARDINAL" 0 nil t)))) + "0"))))) + (defun wallpaper-default-set-function (file) "Set the wallpaper to FILE using a command. This is the default function for `wallpaper-set-function'." (unless wallpaper-command (error "Couldn't find a command to set the wallpaper with")) - (let* ((fmt-spec `((?f . ,(expand-file-name file)) - (?F . ,(mapconcat #'url-hexify-string - (file-name-split file) - "/")) - (?h . ,(wallpaper--get-height-or-width - "height" - #'display-pixel-height - wallpaper-default-height)) - (?w . ,(wallpaper--get-height-or-width - "width" - #'display-pixel-width - wallpaper-default-width)))) + (let* ((real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file)) + wallpaper-command-args)) (bufname (format " *wallpaper-%s*" (random))) (process (and wallpaper-command (apply #'start-process "set-wallpaper" bufname - wallpaper-command - (mapcar (lambda (arg) (format-spec arg fmt-spec)) - wallpaper-command-args))))) + wallpaper-command real-args)))) (unless wallpaper-command (error "Couldn't find a suitable command for setting the wallpaper")) - (wallpaper-debug - "Using command %S %S" wallpaper-command - wallpaper-command-args) + (wallpaper-debug "Using command: \"%s %s\"" + wallpaper-command (string-join wallpaper-command-args " ")) + (wallpaper-debug (wallpaper--format-arg + "f=%f w=%w h=%h S=%S M=%M W=%W" file)) (setf (process-sentinel process) (lambda (process status) (unwind-protect (unless (and (eq (process-status process) 'exit) (zerop (process-exit-status process))) - (message "command %S %s: %S" + (message "command \"%s %s\": %S" (string-join (process-command process) " ") (string-replace "\n" "" status) (with-current-buffer (process-buffer process) diff --git a/test/lisp/image/wallpaper-tests.el b/test/lisp/image/wallpaper-tests.el index 80d512c985..c3feab0e20 100644 --- a/test/lisp/image/wallpaper-tests.el +++ b/test/lisp/image/wallpaper-tests.el @@ -54,4 +54,33 @@ (insert fil) (should (stringp (wallpaper--get-default-file)))))) +(ert-deftest wallpaper--format-arg/filename () + (should (file-name-absolute-p (wallpaper--format-arg "%f" "foo.jpg")))) + +(ert-deftest wallpaper--format-arg/filename-hex () + (should (equal (wallpaper--format-arg "%F" "foo bar åäö.jpg") + "foo%20bar%20%C3%A5%C3%A4%C3%B6.jpg"))) + +(ert-deftest wallpaper--format-arg/width () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%w" "foo.jpg") + (number-to-string wallpaper-default-width)))) + +(ert-deftest wallpaper--format-arg/height () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%h" "foo.jpg") + (number-to-string wallpaper-default-height)))) + +(ert-deftest wallpaper--format-arg/screen () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%S" "foo.jpg") "0"))) + +(ert-deftest wallpaper--format-arg/monitor () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%M" "foo.jpg") "0"))) + +(ert-deftest wallpaper--format-arg/workspace () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%W" "foo.jpg") "0"))) + ;;; wallpaper-tests.el ends here commit 35d5ad713ee05f5cd922f66462df41deed95f7e8 Author: Stefan Kangas Date: Sun Sep 18 11:48:24 2022 +0200 Rewrite wallpaper.el to use a cl-defstruct * lisp/image/wallpaper.el (wallpaper--default-commands): Delete variable. (wallpaper-setter): New cl-defstruct. (wallpaper--default-methods-create): New macro. (wallpaper--default-setters): (wallpaper--current-setter): New variables. (wallpaper--find-setter): New defun to pick a wallpaper-setter. (wallpaper--find-command, wallpaper--find-command-args): Use 'wallpaper--find-setter'. (wallpaper-command): Doc fix. * test/lisp/image/wallpaper-tests.el (wallpaper--find-command/return-string) (wallpaper--find-command-args/return-list) (wallpaper--image-file-regexp/return-string): New tests. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 886c7d691b..bdaa148e2b 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -44,12 +44,27 @@ ;; disable the option "Change picture" in the "Desktop & Screensaver" ;; preferences for this to work (this was seen with macOS 10.13). ;; You might also have to tweak some permissions. +;; +;; Note: If you find that you need to use a command in your +;; environment that was not automatically detected, we would love to +;; hear about it! Please send an email to bug-gnu-emacs@gnu.org and +;; tell us the command (and all options) that worked for you. You can +;; also use `M-x report-emacs-bug'. ;;; Code: (eval-when-compile (require 'subr-x)) (require 'xdg) +(defvar wallpaper-debug nil + "If non-nil, display debug messages.") + +(defun wallpaper-debug (&rest args) + (when wallpaper-debug + (apply #'message + (concat "wallpaper-debug: " (car args)) + (cdr args)))) + (defvar wallpaper-set-function (cond ((fboundp 'w32-set-wallpaper) #'w32-set-wallpaper) @@ -67,123 +82,186 @@ the image file to set the wallpaper to.") ;;; Finding the wallpaper command -(defvar wallpaper--default-commands - ;; When updating this, also update the custom :type for `wallpaper-command'. - '( - ;; Gnome - ("gsettings" "set" "org.gnome.desktop.background" "picture-uri" "file://%F") - ;; KDE Plasma - ("plasma-apply-wallpaperimage" "%f") - ;; XFCE - ("xfconf-query" "-c" "xfce4-desktop" "-p" - "/backdrop/screen0/monitoreDP/workspace0/last-image" "-s" "%f") - ;; LXDE - ("pcmanfm" "--set-wallpaper=%f") - ;; LXQt - ("pcmanfm-qt" "--set-wallpaper=%f") ; "--wallpaper-mode=MODE" - ;; ;; Mate - ;; ("gsettings" "set" "org.mate.background" "picture-filename" "%f") - ;; ;; Cinnamon - ;; ("gsettings" "set" "org.cinnamon.desktop.background" "picture-uri" "file://%F") - ;; ;; Deepin - ;; ("gsettings" "set" "com.deepin.wrap.gnome.desktop.background" "picture-uri" "file://%F") - ;; Sway (Wayland) - ("swaybg" "-o" "*" "-i" "%f" "-m" "fill") - ;; Wayland General - ("wbg" "%f") - ;; macOS - ("osascript" "-e" "tell application \"Finder\" to set desktop picture to POSIX file \"%f\"") - ;; Other / General X - ("gm" "display" "-size" "%wx%h" "-window" "root" "%f") - ("display" "-resize" "%wx%h" "-window" "root" "%f") - ("feh" "--bg-max" "%f") - ("fbsetbg" "-a" "%f") - ("xwallpaper" "--zoom" "%f") - ("hsetroot" "-full" "%f") - ("xloadimage" "-onroot" "-fullscreen" "%f") - ("xsetbg" " %f") - ) - "List of executables and options used for setting the wallpaper. -This is used by `wallpaper--find-command' to automatically set -`wallpaper-command', and by `wallpaper--find-command-args' to set -`wallpaper-command-args'. The commands will be tested in the -order in which they appear. - -Every item in the list has the following form: - - (COMMAND ARG1 .. ARGN) - -COMMAND is the name of the executable (a string) and ARG1 .. ARGN -is its command line arguments (also strings). - -In each of the command line arguments, \"%f\", \"%h\" and \"%w\" -will be replaced as described in `wallpaper-command-args'.") - -(cl-defmethod wallpaper--check-command ((_type (eql 'gsettings))) - (or (and (getenv "DESKTOP_SESSION") - (member (downcase (getenv "DESKTOP_SESSION")) - '("gnome" "gnome" "gnome-wayland" "gnome-xorg" - "unity" "ubuntu" "pantheon" "budgie-desktop" - "pop"))) - (member "GNOME" (xdg-current-desktop)) - (member "Budgie" (xdg-current-desktop)) - (member "GNOME-Classic" (xdg-current-desktop)))) - -(cl-defmethod wallpaper--check-command ((_type (eql 'plasma-apply-wallpaperimage))) - (member "KDE" (xdg-current-desktop))) - -(cl-defmethod wallpaper--check-command ((_type (eql 'xfconf-query))) - (or (and (getenv "DESKTOP_SESSION") - (member (downcase (getenv "DESKTOP_SESSION")) - '("xubuntu" "ubuntustudio"))) - (member "XFCE" (xdg-current-desktop)))) - -(cl-defmethod wallpaper--check-command ((_type (eql 'pcmanf))) - (member "LXDE" (xdg-current-desktop))) +(cl-defstruct (wallpaper-setter + ;; Rename the default constructor from `make-wallpaper-cmd'. + (:constructor + wallpaper-setter-create + ( name command args-raw + &rest rest-plist + &aux + (args (if (listp args-raw) + args-raw + (string-split args-raw))) + (predicate (plist-get rest-plist :predicate)))) + (:copier wallpaper-setter-copy)) + "Structure containing a command to set the wallpaper. + +NAME is a description of the setter (e.g. the name of the Desktop +Environment). + +COMMAND is the executable to run to set the wallpaper. + +ARGS is the default list of command line arguments for COMMAND. + +PREDICATE is a function that will be called without any arguments +and returns non-nil if this setter should be used." + name + command + args + (predicate #'always)) -(cl-defmethod wallpaper--check-command ((_type (eql 'pcmanf-qt))) - (or (member (and (getenv "DESKTOP_SESSION") - (downcase (getenv "DESKTOP_SESSION"))) - '("lubuntu" "lxqt")) - (member "LXQt" (xdg-current-desktop)))) - -;; (cl-defmethod wallpaper--check-command ((_type (eql 'gsettings))) -;; (or (and (getenv "DESKTOP_SESSION") -;; (equal "mate" (downcase (getenv "DESKTOP_SESSION")))) -;; (member "MATE" (xdg-current-desktop)))) - -;; (cl-defmethod wallpaper--check-command ((_type (eql 'gsettings))) -;; (or (equal "cinnamon" (and (getenv "DESKTOP_SESSION") -;; (downcase (getenv "DESKTOP_SESSION")))) -;; (member "X-Cinnamon" (xdg-current-desktop)))) - -;; (cl-defmethod wallpaper--check-command ((_type (eql 'gsettings))) -;; (member "Deepin" (xdg-current-desktop))) +;;;###autoload +(put 'wallpaper-setter-create 'lisp-indent-function 1) + +(defmacro wallpaper--default-methods-create (&rest items) + "Helper macro for defining `wallpaper--default-setters'." + (cons 'list + (mapcar + (lambda (item) + `(wallpaper-setter-create ,@item)) + items))) + +(defvar wallpaper--default-setters + (wallpaper--default-methods-create + + ;; macOS. + ;; NB. Should come first to override everything else. + ("macOS" + "osascript" + '("-e" "tell application \"Finder\" to set desktop picture to POSIX file \"%f\"") + :predicate (lambda () + (eq system-type 'darwin))) + + ;; Desktop environments. + ("Gnome" + "gsettings" + "set org.gnome.desktop.background picture-uri file://%F" + :predicate (lambda () + (or (and (getenv "DESKTOP_SESSION") + (member (downcase (getenv "DESKTOP_SESSION")) + '("gnome" "gnome" "gnome-wayland" "gnome-xorg" + "unity" "ubuntu" "pantheon" "budgie-desktop" + "pop"))) + (member "GNOME" (xdg-current-desktop)) + (member "Budgie" (xdg-current-desktop)) + (member "GNOME-Classic" (xdg-current-desktop))))) + + ("KDE Plasma" + "plasma-apply-wallpaperimage" "%f" + :predicate (lambda () + (member "KDE" (xdg-current-desktop)))) + + ("XFCE" + "xfconf-query" '("-c" "xfce4-desktop" + "-p" "/backdrop/screen0/monitoreDP/workspace0/last-image" + "-s" "%f") + :predicate (lambda () + (or (and (getenv "DESKTOP_SESSION") + (member (downcase (getenv "DESKTOP_SESSION")) + '("xubuntu" "ubuntustudio"))) + (member "XFCE" (xdg-current-desktop))))) + + ("LXDE" + "pcmanfm" "--set-wallpaper=%f" + :predicate (lambda () + (member "LXDE" (xdg-current-desktop)))) + + ("LXQt" + "pcmanfm-qt" "--set-wallpaper=%f" ; "--wallpaper-mode=MODE" + :predicate (lambda () + (or (member (and (getenv "DESKTOP_SESSION") + (downcase (getenv "DESKTOP_SESSION"))) + '("lubuntu" "lxqt")) + (member "LXQt" (xdg-current-desktop))))) + + ("Mate" + "gsettings" "set org.mate.background picture-filename %f" + :predicate (lambda () + (or (and (getenv "DESKTOP_SESSION") + (equal "mate" (downcase (getenv "DESKTOP_SESSION")))) + (member "MATE" (xdg-current-desktop))))) + + ("Cinnamon" + "gsettings" "set org.cinnamon.desktop.background picture-uri file://%F" + :predicate (lambda () + (or (equal "cinnamon" (and (getenv "DESKTOP_SESSION") + (downcase (getenv "DESKTOP_SESSION")))) + (member "X-Cinnamon" (xdg-current-desktop))))) + + ("Deepin" + "gsettings" "set com.deepin.wrap.gnome.desktop.background picture-uri file://%F" + :predicate (lambda () + (member "Deepin" (xdg-current-desktop)))) + + ;; Wayland general. + ("Sway (Wayland)" + "swaybg" "-o * -i %f -m fill" + :predicate (lambda () + (and (getenv "WAYLAND_DISPLAY") + (getenv "SWAYSOCK")))) + + ("wbg" + "wbg" "%f" + :predicate (lambda () + (getenv "WAYLAND_DISPLAY"))) + + ;; X general. + ("GraphicsMagick" + "gm" "display -size %wx%h -window root %f") + + ("ImageMagick" + "display" "-resize %wx%h -window root %f") + + ("feh" + "feh" "--bg-max %f") + + ("fbsetbg" + "fbsetbg" "-a %f") + + ("xwallpaper" + "xwallpaper" "--zoom %f") + + ("hsetroot" + "hsetroot" "-full %f") + + ("xloadimage" + "xloadimage" "-onroot -fullscreen %f") + + ("xsetbg" + "xsetbg" "%f") + ) + "List of setters used for setting the wallpaper. +Every item in the list is a structure of type +`wallpaper-setter' (which see). -(cl-defmethod wallpaper--check-command ((_type (eql 'swaybg))) - (and (getenv "WAYLAND_DISPLAY") - (getenv "SWAYSOCK"))) +This is used by `wallpaper--find-command' to automatically set +`wallpaper-command', and by `wallpaper--find-command-args' to set +`wallpaper-command-args'. The setters will be tested in the +order in which they appear.") -(cl-defmethod wallpaper--check-command ((_type (eql 'wbg))) - (getenv "WAYLAND_DISPLAY")) +(defvar wallpaper--current-setter nil) -(cl-defmethod wallpaper--check-command (_type) - t) +(defun wallpaper--find-setter () + (when (wallpaper--use-default-set-function-p) + (or wallpaper--current-setter + (setq wallpaper--current-setter + (catch 'found + (dolist (setter wallpaper--default-setters) + (wallpaper-debug "Testing setter %s" (wallpaper-setter-name setter)) + (when (and (executable-find (wallpaper-setter-command setter)) + (if-let ((pred (wallpaper-setter-predicate setter))) + (funcall pred) + t)) + (wallpaper-debug "Found setter %s" (wallpaper-setter-name setter)) + (throw 'found setter)))))))) (defun wallpaper--find-command () "Return a valid command to set the wallpaper in this environment." - (when (wallpaper--use-default-set-function-p) - (catch 'found - (dolist (cmd wallpaper--default-commands) - (if (and (wallpaper--check-command (intern (car cmd))) - (executable-find (car cmd))) - (throw 'found (car cmd))))))) - -(defvar wallpaper-command) ; silence byte-compiler -(defun wallpaper--find-command-arguments () + (wallpaper-setter-command (wallpaper--find-setter))) + +(defun wallpaper--find-command-args () "Return command line arguments matching `wallpaper-command'." - (when (wallpaper--use-default-set-function-p) - (cdr (assoc wallpaper-command wallpaper--default-commands)))) + (wallpaper-setter-args (wallpaper--find-setter))) ;;; Customizable variables @@ -192,10 +270,10 @@ will be replaced as described in `wallpaper-command-args'.") (defun wallpaper--set-wallpaper-command (sym val) "Set `wallpaper-command', and update `wallpaper-command-args'. Used to set `wallpaper-command'." - ;; Note: `wallpaper-command' is used by `wallpaper--find-command-arguments'. + ;; Note: `wallpaper-command' is used by `wallpaper--find-command-args'. (prog1 (set-default sym val) (set-default 'wallpaper-command-args - (wallpaper--find-command-arguments)))) + (wallpaper--find-command-args)))) (defcustom wallpaper-command (wallpaper--find-command) "Executable used by `wallpaper-set' for setting the wallpaper. @@ -208,12 +286,6 @@ automatically updated to match. If you need to change this to an unsupported command, you will want to manually customize `wallpaper-command-args' to match. -Note: If you find that you need to use a command in your -environment that is not automatically detected, we would love to -hear about it! Please send an email to bug-gnu-emacs@gnu.org and -tell us the command (and all options) that worked for you. You -can also use \\[report-emacs-bug]. - The value of this variable is ignored on MS-Windows and Haiku systems, where a native API is used instead." :type @@ -241,7 +313,7 @@ systems, where a native API is used instead." :group 'image :version "29.1") -(defcustom wallpaper-command-args (wallpaper--find-command-arguments) +(defcustom wallpaper-command-args (wallpaper--find-command-args) "Command line arguments for `wallpaper-command'. A suitable command for your environment should be detected automatically, so there is usually no need to customize this. @@ -267,15 +339,6 @@ systems, where a native API is used instead." ;;; Utility functions -(defvar wallpaper-debug nil - "If non-nil, display debug messages.") - -(defun wallpaper-debug (&rest args) - (when wallpaper-debug - (apply #'message - (concat "wallpaper-debug: " (car args)) - (cdr args)))) - (defvar wallpaper-default-width 1080 "Default width used by `wallpaper-set'. This is only used when it can't be detected automatically. diff --git a/test/lisp/image/wallpaper-tests.el b/test/lisp/image/wallpaper-tests.el index 8cd0fe2215..80d512c985 100644 --- a/test/lisp/image/wallpaper-tests.el +++ b/test/lisp/image/wallpaper-tests.el @@ -23,6 +23,17 @@ (require 'ert-x) (require 'wallpaper) +(ert-deftest wallpaper--find-command/return-string () + (should (and (wallpaper--find-command) + (stringp (wallpaper--find-command))))) + +(ert-deftest wallpaper--find-command-args/return-list () + (should (and (wallpaper--find-command-args) + (listp (wallpaper--find-command-args))))) + +(ert-deftest wallpaper--image-file-regexp/return-string () + (should (stringp (wallpaper--image-file-regexp)))) + (ert-deftest wallpaper--get-default-file/empty-gives-nil () (with-temp-buffer (should-not (wallpaper--get-default-file)))) commit a386833503430732a5c9bed8dbc5c3073f72b5ab Author: Protesilaos Stavrou Date: Mon Sep 26 15:41:18 2022 +0300 Add log-edit-summary-separator face (bug#58092) * lisp/vc/log-edit.el (log-edit-summary-separator): Add new face. (log-edit-font-lock-keywords): Replace hardcoded face attributes with named face. * etc/NEWS: Announce the new face. diff --git a/etc/NEWS b/etc/NEWS index 0a5b7bc29c..99243481a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1766,6 +1766,11 @@ Writing shorter summary lines avoids truncation in contexts in which Git commands display summary lines. See the two new user options 'vc-git-log-edit-summary-target-len' and 'vc-git-log-edit-summary-max-len'. +--- +*** New 'log-edit-headers-separator' face +It is used to style the line that separates the 'log-edit' headers +from the 'log-edit' summary. + ** Message --- diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 5290616302..4624ada417 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -325,6 +325,11 @@ automatically." (defface log-edit-summary '((t :inherit font-lock-function-name-face)) "Face for the summary in `log-edit-mode' buffers.") +(defface log-edit-headers-separator + '((t :height 0.1 :inverse-video t :extend t)) + "Face for the separator line in `log-edit-mode' buffers." + :version "29.1") + (defface log-edit-header '((t :inherit font-lock-keyword-face)) "Face for the headers in `log-edit-mode' buffers.") @@ -393,7 +398,7 @@ The first subexpression is the actual text of the field.") nil lax)) ("^\n" (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil - (0 '(face (:height 0.1 :inverse-video t :extend t) + (0 '(face log-edit-headers-separator display-line-numbers-disable t rear-nonsticky t)))) (log-edit--match-first-line (0 'log-edit-summary)))) commit 9b73c9eddab79b2c7550e994df74f0680cf5ed5a Author: Stefan Kangas Date: Mon Sep 26 15:36:22 2022 +0200 Autoload image-dired-thumbnail-storage :safe property * lisp/image/image-dired.el (image-dired-thumbnail-storage): Autoload :safe property. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index d933ccf79c..528348d8d4 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -209,8 +209,8 @@ https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html (const :tag "Thumbnail Managing Standard (extra large 1024x1024)" standard-xx-large) (const :tag "Per-directory" per-directory)) - :safe (lambda (value) (eq value 'per-directory)) :version "29.1") +;;;###autoload(put 'image-dired-thumbnail-storage 'safe-local-variable (lambda (x) (eq x 'per-directory))) (define-obsolete-variable-alias 'image-dired-db-file 'image-dired-tags-db-file "29.1") commit fde23c6e7426b96de0989e25d5a565652c995ca4 Author: Lars Ingebrigtsen Date: Mon Sep 26 15:16:16 2022 +0200 Fix (thing-at-point 'url) in eww forms * lisp/net/eww.el (eww-tag-input): Don't claim to have an URL here (bug#58091). * lisp/net/shr.el (shr-next-link, shr-previous-link): Search for shr-tab-stop instead of shr-url so that we can be more general. (shr-urlify): Mark all links as tabbable-to. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2a511333de..61b1b75068 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1629,7 +1629,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (unless (= start (point)) (put-text-property start (1+ start) 'help-echo "Input field") ;; Mark this as an element we can TAB to. - (put-text-property start (1+ start) 'shr-url dom)))) + (put-text-property start (1+ start) 'shr-tab-stop t)))) (defun eww-tag-select (dom) (shr-ensure-paragraph) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index d56420eb02..75992bc62a 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -503,7 +503,7 @@ Value is a pair of positions (START . END) if there is a non-nil (defun shr-next-link () "Skip to the next link." (interactive) - (let ((match (text-property-search-forward 'shr-url nil nil t))) + (let ((match (text-property-search-forward 'shr-tab-stop nil nil t))) (if (not match) (message "No next link") (goto-char (prop-match-beginning match)) @@ -512,7 +512,7 @@ Value is a pair of positions (START . END) if there is a non-nil (defun shr-previous-link () "Skip to the previous link." (interactive) - (if (not (text-property-search-backward 'shr-url nil nil t)) + (if (not (text-property-search-backward 'shr-tab-stop nil nil t)) (message "No previous link") (message "%s" (get-text-property (point) 'help-echo)))) @@ -1215,6 +1215,7 @@ START, and END. Note that START and END should be markers." (add-text-properties start (point) (list 'shr-url url + 'shr-tab-stop t 'button t 'category 'shr ; For button.el button buffers. 'help-echo (let ((parsed (url-generic-parse-url commit 4feeb7570df33ac335049296d62dba5e05031747 Author: Lars Ingebrigtsen Date: Mon Sep 26 13:53:10 2022 +0200 Rescale images along with text in eww with `C-x C-+' * lisp/net/eww.el (eww--rescale-images): Also rescale images when using `C-x C-+' etc (bug#58047). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index af938e3c19..2a511333de 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1179,8 +1179,28 @@ the like." (setq-local bookmark-make-record-function #'eww-bookmark-make-record) (buffer-disable-undo) (setq-local shr-url-transformer #'eww--transform-url) + ;; Also rescale images when rescaling the text. + (add-hook 'text-scale-mode-hook #'eww--rescale-images nil t) (setq buffer-read-only t)) +(defvar text-scale-mode) +(defvar text-scale-mode-amount) +(defun eww--rescale-images () + (let ((scaling (if text-scale-mode + (+ 1 (* text-scale-mode-amount 0.1)) + 1)) + match) + (save-excursion + (goto-char (point-min)) + (while (setq match (text-property-search-forward 'display)) + (let ((image (prop-match-value match))) + (when (imagep image) + (unless (image-property image :original-scale) + (setf (image-property image :original-scale) + (or (image-property image :scale) 1))) + (setf (image-property image :scale) + (* (image-property image :original-scale) scaling)))))))) + (defun eww--url-at-point () "`thing-at-point' provider function." (get-text-property (point) 'shr-url)) commit e2f2f6b9e869e8cf2714b35d5645fbbbcf2975de Author: Lars Ingebrigtsen Date: Mon Sep 26 13:28:30 2022 +0200 Fix percentage width computation in vtable * lisp/emacs-lisp/vtable.el (vtable--compute-width): Fix percentage computation (bug#58067). diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 61265c97c2..9bdf90bf1d 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -770,7 +770,8 @@ If NEXT, do the next column." ((string-match "\\([0-9.]+\\)px" spec) (string-to-number (match-string 1 spec))) ((string-match "\\([0-9.]+\\)%" spec) - (* (string-to-number (match-string 1 spec)) (window-width nil t))) + (/ (* (string-to-number (match-string 1 spec)) (window-width nil t)) + 100)) (t (error "Invalid spec: %s" spec)))) commit aca4d7cfc40272065de15980698770f939068b67 Author: Lars Ingebrigtsen Date: Mon Sep 26 13:20:59 2022 +0200 Keep point in eww after hitting `g' * lisp/net/eww.el (eww-retrieve): Keep point after hitting `g' (bug#58076). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 34e74f8ffa..af938e3c19 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -415,13 +415,11 @@ For more information, see Info node `(eww) Top'." (defun eww-retrieve (url callback cbargs) (cond ((null eww-retrieve-command) - (url-retrieve url #'eww-render - (list url nil (current-buffer)))) + (url-retrieve url #'eww-render cbargs)) ((eq eww-retrieve-command 'sync) - (let ((orig-buffer (current-buffer)) - (data-buffer (url-retrieve-synchronously url))) + (let ((data-buffer (url-retrieve-synchronously url))) (with-current-buffer data-buffer - (eww-render nil url nil orig-buffer)))) + (apply #'eww-render nil url cbargs)))) (t (let ((buffer (generate-new-buffer " *eww retrieve*")) (error-buffer (generate-new-buffer " *eww error*"))) commit 53af11a2812cef93f8867b5690f0e3a797e0e876 Author: Lars Ingebrigtsen Date: Mon Sep 26 12:56:07 2022 +0200 Fix whitespace-mode in read-only buffers * lisp/whitespace.el (whitespace--update-bob-eob): Don't bug out in read-only buffers (bug#58082). diff --git a/lisp/whitespace.el b/lisp/whitespace.el index ae4d8ae3f0..d7b83ef34a 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -2385,38 +2385,39 @@ purposes)." (save-excursion (save-restriction (widen) - (when (or (null beg) - (<= beg (save-excursion - (goto-char whitespace-bob-marker) - ;; Any change in the first non-`empty' - ;; line, even if it's not the first - ;; character in the line, can potentially - ;; cause subsequent lines to become - ;; classified as `empty' (e.g., delete the - ;; "x" from " x"). - (forward-line 1) - (point)))) - (goto-char 1) - (set-marker whitespace-bob-marker (point)) - (save-match-data - (when (looking-at whitespace-empty-at-bob-regexp) - (set-marker whitespace-bob-marker (match-end 1)) - (put-text-property (match-beginning 1) (match-end 1) - 'font-lock-multiline t)))) - (when (or (null end) - (>= end (save-excursion - (goto-char whitespace-eob-marker) - ;; See above comment for the BoB case. - (forward-line -1) - (point)))) - (goto-char (1+ (buffer-size))) - (set-marker whitespace-eob-marker (point)) - (save-match-data - (when (whitespace--looking-back - whitespace-empty-at-eob-regexp) - (set-marker whitespace-eob-marker (match-beginning 1)) - (put-text-property (match-beginning 1) (match-end 1) - 'font-lock-multiline t)))))))) + (let ((inhibit-read-only t)) + (when (or (null beg) + (<= beg (save-excursion + (goto-char whitespace-bob-marker) + ;; Any change in the first non-`empty' + ;; line, even if it's not the first + ;; character in the line, can potentially + ;; cause subsequent lines to become + ;; classified as `empty' (e.g., delete the + ;; "x" from " x"). + (forward-line 1) + (point)))) + (goto-char 1) + (set-marker whitespace-bob-marker (point)) + (save-match-data + (when (looking-at whitespace-empty-at-bob-regexp) + (set-marker whitespace-bob-marker (match-end 1)) + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t)))) + (when (or (null end) + (>= end (save-excursion + (goto-char whitespace-eob-marker) + ;; See above comment for the BoB case. + (forward-line -1) + (point)))) + (goto-char (1+ (buffer-size))) + (set-marker whitespace-eob-marker (point)) + (save-match-data + (when (whitespace--looking-back + whitespace-empty-at-eob-regexp) + (set-marker whitespace-eob-marker (match-beginning 1)) + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; commit 4c0fc12631ba15ffa8e5e6ebc8673f26fdb48202 Author: Eli Zaretskii Date: Mon Sep 26 09:51:14 2022 +0300 ; * etc/TODO: Add some new info to the stylistic-sets item. diff --git a/etc/TODO b/etc/TODO index 3e4979da8a..fefc586123 100644 --- a/etc/TODO +++ b/etc/TODO @@ -359,6 +359,17 @@ should invoke the 'shape' method. 'hbfont_shape' should be extended to pass to 'hb_shape_full' the required array of features, as mentioned in the above HarfBuzz discussion. +Alternatively, stylistic sets could be a font property, or a face +property. See this discussion: + + https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01597.html + +For some relevant use cases, see + + https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01652.html + https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01701.html + https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01772.html + ** Concurrency Stefan Monnier writes: "Including it as an 'experimental' compile-time option sounds good. Of course there might still be big questions commit 9ed03040d5bfb228c8d41f1df44e74a824d0cd44 Author: YAMAMOTO Mitsuharu Date: Mon Sep 26 09:57:23 2022 +0900 Make average width computation on ftcr more permissive (Bug#43058) * src/ftcrfont.c (ftcrfont_open): Use only non-zero width glyphs for computing average width. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index a02ff99870..dc765e5aee 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -233,6 +233,7 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) cairo_glyph_t stack_glyph; font->min_width = font->max_width = 0; font->average_width = font->space_width = 0; + int n = 0; for (char c = 32; c < 127; c++) { cairo_glyph_t *glyphs = &stack_glyph; @@ -252,17 +253,20 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) stack_glyph.index = 0; } int this_width = ftcrfont_glyph_extents (font, stack_glyph.index, NULL); - if (this_width > 0 - && (! font->min_width - || font->min_width > this_width)) - font->min_width = this_width; - if (this_width > font->max_width) - font->max_width = this_width; - if (c == 32) - font->space_width = this_width; - font->average_width += this_width; + if (this_width > 0) + { + if (! font->min_width || font->min_width > this_width) + font->min_width = this_width; + if (this_width > font->max_width) + font->max_width = this_width; + if (c == 32) + font->space_width = this_width; + font->average_width += this_width; + n++; + } } - font->average_width /= 95; + if (n) + font->average_width /= n; cairo_scaled_font_extents (ftcrfont_info->cr_scaled_font, &extents); font->ascent = lround (extents.ascent); commit 76b7a593675c95910881b6551b94ddd23f3b1656 Author: Eli Zaretskii Date: Sun Sep 25 22:49:32 2022 +0300 ; Clarify wording of some doc strings in shortdoc.el * lisp/emacs-lisp/shortdoc.el (shortdoc-next, shortdoc-previous) (shortdoc-next-section, shortdoc-previous-section): Clarify wording. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 6d61ed4ac1..4cfd658e10 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1543,26 +1543,26 @@ Example: (defun shortdoc-next (&optional arg) "Move point to the next function. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function)) (defun shortdoc-previous (&optional arg) "Move point to the previous function. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function t) (backward-char 1)) (defun shortdoc-next-section (&optional arg) "Move point to the next section. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section)) (defun shortdoc-previous-section (&optional arg) "Move point to the previous section. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section t) (forward-line -2)) commit 18d75b4ab91fef6e344e612580088b714acfdb6e Author: Stefan Monnier Date: Sun Sep 25 13:51:30 2022 -0400 tex-mode.el: Don't override AUCTeX modes * lisp/textmodes/tex-mode.el (TeX-mode, plain-TeX-mode, LaTeX-mode): Only define them as aliases in `lisp/loaddefs.el` so we don't override AUCTeX's own definitions when we load `tex-mode.el`. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 77c0d23420..b43537265f 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1043,12 +1043,9 @@ says which mode to use." ;; users who may have files annotated with -*- LaTeX -*- (e.g. because they ;; received them from someone using AUCTeX). -;;;###autoload -(defalias 'TeX-mode #'tex-mode) -;;;###autoload -(defalias 'plain-TeX-mode #'plain-tex-mode) -;;;###autoload -(defalias 'LaTeX-mode #'latex-mode) +;;;###autoload (defalias 'TeX-mode #'tex-mode) +;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode) +;;;###autoload (defalias 'LaTeX-mode #'latex-mode) ;;;###autoload (define-derived-mode plain-tex-mode tex-mode "TeX" commit b55b2f1c316ba6a488cc381513a17cf3eec27a0f Author: Mattias Engdegård Date: Sun Sep 25 17:47:39 2022 +0200 Boolean constant detection additions * lisp/emacs-lisp/byte-opt.el (byte-opt--bool-value-form): `set` is boolean identity in its second argument. (byte-compile-trueconstp): `set-marker` is always true. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4ef9cb0a1e..ed6b7b08a4 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -737,7 +737,7 @@ for speeding up processing.") reverse nreverse sort)) (setq form (nth 1 form)) t) - ((memq head '(mapc setq setcar setcdr puthash)) + ((memq head '(mapc setq setcar setcdr puthash set)) (setq form (nth 2 form)) t) ((memq head '(aset put function-put)) @@ -793,6 +793,7 @@ for speeding up processing.") sxhash sxhash-equal sxhash-eq sxhash-eql sxhash-equal-including-properties make-marker copy-marker point-marker mark-marker + set-marker kbd key-description always)) t) commit 197afa4de340679e18d7b91d50c82d2e14a2699b Author: Mattias Engdegård Date: Sun Sep 25 17:44:29 2022 +0200 ; * src/fns.c (Fcopy_alist): More accurate error type diff --git a/src/fns.c b/src/fns.c index 964141f338..3e5a83d03d 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1415,9 +1415,9 @@ are shared, however. Elements of ALIST that are not conses are also shared. */) (Lisp_Object alist) { + CHECK_LIST (alist); if (NILP (alist)) return alist; - CHECK_CONS (alist); alist = Fcopy_sequence (alist); for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem)) { commit e0565e389670829cf8a55ecee052b947dd297460 Author: Stefan Kangas Date: Sun Sep 25 17:27:20 2022 +0200 Refactor system specific code in wallpaper.el * lisp/image/wallpaper.el (wallpaper-set-function): New defvar containing system specific function for setting wallpaper. (wallpaper-default-set-function): Factor out function from... (wallpaper-set): ...here. Use above new defvar. (wallpaper-default-file-name-regexp): Delete defvar. (wallpaper-image-file-extensions): New defvar. (wallpaper--image-file-regexp): New defun that returns a regexp to match for completion purposes. (wallpaper--use-default-set-function-p): New defun. (wallpaper--find-command, wallpaper--find-command-arguments): Do nothing on MS-Windows and Haiku. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index e5f2df73f4..886c7d691b 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -43,12 +43,27 @@ ;; On macOS, the "osascript" command is used. You might need to ;; disable the option "Change picture" in the "Desktop & Screensaver" ;; preferences for this to work (this was seen with macOS 10.13). +;; You might also have to tweak some permissions. ;;; Code: (eval-when-compile (require 'subr-x)) (require 'xdg) +(defvar wallpaper-set-function + (cond ((fboundp 'w32-set-wallpaper) + #'w32-set-wallpaper) + ((and (fboundp 'haiku-set-wallpaper) + (featurep 'haiku)) + 'haiku-set-wallpaper) + (#'wallpaper-default-set-function)) + "Function used by `wallpaper-set' to set the wallpaper. +The function takes one argument, FILE, which is the file name of +the image file to set the wallpaper to.") + +(defun wallpaper--use-default-set-function-p () + (eq wallpaper-set-function #'wallpaper-default-set-function)) + ;;; Finding the wallpaper command @@ -157,16 +172,18 @@ will be replaced as described in `wallpaper-command-args'.") (defun wallpaper--find-command () "Return a valid command to set the wallpaper in this environment." - (catch 'found - (dolist (cmd wallpaper--default-commands) - (if (and (wallpaper--check-command (intern (car cmd))) - (executable-find (car cmd))) - (throw 'found (car cmd)))))) + (when (wallpaper--use-default-set-function-p) + (catch 'found + (dolist (cmd wallpaper--default-commands) + (if (and (wallpaper--check-command (intern (car cmd))) + (executable-find (car cmd))) + (throw 'found (car cmd))))))) (defvar wallpaper-command) ; silence byte-compiler (defun wallpaper--find-command-arguments () "Return command line arguments matching `wallpaper-command'." - (cdr (assoc wallpaper-command wallpaper--default-commands))) + (when (wallpaper--use-default-set-function-p) + (cdr (assoc wallpaper-command wallpaper--default-commands)))) ;;; Customizable variables @@ -259,9 +276,6 @@ systems, where a native API is used instead." (concat "wallpaper-debug: " (car args)) (cdr args)))) - -;;; wallpaper-set - (defvar wallpaper-default-width 1080 "Default width used by `wallpaper-set'. This is only used when it can't be detected automatically. @@ -279,19 +293,65 @@ See also `wallpaper-default-width'.") (autoload 'ffap-file-at-point "ffap") -;; FIXME: This only says which files are supported by Emacs, not by -;; the external tool we use to set the wallpaper. -(defvar wallpaper-default-file-name-regexp (image-file-name-regexp)) +(defvar wallpaper-image-file-extensions + '("bmp" "gif" "heif" "jpeg" "jpg" "png" "tif" "tiff" "webp") + "List of file extensions that `wallpaper-set' will consider for completion.") + +(defun wallpaper--image-file-regexp () + (rx-to-string '(: "." (eval `(or ,@wallpaper-image-file-extensions)) eos) t)) (defun wallpaper--get-default-file () (catch 'found (dolist (file (list buffer-file-name (ffap-file-at-point))) - (when (and file (string-match wallpaper-default-file-name-regexp file)) + (when (and file (string-match (wallpaper--image-file-regexp) file)) (throw 'found (abbreviate-file-name (expand-file-name file))))))) -(declare-function w32-set-wallpaper "w32fns.c") -(declare-function haiku-set-wallpaper "term/haiku-win.el") + +;;; wallpaper-set + +(defun wallpaper-default-set-function (file) + "Set the wallpaper to FILE using a command. +This is the default function for `wallpaper-set-function'." + (unless wallpaper-command + (error "Couldn't find a command to set the wallpaper with")) + (let* ((fmt-spec `((?f . ,(expand-file-name file)) + (?F . ,(mapconcat #'url-hexify-string + (file-name-split file) + "/")) + (?h . ,(wallpaper--get-height-or-width + "height" + #'display-pixel-height + wallpaper-default-height)) + (?w . ,(wallpaper--get-height-or-width + "width" + #'display-pixel-width + wallpaper-default-width)))) + (bufname (format " *wallpaper-%s*" (random))) + (process + (and wallpaper-command + (apply #'start-process "set-wallpaper" bufname + wallpaper-command + (mapcar (lambda (arg) (format-spec arg fmt-spec)) + wallpaper-command-args))))) + (unless wallpaper-command + (error "Couldn't find a suitable command for setting the wallpaper")) + (wallpaper-debug + "Using command %S %S" wallpaper-command + wallpaper-command-args) + (setf (process-sentinel process) + (lambda (process status) + (unwind-protect + (unless (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (message "command %S %s: %S" + (string-join (process-command process) " ") + (string-replace "\n" "" status) + (with-current-buffer (process-buffer process) + (string-clean-whitespace (buffer-string))))) + (ignore-errors + (kill-buffer (process-buffer process)))))) + process)) ;;;###autoload (defun wallpaper-set (file) @@ -309,10 +369,10 @@ so the value of `wallpaper-commands' is ignored." (list (read-file-name (format-prompt "Set desktop background to" default) default-directory default t nil - (lambda (file-name) - (or (file-directory-p file-name) - (string-match wallpaper-default-file-name-regexp - file-name))))))) + (let ((re (wallpaper--image-file-regexp))) + (lambda (file-name) + (or (file-directory-p file-name) + (string-match re file-name)))))))) (when (file-directory-p file) (error "Can't set wallpaper to a directory: %s" file)) (unless (file-exists-p file) @@ -320,49 +380,7 @@ so the value of `wallpaper-commands' is ignored." (unless (file-readable-p file) (error "File is not readable: %s" file)) (wallpaper-debug "Using image %S:" file) - (cond ((eq system-type 'windows-nt) - (w32-set-wallpaper file)) - ((featurep 'haiku) - (haiku-set-wallpaper file)) - (t - (unless wallpaper-command - (error "Couldn't find a command to set the wallpaper with")) - (let* ((fmt-spec `((?f . ,(expand-file-name file)) - (?F . ,(mapconcat #'url-hexify-string - (file-name-split file) - "/")) - (?h . ,(wallpaper--get-height-or-width - "height" - #'display-pixel-height - wallpaper-default-height)) - (?w . ,(wallpaper--get-height-or-width - "width" - #'display-pixel-width - wallpaper-default-width)))) - (bufname (format " *wallpaper-%s*" (random))) - (process - (and wallpaper-command - (apply #'start-process "set-wallpaper" bufname - wallpaper-command - (mapcar (lambda (arg) (format-spec arg fmt-spec)) - wallpaper-command-args))))) - (unless wallpaper-command - (error "Couldn't find a suitable command for setting the wallpaper")) - (wallpaper-debug - "Using command %S %S" wallpaper-command - wallpaper-command-args) - (setf (process-sentinel process) - (lambda (process status) - (unwind-protect - (unless (and (eq (process-status process) 'exit) - (zerop (process-exit-status process))) - (message "command %S %s: %S" (string-join (process-command process) " ") - (string-replace "\n" "" status) - (with-current-buffer (process-buffer process) - (string-clean-whitespace (buffer-string))))) - (ignore-errors - (kill-buffer (process-buffer process)))))) - process)))) + (funcall wallpaper-set-function file)) (provide 'wallpaper) commit fb5a0497707b2eb1dd58e7d403172e4f3e23d234 Author: Mattias Engdegård Date: Sun Sep 25 17:03:32 2022 +0200 Don't crash in copy-alist with non-list argument * src/fns.c (Fcopy_alist): Check argument type. * test/src/fns-tests.el (fns--copy-alist): New test. diff --git a/src/fns.c b/src/fns.c index d2f1aadb65..964141f338 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1417,6 +1417,7 @@ Elements of ALIST that are not conses are also shared. */) { if (NILP (alist)) return alist; + CHECK_CONS (alist); alist = Fcopy_sequence (alist); for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem)) { diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index fe8df7097a..3f3d9a0285 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1422,4 +1422,31 @@ (should (equal (ntake (- most-negative-fixnum 1) list) nil)) (should (equal list '(a b c))))) +(ert-deftest fns--copy-alist () + (dolist (orig '(nil + ((a . 1) (b . 2) (a . 3)) + (a (b . 3) ((c) (d))))) + (ert-info ((prin1-to-string orig) :prefix "orig: ") + (let ((copy (copy-alist orig))) + (should (equal orig copy)) + (while orig + (should-not (eq orig copy)) + ;; Check that cons pairs are copied but nothing else. + (let ((orig-elt (car orig)) + (copy-elt (car copy))) + (if (atom orig-elt) + (should (eq orig-elt copy-elt)) + (should-not (eq orig-elt copy-elt)) + (should (eq (car orig-elt) (car copy-elt))) + (should (eq (cdr orig-elt) (cdr copy-elt))))) + (setq orig (cdr orig)) + (setq copy (cdr copy)))))) + + (should-error (copy-alist 'a) + :type 'wrong-type-argument) + (should-error (copy-alist [(a . 1) (b . 2) (a . 3)]) + :type 'wrong-type-argument) + (should-error (copy-alist "abc") + :type 'wrong-type-argument)) + ;;; fns-tests.el ends here commit ad88e3e0b5d625282fb73f3378407ac87dad21f0 Author: Stefan Kangas Date: Sun Sep 25 16:16:51 2022 +0200 Add reasonable default to wallpaper-set * lisp/image/wallpaper.el (wallpaper-default-file-name-regexp): New variable. (wallpaper--get-default-file): New function. (wallpaper-set): Use above new function to set a default. * test/lisp/image/wallpaper-tests.el: New file. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 893161bd1a..e5f2df73f4 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -1,4 +1,4 @@ -;;; wallpaper.el --- Change desktop background from Emacs -*- lexical-binding: t; -*- +;;; wallpaper.el --- Change the desktop background -*- lexical-binding: t; -*- ;; Copyright (C) 2022 Free Software Foundation, Inc. @@ -277,6 +277,19 @@ See also `wallpaper-default-width'.") (funcall fun) (read-number (format "Wallpaper %s in pixels: " desc) default))) +(autoload 'ffap-file-at-point "ffap") + +;; FIXME: This only says which files are supported by Emacs, not by +;; the external tool we use to set the wallpaper. +(defvar wallpaper-default-file-name-regexp (image-file-name-regexp)) + +(defun wallpaper--get-default-file () + (catch 'found + (dolist (file (list buffer-file-name (ffap-file-at-point))) + (when (and file (string-match wallpaper-default-file-name-regexp file)) + (throw 'found (abbreviate-file-name + (expand-file-name file))))))) + (declare-function w32-set-wallpaper "w32fns.c") (declare-function haiku-set-wallpaper "term/haiku-win.el") @@ -291,11 +304,15 @@ options `wallpaper-command' and `wallpaper-command-args'. On MS-Windows and Haiku systems, no external command is needed, so the value of `wallpaper-commands' is ignored." - (interactive (list (read-file-name "Set desktop background to: " - default-directory nil t nil - (lambda (fn) - (or (file-directory-p fn) - (string-match (image-file-name-regexp) fn)))))) + (interactive + (let ((default (wallpaper--get-default-file))) + (list (read-file-name (format-prompt "Set desktop background to" default) + default-directory default + t nil + (lambda (file-name) + (or (file-directory-p file-name) + (string-match wallpaper-default-file-name-regexp + file-name))))))) (when (file-directory-p file) (error "Can't set wallpaper to a directory: %s" file)) (unless (file-exists-p file) @@ -331,8 +348,9 @@ so the value of `wallpaper-commands' is ignored." wallpaper-command-args))))) (unless wallpaper-command (error "Couldn't find a suitable command for setting the wallpaper")) - (wallpaper-debug "Using command %S %S" wallpaper-command - wallpaper-command-args) + (wallpaper-debug + "Using command %S %S" wallpaper-command + wallpaper-command-args) (setf (process-sentinel process) (lambda (process status) (unwind-protect diff --git a/test/lisp/image/wallpaper-tests.el b/test/lisp/image/wallpaper-tests.el new file mode 100644 index 0000000000..8cd0fe2215 --- /dev/null +++ b/test/lisp/image/wallpaper-tests.el @@ -0,0 +1,46 @@ +;;; wallpaper-tests.el --- tests for wallpaper.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'wallpaper) + +(ert-deftest wallpaper--get-default-file/empty-gives-nil () + (with-temp-buffer + (should-not (wallpaper--get-default-file)))) + +(ert-deftest wallpaper--get-default-file/visiting-file () + (ert-with-temp-file _ + :buffer buf + :suffix (format ".%s" (car image-file-name-extensions)) + (with-current-buffer buf + (should (wallpaper--get-default-file))))) + +(ert-deftest wallpaper--get-default-file/file-at-point () + ;; ffap needs the file to exist + (ert-with-temp-file fil + :buffer buf + :suffix (format ".%s" (car image-file-name-extensions)) + (with-current-buffer buf + (insert fil) + (should (stringp (wallpaper--get-default-file)))))) + +;;; wallpaper-tests.el ends here commit f761869a563866d55da437d06f267979e90cf3a0 Author: Stefan Kangas Date: Sun Sep 25 16:16:30 2022 +0200 Add :buffer argument to ert-with-temp-file * lisp/emacs-lisp/ert-x.el (ert-with-temp-file): Add new keyword argument :buffer SYMBOL to visit the file with `find-file-literally' before running the body, and cleaning up after. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index fe291290a2..f00f1b33d7 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -451,6 +451,10 @@ The following keyword arguments are supported: :text STRING If non-nil, pass STRING to `make-temp-file' as the TEXT argument. +:buffer SYMBOL Open the temporary file using `find-file-noselect' + and bind SYMBOL to the buffer. Kill the buffer + after BODY exits normally or non-locally. + :coding CODING If non-nil, bind `coding-system-for-write' to CODING when executing BODY. This is handy when STRING includes non-ASCII characters or the temporary file must have a @@ -459,14 +463,17 @@ The following keyword arguments are supported: See also `ert-with-temp-directory'." (declare (indent 1) (debug (symbolp body))) (cl-check-type name symbol) - (let (keyw prefix suffix directory text extra-keywords coding) + (let (keyw prefix suffix directory text extra-keywords buffer coding) (while (keywordp (setq keyw (car body))) (setq body (cdr body)) (pcase keyw (:prefix (setq prefix (pop body))) (:suffix (setq suffix (pop body))) + ;; This is only for internal use by `ert-with-temp-directory' + ;; and is therefore not documented. (:directory (setq directory (pop body))) (:text (setq text (pop body))) + (:buffer (setq buffer (pop body))) (:coding (setq coding (pop body))) (_ (push keyw extra-keywords) (pop body)))) (when extra-keywords @@ -481,9 +488,16 @@ See also `ert-with-temp-directory'." (make-temp-file ,prefix ,directory ,suffix ,text))) (,name ,(if directory `(file-name-as-directory ,temp-file) - temp-file))) + temp-file)) + ,@(when buffer + (list `(,buffer (find-file-literally ,temp-file))))) (unwind-protect (progn ,@body) + (ignore-errors + ,@(when buffer + (list `(with-current-buffer buf + (set-buffer-modified-p nil)) + `(kill-buffer ,buffer)))) (ignore-errors ,(if directory `(delete-directory ,temp-file :recursive) commit 568920a5b703e80c43e1b6f31778ea5776218a1e Author: Po Lu Date: Sun Sep 25 13:22:45 2022 +0000 Implement font-use-system-font on Haiku * doc/emacs/frames.texi (Fonts): Update documentation to say what font-use-system-font really does and where it can be used. * src/haiku_font_support.cc (language_code_points): Fix coding style. (font_style_to_flags, be_font_style_to_flags): Accept const char *. (be_send_font_settings, be_listen_font_settings) (be_lock_font_defaults, be_unlock_font_defaults) (be_get_font_default, be_get_font_size): New functions used to retrieve default font data. * src/haiku_io.c (haiku_len): Handle FONT_CHANGE_EVENT. * src/haiku_support.h (enum haiku_event_type): New event type FONT_CHANGE_EVENT. (enum haiku_what_font): New enum. (struct haiku_font_change_event): New struct. * src/haikufont.c (Ffont_get_system_normal_font) (Ffont_get_system_font, haiku_handle_font_change_event): New functions. (syms_of_haikufont): Provide `dynamic-setting' and define new variables and subrs. * src/haikuterm.c (haiku_default_font_parameter): Use system font. (haiku_read_socket): Handle FONT_CHANGE_EVENTS. (haiku_term_init): Start listening for font configuration changes. * src/haikuterm.h: Update prototypes. * src/xsettings.c (Ffont_get_system_normal_font) (Ffont_get_system_font): Update doc string. (syms_of_xsettings): Replace calls to intern with a static string. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 8a255fa40f..3ff47c6ffc 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -652,14 +652,15 @@ resources file to take effect. @xref{Resources}. Do not quote font names in X resource files. @item -If you are running Emacs on the GNOME desktop, you can tell Emacs to -use the default system font by setting the variable +If you are running Emacs on the GNOME desktop or Haiku, you can tell +Emacs to adjust the frame's default font along with changes to the +default system font by setting the variable @code{font-use-system-font} to @code{t} (the default is @code{nil}). For this to work, Emacs must have been compiled with support for Gsettings (or the older Gconf). (To be specific, the Gsettings -configuration names used are -@samp{org.gnome.desktop.interface monospace-font-name} and -@samp{org.gnome.desktop.interface font-name}.) +configuration names used are @samp{org.gnome.desktop.interface +monospace-font-name} and @samp{org.gnome.desktop.interface +font-name}.) @item Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index d824cc59ae..9a2492c9a1 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -21,6 +21,14 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include +#include +#include +#include +#include +#include +#include +#include #include #include @@ -39,15 +47,57 @@ struct font_object_cache_bucket static struct font_object_cache_bucket *font_object_cache[2048]; +/* The current global monospace family and style. */ +static char *fixed_family, *fixed_style; + +/* The current global variable-width family and style. */ +static char *default_family, *default_style; + +/* The sizes of each of those fonts. */ +static float default_size, fixed_size; + +/* The locker controlling access to those variables. */ +static BLocker default_locker; + /* Haiku doesn't expose font language data in BFont objects. Thus, we select a few representative characters for each supported `:lang' (currently Chinese, Korean and Japanese,) and test for those instead. */ static int language_code_points[MAX_LANGUAGE][3] = - {{20154, 20754, 22996}, /* Chinese. */ - {51312, 49440, 44544}, /* Korean. */ - {26085, 26412, 12371}, /* Japanese. */}; + { + {20154, 20754, 22996}, /* Chinese. */ + {51312, 49440, 44544}, /* Korean. */ + {26085, 26412, 12371}, /* Japanese. */ + }; + +static void be_send_font_settings (void); + +/* Looper used to track changes to system-wide font settings. */ +class EmacsFontMonitorLooper : public BLooper +{ + void + MessageReceived (BMessage *msg) + { + int32 opcode; + + if (msg->what != B_NODE_MONITOR) + return; + + if (msg->FindInt32 ("opcode", &opcode) != B_OK) + return; + + if (opcode != B_STAT_CHANGED) + return; + + /* Wait a little for any message to be completely written after + the file's modification time changes. */ + snooze (10000); + + /* Read and apply font settings. */ + be_send_font_settings (); + } +}; static unsigned int hash_string (const char *name_or_style) @@ -288,12 +338,15 @@ BFont_nchar_bounds (void *font, const char *mb_str, int *advance, } static void -font_style_to_flags (char *st, struct haiku_font_pattern *pattern) +font_style_to_flags (const char *style_string, + struct haiku_font_pattern *pattern) { - char *style = strdup (st); + char *style; char *token; int tok = 0; + style = strdup (style_string); + if (!style) return; @@ -385,7 +438,8 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) pattern->specified &= ~FSPEC_WEIGHT; pattern->specified &= ~FSPEC_WIDTH; pattern->specified |= FSPEC_STYLE; - std::strncpy ((char *) &pattern->style, st, + std::strncpy ((char *) &pattern->style, + style_string, sizeof pattern->style - 1); pattern->style[sizeof pattern->style - 1] = '\0'; } @@ -887,7 +941,7 @@ be_evict_font_cache (void) } void -be_font_style_to_flags (char *style, struct haiku_font_pattern *pattern) +be_font_style_to_flags (const char *style, struct haiku_font_pattern *pattern) { pattern->specified = 0; @@ -939,3 +993,217 @@ be_set_font_antialiasing (void *font, bool antialias_p) ? B_FORCE_ANTIALIASING : B_DISABLE_ANTIALIASING); } + +static void +be_send_font_settings (void) +{ + struct haiku_font_change_event rq; + BFile file; + BPath path; + status_t rc; + BMessage message; + font_family family; + font_style style; + const char *new_family, *new_style; + float new_size; + + rc = find_directory (B_USER_SETTINGS_DIRECTORY, &path); + + if (rc < B_OK) + return; + + rc = path.Append ("system/app_server/fonts"); + + if (rc < B_OK) + return; + + if (file.SetTo (path.Path (), B_READ_ONLY) != B_OK) + return; + + if (message.Unflatten (&file) != B_OK) + return; + + /* Now, populate with new values. */ + if (!default_locker.Lock ()) + gui_abort ("Failed to lock font data locker"); + + /* Obtain default values. */ + be_fixed_font->GetFamilyAndStyle (&family, &style); + default_size = be_fixed_font->Size (); + + /* And the new values. */ + new_family = message.GetString ("fixed family", family); + new_style = message.GetString ("fixed style", style); + new_size = message.GetFloat ("fixed size", default_size); + + /* If it turns out the fixed family changed, send the new family and + style. */ + + if (!fixed_family || !fixed_style + || new_size != fixed_size + || strcmp (new_family, fixed_family) + || strcmp (new_style, fixed_style)) + { + memset (&rq, 0, sizeof rq); + strncpy (rq.new_family, (char *) new_family, + sizeof rq.new_family - 1); + strncpy (rq.new_style, (char *) new_style, + sizeof rq.new_style - 1); + rq.new_size = new_size; + rq.what = FIXED_FAMILY; + + haiku_write (FONT_CHANGE_EVENT, &rq); + } + + if (fixed_family) + free (fixed_family); + + if (fixed_style) + free (fixed_style); + + fixed_family = strdup (new_family); + fixed_style = strdup (new_style); + fixed_size = new_size; + + /* Obtain default values. */ + be_plain_font->GetFamilyAndStyle (&family, &style); + default_size = be_plain_font->Size (); + + /* And the new values. */ + new_family = message.GetString ("plain family", family); + new_style = message.GetString ("plain style", style); + new_size = message.GetFloat ("plain style", default_size); + + if (!default_family || !default_style + || new_size != default_size + || strcmp (new_family, default_family) + || strcmp (new_style, default_style)) + { + memset (&rq, 0, sizeof rq); + strncpy (rq.new_family, (char *) new_family, + sizeof rq.new_family - 1); + strncpy (rq.new_style, (char *) new_style, + sizeof rq.new_style - 1); + rq.new_size = new_size; + rq.what = DEFAULT_FAMILY; + + haiku_write (FONT_CHANGE_EVENT, &rq); + } + + if (default_family) + free (default_family); + + if (default_style) + free (default_style); + + default_family = strdup (new_family); + default_style = strdup (new_style); + default_size = new_size; + + default_locker.Unlock (); +} + +/* Begin listening to font settings changes, by installing a node + watcher. This relies on the settings file already being present + and has several inherent race conditions, but users shouldn't be + changing font settings very quickly. */ + +void +be_listen_font_settings (void) +{ + BPath path; + status_t rc; + BNode node; + node_ref node_ref; + EmacsFontMonitorLooper *looper; + font_family family; + font_style style; + + /* Set up initial values. */ + be_fixed_font->GetFamilyAndStyle (&family, &style); + fixed_family = strdup (family); + fixed_style = strdup (style); + fixed_size = be_fixed_font->Size (); + + be_plain_font->GetFamilyAndStyle (&family, &style); + default_family = strdup (family); + default_style = strdup (style); + default_size = be_plain_font->Size (); + + rc = find_directory (B_USER_SETTINGS_DIRECTORY, &path); + + if (rc < B_OK) + return; + + rc = path.Append ("system/app_server/fonts"); + + if (rc < B_OK) + return; + + rc = node.SetTo (path.Path ()); + + if (rc < B_OK) + return; + + if (node.GetNodeRef (&node_ref) < B_OK) + return; + + looper = new EmacsFontMonitorLooper; + + if (watch_node (&node_ref, B_WATCH_STAT, looper) < B_OK) + { + delete looper; + return; + } + + looper->Run (); +} + +bool +be_lock_font_defaults (void) +{ + return default_locker.Lock (); +} + +void +be_unlock_font_defaults (void) +{ + return default_locker.Unlock (); +} + +const char * +be_get_font_default (enum haiku_what_font what) +{ + switch (what) + { + case FIXED_FAMILY: + return fixed_family; + + case FIXED_STYLE: + return fixed_style; + + case DEFAULT_FAMILY: + return default_family; + + case DEFAULT_STYLE: + return default_style; + } + + return NULL; +} + +int +be_get_font_size (enum haiku_what_font what) +{ + switch (what) + { + case FIXED_FAMILY: + return fixed_size; + + case DEFAULT_FAMILY: + return default_size; + + default: + return 0; + } +} diff --git a/src/haiku_io.c b/src/haiku_io.c index 5cc70f6f71..6ef6f2ebd0 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -109,6 +109,8 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_screen_changed_event); case CLIPBOARD_CHANGED_EVENT: return sizeof (struct haiku_clipboard_changed_event); + case FONT_CHANGE_EVENT: + return sizeof (struct haiku_font_change_event); } emacs_abort (); diff --git a/src/haiku_support.h b/src/haiku_support.h index d66dbc5fa6..e940e69bf1 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -115,6 +115,7 @@ enum haiku_event_type SCREEN_CHANGED_EVENT, MENU_BAR_LEFT, CLIPBOARD_CHANGED_EVENT, + FONT_CHANGE_EVENT, }; struct haiku_clipboard_changed_event @@ -442,6 +443,27 @@ struct haiku_menu_bar_state_event void *window; }; +enum haiku_what_font + { + FIXED_FAMILY, + FIXED_STYLE, + DEFAULT_FAMILY, + DEFAULT_STYLE, + }; + +struct haiku_font_change_event +{ + /* New family, style and size of the font. */ + haiku_font_family_or_style new_family; + haiku_font_family_or_style new_style; + int new_size; + + /* What changed. FIXED_FAMILY means this is the new fixed font. + DEFAULT_FAMILY means this is the new plain font. The other enums + have no meaning. */ + enum haiku_what_font what; +}; + struct haiku_session_manager_reply { bool quit_reply; @@ -697,7 +719,7 @@ extern int be_get_display_screens (void); extern bool be_use_subpixel_antialiasing (void); extern const char *be_find_setting (const char *); extern haiku_font_family_or_style *be_list_font_families (size_t *); -extern void be_font_style_to_flags (char *, struct haiku_font_pattern *); +extern void be_font_style_to_flags (const char *, struct haiku_font_pattern *); extern void *be_open_font_at_index (int, int, float); extern void be_set_font_antialiasing (void *, bool); extern int be_get_ui_color (const char *, uint32_t *); @@ -732,6 +754,13 @@ extern void be_unlock_window (void *); extern bool be_get_explicit_workarea (int *, int *, int *, int *); extern void be_clear_grab_view (void); extern void be_set_use_frame_synchronization (void *, bool); + +extern void be_listen_font_settings (void); + +extern bool be_lock_font_defaults (void); +extern const char *be_get_font_default (enum haiku_what_font); +extern int be_get_font_size (enum haiku_what_font); +extern void be_unlock_font_defaults (void); #ifdef __cplusplus } diff --git a/src/haikufont.c b/src/haikufont.c index 4af9ff9d77..335c312ceb 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -1311,6 +1311,98 @@ in the font selection dialog. */) QCsize, lsize); } +DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font, + Sfont_get_system_normal_font, 0, 0, 0, + doc: /* SKIP: real doc in xsettings.c. */) + (void) +{ + Lisp_Object value; + const char *name, *style; + struct haiku_font_pattern pattern; + Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle; + int size; + + if (!be_lock_font_defaults ()) + return Qnil; + + name = be_get_font_default (DEFAULT_FAMILY); + style = be_get_font_default (DEFAULT_STYLE); + size = be_get_font_size (DEFAULT_FAMILY); + + be_font_style_to_flags (style, &pattern); + + lfamily = build_string_from_utf8 (name); + lweight = (pattern.specified & FSPEC_WEIGHT + ? haikufont_weight_to_lisp (pattern.weight) : Qnil); + lslant = (pattern.specified & FSPEC_SLANT + ? haikufont_slant_to_lisp (pattern.slant) : Qnil); + lwidth = (pattern.specified & FSPEC_WIDTH + ? haikufont_width_to_lisp (pattern.width) : Qnil); + ladstyle = (pattern.specified & FSPEC_STYLE + ? intern (pattern.style) : Qnil); + + value = CALLN (Ffont_spec, QCfamily, lfamily, + QCweight, lweight, QCslant, lslant, + QCwidth, lwidth, QCadstyle, ladstyle, + QCsize, make_fixnum (size)); + be_unlock_font_defaults (); + + return value; +} + +DEFUN ("font-get-system-font", Ffont_get_system_font, + Sfont_get_system_font, 0, 0, 0, + doc: /* SKIP: real doc in xsettings.c. */) + (void) +{ + Lisp_Object value; + const char *name, *style; + struct haiku_font_pattern pattern; + Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle; + int size; + + if (!be_lock_font_defaults ()) + return Qnil; + + name = be_get_font_default (FIXED_FAMILY); + style = be_get_font_default (FIXED_STYLE); + size = be_get_font_size (FIXED_FAMILY); + + be_font_style_to_flags (style, &pattern); + + lfamily = build_string_from_utf8 (name); + lweight = (pattern.specified & FSPEC_WEIGHT + ? haikufont_weight_to_lisp (pattern.weight) : Qnil); + lslant = (pattern.specified & FSPEC_SLANT + ? haikufont_slant_to_lisp (pattern.slant) : Qnil); + lwidth = (pattern.specified & FSPEC_WIDTH + ? haikufont_width_to_lisp (pattern.width) : Qnil); + ladstyle = (pattern.specified & FSPEC_STYLE + ? intern (pattern.style) : Qnil); + + value = CALLN (Ffont_spec, QCfamily, lfamily, + QCweight, lweight, QCslant, lslant, + QCwidth, lwidth, QCadstyle, ladstyle, + QCsize, make_fixnum (size)); + be_unlock_font_defaults (); + + return value; +} + +void +haiku_handle_font_change_event (struct haiku_font_change_event *event, + struct input_event *ie) +{ + ie->kind = CONFIG_CHANGED_EVENT; + + /* This is the name of the display. */ + ie->frame_or_window = XCAR (x_display_list->name_list_element); + + /* And this is the font that changed. */ + ie->arg = (event->what == FIXED_FAMILY + ? Qmonospace_font_name : Qfont_name); +} + static void syms_of_haikufont_for_pdumper (void) { @@ -1344,6 +1436,14 @@ syms_of_haikufont (void) DEFSYM (QCindices, ":indices"); + DEFSYM (Qmonospace_font_name, "monospace-font-name"); + DEFSYM (Qfont_name, "font-name"); + DEFSYM (Qdynamic_setting, "dynamic-setting"); + + DEFVAR_BOOL ("font-use-system-font", use_system_font, + doc: /* SKIP: real doc in xsettings.c. */); + use_system_font = false; + #ifdef USE_BE_CAIRO Fput (Qhaiku, Qfont_driver_superseded_by, Qftcr); #endif @@ -1353,6 +1453,12 @@ syms_of_haikufont (void) staticpro (&font_cache); defsubr (&Sx_select_font); + defsubr (&Sfont_get_system_normal_font); + defsubr (&Sfont_get_system_font); be_init_font_data (); + + /* This tells loadup to load dynamic-setting.el, which handles + config-changed events. */ + Fprovide (Qdynamic_setting, Qnil); } diff --git a/src/haikuterm.c b/src/haikuterm.c index b0832059ba..838eb128fa 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2988,18 +2988,11 @@ haiku_default_font_parameter (struct frame *f, Lisp_Object parms) font_param = Qnil; if (NILP (font_param)) - { - /* System font should take precedence over X resources. We suggest this - regardless of font-use-system-font because .emacs may not have been - read yet. */ - struct haiku_font_pattern ptn; - ptn.specified = 0; - - BFont_populate_fixed_family (&ptn); - - if (ptn.specified & FSPEC_FAMILY) - font = font_open_by_name (f, build_unibyte_string (ptn.family)); - } + /* System font should take precedence over X resources. We + suggest this regardless of font-use-system-font because .emacs + may not have been read yet. Returning a font-spec is Haiku + specific behavior. */ + font = font_open_by_spec (f, Ffont_get_system_font ()); if (NILP (font)) font = !NILP (font_param) ? font_param @@ -4027,6 +4020,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) inev.kind = SAVE_SESSION_EVENT; inev.arg = Qt; break; + case FONT_CHANGE_EVENT: + /* This generates CONFIG_CHANGED_EVENTs, which are then + handled in Lisp. */ + haiku_handle_font_change_event (buf, &inev); + break; case KEY_UP: case DUMMY_EVENT: default: @@ -4417,6 +4415,9 @@ haiku_term_init (void) dpyinfo->default_name = build_string ("GNU Emacs"); haiku_start_watching_selections (); + + /* Start listening for font configuration changes. */ + be_listen_font_settings (); unblock_input (); return dpyinfo; diff --git a/src/haikuterm.h b/src/haikuterm.h index b603c0a482..86274fd42a 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -34,6 +34,9 @@ along with GNU Emacs. If not, see . */ #define HAVE_CHAR_CACHE_MAX 65535 +/* This is really defined in haiku_support.h. */ +struct haiku_font_change_event; + extern int popup_activated_p; struct haikufont_info @@ -361,4 +364,7 @@ extern void haiku_merge_cursor_foreground (struct glyph_string *, unsigned long unsigned long *); extern void haiku_handle_selection_clear (struct input_event *); extern void haiku_start_watching_selections (void); +extern void haiku_handle_font_change_event (struct haiku_font_change_event *, + struct input_event *); + #endif /* _HAIKU_TERM_H_ */ diff --git a/src/xsettings.c b/src/xsettings.c index 9c60ff825a..e4a9865d68 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -1225,7 +1225,8 @@ xsettings_get_font_options (void) DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font, Sfont_get_system_normal_font, 0, 0, 0, - doc: /* Get the system default application font. */) + doc: /* Get the system default application font. +The font is returned as either a font-spec or font name. */) (void) { return current_font ? build_string (current_font) : Qnil; @@ -1233,7 +1234,8 @@ DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font, DEFUN ("font-get-system-font", Ffont_get_system_font, Sfont_get_system_font, 0, 0, 0, - doc: /* Get the system default fixed width font. */) + doc: /* Get the system default fixed width font. +The font is returned as either a font-spec or font name. */) (void) { return current_mono_font ? build_string (current_mono_font) : Qnil; @@ -1282,6 +1284,10 @@ syms_of_xsettings (void) DEFSYM (Qmonospace_font_name, "monospace-font-name"); DEFSYM (Qfont_name, "font-name"); DEFSYM (Qfont_render, "font-render"); + DEFSYM (Qdynamic_setting, "dynamic-setting"); + DEFSYM (Qfont_render_setting, "font-render-setting"); + DEFSYM (Qsystem_font_setting, "system-font-setting"); + defsubr (&Sfont_get_system_font); defsubr (&Sfont_get_system_normal_font); @@ -1297,9 +1303,9 @@ If this variable is nil, Emacs ignores system font changes. */); Vxft_settings = empty_unibyte_string; #if defined USE_CAIRO || defined HAVE_XFT - Fprovide (intern_c_string ("font-render-setting"), Qnil); + Fprovide (Qfont_render_setting, Qnil); #if defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) - Fprovide (intern_c_string ("system-font-setting"), Qnil); + Fprovide (Qsystem_font_setting, Qnil); #endif #endif @@ -1307,5 +1313,5 @@ If this variable is nil, Emacs ignores system font changes. */); DEFSYM (Qtool_bar_style, "tool-bar-style"); defsubr (&Stool_bar_get_system_style); - Fprovide (intern_c_string ("dynamic-setting"), Qnil); + Fprovide (Qdynamic_setting, Qnil); } commit 3502fd98310ad0870965511f600a92cd888a6de0 Author: Stefan Kangas Date: Sun Sep 25 14:57:28 2022 +0200 wallpaper: URI-encode gsettings argument * lisp/image/wallpaper.el (wallpaper--default-commands) (wallpaper-command-args, wallpaper-set): URI-encode gsettings argument. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index aea13227a8..893161bd1a 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -56,7 +56,7 @@ ;; When updating this, also update the custom :type for `wallpaper-command'. '( ;; Gnome - ("gsettings" "set" "org.gnome.desktop.background" "picture-uri" "file://%f") + ("gsettings" "set" "org.gnome.desktop.background" "picture-uri" "file://%F") ;; KDE Plasma ("plasma-apply-wallpaperimage" "%f") ;; XFCE @@ -69,9 +69,9 @@ ;; ;; Mate ;; ("gsettings" "set" "org.mate.background" "picture-filename" "%f") ;; ;; Cinnamon - ;; ("gsettings" "set" "org.cinnamon.desktop.background" "picture-uri" "file://%f") + ;; ("gsettings" "set" "org.cinnamon.desktop.background" "picture-uri" "file://%F") ;; ;; Deepin - ;; ("gsettings" "set" "com.deepin.wrap.gnome.desktop.background" "picture-uri" "file://%f") + ;; ("gsettings" "set" "com.deepin.wrap.gnome.desktop.background" "picture-uri" "file://%F") ;; Sway (Wayland) ("swaybg" "-o" "*" "-i" "%f" "-m" "fill") ;; Wayland General @@ -232,10 +232,11 @@ However, if you do need to change this, you might also want to customize `wallpaper-command' to match. In each of the command line arguments, \"%f\" will be replaced -with the full file name, \"%h\" with the height of the selected -frame's display (as returned by `display-pixel-height'), and -\"%w\" with the width of the selected frame's display (as -returned by `display-pixel-width'). +with the full file name, \"%F\" with the full file name +URI-encoded, \"%h\" with the height of the selected frame's +display (as returned by `display-pixel-height'), and \"%w\" with +the width of the selected frame's display (as returned by +`display-pixel-width'). If `wallpaper-set' is run from a TTY frame, it will prompt for a height and width for \"%h\" and \"%w\" instead. @@ -310,6 +311,9 @@ so the value of `wallpaper-commands' is ignored." (unless wallpaper-command (error "Couldn't find a command to set the wallpaper with")) (let* ((fmt-spec `((?f . ,(expand-file-name file)) + (?F . ,(mapconcat #'url-hexify-string + (file-name-split file) + "/")) (?h . ,(wallpaper--get-height-or-width "height" #'display-pixel-height commit 489bca19b7a55ba00dbc1d917cd8832268cebcee Author: Stefan Kangas Date: Sun Sep 25 14:26:40 2022 +0200 Improve shortdoc documentation * doc/emacs/help.texi (Name Help): * doc/lispref/help.texi (Documentation Groups): Refer to 'shortdoc' convenience alias instead of 'shortdoc-display-group'. * lisp/emacs-lisp/shortdoc.el: Add Commentary. (shortdoc-next, shortdoc-previous) (shortdoc-next-section, shortdoc-previous-section): Doc fixes. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 84b082825c..6d9c028b74 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -311,12 +311,11 @@ doc string to display. In that case, if to load the file in which the function is defined to see whether there's a doc string there. -@findex shortdoc-display-group +@findex shortdoc You can get an overview of functions relevant for a particular topic -by using the @kbd{M-x shortdoc-display-group} command. This will -prompt you for an area of interest, e.g., @code{string}, and pop you -to a buffer where many of the functions relevant for handling strings -are listed. +by using the @kbd{M-x shortdoc} command. This will prompt you for an +area of interest, e.g., @code{string}, and pop you to a buffer where +many of the functions relevant for handling strings are listed. @kindex C-h v @findex describe-variable diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 154a7abeb6..65ad5f0554 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -827,7 +827,7 @@ if the user types the help character again. Emacs can list functions based on various groupings. For instance, @code{string-trim} and @code{mapconcat} are ``string'' functions, so -@kbd{M-x shortdoc-display-group RET string RET} will give an overview +@kbd{M-x shortdoc RET string RET} will give an overview of functions that operate on strings. The documentation groups are created with the diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index b5c99cf2c9..6d61ed4ac1 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -22,6 +22,15 @@ ;;; Commentary: +;; This package lists functions based on various groupings. +;; +;; For instance, `string-trim' and `mapconcat' are `string' functions, +;; so `M-x shortdoc RET string RET' will give an overview of functions +;; that operate on strings. +;; +;; The documentation groups are created with the +;; `define-short-documentation-group' macro. + ;;; Code: (require 'seq) @@ -1533,27 +1542,27 @@ Example: (setq arg (1- arg)))) (defun shortdoc-next (&optional arg) - "Move cursor to the next function. -With ARG, do it that many times." + "Move point to the next function. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function)) (defun shortdoc-previous (&optional arg) - "Move cursor to the previous function. -With ARG, do it that many times." + "Move point to the previous function. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function t) (backward-char 1)) (defun shortdoc-next-section (&optional arg) - "Move cursor to the next section. -With ARG, do it that many times." + "Move point to the next section. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section)) (defun shortdoc-previous-section (&optional arg) - "Move cursor to the previous section. -With ARG, do it that many times." + "Move point to the previous section. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section t) (forward-line -2)) commit a256f49f0828a2069acc302dd11d78be2486b565 Author: Stefan Kangas Date: Sun Sep 25 14:22:06 2022 +0200 Make image-dired-thumb-name more portable * lisp/image/image-dired-util.el (image-dired-thumb-name): Create file names in a portable manner. * test/lisp/image/image-dired-util-tests.el (image-dired-thumb-name/standard) (image-dired-thumb-name/image-dired) (image-dired-thumb-name/per-directory): Expand tests. diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el index f8e81d2e8d..e7d116d90b 100644 --- a/lisp/image/image-dired-util.el +++ b/lisp/image/image-dired-util.el @@ -85,19 +85,22 @@ See also `image-dired-thumbnail-storage'." ;; Maintained for backwards compatibility: (eq 'use-image-dired-dir image-dired-thumbnail-storage)) (let* ((f (expand-file-name file)) - (hash - (md5 (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 hash (concat "_" hash) "") - (file-name-extension f)))) + (hash (md5 (file-name-as-directory (file-name-directory f))))) + (expand-file-name + (format "%s%s.thumb.%s" + (file-name-base f) + (if hash (concat "_" hash) "") + (file-name-extension f)) + (image-dired-dir)))) ((eq 'per-directory image-dired-thumbnail-storage) (let ((f (expand-file-name file))) - (format "%s.image-dired/%s.thumb.%s" - (file-name-directory f) - (file-name-base f) - (file-name-extension f)))))) + (expand-file-name + (format "%s.thumb.%s" + (file-name-base f) + (file-name-extension f)) + (expand-file-name + ".image-dired" + (file-name-directory f))))))) (defvar image-dired-thumbnail-buffer "*image-dired*" "Image-Dired's thumbnail buffer.") diff --git a/test/lisp/image/image-dired-util-tests.el b/test/lisp/image/image-dired-util-tests.el index 39862fc6fa..9fb457dd36 100644 --- a/test/lisp/image/image-dired-util-tests.el +++ b/test/lisp/image/image-dired-util-tests.el @@ -28,6 +28,10 @@ (ert-deftest image-dired-thumb-name/standard () (let ((image-dired-thumbnail-storage 'standard)) (should (file-name-absolute-p (image-dired-thumb-name "foo.jpg"))) + (should (file-name-absolute-p (image-dired-thumb-name "/tmp/foo.jpg"))) + (should (equal + (file-name-directory (image-dired-thumb-name "foo.jpg")) + (file-name-directory (image-dired-thumb-name "/tmp/foo.jpg")))) (should (string-search (xdg-cache-home) (image-dired-thumb-name "foo.jpg"))) (should (string-match (rx (in "0-9a-f") ".png") @@ -39,6 +43,10 @@ (let ((image-dired-dir dir) (image-dired-thumbnail-storage 'image-dired)) (should (file-name-absolute-p (image-dired-thumb-name "foo.jpg"))) + (should (file-name-absolute-p (image-dired-thumb-name "/tmp/foo.jpg"))) + (should (equal + (file-name-directory (image-dired-thumb-name "foo.jpg")) + (file-name-directory (image-dired-thumb-name "/tmp/foo.jpg")))) (should (equal (file-name-nondirectory ;; The checksum is based on the directory name. (image-dired-thumb-name "/some/path/foo.jpg")) @@ -47,6 +55,12 @@ (ert-deftest image-dired-thumb-name/per-directory () (let ((image-dired-thumbnail-storage 'per-directory)) (should (file-name-absolute-p (image-dired-thumb-name "foo.jpg"))) + (should (file-name-absolute-p (image-dired-thumb-name "/tmp/foo.jpg"))) + (should (equal + (file-name-nondirectory (image-dired-thumb-name "foo.jpg")) + (file-name-nondirectory (image-dired-thumb-name "/tmp/foo.jpg")))) + (should (equal (file-name-split (image-dired-thumb-name "/tmp/foo.jpg")) + '("" "tmp" ".image-dired" "foo.thumb.jpg"))) (should (equal (file-name-nondirectory (image-dired-thumb-name "foo.jpg")) "foo.thumb.jpg")))) commit 971566e88a9fdb414b3c821cb55a7fc0e903eeba Author: Stefan Kangas Date: Sun Sep 25 13:54:37 2022 +0200 Fix shortdoc movement commands * lisp/emacs-lisp/shortdoc.el (shortdoc--goto-section): Don't skip over current function or section when searching. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 33106808d2..b5c99cf2c9 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1529,7 +1529,7 @@ Example: (funcall (if reverse 'text-property-search-backward 'text-property-search-forward) - sym nil t t) + sym nil t) (setq arg (1- arg)))) (defun shortdoc-next (&optional arg) commit e5896907813a9540d0a6b3e60f682afd273fc8e9 Author: Stefan Kangas Date: Sun Sep 25 13:48:12 2022 +0200 Add new command 'shortdoc-copy-function-as-kill' * lisp/emacs-lisp/shortdoc.el (shortdoc-copy-function-as-kill): New command. (shortdoc-mode-map): Bind above new command to "w". diff --git a/etc/NEWS b/etc/NEWS index 139e65a4f1..0a5b7bc29c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1714,6 +1714,10 @@ info node. This command only works for the Emacs and Emacs Lisp manuals. ** Shortdoc +--- +*** New command 'shortdoc-copy-function-as-kill' bound to 'w'. +It copies the name of the function near point into the kill ring. + --- *** 'N' and 'P' are now bound to 'shortdoc-(next|previous)-section'. This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 13d99adcf0..33106808d2 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1515,7 +1515,8 @@ Example: "N" #'shortdoc-next-section "P" #'shortdoc-previous-section "C-c C-n" #'shortdoc-next-section - "C-c C-p" #'shortdoc-previous-section) + "C-c C-p" #'shortdoc-previous-section + "w" #'shortdoc-copy-function-as-kill) (define-derived-mode shortdoc-mode special-mode "shortdoc" "Mode for shortdoc." @@ -1557,6 +1558,20 @@ With ARG, do it that many times." (shortdoc--goto-section arg 'shortdoc-section t) (forward-line -2)) +(defun shortdoc-copy-function-as-kill () + "Copy name of the function near point into the kill ring." + (interactive) + (save-excursion + (goto-char (pos-bol)) + (when-let* ((re (rx bol "(" (group (+ (not (in " ")))))) + (string + (and (or (looking-at re) + (re-search-backward re nil t)) + (match-string 1)))) + (set-text-properties 0 (length string) nil string) + (kill-new string) + (message string)))) + (provide 'shortdoc) ;;; shortdoc.el ends here commit 46ec36adfd3925816f3baa87c5b457ade2677c43 Author: Stefan Kangas Date: Sun Sep 25 13:42:57 2022 +0200 * etc/NEWS.22: Belatedly announce 'dired-copy-filename-as-kill'. diff --git a/etc/NEWS.22 b/etc/NEWS.22 index 926b9f489e..d7b26dda51 100644 --- a/etc/NEWS.22 +++ b/etc/NEWS.22 @@ -1413,7 +1413,8 @@ with different file attributes in two dired buffers. *** New Dired command 'dired-do-touch' (bound to T) changes timestamps of marked files with the value entered in the minibuffer. -*** In Dired, the w command now stores the current line's file name +*** New Dired command 'dired-copy-filename-as-kill' copies file name. +In Dired, the w command now stores the current line's file name into the kill ring. With a zero prefix arg, it stores the absolute file name. *** In Dired-x, Omitting files is now a minor mode, dired-omit-mode. commit 3af2f9cce312a2e9fff1bfc5f7689c5b9db369bd Author: Stefan Kangas Date: Sun Sep 25 13:22:17 2022 +0200 Bind "N"/"P" to next/prev section in shortdoc * lisp/emacs-lisp/shortdoc.el (shortdoc-mode-map): Bind "N" and "P" to 'shortdoc-next-section' and 'shortdoc-previous-section'. diff --git a/etc/NEWS b/etc/NEWS index 835fcf8bca..139e65a4f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1712,6 +1712,12 @@ This fills the region to be no wider than a specified pixel width. This will take you to the gnu.org web server's version of the current info node. This command only works for the Emacs and Emacs Lisp manuals. +** Shortdoc + +--- +*** 'N' and 'P' are now bound to 'shortdoc-(next|previous)-section'. +This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'. + ** VC --- diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index d07d1019b4..13d99adcf0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1512,6 +1512,8 @@ Example: :doc "Keymap for `shortdoc-mode'." "n" #'shortdoc-next "p" #'shortdoc-previous + "N" #'shortdoc-next-section + "P" #'shortdoc-previous-section "C-c C-n" #'shortdoc-next-section "C-c C-p" #'shortdoc-previous-section) commit d25a26ab40def7c3c4545537fa09ab67cf0521af Author: Stefan Kangas Date: Sun Sep 25 12:49:23 2022 +0200 * lisp/bookmark.el (bookmark-rename): Improve prompt. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index a4d4237151..b57ad12986 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1458,7 +1458,7 @@ name." (let ((final-new-name (or new-name ; use second arg, if non-nil (read-from-minibuffer - "New name: " + (format-prompt "Rename \"%s\" to" nil old-name) nil (define-keymap :parent minibuffer-local-map commit 97d7f8c73720d24dd154d2de2b4a0d13bc9d4e6a Author: Stefan Kangas Date: Sun Sep 25 00:37:40 2022 +0200 Add new command image-dired-copy-filename-as-kill * lisp/image/image-dired.el (image-dired-copy-filename-as-kill): New command. (image-dired-thumbnail-mode-map): Bind above new command to "w". diff --git a/etc/NEWS b/etc/NEWS index 3d1af8bd6f..835fcf8bca 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2098,6 +2098,11 @@ It removes all marks from all files in the thumbnail and the associated Dired buffer, and is bound to 'U' in the thumbnail and display buffer. +--- +*** New command 'image-dired-copy-filename-as-kill'. +It copies the name of the marked or current image to the kill ring, +and is bound to "w" in the thumbnail buffer. + --- *** New command 'image-dired-wallpaper-set'. This command sets the desktop background to the image at point in the diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index b8b16343c1..d933ccf79c 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -924,6 +924,7 @@ You probably want to use this together with "SPC" #'image-dired-display-next-thumbnail-original "DEL" #'image-dired-display-previous-thumbnail-original "c" #'image-dired-comment-thumbnail + "w" #'image-dired-copy-filename-as-kill "W" #'image-dired-wallpaper-set ;; Mouse @@ -1278,6 +1279,13 @@ overwritten. This confirmation can be turned off using (image-dired-update-property 'comment comment)) (image-dired--update-header-line)) +(defun image-dired-copy-filename-as-kill (&optional arg) + "Copy names of marked (or next ARG) files into the kill ring. +This works as `dired-copy-filename-as-kill' (which see)." + (interactive "P" image-dired-thumbnail-mode) + (image-dired--with-dired-buffer + (dired-copy-filename-as-kill arg))) + ;;; Mouse support commit b2283409fbe4324ee2fb50b385a9b6cc3458693c Author: Philip Kaludercic Date: Sun Sep 25 10:29:40 2022 +0200 * lisp/net/rcirc.el (rcirc-print): Remove 'fill-region' call See Bug#57376. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 418fde62b9..fa481ce528 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2075,9 +2075,6 @@ connection." 'rcirc-msgid (rcirc-get-tag "msgid")) (propertize "\n" 'hard t)) - ;; squeeze spaces out of text before rcirc-text - (fill-region (point-min) (point-max)) - (goto-char (or (next-single-property-change (point-min) 'rcirc-text) (point))) (when (rcirc-buffer-process) commit f6fa524c5331db81f43be5e1fef4b6b860e687ae Author: Philip Kaludercic Date: Sun Sep 25 10:22:25 2022 +0200 Add formatting commands to rcirc * etc/NEWS: Mention new command * lisp/net/rcirc.el (rcirc-format): Add new utility function. (rcirc-unformat): Add new command. (rcirc-format-bold): Add new command. (rcirc-format-italic): Add new command. (rcirc-format-underline): Add new command. (rcirc-format-strike-trough): Add new command. (rcirc-format-fixed-width): Add new command. (rcirc-mode-map): Bind formatting commands. (rcirc-multiline-minor-mode-map): Bind formatting commands. diff --git a/etc/NEWS b/etc/NEWS index 74e29a0ea5..3d1af8bd6f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1089,6 +1089,15 @@ to be reformatted into 09:47 I am not on IRC +--- +*** New formatting commands. +Most IRC clients (including rcirc) support basic formatting using +control codes. Under the 'C-c C-f' prefix a few commands have been +added to insert these automatically. For example, if a region is +active and 'C-c C-f C-b' is invoked, markup is inserted for the region +to be highlighted bold. + + ** Imenu +++ diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index eb3b48da6e..418fde62b9 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1340,12 +1340,91 @@ The list is updated automatically by `defun-rcirc-command'.") 'set-rcirc-encode-coding-system "28.1") +(defun rcirc-format (pre &optional replace) + "Insert markup formatting PRE. +PRE and \"^O\" (ASCII #x0f) will either be inserted around the +current point respectively or the active region, if present. +This function an auxiliary function is not meant to be used +directly, but is invoked by other commands. If the optional +argument REPLACE is non-nil, first remove any formatting before +inserting the new one." + (when replace (rcirc-unformat)) + (save-excursion + (if (use-region-p) + (let ((beg (region-beginning))) + (goto-char (region-end)) + (insert "") + (goto-char beg) + (insert pre)) + (insert pre ""))) + (when (or (not (region-active-p)) (< (point) (mark))) + (forward-char (length pre)))) + +(defun rcirc-unformat () + "Remove the closes formatting found closes to the current point." + (interactive) + (save-excursion + (when (and (search-backward-regexp (rx (or "" "" "" "" "")) + rcirc-prompt-end-marker t) + (looking-at (rx (group (or "" "" "" "" "")) + (*? nonl) + (group "")))) + (replace-match "" nil nil nil 2) + (replace-match "" nil nil nil 1)))) + +(defun rcirc-format-bold (replace) + "Insert bold formatting. +If REPLACE is non-nil or a prefix argument is given, any prior +formatting will be replaced before the bold formatting is +inserted." + (interactive "P") + (rcirc-format "" replace)) + +(defun rcirc-format-italic (replace) + "Insert italic formatting. +If REPLACE is non-nil or a prefix argument is given, any prior +formatting will be replaced before the italic formatting is +inserted." + (interactive "P") + (rcirc-format "" replace)) + +(defun rcirc-format-underline (replace) + "Insert underlining formatting. +If REPLACE is non-nil or a prefix argument is given, any prior +formatting will be replaced before the underline formatting is +inserted." + (interactive "P") + (rcirc-format "" replace)) + +(defun rcirc-format-strike-trough (replace) + "Insert strike-trough formatting. +If REPLACE is non-nil or a prefix argument is given, any prior +formatting will be replaced before the strike-trough formatting +is inserted." + (interactive "P") + (rcirc-format "" replace)) + +(defun rcirc-format-fixed-width (replace) + "Insert fixed-width formatting. +If REPLACE is non-nil or a prefix argument is given, any prior +formatting will be replaced before the fixed width formatting is +inserted." + (interactive "P") + (rcirc-format "" replace)) + (defvar-keymap rcirc-mode-map :doc "Keymap for rcirc mode." "RET" #'rcirc-send-input "M-p" #'rcirc-insert-prev-input "M-n" #'rcirc-insert-next-input "TAB" #'completion-at-point + "C-c C-f C-b" #'rcirc-format-bold + "C-c C-f C-i" #'rcirc-format-italic + "C-c C-f C-u" #'rcirc-format-underline + "C-c C-f C-s" #'rcirc-format-strike-trough + "C-c C-f C-f" #'rcirc-format-fixed-width + "C-c C-f C-t" #'rcirc-format-fixed-width ;as in AucTeX + "C-c C-f C-d" #'rcirc-unformat "C-c C-b" #'rcirc-browse-url "C-c C-c" #'rcirc-edit-multiline "C-c C-j" #'rcirc-cmd-join @@ -1725,6 +1804,13 @@ extracted." (defvar-keymap rcirc-multiline-minor-mode-map :doc "Keymap for multiline mode in rcirc." + "C-c C-f C-b" #'rcirc-format-bold + "C-c C-f C-i" #'rcirc-format-italic + "C-c C-f C-u" #'rcirc-format-underline + "C-c C-f C-s" #'rcirc-format-strike-trough + "C-c C-f C-f" #'rcirc-format-fixed-width + "C-c C-f C-t" #'rcirc-format-fixed-width ;as in AucTeX + "C-c C-f C-d" #'rcirc-unformat "C-c C-c" #'rcirc-multiline-minor-submit "C-x C-s" #'rcirc-multiline-minor-submit "C-c C-k" #'rcirc-multiline-minor-cancel commit d98ee767765032acc7f8f14c86dcbbfb67dbcaee Author: Lars Ingebrigtsen Date: Sat Sep 24 22:43:26 2022 +0200 Tweak window handling in vc-pull-and-push * lisp/vc/vc-dispatcher.el (vc--inhibit-async-window): Rename variable. (vc-do-async-command): Allow inhibiting all window changes. * lisp/vc/vc-git.el (vc-git-pull-and-push): Don't pop up the window asynchronously on the "pull" because that gets in the way of doing other things. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 52cf60e992..89bf79622e 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -425,7 +425,7 @@ case, and the process object in the asynchronous case." command file-or-list flags)) status))))) -(defvar vc--inhibit-change-window-start nil) +(defvar vc--inhibit-async-window nil) (defun vc-do-async-command (buffer root command &rest args) "Run COMMAND asynchronously with ARGS, displaying the result. @@ -436,7 +436,7 @@ The process object is returned. Display the buffer in some window, but don't select it." (let ((dir default-directory) (inhibit-read-only t) - window new-window-start proc) + new-window-start proc) (setq buffer (get-buffer-create buffer)) (if (get-buffer-process buffer) (error "Another VC action on %s is running" root)) @@ -459,10 +459,9 @@ Display the buffer in some window, but don't select it." (insert "\"...\n") args)))) (setq proc (apply #'vc-do-command t 'async command nil args)))) - (setq window (display-buffer buffer)) - (when (and window - (not vc--inhibit-change-window-start)) - (set-window-start window new-window-start)) + (unless vc--inhibit-async-window + (when-let ((window (display-buffer buffer))) + (set-window-start window new-window-start))) proc)) (defvar compilation-error-regexp-alist) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 22f7750feb..f5ac43f536 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1150,11 +1150,11 @@ for the Git command to run." (with-current-buffer (process-buffer proc) (if (and (eq (process-status proc) 'exit) (zerop (process-exit-status proc))) - (let ((vc--inhibit-change-window-start t)) + (let ((vc--inhibit-async-window t)) (vc-git-push nil)) (vc-exec-after (lambda () - (let ((vc--inhibit-change-window-start t)) + (let ((vc--inhibit-async-window t)) (vc-git-push nil))) proc)))))) commit be9e51f61f6c6de17967c139c95d71472bc30137 Author: Sean Whitton Date: Sat Sep 24 12:06:47 2022 -0700 ; Drop two obsolete defvars * lisp/vc/vc-git.el (vc-want-edit-command-p) * lisp/vc/vc.el (vc-want-edit-command-p): Drop obsolete defvar. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 8cca60961d..22f7750feb 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1089,7 +1089,6 @@ It is based on `log-edit-mode', and has Git-specific extensions." (declare-function vc-compilation-mode "vc-dispatcher" (backend)) (defvar compilation-directory) (defvar compilation-arguments) -(defvar vc-want-edit-command-p) (defun vc-git--pushpull (command prompt extra-args) "Run COMMAND (a string; either push or pull) on the current Git branch. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4950a1a32d..24300e014a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1046,7 +1046,6 @@ Within directories, only files already under version control are noticed." (defvar log-edit-vc-backend) (defvar diff-vc-backend) (defvar diff-vc-revisions) -(defvar vc-want-edit-command-p) (defun vc-deduce-backend () (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) commit 5e26d5f527eae5e004b85d830701346189ef497a Author: Stefan Kangas Date: Sat Sep 24 20:18:48 2022 +0200 ; Simplify image-dired-forward-image * lisp/image/image-dired.el (image-dired-forward-image): Simplify. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index c519b32654..b8b16343c1 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -675,16 +675,14 @@ point is on the last image, move to the last one and vice versa." (forward-char (if (> arg 0) 1 -1))) (setq pos (point)) (image-dired-image-at-point-p))) - (progn (goto-char pos) - (image-dired--update-header-line)) + (goto-char pos) (if wrap-around - (progn (goto-char (if (> arg 0) - (point-min) - ;; There are two spaces after the last image. - (- (point-max) 2))) - (image-dired--update-header-line)) - (message "At %s image" (if (> arg 0) "last" "first")) - (image-dired--update-header-line))))) + (goto-char (if (> arg 0) + (point-min) + ;; There are two spaces after the last image. + (- (point-max) 2))) + (message "At %s image" (if (> arg 0) "last" "first")))))) + (image-dired--update-header-line) (when image-dired-track-movement (image-dired-track-original-file))) commit 0e6c15bbaf14e92df44a3ea0fd2716527cbb2d5f Author: Stefan Kangas Date: Sat Sep 24 20:08:25 2022 +0200 image-dired: Add faces for header line * lisp/image/image-dired.el (image-dired-thumb-header-file-name) (image-dired-thumb-header-directory-name) (-image-dired-thumb-header-file-size) (image-dired-thumb-header-image-count): New faces. (image-dired-format-properties-string): Use above new faces. (image-dired-thumb-mark, image-dired-thumb-flagged): Move definition further down. diff --git a/etc/NEWS b/etc/NEWS index 1816dd716a..74e29a0ea5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2128,6 +2128,15 @@ old format, add this to your Init file: (setopt image-dired-display-properties-format "%b: %f (%t): %c") +--- +*** New faces for the header line of the thumbnail buffer. +These faces correspond to different parts of the header line, as +specified in 'image-dired-display-properties-format': +- 'image-dired-thumb-header-file-name' +- 'image-dired-thumb-header-directory-name' +- 'image-dired-thumb-header-file-size' +- 'image-dired-thumb-header-image-count' + --- *** PDF support. Image-Dired now displays thumbnails for PDF files. Type 'RET' on a diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 080c2536af..c519b32654 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -259,22 +259,6 @@ deletion." :type 'boolean :version "28.1") -(defface image-dired-thumb-mark - '((((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. Used by `image-dired-display-thumbs' and other functions that needs @@ -362,6 +346,52 @@ This affects the following commands: :type 'boolean :version "29.1") + +;;; Faces + +;;;; Header line + +(defface image-dired-thumb-header-file-name + '((default :weight bold)) + "Face for the file name in the header line of the thumbnail buffer." + :version "29.1") + +(defface image-dired-thumb-header-directory-name + '((default :inherit header-line)) + "Face for the directory name in the header line of the thumbnail buffer." + :version "29.1") + +(defface -image-dired-thumb-header-file-size + '((((class color) (min-colors 88)) :foreground "cadet blue") + (((class color) (min-colors 16)) :foreground "black") + (default :inherit header-line)) + "Face for the file size in the header line of the thumbnail buffer." + :version "29.1") + +(defface image-dired-thumb-header-image-count + '((default :inherit header-line)) + "Face for the image count in the header line of the thumbnail buffer." + :version "29.1") + +;;;; Thumbnail buffer + +(defface image-dired-thumb-mark + '((((class color) (min-colors 16)) :background "DarkOrange") + (((class color)) :foreground "yellow") + (default :inherit header-line)) + "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") + ;;; Util functions @@ -731,14 +761,19 @@ comment." (format-spec image-dired-display-properties-format `((?b . ,(or buf "")) - (?d . ,(file-name-nondirectory - (directory-file-name - (file-name-directory file)))) - (?f . ,(file-name-nondirectory file)) - (?n . ,image-count) - (?s . ,(file-size-human-readable - (file-attribute-size - (file-attributes file)))) + (?d . ,(propertize + (file-name-nondirectory + (directory-file-name + (file-name-directory file))) + 'face 'image-dired-thumb-header-directory-name)) + (?f . ,(propertize (file-name-nondirectory file) + 'face 'image-dired-thumb-header-file-name)) + (?n . ,(propertize image-count + 'face 'image-dired-thumb-header-image-count)) + (?s . ,(propertize (file-size-human-readable + (file-attribute-size + (file-attributes file))) + 'face 'image-dired-thumb-header-file-size)) (?t . ,(or props "")) (?c . ,(or comment ""))))) commit 573f31db966dbed5a209c8adb008702d68632808 Author: Stefan Kangas Date: Sat Sep 24 10:45:37 2022 +0200 image-dired: Add new %-format specifiers for header line * lisp/image/image-dired.el (image-dired-format-properties-string): Add new specifiers "%n", "%d", and "%s". (image-dired-display-properties-format): Change default format to use above new specifiers. (image-dired--number-of-thumbnails): New variable. (image-dired-insert-thumbnail, image-dired-display-thumbs): Keep track of file number when appending it into the thumbnail buffer. (image-dired--update-header-line): Support above new format specifiers. Rename from 'image-dired-update-header-line' and update callers. * lisp/image/image-dired-dired.el (image-dired-dired-display-properties): Support above new format specifiers. diff --git a/etc/NEWS b/etc/NEWS index 5b15e9dcb6..1816dd716a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2113,9 +2113,20 @@ used for images that are flagged for deletion in the Dired buffer associated with Image-Dired. --- -*** Image information is now shown in the header line. -This replaces the message most navigation commands in the thumbnail -buffer used to show at the bottom of the screen. +*** Image information is now shown in the header line of the thumbnail buffer. +This replaces the message that most navigation commands in the +thumbnail buffer used to show at the bottom of the screen. + +--- +*** New specifiers for 'image-dired-display-properties-format'. +This is used to format the new header line. The new specifiers are: +"%d" for the name of the directory that the file is in, "%n" for +file's number in the thumbnail buffer, and "%s" for the file size. + +The default format has been updated to use this. If you prefer the +old format, add this to your Init file: + + (setopt image-dired-display-properties-format "%b: %f (%t): %c") --- *** PDF support. @@ -2155,12 +2166,6 @@ You can set the delay with a prefix argument, or a negative prefix argument to prompt for a delay. Customize the user option 'image-dired-slideshow-delay' to change the default from 5 seconds. ---- -*** 'image-dired-display-properties-format' default has changed. -If you prefer the old format, add this to your Init file: - - (setopt image-dired-display-properties-format "%b: %f (%t): %c") - +++ *** 'image-dired-show-all-from-dir-max-files' increased to 1000. This user option controls asking for confirmation when starting diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index 3c9e0c5b3f..94367b566e 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -166,7 +166,7 @@ but the other way around." (when found (if (setq window (image-dired-thumbnail-window)) (set-window-point window (point))) - (image-dired-update-header-line)))))) + (image-dired--update-header-line)))))) (defun image-dired-dired-next-line (&optional arg) "Call `dired-next-line', then track thumbnail. @@ -387,17 +387,18 @@ matching tag will be marked in the Dired buffer." (defun image-dired-dired-display-properties () "Display properties for Dired file in the echo area." (interactive nil dired-mode) - (let* ((file (dired-get-filename)) - (file-name (file-name-nondirectory file)) + (let* ((file-name (dired-get-filename)) (dired-buf (buffer-name (current-buffer))) - (props (string-join (image-dired-list-tags file) ", ")) - (comment (image-dired-get-comment file)) + (image-count "") ; TODO + (props (string-join (image-dired-list-tags file-name) ", ")) + (comment (image-dired-get-comment file-name)) (message-log-max nil)) (if file-name (message "%s" (image-dired-format-properties-string dired-buf file-name + image-count props comment))))) diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 05bd827557..080c2536af 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -298,16 +298,19 @@ For more information, see the documentation for `image-dired-toggle-movement-tracking'." :type 'boolean) -(defcustom image-dired-display-properties-format "%-40f %b %t %c" +(defcustom image-dired-display-properties-format "%n %d/%f %s %t %c" "Display format for thumbnail properties. This is used for the header line in the Image-Dired buffer. The following %-specs are replaced by `format-spec' before displaying: - \"%b\" The associated Dired buffer name. \"%f\" The file name (without a directory) of the original image file. + \"%n\" The number of this image out of the total (e.g. 1/10). + \"%b\" The associated Dired buffer name. + \"%d\" The name of the directory that the file is in. + \"%s\" The image file size. \"%t\" The list of tags (from the Image-Dired database). \"%c\" The comment (from the Image-Dired database)." :type 'string @@ -392,9 +395,10 @@ This affects the following commands: thumb-file)) (defun image-dired-insert-thumbnail ( file original-file-name - associated-dired-buffer) + associated-dired-buffer image-number) "Insert thumbnail image FILE. -Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." +Add text properties ORIGINAL-FILE-NAME, ASSOCIATED-DIRED-BUFFER +and IMAGE-NUMBER." (let (beg end) (setq beg (point)) (image-dired-insert-image @@ -418,6 +422,7 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." 'keymap nil 'original-file-name original-file-name 'associated-dired-buffer associated-dired-buffer + 'image-number image-number 'tags (image-dired-list-tags original-file-name) 'mouse-face 'highlight 'comment (image-dired-get-comment original-file-name))))) @@ -510,6 +515,8 @@ Restore any changes to the window configuration made by calling (t (image-dired-line-up-dynamic)))) +(defvar-local image-dired--number-of-thumbnails nil) + ;;;###autoload (defun image-dired-display-thumbs (&optional arg append do-not-pop) "Display thumbnails of all marked files, in `image-dired-thumbnail-buffer'. @@ -542,11 +549,15 @@ thumbnail buffer to be selected." (with-current-buffer buf (let ((inhibit-read-only t)) (if (not append) - (erase-buffer) + (progn + (setq image-dired--number-of-thumbnails 0) + (erase-buffer)) (goto-char (point-max))) (dolist (file files) (let ((thumb (image-dired--get-create-thumbnail-file file))) - (image-dired-insert-thumbnail thumb file dired-buf)))) + (image-dired-insert-thumbnail + thumb file dired-buf + (cl-incf image-dired--number-of-thumbnails))))) (if do-not-pop (display-buffer buf) (pop-to-buffer buf)) @@ -580,7 +591,7 @@ never ask for confirmation." (dired-unmark-all-marks)) (pop-to-buffer image-dired-thumbnail-buffer) (setq default-directory dir) - (image-dired-update-header-line)) + (image-dired--update-header-line)) (t (message "Image-Dired canceled"))))) ;;;###autoload @@ -635,15 +646,15 @@ point is on the last image, move to the last one and vice versa." (setq pos (point)) (image-dired-image-at-point-p))) (progn (goto-char pos) - (image-dired-update-header-line)) + (image-dired--update-header-line)) (if wrap-around (progn (goto-char (if (> arg 0) (point-min) ;; There are two spaces after the last image. (- (point-max) 2))) - (image-dired-update-header-line)) + (image-dired--update-header-line)) (message "At %s image" (if (> arg 0) "last" "first")) - (image-dired-update-header-line))))) + (image-dired--update-header-line))))) (when image-dired-track-movement (image-dired-track-original-file))) @@ -667,7 +678,7 @@ On reaching end or beginning of buffer, stop and show a message." (image-dired--movement-ensure-point-pos ,reverse) (when image-dired-track-movement (image-dired-track-original-file)) - (image-dired-update-header-line))) + (image-dired--update-header-line))) (defmacro image-dired--movement-command-line (&optional reverse) `(image-dired--movement-command @@ -710,36 +721,46 @@ On reaching end or beginning of buffer, stop and show a message." ;;; Header line -(defun image-dired-format-properties-string (buf file props comment) +(defun image-dired-format-properties-string (buf file image-count props comment) "Format display properties. -BUF is the associated Dired buffer, FILE is the original image file -name, PROPS is a stringified list of tags and COMMENT is the image file's +BUF is the associated Dired buffer, FILE is the original image +file name, IMAGE-COUNT is a string like \"N/M\" where N is the +number of this image and M is the total number of images, PROPS +is a stringified list of tags, and COMMENT is the image file's comment." (format-spec image-dired-display-properties-format - (list - (cons ?b (or buf "")) - (cons ?f file) - (cons ?t (or props "")) - (cons ?c (or comment ""))))) - -(defun image-dired-update-header-line () + `((?b . ,(or buf "")) + (?d . ,(file-name-nondirectory + (directory-file-name + (file-name-directory file)))) + (?f . ,(file-name-nondirectory file)) + (?n . ,image-count) + (?s . ,(file-size-human-readable + (file-attribute-size + (file-attributes file)))) + (?t . ,(or props "")) + (?c . ,(or comment ""))))) + +(defun image-dired--update-header-line () "Update image information in the header line." - (when (and (not (eobp)) - (memq major-mode '(image-dired-thumbnail-mode - image-dired-display-image-mode))) - (let ((file-name (file-name-nondirectory (image-dired-original-file-name))) + (when (derived-mode-p 'image-dired-thumbnail-mode) + (let ((file-name (image-dired-original-file-name)) (dired-buf (buffer-name (image-dired-associated-dired-buffer))) + (image-count (format "%s/%s" + (get-text-property (point) 'image-number) + image-dired--number-of-thumbnails)) (props (string-join (get-text-property (point) 'tags) ", ")) (comment (get-text-property (point) 'comment)) (message-log-max nil)) - (if file-name - (setq header-line-format - (image-dired-format-properties-string - dired-buf - file-name - props - comment)))))) + (when file-name + (setq header-line-format + (image-dired-format-properties-string + dired-buf + file-name + image-count + props + comment)))))) ;;; Marking and flagging @@ -956,6 +977,8 @@ Use `image-dired-minor-mode' to get a nice setup." Resized or in full-size." :interactive nil :group 'image-dired + (setq-local column-number-mode nil) + (setq-local line-number-mode nil) (add-hook 'file-name-at-point-functions #'image-dired-file-name-at-point nil t)) @@ -1220,7 +1243,7 @@ overwritten. This confirmation can be turned off using (comment (image-dired-read-comment file))) (image-dired-write-comments (list (cons file comment))) (image-dired-update-property 'comment comment)) - (image-dired-update-header-line)) + (image-dired--update-header-line)) ;;; Mouse support @@ -1251,7 +1274,7 @@ non-nil." (image-dired-backward-image)) (if image-dired-track-movement (image-dired-track-original-file)) - (image-dired-update-header-line)) + (image-dired--update-header-line)) @@ -1622,9 +1645,6 @@ Dired." (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-display-thumb-properties - #'image-dired-update-header-line "29.1") - (defvar image-dired-slideshow-count 0 "Keeping track on number of images in slideshow.") (make-obsolete-variable 'image-dired-slideshow-count "no longer used." "29.1") @@ -1881,6 +1901,8 @@ when using per-directory thumbnail file storage")) #'image-dired--thumb-update-marks "29.1") (define-obsolete-function-alias 'image-dired-get-thumbnail-image #'image-dired--get-create-thumbnail-file "29.1") +(define-obsolete-function-alias 'image-dired-display-thumb-properties + #'image-dired--update-header-line "29.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;; TEST-SECTION ;;;;;;;;;;; commit 9a5176aec018d6cb6c32614b3b1c8b0dd6d9b71a Author: Sean Whitton Date: Sat Sep 24 10:39:52 2022 -0700 Generalize & simplify implementation of user edits to VC commands * lisp/vc/vc-dispatcher.el (vc-pre-command-functions) (vc-want-edit-command-p): Delete. (vc-filter-command-function): New variable. (vc-user-edit-command): Factor out of vc-do-command. (vc-do-command, vc-do-async-command) * lisp/vc/vc-git.el (vc-git--pushpull) * lisp/vc/vc.el (vc-print-branch-log): Use vc-filter-command-function in place of vc-pre-command-functions and vc-want-edit-command-p. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index b4493ce40e..52cf60e992 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -109,6 +109,8 @@ ;; TODO: ;; - log buffers need font-locking. +(eval-when-compile (require 'cl-lib)) + ;; General customization (defcustom vc-logentry-check-hook nil @@ -156,9 +158,6 @@ BEWARE: Despite its name, this variable is not itself a hook!") (defvar vc-parent-buffer-name nil) (put 'vc-parent-buffer-name 'permanent-local t) -(defvar vc-want-edit-command-p nil - "If non-nil, let user edit the VC shell command before running it.") - ;; Common command execution logic (defun vc-process-filter (p s) @@ -270,11 +269,12 @@ SUCCESS process has a zero exit code." (declare (indent 0) (debug (def-body))) `(vc-exec-after (lambda () ,@body))) -(defvar vc-pre-command-functions nil - "Hook run at the beginning of `vc-do-command'. -Each function is called inside the buffer in which the command -will be run and is passed 3 arguments: the COMMAND, the FILES and -the FLAGS.") +(defvar vc-filter-command-function (lambda (&rest args) args) + "Function called to transform VC commands before execution. +The function is called inside the buffer in which the command +will be run and is passed the COMMAND, FILE-OR-LIST and FLAGS +arguments to `vc-do-command'. It should return a list of three +elements, the new values for these arguments.") (defvar vc-post-command-functions nil "Hook run at the end of `vc-do-command'. @@ -296,6 +296,23 @@ the man pages for \"torsocks\" for more details about Tor." :version "27.1" :group 'vc) +(defun vc-user-edit-command (command file-or-list flags) + "Prompt the user to edit VC command COMMAND and FLAGS. +Intended to be used as the value of `vc-filter-command-function'." + (let* ((files-separator-p (string= "--" (car (last flags)))) + (edited (split-string-and-unquote + (read-shell-command + (format "Edit VC command & arguments%s: " + (if file-or-list + " (files list to be appended)" + "")) + (combine-and-quote-strings + (cons command (remq nil (if files-separator-p + (butlast flags) + flags)))))))) + (list (car edited) file-or-list + (nconc (cdr edited) (and files-separator-p '("--")))))) + ;;;###autoload (defun vc-do-command (buffer okstatus command file-or-list &rest flags) "Execute a slave command, notifying user and checking for errors. @@ -311,109 +328,102 @@ files or be nil (to execute commands that don't expect a file name or set of files). If an optional list of FLAGS is present, that is inserted into the command line before the filename. -If `vc-want-edit-command-p' is non-nil, prompt the user to edit -COMMAND and FLAGS before execution. - Return the return value of the slave command in the synchronous case, and the process object in the asynchronous case." - (when vc-want-edit-command-p - (let* ((files-separator-p (string= "--" (car (last flags)))) - (edited (split-string-and-unquote - (read-shell-command - (format "Edit VC command & arguments%s: " - (if file-or-list - " (files list to be appended)" - "")) - (combine-and-quote-strings - (cons command (remq nil (if files-separator-p - (butlast flags) - flags)))))))) - (setq command (car edited) - flags (nconc (cdr edited) - (and files-separator-p '("--")))))) - (when vc-tor - (push command flags) - (setq command "torsocks")) - ;; FIXME: file-relative-name can return a bogus result because - ;; it doesn't look at the actual file-system to see if symlinks - ;; come into play. - (let* ((files - (mapcar (lambda (f) (file-relative-name (expand-file-name f))) - (if (listp file-or-list) file-or-list (list file-or-list)))) - ;; Keep entire commands in *Messages* but avoid resizing the - ;; echo area. Messages in this function are formatted in - ;; a such way that the important parts are at the beginning, - ;; due to potential truncation of long messages. - (message-truncate-lines t) - (full-command - (concat (if (string= (substring command -1) "\n") - (substring command 0 -1) - command) - " " (vc-delistify flags) - " " (vc-delistify files))) - (vc-inhibit-message - (or (eq vc-command-messages 'log) - (eq (selected-window) (active-minibuffer-window))))) + (let (;; Keep entire commands in *Messages* but avoid resizing the + ;; echo area. Messages in this function are formatted in + ;; a such way that the important parts are at the beginning, + ;; due to potential truncation of long messages. + (message-truncate-lines t) + (vc-inhibit-message + (or (eq vc-command-messages 'log) + (eq (selected-window) (active-minibuffer-window))))) (save-current-buffer (unless (or (eq buffer t) (and (stringp buffer) (string= (buffer-name) buffer)) (eq buffer (current-buffer))) - (vc-setup-buffer buffer)) - (run-hook-with-args 'vc-pre-command-functions - command file-or-list flags) - ;; If there's some previous async process still running, just kill it. - (let ((squeezed (remq nil flags)) - (inhibit-read-only t) - (status 0)) - (when files - (setq squeezed (nconc squeezed files))) - (let (;; Since some functions need to parse the output - ;; from external commands, set LC_MESSAGES to C. - (process-environment (cons "LC_MESSAGES=C" process-environment)) - (w32-quote-process-args t)) - (if (eq okstatus 'async) - ;; Run asynchronously. - (let ((proc - (let ((process-connection-type nil)) - (apply #'start-file-process command (current-buffer) - command squeezed)))) - (when vc-command-messages - (let ((inhibit-message vc-inhibit-message)) - (message "Running in background: %s" full-command))) - ;; Get rid of the default message insertion, in case we don't - ;; set a sentinel explicitly. - (set-process-sentinel proc #'ignore) - (set-process-filter proc #'vc-process-filter) - (setq status proc) - (when vc-command-messages - (vc-run-delayed - (let ((message-truncate-lines t) - (inhibit-message vc-inhibit-message)) - (message "Done in background: %s" full-command))))) - ;; Run synchronously - (when vc-command-messages - (let ((inhibit-message vc-inhibit-message)) - (message "Running in foreground: %s" full-command))) - (let ((buffer-undo-list t)) - (setq status (apply #'process-file command nil t nil squeezed))) - (when (and (not (eq t okstatus)) - (or (not (integerp status)) - (and okstatus (< okstatus status)))) - (unless (eq ?\s (aref (buffer-name (current-buffer)) 0)) - (pop-to-buffer (current-buffer)) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer)) - (error "Failed (%s): %s" - (if (integerp status) (format "status %d" status) status) - full-command)) - (when vc-command-messages - (let ((inhibit-message vc-inhibit-message)) - (message "Done (status=%d): %s" status full-command))))) - (vc-run-delayed - (run-hook-with-args 'vc-post-command-functions - command file-or-list flags)) - status)))) + (vc-setup-buffer buffer)) + (cl-destructuring-bind (command file-or-list flags) + (funcall vc-filter-command-function command file-or-list flags) + (when vc-tor + (push command flags) + (setq command "torsocks")) + (let* (;; FIXME: file-relative-name can return a bogus result + ;; because it doesn't look at the actual file-system to + ;; see if symlinks come into play. + (files + (mapcar (lambda (f) + (file-relative-name (expand-file-name f))) + (if (listp file-or-list) + file-or-list + (list file-or-list)))) + (full-command + (concat (if (string= (substring command -1) "\n") + (substring command 0 -1) + command) + " " (vc-delistify flags) + " " (vc-delistify files))) + (squeezed (remq nil flags)) + (inhibit-read-only t) + (status 0)) + ;; If there's some previous async process still running, + ;; just kill it. + (when files + (setq squeezed (nconc squeezed files))) + (let (;; Since some functions need to parse the output + ;; from external commands, set LC_MESSAGES to C. + (process-environment + (cons "LC_MESSAGES=C" process-environment)) + (w32-quote-process-args t)) + (if (eq okstatus 'async) + ;; Run asynchronously. + (let ((proc + (let ((process-connection-type nil)) + (apply #'start-file-process command + (current-buffer) command squeezed)))) + (when vc-command-messages + (let ((inhibit-message vc-inhibit-message)) + (message "Running in background: %s" + full-command))) + ;; Get rid of the default message insertion, in case + ;; we don't set a sentinel explicitly. + (set-process-sentinel proc #'ignore) + (set-process-filter proc #'vc-process-filter) + (setq status proc) + (when vc-command-messages + (vc-run-delayed + (let ((message-truncate-lines t) + (inhibit-message vc-inhibit-message)) + (message "Done in background: %s" + full-command))))) + ;; Run synchronously + (when vc-command-messages + (let ((inhibit-message vc-inhibit-message)) + (message "Running in foreground: %s" full-command))) + (let ((buffer-undo-list t)) + (setq status (apply #'process-file + command nil t nil squeezed))) + (when (and (not (eq t okstatus)) + (or (not (integerp status)) + (and okstatus (< okstatus status)))) + (unless (eq ?\s (aref (buffer-name (current-buffer)) 0)) + (pop-to-buffer (current-buffer)) + (goto-char (point-min)) + (shrink-window-if-larger-than-buffer)) + (error "Failed (%s): %s" + (if (integerp status) + (format "status %d" status) + status) + full-command)) + (when vc-command-messages + (let ((inhibit-message vc-inhibit-message)) + (message "Done (status=%d): %s" + status full-command))))) + (vc-run-delayed + (run-hook-with-args 'vc-post-command-functions + command file-or-list flags)) + status))))) (defvar vc--inhibit-change-window-start nil) @@ -424,29 +434,30 @@ of a buffer, which is created. ROOT should be the directory in which the command should be run. The process object is returned. Display the buffer in some window, but don't select it." - (letrec ((dir default-directory) - (inhibit-read-only t) - (fun (lambda (command _ args) - (remove-hook 'vc-pre-command-functions fun) - (goto-char (point-max)) - (unless (eq (point) (point-min)) - (insert " \n")) - (setq new-window-start (point)) - (insert "Running \"" command) - (dolist (arg args) - (insert " " arg)) - (insert "\"...\n"))) - (window nil) - (new-window-start nil) - (proc nil)) + (let ((dir default-directory) + (inhibit-read-only t) + window new-window-start proc) (setq buffer (get-buffer-create buffer)) (if (get-buffer-process buffer) (error "Another VC action on %s is running" root)) (with-current-buffer buffer (setq default-directory root) - (add-hook 'vc-pre-command-functions fun) - ;; Run in the original working directory. - (let ((default-directory dir)) + (let* (;; Run in the original working directory. + (default-directory dir) + (orig-fun vc-filter-command-function) + (vc-filter-command-function + (lambda (&rest args) + (cl-destructuring-bind (&whole args cmd _ flags) + (apply orig-fun args) + (goto-char (point-max)) + (unless (eq (point) (point-min)) + (insert " \n")) + (setq new-window-start (point)) + (insert "Running \"" cmd) + (dolist (flag flags) + (insert " " flag)) + (insert "\"...\n") + args)))) (setq proc (apply #'vc-do-command t 'async command nil args)))) (setq window (display-buffer buffer)) (when (and window diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 18cc4a66ad..8cca60961d 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1094,23 +1094,23 @@ It is based on `log-edit-mode', and has Git-specific extensions." (defun vc-git--pushpull (command prompt extra-args) "Run COMMAND (a string; either push or pull) on the current Git branch. If PROMPT is non-nil, prompt for the Git command to run." + (require 'vc-dispatcher) (let* ((root (vc-git-root default-directory)) (buffer (format "*vc-git : %s*" (expand-file-name root))) (git-program vc-git-program) ;; TODO if pushing, prompt if no default push location - cf bzr. - (vc-want-edit-command-p prompt) - proc) - (require 'vc-dispatcher) - (when vc-want-edit-command-p - (with-current-buffer (get-buffer-create buffer) - (add-hook 'vc-pre-command-functions - (lambda (&rest args) - (setq git-program (car args) - command (caaddr args) - extra-args (cdaddr args))) - nil t))) - (setq proc (apply #'vc-do-async-command - buffer root git-program command extra-args)) + (vc-filter-command-function + (if prompt + (lambda (&rest args) + (cl-destructuring-bind (&whole args git _ flags) + (apply #'vc-user-edit-command args) + (setq git-program git + command (car flags) + extra-args (cdr flags)) + args)) + vc-filter-command-function)) + (proc (apply #'vc-do-async-command + buffer root git-program command extra-args))) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4ebcd3ae16..4950a1a32d 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2764,7 +2764,9 @@ log." (error "No branch specified")) (let* ((backend (vc-responsible-backend default-directory)) (rootdir (vc-call-backend backend 'root default-directory)) - (vc-want-edit-command-p arg)) + (vc-filter-command-function (if arg + #'vc-user-edit-command + vc-filter-command-function))) (vc-print-log-internal backend (list rootdir) branch t (when (> vc-log-show-limit 0) vc-log-show-limit)))) commit 8574ae625e3144d92bb59a0107a4404cc3d0ab86 Author: Juri Linkov Date: Sat Sep 24 20:17:28 2022 +0300 * lisp/emacs-lisp/icons.el (icons--create): Use default rotation 0 (bug#57813) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index ccc3657793..a08ac7463c 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -203,7 +203,7 @@ present if the icon is represented by an image." (window-default-line-height) height) :scale 1 - :rotation (plist-get keywords :rotation) + :rotation (or (plist-get keywords :rotation) 0) :ascent (if (plist-member keywords :ascent) (plist-get keywords :ascent) 'center)) commit 4c66a4addcc1e282f73f77ad11a1c14093c21d07 Author: Michael Albinus Date: Sat Sep 24 18:44:32 2022 +0200 Adapt tramp-docker integration * doc/misc/tramp.texi (Inline methods): Add docker. (Customizing Methods): Remove docker-tramp. Adapt references to this. * etc/NEWS: Mention new Tramp method "docker". Fix typos. * lisp/net/tramp-compat.el (docker-tramp): Warn, if that package is used. * lisp/net/tramp-docker.el: Format header lines. (tramp-docker): Remove custom group. (tramp-docker-program, tramp-docker-method): Add ;;;###tramp-autoload cookie. (tramp-docker-program): Change group to `tramp'. Add version. (tramp-docker--completion-function): Fix docstring. (tramp-docker--add-method, tramp-docker--remove-method) (tramp-docker-unload-function, tramp-docker-setup): Remove functions. (tramp-methods, tramp-set-completion-function): Initialize via `tramp--with-startup'. (tramp-unload-hook): Unload `tramp-docker'. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 0e55b6c1d2..455e145a81 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -903,6 +903,15 @@ supports changing the remote login shell @command{/bin/sh}. Check the @samp{Share SSH connections if possible} control for that session. +@item @option{docker} +@cindex method @option{docker} +@cindex @option{docker} method + +Integration for Docker containers. A container is accessed via +@file{@trampfn{docker,user@@container,/path/to/file}}, where +@samp{user} is the (optional) user that you want to use, and +@samp{container} is the id or name of the container. + @end table @@ -1763,36 +1772,30 @@ They can be installed with Emacs's Package Manager. This includes @c @item ibuffer-tramp.el @c Contact Svend Sorensen -@item docker-tramp -@cindex method @option{docker} -@cindex @option{docker} method -Integration for Docker containers. A container is accessed via -@file{@trampfn{docker,user@@container,/path/to/file}}, where -@samp{user} is the (optional) user that you want to use, and -@samp{container} is the id or name of the container. - @item kubernetes-tramp @cindex method @option{kubectl} @cindex @option{kubectl} method -Integration for Docker containers deployed in a Kubernetes cluster. -It is derived from @samp{docker-tramp}. A container is accessed via +Integration for Docker containers deployed in a Kubernetes cluster. A +container is accessed via @file{@trampfn{kubectl,user@@container,/path/to/file}}, @samp{user} -and @samp{container} have the same meaning as in @samp{docker-tramp}. +and @samp{container} have the same meaning as with the @option{docker} +method. @item lxc-tramp @cindex method @option{lxc} @cindex @option{lxc} method Integration for LXC containers. A container is accessed via @file{@trampfn{lxc,container,/path/to/file}}, @samp{container} has the -same meaning as in @samp{docker-tramp}. A @samp{user} specification -is ignored. +same meaning as with the @option{docker} method. A @samp{user} +specification is ignored. @item lxd-tramp @cindex method @option{lxd} @cindex @option{lxd} method Integration for LXD containers. A container is accessed via @file{@trampfn{lxd,user@@container,/path/to/file}}, @samp{user} and -@samp{container} have the same meaning as in @samp{docker-tramp}. +@samp{container} have the same meaning as with the @option{docker} +method. @item magit-tramp @cindex method @option{git} diff --git a/etc/NEWS b/etc/NEWS index 037368d1ec..5b15e9dcb6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -400,7 +400,7 @@ performance, but the latter is closer to a drop-in replacement. --- ** The thumbs.el library is now obsolete. -We recommend using `M-x image-dired' instead. +We recommend using 'M-x image-dired' instead. --- ** The autoarg.el library is now marked obsolete. @@ -1371,7 +1371,7 @@ This controls how statements like the following are indented: foo && bar -*** New Flymake backend using the ShellCheck program +*** New Flymake backend using the ShellCheck program. It is enabled by default, but requires that the external "shellcheck" command is installed. @@ -2311,6 +2311,10 @@ and friends. ** Tramp ++++ +*** New connection method "docker". +It allows accessing environments provided by Docker. + --- *** Tramp supports abbreviating remote home directories now. When calling 'abbreviate-file-name' on a Tramp file name, the result @@ -2640,7 +2644,7 @@ didn't work well in most files in the past, either, but it will now signal an error in any file.) In addition, files are scanned in a slightly different way. -Previously ';;;###' specs inside a top-level form (i.e., something +Previously, ';;;###' specs inside a top-level form (i.e., something like '(when ... ;;;### ...)' would be ignored. They are now parsed as normal. @@ -2919,7 +2923,7 @@ functions. --- ** '?\' at the end of a line now signals an error. -Previously it produced a nonsense value, -1, that was never intended. +Previously, it produced a nonsense value, -1, that was never intended. --- ** Some libraries obsolete since Emacs 24.1 and 24.3 have been removed: diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index a7dd9c03f3..f6cc1034ca 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -50,6 +50,10 @@ (warn "Tramp has been compiled with Emacs %s, this is Emacs %s" tramp-compat-emacs-compiled-version emacs-version)) +(with-eval-after-load 'docker-tramp + (warn (concat "Package `docker-tramp' has been obsoleted, " + "please use integrated package `tramp-docker'"))) + ;; For not existing functions, obsolete functions, or functions with a ;; changed argument list, there are compiler warnings. We want to ;; avoid them in cases we know what we do. diff --git a/lisp/net/tramp-docker.el b/lisp/net/tramp-docker.el index 3953e4d272..40257a4a12 100644 --- a/lisp/net/tramp-docker.el +++ b/lisp/net/tramp-docker.el @@ -3,39 +3,31 @@ ;; Copyright © 2022 Free Software Foundation, Inc. ;; Author: Brian Cully -;; Maintainer: Brian Cully -;; URL: https://git.spork.org/tramp-docker -;; Keywords: tramp, docker -;; Version: 0.99.1 -;; Package-Requires: ((emacs "23")) +;; Keywords: comm, processes +;; Package: tramp -;;; License: +;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, but -;; 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. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: -;; ;; ‘tramp-docker’ allows Tramp access to environments provided by ;; Docker. ;; ;; ## Usage ;; -;; Call ‘tramp-docker-setup’ in your Emacs initialization. -;; -;; (add-hook 'after-init-hook 'tramp-docker-setup) -;; ;; Open a file on a running systemd-docker container: ;; ;; C-x C-f /docker:USER@CONTAINER:/path/to/file @@ -43,33 +35,28 @@ ;; Where: ;; USER is the user on the container to connect as (optional) ;; CONTAINER is the container to connect to -;; ;;; Code: - -(require 'tramp) -(defgroup tramp-docker nil - "Tramp integration for Docker containers." - :prefix "tramp-docker-" - :group 'applications - :link '(url-link :tag "repo" "https://git.spork.org/tramp-docker.git") - :link '(emacs-commentary-link :tag "Commentary" "tramp-docker")) +(require 'tramp) +;;;###tramp-autoload (defcustom tramp-docker-program "docker" "Name of the Docker client program." + :group 'tramp + :version "29.1" :type '(choice (const "docker") (const "podman") - (string)) - :group 'tramp-docker) + (string))) +;;;###tramp-autoload (defconst tramp-docker-method "docker" "Tramp method name to use to connect to Docker containers.") (defun tramp-docker--completion-function (&rest _args) "List Docker containers available for connection. -This function is used by ‘tramp-set-completion-function’, please +This function is used by `tramp-set-completion-function', please see its function help for a description of the format." (let* ((raw-list (shell-command-to-string (concat tramp-docker-program @@ -83,43 +70,28 @@ see its function help for a description of the format." (mapcar (lambda (m) (list nil m)) machines))) ;; todo: check tramp-async-args and tramp-direct-async -(defun tramp-docker--add-method () - "Add Tramp method handler for Docker containers." - (push `(,tramp-docker-method - (tramp-login-program ,tramp-docker-program) - (tramp-login-args (("exec") - ("-it") - ("-u" "%u") - ("%h") - ("/bin/sh"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-i" "-c"))) - tramp-methods)) - -(defun tramp-docker--remove-method () - "Remove Tramp method handler for docker containers." - (setf (alist-get tramp-docker-method tramp-methods nil t 'string=) nil)) - -(defun tramp-docker-unload-function () - "Remove Tramp method handler and completion functions." - (tramp-set-completion-function tramp-docker-method nil) - (tramp-docker--remove-method) - nil) - -(when nil - (load-file (buffer-file-name)) - (setq tramp-docker-program "doas podman") - (setq tramp-verbose 7) ;; default 3 - (tramp-docker-setup) - (tramp-docker-unload-function)) - -;;;###autoload -(defun tramp-docker-setup () - "Initialize Docker support for Tramp." - (tramp-docker--add-method) - (tramp-set-completion-function tramp-docker-method - '((tramp-docker--completion-function "")))) +;;;###tramp-autoload +(tramp--with-startup + (push `(,tramp-docker-method + (tramp-login-program ,tramp-docker-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("/bin/sh"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c"))) + tramp-methods) + + (tramp-set-completion-function + tramp-docker-method + '((tramp-docker--completion-function "")))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-docker 'force))) (provide 'tramp-docker) + ;;; tramp-docker.el ends here commit 3a0a0d616ecb13eece6c0f07c779d7f094836174 Author: Stefan Kangas Date: Sat Sep 24 18:27:35 2022 +0200 image-dired: Move menu definitions to keymaps * lisp/image/image-dired.el (image-dired-thumbnail-mode-menu): * lisp/image/image-dired-dired.el (image-dired-minor-mode-menu): Delete variables and move menus to... * lisp/image/image-dired.el (image-dired-thumbnail-mode-map): * lisp/image/image-dired-dired.el(image-dired-minor-mode-map): ...here. diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index d4574ca0bc..3c9e0c5b3f 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -206,11 +206,10 @@ With prefix argument, move ARG lines." "C-S-n" #'image-dired-next-line-and-display "C-S-p" #'image-dired-previous-line-and-display "C-S-m" #'image-dired-mark-and-display-next - "" #'image-dired-jump-thumbnail-buffer) + "" #'image-dired-jump-thumbnail-buffer -(easy-menu-define image-dired-minor-mode-menu image-dired-minor-mode-map - "Menu for `image-dired-minor-mode'." - '("Image-dired" + :menu + '("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] diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index dd434ce6ff..05bd827557 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -890,10 +890,9 @@ You probably want to use this together with " " #'image-dired-beginning-of-buffer " " #'image-dired-end-of-buffer " " #'image-dired-move-beginning-of-line - " " #'image-dired-move-end-of-line) + " " #'image-dired-move-end-of-line -(easy-menu-define image-dired-thumbnail-mode-menu image-dired-thumbnail-mode-map - "Menu for `image-dired-thumbnail-mode'." + :menu '("Image-Dired" ["Display image" image-dired-display-thumbnail-original-image] ["Display in external viewer" image-dired-thumbnail-display-external] commit 703f29d541e099c9f43b1b2877846e12098e7361 Author: Manuel Giraud Date: Fri Sep 23 17:14:44 2022 +0200 Ensure no memory leaks of glyph_matrix ; * src/dispnew.c (allocate_matrices_for_window_redisplay): Allocate each glyph_matrix only when it's NULL. (Bug#58028) diff --git a/src/dispnew.c b/src/dispnew.c index b786f0f1ba..2568ba1086 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -1810,9 +1810,12 @@ allocate_matrices_for_window_redisplay (struct window *w) if (w->desired_matrix == NULL) { w->desired_matrix = new_glyph_matrix (NULL); - w->current_matrix = new_glyph_matrix (NULL); + eassert (w->current_matrix == NULL); } + if (w->current_matrix == NULL) + w->current_matrix = new_glyph_matrix (NULL); + dim.width = required_matrix_width (w); dim.height = required_matrix_height (w); adjust_glyph_matrix (w, w->desired_matrix, 0, 0, dim); commit 4b85ae6a24380fb67a3315eaec9233f17a872473 Merge: 2084f4ada3 0df73dabc1 Author: Stefan Monnier Date: Sat Sep 24 11:09:25 2022 -0400 Merge remote-tracking branch 'refs/remotes/origin/master' commit 2084f4ada38c3ebaaf77806f32a79073fc9f0bf4 Author: kobarity Date: Mon Sep 19 13:43:33 2022 +0900 hideshow.el: Improve hs-toggle-hiding behavior * lisp/progmodes/hideshow.el (hs-find-block-beginning-match): New function to be used in `hs-already-hidden-p'. (hs-already-hidden-p): Add check if beginning of line is inside a block. (hs-toggle-hiding): Don't change to selected-window's buffer when event arg is absent. * test/lisp/progmodes/hideshow-tests.el (hideshow-tests-with-temp-buffer-selected): New helper macro. (hideshow-tests-make-event-at): New helper function. (hideshow-already-hidden-p-1): New test. (hideshow-toggle-hiding-1): New test. (hideshow-mouse-toggle-hiding-1): New test (bug#52092). diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 359fd42932..2a1b6d6b7b 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -786,6 +786,14 @@ and `case-fold-search' are both t." (case-fold-search t)) ,@body))) +(defun hs-find-block-beginning-match () + "Reposition point at the end of match of the block-start regexp. +Return point, or nil if original point was not in a block." + (when (and (funcall hs-find-block-beginning-func) + (funcall hs-looking-at-block-start-p-func)) + ;; point is inside a block + (goto-char (match-end 0)))) + (defun hs-overlay-at (position) "Return hideshow overlay at POSITION, or nil if none to be found." (let ((overlays (overlays-at position)) @@ -797,19 +805,18 @@ and `case-fold-search' are both t." (defun hs-already-hidden-p () "Return non-nil if point is in an already-hidden block, otherwise nil." - ;; FIXME: We should probably also consider ourselves "in" a hidden block - ;; when point is right at the edge after a hidden block (bug#52092). (save-excursion (let ((c-reg (hs-inside-comment-p))) (if (and c-reg (nth 0 c-reg)) ;; point is inside a comment, and that comment is hideable (goto-char (nth 0 c-reg)) - (end-of-line) - (when (and (not c-reg) - (funcall hs-find-block-beginning-func) - (funcall hs-looking-at-block-start-p-func)) - ;; point is inside a block - (goto-char (match-end 0))))) + (when (not c-reg) + (end-of-line) + (when (not (hs-find-block-beginning-match)) + ;; We should also consider ourselves "in" a hidden block when + ;; point is right at the edge after a hidden block (bug#52092). + (beginning-of-line) + (hs-find-block-beginning-match))))) (end-of-line) (hs-overlay-at (point)))) @@ -952,7 +959,7 @@ See `hs-hide-block' and `hs-show-block'. Argument E should be the event that triggered this action." (interactive (list last-nonmenu-event)) (hs-life-goes-on - (posn-set-point (event-end e)) + (when e (posn-set-point (event-end e))) (if (hs-already-hidden-p) (hs-show-block) (hs-hide-block)))) diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el index ee2a0c7c4c..22d73fb3c4 100644 --- a/test/lisp/progmodes/hideshow-tests.el +++ b/test/lisp/progmodes/hideshow-tests.el @@ -41,6 +41,18 @@ always located at the beginning of buffer." (goto-char (point-min)) ,@body)) +(defmacro hideshow-tests-with-temp-buffer-selected (mode contents &rest body) + "Create and switch to a `hs-minor-mode' enabled MODE temp buffer with CONTENTS. +BODY is code to be executed within the temp buffer. Point is +always located at the beginning of buffer." + (declare (indent 1) (debug t)) + `(ert-with-test-buffer-selected () + (,mode) + (hs-minor-mode 1) + (insert ,contents) + (goto-char (point-min)) + ,@body)) + (defun hideshow-tests-look-at (string &optional num restore-point) "Move point at beginning of STRING in the current buffer. Optional argument NUM defaults to 1 and is an integer indicating @@ -96,6 +108,39 @@ default to `point-min' and `point-max' respectively." (overlay-end overlay)))) (buffer-substring-no-properties (point-min) (point-max))))) +(defun hideshow-tests-make-event-at (string) + "Make dummy mouse event at beginning of STRING." + (save-excursion + (let ((pos (hideshow-tests-look-at string))) + (vector + `(S-mouse-2 + (,(get-buffer-window) ,pos (1 . 1) 0 nil ,pos (1 . 1) + nil (1 . 1) (1 . 1))))))) + +(ert-deftest hideshow-already-hidden-p-1 () + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hideshow-tests-look-at "printf") + (should (not (hs-already-hidden-p))) + (hs-hide-block) + (goto-char (point-min)) + (hideshow-tests-look-at "{") + (should (hs-already-hidden-p)) + (forward-line -1) + (should (not (hs-already-hidden-p))) + (hideshow-tests-look-at "}") + (should (hs-already-hidden-p)) + (forward-line) + (should (not (hs-already-hidden-p)))))) + (ert-deftest hideshow-hide-block-1 () "Should hide current block." (let ((contents " @@ -263,6 +308,67 @@ main(int argc, char **argv) } ")))) +(ert-deftest hideshow-toggle-hiding-1 () + "Should toggle hiding/showing of a block." + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hideshow-tests-look-at "printf") + (hs-toggle-hiding) + (should (string= + (hideshow-tests-visible-string) + " +int +main() +{} +")) + (hs-toggle-hiding) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-mouse-toggle-hiding-1 () + "Should toggle hiding/showing of a block by mouse events." + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +") + (hidden " +int +main() +{} +") + (call-at (lambda (str) + (let* ((events (hideshow-tests-make-event-at str)) + (last-nonmenu-event (aref events 0))) + (call-interactively #'hs-toggle-hiding nil events))))) + (hideshow-tests-with-temp-buffer-selected + c-mode + contents + ;; Should not hide the block when clicked outside of the block. + (funcall call-at "int") + (should (string= (hideshow-tests-visible-string) contents)) + ;; Should hide the block when clicked inside of the block. + (goto-char (point-min)) + (funcall call-at "printf") + (should (string= (hideshow-tests-visible-string) hidden)) + ;; Should not show the block when clicked outside of the block. + (goto-char (point-min)) + (funcall call-at "int") + (should (string= (hideshow-tests-visible-string) hidden)) + ;; Should show the block when clicked inside of the block. + (goto-char (point-min)) + (funcall call-at "}") + (should (string= (hideshow-tests-visible-string) contents))))) + (provide 'hideshow-tests) ;;; hideshow-tests.el ends here commit 0df73dabc1690b66eb62eac10ff62db1863b256e Author: Lars Ingebrigtsen Date: Sat Sep 24 16:51:37 2022 +0200 Regenerated ldefs-boot.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 4708025002..98a94b310c 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4312,79 +4312,6 @@ it is disabled. ;;; Generated autoloads from emacs-lisp/cl-generic.el (push (purecopy '(cl-generic 1 0)) package--builtin-versions) -(autoload 'cl-defgeneric "cl-generic" "\ -Create a generic function NAME. -DOC-STRING is the base documentation for this class. A generic -function has no body, as its purpose is to decide which method body -is appropriate to use. Specific methods are defined with `cl-defmethod'. -With this implementation the ARGS are currently ignored. -OPTIONS-AND-METHODS currently understands: -- (:documentation DOCSTRING) -- (declare DECLARATIONS) -- (:argument-precedence-order &rest ARGS) -- (:method [QUALIFIERS...] ARGS &rest BODY) -DEFAULT-BODY, if present, is used as the body of a default method. - -(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" nil t) -(function-put 'cl-defgeneric 'lisp-indent-function 2) -(function-put 'cl-defgeneric 'doc-string-elt 3) -(autoload 'cl-generic-define "cl-generic" "\ - - -(fn NAME ARGS OPTIONS)") -(autoload 'cl-defmethod "cl-generic" "\ -Define a new method for generic function NAME. -This defines an implementation of NAME to use for invocations -of specific types of arguments. - -ARGS is a list of dispatch arguments (see `cl-defun'), but where -each variable element is either just a single variable name VAR, -or a list on the form (VAR TYPE). - -For instance: - - (cl-defmethod foo (bar (format-string string) &optional zot) - (format format-string bar)) - -The dispatch arguments have to be among the mandatory arguments, and -all methods of NAME have to use the same set of arguments for dispatch. -Each dispatch argument and TYPE are specified in ARGS where the corresponding -formal argument appears as (VAR TYPE) rather than just VAR. - -The optional EXTRA element, on the form `:extra STRING', allows -you to add more methods for the same specializers and qualifiers. -These are distinguished by STRING. - -The optional argument QUALIFIER is a specifier that modifies how -the method is combined with other methods, including: - :before - Method will be called before the primary - :after - Method will be called after the primary - :around - Method will be called around everything else -The absence of QUALIFIER means this is a \"primary\" method. -The set of acceptable qualifiers and their meaning is defined -(and can be extended) by the methods of `cl-generic-combine-methods'. - -ARGS can also include so-called context specializers, introduced by -`&context' (which should appear right after the mandatory arguments, -before any &optional or &rest). They have the form (EXPR TYPE) where -EXPR is an Elisp expression whose value should match TYPE for the -method to be applicable. - -The set of acceptable TYPEs (also called \"specializers\") is defined -(and can be extended) by the various methods of `cl-generic-generalizers'. - -(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" nil t) -(function-put 'cl-defmethod 'doc-string-elt 'cl--defmethod-doc-pos) -(function-put 'cl-defmethod 'lisp-indent-function 'defun) -(autoload 'cl-generic-define-method "cl-generic" "\ - - -(fn NAME QUALIFIERS ARGS CALL-CON FUNCTION)") -(autoload 'cl-find-method "cl-generic" "\ - - -(fn GENERIC QUALIFIERS SPECIALIZERS)") -(register-definition-prefixes "cl-generic" '("cl-")) ;;; Generated autoloads from emacs-lisp/cl-indent.el @@ -9485,6 +9412,8 @@ Already submitted bugs can be found in the Emacs bug tracker: (fn TOPIC &optional UNUSED)" t) (set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5") +(autoload 'emacs-build-description "emacsbug" "\ +Insert a description of the current Emacs build in the current buffer." t) (autoload 'submit-emacs-patch "emacsbug" "\ Send an Emacs patch to the Emacs maintainers. Interactively, you will be prompted for SUBJECT and a patch FILE @@ -9492,7 +9421,7 @@ name (which will be attached to the mail). You will end up in a Message buffer where you can explain more about the patch. (fn SUBJECT FILE)" t) -(register-definition-prefixes "emacsbug" '("emacs-bug--system-description" "report-emacs-bug-")) +(register-definition-prefixes "emacsbug" '("report-emacs-bug-")) ;;; Generated autoloads from vc/emerge.el @@ -16940,9 +16869,9 @@ should output the image in the current buffer, converted to ;;; Generated autoloads from image/image-crop.el (autoload 'image-cut "image-crop" "\ -Cut a rectangle from the image under point. -Interactively, if given a prefix, prompt for COLOR to use. -Otherwise, default to `image-cut-color'. +Cut a rectangle from the image under point, filling it with COLOR. +COLOR defaults to the value of `image-cut-color'. +Interactively, with prefix argument, prompt for COLOR to use. (fn &optional COLOR)" t) (autoload 'image-crop "image-crop" "\ @@ -16968,7 +16897,7 @@ After cropping an image, you can save it by `M-x image-save' or ;;; Generated autoloads from image/image-dired.el -(push (purecopy '(image-dired 0 4 11)) package--builtin-versions) +(push (purecopy '(image-dired 0 5)) package--builtin-versions) (autoload 'image-dired-dired-with-window-configuration "image-dired" "\ Open directory DIR and create a default window configuration. @@ -17012,8 +16941,8 @@ thumbnail buffer to be selected. (fn &optional ARG APPEND DO-NOT-POP)" '(nil dired-mode)) (autoload 'image-dired-show-all-from-dir "image-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. +Any file matching `image-dired--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 @@ -17044,10 +16973,30 @@ previous -ARG, if ARG<0) files. (autoload 'image-dired-jump-thumbnail-buffer "image-dired-dired" "\ Jump to thumbnail buffer." '(dired-mode)) (autoload 'image-dired-minor-mode "image-dired-dired" "\ -Setup easy-to-use keybindings for the commands to be used in Dired mode. - -Note that n, p and and will be hijacked and bound to -`image-dired-dired-next-line' and `image-dired-dired-previous-line'. +Setup easy-to-use keybindings for Image-Dired in Dired mode. + +This minor mode adds these additional bindings: +\\ + \\[image-dired-next-line-and-display] Move to next line and display thumbnail image. + \\[image-dired-previous-line-and-display] Move to previous line and display thumbnail image. + \\[image-dired-mark-and-display-next] Mark current file and display next thumbnail image. + \\[image-dired-jump-thumbnail-buffer] Jump to thumbnail buffer. + +For reference, these are the default Image-Dired bindings that +are always available in Dired: +\\ + \\[image-dired-display-thumbs] Display thumbnails of all marked files. + \\[image-dired-tag-files] Tag marked file(s). + \\[image-dired-delete-tag] Remove tag for selected file(s). + \\[image-dired-jump-thumbnail-buffer] Jump to thumbnail buffer. + \\[image-dired-dired-display-image] Display current image file. + \\[image-dired-dired-display-external] Display file at point using an external viewer. + \\[image-dired-display-thumbs-append] Append thumbnails to thumbnail buffer. + \\[image-dired-display-thumb] Display thumbnails of all marked files. + \\[image-dired-dired-comment-files] Add comment to current or marked files in Dired. + \\[image-dired-mark-tagged-files] Use REGEXP to mark files with matching tag. + \\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in front of file names. + \\[image-dired-dired-edit-comment-and-tags] Edit comment and tags of marked images. This is a minor mode. If called interactively, toggle the `Image-Dired minor mode' mode. If the prefix argument is @@ -18685,58 +18634,6 @@ sleep in seconds. (fn &optional STEP-TIME)" t) (register-definition-prefixes "life" '("life-")) - -;;; Generated autoloads from linum.el - -(autoload 'linum-mode "linum" "\ -Toggle display of line numbers in the left margin (Linum mode). - -This mode has been largely replaced by `display-line-numbers-mode' -(which is much faster and has fewer interaction problems with other -modes). - -Linum mode is a buffer-local minor mode. - -This is a minor mode. If called interactively, toggle the `Linum -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `linum-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(put 'global-linum-mode 'globalized-minor-mode t) -(defvar global-linum-mode nil "\ -Non-nil if Global Linum mode is enabled. -See the `global-linum-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `global-linum-mode'.") -(custom-autoload 'global-linum-mode "linum" nil) -(autoload 'global-linum-mode "linum" "\ -Toggle Linum mode in all buffers. -With prefix ARG, enable Global Linum mode if ARG is positive; -otherwise, disable it. - -If called from Lisp, toggle the mode if ARG is `toggle'. -Enable the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -Linum mode is enabled in all buffers where `linum-on' would do it. - -See `linum-mode' for more information on Linum mode. - -(fn &optional ARG)" t) -(register-definition-prefixes "linum" '("linum-")) - ;;; Generated autoloads from cedet/ede/linux.el @@ -20985,6 +20882,11 @@ it is disabled. (fn &optional ARG)" t) (register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-")) + +;;; Generated autoloads from emacs-lisp/nadvice.el + +(push (purecopy '(nadvice 1 0)) package--builtin-versions) + ;;; Generated autoloads from net/net-utils.el @@ -22655,6 +22557,15 @@ Inserted by installing Org mode or when a release is made.") The Git version of Org mode. Inserted by installing Org or when a release is made.") + +;;; Generated autoloads from osc.el + +(autoload 'osc-compilation-filter "osc" "\ +Maybe collect OSC control sequences. +This function depends on the variable `osc-for-compilation-buffer', +and is meant to be used in `compilation-filter-hook'.") +(register-definition-prefixes "osc" '("osc-")) + ;;; Generated autoloads from outline.el @@ -26190,7 +26101,7 @@ Regexp to match Header fields that Rmail should display. If nil, display all header fields except those matched by `rmail-ignored-headers'.") (custom-autoload 'rmail-displayed-headers "rmail" t) -(defvar rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:") "\ +(defvar rmail-retry-ignored-headers (concat "^x-authentication-warning:\\|^x-detected-operating-system:\\|" "^x-spam[-a-z]*:\\|^arc-.*:\\|" "^content-type:\\|^content-transfer-encoding:\\|" "^mime-version:\\|^message-id:\\|^x-google-smtp-source:\\|" "^x-received:\\|^received-spf:\\|" "^authentication-results:\\|^dkim-signature:") "\ Headers that should be stripped when retrying a failed message.") (custom-autoload 'rmail-retry-ignored-headers "rmail" t) (defvar rmail-highlighted-headers (purecopy "^From:\\|^Subject:") "\ @@ -29627,6 +29538,10 @@ Studlify-case the current buffer." t) ;;; Generated autoloads from emacs-lisp/subr-x.el +(defsubst string-join (strings &optional 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)) (autoload 'string-truncate-left "subr-x" "\ If STRING is longer than LENGTH, return a truncated version. When truncating, \"...\" is always prepended to the string, so @@ -31253,28 +31168,6 @@ Display a list of threads." t) (put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.") (register-definition-prefixes "thread" '("thread-list-")) - -;;; Generated autoloads from thumbs.el - -(autoload 'thumbs-find-thumb "thumbs" "\ -Display the thumbnail for IMG. - -(fn IMG)" t) -(autoload 'thumbs-show-from-dir "thumbs" "\ -Make a preview buffer for all images in DIR. -Optional argument REG to select file matching a regexp, -and SAME-WINDOW to show thumbs in the same window. - -(fn DIR &optional REG SAME-WINDOW)" t) -(autoload 'thumbs-dired-show-marked "thumbs" "\ -In dired, make a thumbs buffer with marked files." t) -(autoload 'thumbs-dired-show "thumbs" "\ -In dired, make a thumbs buffer with all files in current directory." t) -(defalias 'thumbs 'thumbs-show-from-dir) -(autoload 'thumbs-dired-setroot "thumbs" "\ -In dired, call the setroot program on the image at point." t) -(register-definition-prefixes "thumbs" '("thumbs-")) - ;;; Generated autoloads from emacs-lisp/thunk.el @@ -33505,8 +33398,11 @@ with its diffs (if the underlying VCS supports that). (fn &optional LIMIT REVISION)" t) (autoload 'vc-print-branch-log "vc" "\ Show the change log for BRANCH root in a window. +Optional prefix ARG non-nil requests an opportunity for the user +to edit the VC shell command that will be run to generate the +log. -(fn BRANCH)" t) +(fn BRANCH &optional ARG)" t) (autoload 'vc-log-incoming "vc" "\ Show log of changes that will be received with pull from REMOTE-LOCATION. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. @@ -33572,6 +33468,22 @@ VCS command to run. On a non-distributed version control system, this signals an error. It also signals an error in a Bazaar bound branch. +(fn &optional ARG)" t) +(autoload 'vc-pull-and-push "vc" "\ +First pull, and then push the current branch. +The push will only be performed if the pull operation was successful. + +You must be visiting a version controlled file, or in a `vc-dir' buffer. + +On a distributed version control system, this runs a \"pull\" +operation on the current branch, prompting for the precise +command if required. Optional prefix ARG non-nil forces a prompt +for the VCS command to run. If this is successful, a \"push\" +operation will then be done. + +On a non-distributed version control system, this signals an error. +It also signals an error in a Bazaar bound branch. + (fn &optional ARG)" t) (autoload 'vc-switch-backend "vc" "\ Make BACKEND the current version control system for FILE. @@ -33740,6 +33652,10 @@ FILE-OR-LIST is the name of a working file; it may be a list of files or be nil (to execute commands that don't expect a file name or set of files). If an optional list of FLAGS is present, that is inserted into the command line before the filename. + +If `vc-want-edit-command-p' is non-nil, prompt the user to edit +COMMAND and FLAGS before execution. + Return the return value of the slave command in the synchronous case, and the process object in the asynchronous case. @@ -34916,6 +34832,18 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t) ;;; Generated autoloads from image/wallpaper.el +(autoload 'wallpaper-set "wallpaper" "\ +Set the desktop background to FILE in a graphical environment. + +On GNU/Linux and other Unix-like systems, this relies on an +external command. Which command to use is automatically detected +in most cases, but can be manually customized with the user +options `wallpaper-command' and `wallpaper-command-args'. + +On MS-Windows and Haiku systems, no external command is needed, +so the value of `wallpaper-commands' is ignored. + +(fn FILE)" t) (register-definition-prefixes "wallpaper" '("wallpaper-")) commit b7fb82bc41b807545a369c5ee61de5a557927c7f Author: Lars Ingebrigtsen Date: Sat Sep 24 16:46:22 2022 +0200 Remove "manual" package--builtin-versions updates * lisp/emacs-lisp/nadvice.el: * lisp/emacs-lisp/cl-generic.el: Don't push to package--builtin-versions "manually", because loaddefs-gen does this correctly now. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 3fd85bcb88..b3ade3b894 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -94,11 +94,6 @@ ;; This second one is closely related to what we do here (and that's ;; the name "generalizer" comes from). -;; The autoloads.el mechanism which adds package--builtin-versions -;; maintenance to loaddefs.el doesn't work for preloaded packages (such -;; as this one), so we have to do it by hand! -(push (purecopy '(cl-generic 1 0)) package--builtin-versions) - ;; Note: For generic functions that dispatch on several arguments (i.e. those ;; which use the multiple-dispatch feature), we always use the same "tagcodes" ;; and the same set of arguments on which to dispatch. This works, but is diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index db33474c60..b4acd423b8 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -4,6 +4,7 @@ ;; Author: Stefan Monnier ;; Keywords: extensions, lisp, tools +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -37,11 +38,6 @@ ;;; Code: -;; The autoloads.el mechanism which adds package--builtin-versions -;; maintenance to loaddefs.el doesn't work for preloaded packages (such -;; as this one), so we have to do it by hand! -(push (purecopy '(nadvice 1 0)) package--builtin-versions) - (oclosure-define (advice (:predicate advice--p) (:copier advice--cons (cdr)) commit 152c7322c129c34a208a5681e6a05f79b1d5f3ec Author: Brian Cully Date: Sat Sep 24 16:48:01 2022 +0200 * lisp/net/tramp-docker.el: New file. diff --git a/lisp/net/tramp-docker.el b/lisp/net/tramp-docker.el new file mode 100644 index 0000000000..3953e4d272 --- /dev/null +++ b/lisp/net/tramp-docker.el @@ -0,0 +1,125 @@ +;;; tramp-docker.el --- Tramp integration for Docker containers -*- lexical-binding: t; -*- + +;; Copyright © 2022 Free Software Foundation, Inc. + +;; Author: Brian Cully +;; Maintainer: Brian Cully +;; URL: https://git.spork.org/tramp-docker +;; Keywords: tramp, docker +;; Version: 0.99.1 +;; Package-Requires: ((emacs "23")) + +;;; License: + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; +;; ‘tramp-docker’ allows Tramp access to environments provided by +;; Docker. +;; +;; ## Usage +;; +;; Call ‘tramp-docker-setup’ in your Emacs initialization. +;; +;; (add-hook 'after-init-hook 'tramp-docker-setup) +;; +;; Open a file on a running systemd-docker container: +;; +;; C-x C-f /docker:USER@CONTAINER:/path/to/file +;; +;; Where: +;; USER is the user on the container to connect as (optional) +;; CONTAINER is the container to connect to +;; + +;;; Code: + +(require 'tramp) + +(defgroup tramp-docker nil + "Tramp integration for Docker containers." + :prefix "tramp-docker-" + :group 'applications + :link '(url-link :tag "repo" "https://git.spork.org/tramp-docker.git") + :link '(emacs-commentary-link :tag "Commentary" "tramp-docker")) + +(defcustom tramp-docker-program "docker" + "Name of the Docker client program." + :type '(choice (const "docker") + (const "podman") + (string)) + :group 'tramp-docker) + +(defconst tramp-docker-method "docker" + "Tramp method name to use to connect to Docker containers.") + +(defun tramp-docker--completion-function (&rest _args) + "List Docker containers available for connection. + +This function is used by ‘tramp-set-completion-function’, please +see its function help for a description of the format." + (let* ((raw-list (shell-command-to-string + (concat tramp-docker-program + " ps --format '{{.ID}}\t{{.Names}}'"))) + (lines (split-string raw-list "\n")) + (names (mapcar (lambda (line) + (let ((words (split-string line "\t"))) + (or (nth 1 words) (nth 0 words)))) + lines)) + (machines (seq-take-while (lambda (name) name) names))) + (mapcar (lambda (m) (list nil m)) machines))) + +;; todo: check tramp-async-args and tramp-direct-async +(defun tramp-docker--add-method () + "Add Tramp method handler for Docker containers." + (push `(,tramp-docker-method + (tramp-login-program ,tramp-docker-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("/bin/sh"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c"))) + tramp-methods)) + +(defun tramp-docker--remove-method () + "Remove Tramp method handler for docker containers." + (setf (alist-get tramp-docker-method tramp-methods nil t 'string=) nil)) + +(defun tramp-docker-unload-function () + "Remove Tramp method handler and completion functions." + (tramp-set-completion-function tramp-docker-method nil) + (tramp-docker--remove-method) + nil) + +(when nil + (load-file (buffer-file-name)) + (setq tramp-docker-program "doas podman") + (setq tramp-verbose 7) ;; default 3 + (tramp-docker-setup) + (tramp-docker-unload-function)) + +;;;###autoload +(defun tramp-docker-setup () + "Initialize Docker support for Tramp." + (tramp-docker--add-method) + (tramp-set-completion-function tramp-docker-method + '((tramp-docker--completion-function "")))) + +(provide 'tramp-docker) +;;; tramp-docker.el ends here commit c1cead89f5f230d9bd10da54f0e959d2570a037b Author: Stefan Monnier Date: Sat Sep 24 10:38:09 2022 -0400 (event-start/end): Fix part of bug#52092 When synthesizing a posn for keyboard events, make sure the `posn-point` i the same as `point`. * lisp/subr.el (event--posn-at-point): New function. (event-start, event-end): Use it. diff --git a/lisp/subr.el b/lisp/subr.el index 59f9308f31..26fba4771b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1562,6 +1562,21 @@ in the current Emacs session, then this function may return nil." ;; is this really correct? maybe remove mouse-movement? (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))) +(defun event--posn-at-point () + ;; Use `window-point' for the case when the current buffer + ;; is temporarily switched to some other buffer (bug#50256) + (let* ((pos (window-point)) + (posn (posn-at-point pos))) + (if (null posn) ;; `pos' is "out of sight". + (list (selected-window) pos '(0 . 0) 0) + ;; If `pos' is inside a chunk of text hidden by an `invisible' + ;; or `display' property, `posn-at-point' returns the position + ;; that *is* visible, whereas `event--posn-at-point' is used + ;; when we have a keyboard event, whose position is `point' even + ;; if that position is invisible. + (setf (nth 5 posn) pos) + posn))) + (defun event-start (event) "Return the starting position of EVENT. EVENT should be a mouse click, drag, or key press event. If @@ -1588,10 +1603,7 @@ nil or (STRING . POSITION)'. For more information, see Info node `(elisp)Click Events'." (or (and (consp event) (nth 1 event)) - ;; Use `window-point' for the case when the current buffer - ;; is temporarily switched to some other buffer (bug#50256) - (posn-at-point (window-point)) - (list (selected-window) (window-point) '(0 . 0) 0))) + (event--posn-at-point))) (defun event-end (event) "Return the ending position of EVENT. @@ -1599,10 +1611,7 @@ EVENT should be a click, drag, or key press event. See `event-start' for a description of the value returned." (or (and (consp event) (nth (if (consp (nth 2 event)) 2 1) event)) - ;; Use `window-point' for the case when the current buffer - ;; is temporarily switched to some other buffer (bug#50256) - (posn-at-point (window-point)) - (list (selected-window) (window-point) '(0 . 0) 0))) + (event--posn-at-point))) (defsubst event-click-count (event) "Return the multi-click count of EVENT, a click or drag event. commit 0cc107ac090a67a01e237d48ee5c158eb95f6337 Merge: 2bacd9115f 583ebfa414 Author: Stefan Monnier Date: Sat Sep 24 10:32:39 2022 -0400 Merge branch 'emacs-28' commit 583ebfa4148a817e144fe0f517e2ea81530f252c Author: Stefan Monnier Date: Sat Sep 24 10:24:54 2022 -0400 * lisp/progmodes/hideshow.el (hs-toggle-hiding): Fix `interactive` form This fixes the first part of bug#52092, which is a regression introduced by commit d0e9113de97. diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index f574ec84fb..4b23419764 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -740,6 +740,8 @@ and `case-fold-search' are both t." (defun hs-already-hidden-p () "Return non-nil if point is in an already-hidden block, otherwise nil." + ;; FIXME: We should probably also consider ourselves "in" a hidden block + ;; when point is right at the edge after a hidden block (bug#52092). (save-excursion (let ((c-reg (hs-inside-comment-p))) (if (and c-reg (nth 0 c-reg)) @@ -893,7 +895,7 @@ The hook `hs-hide-hook' is run; see `run-hooks'." "Toggle hiding/showing of a block. See `hs-hide-block' and `hs-show-block'. Argument E should be the event that triggered this action." - (interactive) + (interactive (list last-nonmenu-event)) (hs-life-goes-on (posn-set-point (event-end e)) (if (hs-already-hidden-p) commit 2bacd9115f15111a2b229ea21776bab2fd5839b1 Author: Lars Ingebrigtsen Date: Sat Sep 24 15:27:50 2022 +0200 Make dired-do-rename refuse to rename . and .. * lisp/dired-aux.el (dired-do-rename): Refuse to rename . and .. (bug#52004). This used to error out after renaming. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index f870494e93..9add96c260 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2880,6 +2880,10 @@ of `dired-dwim-target', which see. Also see `dired-do-revert-buffer'." (interactive "P") + (when (seq-find (lambda (file) + (member (file-name-nondirectory file) '("." ".."))) + (dired-get-marked-files nil arg)) + (user-error "Can't rename \".\" or \"..\" files")) (dired-do-create-files 'move #'dired-rename-file "Move" arg dired-keep-marker-rename "Rename")) commit 8dacd8cd914fdbe0f6f17ca57915611d48e9124d Author: Lars Ingebrigtsen Date: Sat Sep 24 15:17:23 2022 +0200 Add a new command vc-pull-and-push * lisp/vc/vc-svn.el (vc-exec-after): * lisp/vc/vc-hg.el (vc-exec-after): * lisp/vc/vc-git.el (vc-exec-after): * lisp/vc/vc-cvs.el (vc-exec-after): * lisp/vc/vc-bzr.el (vc-exec-after): * lisp/org/org-macro.el (vc-exec-after): * lisp/obsolete/vc-mtn.el (vc-exec-after): * lisp/obsolete/vc-arch.el (vc-exec-after): Update declaration. * lisp/vc/vc-dispatcher.el (vc--process-sentinel): Allow running code only on success. (vc-exec-after): Ditto. (vc--inhibit-change-window-start): New variable. (vc-do-async-command): Use it to allow chaining commands without moving window point. Return the process instead of the buffer, since the process may have exited already, and then we can't get at the process. * lisp/vc/vc-git.el (vc-git--pushpull): Return the process object. (vc-git-pull-and-push): New function. * lisp/vc/vc.el (vc-pull-and-push): New command (bug#51964). diff --git a/etc/NEWS b/etc/NEWS index fd9fadc51f..037368d1ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1705,6 +1705,11 @@ info node. This command only works for the Emacs and Emacs Lisp manuals. ** VC +--- +*** New command 'vc-pull-and-push'. +This commands first does a "pull" command, and if that is successful, +do a "push" command afterwards. + +++ *** 'C-x v b' prefix key is used now for branch commands. 'vc-print-branch-log' is bound to 'C-x v b l', and new commands are diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index 537d65c658..20835a09d0 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -311,7 +311,7 @@ Only the value `maybe' can be trusted :-(." ;; dir-status-files called from vc-dir, which loads vc, ;; which loads vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (defun vc-arch-dir-status-files (dir _files callback) "Run `tla inventory' for DIR and pass results to CALLBACK. diff --git a/lisp/obsolete/vc-mtn.el b/lisp/obsolete/vc-mtn.el index cd56b29007..4fc496d509 100644 --- a/lisp/obsolete/vc-mtn.el +++ b/lisp/obsolete/vc-mtn.el @@ -141,7 +141,7 @@ switches." ;; dir-status-files called from vc-dir, which loads vc, ;; which loads vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (defun vc-mtn-dir-status-files (dir _files update-function) (vc-mtn-command (current-buffer) 'async dir "status") diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 0921f3aa27..b58c51f3fb 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -66,7 +66,7 @@ (declare-function org-mode "org" ()) (declare-function vc-backend "vc-hooks" (f)) (declare-function vc-call "vc-hooks" (fun file &rest args) t) -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (defvar org-link-search-must-match-exact-headline) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index f6b17d4ce0..bce7996712 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -339,7 +339,7 @@ in the repository root directory of FILE." "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.") ;; To be called via vc-pull from vc.el, which requires vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) (declare-function vc-compilation-mode "vc-dispatcher" (backend)) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 52cc42791f..2dd3d416ac 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -545,7 +545,7 @@ Will fail unless you have administrative privileges on the repo." ;;; ;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit) "Print commit log associated with FILES into specified BUFFER. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 459c2ae103..b4493ce40e 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -197,7 +197,7 @@ Another is that undo information is not kept." (defvar vc-sentinel-movepoint) ;Dynamically scoped. -(defun vc--process-sentinel (p code) +(defun vc--process-sentinel (p code &optional success) (let ((buf (process-buffer p))) ;; Impatient users sometime kill "slow" buffers; check liveness ;; to avoid "error in process sentinel: Selecting deleted buffer". @@ -218,7 +218,7 @@ Another is that undo information is not kept." ;; each sentinel read&set process-mark, but since `cmd' needs ;; to work both for async and sync processes, this would be ;; difficult to achieve. - (vc-exec-after code) + (vc-exec-after code success) (move-marker m (point))) ;; But sometimes the sentinels really want to move point. (when vc-sentinel-movepoint @@ -235,11 +235,14 @@ Another is that undo information is not kept." 'help-echo "A command is in progress in this buffer")))) -(defun vc-exec-after (code) +(defun vc-exec-after (code &optional success) "Eval CODE when the current buffer's process is done. If the current buffer has no process, just evaluate CODE. Else, add CODE to the process' sentinel. -CODE should be a function of no arguments." +CODE should be a function of no arguments. + +If SUCCESS, it should be a process object. Only run CODE if the +SUCCESS process has a zero exit code." (let ((proc (get-buffer-process (current-buffer)))) (cond ;; If there's no background process, just execute the code. @@ -250,13 +253,15 @@ CODE should be a function of no arguments." ((or (null proc) (eq (process-status proc) 'exit)) ;; Make sure we've read the process's output before going further. (when proc (accept-process-output proc)) - (if (functionp code) (funcall code) (eval code t))) + (when (or (not success) + (zerop (process-exit-status success))) + (if (functionp code) (funcall code) (eval code t)))) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) (vc-set-mode-line-busy-indicator) (letrec ((fun (lambda (p _msg) (remove-function (process-sentinel p) fun) - (vc--process-sentinel p code)))) + (vc--process-sentinel p code success)))) (add-function :after (process-sentinel proc) fun))) (t (error "Unexpected process state")))) nil) @@ -410,11 +415,14 @@ case, and the process object in the asynchronous case." command file-or-list flags)) status)))) +(defvar vc--inhibit-change-window-start nil) + (defun vc-do-async-command (buffer root command &rest args) "Run COMMAND asynchronously with ARGS, displaying the result. Send the output to BUFFER, which should be a buffer or the name of a buffer, which is created. ROOT should be the directory in which the command should be run. +The process object is returned. Display the buffer in some window, but don't select it." (letrec ((dir default-directory) (inhibit-read-only t) @@ -428,7 +436,9 @@ Display the buffer in some window, but don't select it." (dolist (arg args) (insert " " arg)) (insert "\"...\n"))) - (window nil) (new-window-start nil)) + (window nil) + (new-window-start nil) + (proc nil)) (setq buffer (get-buffer-create buffer)) (if (get-buffer-process buffer) (error "Another VC action on %s is running" root)) @@ -437,11 +447,12 @@ Display the buffer in some window, but don't select it." (add-hook 'vc-pre-command-functions fun) ;; Run in the original working directory. (let ((default-directory dir)) - (apply #'vc-do-command t 'async command nil args))) + (setq proc (apply #'vc-do-command t 'async command nil args)))) (setq window (display-buffer buffer)) - (if window - (set-window-start window new-window-start)) - buffer)) + (when (and window + (not vc--inhibit-change-window-start)) + (set-window-start window new-window-start)) + proc)) (defvar compilation-error-regexp-alist) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 3816d323e6..18cc4a66ad 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -624,7 +624,7 @@ or an empty string if none." ;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command ;; from vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) ;; Follows vc-exec-after. (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) @@ -1098,7 +1098,8 @@ If PROMPT is non-nil, prompt for the Git command to run." (buffer (format "*vc-git : %s*" (expand-file-name root))) (git-program vc-git-program) ;; TODO if pushing, prompt if no default push location - cf bzr. - (vc-want-edit-command-p prompt)) + (vc-want-edit-command-p prompt) + proc) (require 'vc-dispatcher) (when vc-want-edit-command-p (with-current-buffer (get-buffer-create buffer) @@ -1108,8 +1109,8 @@ If PROMPT is non-nil, prompt for the Git command to run." command (caaddr args) extra-args (cdaddr args))) nil t))) - (apply #'vc-do-async-command - buffer root git-program command extra-args) + (setq proc (apply #'vc-do-async-command + buffer root git-program command extra-args)) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) @@ -1124,7 +1125,8 @@ If PROMPT is non-nil, prompt for the Git command to run." (list compile-command nil (lambda (_name-of-mode) buffer) nil)))) - (vc-set-async-update buffer))) + (vc-set-async-update buffer) + proc)) (defun vc-git-pull (prompt) "Pull changes into the current Git branch. @@ -1138,6 +1140,25 @@ Normally, this runs \"git push\". If PROMPT is non-nil, prompt for the Git command to run." (vc-git--pushpull "push" prompt nil)) +(defun vc-git-pull-and-push (prompt) + "Pull changes into the current Git branch, and then push. +The push will only be performed if the pull was successful. + +Normally, this runs \"git pull\". If PROMPT is non-nil, prompt +for the Git command to run." + (let ((proc (vc-git--pushpull "pull" prompt '("--stat")))) + (when (process-buffer proc) + (with-current-buffer (process-buffer proc) + (if (and (eq (process-status proc) 'exit) + (zerop (process-exit-status proc))) + (let ((vc--inhibit-change-window-start t)) + (vc-git-push nil)) + (vc-exec-after + (lambda () + (let ((vc--inhibit-change-window-start t)) + (vc-git-push nil))) + proc)))))) + (defun vc-git-merge-branch () "Merge changes into the current Git branch. This prompts for a branch to merge from." diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index f4a44df3c2..eed9592378 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1345,7 +1345,7 @@ REV is the revision to check out into WORKFILE." ;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command ;; from vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) ;; Follows vc-exec-after. (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 08b53a7169..9c2bdf6674 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -207,7 +207,7 @@ switches." ;; dir-status-files called from vc-dir, which loads vc, ;; which loads vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (autoload 'vc-expand-dirs "vc") diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a45e0e0c52..4ebcd3ae16 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2975,6 +2975,28 @@ It also signals an error in a Bazaar bound branch." (vc-call-backend backend 'push arg) (user-error "VC push is unsupported for `%s'" backend)))) +;;;###autoload +(defun vc-pull-and-push (&optional arg) + "First pull, and then push the current branch. +The push will only be performed if the pull operation was successful. + +You must be visiting a version controlled file, or in a `vc-dir' buffer. + +On a distributed version control system, this runs a \"pull\" +operation on the current branch, prompting for the precise +command if required. Optional prefix ARG non-nil forces a prompt +for the VCS command to run. If this is successful, a \"push\" +operation will then be done. + +On a non-distributed version control system, this signals an error. +It also signals an error in a Bazaar bound branch." + (interactive "P") + (let* ((vc-fileset (vc-deduce-fileset t)) + (backend (car vc-fileset))) + (if (vc-find-backend-function backend 'pull-and-push) + (vc-call-backend backend 'pull-and-push arg) + (user-error "VC pull-and-push is unsupported for `%s'" backend)))) + (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. If version backups should be used for FILE, and there exists commit 3ce322efef3c57b83d0f243c6f0d4f560d50fe7a Author: Lars Ingebrigtsen Date: Sat Sep 24 15:07:17 2022 +0200 Tweak binding of `+' in vc-dir * lisp/vc/vc-dir.el (vc-dir-mode-map): Point to the actual function instead of the alias. This makes *Help* more helpful. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index b4568727ea..037de415e6 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -266,7 +266,7 @@ See `run-hooks'." :enable (vc-find-backend-function vc-dir-backend 'push) :help "Push the current branch's changes")) (define-key map [update] - '(menu-item "Update to Latest Version" vc-update + '(menu-item "Update to Latest Version" vc-pull :help "Update the current fileset's files to their tip revisions")) (define-key map [revert] '(menu-item "Revert to Base Version" vc-revert @@ -306,8 +306,8 @@ See `run-hooks'." (define-key map "=" #'vc-diff) ;; C-x v = (define-key map "D" #'vc-root-diff) ;; C-x v D (define-key map "i" #'vc-register) ;; C-x v i - (define-key map "+" #'vc-update) ;; C-x v + - ;; I'd prefer some kind of symmetry with vc-update: + (define-key map "+" #'vc-pull) ;; C-x v + + ;; I'd prefer some kind of symmetry with vc-pull: (define-key map "P" #'vc-push) ;; C-x v P (define-key map "l" #'vc-print-log) ;; C-x v l (define-key map "L" #'vc-print-root-log) ;; C-x v L commit e4b1445f4301a4a672442d29f93983d804a80982 Author: Alan Mackenzie Date: Sat Sep 24 12:23:32 2022 +0000 CC Mode. Make AWK Mode work with electric-pair-mode Also fix some minor anomalies with other CC Mode modes in electric-pair-mode. This fixes bug #53446. * lisp/progmodes/cc-mode.el (c-open-string-opener): New buffer local variable. (c-after-change-mark-abnormal-strings): Set c-open-string-opener when an unbalanced string is detected. (c-before-change): Initilize c-open-string-opener to nil, each buffer change. (c-electric-pair-inhibit-predicate): Use the value of c-open-string-opener to flag an unbalaced string rather than trying to calculate it again. * lisp/progmodes/cc-awk.el (c-awk-syntax-tablify-string): Set c-open-string-opener when an unbalanced string is detected. diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 57750a2b39..089fa9ffe4 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -56,6 +56,7 @@ ;; Silence the byte compiler. (cc-bytecomp-defvar c-new-BEG) (cc-bytecomp-defvar c-new-END) +(cc-bytecomp-defvar c-open-string-opener) (cc-bytecomp-defun c-restore-string-fences) (cc-bytecomp-defun c-clear-string-fences) @@ -777,16 +778,20 @@ ;; opener, t if it would be a division sign. ;; ;; This function does hidden buffer changes. - (search-forward-regexp c-awk-string-without-end-here-re nil t) ; a (possibly unterminated) string - (c-awk-set-string-regexp-syntax-table-properties - (match-beginning 0) (match-end 0)) - (cond ((looking-at "\"") - (forward-char) - t) ; In AWK, ("15" / 5) gives 3 ;-) - ((looking-at "[\n\r]") ; Unterminated string with EOL. - (forward-char) - nil) ; / on next line would start a regexp - (t nil))) ; Unterminated string at EOB + (let ((string-start (if (eq (char-after) ?_) (1+ (point)) (point)))) + (search-forward-regexp c-awk-string-without-end-here-re nil t) ; a (possibly unterminated) string + (c-awk-set-string-regexp-syntax-table-properties + (match-beginning 0) (match-end 0)) + (cond ((looking-at "\"") + (forward-char) + t) ; In AWK, ("15" / 5) gives 3 ;-) + ((looking-at "[\n\r]") ; Unterminated string with EOL. + (setq c-open-string-opener string-start) + (forward-char) + nil) ; / on next line would start a regexp + (t ; Unterminated string at EOB + (setq c-open-string-opener string-start) + nil)))) (defun c-awk-syntax-tablify-/ (anchor anchor-state-/div) ;; Point is at a /. Determine whether this is a division sign or a regexp diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 9309a546db..15dfdc4b0e 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1421,6 +1421,13 @@ Note that the style variables are always made local to the buffer." (c-clear-syn-tab (point))) (t (c-benign-error "c-remove-string-fences: Wrong position"))))) +(defvar c-open-string-opener nil + "The position of the opening delimiter of an unterminated string or nil. +This is valid only immediately after a buffer change, and refers +only to an opener in the (logical) line containing the END +position of `after-change-functions'.") +(make-variable-buffer-local 'c-open-string-opener) + (defun c-before-change-check-unbalanced-strings (beg end) ;; If BEG or END is inside an unbalanced string, remove the syntax-table ;; text property from respectively the start or end of the string. Also @@ -1685,13 +1692,14 @@ Note that the style variables are always made local to the buffer." (c-put-syn-tab (1- (point)) '(15)) (c-put-syn-tab (match-end 0) '(15)) (setq c-new-BEG (min c-new-BEG (point)) - c-new-END (max c-new-END (match-end 0)))) + c-new-END (max c-new-END (match-end 0))) + (setq c-open-string-opener (1- (point)))) ((or (eq (match-end 0) (point-max)) (eq (char-after (match-end 0)) ?\\)) ; \ at EOB (c-put-syn-tab (1- (point)) '(15)) (setq c-new-BEG (min c-new-BEG (point)) c-new-END (max c-new-END (match-end 0))) ; Do we need c-new-END? - )) + (setq c-open-string-opener (1- (point))))) (goto-char (min (1+ (match-end 0)) (point-max)))) (setq s nil))))) @@ -2130,6 +2138,7 @@ with // and /*, not more generic line and block comments." ;; (c-new-BEG c-new-END) will be the region to fontify. (setq c-new-BEG beg c-new-END end) (setq c-maybe-stale-found-type nil) + (setq c-open-string-opener nil) ;; A workaround for syntax-ppss's failure to notice syntax-table text ;; property changes. (when (fboundp 'syntax-ppss) @@ -2698,11 +2707,9 @@ 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 \" 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. +the quotes on the current line are already balanced. 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 @@ -2710,11 +2717,7 @@ invalid strings with such a syntax table text property on the opening \" and the next unescaped end of line." (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)))) + (not c-open-string-opener) (funcall (default-value 'electric-pair-inhibit-predicate) char))) commit 1556b4376457db409a0a15765e89b2a209007d7b Author: Visuwesh Date: Sat Sep 24 14:09:53 2022 +0200 docview: Use svg images when using mupdf for conversion * lisp/doc-view.el (doc-view-mupdf-use-svg, doc-view-svg-background) (doc-view-svg-foreground): New user options. (doc-view-insert-image): Add :background and :foreground image attributes when display svg images. (doc-view-set-up-single-converter): Produce svg images when using mupdf (bug#58041). diff --git a/lisp/doc-view.el b/lisp/doc-view.el index aa0f9fd383..fbd1427946 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -209,6 +209,23 @@ are available (see Info node `(emacs)Document View')." function) :version "24.4") +(defcustom doc-view-mupdf-use-svg (image-type-available-p 'svg) + "Whether to use svg images for PDF files." + :type 'boolean + :version "29.1") + +(defcustom doc-view-svg-background "white" + "Background color for svg images. +See `doc-view-mupdf-use-svg'." + :type 'color + :version "29.1") + +(defcustom doc-view-svg-foreground "black" + "Foreground color for svg images. +See `doc-view-mupdf-use-svg'." + :type 'color + :version "29.1") + (defcustom doc-view-ghostscript-options '("-dSAFER" ;; Avoid security problems when rendering files from untrusted ;; sources. @@ -1562,6 +1579,9 @@ ARGS is a list of image descriptors." (setq args `(,@args :width ,doc-view-image-width))) (unless (member :transform-smoothing args) (setq args `(,@args :transform-smoothing t))) + (when (eq doc-view--image-type 'svg) + (setq args `(,@args :background ,doc-view-svg-background + :foreground ,doc-view-svg-foreground))) (apply #'create-image file doc-view--image-type nil args)))) (slice (doc-view-current-slice)) (img-width (and image (car (image-size image)))) @@ -1983,7 +2003,11 @@ If BACKWARD is non-nil, jump to the previous match." (pcase-let ((`(,conv-function ,type ,extension) (pcase doc-view-doc-type ('djvu (list #'doc-view-djvu->tiff-converter-ddjvu 'tiff "tif")) - (_ (list doc-view-pdf->png-converter-function 'png "png"))))) + (_ (if (and (eq doc-view-pdf->png-converter-function + #'doc-view-pdf->png-converter-mupdf) + doc-view-mupdf-use-svg) + (list doc-view-pdf->png-converter-function 'svg "svg") + (list doc-view-pdf->png-converter-function 'png "png")))))) (setq-local doc-view-single-page-converter-function conv-function) (setq-local doc-view--image-type type) (setq-local doc-view--image-file-pattern (concat "page-%s." extension)))) commit 5be35812acc0756f2f8e370e3aff2275fdf3a7ea Author: Stefan Kangas Date: Sat Sep 24 14:07:55 2022 +0200 image-dired: Prefer command remapping * lisp/image/image-dired.el (image-dired-thumbnail-mode-map): Prefer command remapping to binding keys directly. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index f73b81c22d..dd434ce6ff 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -843,20 +843,6 @@ You probably want to use this together with (defvar-keymap image-dired-thumbnail-mode-map :doc "Keymap for `image-dired-thumbnail-mode'." - "" #'image-dired-forward-image - "" #'image-dired-backward-image - "" #'image-dired-previous-line - "" #'image-dired-next-line - "C-f" #'image-dired-forward-image - "C-b" #'image-dired-backward-image - "C-p" #'image-dired-previous-line - "C-n" #'image-dired-next-line - - "<" #'image-dired-beginning-of-buffer - ">" #'image-dired-end-of-buffer - "M-<" #'image-dired-beginning-of-buffer - "M->" #'image-dired-end-of-buffer - "d" #'image-dired-flag-thumb-original-file "" #'image-dired-flag-thumb-original-file "m" #'image-dired-mark-thumb-original-file @@ -897,6 +883,12 @@ You probably want to use this together with "C-" #'ignore ; Don't open the buffer menu. "C-" #'image-dired-mouse-toggle-mark + " " #'image-dired-forward-image + " " #'image-dired-backward-image + " " #'image-dired-next-line + " " #'image-dired-previous-line + " " #'image-dired-beginning-of-buffer + " " #'image-dired-end-of-buffer " " #'image-dired-move-beginning-of-line " " #'image-dired-move-end-of-line) commit 0bca1b4d037ef23d259dc6e7561266bf54433339 Author: Stefan Kangas Date: Sat Sep 24 13:36:39 2022 +0200 image-dired: Fix C-a/C-e in thumbnail buffer * lisp/image/image-dired.el (image-dired--movement-ensure-point-pos): New function, and... (image-dired--movement-command): ...new macros broken out from... (image-dired-next-line, image-dired-previous-line) (image-dired-beginning-of-buffer, image-dired-end-of-buffer): ...here. (image-dired-move-beginning-of-line) (image-dired-move-end-of-line): New commands. (image-dired-thumbnail-mode-map): Remap 'move-beginning-of-line' and 'move-beginning-of-line' to above new commands. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index c25dcad769..f73b81c22d 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -655,56 +655,57 @@ On reaching end or beginning of buffer, stop and show a message." (interactive "p" image-dired-thumbnail-mode) (image-dired-forward-image (- (or arg 1)))) +(defun image-dired--movement-ensure-point-pos (&optional reverse) + "Ensure point is on an image." + (while (and (not (image-at-point-p)) + (not (if reverse (bobp) (eobp)))) + (forward-char (if reverse -1 1)))) + +(defmacro image-dired--movement-command (to &optional reverse) + `(progn + (goto-char ,to) + (image-dired--movement-ensure-point-pos ,reverse) + (when image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-update-header-line))) + +(defmacro image-dired--movement-command-line (&optional reverse) + `(image-dired--movement-command + (let ((goal-column (current-column))) + (forward-line ,(if reverse -1 1)) + (move-to-column goal-column) + (point)) + ,reverse)) + (defun image-dired-next-line () "Move to next line in the thumbnail buffer." (interactive nil image-dired-thumbnail-mode) - (let ((goal-column (current-column))) - (forward-line 1) - (move-to-column goal-column)) - ;; If we end up in an empty spot, back up to the next thumbnail. - (if (not (image-dired-image-at-point-p)) - (image-dired-backward-image)) - (if image-dired-track-movement - (image-dired-track-original-file)) - (image-dired-update-header-line)) + (image-dired--movement-command-line)) (defun image-dired-previous-line () "Move to previous line in the thumbnail buffer." (interactive nil image-dired-thumbnail-mode) - (let ((goal-column (current-column))) - (forward-line -1) - (move-to-column goal-column)) - ;; If we end up in an empty spot, back up to the next thumbnail. - ;; This should only happen if the user deleted a thumbnail and did - ;; not refresh, so it is not very common. But we can handle it in a - ;; good manner, so why not? - (if (not (image-dired-image-at-point-p)) - (image-dired-backward-image)) - (if image-dired-track-movement - (image-dired-track-original-file)) - (image-dired-update-header-line)) + (image-dired--movement-command-line 'reverse)) (defun image-dired-beginning-of-buffer () "Move to the first image in the thumbnail buffer." (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-update-header-line)) + (image-dired--movement-command (point-min))) (defun image-dired-end-of-buffer () "Move to the last image in the thumbnail buffer." (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-update-header-line)) + (image-dired--movement-command (point-max) 'reverse)) + +(defun image-dired-move-beginning-of-line () + "Move to the beginning of current line in thumbnail buffer." + (interactive nil image-dired-thumbnail-mode) + (image-dired--movement-command (pos-bol))) + +(defun image-dired-move-end-of-line () + "Move to the end of current line in thumbnail buffer." + (interactive nil image-dired-thumbnail-mode) + (image-dired--movement-command (pos-eol) 'reverse)) ;;; Header line @@ -894,7 +895,10 @@ You probably want to use this together with "" #'image-dired-mouse-select-thumbnail "" #'image-dired-mouse-select-thumbnail "C-" #'ignore ; Don't open the buffer menu. - "C-" #'image-dired-mouse-toggle-mark) + "C-" #'image-dired-mouse-toggle-mark + + " " #'image-dired-move-beginning-of-line + " " #'image-dired-move-end-of-line) (easy-menu-define image-dired-thumbnail-mode-menu image-dired-thumbnail-mode-map "Menu for `image-dired-thumbnail-mode'." commit 32e736d903f65a74af2bbf0d3b7bd7ee60ee5837 Author: Stefan Kangas Date: Sat Sep 24 13:22:59 2022 +0200 Make thumbs.el obsolete * lisp/obsolete/thumbs.el: Add Obsolete-since. * etc/NEWS: Announce obsoletion of thumbs.el. (Bug#57779) diff --git a/etc/NEWS b/etc/NEWS index ff97c2350f..fd9fadc51f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -398,6 +398,10 @@ We recommend using either the built-in 'display-line-numbers-mode', or the 'nlinum' package from GNU ELPA instead. The former has better performance, but the latter is closer to a drop-in replacement. +--- +** The thumbs.el library is now obsolete. +We recommend using `M-x image-dired' instead. + --- ** The autoarg.el library is now marked obsolete. This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor diff --git a/lisp/obsolete/thumbs.el b/lisp/obsolete/thumbs.el index a9ff9f5ebc..a98b339b47 100644 --- a/lisp/obsolete/thumbs.el +++ b/lisp/obsolete/thumbs.el @@ -5,6 +5,7 @@ ;; Author: Jean-Philippe Theberge ;; Maintainer: emacs-devel@gnu.org ;; Keywords: Multimedia +;; Obsolete-since: 29.1 ;; This file is part of GNU Emacs. @@ -23,6 +24,11 @@ ;;; Commentary: +;; NOTE: This library was made obsolete in Emacs 29.1. +;; We recommend using `M-x image-dired' instead. +;; +;; -------------------- +;; ;; This package create two new modes: `thumbs-mode' and `thumbs-view-image-mode'. ;; It is used for basic browsing and viewing of images from within Emacs. ;; Minimal image manipulation functions are also available via external @@ -387,6 +393,7 @@ and SAME-WINDOW to show thumbs in the same window." ;;;###autoload (defalias 'thumbs 'thumbs-show-from-dir) +(make-obsolete 'thumbs 'image-dired "29.1") (defun thumbs-find-image (img &optional num otherwin) (let ((buffer (current-buffer))) commit 4b537dd99f686e65e7ba0295eb157841e0d442e5 Author: Stefan Kangas Date: Sat Sep 24 13:18:38 2022 +0200 Move thumbs.el to lisp/obsolete * lisp/thumbs.el: * test/lisp/thumbs-tests.el: Move from here... * lisp/obsolete/thumbs.el: * test/lisp/obsolete/thumbs-tests.el: ...to here. (Bug#57779) diff --git a/lisp/thumbs.el b/lisp/obsolete/thumbs.el similarity index 100% rename from lisp/thumbs.el rename to lisp/obsolete/thumbs.el diff --git a/test/lisp/thumbs-tests.el b/test/lisp/obsolete/thumbs-tests.el similarity index 100% rename from test/lisp/thumbs-tests.el rename to test/lisp/obsolete/thumbs-tests.el commit 95d4f5d691c2c75aefdbd328b0fe251e824efa6c Author: Stefan Kangas Date: Sat Sep 24 13:08:11 2022 +0200 image-dired: Regenerate old thumbnails when needed * lisp/image/image-dired.el (image-dired--get-create-thumbnail-file): Rename from 'image-dired-get-thumbnail-image'. Update callers and make old name into an obsolete alias. (image-dired-display-thumbs): Use above function to simplify and regenerate the thumbnail if it's outdated. diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index 73434c6062..d4574ca0bc 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -70,7 +70,8 @@ previous -ARG, if ARG<0) files." overlay) (when (and image-file (string-match-p (image-dired--file-name-regexp) image-file)) - (setq thumb-file (image-dired-get-thumbnail-image image-file)) + (setq thumb-file (create-image + (image-dired--get-create-thumbnail-file image-file))) ;; If image is not already added, then add it. (let ((thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point))) if (overlay-get ov 'thumb-file) return ov))) diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 7c6d910b42..c25dcad769 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -375,18 +375,21 @@ This affects the following commands: :margin ,margin))) (insert-image i))) -(defun image-dired-get-thumbnail-image (file) +(defun image-dired--get-create-thumbnail-file (file) "Return the image descriptor for a thumbnail of image file FILE." (unless (string-match-p (image-dired--file-name-regexp) file) (error "%s is not a valid image file" file)) (let* ((thumb-file (image-dired-thumb-name file)) (thumb-attr (file-attributes thumb-file))) - (when (or (not thumb-attr) - (time-less-p (file-attribute-modification-time thumb-attr) - (file-attribute-modification-time - (file-attributes file)))) - (image-dired-create-thumb file thumb-file)) - (create-image thumb-file))) + (if (or (not thumb-attr) + (time-less-p (file-attribute-modification-time thumb-attr) + (file-attribute-modification-time + (file-attributes file)))) + (image-dired-create-thumb file thumb-file) + (image-dired-debug "Found thumb for %s: %s" + (file-name-nondirectory file) + (file-name-nondirectory thumb-file))) + thumb-file)) (defun image-dired-insert-thumbnail ( file original-file-name associated-dired-buffer) @@ -531,7 +534,7 @@ thumbnail buffer to be selected." (interactive "P" nil dired-mode) (setq image-dired--generate-thumbs-start (current-time)) (let ((buf (image-dired-create-thumbnail-buffer)) - thumb-name files dired-buf) + files dired-buf) (if arg (setq files (list (dired-get-filename))) (setq files (dired-get-marked-files))) @@ -541,11 +544,9 @@ thumbnail buffer to be selected." (if (not append) (erase-buffer) (goto-char (point-max))) - (dolist (curr-file files) - (setq thumb-name (image-dired-thumb-name curr-file)) - (when (not (file-exists-p thumb-name)) - (image-dired-create-thumb curr-file thumb-name)) - (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) + (dolist (file files) + (let ((thumb (image-dired--get-create-thumbnail-file file))) + (image-dired-insert-thumbnail thumb file dired-buf)))) (if do-not-pop (display-buffer buf) (pop-to-buffer buf)) @@ -1872,6 +1873,7 @@ when using per-directory thumbnail file storage")) (define-obsolete-function-alias 'image-dired-slideshow-stop #'image-dired--slideshow-stop "29.1") (define-obsolete-function-alias 'image-dired-create-display-image-buffer #'ignore "29.1") +;; These can't use the #' quote as they point to obsolete names. (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 @@ -1882,6 +1884,8 @@ when using per-directory thumbnail file storage")) 'image-dired--hidden-p "29.1") (define-obsolete-function-alias 'image-dired-thumb-update-marks #'image-dired--thumb-update-marks "29.1") +(define-obsolete-function-alias 'image-dired-get-thumbnail-image + #'image-dired--get-create-thumbnail-file "29.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;; TEST-SECTION ;;;;;;;;;;; commit 16681ba91cbd673b395cacf38f1603520eddba37 Author: Stefan Kangas Date: Sat Sep 24 12:44:11 2022 +0200 image-dired: Improve performance of marking commands * lisp/image/image-dired.el (image-dired-thumbnail-storage): Mark (image-dired--thumb-update-mark-at-point): New function. (image-dired--thumb-update-marks): (image-dired--do-mark-command): Use it. (image-dired--thumb-update-marks): Rename from 'image-dired-thumb-update-marks'. Update all callers and make the old name into an obsolete alias. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index d84734f4d4..7c6d910b42 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -776,18 +776,21 @@ Should be called from commands in `image-dired-thumbnail-mode'." ,@body)) (user-error "No such buffer: %s" image-dired-thumbnail-buffer))) -(defmacro image-dired--do-mark-command (maybe-next update &rest body) - "Helper macro for the mark, unmark and flag commands. -Run BODY in Dired buffer. +(defmacro image-dired--do-mark-command (maybe-next update-mark &rest body) + "Run BODY in Dired buffer. +Helper macro for the mark, unmark and flag commands. + If MAYBE-NEXT is non-nil, show next image according to `image-dired-marking-shows-next'. -If UPDATE is non-nil, call `image-dired-thumb-update-marks' too." + +If UPDATE-MARK is non-nil, also update the mark in the thumbnail +buffer with `image-dired--thumb-update-mark-at-point'." (declare (indent defun) (debug t)) `(image-dired--with-thumbnail-buffer (image-dired--on-file-in-dired-buffer ,@body) - ,(when update - '(image-dired-thumb-update-marks)) + ,(when update-mark + '(image-dired--thumb-update-mark-at-point)) ,(when maybe-next '(if image-dired-marking-shows-next (image-dired-display-next-thumbnail-original) @@ -818,7 +821,7 @@ Also update the marks in the thumbnail buffer." (image-dired--do-mark-command nil t (dired-unmark-all-marks)) (image-dired--with-thumbnail-buffer - (image-dired-thumb-update-marks))) + (image-dired--thumb-update-marks))) (defun image-dired-jump-original-dired-buffer () "Jump to the Dired buffer associated with the current image file. @@ -1287,7 +1290,18 @@ for deletion instead." (image-dired--on-file-in-dired-buffer (dired-do-delete))) -(defun image-dired-thumb-update-marks () +(defun image-dired--thumb-update-mark-at-point () + (with-silent-modifications + (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)))))) + +(defun image-dired--thumb-update-marks () "Update the marks in the thumbnail buffer." (when image-dired-thumb-visible-marks (with-current-buffer image-dired-thumbnail-buffer @@ -1295,15 +1309,7 @@ for deletion instead." (goto-char (point-min)) (let ((inhibit-read-only t)) (while (not (eobp)) - (with-silent-modifications - (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))))) + (image-dired--thumb-update-mark-at-point) (forward-char 2))))))) (defun image-dired-mouse-toggle-mark-1 () @@ -1334,7 +1340,7 @@ Track this in associated Dired buffer if (mouse-set-point event) (goto-char (posn-point (event-end event))) (image-dired-mouse-toggle-mark-1)) - (image-dired-thumb-update-marks)) + (image-dired--thumb-update-marks)) ;;; bookmark.el support @@ -1580,7 +1586,7 @@ Dired." (dired-unmark 1) (dired-mark 1))) ((eq command 'flag) (dired-flag-file-deletion 1))) - (image-dired-thumb-update-marks)))))) + (image-dired--thumb-update-marks)))))) (defun image-dired-display-current-image-full () "Display current image in full size." @@ -1874,6 +1880,8 @@ when using per-directory thumbnail file storage")) 'image-dired--add-to-tag-file-lists "29.1") (define-obsolete-function-alias 'image-dired-hidden-p 'image-dired--hidden-p "29.1") +(define-obsolete-function-alias 'image-dired-thumb-update-marks + #'image-dired--thumb-update-marks "29.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;; TEST-SECTION ;;;;;;;;;;; commit 3d75bab0e5c00b85f0b27cd4dbfbba2f1db7ffe7 Author: Stefan Kangas Date: Sat Sep 24 12:38:41 2022 +0200 image-dired: Mark 'per-directory' as :safe * lisp/image/image-dired.el (image-dired-thumbnail-storage): Mark 'per-directory' value as :safe. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 07c76a2a1f..d84734f4d4 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -209,6 +209,7 @@ https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html (const :tag "Thumbnail Managing Standard (extra large 1024x1024)" standard-xx-large) (const :tag "Per-directory" per-directory)) + :safe (lambda (value) (eq value 'per-directory)) :version "29.1") (define-obsolete-variable-alias 'image-dired-db-file commit 61b877237baa381430cab554cbd4b4c5838095dc Author: Stefan Kangas Date: Sat Sep 24 11:49:46 2022 +0200 Add new macro image-dired--with-dired-buffer * lisp/image/image-dired-util.el (image-dired--with-dired-buffer): New macro. * lisp/image/image-dired.el (image-dired-track-original-file) (image-dired--on-file-in-dired-buffer) (image-dired--do-mark-command) (image-dired--on-file-in-dired-buffer) (image-dired-jump-original-dired-buffer) (image-dired-thumb-file-marked-p, image-dired-delete-marked): Use above new macro to simplify and improve error handling. (image-dired-show-all-from-dir): Simplify removing Dired marks. (image-dired-thumb-update-marks): Avoid triggering above new error handling. diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el index 8d77a97dc4..f8e81d2e8d 100644 --- a/lisp/image/image-dired-util.el +++ b/lisp/image/image-dired-util.el @@ -118,6 +118,21 @@ See also `image-dired-thumbnail-storage'." "Get associated Dired buffer at point." (get-text-property (point) 'associated-dired-buffer)) +(defmacro image-dired--with-dired-buffer (&rest body) + "Run BODY in associated Dired buffer. +Should be used by commands in `image-dired-thumbnail-mode'." + (declare (indent defun) (debug t)) + (let ((file (make-symbol "file")) + (dired-buf (make-symbol "dired-buf"))) + `(let ((,file (image-dired-original-file-name)) + (,dired-buf (image-dired-associated-dired-buffer))) + (unless ,file + (error "No image at point")) + (unless (and ,dired-buf (buffer-live-p ,dired-buf)) + (error "Cannot find associated Dired buffer for image: %s" ,file)) + (with-current-buffer ,dired-buf + ,@body)))) + (defun image-dired-get-buffer-window (buf) "Return window where buffer BUF is." (get-window-with-predicate diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index c471be86bb..07c76a2a1f 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -574,10 +574,11 @@ never ask for confirmation." "Directory contains more than %d image files. Proceed?" image-dired-show-all-from-dir-max-files)))) (image-dired-display-thumbs) + (let ((inhibit-message t)) + (dired-unmark-all-marks)) (pop-to-buffer image-dired-thumbnail-buffer) (setq default-directory dir) - (image-dired-update-header-line) - (image-dired-unmark-all-marks)) + (image-dired-update-header-line)) (t (message "Image-Dired canceled"))))) ;;;###autoload @@ -588,17 +589,15 @@ never ask for confirmation." (defun image-dired-track-original-file () "Track the original file in the associated Dired buffer. -See documentation for `image-dired-toggle-movement-tracking'. -Interactive use only useful if `image-dired-track-movement' is nil." +See `image-dired-toggle-movement-tracking'. Interactive use is +only useful if `image-dired-track-movement' is nil." (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) - (let* ((dired-buf (image-dired-associated-dired-buffer)) - (file-name (image-dired-original-file-name)) - (window (image-dired-get-buffer-window dired-buf))) - (and (buffer-live-p dired-buf) file-name - (with-current-buffer dired-buf - (if (not (dired-goto-file file-name)) - (message "Could not track file") - (if window (set-window-point window (point)))))))) + (let ((file-name (image-dired-original-file-name))) + (image-dired--with-dired-buffer + (if (not (dired-goto-file file-name)) + (message "Could not find image in Dired buffer for tracking") + (when-let (window (image-dired-get-buffer-window (current-buffer))) + (set-window-point window (point))))))) (defun image-dired-toggle-movement-tracking () "Turn on and off `image-dired-track-movement'. @@ -760,13 +759,11 @@ for. The default is to look for `dired-marker-char'." "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 t)) - `(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 + `(if-let ((file-name (image-dired-original-file-name))) + (image-dired--with-dired-buffer (when (dired-goto-file file-name) - ,@body))))) + ,@body)) + (message "No image with correct properties at point"))) (defmacro image-dired--with-thumbnail-buffer (&rest body) (declare (indent defun) (debug t)) @@ -827,15 +824,13 @@ Also update the marks in the thumbnail buffer." You probably want to use this together with `image-dired-track-original-file'." (interactive nil image-dired-thumbnail-mode) - (let ((buf (image-dired-associated-dired-buffer)) - window frame) - (setq window (image-dired-get-buffer-window buf)) - (if window + (image-dired--with-dired-buffer + (if-let ((window (image-dired-get-buffer-window (current-buffer)))) (progn - (if (not (equal (selected-frame) (setq frame (window-frame window)))) - (select-frame-set-input-focus frame)) + (if (not (equal (selected-frame) (window-frame window))) + (select-frame-set-input-focus (window-frame window))) (select-window window)) - (message "Associated dired buffer not visible")))) + (message "Associated Dired buffer not visible")))) ;;; Major modes @@ -1266,15 +1261,13 @@ non-nil." "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) - (if flagged - (image-dired-dired-file-flagged-p) - (image-dired-dired-file-marked-p)))))))) + (let ((file-name (image-dired-original-file-name))) + (image-dired--with-dired-buffer + (save-excursion + (when (dired-goto-file file-name) + (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." @@ -1290,7 +1283,7 @@ for deletion instead." (unless (bobp) (backward-char))) (image-dired--line-up-with-method) - (with-current-buffer (image-dired-associated-dired-buffer) + (image-dired--on-file-in-dired-buffer (dired-do-delete))) (defun image-dired-thumb-update-marks () @@ -1310,7 +1303,7 @@ for deletion instead." 'image-dired-thumb-flagged)) (t (remove-text-properties (point) (1+ (point)) '(face image-dired-thumb-mark))))) - (forward-char))))))) + (forward-char 2))))))) (defun image-dired-mouse-toggle-mark-1 () "Toggle Dired mark for current thumbnail. commit 06de788529bb385462bc2539443d775328f82341 Author: Lars Ingebrigtsen Date: Sat Sep 24 14:06:26 2022 +0200 Tweak how :override advice is formatted in *Help* * lisp/emacs-lisp/nadvice.el (advice--make-single-doc): Format :overrides specially (bug#57974). (advice--make-docstring): Put overrides at the front. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index a9a20ab5ab..db33474c60 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -108,19 +108,26 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") (format "%s\n%s" name doc) (format "%s" name)) (or doc "No documentation"))))) - "\n"))) + "\n" + (and + (eq how :override) + (concat + (format-message + "\nThis is an :override advice, which means that `%s' isn't\n" function) + "run at all, and the documentation below may be irrelevant.\n"))))) (defun advice--make-docstring (function) "Build the raw docstring for FUNCTION, presumably advised." (let* ((flist (indirect-function function)) (docfun nil) (macrop (eq 'macro (car-safe flist))) - (docstring nil)) + (before nil) + (after nil)) (when macrop (setq flist (cdr flist))) (if (and (autoloadp flist) (get function 'advice--pending)) - (setq docstring + (setq after (advice--make-single-doc (get function 'advice--pending) function macrop)) (while (advice--p flist) @@ -130,9 +137,13 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") ;; object instead! So here we try to undo the damage. (when (integerp (aref flist 4)) (setq docfun flist)) - (setq docstring (concat docstring (advice--make-single-doc - flist function macrop)) - flist (advice--cdr flist)))) + (let ((doc-bit (advice--make-single-doc flist function macrop))) + ;; We want :overrides to go to the front, because they mean + ;; that the doc string may be irrelevant. + (if (eq (advice--how flist) :override) + (setq before (concat before doc-bit)) + (setq after (concat after doc-bit)))) + (setq flist (advice--cdr flist)))) (unless docfun (setq docfun flist)) (let* ((origdoc (unless (eq function docfun) ;Avoid inf-loops. @@ -145,12 +156,17 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") (if (stringp arglist) t (help--make-usage-docstring function arglist))) (setq origdoc (cdr usage)) (car usage))) - (help-add-fundoc-usage (concat origdoc - (if (string-suffix-p "\n" origdoc) - "\n" - "\n\n") - docstring) - usage)))) + (help-add-fundoc-usage + (with-temp-buffer + (when before + (insert before) + (ensure-empty-lines 1)) + (insert origdoc) + (when after + (ensure-empty-lines 1) + (insert after)) + (buffer-string)) + usage)))) (defun advice-eval-interactive-spec (spec) "Evaluate the interactive spec SPEC." commit bbd7059da4555586ecedd091cf8a223086bd6201 Author: Lars Ingebrigtsen Date: Sat Sep 24 12:44:44 2022 +0200 Rename file-name-directory * lisp/emacs-lisp/shortdoc.el (file-name): * doc/lispref/files.texi (Directory Names): Adjust. * lisp/files.el (file-name-parent-directory): Rename from `file-name-directory' (bug#58039). diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 986fb22c75..e1aa2de523 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2445,7 +2445,7 @@ You can use this function for directory names and for file names, because it recognizes abbreviations even as part of the name. @end defun -@defun file-parent-directory filename +@defun file-name-parent-directory filename This function returns the directory name of the parent directory of @var{filename}. If @var{filename} is at the root directory of the filesystem, it returns @code{nil}. A relative @var{filename} is diff --git a/etc/NEWS b/etc/NEWS index 0d69e87907..ff97c2350f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -482,7 +482,7 @@ user option 'global-text-scale-adjust-resizes-frames' controls whether the frames are resized when the font size is changed. +++ -** New function 'file-parent-directory'. +** New function 'file-name-parent-directory'. Get the parent directory of a file. ** New config variable 'syntax-wholeline-max' to reduce the cost of long lines. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index fe4f2ae3ac..d07d1019b4 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -355,11 +355,11 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (abbreviate-file-name :no-eval (abbreviate-file-name "/home/some-user") :eg-result "~some-user") - (file-parent-directory - :eval (file-parent-directory "/foo/bar") - :eval (file-parent-directory "/foo/") - :eval (file-parent-directory "foo/bar") - :eval (file-parent-directory "foo")) + (file-name-parent-directory + :eval (file-name-parent-directory "/foo/bar") + :eval (file-name-parent-directory "/foo/") + :eval (file-name-parent-directory "foo/bar") + :eval (file-name-parent-directory "foo")) "Quoted File Names" (file-name-quote :args (name) diff --git a/lisp/files.el b/lisp/files.el index 7fde8720fa..1e1ec6127d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5173,7 +5173,7 @@ On most systems, this will be true: (setq filename nil)))) components)) -(defun file-parent-directory (filename) +(defun file-name-parent-directory (filename) "Return the directory name of the parent directory of FILENAME. If FILENAME is at the root of the filesystem, return nil. If FILENAME is relative, it is interpreted to be relative commit 6403ede2016d0d16a487d759ef45745c3d4ac24b Author: Lars Ingebrigtsen Date: Sat Sep 24 12:15:58 2022 +0200 Ensure that cus-load doesn't add things twice * lisp/cus-dep.el (custom-make-dependencies): Use it. * lisp/custom.el (custom--add-custom-loads): New function. diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 163a2da1f1..3f18202aff 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -175,10 +175,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (prin1 (sort found #'string<)))) alist)))))) (dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2))))) - ;; Don't overwrite elements added by packages. - (insert "(put '" (car e) - " 'custom-loads (append '" (cdr e) - " (get '" (car e) " 'custom-loads)))\n"))) + (insert "(custom--add-custom-loads '" (car e) " '" (cdr e) ")\n"))) (insert "\ ;; The remainder of this file is for handling :version. diff --git a/lisp/custom.el b/lisp/custom.el index 352b5b0e16..604b1a3ff4 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1707,6 +1707,13 @@ If a choice with the same tag already exists, no action is taken." (put variable 'custom-type (append choices (list choice)))))) +(defun custom--add-custom-loads (symbol loads) + ;; Don't overwrite existing `custom-loads'. + (dolist (load (get symbol 'custom-loads)) + (unless (memq load loads) + (push load loads))) + (put symbol 'custom-loads loads)) + (provide 'custom) ;;; custom.el ends here commit 126d5b23cf252ceae537a686e46ba86c0591e658 Author: Lars Ingebrigtsen Date: Sat Sep 24 11:43:04 2022 +0200 `append' doc string clarification * src/fns.c (Fappend): Clarify whether arguments are copied. diff --git a/src/fns.c b/src/fns.c index 9dd10fe443..d2f1aadb65 100644 --- a/src/fns.c +++ b/src/fns.c @@ -610,7 +610,10 @@ DEFUN ("append", Fappend, Sappend, 0, MANY, 0, doc: /* Concatenate all the arguments and make the result a list. The result is a list whose elements are the elements of all the arguments. Each argument may be a list, vector or string. -The last argument is not copied, just used as the tail of the new list. + +All arguments except the last argument are copied. The last argument +is just used as the tail of the new list. + usage: (append &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { commit 90d2813f42678bbb5d22fbb6f59523ba567c6f36 Author: Lars Ingebrigtsen Date: Sat Sep 24 11:36:28 2022 +0200 Clarify message-newline-and-reformat doc string * lisp/gnus/message.el (message-newline-and-reformat): Clarify the DWIM-ness in the doc string (bug#57986). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 49a04f601f..e19ac76869 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3551,7 +3551,12 @@ of lines before the signature intact." (defun message-newline-and-reformat (&optional arg not-break) "Insert four newlines, and then reformat if inside quoted text. -Prefix arg means justify as well." +Prefix arg means justify as well. + +This function tries to guess what the quote prefix is based on +the text on the current line before point. If point is at the +start of the line, the formatted text (if any) is filled without +a quote prefix." (interactive (list (if current-prefix-arg 'full)) message-mode) (unless (message-in-body-p) (error "This command only works in the body of the message")) commit 7b1c0c34422a7e4d6c607147dfffd8631184078c Author: Stefan Kangas Date: Sat Sep 24 11:10:29 2022 +0200 ; * lisp/image/image-dired.el: Improve sectioning. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 9f686e273d..c471be86bb 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -446,6 +446,9 @@ thumbnail." (defvar image-dired-saved-window-configuration nil "Saved window configuration.") + +;;; Starting Image-Dired + ;;;###autoload (defun image-dired-dired-with-window-configuration (dir &optional arg) "Open directory DIR and create a default window configuration. @@ -581,7 +584,7 @@ never ask for confirmation." (defalias 'image-dired 'image-dired-show-all-from-dir) -;;; Thumbnail mode (cont.) +;;; Movement tracking (defun image-dired-track-original-file () "Track the original file in the associated Dired buffer. @@ -607,6 +610,8 @@ position in the other buffer." (setq image-dired-track-movement (not image-dired-track-movement)) (message "Movement tracking %s" (if image-dired-track-movement "on" "off"))) + +;;; Navigation (defun image-dired-forward-image (&optional arg wrap-around) "Move to next image in the thumbnail buffer. @@ -700,6 +705,9 @@ On reaching end or beginning of buffer, stop and show a message." (image-dired-track-original-file)) (image-dired-update-header-line)) + +;;; Header line + (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 @@ -731,6 +739,9 @@ comment." props comment)))))) + +;;; Marking and flagging + (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 @@ -745,16 +756,6 @@ for. The default is to look for `dired-marker-char'." "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--with-thumbnail-buffer (&rest body) - (declare (indent defun) (debug t)) - `(if-let ((buf (get-buffer image-dired-thumbnail-buffer))) - (with-current-buffer buf - (if-let ((win (get-buffer-window buf))) - (with-selected-window win - ,@body) - ,@body)) - (user-error "No such buffer: %s" image-dired-thumbnail-buffer))) - (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'." @@ -767,6 +768,16 @@ Should be called from commands in `image-dired-thumbnail-mode'." (when (dired-goto-file file-name) ,@body))))) +(defmacro image-dired--with-thumbnail-buffer (&rest body) + (declare (indent defun) (debug t)) + `(if-let ((buf (get-buffer image-dired-thumbnail-buffer))) + (with-current-buffer buf + (if-let ((win (get-buffer-window buf))) + (with-selected-window win + ,@body) + ,@body)) + (user-error "No such buffer: %s" image-dired-thumbnail-buffer))) + (defmacro image-dired--do-mark-command (maybe-next update &rest body) "Helper macro for the mark, unmark and flag commands. Run BODY in Dired buffer. @@ -826,6 +837,9 @@ You probably want to use this together with (select-window window)) (message "Associated dired buffer not visible")))) + +;;; Major modes + (defvar-keymap image-dired-thumbnail-mode-map :doc "Keymap for `image-dired-thumbnail-mode'." "" #'image-dired-forward-image @@ -941,9 +955,6 @@ Use `image-dired-minor-mode' to get a nice setup." ;; Use approximately as much vertical spacing as horizontal. (setq-local line-spacing (frame-char-width))) - -;;; Display image mode - (define-derived-mode image-dired-display-image-mode image-mode "image-dired-image-display" "Mode for displaying and manipulating original image. @@ -1042,7 +1053,7 @@ With a negative prefix argument, prompt user for the delay." (remove-hook 'post-command-hook 'image-dired--slideshow-stop)))) -;;; Thumbnail mode (cont. 3) +;;; Thumbnail layout and display (defun image-dired-delete-char () "Remove current thumbnail from thumbnail buffer and line up." @@ -1113,6 +1124,9 @@ Ask user how many thumbnails should be displayed per row." (message "Number must be greater than 0") (image-dired-line-up)))) + +;;; Display image from thumbnail buffer + (defun image-dired-thumbnail-display-external () "Display original image for thumbnail at point using external viewer." (interactive nil image-dired-thumbnail-mode) @@ -1161,6 +1175,23 @@ With prefix argument ARG, display image in its original size." (t (image-dired-display-image file arg))))) +(defun image-dired-display-next-thumbnail-original (&optional arg) + "Move to the next image in the thumbnail buffer and display it. +With prefix ARG, move that many thumbnails." + (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode) + (image-dired--with-thumbnail-buffer + (image-dired-forward-image arg t) + (image-dired-display-thumbnail-original-image))) + +(defun image-dired-display-previous-thumbnail-original (arg) + "Move to the previous image in the thumbnail buffer and display it. +With prefix ARG, move that many thumbnails." + (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode) + (image-dired-display-next-thumbnail-original (- arg))) + + +;;; Misc commands + (defun image-dired-rotate-original-left () "Rotate original image left (counter clockwise) 90 degrees. The result of the rotation is displayed in the image display area @@ -1181,20 +1212,6 @@ overwritten. This confirmation can be turned off using (image-dired--with-marked (image-dired-rotate-original "90"))) -(defun image-dired-display-next-thumbnail-original (&optional arg) - "Move to the next image in the thumbnail buffer and display it. -With prefix ARG, move that many thumbnails." - (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired--with-thumbnail-buffer - (image-dired-forward-image arg t) - (image-dired-display-thumbnail-original-image))) - -(defun image-dired-display-previous-thumbnail-original (arg) - "Move to the previous image in the thumbnail buffer and display it. -With prefix ARG, move that many thumbnails." - (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired-display-next-thumbnail-original (- arg))) - (defun image-dired-wallpaper-set (file) "Set the wallpaper to FILE in a graphical environment." (interactive (list (image-dired-original-file-name)) commit 143f23e8c026a882f64be867d4c880065ab65870 Author: Stefan Kangas Date: Sat Sep 24 11:07:45 2022 +0200 ; Make 'M-x image-dired' prompt even clearer * lisp/image/image-dired.el (image-dired-show-all-from-dir): Make prompt even clearer. Suggested by Eli Zaretskii . diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 1fe0ffb838..9f686e273d 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -557,7 +557,7 @@ 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 (directory): ") + (interactive "DShow thumbnails for directory: ") (dired dir) (dired-mark-files-regexp (image-dired--file-name-regexp)) (let ((files (dired-get-marked-files nil nil nil t))) commit 09711d396a1e1a2796514a0f5a966acf6ed7ff68 Author: Stefan Kangas Date: Sat Sep 24 11:06:51 2022 +0200 Improve image-dired-thumbnail-display-external * lisp/image/image-dired.el: (image-dired-external-viewer): Add more image viewers and slightly re-arrange. (image-dired-thumbnail-display-external): Correctly handle external viewers with spaces or flags. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 1b7ec740f0..1fe0ffb838 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -316,14 +316,16 @@ displaying: (defcustom image-dired-external-viewer ;; TODO: Use mailcap, dired-guess-shell-alist-default, ;; dired-view-command-alist. - (cond ((executable-find "display")) - ((executable-find "xli")) + (cond ((executable-find "display") "display") + ((executable-find "feh") "feh") + ((executable-find "gm") "gm display") + ((executable-find "xli") "xli") ((executable-find "qiv") "qiv -t") - ((executable-find "feh") "feh")) + ((executable-find "xloadimage") "xloadimage")) "Name of external viewer. Including parameters. Used when displaying original image from `image-dired-thumbnail-mode'." - :version "28.1" + :version "29.1" :type '(choice string (const :tag "Not Set" nil))) @@ -1119,8 +1121,9 @@ Ask user how many thumbnails should be displayed per row." (message "No thumbnail at point") (if (not file) (message "No original file name found") - (start-process "image-dired-thumb-external" nil - image-dired-external-viewer file))))) + (apply #'start-process "image-dired-thumb-external" nil + (append (string-split image-dired-external-viewer " ") + (list file))))))) (defun image-dired-display-image (file &optional _ignored) "Display image FILE in the image buffer window. commit 8a224e5124f4a64054d570054a37d2e56d3fe500 Author: Stefan Kangas Date: Sat Sep 24 02:15:53 2022 +0200 * lisp/emacs-lisp/shortdoc.el (file-name): Improve examples. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 2472479bad..fe4f2ae3ac 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -357,11 +357,9 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eg-result "~some-user") (file-parent-directory :eval (file-parent-directory "/foo/bar") - :eval (file-parent-directory "~") - :eval (file-parent-directory "/tmp/") + :eval (file-parent-directory "/foo/") :eval (file-parent-directory "foo/bar") - :eval (file-parent-directory "foo") - :eval (file-parent-directory "/")) + :eval (file-parent-directory "foo")) "Quoted File Names" (file-name-quote :args (name) commit 7bac1d0b60bbc942a65a16635b49bab8ce52ffa9 Author: Stefan Kangas Date: Sat Sep 24 01:45:54 2022 +0200 image-dired: Use command substitution for tags bindings * lisp/image/image-dired-tags.el (image-dired-dired-edit-comment-and-tags): Use substitute-command-keys diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el index 7a837875ce..dfd6473285 100644 --- a/lisp/image/image-dired-tags.el +++ b/lisp/image/image-dired-tags.el @@ -293,11 +293,14 @@ easy-to-use form." (remove-overlays) ;; Some help for the user. (widget-insert - "\nEdit comments and tags for each image. Separate multiple tags -with a comma. Move forward between fields using TAB or RET. -Move to the previous field using backtab (S-TAB). Save by -activating the Save button at the bottom of the form or cancel -the operation by activating the Cancel button.\n\n") + (substitute-command-keys + "\\ +Edit comments and tags for each image. Separate multiple tags +with a comma. Move forward between fields using \\[widget-forward] \ +or \\[widget-field-activate]. +Move to the previous field using \\[widget-backward]. Save by +activating the \"Save\" button at the bottom of the form or +cancel the operation by activating the \"Cancel\" button.\n\n")) ;; Here comes all images and a comment and tag field for each ;; image. (let (thumb-file img comment-widget tag-widget) commit b74ee91122ed65411949f992022d2af72b551f90 Author: Stefan Kangas Date: Fri Sep 23 23:47:23 2022 +0200 image-dired: Various code clean ups * lisp/image/image-dired.el (image-dired--display-thumb-properties-fun): Delete function. (image-dired-forward-image): Immediately update header line. Improve docstring. (image-dired-backward-image, image-dired-next-line) (image-dired-previous-line, image-dired-beginning-of-buffer) (image-dired-end-of-buffer, image-dired-display-image): Improve docstring. (image-dired-comment-thumbnail): Fix interactive declaration. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 43faccad1e..1b7ec740f0 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -605,17 +605,9 @@ position in the other buffer." (setq image-dired-track-movement (not image-dired-track-movement)) (message "Movement tracking %s" (if image-dired-track-movement "on" "off"))) -(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-update-header-line)))))) (defun image-dired-forward-image (&optional arg wrap-around) - "Move to next image and display properties. + "Move to next image in the thumbnail buffer. 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. @@ -643,12 +635,12 @@ point is on the last image, move to the last one and vice versa." (- (point-max) 2))) (image-dired-update-header-line)) (message "At %s image" (if (> arg 0) "last" "first")) - (run-at-time 1 nil (image-dired--display-thumb-properties-fun)))))) + (image-dired-update-header-line))))) (when image-dired-track-movement (image-dired-track-original-file))) (defun image-dired-backward-image (&optional arg) - "Move to previous image and display properties. + "Move to previous image in the thumbnail buffer. 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." @@ -656,7 +648,7 @@ On reaching end or beginning of buffer, stop and show a message." (image-dired-forward-image (- (or arg 1)))) (defun image-dired-next-line () - "Move to next line and display properties." + "Move to next line in the thumbnail buffer." (interactive nil image-dired-thumbnail-mode) (let ((goal-column (current-column))) (forward-line 1) @@ -669,7 +661,7 @@ On reaching end or beginning of buffer, stop and show a message." (image-dired-update-header-line)) (defun image-dired-previous-line () - "Move to previous line and display properties." + "Move to previous line in the thumbnail buffer." (interactive nil image-dired-thumbnail-mode) (let ((goal-column (current-column))) (forward-line -1) @@ -685,7 +677,7 @@ On reaching end or beginning of buffer, stop and show a message." (image-dired-update-header-line)) (defun image-dired-beginning-of-buffer () - "Move to the first image in the buffer and display properties." + "Move to the first image in the thumbnail buffer." (interactive nil image-dired-thumbnail-mode) (goto-char (point-min)) (while (and (not (image-at-point-p)) @@ -696,7 +688,7 @@ On reaching end or beginning of buffer, stop and show a message." (image-dired-update-header-line)) (defun image-dired-end-of-buffer () - "Move to the last image in the buffer and display properties." + "Move to the last image in the thumbnail buffer." (interactive nil image-dired-thumbnail-mode) (goto-char (point-max)) (while (and (not (image-at-point-p)) @@ -1131,7 +1123,7 @@ Ask user how many thumbnails should be displayed per row." image-dired-external-viewer file))))) (defun image-dired-display-image (file &optional _ignored) - "Display image FILE in a the image buffer window. + "Display image FILE in the image buffer window. If it is an image, the window will use `image-dired-display-image-mode' which is based on `image-mode'." (declare (advertised-calling-convention (file) "29.1")) @@ -1206,12 +1198,9 @@ With prefix ARG, move that many thumbnails." image-dired-thumbnail-mode) (wallpaper-set file)) - -;;; Image Comments - (defun image-dired-comment-thumbnail () "Add comment to current thumbnail in thumbnail buffer." - (interactive nil image-dired-comment-thumbnail image-dired-display-image-mode) + (interactive nil image-dired-thumbnail-mode) (let* ((file (image-dired-original-file-name)) (comment (image-dired-read-comment file))) (image-dired-write-comments (list (cons file comment))) @@ -1365,6 +1354,7 @@ Track this in associated Dired buffer if (goto-char (point-min)))) (put 'image-dired-bookmark-jump 'bookmark-handler-type "Image-Dired") + ;;; Obsolete commit 54876bf498f5e6b4f7a66a051b105c3ddd308945 Author: Po Lu Date: Sat Sep 24 16:27:42 2022 +0800 Reduce complexity of scroll bar window protection code It turns out my previous theories of why ClientMessages were generated were wrong, and they are just generated so we can set finish to X_EVENT_GOTO_OUT to have them delivered immediately. This allows for the code to be simplified greatly, by not unpacking pointers to the raw window into the client messages. * src/xterm.c (x_unprotect_window_for_callback): Return the window removed from the queue, or nil if none. (x_scroll_bar_to_input_event) (x_horizontal_scroll_bar_to_input_event): Use window provided by x_unprotect_window_for_callback. (handle_one_xevent): Pass dpyinfo to functions that need it. (x_free_frame_resources): Remove "first scroll bar request" code. * src/xterm.h (struct x_display_info): Likewise. diff --git a/src/xterm.c b/src/xterm.c index 2d366e5511..527c26f0da 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14385,17 +14385,23 @@ x_protect_window_for_callback (struct x_display_info *dpyinfo, return true; } -static void +static Lisp_Object x_unprotect_window_for_callback (struct x_display_info *dpyinfo) { + Lisp_Object window; + if (!dpyinfo->n_protected_windows) - emacs_abort (); + return Qnil; + + window = dpyinfo->protected_windows[0]; dpyinfo->n_protected_windows--; if (dpyinfo->n_protected_windows) memmove (dpyinfo->protected_windows, &dpyinfo->protected_windows[1], sizeof (Lisp_Object) * dpyinfo->n_protected_windows); + + return window; } /* Send a client message with message type Xatom_Scrollbar for a @@ -14462,30 +14468,34 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, in *IEVENT. */ static void -x_scroll_bar_to_input_event (const XEvent *event, +x_scroll_bar_to_input_event (struct x_display_info *dpyinfo, + const XEvent *event, struct input_event *ievent) { - const XClientMessageEvent *ev = &event->xclient; Lisp_Object window; - struct window *w; - /* See the comment in the function above. */ - intptr_t iw0 = ev->data.l[0]; - intptr_t iw1 = ev->data.l[1]; - intptr_t iw = (iw0 << 31 << 1) + (iw1 & 0xffffffffu); - w = (struct window *) iw; + /* Every time a scroll bar ClientMessage event is sent, the window + is pushed onto a queue that is traced for garbage collection. + Every time we need a window for a read scroll bar event, we + simply read from the other side of the queue. */ + window = x_unprotect_window_for_callback (dpyinfo); - XSETWINDOW (window, w); + if (NILP (window)) + { + /* This means we are getting extra scroll bar events for some + reason, and shouldn't be possible in practice. */ + EVENT_INIT (*ievent); + return; + } ievent->kind = SCROLL_BAR_CLICK_EVENT; ievent->frame_or_window = window; ievent->arg = Qnil; - ievent->timestamp - = x_get_last_toolkit_time (FRAME_DISPLAY_INFO (XFRAME (w->frame))); + ievent->timestamp = x_get_last_toolkit_time (dpyinfo); ievent->code = 0; - ievent->part = ev->data.l[2]; - ievent->x = make_fixnum (ev->data.l[3]); - ievent->y = make_fixnum (ev->data.l[4]); + ievent->part = event->xclient.data.l[2]; + ievent->x = make_fixnum (event->xclient.data.l[3]); + ievent->y = make_fixnum (event->xclient.data.l[4]); ievent->modifiers = 0; } @@ -14493,30 +14503,34 @@ x_scroll_bar_to_input_event (const XEvent *event, input event in *IEVENT. */ static void -x_horizontal_scroll_bar_to_input_event (const XEvent *event, +x_horizontal_scroll_bar_to_input_event (struct x_display_info *dpyinfo, + const XEvent *event, struct input_event *ievent) { - const XClientMessageEvent *ev = &event->xclient; Lisp_Object window; - struct window *w; - /* See the comment in the function above. */ - intptr_t iw0 = ev->data.l[0]; - intptr_t iw1 = ev->data.l[1]; - intptr_t iw = (iw0 << 31 << 1) + (iw1 & 0xffffffffu); - w = (struct window *) iw; + /* Every time a scroll bar ClientMessage event is sent, the window + is pushed onto a queue that is traced for garbage collection. + Every time we need a window for a read scroll bar event, we + simply read from the other side of the queue. */ + window = x_unprotect_window_for_callback (dpyinfo); - XSETWINDOW (window, w); + if (NILP (window)) + { + /* This means we are getting extra scroll bar events for some + reason, and shouldn't be possible in practice. */ + EVENT_INIT (*ievent); + return; + } ievent->kind = HORIZONTAL_SCROLL_BAR_CLICK_EVENT; ievent->frame_or_window = window; ievent->arg = Qnil; - ievent->timestamp - = x_get_last_toolkit_time (FRAME_DISPLAY_INFO (XFRAME (w->frame))); + ievent->timestamp = x_get_last_toolkit_time (dpyinfo); ievent->code = 0; - ievent->part = ev->data.l[2]; - ievent->x = make_fixnum (ev->data.l[3]); - ievent->y = make_fixnum (ev->data.l[4]); + ievent->part = event->xclient.data.l[2]; + ievent->x = make_fixnum (event->xclient.data.l[3]); + ievent->y = make_fixnum (event->xclient.data.l[4]); ievent->modifiers = 0; } @@ -18104,28 +18118,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, we construct an input_event. */ if (event->xclient.message_type == dpyinfo->Xatom_Scrollbar) { - x_scroll_bar_to_input_event (event, &inev.ie); - - /* Unprotect the first window to be sent in a - ClientMessage event, since it is now on the stack and - thereby subject to garbage collection. */ - if (event->xclient.serial - >= dpyinfo->first_valid_scroll_bar_req) - x_unprotect_window_for_callback (dpyinfo); + /* Convert the scroll bar event to an input event using + the first window entered into the scroll bar event + queue. */ + x_scroll_bar_to_input_event (dpyinfo, event, &inev.ie); *finish = X_EVENT_GOTO_OUT; goto done; } else if (event->xclient.message_type == dpyinfo->Xatom_Horizontal_Scrollbar) { - x_horizontal_scroll_bar_to_input_event (event, &inev.ie); - - /* Unprotect the first window to be sent in a - ClientMessage event, since it is now on the stack and - thereby subject to garbage collection. */ - if (event->xclient.serial - >= dpyinfo->first_valid_scroll_bar_req) - x_unprotect_window_for_callback (dpyinfo); + /* Convert the horizontal scroll bar event to an input + event using the first window entered into the scroll + bar event queue. */ + x_horizontal_scroll_bar_to_input_event (dpyinfo, event, + &inev.ie); *finish = X_EVENT_GOTO_OUT; goto done; @@ -27347,11 +27354,8 @@ x_free_frame_resources (struct frame *f) #ifdef USE_TOOLKIT_SCROLL_BARS /* Since the frame was destroyed, we can no longer guarantee that scroll bar events will be received. Clear - protected_windows, and ignore any preceding scroll bar events - that happen to still be deliverable. */ + protected_windows. */ dpyinfo->n_protected_windows = 0; - dpyinfo->first_valid_scroll_bar_req - = XNextRequest (dpyinfo->display); #endif } diff --git a/src/xterm.h b/src/xterm.h index d1671621c7..d6ff15e40f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -839,15 +839,6 @@ struct x_display_info server_time_monotonic_p will be true). */ int_fast64_t server_time_offset; #endif - -#if defined USE_TOOLKIT_SCROLL_BARS - /* Serial number of the first scroll bar event to start listening - to. This is necessary because protected_windows is display - local, but the destruction of a frame's edit window may cause - event windows to vanish before they are delivered, leading to - windows remaining protected indefinitely. */ - unsigned long first_valid_scroll_bar_req; -#endif }; #ifdef HAVE_X_I18N commit 767a10cc63de8ce9f85ac688be33555278b4f3fb Author: Augusto Stoffel Date: Sat Sep 17 18:30:04 2022 +0200 New Flymake backend using the shellcheck program See bug#57884. * lisp/progmodes/sh-script.el: Require let-alist and subr-x when compiling. (sh--json-read): Helper function to deal with possible absence of json-parse-buffer. (sh-shellcheck-program, sh--shellcheck-process, sh-shellcheck-flymake): Variables and function defining a Flymake backend. (sh-mode): Add it to 'flymake-diagnostic-functions'. diff --git a/etc/NEWS b/etc/NEWS index 34025ff83d..0d69e87907 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1367,6 +1367,10 @@ This controls how statements like the following are indented: foo && bar +*** New Flymake backend using the ShellCheck program +It is enabled by default, but requires that the external "shellcheck" +command is installed. + ** Cperl Mode --- diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 517fbbd8e7..558b62b20a 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -31,6 +31,9 @@ ;; available for filenames, variables known from the script, the shell and ;; the environment as well as commands. +;; A Flymake backend using the "shellcheck" program is provided. See +;; https://www.shellcheck.net/ for installation instructions. + ;;; Known Bugs: ;; - In Bourne the keyword `in' is not anchored to case, for, select ... @@ -141,7 +144,9 @@ (eval-when-compile (require 'skeleton) (require 'cl-lib) - (require 'comint)) + (require 'comint) + (require 'let-alist) + (require 'subr-x)) (require 'executable) (autoload 'comint-completion-at-point "comint") @@ -1580,6 +1585,7 @@ with your script for an edit-interpret-debug cycle." ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") (t sh-shell-file)) nil nil) + (add-hook 'flymake-diagnostic-functions #'sh-shellcheck-flymake nil t) (add-hook 'hack-local-variables-hook #'sh-after-hack-local-variables nil t)) @@ -3103,6 +3109,88 @@ shell command and conveniently use this command." (delete-region (1+ (point)) (progn (skip-chars-backward " \t") (point))))))) +;;; Flymake backend + +(defcustom sh-shellcheck-program "shellcheck" + "Name of the shellcheck executable." + :type 'string + :version "29.1") + +(defcustom sh-shellcheck-arguments nil + "Additional arguments to the shellcheck program." + :type '(repeat string) + :version "29.1") + +(defvar-local sh--shellcheck-process nil) + +(defalias 'sh--json-read + (if (fboundp 'json-parse-buffer) + (lambda () (json-parse-buffer :object-type 'alist)) + (require 'json) + 'json-read)) + +(defun sh-shellcheck-flymake (report-fn &rest _args) + "Flymake backend using the shellcheck program. +Takes a Flymake callback REPORT-FN as argument, as expected of a +member of `flymake-diagnostic-functions'." + (when (process-live-p sh--shellcheck-process) + (kill-process sh--shellcheck-process)) + (let* ((source (current-buffer)) + (dialect (named-let recur ((s sh-shell)) + (pcase s + ((or 'bash 'dash 'sh) (symbol-name s)) + ('ksh88 "ksh") + ((guard s) + (recur (alist-get s sh-ancestor-alist)))))) + (sentinel + (lambda (proc _event) + (when (memq (process-status proc) '(exit signal)) + (unwind-protect + (if (with-current-buffer source + (not (eq proc sh--shellcheck-process))) + (flymake-log :warning "Canceling obsolete check %s" proc) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (thread-last + (sh--json-read) + (alist-get 'comments) + (seq-filter + (lambda (item) + (let-alist item (string= .file "-")))) + (mapcar + (lambda (item) + (let-alist item + (flymake-make-diagnostic + source + (cons .line .column) + (unless (and (eq .line .endLine) + (eq .column .endColumn)) + (cons .endLine .endColumn)) + (pcase .level + ("error" :error) + ("warning" :warning) + (_ :note)) + (format "SC%s: %s" .code .message))))) + (funcall report-fn)))) + (kill-buffer (process-buffer proc))))))) + (unless dialect + (error "`sh-shellcheck-flymake' is not suitable for shell type `%s'" + sh-shell)) + (setq sh--shellcheck-process + (make-process + :name "shellcheck" :noquery t :connection-type 'pipe + :buffer (generate-new-buffer " *flymake-shellcheck*") + :command `(,sh-shellcheck-program + "--format=json1" + "-s" ,dialect + ,@sh-shellcheck-arguments + "-") + :sentinel sentinel)) + (save-restriction + (widen) + (process-send-region sh--shellcheck-process (point-min) (point-max)) + (process-send-eof sh--shellcheck-process)))) + (provide 'sh-script) ;;; sh-script.el ends here commit 597c59078ec3cc352562bfe4898072ee11ad8b0b Author: Eli Zaretskii Date: Sat Sep 24 09:22:45 2022 +0300 ; * src/keyboard.c (Fposn_at_point): Doc fix. (Bug#52092) diff --git a/src/keyboard.c b/src/keyboard.c index 9865bc9add..3d08aa5af4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -11393,6 +11393,9 @@ DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0, doc: /* Return position information for buffer position POS in WINDOW. POS defaults to point in WINDOW; WINDOW defaults to the selected window. +If POS is in invisible text or is hidden by `display' properties, +this function may report on buffer positions before or after POS. + Return nil if POS is not visible in WINDOW. Otherwise, the return value is similar to that returned by `event-start' for a mouse click at the upper left corner of the glyph corresponding