diff options
author | Philip Kaludercic <philipk@posteo.net> | 2022-10-15 17:38:30 +0200 |
---|---|---|
committer | Philip Kaludercic <philipk@posteo.net> | 2022-10-15 17:38:30 +0200 |
commit | 01e45efcd44e92dd259283df0e62653c7c20e9cc (patch) | |
tree | 552c1a6ce7d52b897cf5f089d6c589921efbe9bd /lisp | |
parent | 982c0e6c15535defcf6ac3c4d4169708c60efc18 (diff) | |
parent | 5933055a3e7387b0095f0df7876a208ab15f4f45 (diff) | |
download | emacs-01e45efcd44e92dd259283df0e62653c7c20e9cc.tar.gz emacs-01e45efcd44e92dd259283df0e62653c7c20e9cc.tar.bz2 emacs-01e45efcd44e92dd259283df0e62653c7c20e9cc.zip |
Merge branch 'master' into feature/package+vc
Diffstat (limited to 'lisp')
65 files changed, 821 insertions, 373 deletions
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 0b97a641099..6053ffa65aa 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -9490,7 +9490,7 @@ toolbar/rescan.pbm, toolbar/rescan.xpm, toolbar/show.pbm, toolbar/show.xpm, toolbar/widen.pbm, toolbar/widen.xpm: Upgraded to mh-e version 6.1.1. Full ChangeLog available in - http://prdownloads.sourceforge.net/mh-e/mh-e-6.1.tgz?download . + https://prdownloads.sourceforge.net/mh-e/mh-e-6.1.tgz?download . There were no user-visible changes in 6.1.1 from 6.1--only the section of the Makefile that installs the files into Emacs was changed. diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index c84e44536d2..686746abe0b 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -155,7 +155,7 @@ * epa.el (epa-decrypt-region): Detect encoding if coding-system-for-read is not specified. - <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=17018> + <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=17018> (epa-verify-region): Ditto. 2009-06-04 Stefan Monnier <monnier@iro.umontreal.ca> @@ -540,7 +540,7 @@ * epa-file.el (epa-file-decode-and-insert): Use string-to-multibyte instead of set-buffer-multibyte. - <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=15259> + <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=15259> 2009-04-18 Yann Hodique <yann.hodique@gmail.com> (tiny change) diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 53caf69e1ce..23e61ff7872 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -22762,7 +22762,7 @@ Automatically handle .xz suffix (XZ-compressed files), too. * jka-cmpr-hook.el (jka-compr-compression-info-list): Add xz. - XZ is the successor to LZMA: <http://tukaani.org/xz/> + XZ is the successor to LZMA: <https://tukaani.org/xz/> 2009-06-22 Dmitry Dzhus <dima@sphinx.net.ru> Nick Roberts <nickrob@snap.net.nz> diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index cebafe18aa0..df731fe9ed2 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -14039,7 +14039,7 @@ * epa-file.el (epa-file-write-region): Encode the region according to `buffer-file-format'. Problem reported at: - <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=32917>. + <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=32917>. 2014-01-14 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 256017f6c5b..338814fdda2 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -430,6 +430,12 @@ compile-always: find $(lisp) -name '*.elc' $(FIND_DELETE) $(MAKE) compile +.PHONY: trampolines +trampolines: compile +ifeq ($(HAVE_NATIVE_COMP),yes) + $(emacs) -l comp -f comp-compile-all-trampolines +endif + .PHONY: backup-compiled-files compile-after-backup # Backup compiled Lisp files in elc.tar.gz. If that file already diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 580f6b3ced2..51d939151ce 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -168,7 +168,7 @@ If this contains a %s, that will be replaced by the matching rule." (".dir-locals.el" nil - ";;; Directory Local Variables\n" + ";;; Directory Local Variables -*- no-byte-compile: t; -*-\n" ";;; For more information see (info \"(emacs) Directory Variables\")\n\n" "((" '(setq v1 (let (modes) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index 0564cf6d048..5b0df013a3c 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -47,7 +47,7 @@ ;; The original pulse code was written for semantic tag highlighting. ;; It has been extracted, and adapted for general purpose pulsing. ;; -;; Pulse is a part of CEDET. http://cedet.sf.net +;; Pulse is a part of CEDET. https://cedet.sourceforge.net (require 'color) diff --git a/lisp/custom.el b/lisp/custom.el index 604b1a3ff48..0d3e2e5d0c2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1152,9 +1152,11 @@ list, in which A occurs before B if B was defined with a ;; (provide-theme 'THEME) -(defmacro deftheme (theme &optional doc) +(defmacro deftheme (theme &optional doc &rest properties) "Declare THEME to be a Custom theme. The optional argument DOC is a doc string describing the theme. +PROPERTIES are interpreted as a property list that will be stored +in the `theme-properties' property for THEME. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." @@ -1164,18 +1166,25 @@ see `custom-make-theme-feature' for more information." ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. - (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) + (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc + (cons 'list properties)))) -(defun custom-declare-theme (theme feature &optional doc) +(defun custom-declare-theme (theme feature &optional doc properties) "Like `deftheme', but THEME is evaluated as a normal argument. -FEATURE is the feature this theme provides. Normally, this is a symbol -created from THEME by `custom-make-theme-feature'." +FEATURE is the feature this theme provides. Normally, this is a +symbol created from THEME by `custom-make-theme-feature'. The +optional argument DOC may contain the documentation for THEME. +The optional argument PROPERTIES may contain a property list of +attributes associated with THEME." (unless (custom-theme-name-valid-p theme) (error "Custom theme cannot be named %S" theme)) (unless (memq theme custom-known-themes) (push theme custom-known-themes)) (put theme 'theme-feature feature) - (when doc (put theme 'theme-documentation doc))) + (when doc + (put theme 'theme-documentation doc)) + (when properties + (put theme 'theme-properties properties))) (defun custom-make-theme-feature (theme) "Given a symbol THEME, create a new symbol by appending \"-theme\". @@ -1372,6 +1381,58 @@ Return t if THEME was successfully loaded, nil otherwise." (enable-theme theme)) t) +(defun theme-list-variants (theme &rest list) + "Return a list of theme variants for THEME. +By default this will use all known custom themes (see +`custom-available-themes') to check for variants. This can be +restricted if the optional argument LIST containing a list of +theme symbols to consider." + (let* ((properties (get theme 'theme-properties)) + (family (plist-get properties :family))) + (seq-filter + (lambda (variant) + (and (eq (plist-get (get variant 'theme-properties) :family) + family) + (not (eq variant theme)))) + (or list (custom-available-themes))))) + +(defun theme-choose-variant (&optional no-confirm no-enable) + "Switch from the current theme to one of its variants. +The current theme will be disabled before variant is enabled. If +the current theme has only one variant, switch to that variant +without prompting, otherwise prompt for the variant to select. +See `load-theme' for the meaning of NO-CONFIRM and NO-ENABLE." + (interactive) + (let ((active-color-schemes + (seq-filter + (lambda (theme) + ;; FIXME: As most themes currently do not have a `:kind' + ;; tag, it is assumed that a theme is a color scheme by + ;; default. This should be reconsidered in the future. + (memq (plist-get (get theme 'theme-properties) :kind) + '(color-scheme nil))) + custom-enabled-themes))) + (cond + ((length= active-color-schemes 0) + (user-error "No theme is active, cannot toggle")) + ((length> active-color-schemes 1) + (user-error "More than one theme active, cannot unambiguously toggle"))) + (let* ((theme (car active-color-schemes)) + (family (plist-get (get theme 'theme-properties) :family))) + (unless family + (error "Theme `%s' does not have any known variants" theme)) + (let* ((variants (theme-list-variants theme)) + (choice (cond + ((null variants) + (error "`%s' has no variants" theme)) + ((length= variants 1) + (car variants)) + ((intern (completing-read "Load custom theme: " variants)))))) + (disable-theme theme) + (load-theme choice no-confirm no-enable))))) + +(defalias 'toggle-theme #'theme-choose-variant) + (defun custom-theme-load-confirm (hash) "Query the user about loading a Custom theme that may not be safe. The theme should be in the current buffer. If the user agrees, diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el index 6ff67d46d20..54d60c84d4f 100644 --- a/lisp/ecomplete.el +++ b/lisp/ecomplete.el @@ -70,9 +70,9 @@ :type '(symbol :tag "Coding system")) (defcustom ecomplete-sort-predicate #'ecomplete-decay - "Predicate to use when sorting matched. -The predicate is called with two parameters that represent the -completion. Each parameter is a list where the first element is + "Predicate to use when sorting matched ecomplete candidates. +The predicate is called with two arguments that represent the +completion. Each argument is a list where the first element is the times the completion has been used, the second is the timestamp of the most recent usage, and the third item is the string that was matched." @@ -86,6 +86,11 @@ string that was matched." :type 'boolean :version "29.1") +(defcustom ecomplete-filter-regexp nil + "Regular expression of addresses that should not be stored by ecomplete." + :type 'regexp + :version "29.1") + ;;; Internal variables. (defvar ecomplete-database nil) @@ -104,20 +109,22 @@ string that was matched." By default, the longest version of TEXT will be preserved, but if FORCE is non-nil, use TEXT exactly as is." (unless ecomplete-database (ecomplete-setup)) - (let ((elems (assq type ecomplete-database)) - (now (time-convert nil 'integer)) - entry) - (unless elems - (push (setq elems (list type)) ecomplete-database)) - (if (setq entry (assoc key (cdr elems))) - (pcase-let ((`(,_key ,count ,_time ,oldtext) entry)) - (setcdr entry (list (1+ count) now - ;; Preserve the "more complete" text. - (if (or force - (>= (length text) (length oldtext))) - text - oldtext)))) - (nconc elems (list (list key 1 now text)))))) + (unless (and ecomplete-filter-regexp + (string-match-p ecomplete-filter-regexp key)) + (let ((elems (assq type ecomplete-database)) + (now (time-convert nil 'integer)) + entry) + (unless elems + (push (setq elems (list type)) ecomplete-database)) + (if (setq entry (assoc key (cdr elems))) + (pcase-let ((`(,_key ,count ,_time ,oldtext) entry)) + (setcdr entry (list (1+ count) now + ;; Preserve the "more complete" text. + (if (or force + (>= (length text) (length oldtext))) + text + oldtext)))) + (nconc elems (list (list key 1 now text))))))) (defun ecomplete--remove-item (type key) "Remove the element of TYPE and KEY from the ecomplete database." @@ -289,7 +296,7 @@ non-nil and there is only a single completion option available." nil t))) (defun ecomplete-edit () - "Prompt for an item and allow editing it." + "Prompt for an ecomplete item and allow editing it." (interactive) (let* ((type (ecomplete--prompt-type)) (data (cdr (assq type ecomplete-database))) @@ -305,7 +312,8 @@ non-nil and there is only a single completion option available." (ecomplete-save))) (defun ecomplete-remove () - "Remove entries matching a regexp from the ecomplete database." + "Remove from the ecomplete database the entries matching a regexp. +Prompt for the regexp to match the database entries to be removed." (interactive) (let* ((type (ecomplete--prompt-type)) (data (cdr (assq type ecomplete-database))) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6656b7e57c1..889bffa3f5c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4204,6 +4204,17 @@ bytecode definition was not changed in the meantime)." ;;; Compiler entry points. +(defun comp-compile-all-trampolines () + "Pre-compile AOT all trampolines." + (let ((comp-running-batch-compilation t) + ;; We want to target only the 'native-lisp' directory. + (native-compile-target-directory + (car (last native-comp-eln-load-path)))) + (mapatoms (lambda (f) + (when (subr-primitive-p (symbol-function f)) + (message "Compiling trampoline for: %s" f) + (comp-trampoline-compile f)))))) + ;;;###autoload (defun comp-lookup-eln (filename) "Given a Lisp source FILENAME return the corresponding .eln file if found. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 964d23c770e..a1c4f91579e 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -283,6 +283,12 @@ expression, in which case we want to handle forms differently." ,@(when-let ((safe (plist-get props :safe))) `((put ',varname 'safe-local-variable ,safe)))))) + ;; Extract theme properties. + ((eq car 'deftheme) + (let* ((name (car-safe (cdr-safe form))) + (props (nthcdr 3 form))) + `(put ',name 'theme-properties (list ,@props)))) + ((eq car 'defgroup) ;; In Emacs this is normally handled separately by cus-dep.el, but for ;; third party packages, it can be convenient to explicitly autoload @@ -730,7 +736,14 @@ rules for built-in packages and excluded files." ;; updated. (file-newer-than-file-p (expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory) - output-file)))) + output-file))) + (let ((lisp-mode-autoload-regexp + "^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)")) + (loaddefs-generate + (expand-file-name "../etc/themes/" lisp-directory) + (expand-file-name "theme-loaddefs.el" lisp-directory)))) + +;;;###autoload (load "theme-loaddefs.el") (provide 'loaddefs-gen) diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index 56b1ea6ed48..968a80b59e7 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -262,12 +262,7 @@ by counted more than once." (cl-struct-slot-info struct-type))))) (defun memory-report--format (bytes) - (setq bytes (/ bytes 1024.0)) - (let ((units '("KiB" "MiB" "GiB" "TiB"))) - (while (>= bytes 1024) - (setq bytes (/ bytes 1024.0)) - (setq units (cdr units))) - (format "%6.1f %s" bytes (car units)))) + (format "%10s" (file-size-human-readable bytes 'iec " "))) (defun memory-report--gc-elem (elems type) (* (nth 1 (assq type elems)) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 106b7d5a8de..92f15337671 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -975,7 +975,7 @@ untar into a directory named DIR; otherwise, signal an error." (or (string-match regexp name) ;; Tarballs created by some utilities don't list ;; directories with a trailing slash (Bug#13136). - (and (string-equal dir name) + (and (string-equal (expand-file-name dir) name) (eq (tar-header-link-type tar-data) 5)) (error "Package does not untar cleanly into directory %s/" dir))))) (tar-untar-buffer)) @@ -1240,8 +1240,12 @@ Return the pkg-desc, with desc-kind set to KIND." "Find package information for a tar file. The return result is a `package-desc'." (cl-assert (derived-mode-p 'tar-mode)) - (let* ((dir-name (file-name-directory - (tar-header-name (car tar-parse-info)))) + (let* ((dir-name (named-let loop + ((filename (tar-header-name (car tar-parse-info)))) + (let ((dirname (file-name-directory filename))) + ;; The first file can be in a subdir: look for the top. + (if dirname (loop (directory-file-name dirname)) + (file-name-as-directory filename))))) (desc-file (package--description-file dir-name)) (tar-desc (tar-get-file-descriptor (concat dir-name desc-file)))) (unless tar-desc diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 4cfd658e10d..dbac03432c1 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -897,6 +897,8 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (seq-drop-while #'numberp '(1 2 c d 5))) (seq-filter :eval (seq-filter #'numberp '(a b 3 4 f 6))) + (seq-keep + :eval (seq-keep #'cl-digit-char-p '(?6 ?a ?7))) (seq-remove :eval (seq-remove #'numberp '(1 2 c d 5))) (seq-remove-at-position diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 9bdf90bf1d6..de8503a1cb1 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -353,6 +353,11 @@ This also updates the displayed table." (let* ((cache (vtable--cache table)) (inhibit-read-only t) (keymap (get-text-property (point) 'keymap)) + (ellipsis (if (vtable-ellipsis table) + (propertize (truncate-string-ellipsis) + 'face (vtable-face table)) + "")) + (ellipsis-width (string-pixel-width ellipsis)) (elem (and after-object (assq after-object (car cache)))) (line (cons object (vtable--compute-cached-line table object)))) @@ -370,7 +375,8 @@ This also updates the displayed table." ;; FIXME: We have to adjust colors in lines below this if we ;; have :row-colors. (vtable--insert-line table line 0 - (nth 1 cache) (vtable--spacer table)) + (nth 1 cache) (vtable--spacer table) + ellipsis ellipsis-width) (add-text-properties start (point) (list 'keymap keymap 'vtable table))) ;; We may have inserted a non-numerical value into a previously @@ -516,7 +522,8 @@ This also updates the displayed table." (if (> (nth 1 elem) (elt widths index)) (concat (vtable--limit-string - pre-computed (- (elt widths index) ellipsis-width)) + pre-computed (- (elt widths index) + (or ellipsis-width 0))) ellipsis) pre-computed)) ;; Recompute widths. @@ -524,7 +531,8 @@ This also updates the displayed table." (if (> (string-pixel-width value) (elt widths index)) (concat (vtable--limit-string - value (- (elt widths index) ellipsis-width)) + value (- (elt widths index) + (or ellipsis-width 0))) ellipsis) value)))) (start (point)) diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1 index 0ea7ef09aa7..8fc97854303 100644 --- a/lisp/erc/ChangeLog.1 +++ b/lisp/erc/ChangeLog.1 @@ -3779,7 +3779,7 @@ doesn't appear). * NEWS: Added the information from - http://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer + https://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer changes which weren't yet documented on that page. 2005-01-06 Hoan Ton-That <hoan@ton-that.org> @@ -8298,7 +8298,7 @@ it doesn't move point to end-of-buffer in non-ERC buffers. Fixed erc-kill-buffer-function so it doesn't run the erc-kill-server-hook hooks if the server connection is closed. Fixed bug 658552, which is described in detail at - http://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125 + https://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125 2002-12-26 Alex Schroeder <alex@gnu.org> diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f128387bcf6..db39e341b2f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6961,6 +6961,8 @@ shortened server name instead." (defvar tabbar--local-hlf) +;; FIXME when 29.1 is cut and `format-spec' is added to ELPA Compat, +;; remove the function invocations from the spec form below. (defun erc-update-mode-line-buffer (buffer) "Update the mode line in a single ERC buffer BUFFER." (with-current-buffer buffer @@ -7325,7 +7327,7 @@ See also `format-spec'." (error "No format spec for message %s" msg)) (when (functionp entry) (setq entry (apply entry args))) - (format-spec entry (apply #'format-spec-make args)))) + (format-spec entry (apply #'format-spec-make args) 'ignore))) ;;; Various hook functions diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 40b83010f94..4b5e4dd53ed 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -372,12 +372,10 @@ Remove the DIRECTORY(ies), if they are empty.") (setq attr (eshell-file-attributes (car files))) (file-attribute-inode-number attr-target) (file-attribute-inode-number attr) - (equal (file-attribute-inode-number attr-target) - (file-attribute-inode-number attr)) (file-attribute-device-number attr-target) (file-attribute-device-number attr) - (equal (file-attribute-device-number attr-target) - (file-attribute-device-number attr))) + (equal (file-attribute-file-identifier attr-target) + (file-attribute-file-identifier attr))) (eshell-error (format-message "%s: `%s' and `%s' are the same file\n" command (car files) target))) (t diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 7e005a0fc1c..bb928fc5fb0 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -277,7 +277,23 @@ Used only on systems which do not support async subprocesses.") eshell-delete-exited-processes delete-exited-processes)) (process-environment (eshell-environment-variables)) + (coding-system-for-read coding-system-for-read) + (coding-system-for-write coding-system-for-write) proc stderr-proc decoding encoding changed) + ;; MS-Windows needs special setting of encoding/decoding, because + ;; (a) non-ASCII text in command-line arguments needs to be + ;; encoded in the system's codepage; and (b) because many Windows + ;; programs will always interpret any non-ASCII input as encoded + ;; in the system codepage. + (when (eq system-type 'windows-nt) + (or coding-system-for-read ; Honor manual decoding settings + (setq coding-system-for-read + (coding-system-change-eol-conversion locale-coding-system + 'dos))) + (or coding-system-for-write ; Honor manual encoding settings + (setq coding-system-for-write + (coding-system-change-eol-conversion locale-coding-system + 'unix)))) (cond ((fboundp 'make-process) (unless (equal (car (aref eshell-current-handles eshell-output-handle)) @@ -325,7 +341,7 @@ Used only on systems which do not support async subprocesses.") (setq decoding (coding-system-change-eol-conversion decoding 'dos) changed t)) ;; Even if `make-process' left the coding system for encoding - ;; data sent from the process undecided, we had better use the + ;; data sent to the process undecided, we had better use the ;; same one as what we use for decoding. But, we should ;; suppress EOL conversion. (if (and decoding (not encoding)) diff --git a/lisp/files-x.el b/lisp/files-x.el index da1e44e2504..0131d495f27 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -489,7 +489,9 @@ from the MODE alist ignoring the input argument VALUE." dir-locals-directory-cache)) ;; Insert modified alist of directory-local variables. - (insert ";;; Directory Local Variables\n") + ;; When changing this, also update the ".dir-locals.el" file for + ;; Emacs itself, as well as the template in autoinsert.el. + (insert ";;; Directory Local Variables -*- no-byte-compile: t -*-\n") (insert ";;; For more information see (info \"(emacs) Directory Variables\")\n\n") (princ (dir-locals-to-string (sort variables diff --git a/lisp/files.el b/lisp/files.el index 43c5d7d1da1..3fa0f2f3b81 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -208,9 +208,10 @@ if the file has changed on disk and you have not edited the buffer." :group 'find-file) (defvar-local buffer-file-number nil - "The device number and file number of the file visited in the current buffer. -The value is a list of the form (FILENUM DEVNUM). -This pair of numbers uniquely identifies the file. + "The inode number and the device of the file visited in the current buffer. +The value is a list of the form (INODENUM DEVICE), where DEVICE can be +either a single number or a cons cell of two numbers. +This tuple of numbers uniquely identifies the file. If the buffer is visiting a new file, the value is nil.") (put 'buffer-file-number 'permanent-local t) @@ -2163,7 +2164,7 @@ If there is no such live buffer, return nil." (setq list (cdr list))) found) (let* ((attributes (file-attributes truename)) - (number (nthcdr 10 attributes)) + (number (file-attribute-file-identifier attributes)) (list (buffer-list)) found) (and buffer-file-numbers-unique (car-safe number) ;Make sure the inode is not just nil. @@ -2366,7 +2367,7 @@ the various files." (let* ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename filename))) (attributes (file-attributes truename)) - (number (nthcdr 10 attributes)) + (number (file-attribute-file-identifier attributes)) ;; Find any buffer for a file that has same truename. (other (and (not buf) (find-buffer-visiting @@ -4744,7 +4745,7 @@ the old visited file has been renamed to the new name FILENAME." (setq buffer-file-name truename)))) (setq buffer-file-number (if filename - (nthcdr 10 (file-attributes buffer-file-name)) + (file-attribute-file-identifier (file-attributes buffer-file-name)) nil)) ;; write-file-functions is normally used for things like ftp-find-file ;; that visit things that are not local files as if they were files. @@ -5733,7 +5734,8 @@ Before and after saving the buffer, this function runs (setq save-buffer-coding-system last-coding-system-used) (setq buffer-file-coding-system last-coding-system-used)) (setq buffer-file-number - (nthcdr 10 (file-attributes buffer-file-name))) + (file-attribute-file-identifier + (file-attributes buffer-file-name))) (if setmodes (condition-case () (progn @@ -6344,9 +6346,10 @@ If FILE1 or FILE2 does not exist, the return value is unspecified." (equal f1-attr f2-attr)))))) (defun file-in-directory-p (file dir) - "Return non-nil if FILE is in DIR or a subdirectory of DIR. -A directory is considered to be \"in\" itself. -Return nil if DIR is not an existing directory." + "Return non-nil if DIR is a parent directory of FILE. +Value is non-nil if FILE is inside DIR or inside a subdirectory of DIR. +A directory is considered to be a \"parent\" of itself. +DIR must be an existing directory, otherwise the function returns nil." (let ((handler (or (find-file-name-handler file 'file-in-directory-p) (find-file-name-handler dir 'file-in-directory-p)))) (if handler @@ -8657,19 +8660,26 @@ It is a nonnegative integer." (defsubst file-attribute-device-number (attributes) "The file system device number in ATTRIBUTES returned by `file-attributes'. -It is an integer." +It is an integer or a cons cell of integers." (nth 11 attributes)) +(defsubst file-attribute-file-identifier (attributes) + "The inode and device numbers in ATTRIBUTES returned by `file-attributes'. +The value is a list of the form (INODENUM DEVICE), where DEVICE could be +either a single number or a cons cell of two numbers. +This tuple of numbers uniquely identifies the file." + (nthcdr 10 attributes)) + (defun file-attribute-collect (attributes &rest attr-names) "Return a sublist of ATTRIBUTES returned by `file-attributes'. ATTR-NAMES are symbols with the selected attribute names. Valid attribute names are: type, link-number, user-id, group-id, access-time, modification-time, status-change-time, size, modes, -inode-number and device-number." +inode-number, device-number and file-number." (let ((all '(type link-number user-id group-id access-time modification-time status-change-time - size modes inode-number device-number)) + size modes inode-number device-number file-number)) result) (while attr-names (let ((attr (pop attr-names))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 67ec0531fa4..5e4e9854a6b 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4361,10 +4361,10 @@ arguments. If METHOD is nil in this case, the return value of the function will be inserted instead. If the buffer already has a\"X-Message-SMTP-Method\" header, it is left unchanged." - :type '(alist :key-type '(choice - (string :tag "From Address") - (function :tag "Predicate")) - :value-type 'string) + :type '(alist :key-type (choice + (string :tag "From Address") + (function :tag "Predicate")) + :value-type string) :version "29.1" :group 'message-sending) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 8646998deb9..8d314706340 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -194,7 +194,7 @@ This can be either \"inline\" or \"attachment\".") nil) (verbatim-marks ;; slrn-style verbatim marks, see - ;; http://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks + ;; https://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks "^#v\\+" "^#v\\-$" ,(lambda () (mm-uu-verbatim-marks-extract 0 0)) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index cdff7c9accf..378ada62475 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -23,7 +23,7 @@ ;;; Commentary: -;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/ +;; For Outlook mail boxes format, see https://mbx2mbox.sourceforge.net/ ;;; Code: diff --git a/lisp/help.el b/lisp/help.el index b4b9120da3e..3f5e57d7d5f 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -112,7 +112,7 @@ buffer.") (define-key map "v" 'describe-variable) (define-key map "w" 'where-is) (define-key map "x" 'describe-command) - (define-key map "q" 'help-quit) + (define-key map "q" 'help-quit-or-quick) map) "Keymap for characters following the Help key.") @@ -125,11 +125,143 @@ buffer.") (defvar help-button-cache nil) + +(defvar help-quick-sections + '(("File" + (save-buffers-kill-terminal . "exit") + (find-file . "find") + (write-file . "write") + (save-buffer . "save") + (save-some-buffers . "all")) + ("Buffer" + (kill-buffer . "kill") + (list-buffers . "list") + (switch-to-buffer . "switch") + (goto-line . "goto line") + (read-only-mode . "read only")) + ("Window" + (delete-window . "only other") + (delete-other-windows . "only this") + (split-window-below . "split vert.") + (split-window-right . "split horiz.") + (other-window . "other window")) + ("Mark & Kill" + (set-mark-command . "mark") + (kill-line . "kill line") + (kill-ring-save . "kill region") + (yank . "yank") + (exchange-point-and-mark . "swap")) + ("Projects" + (project-switch-project . "switch") + (project-find-file . "find file") + (project-find-regexp . "search") + (project-query-replace-regexp . "search & replace") + (project-compile . "compile")) + ("Misc." + (undo . "undo") + (isearch-forward . "search") + (isearch-backward . "reverse search") + (query-replace . "search & replace") + (fill-paragraph . "reformat")))) + +(declare-function prop-match-value "text-property-search" (match)) + +;; Inspired by a mg fork (https://github.com/troglobit/mg) +(defun help-quick () + "Display a quick-help buffer." + (interactive) + (with-current-buffer (get-buffer-create "*Quick Help*") + (let ((inhibit-read-only t) (padding 2) blocks) + + ;; Go through every section and prepare a text-rectangle to be + ;; inserted later. + (dolist (section help-quick-sections) + (let ((max-key-len 0) (max-cmd-len 0) keys) + (dolist (ent (reverse (cdr section))) + (catch 'skip + (let* ((bind (where-is-internal (car ent) nil t)) + (key (if bind + (propertize + (key-description bind) + 'face 'help-key-binding) + (throw 'skip nil)))) + (setq max-cmd-len (max (length (cdr ent)) max-cmd-len) + max-key-len (max (length key) max-key-len)) + (push (list key (cdr ent) (car ent)) keys)))) + (when keys + (let ((fmt (format "%%-%ds %%-%ds%s" max-key-len max-cmd-len + (make-string padding ?\s))) + (width (+ max-key-len 1 max-cmd-len padding))) + (push `(,width + ,(propertize + (concat + (car section) + (make-string (- width (length (car section))) ?\s)) + 'face 'bold) + ,@(mapcar (lambda (ent) + (format fmt + (propertize + (car ent) + 'quick-help-cmd + (caddr ent)) + (cadr ent))) + keys)) + blocks))))) + + ;; Insert each rectangle in order until they don't fit into the + ;; frame any more, in which case the next sections are inserted + ;; in a new "line". + (erase-buffer) + (dolist (block (nreverse blocks)) + (when (> (+ (car block) (current-column)) (frame-width)) + (goto-char (point-max)) + (newline 2)) + (save-excursion + (insert-rectangle (cdr block))) + (end-of-line)) + (delete-trailing-whitespace) + + (save-excursion + (goto-char (point-min)) + (while-let ((match (text-property-search-forward 'quick-help-cmd))) + (make-text-button (prop-match-beginning match) + (prop-match-end match) + 'mouse-face 'highlight + 'button t + 'keymap button-map + 'action #'describe-symbol + 'button-data (prop-match-value match))))) + + (help-mode) + + ;; Display the buffer at the bottom of the frame... + (with-selected-window (display-buffer-at-bottom (current-buffer) '()) + ;; ... mark it as dedicated to prevent focus from being stolen + (set-window-dedicated-p (selected-window) t) + ;; ... and shrink it immediately. + (fit-window-to-buffer)) + (message + (substitute-command-keys "Toggle the quick help buffer using \\[help-quit-or-quick].")))) + +(defalias 'cheat-sheet #'help-quick) + (defun help-quit () "Just exit from the Help command's command loop." (interactive) nil) +(defun help-quit-or-quick () + "Call `help-quit' or `help-quick' depending on the context." + (interactive) + (cond + (help-buffer-under-preparation + ;; FIXME: There should be a better way to detect if we are in the + ;; help command loop. + (help-quit)) + ((and-let* ((window (get-buffer-window "*Quick Help*"))) + (quit-window t window))) + ((help-quick)))) + (defvar help-return-method nil "What to do to \"exit\" the help buffer. This is a list @@ -279,6 +411,7 @@ Do not call this in the scope of `with-help-window'." ("describe-package" "Describe a specific Emacs package") "" ("help-with-tutorial" "Start the Emacs tutorial") + ("help-quick-or-quit" "Display the quick help buffer.") ("view-echo-area-messages" "Show recent messages (from echo area)") ("view-lossage" ,(format "Show last %d input keystrokes (lossage)" diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 693c94eea8c..87bea1017f1 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -156,7 +156,8 @@ line about point in the selected window only." :group 'hl-line ;; If the global mode is switched on, then `M-x hl-line-mode' should ;; switch the mode off in this buffer. - (when global-hl-line-mode + (when (and global-hl-line-mode + (eq arg 'toggle)) (setq hl-line-mode nil) (setq-local global-hl-line-mode nil) (global-hl-line-unhighlight)) diff --git a/lisp/info.el b/lisp/info.el index 292bf93a6f4..fabba2734a3 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -763,6 +763,11 @@ See a list of available Info commands in `Info-mode'." (read-file-name "Info file name: " nil nil t)) (if (numberp current-prefix-arg) (format "*info*<%s>" current-prefix-arg)))) + (when file-or-node + ;; Info node names don't contain newlines, so allow for easier use + ;; of names that might have been wrapped (in emails, etc.). + (setq file-or-node + (string-replace "\n" " " file-or-node))) (info-setup file-or-node (pop-to-buffer-same-window (or buffer "*info*")))) diff --git a/lisp/language/indonesian.el b/lisp/language/indonesian.el index 699f8192543..5afcd27759d 100644 --- a/lisp/language/indonesian.el +++ b/lisp/language/indonesian.el @@ -34,7 +34,8 @@ (input-method . "balinese") (sample-text . "Balinese (ᬅᬓ᭄ᬱᬭᬩᬮᬶ) ᬒᬁᬲ᭄ᬯᬲ᭄ᬢ᭄ᬬᬲ᭄ᬢᬸ") (documentation . "\ -Balinese language and its script are supported in this language environment."))) +Balinese language and its script are supported in this language environment.")) + '("Indonesian")) (set-language-info-alist "Javanese" '((charset unicode) @@ -43,7 +44,8 @@ Balinese language and its script are supported in this language environment."))) (input-method . "javanese") (sample-text . "Javanese (ꦲꦏ꧀ꦱꦫꦗꦮ) ꦲꦭꦺꦴ") (documentation . "\ -Javanese language and its script are supported in this language environment."))) +Javanese language and its script are supported in this language environment.")) + '("Indonesian")) (set-language-info-alist "Sundanese" '((charset unicode) @@ -52,7 +54,8 @@ Javanese language and its script are supported in this language environment."))) (input-method . "sundanese") (sample-text . "Sundanese (ᮃᮊ᮪ᮞᮛᮞᮥᮔ᮪ᮓ) ᮞᮙ᮪ᮕᮥᮛᮞᮥᮔ᮪") (documentation . "\ -Sundanese language and its script are supported in this language environment."))) +Sundanese language and its script are supported in this language environment.")) + '("Indonesian")) (set-language-info-alist "Batak" '((charset unicode) @@ -62,7 +65,8 @@ Sundanese language and its script are supported in this language environment.")) (sample-text . "Batak (ᯘᯮᯒᯗ᯲ᯅᯗᯂ᯲) ᯂᯬᯒᯘ᯲ / ᯔᯧᯐᯬᯀᯱᯐᯬᯀᯱ") (documentation . "\ Languages that use the Batak script, such as Karo, Toba, Pakpak, Mandailing -and Simalungun, are supported in this language environment."))) +and Simalungun, are supported in this language environment.")) + '("Indonesian")) (set-language-info-alist "Rejang" '((charset unicode) @@ -71,7 +75,8 @@ and Simalungun, are supported in this language environment."))) (input-method . "rejang") (sample-text . "Rejang (ꥆꤰ꥓ꤼꤽ ꤽꥍꤺꥏ) ꤸꥉꥐꤺꥉꥂꥎ") (documentation . "\ -Rejang language and its script are supported in this language environment."))) +Rejang language and its script are supported in this language environment.")) + '("Indonesian")) (set-language-info-alist "Makasar" '((charset unicode) @@ -80,7 +85,8 @@ Rejang language and its script are supported in this language environment."))) (input-method . "makasar") (sample-text . "Makasar (𑻪𑻢𑻪𑻢) 𑻦𑻤𑻵𑻱") (documentation . "\ -Makassarese language and its script Makasar are supported in this language environment."))) +Makassarese language and its script Makasar are supported in this language environment.")) + '("Indonesian")) (set-language-info-alist "Buginese" '((charset unicode) @@ -89,7 +95,8 @@ Makassarese language and its script Makasar are supported in this language envir (input-method . "lontara") (sample-text . "Buginese (ᨒᨚᨈᨑ) ᨖᨒᨚ") (documentation . "\ -Buginese language and its script Lontara are supported in this language environment."))) +Buginese language and its script Lontara are supported in this language environment.")) + '("Indonesian")) ;; Balinese composition rules (let ((consonant "[\x1B13-\x1B33\x1B45-\x1B4B]") diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index 370be4b4a39..c34017d9b3a 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -228,7 +228,8 @@ thin (i.e. 1-dot width) space." (sample-text . "Hanifi Rohingya (𐴌𐴟𐴇𐴥𐴝𐴚𐴒𐴙𐴝 𐴇𐴝𐴕𐴞𐴉𐴞 𐴓𐴠𐴑𐴤𐴝) 𐴀𐴝𐴏𐴓𐴝𐴀𐴡𐴤𐴛𐴝𐴓𐴝𐴙𐴑𐴟𐴔") (documentation . "\ Rohingya language and its script Hanifi Rohingya are supported -in this language environment."))) +in this language environment.")) + '("Misc")) ;; Hanifi Rohingya composition rules (set-char-table-range @@ -251,7 +252,8 @@ in this language environment."))) (sample-text . "Kharoṣṭhī (𐨑𐨪𐨆𐨛𐨁) 𐨣𐨨𐨲𐨪𐨆 𐨐𐨪𐨅𐨨𐨁") (documentation . "\ Language environment for Gāndhārī, Sanskrit, and other languages -using the Kharoṣṭhī script."))) +using the Kharoṣṭhī script.")) + '("Misc")) (let ((consonant "[\U00010A00\U00010A10-\U00010A35]") (vowel "[\U00010A01-\U00010A06]") @@ -281,7 +283,8 @@ using the Kharoṣṭhī script."))) (sample-text . "Adlam (𞤀𞤣𞤤𞤢𞤥) 𞤅𞤢𞤤𞤢𞥄𞤥") (documentation . "\ Fulani language and its script Adlam are supported -in this language environment."))) +in this language environment.")) + '("Misc")) ;; Adlam composition rules (set-char-table-range @@ -303,7 +306,8 @@ in this language environment."))) (sample-text . "Mende Kikakui (𞠀𞠁𞠂) 𞠛𞠉") (documentation . "\ Mende language and its script Kikakui are supported -in this language environment."))) +in this language environment.")) + '("Misc")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Gothic @@ -317,7 +321,8 @@ in this language environment."))) (sample-text . "Gothic (𐌲𐌿𐍄𐌹𐍃𐌺𐌰) 𐌷𐌰𐌹𐌻𐍃 / 𐌷𐌰𐌹𐌻𐌰") (documentation . "\ Ancient Gothic language using the Gothic script is supported in this -language environment."))) +language environment.")) + '("Misc")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Coptic @@ -331,7 +336,8 @@ language environment."))) (sample-text . "Coptic (ⲘⲉⲧⲢⲉⲙ̀ⲛⲭⲏⲙⲓ) Ⲛⲟⲩϥⲣⲓ") (documentation . "\ Coptic language using the Coptic script is supported in this -language environment."))) +language environment.")) + '("Misc")) (provide 'misc-lang) diff --git a/lisp/language/philippine.el b/lisp/language/philippine.el index e52ad6912cd..ce619bdaa1d 100644 --- a/lisp/language/philippine.el +++ b/lisp/language/philippine.el @@ -35,7 +35,8 @@ (sample-text . "Tagalog (ᜊᜌ᜔ᜊᜌᜒᜈ᜔) ᜃᜓᜋᜓᜐ᜔ᜆ") (documentation . "\ Tagalog language using the Baybayin script is supported in -this language environment."))) +this language environment.")) + '("Philippine")) (set-language-info-alist "Hanunoo" '((charset unicode) @@ -44,7 +45,8 @@ this language environment."))) (input-method . "hanunoo") (sample-text . "Hanunoo (ᜱᜨᜳᜨᜳᜢ) ᜫᜬᜧ᜴ ᜣᜭᜯᜥ᜴ ᜰᜲᜭᜥ᜴") (documentation . "\ -Philippine Language Hanunoo is supported in this language environment."))) +Philippine Language Hanunoo is supported in this language environment.")) + '("Philippine")) (set-language-info-alist "Buhid" '((charset unicode) @@ -52,7 +54,8 @@ Philippine Language Hanunoo is supported in this language environment."))) (coding-priority utf-8) (input-method . "buhid") (documentation . "\ -Philippine Language Buhid is supported in this language environment."))) +Philippine Language Buhid is supported in this language environment.")) + '("Philippine")) (set-language-info-alist "Tagbanwa" '((charset unicode) @@ -61,7 +64,8 @@ Philippine Language Buhid is supported in this language environment."))) (input-method . "tagbanwa") (sample-text . "Tagbanwa (ᝦᝪᝯ) ᝫᝩᝬᝥ ᝣᝮᝧᝯ") (documentation . "\ -Philippine Languages Tagbanwa are supported in this language environment."))) +Philippine Languages Tagbanwa are supported in this language environment.")) + '("Philippine")) ;; Tagalog composition rules (let ((akshara "[\x1700-\x1711\x171F]") diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index c9502fbb212..517b23b1ea9 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -15397,7 +15397,7 @@ it is disabled. ;;; Generated autoloads from progmodes/hideshow.el -(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\ +(defvar hs-special-modes-alist (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\ Alist for initializing the hideshow variables for different modes. Each element has the form (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC @@ -18847,6 +18847,8 @@ done. Otherwise, this function will use the current buffer. Major mode for browsing CVS log output. (fn)" t) +(autoload 'log-view-get-marked "log-view" "\ +Return the list of tags for the marked log entries.") (register-definition-prefixes "log-view" '("log-view-")) @@ -24534,7 +24536,7 @@ Open profile FILENAME. ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 8 1)) package--builtin-versions) +(push (purecopy '(project 0 8 2)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -25926,6 +25928,9 @@ The mode's hook is called both when the mode is enabled and when it is disabled. (fn &optional ARG)" t) +(autoload 'repeat-exit "repeat" "\ +Exit the repeating sequence. +This function can be used to force exit of repetition while it's active." t) (register-definition-prefixes "repeat" '("describe-repeat-maps" "repeat-")) @@ -29436,6 +29441,8 @@ PROMPT will be inserted at the start of the buffer, but won't be included in the resulting string. If PROMPT is nil, no help text will be inserted. +Also see `read-string-from-buffer'. + (fn PROMPT STRING SUCCESS-CALLBACK &key ABORT-CALLBACK)") (autoload 'read-string-from-buffer "string-edit" "\ Switch to a new buffer to edit STRING in a recursive edit. @@ -29445,6 +29452,8 @@ PROMPT will be inserted at the start of the buffer, but won't be included in the resulting string. If nil, no prompt will be inserted in the buffer. +Also see `string-edit'. + (fn PROMPT STRING)") (register-definition-prefixes "string-edit" '("string-edit-")) @@ -32000,14 +32009,14 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar (register-definition-prefixes "tramp-compat" '("tramp-")) -;;; Generated autoloads from net/tramp-crypt.el +;;; Generated autoloads from net/tramp-container.el -(register-definition-prefixes "tramp-crypt" '("tramp-crypt-")) +(register-definition-prefixes "tramp-container" '("tramp-")) -;;; Generated autoloads from net/tramp-docker.el +;;; Generated autoloads from net/tramp-crypt.el -(register-definition-prefixes "tramp-docker" '("tramp-docker-")) +(register-definition-prefixes "tramp-crypt" '("tramp-crypt-")) ;;; Generated autoloads from net/tramp-ftp.el @@ -32740,6 +32749,10 @@ if it had been inserted from a file named URL. (fn URL &optional VISIT BEG END REPLACE)") +(autoload 'url-insert-file-contents-literally "url-handlers" "\ +Insert the data retrieved from URL literally in the current buffer. + +(fn URL)") (register-definition-prefixes "url-handlers" '("url-")) @@ -33440,11 +33453,13 @@ Show the change log for BRANCH root in a window. (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. +In some version control systems REMOTE-LOCATION can be a remote branch name. (fn &optional REMOTE-LOCATION)" t) (autoload 'vc-log-outgoing "vc" "\ Show log of changes that will be sent with a push operation to REMOTE-LOCATION. When called interactively with a prefix argument, prompt for REMOTE-LOCATION. +In some version control systems REMOTE-LOCATION can be a remote branch name. (fn &optional REMOTE-LOCATION)" t) (autoload 'vc-log-search "vc" "\ @@ -33571,6 +33586,18 @@ log entries should be gathered. Request editing the next VC shell command before execution. This is a prefix command. It affects only a VC command executed immediately after this one." t) +(autoload 'vc-prepare-patch "vc" "\ +Compose an Email sending patches for REVISIONS to ADDRESSEE. +If `vc-prepare-patches-separately' is nil, SUBJECT will be used +as the default subject for the message (and it will be prompted +for when called interactively). Otherwise a separate message +will be composed for each revision, with SUBJECT derived from the +invidividual commits. + +When invoked interactively in a Log View buffer with marked +revisions, those revisions will be used. + +(fn ADDRESSEE SUBJECT REVISIONS)" t) (register-definition-prefixes "vc" '("vc-" "with-vc-properties")) @@ -34565,10 +34592,6 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics." t) ;;; Generated autoloads from view.el -(defvar view-remove-frame-by-deleting t "\ -Determine how View mode removes a frame no longer needed. -If nil, make an icon of the frame. If non-nil, delete the frame.") -(custom-autoload 'view-remove-frame-by-deleting "view" t) (defvar-local view-mode nil "\ Non-nil if View mode is enabled. Don't change this variable directly, you must change it by one of the @@ -36122,7 +36145,13 @@ Extract file name from an yenc header.") ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ -Zone out, completely." t) +Zone out, completely. +With a prefix argument the user is prompted for a program to run. +When called from Lisp the optional argument PGM can be used to +run a specific program. The program must be a member of +`zone-programs'. + +(fn &optional PGM)" t) (register-definition-prefixes "zone" '("zone-")) ;;; End of scraped data diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index be1b7642eb3..38a8216dc0c 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -402,7 +402,7 @@ information can be used so that you can replace multiple Bogofilter is a Bayesian spam filtering program. Get it from your local distribution or from the bogofilter web site at URL -`http://bogofilter.sourceforge.net/'. +`https://bogofilter.sourceforge.io/'. Bogofilter is taught by running: @@ -487,7 +487,7 @@ See `mh-bogofilter-blocklist' for more information." SpamProbe is a Bayesian spam filtering program. Get it from your local distribution or from the SpamProbe web site at URL -`http://spamprobe.sourceforge.net'. +`https://spamprobe.sourceforge.net'. To use SpamProbe, add the following recipes to \".procmailrc\": diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 2d528c4862c..1597f3651a5 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1294,6 +1294,11 @@ currently selected window instead." (let ((file (url-unhex-string (url-filename parsed)))) (when-let ((coding (browse-url--file-name-coding-system))) (setq file (decode-coding-string file 'utf-8))) + ;; The local-part of file: URLs on Windows is supposed to + ;; start with an extra slash. + (when (eq system-type 'windows-nt) + (setq file (replace-regexp-in-string + "\\`/\\([a-z]:\\)" "\\1" file))) (funcall func file)) (let ((file-name-handler-alist (cons (cons url-handler-regexp 'url-file-handler) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index fa481ce5283..eadaf00c4b8 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2176,9 +2176,11 @@ connection." (defun rcirc-generate-log-filename (process target) "Return filename for log file based on PROCESS and TARGET." - (if target - (rcirc-generate-new-buffer-name process target) - (process-name process))) + (concat + (if target + (rcirc-generate-new-buffer-name process target) + (process-name process)) + ".log")) (defcustom rcirc-log-filename-function 'rcirc-generate-log-filename "A function to generate the filename used by rcirc's logging facility. @@ -3018,11 +3020,7 @@ for nick completion." :version "29.1") (defface rcirc-bridged-nick - '((((class color) (min-colors 88) (background light)) :background "SlateGray1") - (((class color) (min-colors 88) (background dark)) :background "DarkSlateGray4") - (((class color) (min-colors 16) (background light)) :background "LightBlue") - (((class color) (min-colors 16) (background dark)) :background "DarkSlateGray") - (t :background "blue")) + '((t :inherit highlight)) "Face used for pseudo-nick ." :version "29.1") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 03dc47a053f..4ff57e5d560 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1088,34 +1088,18 @@ Derived from `tramp-postfix-host-format'.") (defun tramp-build-remote-file-name-spec-regexp () "Construct a regexp matching a Tramp file name for a Tramp syntax. It is expected, that `tramp-syntax' has the proper value." - ;; Starting with Emacs 27, we can use `rx-let'. - (let* ((user-regexp - (tramp-compat-rx - (group-n 6 (regexp tramp-user-regexp)) - (regexp tramp-postfix-user-regexp))) - (host-regexp - (tramp-compat-rx - (group-n 7 (| (regexp tramp-host-regexp) - (: (regexp tramp-prefix-ipv6-regexp) - (? (regexp tramp-ipv6-regexp)) - (regexp tramp-postfix-ipv6-regexp))) - ;; Optional port. - (? (regexp tramp-prefix-port-regexp) - (regexp tramp-port-regexp))))) - (user-host-regexp - (if (eq tramp-syntax 'simplified) - ;; There must be either user or host. - (tramp-compat-rx - (| (: (regexp user-regexp) (? (regexp host-regexp))) - (: (? (regexp user-regexp)) (regexp host-regexp)))) - (tramp-compat-rx - (? (regexp user-regexp)) (? (regexp host-regexp)))))) - (tramp-compat-rx - ;; Method. - (group-n 5 (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - ;; User and host. - (regexp user-host-regexp)))) + (tramp-compat-rx + ;; Method. + (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) + ;; Optional user. This includes domain. + (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp)) + ;; Optional host. + (? (group (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp)) + (regexp tramp-postfix-ipv6-regexp))) + ;; Optional port. + (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)))))) (defvar tramp-remote-file-name-spec-regexp nil ; Initialized when defining `tramp-syntax'! @@ -1214,7 +1198,8 @@ The `ftp' syntax does not support methods.") ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also ;; `tramp-drop-volume-letter'. (? (regexp tramp-volume-letter-regexp)) - (regexp tramp-prefix-regexp) + ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'. + (literal tramp-prefix-format) ;; Optional multi hops. (* (regexp tramp-remote-file-name-spec-regexp) @@ -1862,7 +1847,8 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." tramp-prefix-regexp "" (replace-regexp-in-string (tramp-compat-rx - (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format + (regexp tramp-postfix-host-regexp) eos) + tramp-postfix-hop-format (tramp-make-tramp-file-name vec 'noloc))))) (defun tramp-completion-make-tramp-file-name (method user host localname) diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el index 4ee090e4ac7..f50da0ea434 100644 --- a/lisp/org/ob-matlab.el +++ b/lisp/org/ob-matlab.el @@ -32,7 +32,7 @@ ;; matlab.el required for interactive emacs sessions and matlab-mode ;; major mode for source code editing buffer -;; http://matlab-emacs.sourceforge.net/ +;; https://matlab-emacs.sourceforge.net/ ;;; Code: (require 'ob) diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index ced00fbdda4..7a495e8e7f4 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -30,7 +30,7 @@ ;;; Requirements: -;; plantuml | http://plantuml.sourceforge.net/ +;; plantuml | https://plantuml.com/ ;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when exec mode is `jar') ;;; Code: diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 6fc97ca399d..67db49e9a67 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -47,7 +47,7 @@ ;; ;; Install org mode ;; Ensure org-ctags.el is somewhere in your emacs load path. -;; Download and install Exuberant ctags -- "http://ctags.sourceforge.net/" +;; Download and install Exuberant ctags -- "https://ctags.sourceforge.net/" ;; Edit your .emacs file (see next section) and load emacs. ;; To put in your init file (.emacs): diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 7c4de03bc24..7a91a33b745 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -66,7 +66,7 @@ ;; ;; ;; As of March 2009 Firefox users follow the steps documented on -;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here: +;; https://kb.mozillazine.org/Register_protocol, Opera setup is described here: ;; http://www.opera.com/support/kb/view/535/ ;; ;; diff --git a/lisp/outline.el b/lisp/outline.el index 93a9247f613..b87d3ac5e7f 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -516,13 +516,7 @@ See the command `outline-mode' for more information on this mode." (set-window-buffer nil (window-buffer))) (when (or outline--use-buttons outline--use-margins) (add-hook 'after-change-functions - (lambda (beg end _len) - (when outline--use-buttons - (remove-overlays beg end 'outline-button t)) - (when outline--use-margins - (remove-overlays beg end 'outline-margin t)) - (outline--fix-up-all-buttons beg end)) - nil t)) + #'outline--fix-buttons-after-change nil t)) (when outline-minor-mode-highlight (if (and global-font-lock-mode (font-lock-specified-p major-mode)) (progn @@ -1065,107 +1059,6 @@ If non-nil, EVENT should be a mouse event." (mouse-set-point event)) (outline-flag-subtree t))) -(defun outline--make-button-overlay (type) - (let ((o (seq-find (lambda (o) - (overlay-get o 'outline-button)) - (overlays-at (point))))) - (unless o - (setq o (make-overlay (point) (1+ (point)))) - (overlay-put o 'evaporate t) - (overlay-put o 'follow-link 'mouse-face) - (overlay-put o 'mouse-face 'highlight) - (overlay-put o 'outline-button t)) - (let ((icon (icon-elements (if (eq type 'close) - (if outline--use-rtl - 'outline-close-rtl - 'outline-close) - 'outline-open))) - (inhibit-read-only t)) - ;; In editing buffers we use overlays only, but in other buffers - ;; we use a mix of text properties, text and overlays to make - ;; movement commands work more logically. - (when (derived-mode-p 'special-mode) - (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face))) - (if-let ((image (plist-get icon 'image))) - (overlay-put o 'display image) - (overlay-put o 'display (concat (plist-get icon 'string) - (string (char-after (point))))) - (overlay-put o 'face (plist-get icon 'face)))) - o)) - -(defun outline--make-margin-overlay (type) - (let ((o (seq-find (lambda (o) - (overlay-get o 'outline-margin)) - (overlays-at (point))))) - (unless o - (setq o (make-overlay (point) (1+ (point)))) - (overlay-put o 'evaporate t) - (overlay-put o 'outline-margin t)) - (let ((icon (icon-elements (if (eq type 'close) - (if outline--use-rtl - 'outline-close-rtl-in-margins - 'outline-close-in-margins) - 'outline-open-in-margins))) - (inhibit-read-only t)) - (overlay-put - o 'before-string - (propertize " " 'display - `((margin ,(if outline--use-rtl - 'right-margin 'left-margin)) - ,(or (plist-get icon 'image) - (plist-get icon 'string)))))) - o)) - -(defun outline--insert-open-button (&optional use-margins) - (with-silent-modifications - (save-excursion - (beginning-of-line) - (if use-margins - (outline--make-margin-overlay 'open) - (when (derived-mode-p 'special-mode) - (let ((inhibit-read-only t)) - (insert " ") - (beginning-of-line))) - (let ((o (outline--make-button-overlay 'open))) - (overlay-put o 'help-echo "Click to hide") - (overlay-put o 'keymap - (define-keymap - "RET" #'outline-hide-subtree - "<mouse-2>" #'outline-hide-subtree))))))) - -(defun outline--insert-close-button (&optional use-margins) - (with-silent-modifications - (save-excursion - (beginning-of-line) - (if use-margins - (outline--make-margin-overlay 'close) - (when (derived-mode-p 'special-mode) - (let ((inhibit-read-only t)) - (insert " ") - (beginning-of-line))) - (let ((o (outline--make-button-overlay 'close))) - (overlay-put o 'help-echo "Click to show") - (overlay-put o 'keymap - (define-keymap - "RET" #'outline-show-subtree - "<mouse-2>" #'outline-show-subtree))))))) - -(defun outline--fix-up-all-buttons (&optional from to) - (when (or outline--use-buttons outline--use-margins) - (when from - (save-excursion - (goto-char from) - (setq from (line-beginning-position)))) - (outline-map-region - (lambda () - (if (save-excursion - (outline-end-of-heading) - (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline)) - (overlays-at (point)))) - (outline--insert-close-button outline--use-margins) - (outline--insert-open-button outline--use-margins))) - (or from (point-min)) (or to (point-max))))) - (define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1") (defun outline-hide-leaves () @@ -1451,6 +1344,9 @@ convenient way to make a table of contents of the buffer." (insert "\n\n")))))) (kill-new (buffer-string))))))) + +;;; Initial visibility + (defcustom outline-default-state nil "If non-nil, some headings are initially outlined. @@ -1629,6 +1525,9 @@ LEVEL, decides of subtree visibility according to beg end))) (run-hooks 'outline-view-change-hook))) + +;;; Visibility cycling + (defun outline--cycle-state () "Return the cycle state of current heading. Return either `hide-all', `headings-only', or `show-all'." @@ -1742,6 +1641,119 @@ With a prefix argument, show headings up to that LEVEL." (message "Show all"))))) +;;; Button/margin indicators + +(defun outline--make-button-overlay (type) + (let ((o (seq-find (lambda (o) + (overlay-get o 'outline-button)) + (overlays-at (point))))) + (unless o + (setq o (make-overlay (point) (1+ (point)))) + (overlay-put o 'evaporate t) + (overlay-put o 'follow-link 'mouse-face) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'outline-button t)) + (let ((icon (icon-elements (if (eq type 'close) + (if outline--use-rtl + 'outline-close-rtl + 'outline-close) + 'outline-open))) + (inhibit-read-only t)) + ;; In editing buffers we use overlays only, but in other buffers + ;; we use a mix of text properties, text and overlays to make + ;; movement commands work more logically. + (when (derived-mode-p 'special-mode) + (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face))) + (if-let ((image (plist-get icon 'image))) + (overlay-put o 'display image) + (overlay-put o 'display (concat (plist-get icon 'string) + (string (char-after (point))))) + (overlay-put o 'face (plist-get icon 'face)))) + o)) + +(defun outline--make-margin-overlay (type) + (let ((o (seq-find (lambda (o) + (overlay-get o 'outline-margin)) + (overlays-at (point))))) + (unless o + (setq o (make-overlay (point) (1+ (point)))) + (overlay-put o 'evaporate t) + (overlay-put o 'outline-margin t)) + (let ((icon (icon-elements (if (eq type 'close) + (if outline--use-rtl + 'outline-close-rtl-in-margins + 'outline-close-in-margins) + 'outline-open-in-margins)))) + (overlay-put + o 'before-string + (propertize " " 'display + `((margin ,(if outline--use-rtl + 'right-margin 'left-margin)) + ,(or (plist-get icon 'image) + (plist-get icon 'string)))))) + o)) + +(defun outline--insert-open-button (&optional use-margins) + (with-silent-modifications + (save-excursion + (beginning-of-line) + (if use-margins + (outline--make-margin-overlay 'open) + (when (derived-mode-p 'special-mode) + (let ((inhibit-read-only t)) + (insert " ") + (beginning-of-line))) + (let ((o (outline--make-button-overlay 'open))) + (overlay-put o 'help-echo "Click to hide") + (overlay-put o 'keymap + (define-keymap + "RET" #'outline-hide-subtree + "<mouse-2>" #'outline-hide-subtree))))))) + +(defun outline--insert-close-button (&optional use-margins) + (with-silent-modifications + (save-excursion + (beginning-of-line) + (if use-margins + (outline--make-margin-overlay 'close) + (when (derived-mode-p 'special-mode) + (let ((inhibit-read-only t)) + (insert " ") + (beginning-of-line))) + (let ((o (outline--make-button-overlay 'close))) + (overlay-put o 'help-echo "Click to show") + (overlay-put o 'keymap + (define-keymap + "RET" #'outline-show-subtree + "<mouse-2>" #'outline-show-subtree))))))) + +(defun outline--fix-up-all-buttons (&optional from to) + (when (or outline--use-buttons outline--use-margins) + (when from + (save-excursion + (goto-char from) + (setq from (line-beginning-position)))) + (outline-map-region + (lambda () + (if (save-excursion + (outline-end-of-heading) + (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline)) + (overlays-at (point)))) + (outline--insert-close-button outline--use-margins) + (outline--insert-open-button outline--use-margins))) + (or from (point-min)) (or to (point-max))))) + +(defun outline--fix-buttons-after-change (beg end _len) + ;; Handle whole lines + (save-excursion (goto-char beg) (setq beg (pos-bol))) + (save-excursion (goto-char end) (setq end (pos-eol))) + (when outline--use-buttons + (remove-overlays beg end 'outline-button t)) + (when outline--use-margins + (remove-overlays beg end 'outline-margin t)) + (outline--fix-up-all-buttons beg end)) + + (defvar-keymap outline-navigation-repeat-map "C-b" #'outline-backward-same-level "b" #'outline-backward-same-level diff --git a/lisp/play/zone.el b/lisp/play/zone.el index b0ce0194cf0..5ea5bbc9267 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -103,9 +103,24 @@ If the element is a function or a list of a function and a number, program)))) ;;;###autoload -(defun zone () - "Zone out, completely." - (interactive) +(defun zone (&optional pgm) + "Zone out, completely. +With a prefix argument the user is prompted for a program to run. +When called from Lisp the optional argument PGM can be used to +run a specific program. The program must be a member of +`zone-programs'." + (interactive + (and current-prefix-arg + (let ((choice (completing-read + "Program: " + (mapcar + (lambda (prog) + (substring (symbol-name prog) 9)) + zone-programs) + nil t))) + (list (intern (concat "zone-pgm-" choice)))))) + (unless pgm + (setq pgm (aref zone-programs (random (length zone-programs))))) (save-window-excursion (let ((f (selected-frame)) (outbuf (get-buffer-create "*zone*")) @@ -125,8 +140,7 @@ If the element is a function or a list of a function and a number, (set-window-start (selected-window) (point-min)) (set-window-point (selected-window) wp) (sit-for 0 500) - (let ((pgm (elt zone-programs (random (length zone-programs)))) - (ct (and f (frame-parameter f 'cursor-type))) + (let ((ct (and f (frame-parameter f 'cursor-type))) (show-trailing-whitespace nil) restore) (when ct diff --git a/lisp/printing.el b/lisp/printing.el index 0654dcda3df..767648df4d5 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -944,7 +944,7 @@ ;; `https://www.gnu.org/software/ghostscript/ghostscript.html' ;; gsprint `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. ;; enscript `https://people.ssh.fi/mtr/genscript/' -;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm' +;; psnup `https://gnuwin32.sourceforge.net/packages/psutils.htm' ;; redmon `http://www.ghostgum.com.au/software/redmon.htm' ;; ;; @@ -1752,7 +1752,7 @@ Useful links: `https://linux.die.net/man/1/lp' * GNU utilities for w32 (cp.exe) - `http://unxutils.sourceforge.net/'" + `https://unxutils.sourceforge.net/'" :type '(repeat (list :tag "PostScript Printer" @@ -2382,7 +2382,7 @@ Useful links: `http://gershwin.ens.fr/vdaniel/Doc-Locale/Outils-Gnu-Linux/PsUtils/' * psnup (PsUtils for Windows) - `http://gnuwin32.sourceforge.net/packages/psutils.htm' + `https://gnuwin32.sourceforge.net/packages/psutils.htm' * psnup documentation (GNU or Unix - or type `man psnup') `https://linux.die.net/man/1/psnup' diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 733deebdf53..1aee1107e62 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -5,7 +5,7 @@ ;; Author: Christoph Wedler <Christoph.Wedler@sap.com> ;; Keywords: languages, ANTLR, code generator ;; Version: 2.2c -;; URL: http://antlr-mode.sourceforge.net/ +;; URL: https://antlr-mode.sourceforge.net/ ;; This file is part of GNU Emacs. @@ -29,7 +29,7 @@ ;; supported options and various other things like running ANTLR from within ;; Emacs. -;; For details, check <http://antlr-mode.sourceforge.net/> or, if you prefer +;; For details, check <https://antlr-mode.sourceforge.net/> or, if you prefer ;; the manual style, follow all commands mentioned in the documentation of ;; `antlr-mode'. ANTLR is a LL(k)-based recognition tool which generates ;; lexers, parsers and tree transformers in Java, C++ or Sather and can be @@ -106,12 +106,12 @@ "Major mode for ANTLR grammar files." :group 'languages :link '(emacs-commentary-link "antlr-mode.el") - :link '(url-link "http://antlr-mode.sourceforge.net/") + :link '(url-link "https://antlr-mode.sourceforge.net/") :prefix "antlr-") (defconst antlr-version "2.2c" "ANTLR major mode version number. -Check <http://antlr-mode.sourceforge.net/> for the newest.") +Check <https://antlr-mode.sourceforge.net/> for the newest.") ;;;=========================================================================== diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 0ac96219a19..223b1e917fe 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -8356,6 +8356,23 @@ multi-line strings (but not C++, for example)." (goto-char here)))) t) +(defun c-forward-over-colon-type-list () + ;; If we're at a sequence of characters which can extend from, e.g., + ;; a class name up to a colon introducing an inheritance list, + ;; move forward over them, including the colon, and return non-nil. + ;; Otherwise return nil, leaving point unmoved. + (let ((here (point)) pos) + (while (and (re-search-forward c-sub-colon-type-list-re nil t) + (not (eq (char-after) ?:)) + (c-major-mode-is 'c++-mode) + (setq pos (c-looking-at-c++-attribute))) + (goto-char pos)) + (if (eq (char-after) ?:) + (progn (forward-char) + t) + (goto-char here) + nil))) + (defun c-forward-keyword-clause (match) ;; Submatch MATCH in the current match data is assumed to surround a ;; token. If it's a keyword, move over it and any immediately @@ -8463,12 +8480,11 @@ multi-line strings (but not C++, for example)." (and c-record-type-identifiers (progn ;; If a keyword matched both one of the types above and - ;; this one, we match `c-colon-type-list-re' after the + ;; this one, we move forward to the colon following the ;; clause matched above. (goto-char safe-pos) - (looking-at c-colon-type-list-re)) + (c-forward-over-colon-type-list)) (progn - (goto-char (match-end 0)) (c-forward-syntactic-ws) (c-forward-keyword-prefixed-id type)) ;; There's a type after the `c-colon-type-list-re' match @@ -8921,8 +8937,16 @@ multi-line strings (but not C++, for example)." ;; Got some other operator. (setq c-last-identifier-range (cons (point) (match-end 0))) + (if (and (eq (char-after) ?\") + (eq (char-after (1+ (point))) ?\")) + ;; operator"" has an (?)optional tag after it. + (progn + (goto-char (match-end 0)) + (c-forward-syntactic-ws lim+) + (when (c-on-identifier) + (c-forward-token-2 1 nil lim+))) (goto-char (match-end 0)) - (c-forward-syntactic-ws lim+) + (c-forward-syntactic-ws lim+)) (setq pos (point) res 'operator))) @@ -9676,7 +9700,7 @@ point unchanged and return nil." ;; (e.g. "," or ";" or "}"). (let ((here (point)) id-start id-end brackets-after-id paren-depth decorated - got-init arglist) + got-init arglist double-double-quote) (or limit (setq limit (point-max))) (if (and (< (point) limit) @@ -9705,6 +9729,10 @@ point unchanged and return nil." (setq id-start (point)) (if (looking-at c-overloadable-operators-regexp) (progn + (when (and (c-major-mode-is 'c++-mode) + (eq (char-after) ?\") + (eq (char-after (1+ (point))) ?\")) + (setq double-double-quote t)) (goto-char (match-end 0)) (c-forward-syntactic-ws limit) (setq got-identifier t) @@ -9756,6 +9784,13 @@ point unchanged and return nil." t) (t nil))) + (progn + (c-forward-syntactic-ws limit) + (when (and double-double-quote ; C++'s operator"" _tag + (c-on-identifier)) + (c-forward-token-2 1 nil limit)) + t) + ;; Skip out of the parens surrounding the identifier. If closing ;; parens are missing, this form returns nil. (or (= paren-depth 0) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 2e71285cb36..b4ff32b9070 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1141,12 +1141,28 @@ casts and declarations are fontified. Used on level 2 and higher." (while (and (< (point) id-end) (re-search-forward c-opt-identifier-prefix-key id-end t)) (c-forward-syntactic-ws limit)))) - (when (not (get-text-property (point) 'face)) + ;; Only apply the face when the text doesn't have one yet. + ;; Exception: The "" in C++'s operator"" will already wrongly have + ;; string face. + (when (memq (get-text-property (point) 'face) + '(nil font-lock-string-face)) (c-put-font-lock-face (point) id-end (cond ((not (memq types '(nil t))) types) (is-function 'font-lock-function-name-face) - (t 'font-lock-variable-name-face)))))) + (t 'font-lock-variable-name-face)))) + ;; Fontify any _tag in C++'s operator"" _tag. + (when (and + (c-major-mode-is 'c++-mode) + (equal (buffer-substring-no-properties id-start id-end) + "\"\"")) + (goto-char id-end) + (c-forward-syntactic-ws limit) + (when (c-on-identifier) + (c-put-font-lock-face + (point) + (progn (c-forward-over-token) (point)) + font-lock-function-name-face))))) (and template-class (eq init-char ?=) ; C++ "<class X = Y>"? (progn diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index cd23483a58f..b17718cfd54 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -93,7 +93,7 @@ ;; definitions (i.e. this file and/or cc-fonts.el) if necessary. ;; ;; A small example of a derived mode is available at -;; <http://cc-mode.sourceforge.net/derived-mode-ex.el>. It also +;; <https://cc-mode.sourceforge.net/derived-mode-ex.el>. It also ;; contains some useful hints for derived mode developers. ;;; Using language variables: @@ -1449,8 +1449,7 @@ form\". See also `c-op-identifier-prefix'." "??'=" "xor_eq" "&=" "and_eq" "|=" "??!=" "or_eq" "<<" ">>" ">>=" "<<=" "==" "!=" "not_eq" "<=>" "<=" ">=" "&&" "and" "||" "??!??!" "or" "++" "--" "," "->*" "->" - "()" "[]" "<::>" "??(??)") - ;; These work like identifiers in Pike. + "()" "[]" "\"\"" "<::>" "??(??)") pike '("`+" "`-" "`&" "`|" "`^" "`<<" "`>>" "`*" "`/" "`%" "`~" "`==" "`<" "`>" "`!" "`[]" "`[]=" "`->" "`->=" "`()" "``+" "``-" "``&" "``|" "``^" "``<<" "``>>" "``*" "``/" "``%" @@ -2936,6 +2935,15 @@ regexp if `c-colon-type-list-kwds' isn't nil." "[^][{}();,/#=:]*:"))) (c-lang-defvar c-colon-type-list-re (c-lang-const c-colon-type-list-re)) +(c-lang-defconst c-sub-colon-type-list-re + "Regexp matching buffer content that may come between a keyword in +`c-colon-type-list-kwds' and a putative colon, or nil if there are no +such keywords. Exception: it does not match any C++ attributes." + t (if (c-lang-const c-colon-type-list-re) + (substring (c-lang-const c-colon-type-list-re) 0 -1))) +(c-lang-defvar c-sub-colon-type-list-re + (c-lang-const c-sub-colon-type-list-re)) + (c-lang-defconst c-paren-nontype-kwds "Keywords that may be followed by a parenthesis expression that doesn't contain type identifiers." diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 2003b09ded2..dce300f33c9 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -66,12 +66,12 @@ ;; You can get the latest version of CC Mode, including PostScript ;; documentation and separate individual files from: ;; -;; http://cc-mode.sourceforge.net/ +;; https://cc-mode.sourceforge.net/ ;; ;; You can join a moderated CC Mode announcement-only mailing list by ;; visiting ;; -;; http://lists.sourceforge.net/mailman/listinfo/cc-mode-announce +;; https://lists.sourceforge.net/mailman/listinfo/cc-mode-announce ;; Externally maintained major modes which use CC-mode's engine include: ;; - cuda-mode @@ -172,7 +172,7 @@ ;; `c-font-lock-init' too to set up CC Mode's font lock support. ;; ;; See cc-langs.el for further info. A small example of a derived mode -;; is also available at <http://cc-mode.sourceforge.net/ +;; is also available at <https://cc-mode.sourceforge.net/ ;; derived-mode-ex.el>. (defun c-leave-cc-mode-mode () diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index ded5d2130e5..6473b507785 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -980,12 +980,17 @@ Faces `compilation-error-face', `compilation-warning-face', "Face name to use for leaving directory messages.") (defcustom compilation-auto-jump-to-first-error nil - "If non-nil, automatically jump to the first error during compilation." + "If non-nil, automatically jump to the first error during compilation. + +The value `if-location-known' means automatically jump to the first error +if the error's file can be found. The value `first-known' means jump to +the first error whose file can be found. Any other non-nil value means +jump to the first error unconditionally." :type '(choice (const :tag "Never" nil) (const :tag "Always" t) (const :tag "If location known" if-location-known) (const :tag "First known location" first-known)) - :version "23.1") + :version "29.1") (defvar-local compilation-auto-jump-to-next nil "If non-nil, automatically jump to the next error encountered.") diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 20a73e238e9..539b2771490 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -8323,7 +8323,7 @@ the appropriate statement modifier." 'cperl-short-docs 'variable-documentation)))) (Man-switches "") - (manual-program (if is-func "perldoc -f" "perldoc"))) + (manual-program (concat "perldoc -i" (if is-func " -f")))) (Man-getpage-in-background word))) ;;;###autoload diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 6e8032b7eae..0de3d213a4d 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -966,7 +966,7 @@ detailed description of this mode. (if gdb-active-process (gdb-gud-context-command "-exec-continue") "-exec-run"))) - "C-v" "Start or continue execution. Use a prefix to specify arguments.") + "\C-v" "Start or continue execution. Use a prefix to specify arguments.") ;; For debugging Emacs only. (gud-def gud-pp diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index cbbcf1c2b7c..5f265212992 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -488,17 +488,12 @@ not be enclosed in { } or ( )." (defconst makefile-imake-font-lock-keywords - (append - (makefile-make-font-lock-keywords - makefile-var-use-regex - makefile-statements - t - nil - '("^XCOMM.*$" . font-lock-comment-face) - '("XVAR\\(?:use\\|def\\)[0-9]" 0 font-lock-keyword-face prepend) - '("@@" . font-lock-preprocessor-face) - ) - cpp-font-lock-keywords)) + (append (list '("XCOMM.*$" . font-lock-comment-face) + '("XVAR\\(?:use\\|def\\)[0-9]" 0 + font-lock-keyword-face prepend) + '("@@" . font-lock-preprocessor-face)) + cpp-font-lock-keywords + makefile-font-lock-keywords)) (defconst makefile-syntax-propertize-function @@ -932,7 +927,9 @@ Makefile mode can be configured by modifying the following variables: :syntax-table makefile-imake-mode-syntax-table (setq-local syntax-propertize-function nil) (setq font-lock-defaults - `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))) + `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))) + (setq-local comment-start "XCOMM") + (setq-local comment-start-skip "XCOMM[ \t]*")) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ee94d0d85d8..ac278edd409 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. -;; Version: 0.8.1 +;; Version: 0.8.2 ;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 80c5b31b6ea..0de76b0bde3 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3413,15 +3413,25 @@ detecting a prompt at the end of the buffer." "Send STRING to PROCESS and inhibit output. Return the output." (or process (setq process (python-shell-get-process-or-error))) - (cl-letf (((process-filter process) - (lambda (_proc str) - (with-current-buffer (process-buffer process) - (python-shell-output-filter str)))) - (python-shell-output-filter-in-progress t) - (inhibit-quit t)) + (cl-letf* (((process-filter process) + (lambda (_proc str) + (with-current-buffer (process-buffer process) + (python-shell-output-filter str)))) + (python-shell-output-filter-in-progress t) + (inhibit-quit t) + (buffer (process-buffer process)) + (last-prompt (cond ((boundp 'comint-last-prompt-overlay) + 'comint-last-prompt-overlay) + ((boundp 'comint-last-prompt) + 'comint-last-prompt))) + (last-prompt-value (buffer-local-value last-prompt buffer))) (or (with-local-quit - (python-shell-send-string string process) + (unwind-protect + (python-shell-send-string string process) + (when (not (null last-prompt)) + (with-current-buffer buffer + (set last-prompt last-prompt-value)))) (while python-shell-output-filter-in-progress ;; `python-shell-output-filter' takes care of setting ;; `python-shell-output-filter-in-progress' to NIL after it @@ -3430,7 +3440,7 @@ Return the output." (prog1 python-shell-output-filter-buffer (setq python-shell-output-filter-buffer nil))) - (with-current-buffer (process-buffer process) + (with-current-buffer buffer (comint-interrupt-subjob))))) (defun python-shell-internal-send-string (string) @@ -4059,7 +4069,8 @@ With argument MSG show activation/deactivation message." Optional argument PROCESS forces completions to be retrieved using that one instead of current buffer's process." (setq process (or process (get-buffer-process (current-buffer)))) - (let* ((line-start (if (derived-mode-p 'inferior-python-mode) + (let* ((is-shell-buffer (derived-mode-p 'inferior-python-mode)) + (line-start (if is-shell-buffer ;; Working on a shell buffer: use prompt end. (cdr (python-util-comint-last-prompt)) (line-beginning-position))) @@ -4090,7 +4101,8 @@ using that one instead of current buffer's process." (completion-fn (with-current-buffer (process-buffer process) (cond ((or (null prompt) - (< (point) (cdr prompt-boundaries))) + (and is-shell-buffer + (< (point) (cdr prompt-boundaries)))) #'ignore) ((or (not python-shell-completion-native-enable) ;; Even if native completion is enabled, for diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index ac04b64ce59..bb36688ef85 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -751,17 +751,22 @@ quit the *xref* buffer." (defun xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. -This command interactively replaces FROM with TO in the names of the +This function interactively replaces FROM with TO in the names of the references displayed in the current *xref* buffer. -When called interactively, it uses '.*' as FROM, which means -replace the whole name. Unless called with prefix argument, in -which case the user is prompted for both FROM and TO. +When called interactively, it uses '.*' as FROM, which means replace +the whole name, and prompts the user for TO. +If invoked with prefix argument, it prompts the user for both FROM and TO. As each match is found, the user must type a character saying what to do with it. Type SPC or `y' to replace the match, DEL or `n' to skip and go to the next match. For more directions, -type \\[help-command] at that time." +type \\[help-command] at that time. + +Note that this function cannot be used in *xref* buffers that show +a partial list of all references, such as the *xref* buffer created +by \\[xref-find-definitions] and its variants, since those list only +some of the references to the identifiers." (interactive (let* ((fr (if current-prefix-arg @@ -891,7 +896,9 @@ ITEMS is an xref item which " ; FIXME: Expand documentation. (setq pairs (cdr buf-pairs)) (setq continue (perform-replace from to t t nil nil multi-query-replace-map))) - (unless did-it-once (user-error "No suitable matches here")) + (unless did-it-once + (user-error + "Cannot perform global renaming of symbols using find-definition results")) (when (and continue (not buf-pairs)) (message "All results processed")))) diff --git a/lisp/server.el b/lisp/server.el index 3caa335c4eb..90d97c1538e 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1589,14 +1589,19 @@ specifically for the clients and did not exist before their request for it." (server-buffer-done (current-buffer)))) (defun server-kill-emacs-query-function () - "Ask before exiting Emacs if it has live clients. + "Ask before exiting Emacs if it has other live clients. A \"live client\" is a client with at least one live buffer -associated with it." - (or (not (seq-some (lambda (proc) - (seq-some #'buffer-live-p - (process-get proc 'buffers))) - server-clients)) - (yes-or-no-p "This Emacs session has clients; exit anyway? "))) +associated with it. These clients were (probably) started by +external processes that are waiting for some buffers to be +edited. If there are any other clients, we don't want to fail +their waiting processes, so ask the user to be sure." + (let ((this-client (frame-parameter nil 'client))) + (or (not (seq-some (lambda (proc) + (unless (eq proc this-client) + (seq-some #'buffer-live-p + (process-get proc 'buffers)))) + server-clients)) + (yes-or-no-p "This Emacs session has other clients; exit anyway? ")))) (defun server-kill-buffer () "Remove the current buffer from its clients' buffer list. diff --git a/lisp/simple.el b/lisp/simple.el index d2dcbe27a07..e804f717b01 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2465,9 +2465,13 @@ Also see `suggest-key-bindings'." (defun execute-extended-command--shorter (name typed) (let ((candidates '()) + commands (max (length typed)) (len 1) binding) + ;; Precompute a list of commands once to avoid repeated `commandp' testing + ;; of symbols in the `completion-try-completion' call inside the loop below + (mapatoms (lambda (s) (when (commandp s) (push s commands)))) (while (and (not binding) (progn (unless candidates @@ -2480,8 +2484,8 @@ Also see `suggest-key-bindings'." (input-pending-p) ;Dummy call to trigger input-processing, bug#23002. (let ((candidate (pop candidates))) (when (equal name - (car-safe (completion-try-completion - candidate obarray 'commandp len))) + (car-safe (completion-try-completion + candidate commands nil len))) (setq binding candidate)))) binding)) diff --git a/lisp/startup.el b/lisp/startup.el index 04de7e42fea..725984b815b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -458,7 +458,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; The Windows version doesn't report meaningful inode numbers, so ;; use the canonicalized absolute file name of the directory instead. (setq attrs (or canonicalized - (nthcdr 10 (file-attributes this-dir)))) + (file-attribute-file-identifier + (file-attributes this-dir)))) (unless (member attrs normal-top-level-add-subdirs-inode-list) (push attrs normal-top-level-add-subdirs-inode-list) (dolist (file contents) diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el index 5d17b390f4d..bfb5566e896 100644 --- a/lisp/textmodes/less-css-mode.el +++ b/lisp/textmodes/less-css-mode.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; This mode provides syntax highlighting for Less CSS files -;; (http://lesscss.org/), plus optional support for compilation of +;; (https://lesscss.org/), plus optional support for compilation of ;; .less files to .css files at the time they are saved: use ;; `less-css-compile-at-save' to enable this. ;; diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 7d691430ec6..7ce30cba8a4 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -268,7 +268,7 @@ Currently, only Latin-1 characters are supported.") ;; prefer tidy because (o)nsgmls is often built without --enable-http ;; which makes it next to useless (cond ((executable-find "tidy") - ;; tidy is available from http://tidy.sourceforge.net/ + ;; tidy is available from https://tidy.sourceforge.net/ "tidy --gnu-emacs yes -utf8 -e -q") ((executable-find "nsgmls") ;; nsgmls is a free SGML parser in the SP suite available from @@ -276,7 +276,7 @@ Currently, only Latin-1 characters are supported.") "nsgmls -s") ((executable-find "onsgmls") ;; onsgmls is the community version of `nsgmls' - ;; hosted on http://openjade.sourceforge.net/ + ;; hosted on https://openjade.sourceforge.net/ "onsgmls -s") (t "Install (o)nsgmls, tidy, or some other SGML validator, and set `sgml-validate-command'")) "The command to validate an SGML document. diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el index 53850674ac0..3270050ca4a 100644 --- a/lisp/textmodes/string-edit.el +++ b/lisp/textmodes/string-edit.el @@ -46,7 +46,9 @@ called with no parameters. PROMPT will be inserted at the start of the buffer, but won't be included in the resulting string. If PROMPT is nil, no help text -will be inserted." +will be inserted. + +Also see `read-string-from-buffer'." (with-current-buffer (generate-new-buffer "*edit string*") (when prompt (let ((inhibit-read-only t)) @@ -88,7 +90,9 @@ The user finishes editing with \\<string-edit-mode-map>\\[string-edit-done], or PROMPT will be inserted at the start of the buffer, but won't be included in the resulting string. If nil, no prompt will be -inserted in the buffer." +inserted in the buffer. + +Also see `string-edit'." (string-edit prompt string @@ -115,9 +119,7 @@ This will kill the current buffer." (interactive) (goto-char (point-min)) ;; Skip past the help text. - (when-let ((match (text-property-search-forward - 'string-edit--prompt nil t))) - (goto-char (prop-match-beginning match))) + (text-property-search-forward 'string-edit--prompt) (let ((string (buffer-substring (point) (point-max))) (callback string-edit--success-callback)) (quit-window 'kill) diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index a72b2e67a6a..6258e999c1d 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -150,7 +150,6 @@ it up to them." (uncompressed-filename nil) (content-type nil) (content-encoding nil) - (coding-system-for-read 'binary) (filename (url-file-build-filename url))) (or filename (error "File does not exist: %s" (url-recreate-url url))) ;; Need to figure out the content-type from the real extension, diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 8ffe41758ed..d63d755a287 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -373,8 +373,9 @@ in the order given by `git status'." (defun vc-git-working-revision (_file) "Git-specific version of `vc-working-revision'." - (let (process-file-side-effects) - (vc-git--rev-parse "HEAD"))) + (let* ((process-file-side-effects nil) + (commit (vc-git--rev-parse "HEAD" t))) + (or (vc-git-symbolic-commit commit) commit))) (defun vc-git--symbolic-ref (file) (or @@ -1638,7 +1639,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (start-point (when branchp (vc-read-revision (format-prompt "Start point" (car (vc-git-branches))) - (list dir) 'Git)))) + (list dir) 'Git (car (vc-git-branches)))))) (and (or (zerop (vc-git-command nil t nil "update-index" "--refresh")) (y-or-n-p "Modified files exist. Proceed? ") (user-error (format "Can't create %s with modified files" @@ -1677,11 +1678,15 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." ;; does not (and cannot) quote. (vc-git--rev-parse (concat rev "~1")))) -(defun vc-git--rev-parse (rev) +(defun vc-git--rev-parse (rev &optional short) (with-temp-buffer (and - (vc-git--out-ok "rev-parse" rev) - (buffer-substring-no-properties (point-min) (+ (point-min) 40))))) + (if short + (vc-git--out-ok "rev-parse" "--short" rev) + (vc-git--out-ok "rev-parse" rev)) + (string-trim-right + (buffer-substring-no-properties (point-min) (min (+ (point-min) 40) + (point-max))))))) (defun vc-git-next-revision (file rev) "Git-specific version of `vc-next-revision'." @@ -2028,19 +2033,23 @@ FILE can be nil." (setq ok nil)))))) (and ok str))) -(defun vc-git-symbolic-commit (commit) - "Translate COMMIT string into symbolic form. -Returns nil if not possible." +(defun vc-git-symbolic-commit (commit &optional force) + "Translate revision string of COMMIT to a symbolic form. +If the optional argument FORCE is non-nil, the returned value is +allowed to include revision specifications like \"master~8\" +\(the 8th parent of the commit currently pointed to by the master +branch), otherwise such revision specifications are rejected, and +the function returns nil." (and commit - (let ((name (with-temp-buffer - (and - (vc-git--out-ok "name-rev" "--name-only" commit) - (goto-char (point-min)) - (= (forward-line 2) 1) - (bolp) - (buffer-substring-no-properties (point-min) - (1- (point-max))))))) - (and name (not (string= name "undefined")) name)))) + (with-temp-buffer + (and + (vc-git--out-ok "name-rev" "--no-undefined" "--name-only" commit) + (goto-char (point-min)) + (or force (not (looking-at "^.*[~^].*$" t))) + (= (forward-line 2) 1) + (bolp) + (buffer-substring-no-properties (point-min) + (1- (point-max))))))) (defvar-keymap vc-dir-git-mode-map "z c" #'vc-git-stash diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 14b149310c4..49bb7a27aad 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1926,6 +1926,13 @@ Return t if the buffer had changes, nil otherwise." "History for `vc-read-revision'.") (defun vc-read-revision (prompt &optional files backend default initial-input multiple) + "Query the user for a revision using PROMPT. +All subsequent arguments are optional. FILES may specify a file +set to restrict the revisions to. BACKEND is a VC backend as +listed in `vc-handled-backends'. DEFAULT and INITIAL-INPUT are +handled as defined by `completing-read'. If MULTIPLE is non-nil, +the user may be prompted for multiple revisions. If possible +this means that `completing-read-multiple' will be used." (cond ((null files) (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef @@ -1947,6 +1954,10 @@ Return t if the buffer had changes, nil otherwise." answer))))) (defun vc-read-multiple-revisions (prompt &optional files backend default initial-input) + "Query the user for multiple revisions. +This is equivalent to invoking `vc-read-revision' with t for +MULTIPLE. The arguments PROMPT, FILES, BACKEND, DEFAULT and +INITIAL-INPUT are passed on to `vc-read-revision' directly." (vc-read-revision prompt files backend default initial-input t)) (defun vc-diff-build-argument-list-internal (&optional fileset) @@ -3287,10 +3298,11 @@ immediately after this one." (apply #'vc-user-edit-command (apply old args)))))) (defcustom vc-prepare-patches-separately t - "Non-nil means that `vc-prepare-patch' creates a single message. -A single message is created by attaching all patches to the body -of a single message. If nil, each patch will be sent out in a -separate message, which will be prepared sequentially." + "Whether `vc-prepare-patch' should generate a separate message for each patch. +If nil, `vc-prepare-patch' creates a single email message by attaching +all the patches to the body of that message. If non-nil, each patch +will be sent out in a separate message, and the messages will be +prepared sequentially." :type 'boolean :safe #'booleanp :version "29.1") @@ -3308,7 +3320,7 @@ If nil, no default will be used. This option may be set locally." (buffer &optional type description disposition)) (declare-function log-view-get-marked "log-view" ()) -(defun vc-default-prepare-patch (rev) +(defun vc-default-prepare-patch (_backend rev) (let ((backend (vc-backend buffer-file-name))) (with-current-buffer (generate-new-buffer " *vc-default-prepare-patch*") (vc-diff-internal @@ -3325,15 +3337,21 @@ If nil, no default will be used. This option may be set locally." ;;;###autoload (defun vc-prepare-patch (addressee subject revisions) "Compose an Email sending patches for REVISIONS to ADDRESSEE. -If `vc-prepare-patches-separately' is non-nil, SUBJECT will be used -as the default subject for the message. Otherwise a separate -message will be composed for each revision. +If `vc-prepare-patches-separately' is nil, SUBJECT will be used +as the default subject for the message (and it will be prompted +for when called interactively). Otherwise a separate message +will be composed for each revision, with SUBJECT derived from the +invidividual commits. When invoked interactively in a Log View buffer with marked -revisions, these revisions will be used." +revisions, those revisions will be used." (interactive - (let ((revs (or (log-view-get-marked) - (vc-read-multiple-revisions "Revisions: "))) + (let ((revs (vc-read-multiple-revisions + "Revisions: " nil nil nil + (or (and-let* ((revs (log-view-get-marked))) + (mapconcat #'identity revs ",")) + (and-let* ((file (buffer-file-name))) + (vc-working-revision file))))) to) (require 'message) (while (null (setq to (completing-read-multiple @@ -3357,7 +3375,8 @@ revisions, these revisions will be used." 'prepare-patch rev)) revisions))) (if vc-prepare-patches-separately - (dolist (patch patches) + (dolist (patch (reverse patches) + (message "Prepared %d patches..." (length patches))) (compose-mail addressee (plist-get patch :subject) nil nil nil nil @@ -3368,8 +3387,7 @@ revisions, these revisions will be used." (insert-buffer-substring (plist-get patch :buffer) (plist-get patch :body-start) - (plist-get patch :body-end))) - (recursive-edit)) + (plist-get patch :body-end)))) (compose-mail addressee subject nil nil nil nil (mapcar (lambda (p) diff --git a/lisp/view.el b/lisp/view.el index 1207f01db21..d9b1a2d0e7d 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -68,13 +68,6 @@ the F command in `view-mode', but you can set it to t if you want the action for all scroll commands in view mode." :type 'boolean) -;;;###autoload -(defcustom view-remove-frame-by-deleting t - "Determine how View mode removes a frame no longer needed. -If nil, make an icon of the frame. If non-nil, delete the frame." - :type 'boolean - :version "23.1") - (defcustom view-exits-all-viewing-windows nil "Non-nil means restore all windows used to view buffer. Commands that restore windows when finished viewing a buffer, diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 2bda67fe3f3..ee80e41a22e 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -1640,8 +1640,9 @@ VERSION is the version of the XDND protocol understood by SOURCE." desired-name (or file-name-coding-system default-file-name-coding-system))) - (let ((name (funcall x-dnd-direct-save-function - t desired-name))) + (let ((name (expand-file-name + (funcall x-dnd-direct-save-function + t desired-name)))) (setq save-to name save-to-remote name)) (when save-to (if (file-remote-p save-to) |