emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 3eb64d21f6: Merge from origin/emacs-29


From: Stefan Kangas
Subject: master 3eb64d21f6: Merge from origin/emacs-29
Date: Fri, 2 Dec 2022 06:53:54 -0500 (EST)

branch: master
commit 3eb64d21f62c7457895bd19eec76d30bb82566a1
Merge: 7d6f9753ad 39e0c60176
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>

    Merge from origin/emacs-29
    
    39e0c60176 * lisp/tab-bar.el (tab-bar-format-align-right): Fix alignm...
    bf66b90b9a Fix the width of margins for icons in outline-minor-mode (...
    2e4960d63d ; Change c-ts-mode--base-mode to c-ts-base-mode
    1aa1f8432b Add new TypeScript mode tsx-ts-mode
    ad0563855f Add case and match to python--treesit-keywords (bug#59720)
    16e68e64f9 ; * lisp/progmodes/c-ts-mode.el: Change rx to regexp-opt.
    3bccef6f52 project-files (VC-aware): Make sure the VC backend is loaded
    03a40b974c term--update-term-menu: Add the menu to term-terminal-menu
    368c7c7d8e Improve detection of very long lines
    9c58ea37af ; Fix last change in proced.el
    0c1495574a Add colors to Proced (bug#59407)
    91dba5b066 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/e...
    70ecdebc92 ; Fix typos (don't abbreviate "with" or "without")
    d94c5870c0 ; * lisp/tab-bar.el (tab-bar-change-tab-group): Doc fix.
    
    # Conflicts:
    #       etc/NEWS
---
 doc/lispref/display.texi             |   6 +
 etc/NEWS.29                          |  33 ++--
 lisp/emacs-lisp/icons.el             |   4 +
 lisp/outline.el                      |  41 +++--
 lisp/proced.el                       | 302 +++++++++++++++++++++++++++++++----
 lisp/progmodes/c-ts-mode.el          |  16 +-
 lisp/progmodes/project.el            |   7 +-
 lisp/progmodes/python.el             |   4 +-
 lisp/progmodes/typescript-ts-mode.el | 155 +++++++++++-------
 lisp/tab-bar.el                      |  13 +-
 lisp/term.el                         |   6 +-
 src/xdisp.c                          |   3 +-
 12 files changed, 466 insertions(+), 124 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 60955fd319..9d929950a7 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 a9d279fee5..d38ccadba6 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 86c4483030..8ba6d97ea0 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 86ac19aa41..2c3f9798ec 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 ac44ae1513..c7419288ed 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 f802a6ddb2..fcabb5beac 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 1cf50df036..3f4a5fb04b 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 eb34b93e2f..4fc5d24e2f 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 6c926a4e3e..e09bacdcb1 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 <http://www.gnu.org/licenses/>.
 
+
+;;; 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 2f8e8b2934..dcda67e9c5 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 6f3306b088..550aa781cc 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 e4e52fe901..466bb1534a 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);



reply via email to

[Prev in Thread] Current Thread [Next in Thread]