commit d54ffa25bd297f9bc57918ca65db714beade7473 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Thu Aug 26 10:40:35 2021 +0300 Define a substitute for on MS-Windows * lisp/mouse.el (context-menu-mode-map): On w32, use in addition to (the mostly non-existent) . diff --git a/lisp/mouse.el b/lisp/mouse.el index d137419e02..8b20963842 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -469,6 +469,8 @@ the same menu with changes such as added new menu items." (define-key map [mouse-3] nil) (define-key map [down-mouse-3] context-menu-entry) (define-key map [menu] #'context-menu-open) + (if (featurep 'w32) + (define-key map [apps] #'context-menu-open)) (when (featurep 'ns) (define-key map [C-mouse-1] nil) (define-key map [C-down-mouse-1] context-menu-entry)) commit 4ac29b943bdcc099f578660395b17b430551ff79 Author: Dmitry Gutov Date: Thu Aug 26 04:48:05 2021 +0300 Rename arguments for clarity * lisp/vc/vc-git.el (vc-git--literal-pathspecs) (vc-git--literal-pathspecs): Rename arguments for clarity (bug#39452). diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 779326be3f..396d55adb2 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -242,14 +242,14 @@ included in the completions." ;;;###autoload (load "vc-git" nil t) ;;;###autoload (vc-git-registered file)))) -(defun vc-git--literal-pathspec (pathspec) - "Prepend :(literal) path magic to PATHSPEC." - ;; Good example of PATHSPEC that needs this: "test[56].xx". - (and pathspec (concat ":(literal)" (file-local-name pathspec)))) - -(defun vc-git--literal-pathspecs (pathspecs) - "Prepend :(literal) path magic to PATHSPECS." - (mapcar #'vc-git--literal-pathspec pathspecs)) +(defun vc-git--literal-pathspec (file) + "Prepend :(literal) path magic to FILE." + ;; Good example of file name that needs this: "test[56].xx". + (and file (concat ":(literal)" (file-local-name file)))) + +(defun vc-git--literal-pathspecs (files) + "Prepend :(literal) path magic to FILES." + (mapcar #'vc-git--literal-pathspec files)) (defun vc-git-registered (file) "Check whether FILE is registered with git." commit 2b62b2a019b488110901aeff08957c7d903e1588 Author: Dmitry Gutov Date: Thu Aug 26 04:44:21 2021 +0300 Make sure to remove the remote specification before adding :(literal) * lisp/vc/vc-git.el (vc-git--literal-pathspec): Make sure to remove the remote specification from the file name (bug#50175, bug#39452). diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 935dc8b9ae..779326be3f 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -245,7 +245,7 @@ included in the completions." (defun vc-git--literal-pathspec (pathspec) "Prepend :(literal) path magic to PATHSPEC." ;; Good example of PATHSPEC that needs this: "test[56].xx". - (and pathspec (concat ":(literal)" pathspec))) + (and pathspec (concat ":(literal)" (file-local-name pathspec)))) (defun vc-git--literal-pathspecs (pathspecs) "Prepend :(literal) path magic to PATHSPECS." commit a8c803db8e39a44b48aad5c21db3bef68a9ff87d Author: Stephen Gildea Date: Wed Aug 25 18:14:36 2021 -0700 ; * lisp/time-stamp.el: Doc string wording improvements. diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index f568142e8f..5258742845 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -162,9 +162,9 @@ than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', or `time-stamp-format'. These variables are best changed with file-local variables. -If you change `time-stamp-line-limit', `time-stamp-start', +If you were to change `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', or `time-stamp-pattern' in your init file, you -will be incompatible with other people's files.") +would be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-line-limit 'safe-local-variable 'integerp) (defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change! @@ -175,9 +175,9 @@ than one of `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', or `time-stamp-format'. These variables are best changed with file-local variables. -If you change `time-stamp-line-limit', `time-stamp-start', +If you were to change `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', or `time-stamp-pattern' in your init file, you -will be incompatible with other people's files.") +would be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-start 'safe-local-variable 'stringp) (defvar time-stamp-end "\\\\?[\">]" ;Do not change! @@ -197,9 +197,9 @@ to not change the number of lines in the buffer. `time-stamp-inserts-lines' controls this behavior. These variables are best changed with file-local variables. -If you change `time-stamp-line-limit', `time-stamp-start', +If you were to change `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', `time-stamp-pattern', or `time-stamp-inserts-lines' in -your init file, you will be incompatible with other people's files.") +your init file, you would be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-end 'safe-local-variable 'stringp) @@ -214,8 +214,8 @@ unexpected changes in the buffer if used carelessly, but it is useful for generating repeated time stamps. These variables are best changed with file-local variables. -If you change `time-stamp-end' or `time-stamp-inserts-lines' in -your init file, you will be incompatible with other people's files.") +If you were to change `time-stamp-end' or `time-stamp-inserts-lines' in +your init file, you would be incompatible with other people's files.") ;;;###autoload(put 'time-stamp-inserts-lines 'safe-local-variable 'symbolp) @@ -224,8 +224,8 @@ your init file, you will be incompatible with other people's files.") The same time stamp will be written in each case. `time-stamp-count' is best changed with a file-local variable. -If you change it in your init file, you will be incompatible with -other people's files.") +If you were to change it in your init file, you would be incompatible +with other people's files.") ;;;###autoload(put 'time-stamp-count 'safe-local-variable 'integerp) @@ -254,9 +254,9 @@ This part may be omitted to use the normal pattern. The pattern does not need to match the entire line of the time stamp. These variables are best changed with file-local variables. -If you change `time-stamp-pattern', `time-stamp-line-limit', +If you were to change `time-stamp-pattern', `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' in your init file, you -will be incompatible with other people's files. +would be incompatible with other people's files. See also `time-stamp-count' and `time-stamp-inserts-lines'. @@ -303,8 +303,7 @@ To enable automatic time-stamping for only a specific file, add this line to a local variables list near the end of the file: eval: (add-hook \\='before-save-hook \\='time-stamp nil t) -If the first 8 lines of the file do not have a time-stamp template, -this function does nothing. +If the file has no time-stamp template, this function does nothing. You can set `time-stamp-pattern' in a files's local variables list to customize the information in the time stamp and where it is written. commit 3b66c4d8f0966838f4fad1314da105a5fbc4f501 Author: Stefan Monnier Date: Wed Aug 25 18:27:35 2021 -0400 * lisp/term/xterm.el (xterm-function-map): Map `\e[29~` to `menu` diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index e63bf36cc3..43a89ff31f 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -350,7 +350,20 @@ Return the pasted text as a string." (define-key map "\e[5;3~" [M-prior]) (define-key map "\e[6;3~" [M-next]) - (define-key map "\e[29~" [print]) + ;; This escape sequence has a controversial story. + ;; It was initially mapped to [print] (initial commit by Karl Heuer), + ;; but we can't find any justification for it. + ;; Xterm uses this escape sequence for both `F16' and `Menu' keys, + ;; and the reason for it is that in the VT220 keyboard the key + ;; placed logically at position where `F16' would be (and sending + ;; the escape sequence that naturally belongs to `F16') was + ;; labeled `Menu'. [ The story gets even more interesting if you + ;; want to dig deeper, e.g. some terminals would send that same + ;; escape sequence in response to `S-F4' (because they (ab)used + ;; the escape sequence of `F' for `S-F'). ] + ;; The current binding was chosen because current keyboards almost never + ;; have an `F16' key, whereas many do have a `Menu' key. + (define-key map "\e[29~" [menu]) (define-key map "\eOj" [kp-multiply]) (define-key map "\eOk" [kp-add]) commit 46ff443dc0657105213354be12f2d3b97a2538b2 Author: Gabriel do Nascimento Ribeiro Date: Tue Aug 24 11:23:49 2021 -0300 Handle nil messages in repeat-echo-message. * lisp/repeat.el (repeat-echo-message): Handle cases where 'current-message' is nil (bug#50176). diff --git a/lisp/repeat.el b/lisp/repeat.el index 89488ddc98..6c3ffec18f 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -474,8 +474,9 @@ When Repeat mode is enabled, and the command symbol has the property named (if (current-message) (message "%s [%s]" (current-message) mess) (message mess))) - (when (string-search "Repeat with " (current-message)) - (message nil)))) + (and (current-message) + (string-search "Repeat with " (current-message)) + (message nil)))) (defvar repeat-echo-mode-line-string (propertize "[Repeating...] " 'face 'mode-line-emphasis) commit 7db376e560448e61485ba054def8c82b21f33d6a Author: Lars Ingebrigtsen Date: Wed Aug 25 18:04:43 2021 +0200 Make thingatpt respect fields * lisp/thingatpt.el (thing-at-point): Make thingatpt respect fields (bug#9454). diff --git a/etc/NEWS b/etc/NEWS index 2c929e4a62..04e482364a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2432,6 +2432,12 @@ that makes it a valid button. *** New variable 'thing-at-point-provider-alist'. This allows mode-specific alterations to how 'thing-at-point' works. +--- +*** thingatpt now respects fields. +'thing-at-point' (and all functions that use it, like +'symbol-at-point') will narrow to the current field (if any) before +trying to identify the thing at point. + ** Enriched mode --- diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 66bbfb0f9f..ab17748df5 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -162,24 +162,30 @@ Possibilities include `symbol', `list', `sexp', `defun', When the optional argument NO-PROPERTIES is non-nil, strip text properties from the return value. +If the current buffer uses fields (see Info node `(elisp)Fields'), +this function will narrow to the field before identifying the +thing at point. + See the file `thingatpt.el' for documentation on how to define a symbol as a valid THING." - (let ((text - (cond - ((cl-loop for (pthing . function) in thing-at-point-provider-alist - when (eq pthing thing) - for result = (funcall function) - when result - return result)) - ((get thing 'thing-at-point) - (funcall (get thing 'thing-at-point))) - (t - (let ((bounds (bounds-of-thing-at-point thing))) - (when bounds - (buffer-substring (car bounds) (cdr bounds)))))))) - (when (and text no-properties (sequencep text)) - (set-text-properties 0 (length text) nil text)) - text)) + (save-restriction + (narrow-to-region (field-beginning) (field-end)) + (let ((text + (cond + ((cl-loop for (pthing . function) in thing-at-point-provider-alist + when (eq pthing thing) + for result = (funcall function) + when result + return result)) + ((get thing 'thing-at-point) + (funcall (get thing 'thing-at-point))) + (t + (let ((bounds (bounds-of-thing-at-point thing))) + (when bounds + (buffer-substring (car bounds) (cdr bounds)))))))) + (when (and text no-properties (sequencep text)) + (set-text-properties 0 (length text) nil text)) + text))) ;; Go to beginning/end diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index fba6f21d5d..1849480347 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -223,4 +223,12 @@ position to retrieve THING.") (should (equal (test--number "0xf00" 2) 3840)) (should (equal (test--number "0xf00" 3) 3840))) +(ert-deftest test-fields () + (with-temp-buffer + (insert (propertize "foo" 'field 1) "bar" (propertize "zot" 'field 2)) + (goto-char 1) + (should (eq (symbol-at-point) 'foo)) + (goto-char 5) + (should (eq (symbol-at-point) 'bar)))) + ;;; thingatpt.el ends here commit ab799500094fb36b3f26b9c8a4147848b204cf0a Author: Lars Ingebrigtsen Date: Wed Aug 25 17:33:03 2021 +0200 Make `set-locale-environment' complete over locale names * lisp/international/mule-cmds.el (get-locale-names): New function. (set-locale-environment): Use it to allow completion (bug#9655). diff --git a/etc/NEWS b/etc/NEWS index 2575061086..2c929e4a62 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3844,6 +3844,11 @@ locales. They are also available as aliases 'ebcdic-cp-*' (e.g., 'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to support these coding-systems. +--- +** New function 'get-locale-names'. +This utility function returns a list of locale names on the current +system. + --- ** 'while-no-input-ignore-events' accepts more special events. The special events 'dbus-event' and 'file-notify' are now ignored in diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 71e2653ffe..dc09dad2cb 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2610,6 +2610,31 @@ is returned. Thus, for instance, if charset \"ISO8859-2\", (declare-function w32-get-console-codepage "w32proc.c" ()) (declare-function w32-get-console-output-codepage "w32proc.c" ()) +(defun get-locale-names () + "Return a list of locale names." + (cond + ;; On Windows we have a built-in method to get the names. + ((and (fboundp 'w32-get-locale-info) + (fboundp 'w32-get-valid-locale-ids)) + (mapcar #'w32-get-locale-info (w32-get-valid-locale-ids))) + ;; Unix-ey hosts should have a command to output locales currently + ;; defined by the OS. + ((executable-find "locale") + (split-string (shell-command-to-string "locale -a"))) + ;; Fall back on the list of all defined locales. + ((and locale-translation-file-name + (file-exists-p locale-translation-file-name)) + (with-temp-buffer + (insert-file-contents locale-translation-file-name) + (let ((locales nil)) + (while (not (eobp)) + (unless (looking-at-p "#") + (push (cadr (split-string (buffer-substring + (point) (line-end-position)))) + locales)) + (forward-line 1)) + (nreverse locales)))))) + (defun locale-translate (locale) "Expand LOCALE according to `locale-translation-file-name', if possible. For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"." @@ -2650,8 +2675,8 @@ touch session-global parameters like the language environment. See also `locale-charset-language-names', `locale-language-names', `locale-preferred-coding-systems' and `locale-coding-system'." - (interactive "sSet environment for locale: ") - + (interactive (list (completing-read "Set environment for locale: " + (get-locale-names)))) ;; Do this at runtime for the sake of binaries possibly transported ;; to a system without X. (setq locale-translation-file-name commit 1155826c9884b4a93ef52cf6cd6a9735a1c83951 Author: João Távora Date: Wed Aug 25 16:25:20 2021 +0100 Speed up pcm completion styles for patternless special case Fixes: bug#48841 * lisp/minibuffer.el (completion-flex-all-completions): Skip completion-pcm--hilit-commonality if there's no pattern yet. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 89d3a2a09d..68e4fa17fc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3529,7 +3529,8 @@ string in COMPLETIONS. Return a deep copy of COMPLETIONS where each string is propertized with `completion-score', a number between 0 and 1, and with faces `completions-common-part', `completions-first-difference' in the relevant segments." - (when completions + (cond + ((and completions (cl-loop for e in pattern thereis (stringp e))) (let* ((re (completion-pcm--pattern->regex pattern 'group)) (point-idx (completion-pcm--pattern-point-idx pattern)) (case-fold-search completion-ignore-case) @@ -3620,7 +3621,8 @@ between 0 and 1, and with faces `completions-common-part', 0 1 'completion-score (/ score-numerator (* end (1+ score-denominator)) 1.0) str))) str) - completions)))) + completions))) + (t completions))) (defun completion-pcm--find-all-completions (string table pred point &optional filter) commit 8ba6a38b3bccab6eda8e1962e4c8618704b9f83e Merge: 979f14e641 5b03849102 Author: Glenn Morris Date: Wed Aug 25 07:51:41 2021 -0700 ; Merge from origin/emacs-27 The following commit was skipped: 5b03849102 (origin/emacs-27) ; * test/lisp/files-tests.el: Add tests ... commit 979f14e6419ad622d2d20195701ab7436f2f4070 Author: Lars Ingebrigtsen Date: Wed Aug 25 16:27:37 2021 +0200 Disable xterm selection operators in stterm * lisp/term/st.el (xterm-st-extra-capabilities): st doesn't support the xterm selection things (bug#50192). diff --git a/lisp/term/st.el b/lisp/term/st.el index f1cbad6d59..26478ca249 100644 --- a/lisp/term/st.el +++ b/lisp/term/st.el @@ -11,8 +11,7 @@ (require 'term/xterm) -(defcustom xterm-st-extra-capabilities '( modifyOtherKeys getSelection - setSelection) +(defcustom xterm-st-extra-capabilities '(modifyOtherKeys) "Extra capabilities supported under \"stterm\"." :version "28.1" :type xterm--extra-capabilities-type commit 9759fb596b634db2faf7edcd4fd557a11abe9903 Author: Eli Zaretskii Date: Wed Aug 25 15:29:52 2021 +0300 Add missing :version tags to new faces * lisp/term.el (term-color-bright-black, term-color-bright-red) (term-color-bright-green, term-color-bright-yellow) (term-color-bright-blue, term-color-bright-magenta) (term-color-bright-cyan, term-color-bright-white): Add :version. diff --git a/lisp/term.el b/lisp/term.el index ef2532182c..c4e6c528e4 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -812,42 +812,50 @@ Buffer local variable.") (defface term-color-bright-black '((t :foreground "gray30" :background "gray30")) "Face used to render bright black color code." - :group 'term) + :group 'term + :version "28.1") (defface term-color-bright-red '((t :foreground "red2" :background "red2")) "Face used to render bright red color code." - :group 'term) + :group 'term + :version "28.1") (defface term-color-bright-green '((t :foreground "green2" :background "green2")) "Face used to render bright green color code." - :group 'term) + :group 'term + :version "28.1") (defface term-color-bright-yellow '((t :foreground "yellow2" :background "yellow2")) "Face used to render bright yellow color code." - :group 'term) + :group 'term + :version "28.1") (defface term-color-bright-blue '((t :foreground "blue1" :background "blue1")) "Face used to render bright blue color code." - :group 'term) + :group 'term + :version "28.1") (defface term-color-bright-magenta '((t :foreground "magenta2" :background "magenta2")) "Face used to render bright magenta color code." - :group 'term) + :group 'term + :version "28.1") (defface term-color-bright-cyan '((t :foreground "cyan2" :background "cyan2")) "Face used to render bright cyan color code." - :group 'term) + :group 'term + :version "28.1") (defface term-color-bright-white '((t :foreground "white" :background "white")) "Face used to render bright white color code." - :group 'term) + :group 'term + :version "28.1") (defcustom term-buffer-maximum-size 8192 "The maximum size in lines for term buffers. commit 2b2a103db0c3597c7685d3ffff4bca7f2e4d094e Author: Jim Porter Date: Tue Aug 24 15:46:06 2021 -0700 Add support for "bright" ANSI colors in term-mode * list/term.el (ansi-term-color-vector): Add new faces. (term-color-white): Tweak colors. (term-color-bright-black, term-color-bright-red, term-color-bright-green) (term-color-bright-yellow, term-color-bright-blue) (term-color-bright-magenta, term-color-bright-cyan) (term-color-bright-white): New faces. (term--maybe-brighten-color): New function. (term-handle-colors-array): Handle bright colors. * test/lisp/term-tests.el (term-colors, term-colors-bold-is-bright): New functions. diff --git a/etc/NEWS b/etc/NEWS index 62edfc7348..2575061086 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2370,6 +2370,13 @@ based on the current window size. In previous versions of Emacs, this was always done (and that could lead to odd displays when resizing the window after starting). This variable defaults to nil. +--- +*** 'term-mode' now supports "bright" color codes. +"Bright" ANSI color codes are now displayed using the color values +defined in 'term-color-bright-*'. In addition, bold text with regular +ANSI colors can be displayed as "bright" if 'ansi-color-bold-is-bright' +is non-nil. + ** Widget +++ diff --git a/lisp/term.el b/lisp/term.el index b3870a814d..ef2532182c 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -727,7 +727,15 @@ Buffer local variable.") term-color-blue term-color-magenta term-color-cyan - term-color-white]) + term-color-white + term-color-bright-black + term-color-bright-red + term-color-bright-green + term-color-bright-yellow + term-color-bright-blue + term-color-bright-magenta + term-color-bright-cyan + term-color-bright-white]) (defcustom term-default-fg-color nil "If non-nil, default color for foreground in Term mode." @@ -797,10 +805,50 @@ Buffer local variable.") :group 'term) (defface term-color-white - '((t :foreground "white" :background "white")) + '((t :foreground "grey90" :background "gray90")) "Face used to render white color code." :group 'term) +(defface term-color-bright-black + '((t :foreground "gray30" :background "gray30")) + "Face used to render bright black color code." + :group 'term) + +(defface term-color-bright-red + '((t :foreground "red2" :background "red2")) + "Face used to render bright red color code." + :group 'term) + +(defface term-color-bright-green + '((t :foreground "green2" :background "green2")) + "Face used to render bright green color code." + :group 'term) + +(defface term-color-bright-yellow + '((t :foreground "yellow2" :background "yellow2")) + "Face used to render bright yellow color code." + :group 'term) + +(defface term-color-bright-blue + '((t :foreground "blue1" :background "blue1")) + "Face used to render bright blue color code." + :group 'term) + +(defface term-color-bright-magenta + '((t :foreground "magenta2" :background "magenta2")) + "Face used to render bright magenta color code." + :group 'term) + +(defface term-color-bright-cyan + '((t :foreground "cyan2" :background "cyan2")) + "Face used to render bright cyan color code." + :group 'term) + +(defface term-color-bright-white + '((t :foreground "white" :background "white")) + "Face used to render bright white color code." + :group 'term) + (defcustom term-buffer-maximum-size 8192 "The maximum size in lines for term buffers. Term buffers are truncated from the top to be no greater than this number. @@ -3225,6 +3273,15 @@ option is enabled. See `term-set-goto-process-mark'." ;; FIXME: No idea why this is here, it looks wrong. --Stef (setq term-ansi-face-already-done nil)) +(defun term--maybe-brighten-color (color bold) + "Possibly convert COLOR to its bright variant. +COLOR is an index into `ansi-term-color-vector'. If BOLD and +`ansi-color-bold-is-bright' are non-nil and COLOR is a regular color, +return the bright version of COLOR; otherwise, return COLOR." + (if (and ansi-color-bold-is-bright bold (<= 1 color 8)) + (+ color 8) + color)) + ;; New function to deal with ansi colorized output, as you can see you can ;; have any bold/underline/fg/bg/reverse combination. -mm @@ -3264,6 +3321,10 @@ option is enabled. See `term-set-goto-process-mark'." ((and (>= parameter 30) (<= parameter 37)) (setq term-ansi-current-color (- parameter 29))) + ;; Bright foreground + ((and (>= parameter 90) (<= parameter 97)) + (setq term-ansi-current-color (- parameter 81))) + ;; Reset foreground ((eq parameter 39) (setq term-ansi-current-color 0)) @@ -3272,6 +3333,10 @@ option is enabled. See `term-set-goto-process-mark'." ((and (>= parameter 40) (<= parameter 47)) (setq term-ansi-current-bg-color (- parameter 39))) + ;; Bright foreground + ((and (>= parameter 100) (<= parameter 107)) + (setq term-ansi-current-bg-color (- parameter 91))) + ;; Reset background ((eq parameter 49) (setq term-ansi-current-bg-color 0)) @@ -3290,37 +3355,43 @@ option is enabled. See `term-set-goto-process-mark'." ;; term-ansi-current-bg-color) (unless term-ansi-face-already-done - (if term-ansi-current-invisible - (let ((color - (if term-ansi-current-reverse - (face-foreground - (elt ansi-term-color-vector term-ansi-current-color) - nil 'default) - (face-background - (elt ansi-term-color-vector term-ansi-current-bg-color) - nil 'default)))) - (setq term-current-face - (list :background color - :foreground color)) - ) ;; No need to bother with anything else if it's invisible. - (setq term-current-face - (list :foreground - (face-foreground - (elt ansi-term-color-vector term-ansi-current-color) - nil 'default) - :background - (face-background - (elt ansi-term-color-vector term-ansi-current-bg-color) - nil 'default) - :inverse-video term-ansi-current-reverse)) - - (when term-ansi-current-bold + (let ((current-color (term--maybe-brighten-color + term-ansi-current-color + term-ansi-current-bold)) + (current-bg-color (term--maybe-brighten-color + term-ansi-current-bg-color + term-ansi-current-bold))) + (if term-ansi-current-invisible + (let ((color + (if term-ansi-current-reverse + (face-foreground + (elt ansi-term-color-vector current-color) + nil 'default) + (face-background + (elt ansi-term-color-vector current-bg-color) + nil 'default)))) + (setq term-current-face + (list :background color + :foreground color)) + ) ;; No need to bother with anything else if it's invisible. (setq term-current-face - `(,term-current-face :inherit term-bold))) + (list :foreground + (face-foreground + (elt ansi-term-color-vector current-color) + nil 'default) + :background + (face-background + (elt ansi-term-color-vector current-bg-color) + nil 'default) + :inverse-video term-ansi-current-reverse)) + + (when term-ansi-current-bold + (setq term-current-face + `(,term-current-face :inherit term-bold))) - (when term-ansi-current-underline - (setq term-current-face - `(,term-current-face :inherit term-underline))))) + (when term-ansi-current-underline + (setq term-current-face + `(,term-current-face :inherit term-underline)))))) ;; (message "Debug %S" term-current-face) ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el index 50ac370b5b..a61d0939ea 100644 --- a/test/lisp/term-tests.el +++ b/test/lisp/term-tests.el @@ -28,6 +28,45 @@ (defvar term-height) ; Number of lines in window. (defvar term-width) ; Number of columns in window. +(defvar yellow-fg-props + '(:foreground "yellow3" :background "unspecified-bg" :inverse-video nil)) +(defvar yellow-bg-props + '(:foreground "unspecified-fg" :background "yellow3" :inverse-video nil)) +(defvar bright-yellow-fg-props + '(:foreground "yellow2" :background "unspecified-bg" :inverse-video nil)) +(defvar bright-yellow-bg-props + '(:foreground "unspecified-fg" :background "yellow2" :inverse-video nil)) + +(defvar ansi-test-strings + `(("\e[33mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face yellow-fg-props)) + ("\e[43mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face yellow-bg-props)) + ("\e[93mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face bright-yellow-fg-props)) + ("\e[103mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face bright-yellow-bg-props)) + ("\e[1;33mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props :inherit term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props :inherit term-bold))) + ("\e[33;1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props :inherit term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props :inherit term-bold))) + ("\e[1m\e[33mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props :inherit term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props :inherit term-bold))) + ("\e[33m\e[1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props :inherit term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props :inherit term-bold))))) + (defun term-test-screen-from-input (width height input &optional return-var) (with-temp-buffer (term-mode) @@ -48,7 +87,7 @@ (mapc (lambda (input) (term-emulate-terminal proc input)) input) (term-emulate-terminal proc input)) (if return-var (buffer-local-value return-var (current-buffer)) - (buffer-substring-no-properties (point-min) (point-max)))))) + (buffer-substring (point-min) (point-max)))))) (ert-deftest term-simple-lines () (skip-unless (not (memq system-type '(windows-nt ms-dos)))) @@ -77,6 +116,24 @@ first line\r_next line\r\n")) (term-test-screen-from-input 40 12 (let ((str (make-string 30 ?a))) (list str str)))))) +(ert-deftest term-colors () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (pcase-dolist (`(,str ,expected) ansi-test-strings) + (let ((result (term-test-screen-from-input 40 12 str))) + (should (equal result expected)) + (should (equal (text-properties-at 0 result) + (text-properties-at 0 expected)))))) + +(ert-deftest term-colors-bold-is-bright () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (let ((term-color-bold-is-bright t)) + (pcase-dolist (`(,str ,expected ,bright-expected) ansi-test-strings) + (let ((expected (or bright-expected expected)) + (result (term-test-screen-from-input 40 12 str))) + (should (equal result expected)) + (should (equal (text-properties-at 0 result) + (text-properties-at 0 expected))))))) + (ert-deftest term-cursor-movement () (skip-unless (not (memq system-type '(windows-nt ms-dos)))) ;; Absolute positioning. commit c8e3347ec01a9ed6dc8d88c2dbbb3a08497e8eb2 Author: Jim Porter Date: Mon Aug 23 17:51:05 2021 -0700 Add support for "bright" ANSI colors in ansi-color * lisp/ansi-color.el (ansi-bright-color-names-vector): New defcustom. (ansi-color-bold-is-bright): New defcustom. (ansi-color--find-face): Sort ANSI codes and check 'ansi-color-bold-is-bright'. (ansi-color-apply-sequence): Support bright ANSI colors. (ansi-color--fill-color-map): New function. (ansi-color-make-color-map): Add bright ANSI colors. (ansi-color-get-face-1): Add BRIGHT parameter. * test/lisp/ansi-color-tests.el (ansi-color-apply-on-region-bold-is-bright-test): New function. diff --git a/etc/NEWS b/etc/NEWS index bfc1d3ef2e..62edfc7348 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -375,6 +375,13 @@ emulators by using the new input-meta-mode with the special value This parameter, similar to 'drag-with-header-line', allows moving frames by dragging the tab lines of their topmost windows with the mouse. +--- +** 'ansi-color' now supports "bright" color codes. +"Bright" ANSI color codes are now displayed when applying ANSI color +filters using the color values defined in 'ansi-bright-color-names-vector'. +In addition, bold text with regular ANSI colors can be displayed as +"bright" if 'ansi-color-bold-is-bright' is non-nil. + * Editing Changes in Emacs 28.1 diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 79dc821ea1..0dc9a52388 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -150,6 +150,48 @@ foreground and background colors, respectively." :version "24.4" ; default colors copied from `xterm-standard-colors' :group 'ansi-colors) +(defcustom ansi-bright-color-names-vector + ["gray30" "red2" "green2" "yellow2" "blue1" "magenta2" "cyan2" "white"] + "Colors used for SGR control sequences determining a \"bright\" color. +This vector holds the colors used for SGR control sequences parameters +90 to 97 (bright foreground colors) and 100 to 107 (brightbackground +colors). + +Parameter Color + 90 100 bright black + 91 101 bright red + 92 102 bright green + 93 103 bright yellow + 94 104 bright blue + 95 105 bright magenta + 96 106 bright cyan + 97 107 bright white + +This vector is used by `ansi-color-make-color-map' to create a color +map. This color map is stored in the variable `ansi-color-map'. + +Each element may also be a cons cell where the car and cdr specify the +foreground and background colors, respectively." + :type '(vector (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color))) + :set 'ansi-color-map-update + :initialize 'custom-initialize-default + :version "28.1" + :group 'ansi-colors) + +(defcustom ansi-color-bold-is-bright nil + "If set to non-nil, combining ANSI bold and a color produces the bright +version of that color." + :type 'boolean + :version "28.1" + :group 'ansi-colors) + (defconst ansi-color-control-seq-regexp ;; See ECMA 48, section 5.4 "Control Sequences". "\e\\[[\x30-\x3F]*[\x20-\x2F]*[\x40-\x7E]" @@ -304,9 +346,14 @@ This function can be added to `comint-preoutput-filter-functions'." (defun ansi-color--find-face (codes) "Return the face corresponding to CODES." - (let (faces) + ;; Sort the codes in ascending order to guarantee that "bold" comes before + ;; any of the colors. This ensures that `ansi-color-bold-is-bright' is + ;; applied correctly. + (let (faces bright (codes (sort (copy-sequence codes) #'<))) (while codes - (let ((face (ansi-color-get-face-1 (pop codes)))) + (let ((face (ansi-color-get-face-1 (pop codes) bright))) + (when (and ansi-color-bold-is-bright (eq face 'bold)) + (setq bright t)) ;; In the (default underline) face, say, the value of the ;; "underline" attribute of the `default' face wins. (unless (eq face 'default) @@ -570,11 +617,11 @@ ESCAPE-SEQUENCE is an escape sequence parsed by For each new code, the following happens: if it is 1-7, add it to the list of codes; if it is 21-25 or 27, delete appropriate -parameters from the list of codes; if it is 30-37 resp. 39, the -foreground color code is replaced or added resp. deleted; if it -is 40-47 resp. 49, the background color code is replaced or added -resp. deleted; any other code is discarded together with the old -codes. Finally, the so changed list of codes is returned." +parameters from the list of codes; if it is 30-37 (or 90-97) resp. 39, +the foreground color code is replaced or added resp. deleted; if it +is 40-47 (or 100-107) resp. 49, the background color code is replaced +or added resp. deleted; any other code is discarded together with the +old codes. Finally, the so changed list of codes is returned." (let ((new-codes (ansi-color-parse-sequence escape-sequence))) (while new-codes (let* ((new (pop new-codes)) @@ -591,7 +638,7 @@ codes. Finally, the so changed list of codes is returned." (22 (remq 1 codes)) (25 (remq 6 codes)) (_ codes))))) - ((or 3 4) (let ((r (mod new 10))) + ((or 3 4 9 10) (let ((r (mod new 10))) (unless (= r 8) (let (beg) (while (and codes (/= q (/ (car codes) 10))) @@ -603,6 +650,19 @@ codes. Finally, the so changed list of codes is returned." (_ nil))))) codes)) +(defun ansi-color--fill-color-map (map map-index property vector get-color) + "Fill a range of color values from VECTOR and store in MAP. + +Start filling MAP from MAP-INDEX, and make faces for PROPERTY (`foreground' +or `background'). GET-COLOR is a function taking an element of VECTOR and +returning the color value to use." + (mapc + (lambda (e) + (aset map map-index + (ansi-color-make-face property (funcall get-color e))) + (setq map-index (1+ map-index)) ) + vector)) + (defun ansi-color-make-color-map () "Creates a vector of face definitions and returns it. @@ -611,7 +671,7 @@ The index into the vector is an ANSI code. See the documentation of The face definitions are based upon the variables `ansi-color-faces-vector' and `ansi-color-names-vector'." - (let ((map (make-vector 50 nil)) + (let ((map (make-vector 110 nil)) (index 0)) ;; miscellaneous attributes (mapc @@ -620,23 +680,21 @@ The face definitions are based upon the variables (setq index (1+ index)) ) ansi-color-faces-vector) ;; foreground attributes - (setq index 30) - (mapc - (lambda (e) - (aset map index - (ansi-color-make-face 'foreground - (if (consp e) (car e) e))) - (setq index (1+ index)) ) - ansi-color-names-vector) + (ansi-color--fill-color-map + map 30 'foreground ansi-color-names-vector + (lambda (e) (if (consp e) (car e) e))) ;; background attributes - (setq index 40) - (mapc - (lambda (e) - (aset map index - (ansi-color-make-face 'background - (if (consp e) (cdr e) e))) - (setq index (1+ index)) ) - ansi-color-names-vector) + (ansi-color--fill-color-map + map 40 'background ansi-color-names-vector + (lambda (e) (if (consp e) (cdr e) e))) + ;; bright foreground attributes + (ansi-color--fill-color-map + map 90 'foreground ansi-bright-color-names-vector + (lambda (e) (if (consp e) (car e) e))) + ;; bright background attributes + (ansi-color--fill-color-map + map 100 'background ansi-bright-color-names-vector + (lambda (e) (if (consp e) (cdr e) e))) map)) (defvar ansi-color-map (ansi-color-make-color-map) @@ -660,9 +718,13 @@ property of `ansi-color-faces-vector' and `ansi-color-names-vector'." (set-default symbol value) (setq ansi-color-map (ansi-color-make-color-map))) -(defun ansi-color-get-face-1 (ansi-code) +(defun ansi-color-get-face-1 (ansi-code &optional bright) "Get face definition from `ansi-color-map'. -ANSI-CODE is used as an index into the vector." +ANSI-CODE is used as an index into the vector. BRIGHT, if non-nil, +requests \"bright\" ANSI colors, even if ANSI-CODE is a normal-intensity +color." + (when (and bright (<= 30 ansi-code 49)) + (setq ansi-code (+ ansi-code 60))) (condition-case nil (aref ansi-color-map ansi-code) (args-out-of-range nil))) diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el index 107dc8e400..c94561bda1 100644 --- a/test/lisp/ansi-color-tests.el +++ b/test/lisp/ansi-color-tests.el @@ -25,17 +25,54 @@ ;;; Code: (require 'ansi-color) +(eval-when-compile (require 'cl-lib)) -(defvar test-strings '(("\e[33mHello World\e[0m" . "Hello World") - ("\e[1m\e[3m\e[5mbold italics blink\e[0m" . "bold italics blink"))) +(defvar yellow (aref ansi-color-names-vector 3)) +(defvar bright-yellow (aref ansi-bright-color-names-vector 3)) + +(defvar test-strings + `(("\e[33mHello World\e[0m" "Hello World" + (foreground-color . ,yellow)) + ("\e[43mHello World\e[0m" "Hello World" + (background-color . ,yellow)) + ("\e[93mHello World\e[0m" "Hello World" + (foreground-color . ,bright-yellow)) + ("\e[103mHello World\e[0m" "Hello World" + (background-color . ,bright-yellow)) + ("\e[1;33mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[33;1mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[1m\e[33mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[33m\e[1mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[1m\e[3m\e[5mbold italics blink\e[0m" "bold italics blink" + (bold italic success)))) (ert-deftest ansi-color-apply-on-region-test () - (dolist (pair test-strings) - (with-temp-buffer - (insert (car pair)) + (pcase-dolist (`(,input ,text ,face) test-strings) + (with-temp-buffer + (insert input) + (ansi-color-apply-on-region (point-min) (point-max)) + (should (equal (buffer-string) text)) + (should (equal (get-char-property (point-min) 'face) face)) + (should (not (equal (overlays-at (point-min)) nil)))))) + +(ert-deftest ansi-color-apply-on-region-bold-is-bright-test () + (pcase-dolist (`(,input ,text ,face ,bright-face) test-strings) + (with-temp-buffer + (let ((ansi-color-bold-is-bright t)) + (insert input) (ansi-color-apply-on-region (point-min) (point-max)) - (should (equal (buffer-string) (cdr pair))) - (should (not (equal (overlays-at (point-min)) nil)))))) + (should (equal (buffer-string) text)) + (should (equal (get-char-property (point-min) 'face) + (or bright-face face))) + (should (not (equal (overlays-at (point-min)) nil))))))) (ert-deftest ansi-color-apply-on-region-preserving-test () (dolist (pair test-strings) commit f09ee98e6877a1b8b33bd9ec976d71f1b2d6d2da Author: Shitikanth Kashyap Date: Wed Aug 25 13:34:45 2021 +0200 tabulated-list-print delete excess lines * lisp/emacs-lisp/tabulated-list.el (tabulated-list-print): Ensure that we delete remaining lines if the list has gotten shorter (bug#50194). Copyright-paperwork-exempt: yes diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index f0ee78745a..fecfa91147 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -481,6 +481,8 @@ changing `tabulated-list-sort-key'." (forward-line 1) (delete-region old (point)))))) (setq entries (cdr entries))) + (when update + (delete-region (point) (point-max))) (set-buffer-modified-p nil) ;; If REMEMBER-POS was specified, move to the "old" location. (if saved-pt commit 630a13ac4631866889bab1177e06ca1d693708c1 Author: Augusto Stoffel Date: Wed Aug 25 12:29:22 2021 +0200 Add support for OSC escape codes in comint * doc/emacs/misc.texi (Shell Mode): Document it. * lisp/comint.el (comint-osc-handlers, comint-osc--marker): New variables. (comint-osc-process-output): New function. (comint-osc-hyperlink-map): New map. (comint-osc-hyperlink-handler): New function. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 528cfa94c6..47e3e11d33 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1113,6 +1113,19 @@ subshell: @end example @end table +By default, Shell mode handles common @acronym{ANSI} escape codes (for +instance, for changing the color of text). Emacs also optionally +supports some extend escape codes, like some of the @acronym{OSC} +(Operating System Codes) if you put the following in your init file: + +@lisp +(add-hook 'comint-output-filter-functions 'comint-osc-process-output) +@end lisp + +With this enabled, the output from, for instance, @code{ls +--hyperlink} will be made into clickable buttons in the Shell mode +buffer. + @cindex Comint mode @cindex mode, Comint Shell mode is a derivative of Comint mode, a general-purpose mode for diff --git a/etc/NEWS b/etc/NEWS index 07a78216b8..bfc1d3ef2e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1561,10 +1561,6 @@ If non-nil, 'shell-mode' handles implicit "cd" commands, changing the directory if the command is a directory. Useful for shells like "zsh" that has this feature. -+++ -*** 'comint-delete-output' can now save deleted text in the kill-ring. -Interactively, 'C-u C-c C-o' triggers this new optional behavior. - ** Eshell --- @@ -3026,6 +3022,21 @@ default are unaffected.) states to be maintained if 'so-long-mode' replaces the original major mode. By default, these new options support 'view-mode'. +** Comint + ++++ +*** Support for OSC escape sequences. +Adding the new 'comint-osc-process-output' to +'comint-output-filter-functions' enables the interpretation of OSC +("Operating System Command") escape sequences in comint buffers. By +default, only OSC 8, for hyperlinks, is acted upon. Adding more +entries to `comint-osc-handlers' allows a customized treatment of +further escape sequences. + ++++ +*** 'comint-delete-output' can now save deleted text in the kill-ring. +Interactively, 'C-u C-c C-o' triggers this new optional behavior. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/comint.el b/lisp/comint.el index 7af8e8fd2a..b2557dd502 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3887,6 +3887,91 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; don't advance, so ensure forward progress. (forward-line 1))) (nreverse results)))) + + +;;; OSC escape sequences (Operating System Commands) +;;============================================================================ +;; Adding `comint-osc-process-output' to `comint-output-filter-functions' +;; enables the interpretation of OSC escape sequences. By default, only +;; OSC 8, for hyperlinks, is acted upon. Adding more entries to +;; `comint-osc-handlers' allows a customized treatment of further sequences. + +(defvar-local comint-osc-handlers '(("8" . comint-osc-hyperlink-handler)) + "Alist of handlers for OSC escape sequences. +See `comint-osc-process-output' for details.") + +(defvar-local comint-osc--marker nil) + +(defun comint-osc-process-output (_) + "Interpret OSC escape sequences in comint output. +This function is intended to be added to +`comint-output-filter-functions' in order to interpret escape +sequences of the forms + + ESC ] command ; text BEL + ESC ] command ; text ESC \\ + +Specifically, every occurrence of such escape sequences is +removed from the buffer. Then, if `command' is a key of the +`comint-osc-handlers' alist, the corresponding value, which +should be a function, is called with `command' and `text' as +arguments, with point where the escape sequence was located." + (let ((bound (process-mark (get-buffer-process (current-buffer))))) + (save-excursion + (goto-char (or comint-osc--marker + (and (markerp comint-last-output-start) + (eq (marker-buffer comint-last-output-start) + (current-buffer)) + comint-last-output-start) + (point-min))) + (when (eq (char-before) ?\e) (backward-char)) + (while (re-search-forward "\e]" bound t) + (let ((pos0 (match-beginning 0)) + (code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" bound t) + (match-string 1))) + (pos1 (point))) + (if (re-search-forward "\a\\|\e\\\\" bound t) + (let ((text (buffer-substring-no-properties + pos1 (match-beginning 0)))) + (setq comint-osc--marker nil) + (delete-region pos0 (point)) + (when-let ((fun (cdr (assoc-string code comint-osc-handlers)))) + (funcall fun code text))) + (put-text-property pos0 bound 'invisible t) + (setq comint-osc--marker (copy-marker pos0)))))))) + +;; Hyperlink handling (OSC 8) + +(defvar comint-osc-hyperlink-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\r" 'browse-url-button-open) + (define-key map [mouse-2] 'browse-url-button-open) + (define-key map [follow-link] 'mouse-face) + map) + "Keymap used by OSC 8 hyperlink buttons.") + +(define-button-type 'comint-osc-hyperlink + 'keymap comint-osc-hyperlink-map + 'help-echo (lambda (_ buffer pos) + (when-let ((url (get-text-property pos 'browse-url-data buffer))) + (format "mouse-2, C-c RET: Open %s" url)))) + +(defvar-local comint-osc-hyperlink--state nil) + +(defun comint-osc-hyperlink-handler (_ text) + "Create a hyperlink from an OSC 8 escape sequence. +This function is intended to be included as an entry of +`comint-osc-handlers'." + (when comint-osc-hyperlink--state + (let ((start (car comint-osc-hyperlink--state)) + (url (cdr comint-osc-hyperlink--state))) + (make-text-button start (point) + 'type 'comint-osc-hyperlink + 'browse-url-data url))) + (setq comint-osc-hyperlink--state + (and (string-match ";\\(.+\\)" text) + (cons (point-marker) (match-string-no-properties 1 text))))) + ;;; Converting process modes to use comint mode ;;============================================================================ diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index f739cd72cc..c8ca70cc1f 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1780,6 +1780,7 @@ clickable and will use `browse-url' to open the URLs in question." category browse-url browse-url-data ,(match-string 0))))))) +;;;###autoload (defun browse-url-button-open (&optional external mouse-event) "Follow the link under point using `browse-url'. If EXTERNAL (the prefix if used interactively), open with the commit 64b4c85637d9d5aa98ddc4f006f24cbd28727416 Author: Lars Ingebrigtsen Date: Wed Aug 25 11:58:27 2021 +0200 Fix up deleting auto-save/killing buffer wrt. `auto-save-visited-mode' * src/buffer.c (Fkill_buffer): Respect `auto-save-visited-mode'. diff --git a/src/buffer.c b/src/buffer.c index 5951040ff2..100ebc7e2d 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1798,11 +1798,15 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* Delete the autosave file, if requested. */ if (modified - && STRINGP (BVAR (b, auto_save_file_name)) - && !NILP (Ffile_exists_p (BVAR (b, auto_save_file_name))) && kill_buffer_delete_auto_save_files && delete_auto_save_files - && !NILP (Frecent_auto_save_p ())) + && !NILP (Frecent_auto_save_p ()) + && STRINGP (BVAR (b, auto_save_file_name)) + && !NILP (Ffile_exists_p (BVAR (b, auto_save_file_name))) + /* If `auto-save-visited-mode' is on, then we're auto-saving + to the visited file -- don't delete it.. */ + && NILP (Fstring_equal (BVAR (b, auto_save_file_name), + BVAR (b, filename)))) { tem = do_yes_or_no_p (build_string ("Delete auto-save file? ")); if (!NILP (tem)) commit de645109732899fcd6f1b88142c66c1ee799665c Author: Lars Ingebrigtsen Date: Wed Aug 25 11:49:52 2021 +0200 Further checks for kill-buffer-delete-auto-save-files * src/buffer.c (Fkill_buffer): Check that the auto-save file exists before asking whether to delete it. diff --git a/src/buffer.c b/src/buffer.c index 7ba0c8bc2a..5951040ff2 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1798,6 +1798,8 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* Delete the autosave file, if requested. */ if (modified + && STRINGP (BVAR (b, auto_save_file_name)) + && !NILP (Ffile_exists_p (BVAR (b, auto_save_file_name))) && kill_buffer_delete_auto_save_files && delete_auto_save_files && !NILP (Frecent_auto_save_p ())) commit 7782ccd6de259c14c3843cfed38d944d91b32c89 Author: Lars Ingebrigtsen Date: Wed Aug 25 11:41:38 2021 +0200 Fix up previous conf-mode/tex-mode redirection hacks * lisp/textmodes/conf-mode.el (conf-mode): * lisp/textmodes/tex-mode.el (tex--redirect-to-submode): The previous hack to these redirections would disable all local variables. Try to work around this a bit more. diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 949d8cbdab..57ec8a0428 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -417,16 +417,18 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode', ;; To tell the difference between those two cases where the function ;; might be called, we check `delay-mode-hooks'. ;; (inspired from tex-mode.el) +(defvar conf-mode--recursing nil) (advice-add 'conf-mode :around (lambda (orig-fun) "Redirect to one of the submodes when called directly." ;; The file may have "mode: conf" in the local variable ;; block, in which case we'll be called recursively ;; infinitely. Inhibit that. - (let ((enable-local-variables nil)) - (funcall (if delay-mode-hooks orig-fun (conf--guess-mode)))))) - - + (let ((conf-mode--recursing conf-mode--recursing)) + (funcall (if (or delay-mode-hooks conf-mode--recursing) + orig-fun + (setq conf-mode--recursing t) + (conf--guess-mode)))))) (defun conf-mode-initialize (comment &optional font-lock) "Initializations for sub-modes of `conf-mode'. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 2a61e4e9a3..d7cd0aceb2 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1014,15 +1014,17 @@ says which mode to use." (tex-common-initialization)) (advice-add 'tex-mode :around #'tex--redirect-to-submode) +(defvar tex-mode--recursing nil) (defun tex--redirect-to-submode (orig-fun) "Redirect to one of the submodes when called directly." ;; The file may have "mode: tex" in the local variable ;; block, in which case we'll be called recursively ;; infinitely. Inhibit that. - (let ((enable-local-variables nil)) - (funcall (if delay-mode-hooks + (let ((tex-mode--recursing tex-mode--recursing)) + (funcall (if (or delay-mode-hooks tex-mode--recursing) ;; We're called from one of the children already. orig-fun + (setq tex-mode--recursing t) (tex--guess-mode))))) ;; The following three autoloaded aliases appear to conflict with commit 5b03849102819e147ba6458bd7eb2bd5abc7e60d Author: Tino Calancha Date: Fri Aug 20 18:07:04 2021 +0200 ; * test/lisp/files-tests.el: Add tests for save-some-buffers ; Do not merge to master. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 1fc8007352..fc8adb88b5 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1326,5 +1326,213 @@ See ." (normal-mode) (should (not (eq major-mode 'text-mode)))))) +(defun files-tests--save-some-buffers (pred def-pred-bind exp-1 exp-2) + "Helper function to test `save-some-buffers'. + +This function creates two visiting-file buffers, BUF-1, BUF-2 in + different directories at the same level, i.e., none of them is a + subdir of the other; then, it modifies both buffers; finally, it calls + `save-some-buffers' from BUF-1 with first arg t, second arg PRED + and `save-some-buffers-default-predicate' let-bound to + DEF-PRED-BIND. + +EXP-1 and EXP-2 are the expected values of calling `buffer-modified-p' +on BUF-1 and BUF-2 after the `save-some-buffers' call. + +The test is repeated with `save-some-buffers-default-predicate' +let-bound to PRED and passing nil as second arg of +`save-some-buffers'." + (let* ((dir (make-temp-file "testdir" 'dir)) + (file-1 (expand-file-name "subdir-1/file.foo" dir)) + (file-2 (expand-file-name "subdir-2/file.bar" dir)) + (inhibit-message t) + buf-1 buf-2) + (unwind-protect + (progn + (make-empty-file file-1 'parens) + (make-empty-file file-2 'parens) + (setq buf-1 (find-file file-1) + buf-2 (find-file file-2)) + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (insert "foobar\n"))) + ;; Run the test. + (with-current-buffer buf-1 + (let ((save-some-buffers-default-predicate def-pred-bind)) + (save-some-buffers t pred)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2)))) + ;; Set both buffers as modified to run another test. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (set-buffer-modified-p t))) + ;; The result of this test must be identical as the previous one. + (with-current-buffer buf-1 + (let ((save-some-buffers-default-predicate (or pred def-pred-bind))) + (save-some-buffers t nil)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2))))) + ;; Clean up. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory dir 'recursive)))) + +(ert-deftest files-tests-save-some-buffers () + "Test `save-some-buffers'. +Test the 3 cases for the second argument PRED, i.e., nil, t or +predicate. +The value of `save-some-buffers-default-predicate' is ignored unless +PRED is nil." + (let* ((foo-file-p (lambda () (string-suffix-p ".foo" buffer-file-name))) + (bar-file-p (lambda () (string-suffix-p ".bar" buffer-file-name))) + (args-results `((nil nil nil nil) + (nil ,foo-file-p nil t) + (nil ,bar-file-p t nil) + (,foo-file-p nil nil t) + (,bar-file-p nil t nil) + + (buffer-modified-p nil nil nil) + (t nil nil nil) + (t ,foo-file-p nil nil)))) + (pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results) + (files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2)))) + +(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results) + "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'. + +This macro creates several non-visiting-file buffers in different + directories at the same level, i.e., none of them is a subdir of the + other; then, it modifies the buffers and sets their `buffer-offer-save' + as specified by BUFFERS-OFFER, a list of elements + (BUFFER OFFER-SAVE). Finally, it calls FN-TEST from the first + buffer. + +FN-TEST is the function to test: either `save-some-buffers' or +`save-buffers-kill-emacs'. This function is called with +`save-some-buffers-default-predicate' let-bound to a value +specified inside ARGS-RESULTS. + +FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION +is a function symbol that this macro temporary binds to BINDING during +the FN-TEST call. + +ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where + FN-ARGS are the arguments for FN-TEST; + CALLERS-DIR specifies the value to let-bind +`save-some-buffers-default-predicate'; + EXPECTED is the expected result of the test." + (declare (debug (form symbol form form))) + (let ((dir (gensym "dir")) + (buffers (gensym "buffers"))) + `(let* ((,dir (make-temp-file "testdir" 'dir)) + (inhibit-message t) + (use-dialog-box nil) + ,buffers) + (pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer) + (let* ((buf (generate-new-buffer (symbol-name bufsym))) + (subdir (expand-file-name + (format "subdir-%s" (buffer-name buf)) + ,dir))) + (make-directory subdir 'parens) + (push buf ,buffers) + (with-current-buffer buf + (cd subdir) + (setq buffer-offer-save offer-save) + (insert "foobar\n")))) + (setq ,buffers (nreverse ,buffers)) + (let ((nb-saved-buffers 0)) + (unwind-protect + (pcase-dolist (`(,fn-test-args ,callers-dir ,expected) + ,args-results) + (setq nb-saved-buffers 0) + (with-current-buffer (car ,buffers) + (cl-letf + (,@(mapcar (lambda (pair) `((symbol-function ,(car pair)) ,(cdr pair))) + fn-binders) + (save-some-buffers-default-predicate callers-dir)) + (apply #',fn-test fn-test-args) + (should (equal nb-saved-buffers expected))))) + ;; Clean up. + (dolist (buf ,buffers) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory ,dir 'recursive)))))) + +(defmacro files-tests-with-all-permutations (permutation list &rest body) + "Execute BODY forms for all permutations of LIST. +Execute the forms with the symbol PERMUTATION bound to the current +permutation." + (declare (indent 2) (debug (symbol form body))) + (let ((vec (gensym "vec"))) + `(let ((,vec (vconcat ,list))) + (cl-labels ((swap (,vec i j) + (let ((tmp (aref ,vec j))) + (aset ,vec j (aref ,vec i)) + (aset ,vec i tmp))) + (permute (,vec l r) + (if (= l r) + (let ((,permutation (append ,vec nil))) + ,@body) + (cl-loop for idx from l below (1+ r) do + (swap ,vec idx l) + (permute ,vec (1+ l) r) + (swap ,vec idx l))))) + (permute ,vec 0 (1- (length ,vec))))))) + +(ert-deftest files-tests-buffer-offer-save () + "Test `save-some-buffers' for non-visiting buffers. +Check the behavior of `save-some-buffers' for non-visiting-file +buffers under several values of `buffer-offer-save'. +The value of `save-some-buffers-default-predicate' is ignored unless +PRED is nil." + (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil))) + (nb-might-save + (length + (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init))) + (nb-always-save + (length + (cl-remove-if-not (lambda (l) (eq 'always (cadr l))) buffers-offer-init))) + (only-buf-1-p (lambda () (string-prefix-p "buf-1" (buffer-name))))) + (files-tests-with-all-permutations + buffers-offer + buffers-offer-init + (dolist (pred `(nil t ,only-buf-1-p)) + (dolist (def-pred-bind `(nil ,only-buf-1-p)) + (let* ((res (cond ((null pred) + (or (and (null def-pred-bind) nb-always-save) + 1)) + (t + (or (and (eq pred t) nb-might-save) + 1)))) + (args-res `(((nil ,pred) ,def-pred-bind ,res)))) + (files-tests--with-buffer-offer-save + buffers-offer + save-some-buffers + ;; Increase counter and answer 'n' when prompted to save a buffer. + (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n))) + args-res))))))) + +(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers () + "Test that `save-buffers-kill-emacs' asks to save buffers as expected. +Prompt users for any modified buffer with `buffer-offer-save' non-nil." + (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil))) + (nb-might-save + (length + (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init)))) + (files-tests-with-all-permutations + buffers-offer + buffers-offer-init + (files-tests--with-buffer-offer-save + buffers-offer + save-buffers-kill-emacs + ;; Increase counter and answer 'n' when prompted to save a buffer. + (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n)) + ('kill-emacs . #'ignore)) ; Do not kill Emacs. + `((nil nil ,nb-might-save) + ;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored. + (nil (lambda () (string-prefix-p "foo" (buffer-name))) ,nb-might-save)))))) + + (provide 'files-tests) ;;; files-tests.el ends here