diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 60955fd3195..9d929950a7e 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7124,6 +7124,12 @@ This is only valid for @code{image} icons, and can be either a number (which specifies the height in pixels), or the symbol @code{line}, which will use the default line height in the currently selected window. + +@item :width +This is only valid for @code{image} icons, and can be either a number +(which specifies the width in pixels), or the symbol @code{font}, +which will use the width in pixels of the current buffer’s default +face font. @end table @var{doc} should be a doc string. diff --git a/etc/NEWS.29 b/etc/NEWS.29 index a9d279fee5b..d38ccadba64 100644 --- a/etc/NEWS.29 +++ b/etc/NEWS.29 @@ -2810,6 +2810,22 @@ Set it to nil to exclude line numbering from kills and copies. argument which allows tree-widget display to be activated and computed only when the user expands the node. +** Proced + +--- +*** proced.el shows system processes of remote hosts. +When 'default-directory' is remote, and 'proced' is invoked with a +negative argument like 'C-u - proced', the system processes of that +remote host are shown. Alternatively, the user option +'proced-show-remote-processes' can be set to non-nil. +'proced-signal-function' has been marked obsolete. + +--- +*** Proced can now optionally show process details in color. +New user option 'proced-enable-color-flag' enables coloring of Proced +buffers. This option is disabled by default; customize it to a +non-nil value to enable colors. + ** Miscellaneous --- @@ -2895,14 +2911,6 @@ also been renamed: 'mark-bib' to 'bib-mark' 'unread-bib' to 'bib-unread' ---- -*** proced.el shows system processes of remote hosts. -When 'default-directory' is remote, and 'proced' is invoked with a -negative argument like 'C-u - proced', the system processes of that -remote host are shown. Alternatively, the user option -'proced-show-remote-processes' can be set to non-nil. -'proced-signal-function' has been marked obsolete. - --- *** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. The old name is still available as an obsolete function alias. @@ -2981,7 +2989,14 @@ when visiting JSON files. ** New major mode 'typescript-ts-mode'. A major mode based on the tree-sitter library for editing programs in the TypeScript language. It includes support for font-locking, -indentation, and navigation. +indentation, and navigation. This mode will be auto-enabled for +files with the '.ts' extension. + +** New major mode 'tsx-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the TypeScript language, with support for TSX. It includes +support for font-locking, indentation, and navigation. This mode +will be auto-enabled for files with the '.tsx' extension. ** New major mode 'c-ts-mode'. A major mode based on the tree-sitter library for editing programs diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 86c44830308..8ba6d97ea00 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -202,6 +202,10 @@ present if the icon is represented by an image." (list :height (if (eq height 'line) (window-default-line-height) height))) + (if-let ((width (plist-get keywords :width))) + (list :width (if (eq width 'font) + (default-font-width) + width))) '(:scale 1) (if-let ((rotation (plist-get keywords :rotation))) (list :rotation rotation)) diff --git a/lisp/outline.el b/lisp/outline.el index 86ac19aa415..2c3f9798ec4 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -318,6 +318,12 @@ don't modify the buffer." (defvar-local outline--use-rtl nil "Non-nil when direction of clickable buttons is right-to-left.") +(defvar-local outline--margin-width nil + "Current margin width.") + +(defvar-local outline-margin-width nil + "Default margin width.") + (define-icon outline-open nil '((image "outline-open.svg" "outline-open.pbm" :height (0.8 . em)) (emoji "🔽") @@ -344,24 +350,24 @@ don't modify the buffer." "Right-to-left icon used for buttons in closed outline sections." :version "29.1") -(define-icon outline-open-in-margins outline-open - '((image "outline-open.svg" "outline-open.pbm" :height 10) +(define-icon outline-open-in-margins nil + '((image "outline-open.svg" "outline-open.pbm" :width font) (emoji "🔽") (symbol "▼") (text "v")) "Icon used for buttons for opened sections in margins." :version "29.1") -(define-icon outline-close-in-margins outline-close - '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90) +(define-icon outline-close-in-margins nil + '((image "outline-open.svg" "outline-open.pbm" :width font :rotation -90) (emoji "▶️") (symbol "▶") (text ">")) "Icon used for buttons for closed sections in margins." :version "29.1") -(define-icon outline-close-rtl-in-margins outline-close-rtl - '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90) +(define-icon outline-close-rtl-in-margins nil + '((image "outline-open.svg" "outline-open.pbm" :width font :rotation 90) (emoji "◀️") (symbol "◀") (text "<")) @@ -528,9 +534,22 @@ See the command `outline-mode' for more information on this mode." (when (and (eq outline-minor-mode-use-buttons 'in-margins) (> 1 (if outline--use-rtl right-margin-width left-margin-width))) + (setq outline--margin-width + (or outline-margin-width + (ceiling + (/ (seq-max + (seq-map #'string-pixel-width + (seq-map #'icon-string + `(outline-open-in-margins + ,(if outline--use-rtl + 'outline-close-rtl-in-margins + 'outline-close-in-margins))))) + (* (default-font-width) 1.0))))) (if outline--use-rtl - (setq-local right-margin-width (1+ right-margin-width)) - (setq-local left-margin-width (1+ left-margin-width))) + (setq-local right-margin-width (+ right-margin-width + outline--margin-width)) + (setq-local left-margin-width (+ left-margin-width + outline--margin-width))) (setq-local fringes-outside-margins t) ;; Force display of margins (when (eq (current-buffer) (window-buffer)) @@ -566,8 +585,10 @@ See the command `outline-mode' for more information on this mode." (< 0 (if outline--use-rtl right-margin-width left-margin-width))) (if outline--use-rtl - (setq-local right-margin-width (1- right-margin-width)) - (setq-local left-margin-width (1- left-margin-width))) + (setq-local right-margin-width (- right-margin-width + outline--margin-width)) + (setq-local left-margin-width (- left-margin-width + outline--margin-width))) (setq-local fringes-outside-margins nil) ;; Force removal of margins (when (eq (current-buffer) (window-buffer)) diff --git a/lisp/proced.el b/lisp/proced.el index ac44ae1513d..c7419288edf 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -114,41 +114,58 @@ the external command (usually \"kill\")." (defcustom proced-grammar-alist '( ;; attributes defined in `process-attributes' (euid "EUID" "%d" right proced-< nil (euid pid) (nil t nil)) - (user "User" nil left proced-string-lessp nil (user pid) (nil t nil)) + (user "User" proced-format-user left proced-string-lessp nil + (user pid) (nil t nil)) (egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil)) - (group "Group" nil left proced-string-lessp nil (group user pid) (nil t nil)) + (group "Group" nil left proced-string-lessp nil (group user pid) + (nil t nil)) (comm "Command" nil left proced-string-lessp nil (comm pid) (nil t nil)) - (state "Stat" nil left proced-string-lessp nil (state pid) (nil t nil)) - (ppid "PPID" "%d" right proced-< nil (ppid pid) - ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) - "refine to process parents")) - (pgrp "PGrp" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) - (sess "Sess" "%d" right proced-< nil (sess pid) (nil t nil)) - (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) + (state "Stat" proced-format-state left proced-string-lessp nil + (state pid) (nil t nil)) + (ppid "PPID" proced-format-ppid right proced-< nil (ppid pid) + ((lambda (ppid) + (proced-filter-parents proced-process-alist ppid)) + "refine to process parents")) + (pgrp "PGrp" proced-format-pgrp right proced-< nil (pgrp euid pid) + (nil t nil)) + (sess "Sess" proced-format-sess right proced-< nil (sess pid) + (nil t nil)) + (ttname "TTY" proced-format-ttname left proced-string-lessp nil + (ttname pid) (nil t nil)) (tpgid "TPGID" "%d" right proced-< nil (tpgid pid) (nil t nil)) (minflt "MinFlt" "%d" right proced-< nil (minflt pid) (nil t t)) (majflt "MajFlt" "%d" right proced-< nil (majflt pid) (nil t t)) (cminflt "CMinFlt" "%d" right proced-< nil (cminflt pid) (nil t t)) (cmajflt "CMajFlt" "%d" right proced-< nil (cmajflt pid) (nil t t)) - (utime "UTime" proced-format-time right proced-time-lessp t (utime pid) (nil t t)) - (stime "STime" proced-format-time right proced-time-lessp t (stime pid) (nil t t)) - (time "Time" proced-format-time right proced-time-lessp t (time pid) (nil t t)) - (cutime "CUTime" proced-format-time right proced-time-lessp t (cutime pid) (nil t t)) - (cstime "CSTime" proced-format-time right proced-time-lessp t (cstime pid) (nil t t)) - (ctime "CTime" proced-format-time right proced-time-lessp t (ctime pid) (nil t t)) + (utime "UTime" proced-format-time right proced-time-lessp t (utime pid) + (nil t t)) + (stime "STime" proced-format-time right proced-time-lessp t (stime pid) + (nil t t)) + (time "Time" proced-format-time right proced-time-lessp t (time pid) + (nil t t)) + (cutime "CUTime" proced-format-time right proced-time-lessp t (cutime pid) + (nil t t)) + (cstime "CSTime" proced-format-time right proced-time-lessp t (cstime pid) + (nil t t)) + (ctime "CTime" proced-format-time right proced-time-lessp t (ctime pid) + (nil t t)) (pri "Pr" "%d" right proced-< t (pri pid) (nil t t)) (nice "Ni" "%3d" 3 proced-< t (nice pid) (t t nil)) (thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t)) - (start "Start" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) - (vsize "VSize" proced-format-memory right proced-< t (vsize pid) (nil t t)) - (rss "RSS" proced-format-memory right proced-< t (rss pid) (nil t t)) - (etime "ETime" proced-format-time right proced-time-lessp t (etime pid) (nil t t)) - (pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t)) - (pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t)) - (args "Args" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) + (start "Start" proced-format-start 6 proced-time-lessp nil (start pid) + (t t nil)) + (vsize "VSize" proced-format-memory right proced-< t (vsize pid) + (nil t t)) + (rss "RSS" proced-format-rss right proced-< t (rss pid) (nil t t)) + (etime "ETime" proced-format-time right proced-time-lessp t (etime pid) + (nil t t)) + (pcpu "%CPU" proced-format-cpu right proced-< t (pcpu pid) (nil t t)) + (pmem "%Mem" proced-format-mem right proced-< t (pmem pid) (nil t t)) + (args "Args" proced-format-args left proced-string-lessp nil + (args pid) (nil t nil)) ;; ;; attributes defined by proced (see `proced-process-attributes') - (pid "PID" "%d" right proced-< nil (pid) + (pid "PID" proced-format-pid right proced-< nil (pid) ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) "refine to process children")) ;; process tree @@ -367,6 +384,32 @@ May be used to revert the process listing." :type 'hook :options '(proced-revert)) +(defcustom proced-enable-color-flag nil + "Non-nil means Proced should display some process attributes with color." + :type 'boolean + :version "29.1") + +(defcustom proced-low-memory-usage-threshold 0.1 + "The upper bound for low relative memory usage display in Proced. + +When `proced-enable-color-flag' is non-nil, RSS values denoting a +proportion of memory, relative to total memory, that is lower +than this value will be displayed using the `proced-memory-low-usage' face." + :type 'float + :version "29.1") + +(defcustom proced-medium-memory-usage-threshold 0.5 + "The upper bound for medium relative memory usage display in Proced. + +When `proced-enable-color-flag' is non-nil, RSS values denoting a +proportion of memory, relative to total memory, that is less than +this value, but greater than `proced-low-memory-usage-threshold', +will be displayed using the `proced-memory-medium-usage' face. +RSS values denoting a greater proportion than this value will be +displayed using the `proced-memory-high-usage' face." + :type 'float + :version "29.1") + ;; Internal variables (defvar proced-available t;(not (null (list-system-processes))) @@ -403,6 +446,114 @@ It is a list of lists (KEY PREDICATE REVERSE).") '((t (:inherit font-lock-keyword-face))) "Face used for header of attribute used for sorting.") +(defface proced-run-status-code + '((t (:foreground "green"))) + "Face used in Proced buffers for running or runnable status code character \"R\"." + :version "29.1") + +(defface proced-interruptible-sleep-status-code + '((((class color) (min-colors 88)) (:foreground "DimGrey")) + (t (:italic t))) + "Face used in Proced buffers for interruptible sleep status code character \"S\"." + :version "29.1") + +(defface proced-uninterruptible-sleep-status-code + '((((class color)) (:foreground "red")) + (t (:bold t))) + "Face used in Proced buffers for uninterruptible sleep status code character \"D\"." + :version "29.1") + +(defface proced-executable + '((((class color) (min-colors 88) (background dark)) (:foreground "DeepSkyBlue")) + (((class color) (background dark)) (:foreground "cyan")) + (((class color) (background light)) (:foreground "blue")) + (t (:bold t))) + "Face used in Proced buffers for executable names. +The first word in the process arguments attribute is assumed to +be the executable that runs in the process." + :version "29.1") + +(defface proced-memory-high-usage + '((((class color) (min-colors 88) (background dark)) (:foreground "orange")) + (((class color) (min-colors 88) (background light)) (:foreground "OrangeRed")) + (((class color)) (:foreground "red")) + (t (:underline t))) + "Face used in Proced buffers for high memory usage." + :version "29.1") + +(defface proced-memory-medium-usage + '((((class color) (min-colors 88) (background dark)) (:foreground "yellow3")) + (((class color) (min-colors 88) (background light)) (:foreground "orange")) + (((class color)) (:foreground "yellow"))) + "Face used in Proced buffers for medium memory usage." + :version "29.1") + +(defface proced-memory-low-usage + '((((class color) (min-colors 88) (background dark)) (:foreground "#8bcd50")) + (((class color)) (:foreground "green"))) + "Face used in Proced buffers for low memory usage." + :version "29.1") + +(defface proced-emacs-pid + '((((class color) (min-colors 88)) (:foreground "purple")) + (((class color)) (:foreground "magenta"))) + "Face used in Proced buffers for the process ID of the current Emacs process." + :version "29.1") + +(defface proced-pid + '((((class color) (min-colors 88)) (:foreground "#5085ef")) + (((class color)) (:foreground "blue"))) + "Face used in Proced buffers for process IDs." + :version "29.1") + +(defface proced-session-leader-pid + '((((class color) (min-colors 88)) (:foreground "#5085ef" :underline t)) + (((class color)) (:foreground "blue" :underline t)) + (t (:underline t))) + "Face used in Proced buffers for process IDs which are session leaders." + :version "29.1") + +(defface proced-ppid + '((((class color) (min-colors 88)) (:foreground "#5085bf")) + (((class color)) (:foreground "blue"))) + "Face used in Proced buffers for parent process IDs." + :version "29.1") + +(defface proced-pgrp + '((((class color) (min-colors 88)) (:foreground "#4785bf")) + (((class color)) (:foreground "blue"))) + "Face used in Proced buffers for process group IDs." + :version "29.1") + +(defface proced-sess + '((((class color) (min-colors 88)) (:foreground "#41729f")) + (((class color)) (:foreground "MidnightBlue"))) + "Face used in Proced buffers for process session IDs." + :version "29.1") + +(defface proced-cpu + '((((class color) (min-colors 88)) (:foreground "#6d5cc3" :bold t)) + (t (:bold t))) + "Face used in Proced buffers for process CPU utilization." + :version "29.1") + +(defface proced-mem + '((((class color) (min-colors 88)) + (:foreground "#6d5cc3"))) + "Face used in Proced buffers for process memory utilization." + :version "29.1") + +(defface proced-user + '((t (:bold t))) + "Face used in Proced buffers for the user owning the process." + :version "29.1") + +(defface proced-time-colon + '((((class color) (min-colors 88)) (:foreground "DarkMagenta")) + (t (:bold t))) + "Face used in Proced buffers for the colon in time strings." + :version "29.1") + (defvar proced-re-mark "^[^ \n]" "Regexp matching a marked line. Important: the match ends just after the marker.") @@ -1392,26 +1543,32 @@ Prefix ARG controls sort order, see `proced-sort-interactive'." (hours (truncate ftime 3600)) (ftime (mod ftime 3600)) (minutes (truncate ftime 60)) - (seconds (mod ftime 60))) + (seconds (mod ftime 60)) + (colon (if proced-enable-color-flag + (propertize ":" 'font-lock-face 'proced-time-colon) + ":"))) (cond ((< 0 days) - (format "%d-%02d:%02d:%02d" days hours minutes seconds)) + (format "%d-%02d%s%02d%s%02d" days hours colon minutes colon seconds)) ((< 0 hours) - (format "%02d:%02d:%02d" hours minutes seconds)) + (format "%02d%s%02d%s%02d" hours colon minutes colon seconds)) (t - (format "%02d:%02d" minutes seconds))))) + (format "%02d%s%02d" minutes colon seconds))))) (defun proced-format-start (start) "Format time START. The return string is always 6 characters wide." (let ((d-start (decode-time start)) - (d-current (decode-time))) + (d-current (decode-time)) + (colon (if proced-enable-color-flag + (propertize ":" 'font-lock-face 'proced-time-colon) + ":"))) (cond (;; process started in previous years (< (decoded-time-year d-start) (decoded-time-year d-current)) (format-time-string " %Y" start)) ;; process started today ((and (= (decoded-time-day d-start) (decoded-time-day d-current)) (= (decoded-time-month d-start) (decoded-time-month d-current))) - (format-time-string " %H:%M" start)) + (string-replace ":" colon (format-time-string " %H:%M" start))) (t ;; process started this year (format-time-string "%b %e" start))))) @@ -1429,12 +1586,97 @@ The return string is always 6 characters wide." (defun proced-format-args (args) "Format attribute ARGS. Replace newline characters by \"^J\" (two characters)." - (string-replace "\n" "^J" args)) + (string-replace "\n" "^J" + (pcase-let* ((`(,exe . ,rest) (split-string args)) + (exe-prop (if proced-enable-color-flag + (propertize exe 'font-lock-face 'proced-executable) + exe))) + (mapconcat #'identity (cons exe-prop rest) " ")))) (defun proced-format-memory (kilobytes) "Format KILOBYTES in a human readable format." (funcall byte-count-to-string-function (* 1024 kilobytes))) +(defun proced-format-rss (kilobytes) + "Format RSS KILOBYTES in a human readable format." + (let ((formatted (proced-format-memory kilobytes))) + (if-let* ((proced-enable-color-flag) + (total (car (memory-info))) + (proportion (/ (float kilobytes) total))) + (cond ((< proportion proced-low-memory-usage-threshold) + (propertize formatted 'font-lock-face 'proced-memory-low-usage)) + ((< proportion proced-medium-memory-usage-threshold) + (propertize formatted 'font-lock-face 'proced-memory-medium-usage)) + (t (propertize formatted 'font-lock-face 'proced-memory-high-usage))) + formatted))) + +(defun proced-format-state (state) + "Format STATE." + (cond ((and proced-enable-color-flag (string= state "R")) + (propertize state 'font-lock-face 'proced-run-status-code)) + ((and proced-enable-color-flag (string= state "S")) + (propertize state 'font-lock-face 'proced-interruptible-sleep-status-code)) + ((and proced-enable-color-flag (string= state "D")) + (propertize state 'font-lock-face 'proced-uninterruptible-sleep-status-code)) + (t state))) + +(defun proced-format-pid (pid) + "Format PID." + (let ((proc-info (process-attributes pid)) + (pid-s (number-to-string pid))) + (cond ((and proced-enable-color-flag + (not (file-remote-p default-directory)) + (equal pid (emacs-pid))) + (propertize pid-s 'font-lock-face 'proced-emacs-pid)) + ((and proced-enable-color-flag (equal pid (alist-get 'sess proc-info))) + (propertize pid-s 'font-lock-face 'proced-session-leader-pid)) + (proced-enable-color-flag + (propertize pid-s 'font-lock-face 'proced-pid)) + (t pid-s)))) + +(defun proced-format-ppid (ppid) + "Format PPID." + (let ((ppid-s (number-to-string ppid))) + (cond ((and proced-enable-color-flag + (not (file-remote-p default-directory)) + (= ppid (emacs-pid))) + (propertize ppid-s 'font-lock-face 'proced-emacs-pid)) + (proced-enable-color-flag + (propertize ppid-s 'font-lock-face 'proced-ppid)) + (t ppid-s)))) + +(defun proced-format-pgrp (pgrp) + "Format PGRP." + (if proced-enable-color-flag + (propertize (number-to-string pgrp) 'font-lock-face 'proced-pgrp) + (number-to-string pgrp))) + +(defun proced-format-sess (sess) + "Format SESS." + (if proced-enable-color-flag + (propertize (number-to-string sess) 'font-lock-face 'proced-sess) + (number-to-string sess))) + +(defun proced-format-cpu (cpu) + "Format CPU." + (let ((formatted (format "%.1f" cpu))) + (if proced-enable-color-flag + (propertize formatted 'font-lock-face 'proced-cpu) + formatted))) + +(defun proced-format-mem (mem) + "Format MEM." + (let ((formatted (format "%.1f" mem))) + (if proced-enable-color-flag + (propertize formatted 'font-lock-face 'proced-mem) + formatted))) + +(defun proced-format-user (user) + "Format USER." + (if proced-enable-color-flag + (propertize user 'font-lock-face 'proced-user) + user)) + (defun proced-format (process-alist format) "Display PROCESS-ALIST using FORMAT." (if (symbolp format) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index f802a6ddb2d..fcabb5beac8 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -519,17 +519,17 @@ the subtrees." (forward-line 1))))) ;;;###autoload -(define-derived-mode c-ts-mode--base-mode prog-mode "C" +(define-derived-mode c-ts-base-mode prog-mode "C" "Major mode for editing C, powered by tree-sitter." :syntax-table c-ts-mode--syntax-table ;; Navigation. (setq-local treesit-defun-type-regexp - (rx (or "function_definition" - "type_definition" - "struct_specifier" - "enum_specifier" - "union_specifier"))) + (regexp-opt '("function_definition" + "type_definition" + "struct_specifier" + "enum_specifier" + "union_specifier"))) ;; Nodes like struct/enum/union_specifier can appear in ;; function_definitions, so we need to find the top-level node. @@ -554,7 +554,7 @@ the subtrees." ( bracket delimiter error function operator variable)))) ;;;###autoload -(define-derived-mode c-ts-mode c-ts-mode--base-mode "C" +(define-derived-mode c-ts-mode c-ts-base-mode "C" "Major mode for editing C, powered by tree-sitter." :group 'c @@ -586,7 +586,7 @@ the subtrees." (setq-local end-of-defun-function #'c-ts-mode--end-of-defun)) ;;;###autoload -(define-derived-mode c++-ts-mode c-ts-mode--base-mode "C++" +(define-derived-mode c++-ts-mode c-ts-base-mode "C++" "Major mode for editing C++, powered by tree-sitter." :group 'c++ diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 1cf50df0366..3f4a5fb04bc 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.9.0 +;; Version: 0.9.1 ;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -583,9 +583,10 @@ project backend implementation of `project-external-roots'.") (mapcan (lambda (dir) (let ((ignores project-vc-ignores) - backend) + (backend (cadr project))) + (when backend + (require (intern (concat "vc-" (downcase (symbol-name backend)))))) (if (and (file-equal-p dir (nth 2 project)) - (setq backend (cadr project)) (cond ((eq backend 'Hg)) ((and (eq backend 'Git) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index eb34b93e2fd..4fc5d24e2fb 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -967,9 +967,9 @@ It makes underscores and dots word constituent chars.") ;; merge with `python-font-lock-keywords-level-2'. (defvar python--treesit-keywords - '("as" "assert" "async" "await" "break" "class" "continue" "def" + '("as" "assert" "async" "await" "break" "case" "class" "continue" "def" "del" "elif" "else" "except" "exec" "finally" "for" "from" - "global" "if" "import" "lambda" "nonlocal" "pass" "print" + "global" "if" "import" "lambda" "match" "nonlocal" "pass" "print" "raise" "return" "try" "while" "with" "yield" ;; These are technically operators, but we fontify them as ;; keywords. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 6c926a4e3e0..e09bacdcb1b 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -22,6 +22,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . + +;;; Commentary: +;; + ;;; Code: (require 'treesit) @@ -56,8 +60,10 @@ table) "Syntax table for `typescript-ts-mode'.") -(defvar typescript-ts-mode--indent-rules - `((tsx +(defun typescript-ts-mode--indent-rules (language) + "Rules used for indentation. +Argument LANGUAGE is either `typescript' or `tsx'." + `((,language ((parent-is "program") parent-bol 0) ((node-is "}") parent-bol 0) ((node-is ")") parent-bol 0) @@ -82,14 +88,13 @@ ((parent-is "arrow_function") parent-bol typescript-ts-mode-indent-offset) ((parent-is "parenthesized_expression") parent-bol typescript-ts-mode-indent-offset) - ;; TSX - ((parent-is "jsx_opening_element") parent typescript-ts-mode-indent-offset) - ((node-is "jsx_closing_element") parent 0) - ((parent-is "jsx_element") parent typescript-ts-mode-indent-offset) - ((node-is "/") parent 0) - ((parent-is "jsx_self_closing_element") parent typescript-ts-mode-indent-offset) - (no-node parent-bol 0))) - "Tree-sitter indent rules.") + ,@(when (eq language 'tsx) + `(((parent-is "jsx_opening_element") parent typescript-ts-mode-indent-offset) + ((node-is "jsx_closing_element") parent 0) + ((parent-is "jsx_element") parent typescript-ts-mode-indent-offset) + ((node-is "/") parent 0) + ((parent-is "jsx_self_closing_element") parent typescript-ts-mode-indent-offset))) + (no-node parent-bol 0)))) (defvar typescript-ts-mode--keywords '("!" "abstract" "as" "async" "await" "break" @@ -110,14 +115,16 @@ "&&" "||" "!" "?.") "TypeScript operators for tree-sitter font-locking.") -(defvar typescript-ts-mode--font-lock-settings +(defun typescript-ts-mode--font-lock-settings (language) + "Tree-sitter font-lock settings. +Argument LANGUAGE is either `typescript' or `tsx'." (treesit-font-lock-rules - :language 'tsx + :language language :override t :feature 'comment `((comment) @font-lock-comment-face) - :language 'tsx + :language language :override t :feature 'constant `(((identifier) @font-lock-constant-face @@ -125,13 +132,13 @@ [(true) (false) (null)] @font-lock-constant-face) - :language 'tsx + :language language :override t :feature 'keyword `([,@typescript-ts-mode--keywords] @font-lock-keyword-face [(this) (super)] @font-lock-keyword-face) - :language 'tsx + :language language :override t :feature 'string `((regex pattern: (regex_pattern)) @font-lock-string-face @@ -139,7 +146,7 @@ (template_string) @js--fontify-template-string (template_substitution ["${" "}"] @font-lock-builtin-face)) - :language 'tsx + :language language :override t :feature 'declaration `((function @@ -177,7 +184,7 @@ (identifier) @font-lock-function-name-face) value: (array (number) (function)))) - :language 'tsx + :language language :override t :feature 'identifier `((nested_type_identifier @@ -208,7 +215,7 @@ (_ (_ (identifier) @font-lock-variable-name-face)) (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) - :language 'tsx + :language language :override t :feature 'expression '((assignment_expression @@ -223,7 +230,7 @@ (member_expression property: (property_identifier) @font-lock-function-name-face)])) - :language 'tsx + :language language :override t :feature 'pattern `((pair_pattern @@ -231,7 +238,7 @@ (array_pattern (identifier) @font-lock-variable-name-face)) - :language 'tsx + :language language :override t :feature 'jsx `((jsx_opening_element @@ -248,31 +255,31 @@ (jsx_attribute (property_identifier) @font-lock-constant-face)) - :language 'tsx + :language language :feature 'number `((number) @font-lock-number-face ((identifier) @font-lock-number-face (:match "^\\(:?NaN\\|Infinity\\)$" @font-lock-number-face))) - :language 'tsx + :language language :feature 'operator `([,@typescript-ts-mode--operators] @font-lock-operator-face (ternary_expression ["?" ":"] @font-lock-operator-face)) - :language 'tsx + :language language :feature 'bracket '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - :language 'tsx + :language language :feature 'delimiter '((["," "." ";" ":"]) @font-lock-delimiter-face) - :language 'tsx + :language language :feature 'escape-sequence :override t '((escape_sequence) @font-lock-escape-face) - :language 'tsx + :language language :override t :feature 'property `((pair value: (identifier) @font-lock-variable-name-face) @@ -280,17 +287,71 @@ ((shorthand_property_identifier) @font-lock-property-face) ((shorthand_property_identifier_pattern) - @font-lock-property-face))) - "Tree-sitter font-lock settings.") + @font-lock-property-face)))) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)) ;;;###autoload -(add-to-list 'auto-mode-alist '("\\.tsx\\'" . typescript-ts-mode)) +(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode)) ;;;###autoload -(define-derived-mode typescript-ts-mode prog-mode "TypeScript" +(define-derived-mode typescript-ts-base-mode prog-mode "TypeScript" + "Major mode for editing TypeScript." + :group 'typescript + :syntax-table typescript-ts-mode--syntax-table + + ;; Comments. + (setq-local comment-start "// ") + (setq-local comment-end "") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end-skip + (rx (* (syntax whitespace)) + (group (or (syntax comment-end) + (seq (+ "*") "/"))))) + + ;; Electric + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) + + ;; Navigation. + (setq-local treesit-defun-type-regexp + (regexp-opt '("class_declaration" + "method_definition" + "function_declaration" + "lexical_declaration"))) + ;; Imenu. + (setq-local imenu-create-index-function #'js--treesit-imenu) + + ;; Which-func (use imenu). + (setq-local which-func-functions nil)) + +;;;###autoload +(define-derived-mode typescript-ts-mode typescript-ts-base-mode "TypeScript" + "Major mode for editing TypeScript." + :group 'typescript + :syntax-table typescript-ts-mode--syntax-table + + (when (treesit-ready-p 'typescript) + (treesit-parser-create 'typescript) + + ;; Indent. + (setq-local treesit-simple-indent-rules + (typescript-ts-mode--indent-rules 'typescript)) + + ;; Font-lock. + (setq-local treesit-font-lock-settings + (typescript-ts-mode--font-lock-settings 'typescript)) + (setq-local treesit-font-lock-feature-list + '((comment declaration) + (keyword string) + (constant expression identifier number pattern property) + (bracket delimiter))) + + (treesit-major-mode-setup))) + +;;;###autoload +(define-derived-mode tsx-ts-mode typescript-ts-base-mode "TypeScript[TSX]" "Major mode for editing TypeScript." :group 'typescript :syntax-table typescript-ts-mode--syntax-table @@ -301,43 +362,27 @@ ;; Comments. (setq-local comment-start "// ") (setq-local comment-end "") - (setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*"))) - (* (syntax whitespace)))) + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") (setq-local comment-end-skip (rx (* (syntax whitespace)) (group (or (syntax comment-end) (seq (+ "*") "/"))))) - ;; Electric - (setq-local electric-indent-chars - (append "{}():;," electric-indent-chars)) - ;; Indent. - (setq-local treesit-simple-indent-rules typescript-ts-mode--indent-rules) - - ;; Navigation. - (setq-local treesit-defun-type-regexp - (rx (or "class_declaration" - "method_definition" - "function_declaration" - "lexical_declaration"))) + (setq-local treesit-simple-indent-rules + (typescript-ts-mode--indent-rules 'tsx)) ;; Font-lock. - (setq-local treesit-font-lock-settings typescript-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-settings + (typescript-ts-mode--font-lock-settings 'tsx)) (setq-local treesit-font-lock-feature-list - '(( comment declaration) - ( keyword string) - ( constant expression identifier jsx number pattern property) - ( bracket delimiter))) - ;; Imenu. - (setq-local imenu-create-index-function #'js--treesit-imenu) - - ;; Which-func (use imenu). - (setq-local which-func-functions nil) + '((comment declaration) + (keyword string) + (constant expression identifier jsx number pattern property) + (bracket delimiter))) (treesit-major-mode-setup))) - (provide 'typescript-ts-mode) ;;; typescript-ts-mode.el ends here diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 2f8e8b29348..dcda67e9c5b 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -936,7 +936,12 @@ when the tab is current. Return the result as a keymap." (hpos (progn (add-face-text-property 0 (length rest) 'tab-bar t rest) (string-pixel-width rest))) - (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) + (str (propertize " " 'display + ;; The `right' spec doesn't work on TTY frames + ;; when windows are split horizontally (bug#59620) + (if window-system + `(space :align-to (- right (,hpos))) + `(space :align-to (,(- (frame-inner-width) hpos))))))) `((align-right menu-item ,str ignore)))) (defun tab-bar-format-global () @@ -1083,7 +1088,7 @@ tab bar might wrap to the second line when it shouldn't.") (setf (substring name ins-pos ins-pos) space) (setq curr-width (string-pixel-width name)) (if (and (< curr-width width) - (not (eq curr-width prev-width))) + (> curr-width prev-width)) (setq prev-width curr-width prev-name name) ;; Set back a shorter name @@ -1096,7 +1101,7 @@ tab bar might wrap to the second line when it shouldn't.") (setf (substring name del-pos1 del-pos2) "") (setq curr-width (string-pixel-width name)) (if (and (> curr-width width) - (not (eq curr-width prev-width))) + (< curr-width prev-width)) (setq prev-width curr-width) (setq continue nil))) (let* ((len (length name)) @@ -1941,7 +1946,7 @@ If GROUP-NAME is the empty string, then remove the tab from any group. While using this command, you might also want to replace `tab-bar-format-tabs' with `tab-bar-format-tabs-groups' in `tab-bar-format' to group tabs on the tab bar. -At the end it runs the hook `tab-bar-tab-post-change-group-functions'." +Runs the hook `tab-bar-tab-post-change-group-functions' at the end." (interactive (let* ((tabs (funcall tab-bar-tabs-function)) (tab-number (or current-prefix-arg diff --git a/lisp/term.el b/lisp/term.el index 6f3306b0881..550aa781cc5 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -976,7 +976,7 @@ underlying shell." 'term-mode)) (buffer-list)))) (easy-menu-change - '("Terminal") + nil "Terminal Buffers" (mapcar (lambda (buffer) @@ -986,7 +986,9 @@ underlying shell." (lambda () (interactive) (switch-to-buffer buffer)))) - buffer-list))))) + buffer-list) + nil + term-terminal-menu)))) (easy-menu-define term-signals-menu (list term-mode-map term-raw-map term-pager-break-map) diff --git a/src/xdisp.c b/src/xdisp.c index e4e52fe901d..466bb1534ae 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19535,7 +19535,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Check whether the buffer to be displayed contains long lines. */ if (!NILP (Vlong_line_threshold) && !current_buffer->long_line_optimizations_p - && CHARS_MODIFF - CHARS_UNCHANGED_MODIFIED > 8) + && (CHARS_MODIFF - CHARS_UNCHANGED_MODIFIED > 8 + || current_buffer->clip_changed)) { ptrdiff_t cur, next, found, max = 0, threshold; threshold = XFIXNUM (Vlong_line_threshold);