commit dd7a7633bebc4db5caca3898bf318721f1f370c8 (HEAD, refs/remotes/origin/master) Merge: 98327e3719 1e36ad9458 Author: Stefan Kangas Date: Sat Dec 3 06:30:29 2022 +0100 Merge from origin/emacs-29 1e36ad9458 ; server-tests: remove CI debugging 54633fcd76 ; * lisp/subr.el (string-equal-ignore-case): Doc fix (bug#... 8413e95138 ; server-test CI debugging 4b3eb928fe Fix server-tests run noninteractively (bug#59742) 1b567f5a67 Use file-name-nondirectory to determine default project-name f72cda2b82 Speed up auto-completion in 'sh-script-mode' e5b0141b0d Fix error editing multisession variables (bug#59710) commit 98327e371938033f7ccefd1c5226cd102cb29ad1 Merge: 9065d74515 24ca490d7d Author: Stefan Kangas Date: Sat Dec 3 06:30:29 2022 +0100 ; Merge from origin/emacs-29 The following commits were skipped: 24ca490d7d ; Fix a typo in .clang-format. a48cd7bb9f ; Make clang-format format indent preprocessor blocks corr... commit 9065d745151e1995b80a1f4d5a04e2af111ad928 Merge: 2541bec21b 2b9cd50f93 Author: Stefan Kangas Date: Sat Dec 3 06:30:29 2022 +0100 Merge from origin/emacs-29 2b9cd50f93 Add tsx-ts-mode to eglot-server-programs commit 2541bec21bf3cf090071e434dac170d52394594e Author: Juanma Barranquero Date: Sat Dec 3 02:04:48 2022 +0100 * lisp/bindings.el (bound-and-true-p): Verify argument is a symbol diff --git a/lisp/bindings.el b/lisp/bindings.el index c1ad5f7520..a3f51ebb31 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -670,6 +670,8 @@ bound-and-true-p "Return the value of symbol VAR if it is bound, else nil. Note that if `lexical-binding' is in effect, this function isn't meaningful if it refers to a lexically bound variable." + (unless (symbolp var) + (signal 'wrong-type-argument (list 'symbolp var))) `(and (boundp (quote ,var)) ,var)) ;; Use mode-line-mode-menu for local minor-modes only. commit 73d169c7db36e8144b2766532181a57ff146bc11 Author: Stefan Monnier Date: Fri Dec 2 19:15:46 2022 -0500 * lisp/emacs-lisp/cl-macs.el (cl-flet): Optimize a bit more Also optimize the case where we use `cl-flet` to introduce a local alias. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 43a2ed9205..95e78ceab6 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2052,7 +2052,8 @@ cl-flet (dolist (binding bindings) (let ((var (make-symbol (format "--cl-%s--" (car binding)))) (args-and-body (cdr binding))) - (if (and (= (length args-and-body) 1) (symbolp (car args-and-body))) + (if (and (= (length args-and-body) 1) + (macroexp-copyable-p (car args-and-body))) ;; Optimize (cl-flet ((fun var)) body). (setq var (car args-and-body)) (push (list var (if (= (length args-and-body) 1) commit 1e36ad9458e8deacfc85da573bb0ca0f270d4802 Author: Mattias Engdegård Date: Fri Dec 2 18:26:04 2022 +0100 ; server-tests: remove CI debugging diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el index f08c5bce5d..ebf84481c6 100644 --- a/test/lisp/server-tests.el +++ b/test/lisp/server-tests.el @@ -25,7 +25,6 @@ (defconst server-tests/can-create-frames-p (and (not (memq system-type '(windows-nt ms-dos))) - nil (not (member (getenv "TERM") '("dumb" "" nil)))) "Non-nil if we can create a new frame in the tests. Some tests below need to create new frames for the emacsclient. @@ -119,8 +118,6 @@ server-tests/variable (ert-deftest server-tests/server-start/sets-minor-mode () "Ensure that calling `server-start' also sets `server-mode' properly." - (message "TERM=%S" (getenv "TERM")) - (should nil) (server-tests/with-server ;; Make sure starting the server activates the minor mode. (should (eq server-mode t)) commit 54633fcd761f8fa2d10a2a653361d6b7b6ff10f2 Author: Eli Zaretskii Date: Fri Dec 2 19:08:08 2022 +0200 ; * lisp/subr.el (string-equal-ignore-case): Doc fix (bug#59779). diff --git a/lisp/subr.el b/lisp/subr.el index cfce5b18c5..1566216279 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5435,7 +5435,7 @@ replace-regexp-in-string (apply #'concat (nreverse matches))))) (defsubst string-equal-ignore-case (string1 string2) - "Like `string-equal', but case-insensitive. + "Compare STRING1 and STRING2 case-insensitively. Upper-case and lower-case letters are treated as equal. Unibyte strings are converted to multibyte for comparison." (declare (pure t) (side-effect-free t)) commit 8413e9513830181994dba891bcd2c9bc570d7ec3 Author: Mattias Engdegård Date: Fri Dec 2 18:06:00 2022 +0100 ; server-test CI debugging diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el index c7813e2aef..f08c5bce5d 100644 --- a/test/lisp/server-tests.el +++ b/test/lisp/server-tests.el @@ -25,8 +25,8 @@ (defconst server-tests/can-create-frames-p (and (not (memq system-type '(windows-nt ms-dos))) - ;; TERM=dumb is what we get when running from `compile'. - (not (equal (getenv "TERM") "dumb"))) + nil + (not (member (getenv "TERM") '("dumb" "" nil)))) "Non-nil if we can create a new frame in the tests. Some tests below need to create new frames for the emacsclient. However, this doesn't work on all platforms. In particular, @@ -119,6 +119,8 @@ server-tests/variable (ert-deftest server-tests/server-start/sets-minor-mode () "Ensure that calling `server-start' also sets `server-mode' properly." + (message "TERM=%S" (getenv "TERM")) + (should nil) (server-tests/with-server ;; Make sure starting the server activates the minor mode. (should (eq server-mode t)) commit 4b3eb928fed4b236d1ae06ae7d9d51a4466554d2 Author: Mattias Engdegård Date: Fri Dec 2 17:27:16 2022 +0100 Fix server-tests run noninteractively (bug#59742) This may or may not fix the test run from CI. * test/lisp/server-tests.el (server-tests/can-create-frames-p): Don't attempt to create frames if TERM=dumb, which what we have if run from M-x compile (for instance). (server-tests/server-force-stop/keeps-frames): Delete created frame so that it doesn't cause trouble for other tests. diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el index f8ecd046f2..c7813e2aef 100644 --- a/test/lisp/server-tests.el +++ b/test/lisp/server-tests.el @@ -21,9 +21,12 @@ (require 'ert) (require 'server) +(require 'cl-lib) (defconst server-tests/can-create-frames-p - (not (memq system-type '(windows-nt ms-dos))) + (and (not (memq system-type '(windows-nt ms-dos))) + ;; TERM=dumb is what we get when running from `compile'. + (not (equal (getenv "TERM") "dumb"))) "Non-nil if we can create a new frame in the tests. Some tests below need to create new frames for the emacsclient. However, this doesn't work on all platforms. In particular, @@ -188,8 +191,9 @@ server-tests/server-force-stop/keeps-frames then, requires a few tricks to run as a regression test). So long as this works, the problem in bug#58877 shouldn't occur." (skip-unless server-tests/can-create-frames-p) - (let ((starting-frame-count (length (frame-list))) - terminal) + (let* ((starting-frames (frame-list)) + (starting-frame-count (length starting-frames)) + terminal) (unwind-protect (server-tests/with-server (server-tests/with-client emacsclient '("-c") 'exit @@ -214,6 +218,9 @@ server-tests/server-force-stop/keeps-frames (when (and terminal (eq (terminal-live-p terminal) t) (not (eq system-type 'windows-nt))) - (delete-terminal terminal))))) + (delete-terminal terminal))) + ;; Delete the created frame. + (delete-frame (car (cl-set-difference (frame-list) starting-frames)) + t))) ;;; server-tests.el ends here commit 1b567f5a67de1151b76b279311a73a7bf7174c12 Author: Randy Taylor Date: Thu Dec 1 22:12:07 2022 -0500 Use file-name-nondirectory to determine default project-name * lisp/progmodes/project.el (project-name): Use file-name-nondirectory instead of file-name-base (bug#59756). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 3f4a5fb04b..38d4fdad5f 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.1 +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -278,7 +278,7 @@ project-external-roots (cl-defgeneric project-name (project) "A human-readable name for the project. Nominally unique, but not enforced." - (file-name-base (directory-file-name (project-root project)))) + (file-name-nondirectory (directory-file-name (project-root project)))) (cl-defgeneric project-ignores (_project _dir) "Return the list of glob patterns to ignore inside DIR. commit f72cda2b822e0726f46a8caa4ec0b8e7ddae2584 Author: Yikai Zhao Date: Tue Nov 29 22:30:14 2022 +0800 Speed up auto-completion in 'sh-script-mode' * lisp/progmodes/sh-script.el (sh--cmd-completion-table-gen): New function, replacement for 'sh--cmd-completion-table'. (sh--cmd-completion-table): Function removed. (sh-completion-at-point-function): Use 'sh--cmd-completion-table-gen'. (Bug#59678) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 408ebfc045..e170d18afe 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1688,19 +1688,17 @@ sh--vars-before-point ;; (defun sh--var-completion-table (string pred action) ;; (complete-with-action action (sh--vars-before-point) string pred)) -(defun sh--cmd-completion-table (string pred action) - (let ((cmds - (append (when (fboundp 'imenu--make-index-alist) - (mapcar #'car - (condition-case nil - (imenu--make-index-alist) - (imenu-unavailable nil)))) - (mapcar (lambda (v) (concat v "=")) - (sh--vars-before-point)) - (locate-file-completion-table - exec-path exec-suffixes string pred t) - sh--completion-keywords))) - (complete-with-action action cmds string pred))) +(defun sh--cmd-completion-table-gen (string) + (append (when (fboundp 'imenu--make-index-alist) + (mapcar #'car + (condition-case nil + (imenu--make-index-alist) + (imenu-unavailable nil)))) + (mapcar (lambda (v) (concat v "=")) + (sh--vars-before-point)) + (locate-file-completion-table + exec-path exec-suffixes string nil t) + sh--completion-keywords)) (defun sh-completion-at-point-function () (save-excursion @@ -1713,14 +1711,14 @@ sh-completion-at-point-function (list start end (sh--vars-before-point) :company-kind (lambda (_) 'variable))) ((sh-smie--keyword-p) - (list start end #'sh--cmd-completion-table + (list start end + (completion-table-with-cache #'sh--cmd-completion-table-gen) :company-kind (lambda (s) (cond ((member s sh--completion-keywords) 'keyword) ((string-suffix-p "=" s) 'variable) - (t 'function))) - )))))) + (t 'function))))))))) ;;; Indentation and navigation with SMIE. commit e5b0141b0d7231426971763486b9cec0aac77a88 Author: Juanma Barranquero Date: Fri Dec 2 14:14:26 2022 +0100 Fix error editing multisession variables (bug#59710) * lisp/emacs-lisp/multisession.el (multisession-edit-value): Do not use `bound-and-true-p' on a non-symbol. This reverts commit bd586121ac21e046f60f75eeb0200866c38d6f9f. diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index 9d6e8c0d88..78d4137317 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -447,8 +447,9 @@ multisession-edit-value (let* ((object (or ;; If the multisession variable already exists, use ;; it (so that we update it). - (and (intern-soft (cdr id)) - (bound-and-true-p (intern (cdr id)))) + (if-let (sym (intern-soft (cdr id))) + (and (boundp sym) (symbol-value sym)) + nil) ;; Create a new object. (make-multisession :package (car id) commit 64044f545add60e045ff16a9891b06f429ac935f Author: Po Lu Date: Fri Dec 2 21:00:30 2022 +0800 More behind the scenes transparent speedups around xselect.c * src/xdisp.c (display_menu_bar): Fix compiler warning about NULL pointer dereference. * src/xfns.c (Fx_begin_drag): Use x_intern_atoms. (Fx_change_window_property): Pass dpyinfo to x_fill_property_data. * src/xselect.c (lisp_data_to_selection_data): Use x_intern_atoms instead of syncing for each atom. (x_fill_property_data, x_send_client_event): Use x_intern_cached_atom. * src/xterm.c (x_intern_atoms): New function. * src/xterm.h: Update prototypes. diff --git a/src/xdisp.c b/src/xdisp.c index 466bb1534a..b7333dc1ee 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -26312,13 +26312,17 @@ display_menu_bar (struct window *w) it.first_visible_x = 0; it.last_visible_x = FRAME_PIXEL_WIDTH (f); #elif defined (HAVE_X_WINDOWS) /* X without toolkit. */ - struct window *menu_w; + struct window *menu_window; + + menu_window = NULL; + if (FRAME_WINDOW_P (f)) { /* Menu bar lines are displayed in the desired matrix of the dummy window menu_bar_window. */ - menu_w = XWINDOW (f->menu_bar_window); - init_iterator (&it, menu_w, -1, -1, menu_w->desired_matrix->rows, + menu_window = XWINDOW (f->menu_bar_window); + init_iterator (&it, menu_window, -1, -1, + menu_window->desired_matrix->rows, MENU_FACE_ID); it.first_visible_x = 0; it.last_visible_x = FRAME_PIXEL_WIDTH (f); @@ -26379,11 +26383,16 @@ display_menu_bar (struct window *w) #if defined (HAVE_X_WINDOWS) && !defined (USE_X_TOOLKIT) && !defined (USE_GTK) /* With the non-toolkit version, modify the menu bar window height accordingly. */ - if (FRAME_WINDOW_P (it.f)) + if (FRAME_WINDOW_P (it.f) && menu_window) { - struct glyph_row *row = it.glyph_row; - int delta_height = ((row->y + row->height) - - WINDOW_BOX_HEIGHT_NO_MODE_LINE (menu_w)); + struct glyph_row *row; + int delta_height; + + row = it.glyph_row; + delta_height + = ((row->y + row->height) + - WINDOW_BOX_HEIGHT_NO_MODE_LINE (menu_window)); + if (delta_height != 0) { FRAME_MENU_BAR_HEIGHT (it.f) += delta_height; diff --git a/src/xfns.c b/src/xfns.c index 36b51a3011..df805d66db 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7079,8 +7079,8 @@ of (ITEM . STRING), where ITEM is the name of an action, and STRING is /* Catch errors since interning lots of targets can potentially generate a BadAlloc error. */ x_catch_errors (FRAME_X_DISPLAY (f)); - XInternAtoms (FRAME_X_DISPLAY (f), target_names, - ntargets, False, target_atoms); + x_intern_atoms (FRAME_DISPLAY_INFO (f), target_names, + ntargets, target_atoms); x_check_errors (FRAME_X_DISPLAY (f), "Failed to intern target atoms: %s"); x_uncatch_errors_after_check (); @@ -7484,7 +7484,7 @@ DEFUN ("x-change-window-property", Fx_change_window_property, elsize = element_format == 32 ? sizeof (long) : element_format >> 3; data = xnmalloc (nelements, elsize); - x_fill_property_data (FRAME_X_DISPLAY (f), value, data, nelements, + x_fill_property_data (FRAME_DISPLAY_INFO (f), value, data, nelements, element_format); } else diff --git a/src/xselect.c b/src/xselect.c index c47093dfad..120a5a163e 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2216,7 +2216,12 @@ cons_to_x_long (Lisp_Object obj) lisp_data_to_selection_data (struct x_display_info *dpyinfo, Lisp_Object obj, struct selection_data *cs) { - Lisp_Object type = Qnil; + Lisp_Object type; + char **name_buffer; + + USE_SAFE_ALLOCA; + + type = Qnil; eassert (cs != NULL); @@ -2321,8 +2326,19 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, x_atoms = data; cs->format = 32; cs->size = size; - for (i = 0; i < size; i++) - x_atoms[i] = symbol_to_x_atom (dpyinfo, AREF (obj, i)); + + if (size == 1) + x_atoms[0] = symbol_to_x_atom (dpyinfo, AREF (obj, i)); + else + { + SAFE_NALLOCA (name_buffer, sizeof *x_atoms, size); + + for (i = 0; i < size; i++) + name_buffer[i] = SSDATA (SYMBOL_NAME (AREF (obj, i))); + + x_intern_atoms (dpyinfo, name_buffer, size, + x_atoms); + } } else /* This vector is an INTEGER set, or something like it */ @@ -2364,6 +2380,8 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, signal_error (/* Qselection_error */ "Unrecognized selection data", obj); cs->type = symbol_to_x_atom (dpyinfo, type); + + SAFE_FREE (); } static Lisp_Object @@ -2891,8 +2909,8 @@ x_check_property_data (Lisp_Object data) XClientMessageEvent). */ void -x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, - int nelements_max, int format) +x_fill_property_data (struct x_display_info *dpyinfo, Lisp_Object data, + void *ret, int nelements_max, int format) { unsigned long val; unsigned long *d32 = (unsigned long *) ret; @@ -2927,7 +2945,7 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, else if (STRINGP (o)) { block_input (); - val = XInternAtom (dpy, SSDATA (o), False); + val = x_intern_cached_atom (dpyinfo, SSDATA (o), false); unblock_input (); } else @@ -3215,7 +3233,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l)); /* event.xclient.data can hold 20 chars, 10 shorts, or 5 longs. */ - x_fill_property_data (dpyinfo->display, values, event.xclient.data.b, + x_fill_property_data (dpyinfo, values, event.xclient.data.b, 5 * 32 / event.xclient.format, event.xclient.format); diff --git a/src/xterm.c b/src/xterm.c index 43dc7c18b9..c775f19985 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -28875,6 +28875,53 @@ x_get_atom_name (struct x_display_info *dpyinfo, Atom atom, return value; } +/* Intern an array of atoms, and do so quickly, avoiding extraneous + roundtrips to the X server. + + Avoid sending atoms that have already been found to the X server. + This cannot do anything that will end up triggering garbage + collection. */ + +void +x_intern_atoms (struct x_display_info *dpyinfo, char **names, int count, + Atom *atoms_return) +{ + int i, j, indices[256]; + char *new_names[256]; + Atom results[256], candidate; + + if (count > 256) + /* Atoms array too big to inspect reasonably, just send it to the + server and back. */ + XInternAtoms (dpyinfo->display, new_names, count, False, atoms_return); + else + { + for (i = 0, j = 0; i < count; ++i) + { + candidate = x_intern_cached_atom (dpyinfo, names[i], + true); + + if (candidate) + atoms_return[i] = candidate; + else + { + indices[j++] = i; + new_names[j - 1] = names[i]; + } + } + + if (!j) + return; + + /* Now, get the results back from the X server. */ + XInternAtoms (dpyinfo->display, new_names, j, False, + results); + + for (i = 0; i < j; ++i) + atoms_return[indices[i]] = results[i]; + } +} + #ifndef USE_GTK /* Set up XEmbed for F, and change its save set to handle the parent diff --git a/src/xterm.h b/src/xterm.h index 86763dc6e0..0b227cbdc0 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1723,6 +1723,11 @@ #define SELECTION_EVENT_TIME(eventp) \ extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *, int *, int *, int *, unsigned int *); +extern Atom x_intern_cached_atom (struct x_display_info *, const char *, + bool); +extern void x_intern_atoms (struct x_display_info *, char **, int, Atom *); +extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; #ifdef HAVE_GTK3 extern void x_scroll_bar_configure (GdkEvent *); @@ -1815,11 +1820,8 @@ x_mutable_colormap (XVisualInfo *visual) struct input_event *, bool, int, int); extern int x_check_property_data (Lisp_Object); -extern void x_fill_property_data (Display *, - Lisp_Object, - void *, - int, - int); +extern void x_fill_property_data (struct x_display_info *, Lisp_Object, + void *, int, int); extern Lisp_Object x_property_data_to_lisp (struct frame *, const unsigned char *, Atom, @@ -1832,10 +1834,6 @@ x_mutable_colormap (XVisualInfo *visual) Lisp_Object); extern void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Time); -extern Atom x_intern_cached_atom (struct x_display_info *, const char *, - bool); -extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) - ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; extern void mark_xselect (void); commit 24ca490d7dca186d9dcc3752975432d78a6a76f8 Author: Dick R. Chiang Date: Thu Dec 1 16:54:06 2022 -0500 ; Fix a typo in .clang-format. diff --git a/.clang-format b/.clang-format index 016fb77838..5c987536b0 100644 --- a/.clang-format +++ b/.clang-format @@ -7,7 +7,7 @@ BreakBeforeBinaryOperators: All BreakBeforeBraces: GNU ColumnLimit: 70 ContinuationIndentWidth: 2 -IndentPPDDirectives: AfterHash +IndentPPDirectives: AfterHash PPIndentWidth: 1 ForEachMacros: - FOR_EACH_TAIL commit a48cd7bb9f80d4a903f5c3971db4d7b163edbc49 Author: Vibhav Pant Date: Wed Nov 30 23:07:44 2022 +0530 ; Make clang-format format indent preprocessor blocks correctly. (cherry picked from commit 1abda0c83981a6d35dd4b2dd3e88e9886d13cb09) diff --git a/.clang-format b/.clang-format index 2208240a66..016fb77838 100644 --- a/.clang-format +++ b/.clang-format @@ -7,6 +7,8 @@ BreakBeforeBinaryOperators: All BreakBeforeBraces: GNU ColumnLimit: 70 ContinuationIndentWidth: 2 +IndentPPDDirectives: AfterHash +PPIndentWidth: 1 ForEachMacros: - FOR_EACH_TAIL - FOR_EACH_TAIL_SAFE commit a67ed9a403f7b674ef4252f582d41e0ab6f7b7bd Author: Dick R. Chiang Date: Thu Dec 1 16:54:06 2022 -0500 ; Fix typo in .clang-format (Bug#59768) diff --git a/.clang-format b/.clang-format index 016fb77838..5c987536b0 100644 --- a/.clang-format +++ b/.clang-format @@ -7,7 +7,7 @@ BreakBeforeBinaryOperators: All BreakBeforeBraces: GNU ColumnLimit: 70 ContinuationIndentWidth: 2 -IndentPPDDirectives: AfterHash +IndentPPDirectives: AfterHash PPIndentWidth: 1 ForEachMacros: - FOR_EACH_TAIL commit 2b9cd50f935d06e627c7a6de239b78dafbff670a Author: Brian Leung Date: Fri Dec 2 03:02:30 2022 -0800 Add tsx-ts-mode to eglot-server-programs * lisp/progmodes/eglot.el (eglot-server-programs): Add tsx-ts-mode. (Bug#59770) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index e5c943ebf7..c266f6e18a 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -190,7 +190,7 @@ eglot-server-programs ((js-json-mode json-mode json-ts-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio")))) - ((js-mode js-ts-mode typescript-ts-mode typescript-mode) + ((js-mode js-ts-mode tsx-ts-mode typescript-ts-mode typescript-mode) . ("typescript-language-server" "--stdio")) ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) ((php-mode phps-mode) commit 3eb64d21f62c7457895bd19eec76d30bb82566a1 Merge: 7d6f9753ad 39e0c60176 Author: Stefan Kangas Date: Fri Dec 2 12:36:35 2022 +0100 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 commit 39e0c60176242a2ca09f65090bcf2751b346ed26 Author: Juri Linkov Date: Fri Dec 2 09:59:53 2022 +0200 * 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). diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index cba213d45d..dcda67e9c5 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -936,7 +936,12 @@ tab-bar-format-align-right (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-auto-width (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-auto-width (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)) commit bf66b90b9aea61799c089e91ceec3ce237195f3a Author: Juri Linkov Date: Fri Dec 2 09:54:22 2022 +0200 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. 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 @@ Icons (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 86c4483030..8ba6d97ea0 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -202,6 +202,10 @@ icons--create (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 @@ outline--button-icons (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 @@ outline-close-rtl "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 @@ outline-minor-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 @@ outline-minor-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)) commit 2e4960d63df27395f4d9a7b15a5f9c5b872f4b06 Author: Yuan Fu Date: Thu Dec 1 20:42:35 2022 -0800 ; 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. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index ad64df6143..fcabb5beac 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -519,7 +519,7 @@ c-ts-mode--end-of-defun (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 @@ c-ts-mode--base-mode ( 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 @@ c-ts-mode (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++ commit 1aa1f8432b085305f0f46c42a9054987ac9afc2a Author: Theodor Thornhill Date: Tue Nov 29 21:39:38 2022 +0100 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. diff --git a/etc/NEWS b/etc/NEWS index 547b488a57..d38ccadba6 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 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 . + +;;; Commentary: +;; + ;;; Code: (require 'treesit) @@ -56,8 +60,10 @@ typescript-ts-mode--syntax-table 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 @@ typescript-ts-mode--indent-rules ((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-ts-mode--operators "&&" "||" "!" "?.") "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 @@ typescript-ts-mode--font-lock-settings [(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 @@ typescript-ts-mode--font-lock-settings (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 @@ typescript-ts-mode--font-lock-settings (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 @@ typescript-ts-mode--font-lock-settings (_ (_ (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 @@ typescript-ts-mode--font-lock-settings (member_expression property: (property_identifier) @font-lock-function-name-face)])) - :language 'tsx + :language language :override t :feature 'pattern `((pair_pattern @@ -231,7 +238,7 @@ typescript-ts-mode--font-lock-settings (array_pattern (identifier) @font-lock-variable-name-face)) - :language 'tsx + :language language :override t :feature 'jsx `((jsx_opening_element @@ -248,31 +255,31 @@ typescript-ts-mode--font-lock-settings (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 @@ typescript-ts-mode--font-lock-settings ((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 @@ typescript-ts-mode ;; 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 commit ad0563855fab51c4d40d48ea9fe1ee36e69b29bf Author: Daniel Martín Date: Wed Nov 30 16:11:46 2022 +0100 Add case and match to python--treesit-keywords (bug#59720) * lisp/progmodes/python.el (python--treesit-keywords): Add "case" and "match" keywords. 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 @@ python-dotty-syntax-table ;; 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. commit 16e68e64f924e99d0ad823dcfa9f7b7cc8975b50 Author: Yuan Fu Date: Thu Dec 1 18:57:54 2022 -0800 ; * lisp/progmodes/c-ts-mode.el: Change rx to regexp-opt. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index f802a6ddb2..ad64df6143 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -525,11 +525,11 @@ c-ts-mode--base-mode ;; 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. commit 3bccef6f52598dd5aea37016254a3bc17893298d Author: Dmitry Gutov Date: Fri Dec 2 04:03:03 2022 +0200 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). 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-files (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) commit 03a40b974c47f99c7d7fb00638b2c8371ede7af4 Author: Sean Whitton Date: Thu Dec 1 15:14:28 2022 -0700 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. 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 @@ term--update-term-menu 'term-mode)) (buffer-list)))) (easy-menu-change - '("Terminal") + nil "Terminal Buffers" (mapcar (lambda (buffer) @@ -986,7 +986,9 @@ term--update-term-menu (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) commit 368c7c7d8e4291bbfd5d9071333990645fb73254 Author: Eli Zaretskii Date: Fri Dec 2 00:07:53 2022 +0200 Improve detection of very long lines * src/xdisp.c (redisplay_window): Recheck for long lines if the restriction has changed. (Bug#56682) diff --git a/src/xdisp.c b/src/xdisp.c index 171c6ccaa0..255851b921 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); commit 9c58ea37afc044a49fdd59fb4d1b8b6dd2d49ca9 Author: Eli Zaretskii Date: Thu Dec 1 20:15:52 2022 +0200 ; 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. diff --git a/etc/NEWS b/etc/NEWS index bfd9b5f26e..547b488a57 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 f91d3d2f22..c7419288ed 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -114,38 +114,55 @@ proced-signal-list (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 @@ proced-enable-color-flag :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. - -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." + "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") @@ -431,19 +448,19 @@ proced-sort-header (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 @@ proced-executable (((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 @@ proced-format-time (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))))) commit 0c1495574a14b9131a0c0a8ef126976393a00e3d Author: Laurence Warne Date: Wed Nov 16 14:32:44 2022 +0000 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. diff --git a/etc/NEWS b/etc/NEWS index a9d279fee5..bfd9b5f26e 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 ac44ae1513..f91d3d2f22 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -114,16 +114,16 @@ proced-signal-list (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 @@ proced-grammar-alist (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 @@ proced-after-send-signal-hook :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 @@ proced-sort-header '((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 @@ proced-format-time (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 @@ proced-format-tree (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) commit 91dba5b06688b1c4d891aa8ca4d2b321a52069ee Merge: d94c5870c0 70ecdebc92 Author: Eli Zaretskii Date: Thu Dec 1 19:34:32 2022 +0200 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit d94c5870c07d07a460a4512395353824ad1af23a Author: Eli Zaretskii Date: Thu Dec 1 17:34:26 2022 +0200 ; * lisp/tab-bar.el (tab-bar-change-tab-group): Doc fix. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 2f8e8b2934..cba213d45d 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1941,7 +1941,7 @@ tab-bar-change-tab-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