From d94c5870c07d07a460a4512395353824ad1af23a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 1 Dec 2022 17:34:26 +0200 Subject: [PATCH 01/12] ; * lisp/tab-bar.el (tab-bar-change-tab-group): Doc fix. --- lisp/tab-bar.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 2f8e8b29348..cba213d45da 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1941,7 +1941,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 From 0c1495574a14b9131a0c0a8ef126976393a00e3d Mon Sep 17 00:00:00 2001 From: Laurence Warne Date: Wed, 16 Nov 2022 14:32:44 +0000 Subject: [PATCH 02/12] Add colors to Proced (bug#59407) Add a new custom variable proced-enable-color-flag which when set to a non-nil value (defaults to nil), will prompt some format functions to furnish their respective process attributes with colors and effects in order to make them easier to distinguish and highlight possible issues (e.g. high memory usage), in a manner similar to htop. In particular, the current Emacs process id is highlighted purple in both the process id and parent process id columns, session leaders have their process ids underlined, larger memory sizes for rss are highlighted in darker shades of orange, and the first word in the args property (the executable) is highlighted in blue. * lisp/proced.el (proced-grammar-alist): Update to use the new format functions. (proced-low-memory-usage-threshold): New custom variable to determine whether a value represents 'low' memory usage, used only in proced-format-memory for coloring. (proced-medium-memory-usage-threshold): New custom variable to determine whether a value represents 'medium' memory usage, used only in proced-format-memory for coloring. (proced-enable-color-flag): New custom variable to toggle coloring. (proced-run-status-code, proced-interruptible-sleep-status-code) (proced-uninterruptible-sleep-status-code, proced-executable) (proced-executable, proced-memory-gb, proced-memory-mb) (proced-memory-default, proced-pid, proced-ppid, proced-pgrp) (proced-sess, proced-cpu, proced-mem, proced-user, proced-time-colon): New faces. (proced-format-time): Edit function to color colons using proced-time-colon. (proced-format-args): Edit function to color executables using proced-executable. (proced-format-state): New function to color states. (proced-format-pid): New function to color process ids. (proced-format-ppid): New function to color parent process ids. (proced-format-pgrp): New function to color process group ids. (proced-format-sess): New function to color process session leader ids. (proced-format-cpu): New function to color cpu utilization. (proced-format-mem): New function to color memory utilization. (proced-format-user): New function to color the user a process belongs to. --- etc/NEWS | 8 ++ lisp/proced.el | 255 +++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 247 insertions(+), 16 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a9d279fee5b..bfd9b5f26e7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -504,6 +504,14 @@ option) and can be set to nil to disable Just-in-time Lock mode. * Changes in Emacs 29.1 +--- +** New user option `proced-enable-color-flag` to enable coloring of proced buffers +This option prompts some format functions to furnish their respective +process attributes with colors in a manner similar to htop. + +This option is disabled by default and needs setting to a non-nil +value to take effect. + +++ ** New user option 'major-mode-remap-alist' to specify favorite major modes. This user option lets you remap the default modes (e.g. 'perl-mode' or diff --git a/lisp/proced.el b/lisp/proced.el index ac44ae1513d..f91d3d2f223 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -114,16 +114,16 @@ 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)) (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) + (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" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) - (sess "Sess" "%d" right proced-< nil (sess pid) (nil t nil)) + (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)) @@ -141,14 +141,14 @@ the external command (usually \"kill\")." (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)) + (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" "%.1f" right proced-< t (pcpu pid) (nil t t)) - (pmem "%Mem" "%.1f" right proced-< t (pmem 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 +367,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 memory usage, relative to total memory. + +When `proced-enable-color-flag' is non-nil, RSS values denoting a proportion +of memory 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 memory usage, relative to total memory. + +When `proced-enable-color-flag' is non-nil, RSS values denoting a proportion +of memory 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 +429,112 @@ 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 the 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 the 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 the 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 executables (first word in the args process attribute)." + :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 +1524,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%3$s%02d%3$s%02d" days hours colon minutes seconds)) ((< 0 hours) - (format "%02d:%02d:%02d" hours minutes seconds)) + (format "%02d%2$s%02d%2$s%02d" hours colon minutes 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 +1567,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) From 9c58ea37afc044a49fdd59fb4d1b8b6dd2d49ca9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 1 Dec 2022 20:15:52 +0200 Subject: [PATCH 03/12] ; Fix last change in proced.el * lisp/proced.el (proced-low-memory-usage-threshold) (proced-medium-memory-usage-threshold, proced-run-status-code) (proced-interruptible-sleep-status-code) (proced-uninterruptible-sleep-status-code, proced-executable): Fix doc strings. (proced-format-time): Simplify the format, to avoid bogus warnings from the byte-compiler. * etc/NEWS: Move Proced entries to one place and fix their wording. --- etc/NEWS | 32 +++++++++--------- lisp/proced.el | 89 ++++++++++++++++++++++++++++++-------------------- 2 files changed, 70 insertions(+), 51 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index bfd9b5f26e7..547b488a57b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -504,14 +504,6 @@ option) and can be set to nil to disable Just-in-time Lock mode. * Changes in Emacs 29.1 ---- -** New user option `proced-enable-color-flag` to enable coloring of proced buffers -This option prompts some format functions to furnish their respective -process attributes with colors in a manner similar to htop. - -This option is disabled by default and needs setting to a non-nil -value to take effect. - +++ ** New user option 'major-mode-remap-alist' to specify favorite major modes. This user option lets you remap the default modes (e.g. 'perl-mode' or @@ -2818,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 --- @@ -2903,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. diff --git a/lisp/proced.el b/lisp/proced.el index f91d3d2f223..c7419288edf 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -114,38 +114,55 @@ 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" proced-format-user 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" proced-format-state left proced-string-lessp nil (state 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)) + ((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)) + (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)) + (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)) + (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" proced-format-pid right proced-< nil (pid) @@ -373,23 +390,23 @@ May be used to revert the process listing." :version "29.1") (defcustom proced-low-memory-usage-threshold 0.1 - "The upper bound for low memory usage, relative to total memory. + "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 lower than this value will be displayed using the -`proced-memory-low-usage' face." +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 memory usage, relative to total memory. + "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 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." +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") @@ -431,19 +448,19 @@ It is a list of lists (KEY PREDICATE REVERSE).") (defface proced-run-status-code '((t (:foreground "green"))) - "Face used in Proced buffers for the running or runnable status code character \"R\"." + "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 the interruptible sleep status code character \"S\"." + "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 the uninterruptible sleep status code character \"D\"." + "Face used in Proced buffers for uninterruptible sleep status code character \"D\"." :version "29.1") (defface proced-executable @@ -451,7 +468,9 @@ It is a list of lists (KEY PREDICATE REVERSE).") (((class color) (background dark)) (:foreground "cyan")) (((class color) (background light)) (:foreground "blue")) (t (:bold t))) - "Face used in Proced buffers for executables (first word in the args process attribute)." + "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 @@ -1529,9 +1548,9 @@ Prefix ARG controls sort order, see `proced-sort-interactive'." (propertize ":" 'font-lock-face 'proced-time-colon) ":"))) (cond ((< 0 days) - (format "%d-%02d%3$s%02d%3$s%02d" days hours colon minutes seconds)) + (format "%d-%02d%s%02d%s%02d" days hours colon minutes colon seconds)) ((< 0 hours) - (format "%02d%2$s%02d%2$s%02d" hours colon minutes seconds)) + (format "%02d%s%02d%s%02d" hours colon minutes colon seconds)) (t (format "%02d%s%02d" minutes colon seconds))))) From 368c7c7d8e4291bbfd5d9071333990645fb73254 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Dec 2022 00:07:53 +0200 Subject: [PATCH 04/12] Improve detection of very long lines * src/xdisp.c (redisplay_window): Recheck for long lines if the restriction has changed. (Bug#56682) --- src/xdisp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 171c6ccaa02..255851b9213 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); From 03a40b974c47f99c7d7fb00638b2c8371ede7af4 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 1 Dec 2022 15:14:28 -0700 Subject: [PATCH 05/12] term--update-term-menu: Add the menu to term-terminal-menu Reading bug#5641, the intention was to add this to the existing "Terminal" menu for term-mode buffers, not to the local keymaps of all other buffers. Moreover, the existing code signaled errors when switching to buffers with no local keymap, such as term-mode buffers whose processes have died. * lisp/term.el (term--update-term-menu): Add the menu to term-terminal-menu, instead of implicitly trying to add it to every local keymap. --- lisp/term.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) 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) From 3bccef6f52598dd5aea37016254a3bc17893298d Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 2 Dec 2022 04:03:03 +0200 Subject: [PATCH 06/12] project-files (VC-aware): Make sure the VC backend is loaded * lisp/progmodes/project.el (project-files): Make sure the VC backend is loaded (bug#59734). --- lisp/progmodes/project.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) 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) From 16e68e64f924e99d0ad823dcfa9f7b7cc8975b50 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 1 Dec 2022 18:57:54 -0800 Subject: [PATCH 07/12] ; * lisp/progmodes/c-ts-mode.el: Change rx to regexp-opt. --- lisp/progmodes/c-ts-mode.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index f802a6ddb2d..ad64df6143c 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -525,11 +525,11 @@ the subtrees." ;; 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. From ad0563855fab51c4d40d48ea9fe1ee36e69b29bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= Date: Wed, 30 Nov 2022 16:11:46 +0100 Subject: [PATCH 08/12] Add case and match to python--treesit-keywords (bug#59720) * lisp/progmodes/python.el (python--treesit-keywords): Add "case" and "match" keywords. --- lisp/progmodes/python.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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. From 1aa1f8432b085305f0f46c42a9054987ac9afc2a Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Tue, 29 Nov 2022 21:39:38 +0100 Subject: [PATCH 09/12] Add new TypeScript mode tsx-ts-mode There are in fact two languages supporting TypeScript for tree-sitter. Because TSX causes some ambiguities with types there are two grammars, one called typescript and one called tsx. To account for this and to be as correct as possible we enable using both. * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--indent-rules): Change to a function to accomodate the two languages. (typescript-ts-mode--font-lock-settings): Change to a function to accomodate the two languages. (typescript-ts-base-mode): Parent mode for typescript-ts-mode and tsx-ts-mode. (typescript-ts-mode): Derive from typescript-ts-base-mode and extend with language specific settings (tsx-ts-mode): New major mode that derives from typescript-ts-base-mode and extend it with language specific settings Add autoload cookies for the respective file type extensions: .ts and .tsx. * etc/NEWS: Mention the new mode. --- etc/NEWS | 9 +- lisp/progmodes/typescript-ts-mode.el | 155 +++++++++++++++++---------- 2 files changed, 108 insertions(+), 56 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 547b488a57b..d38ccadba64 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2989,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/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 From 2e4960d63df27395f4d9a7b15a5f9c5b872f4b06 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 1 Dec 2022 20:42:35 -0800 Subject: [PATCH 10/12] ; Change c-ts-mode--base-mode to c-ts-base-mode * lisp/progmodes/c-ts-mode.el (c-ts-mode--base-mode) (c-ts-mode, c++-ts-mode): Change to c-ts-base-mode. --- lisp/progmodes/c-ts-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index ad64df6143c..fcabb5beac8 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -519,7 +519,7 @@ 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 @@ -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++ From bf66b90b9aea61799c089e91ceec3ce237195f3a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 2 Dec 2022 09:54:22 +0200 Subject: [PATCH 11/12] Fix the width of margins for icons in outline-minor-mode (bug#59719) * doc/lispref/display.texi (Icons): Add :width spec. * lisp/emacs-lisp/icons.el (icons--create): Handle :width as well. * lisp/outline.el (outline--margin-width, outline-margin-width): New variables. (outline-open-in-margins, outline-close-in-margins) (outline-close-rtl-in-margins): Don't inherit from parents. Use `:width font' instead of `:height 10'. (outline-minor-mode): Calculate the number of columns for margins to fit the icons. --- doc/lispref/display.texi | 6 ++++++ lisp/emacs-lisp/icons.el | 4 ++++ lisp/outline.el | 41 ++++++++++++++++++++++++++++++---------- 3 files changed, 41 insertions(+), 10 deletions(-) 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/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)) From 39e0c60176242a2ca09f65090bcf2751b346ed26 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 2 Dec 2022 09:59:53 +0200 Subject: [PATCH 12/12] * lisp/tab-bar.el (tab-bar-format-align-right): Fix alignment on TTY frames. Calculate the alignment from the left edge instead of the right edge since the `right' spec doesn't work on TTY frames when windows are split horizontally (bug#59620). --- lisp/tab-bar.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index cba213d45da..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))