commit 75873450e1b036daab94124f92c71a23fc442a57 (HEAD, refs/remotes/origin/master) Merge: e0e147e103 7b2dd0ed50 Author: Eli Zaretskii Date: Fri Sep 18 11:34:38 2020 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit e0e147e10389e407531ca81d0063a11a5716d765 Author: Mike Hamrick Date: Sun Sep 13 15:52:24 2020 -0700 TTY Support for ECMA-48 strike-through graphic rendition * term.c: Support strike-through in capable terminals. (no_color_bit): Replace unused NC_INVIS with NC_STRIKE_THROUGH. (turn_on_face): Output via TS_enter_strike_through_mode if available. (turn_off_face): Handle strike-through case. (tty_capable_p, init_tty): Support strike-through. * termchar.h (struct tty_display_info): Add field for strike-through. * xfaces.c (tty_supports_face_attributes_p, realize_tty_face): Handle strike-through case. * dispextern.h: Add TTY_CAP_STRIKE_THROUGH definition. (struct face): Add field tty_strike_through_p. diff --git a/etc/NEWS b/etc/NEWS index 3a7180cacf..54bad068f8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,6 +85,13 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 +--- +** Support for the 'strike-through' face attribute on TTY frames. +If your terminal's termcap or terminfo database entry has the 'smxx' +capability defined, Emacs will now emit the prescribed escape +sequences necessary to render faces with the 'strike-through' +attribute on TTY frames. + +++ *** Emacs now defaults to UTF-8 instead of ISO-8859-1. This is only for the default, where the user has set no 'LANG' (or diff --git a/src/dispextern.h b/src/dispextern.h index 956ca96eb6..e20f7bb7b6 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1744,6 +1744,7 @@ struct face bool_bf tty_italic_p : 1; bool_bf tty_underline_p : 1; bool_bf tty_reverse_p : 1; + bool_bf tty_strike_through_p : 1; /* True means that colors of this face may not be freed because they have been copied bitwise from a base face (see @@ -3290,6 +3291,7 @@ enum tool_bar_item_image #define TTY_CAP_BOLD 0x04 #define TTY_CAP_DIM 0x08 #define TTY_CAP_ITALIC 0x10 +#define TTY_CAP_STRIKE_THROUGH 0x20 /*********************************************************************** diff --git a/src/term.c b/src/term.c index 5cbb092ad1..22035f4fe3 100644 --- a/src/term.c +++ b/src/term.c @@ -105,14 +105,14 @@ struct tty_display_info *tty_list; enum no_color_bit { - NC_STANDOUT = 1 << 0, - NC_UNDERLINE = 1 << 1, - NC_REVERSE = 1 << 2, - NC_ITALIC = 1 << 3, - NC_DIM = 1 << 4, - NC_BOLD = 1 << 5, - NC_INVIS = 1 << 6, - NC_PROTECT = 1 << 7 + NC_STANDOUT = 1 << 0, + NC_UNDERLINE = 1 << 1, + NC_REVERSE = 1 << 2, + NC_ITALIC = 1 << 3, + NC_DIM = 1 << 4, + NC_BOLD = 1 << 5, + NC_STRIKE_THROUGH = 1 << 6, + NC_PROTECT = 1 << 7 }; /* internal state */ @@ -1931,6 +1931,9 @@ turn_on_face (struct frame *f, int face_id) if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE)) OUTPUT1_IF (tty, tty->TS_enter_underline_mode); + if (face->tty_strike_through_p && MAY_USE_WITH_COLORS_P (tty, NC_STRIKE_THROUGH)) + OUTPUT1_IF (tty, tty->TS_enter_strike_through_mode); + if (tty->TN_max_colors > 0) { const char *ts; @@ -1971,7 +1974,8 @@ turn_off_face (struct frame *f, int face_id) if (face->tty_bold_p || face->tty_italic_p || face->tty_reverse_p - || face->tty_underline_p) + || face->tty_underline_p + || face->tty_strike_through_p) { OUTPUT1_IF (tty, tty->TS_exit_attribute_mode); if (strcmp (tty->TS_exit_attribute_mode, tty->TS_end_standout_mode) == 0) @@ -2006,11 +2010,12 @@ tty_capable_p (struct tty_display_info *tty, unsigned int caps) if ((caps & (cap)) && (!(TS) || !MAY_USE_WITH_COLORS_P(tty, NC_bit))) \ return 0; - TTY_CAPABLE_P_TRY (tty, TTY_CAP_INVERSE, tty->TS_standout_mode, NC_REVERSE); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode, NC_UNDERLINE); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM); - TTY_CAPABLE_P_TRY (tty, TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC); + TTY_CAPABLE_P_TRY (tty, TTY_CAP_INVERSE, tty->TS_standout_mode, NC_REVERSE); + TTY_CAPABLE_P_TRY (tty, TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode, NC_UNDERLINE); + TTY_CAPABLE_P_TRY (tty, TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD); + TTY_CAPABLE_P_TRY (tty, TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM); + TTY_CAPABLE_P_TRY (tty, TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC); + TTY_CAPABLE_P_TRY (tty, TTY_CAP_STRIKE_THROUGH, tty->TS_enter_strike_through_mode, NC_STRIKE_THROUGH); /* We can do it! */ return 1; @@ -4124,6 +4129,7 @@ use the Bourne shell command 'TERM=...; export TERM' (C-shell:\n\ tty->TS_enter_alt_charset_mode = tgetstr ("as", address); tty->TS_exit_alt_charset_mode = tgetstr ("ae", address); tty->TS_exit_attribute_mode = tgetstr ("me", address); + tty->TS_enter_strike_through_mode = tgetstr ("smxx", address); MultiUp (tty) = tgetstr ("UP", address); MultiDown (tty) = tgetstr ("DO", address); diff --git a/src/termchar.h b/src/termchar.h index c96b81913b..a8b3051767 100644 --- a/src/termchar.h +++ b/src/termchar.h @@ -136,6 +136,7 @@ struct tty_display_info const char *TS_enter_reverse_mode; /* "mr" -- enter reverse video mode. */ const char *TS_exit_underline_mode; /* "us" -- start underlining. */ const char *TS_enter_underline_mode; /* "ue" -- end underlining. */ + const char *TS_enter_strike_through_mode; /* "smxx" -- turn on strike-through mode. */ /* "as"/"ae" -- start/end alternate character set. Not really supported, yet. */ diff --git a/src/xfaces.c b/src/xfaces.c index 06d2f994de..73a536b19c 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -5217,7 +5217,6 @@ tty_supports_face_attributes_p (struct frame *f, || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) - || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])) return false; @@ -5282,6 +5281,15 @@ tty_supports_face_attributes_p (struct frame *f, test_caps |= TTY_CAP_INVERSE; } + /* strike through */ + val = attrs[LFACE_STRIKE_THROUGH_INDEX]; + if (!UNSPECIFIEDP (val)) + { + if (face_attr_equal_p (val, def_attrs[LFACE_STRIKE_THROUGH_INDEX])) + return false; /* same as default */ + else + test_caps |= TTY_CAP_STRIKE_THROUGH; + } /* Color testing. */ @@ -6244,6 +6252,8 @@ realize_tty_face (struct face_cache *cache, face->tty_underline_p = true; if (!NILP (attrs[LFACE_INVERSE_INDEX])) face->tty_reverse_p = true; + if (!NILP (attrs[LFACE_STRIKE_THROUGH_INDEX])) + face->tty_strike_through_p = true; /* Map color names to color indices. */ map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted); commit 7b2dd0ed50e197096ac6bf559e7ef59610dda3a1 Author: James N. V. Cash Date: Fri Sep 18 11:27:07 2020 +0300 * lisp/tab-bar.el (tab-bar-new-tab-to): Fix tabs not reappearing (bug#42052) Copyright-paperwork-exempt: yes diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index d8f932e7a4..e4b3c8cf19 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -801,7 +801,6 @@ After the tab is created, the hooks in (nth to-index tabs))) (cond - (tab-bar-mode) ((eq tab-bar-show t) (tab-bar-mode 1)) ((and (natnump tab-bar-show) commit 38519caa670dd76bc23235094f07f33003c2be82 Author: Eli Zaretskii Date: Fri Sep 18 10:59:26 2020 +0300 Update TUTORIAL.he * etc/tutorials/TUTORIAL.he: Adapt to latest changes in the English TUTORIAL. diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index a6e6f25269..907da24280 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -419,8 +419,9 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא >> גזרו שורה זו עם C-k, אחר־כך הקישו ‪C-/‬ והיא תופיע שוב. ‏C-_‎ הינה דרך חלופית להפעיל את פקודת הביטול. היא פועלת בדיוק כמו ‪C-/‬. -במקלדות אחדות הקשה על ‪C-/‬ שולחת ל־Emacs את התו C-_‎. חלופה נוספת היא -C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו. +במקלדות אחדות אפשר לא ללחוץ על shift כשמקישים ‏C-_‎. +במקלדות אחדות הקשה על ‪C-/‬ שולחת ל־Emacs את התו C-_‎. +חלופה נוספת היא C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו. ארגומנט נומרי ל־‪C-/‬ או ל־C-_‎ או ל־C-x u משמש כמספר החזרות על הפקודה. commit 7fec0a444eb6c9e871326ab5b5d5eefb14e513fd Author: Richard Stallman Date: Wed Sep 16 23:52:48 2020 -0400 Document easy ways of typing undo key on TTY frames * doc/emacs/basic.texi (Basic Undo): Document the easiest way to type the undo key. * etc/tutorials/TUTORIAL: Describe typing C-_ without the Shift key. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 0b685fafe9..444b2469cf 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -461,6 +461,14 @@ Normally, this command undoes the last change, moving point back to where it was before the change. The undo command applies only to changes in the buffer; you can't use it to undo cursor motion. + On a graphics terminal (including text-mode frames displayed by a +terminal emulator, such as @command{xterm}), the easiest way to invoke +@code{undo} is with @kbd{C-/}; that doesn't need the Shift key. On a +text terminal, @kbd{C-/} does not exist, but in many cases you can type +@kbd{C-_} without the Shift key (in effect pressing @kbd{C--}) and it +will work anyway, at least with keyboards that produce the US ASCII +character set. + Although each editing command usually makes a separate entry in the undo records, very simple commands may be grouped together. Sometimes, an entry may cover just part of a complex command. diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index 227c13f3e3..319ba52b67 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -473,6 +473,7 @@ to undo insertion of text.) >> Kill this line with C-k, then type C-/ and it should reappear. C-_ is an alternative undo command; it works exactly the same as C-/. +On some text terminals, you can omit the shift key when you type C-_. On some text terminals, typing C-/ actually sends C-_ to Emacs. Alternatively, C-x u also works exactly like C-/, but is a little less convenient to type. commit 8a028e900dac18208228a6d7eb4daef3e7aa174e Author: Lars Ingebrigtsen Date: Fri Sep 18 01:11:40 2020 +0200 Revert "Make delete-pair only delete pairs that are part of insert-pair-alist" This reverts commit 82de8ecc080d91dd05f2432d2d07feb2955aeec4. This patch breaks doing `M-x delete-pair' on "foo" in text-mode. diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index ac4ba78897..8c18557c79 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -735,37 +735,12 @@ This command assumes point is not in a string or comment." (insert-pair arg ?\( ?\))) (defun delete-pair (&optional arg) - "Delete a pair of characters enclosing ARG sexps that follow point. -A negative ARG deletes a pair around the preceding ARG sexps instead." - (interactive "P") - (if arg - (setq arg (prefix-numeric-value arg)) - (setq arg 1)) - (if (< arg 0) - (save-excursion - (skip-chars-backward " \t") - (save-excursion - (let ((close-char (char-before))) - (forward-sexp arg) - (unless (member (list (char-after) close-char) - (mapcar (lambda (p) - (if (= (length p) 3) (cdr p) p)) - insert-pair-alist)) - (error "Not after matching pair")) - (delete-char 1))) - (delete-char -1)) - (save-excursion - (skip-chars-forward " \t") - (save-excursion - (let ((open-char (char-after))) - (forward-sexp arg) - (unless (member (list open-char (char-before)) - (mapcar (lambda (p) - (if (= (length p) 3) (cdr p) p)) - insert-pair-alist)) - (error "Not before matching pair")) - (delete-char -1))) - (delete-char 1)))) + "Delete a pair of characters enclosing ARG sexps following point. +A negative ARG deletes a pair of characters around preceding ARG sexps." + (interactive "p") + (unless arg (setq arg 1)) + (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1))) + (delete-char (if (> arg 0) 1 -1))) (defun raise-sexp (&optional arg) "Raise ARG sexps higher up the tree." commit 1e301425ddb812d6746376fdea368c12b99c8f45 Author: Lars Ingebrigtsen Date: Fri Sep 18 00:20:38 2020 +0200 Remove mention of C-u M-. from the refcards The "find next tags" command no longer exists, as the machinery has been replaced by xref. diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex index 3b299bdd3e..5a3adb80b3 100644 --- a/etc/refcards/cs-refcard.tex +++ b/etc/refcards/cs-refcard.tex @@ -494,7 +494,6 @@ \section{Kontrola pravopisu} \section{Tagy} \key{najít tag (definici)}{M-.} -\key{najít další výskyt tagu}{C-u M-.} \metax{zadat soubor s novými tagy}{M-x visit-tags-table} \metax{vyhledat reg.\ výraz v~souborech s~tagy}{M-x tags-search} diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex index 21f27479eb..699dd9054d 100644 --- a/etc/refcards/cs-survival.tex +++ b/etc/refcards/cs-survival.tex @@ -255,7 +255,6 @@ \section{Značky (tags)} příkaz `{\tt etags} {\it vstupní\_soubory}' v příkazovém interpretu. \askip \key{M-.} najdi definici -\key{C-u M-.} najdi další výskyt definice \key{M-*} běž tam, odkud byla volána poslední \kbd{M-.} \mkey{M-x tags-query-replace} spusť query-replace na všech souborech zaznamenaných v tabulce značek. diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex index 6d972ee52b..29ddf12d49 100644 --- a/etc/refcards/de-refcard.tex +++ b/etc/refcards/de-refcard.tex @@ -497,7 +497,6 @@ \section{Rechtschreibpr\"ufung} \section{Tags} \key{Tag finden (Definition)}{M-.} -\key{n\"achstes Vorkommen von Tag finden}{C-u M-.} \metax{neue Tagsdatei angeben}{M-x visit-tags-table} \metax{regul\"aren Ausdruck in Dateien suchen}{M-x tags-search} diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex index 787556d386..fe303ee8a5 100644 --- a/etc/refcards/fr-refcard.tex +++ b/etc/refcards/fr-refcard.tex @@ -500,7 +500,6 @@ \section{V\'erifier l'orthographe} \section{Tags} \key{Trouver un tag (une d\'efinition)}{M-.} -\key{Passer \`a l'occurrence suivante du tag}{C-u M-.} \metax{Sp\'ecifier un autre fichier de tags}{M-x visit-tags-table} \metax{Rechercher dans tous les fichiers des tags}{M-x tags-search} diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex index 0aa5df3786..1cd6852db8 100644 --- a/etc/refcards/fr-survival.tex +++ b/etc/refcards/fr-survival.tex @@ -251,7 +251,6 @@ \section{Marqueurs} tel fichier, tapez `{\tt etags} {\it fichier\_entr\'ee}' \`a l'invite du shell. \askip \key{M-.} trouve une d\'efinition -\key{C-u M-.} trouve l'occurrence suivante de la d\'efinition \key{M-*} revient o\`u \kbd{M-.} a \'et\'e appel\'e pour la derni\`ere fois \mkey{M-x tags-query-replace} lance query-replace sur tous les fichiers enregistr\'es dans le tableau des marqueurs diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex index 68acac973b..2b92fb5545 100644 --- a/etc/refcards/pl-refcard.tex +++ b/etc/refcards/pl-refcard.tex @@ -690,10 +690,8 @@ \section{Przestawianie} \section{Tags} %\key{find a tag (a definition)}{M-.} -%\key{find next occurrence of tag}{C-u M-.} %\metax{specify a new tags file}{M-x visit-tags-table} \key{znajd/x okre/slenie (definicj/e)}{M-.} -\key{znajd/x nast/epne wyst/apienie definicji}{C-u M-.} \metax{podaj nowy plik TAGS}{M-x visit-tags-table} %\metax{regexp search on all files in tags table}{M-x tags-search} diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex index c75fd2f640..d4e3123458 100644 --- a/etc/refcards/pt-br-refcard.tex +++ b/etc/refcards/pt-br-refcard.tex @@ -506,7 +506,6 @@ \section{Verifica{\c{c}}{\~a}o Ortogr{\'a}fica} \section{Tags} \key{busca uma tag (uma defini{\c{c}}{\~a}o)}{M-.} -\key{encontra a pr{\'o}xima ocorr{\^e}ncia da tag}{C-u M-.} \metax{especifica um novo arquivo de tags}{M-x visit-tags-table} \metax{busca por regexp em todos arquivos}{M-x tags-search} diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex index c8f07540e5..6cac28fabb 100644 --- a/etc/refcards/refcard.tex +++ b/etc/refcards/refcard.tex @@ -511,7 +511,6 @@ \section{Spelling Check} \section{Tags} \key{find a tag (a definition)}{M-.} -\key{find next occurrence of tag}{C-u M-.} \metax{specify a new tags file}{M-x visit-tags-table} \metax{regexp search on all files in tags table}{M-x tags-search} diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index 0d210b4545..165c00d309 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -340,7 +340,6 @@ \section{Теги} \begin{tabular}{p{\ColWidth}l} найти определение тега & \kbd{M-.} \\ -найти следующее вхождение тега & \kbd{C-u M-.} \\ использовать новый файл с тегами & \kbd{M-x visit-tags-table} \\ поиск по шаблону по всей таблице тегов & \kbd{M-x tags-search} \\ diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex index 9302e1825e..b232ea8edf 100644 --- a/etc/refcards/sk-refcard.tex +++ b/etc/refcards/sk-refcard.tex @@ -494,7 +494,6 @@ \section{Kontrola pravopisu} \section{Tagy} \key{nájsť tag (definíciu)}{M-.} -\key{nájsť ďalší výskyt tagu}{C-u M-.} \metax{zadať súbor s novými tagmi}{M-x visit-tags-table} \metax{vyhľadať reg.\ výraz v~súboroch s~tagmi}{M-x tags-search} diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex index 5f06c2d11e..8e5d85f4d3 100644 --- a/etc/refcards/sk-survival.tex +++ b/etc/refcards/sk-survival.tex @@ -258,7 +258,6 @@ \section{Značky (tags)} príkaz `{\tt etags} {\it vstupné\_súbory}' v príkazovom interprétereri. \askip \key{M-.} nájdi definícu -\key{C-u M-.} nájdi ďalší výskyt definície \key{M-*} choď tam, odkiaľ bola volaná posledná \kbd{M-.} \mkey{M-x tags-query-replace} spusti query-replace na všetkých súboroch zaznamenaných v tabuľke značiek. diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex index 5e73a45b2d..24204e5200 100644 --- a/etc/refcards/survival.tex +++ b/etc/refcards/survival.tex @@ -243,7 +243,6 @@ \section{Tags} `{\tt etags} {\it input\_files}' as a shell command. \askip \key{M-.} find a definition -\key{C-u M-.} find next occurrence of definition \key{M-*} pop back to where \kbd{M-.} was last invoked \mkey{M-x tags-query-replace} run query-replace on all files recorded in tags table commit 3b3cf6c588f335ae046e4619d4f4f4ce29658c52 Author: Mauro Aranda Date: Thu Sep 17 23:46:24 2020 +0200 Fix recent change in wid-edit * lisp/wid-edit.el (widget-button--check-and-call-button): Record the ending position of event, because we might need it when the :mouse-down-action function returns non-nil (bug#20664). diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 8be489bf08..5ac52777f8 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -978,7 +978,8 @@ If nil, point returns to its original position after invoking a button.") If nothing was called, return non-nil." (let* ((oevent event) (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) - newpoint pos) + (pos (widget-event-point event)) + newpoint) (catch 'button-press-cancelled ;; Mouse click on a widget button. Do the following ;; in a save-excursion so that the click on the button commit bd6c600687f67ce11fa0cf04b61d44f3dcef9a44 Author: Lars Ingebrigtsen Date: Thu Sep 17 20:48:29 2020 +0200 Doc string typo fix for mode-line-position-column-format * lisp/bindings.el (mode-line-position-column-format): Fix typo in doc string. diff --git a/lisp/bindings.el b/lisp/bindings.el index 54e171e44b..a1751a253c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -446,7 +446,7 @@ format spec will be replaced by the line number." This is used when `column-number-mode' is switched on. The \"%c\" format spec will be replaced by the column number, which is zero-based if `column-number-indicator-zero-based' is non-nil, -and one-based if `column-number-indicator-zero-based' is nil.." +and one-based if `column-number-indicator-zero-based' is nil." :type 'form :version "28.1" :group 'mode-line) commit 65b7d465a5e5afaa5332cb8d24b0834ebb7633fc Author: Oleh Krehel Date: Thu Sep 17 20:43:34 2020 +0200 Make face names clickable in Customize buffers * lisp/cus-edit.el (custom-face-value-create): Make the face name a clickable button (bug#20664). diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 6d0ec5d148..9626b3cf81 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -3560,19 +3560,20 @@ the present value is saved to its :shown-value property instead." (widget-put widget :buttons buttons)) ;; Draw an ordinary `custom-face' widget - (let ((opoint (point))) - ;; Visibility indicator. - (push (widget-create-child-and-convert - widget 'custom-visibility - :help-echo "Hide or show this face." - :on "Hide" :off "Show" - :on-glyph "down" :off-glyph "right" - :action 'custom-toggle-hide-face - (not hiddenp)) - buttons) - ;; Face name (tag). - (insert " " tag) - (widget-specify-sample widget opoint (point))) + ;; Visibility indicator. + (push (widget-create-child-and-convert + widget 'custom-visibility + :help-echo "Hide or show this face." + :on "Hide" :off "Show" + :on-glyph "down" :off-glyph "right" + :action 'custom-toggle-hide-face + (not hiddenp)) + buttons) + ;; Face name (tag). + (insert " ") + (insert-text-button tag + 'action (lambda (&rest _x) + (find-face-definition symbol))) (insert (cond ((eq custom-buffer-style 'face) " ") ((string-match-p "face\\'" tag) ":") commit 8b61e20e4edb9d2f67134bc9f3739f936aafb01c Author: Lars Ingebrigtsen Date: Thu Sep 17 20:42:03 2020 +0200 Refactor a very long wid-edit function and add additional checking * lisp/wid-edit.el (widget-button--check-and-call-button): Factor out a too-long condition/call... (widget-button-click): From here. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index bc2afc6a6f..8be489bf08 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -973,86 +973,91 @@ Note that such modes will need to require wid-edit.") "If non-nil, `widget-button-click' moves point to a button after invoking it. If nil, point returns to its original position after invoking a button.") +(defun widget-button--check-and-call-button (event button) + "Call BUTTON if BUTTON is a widget and EVENT is correct for it. +If nothing was called, return non-nil." + (let* ((oevent event) + (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) + newpoint pos) + (catch 'button-press-cancelled + ;; Mouse click on a widget button. Do the following + ;; in a save-excursion so that the click on the button + ;; doesn't change point. + (save-selected-window + (select-window (posn-window (event-start event))) + (save-excursion + (goto-char (posn-point (event-start event))) + (let* ((overlay (widget-get button :button-overlay)) + (pressed-face (or (widget-get button :pressed-face) + widget-button-pressed-face)) + (face (overlay-get overlay 'face)) + (mouse-face (overlay-get overlay 'mouse-face))) + (unwind-protect + ;; Read events, including mouse-movement + ;; events, waiting for a release event. If we + ;; began with a mouse-1 event and receive a + ;; movement event, that means the user wants + ;; to perform drag-selection, so cancel the + ;; button press and do the default mouse-1 + ;; action. For mouse-2, just highlight/ + ;; unhighlight the button the mouse was + ;; initially on when we move over it. + (save-excursion + (when face ; avoid changing around image + (overlay-put overlay 'face pressed-face) + (overlay-put overlay 'mouse-face pressed-face)) + (unless (widget-apply button :mouse-down-action event) + (let ((track-mouse t)) + (while (not (widget-button-release-event-p event)) + (setq event (read-event)) + (when (and mouse-1 (mouse-movement-p event)) + (push event unread-command-events) + (setq event oevent) + (throw 'button-press-cancelled t)) + (unless (or (integerp event) + (memq (car event) + '(switch-frame select-window)) + (eq (car event) 'scroll-bar-movement)) + (setq pos (widget-event-point event)) + (if (and pos + (eq (get-char-property pos 'button) + button)) + (when face + (overlay-put overlay 'face pressed-face) + (overlay-put overlay 'mouse-face pressed-face)) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face)))))) + + ;; When mouse is released over the button, run + ;; its action function. + (when (and pos (eq (get-char-property pos 'button) button)) + (goto-char pos) + (widget-apply-action button event) + (if widget-button-click-moves-point + (setq newpoint (point))))) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face)))) + + (when newpoint + (goto-char newpoint))) + nil))) + (defun widget-button-click (event) "Invoke the button that the mouse is pointing at." (interactive "e") (if (widget-event-point event) - (let* ((oevent event) - (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) + (let* ((mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) (pos (widget-event-point event)) (start (event-start event)) - (button (get-char-property + (button (get-char-property pos 'button (and (windowp (posn-window start)) - (window-buffer (posn-window start))))) - newpoint) - (when (or (null button) - (catch 'button-press-cancelled - ;; Mouse click on a widget button. Do the following - ;; in a save-excursion so that the click on the button - ;; doesn't change point. - (save-selected-window - (select-window (posn-window (event-start event))) - (save-excursion - (goto-char (posn-point (event-start event))) - (let* ((overlay (widget-get button :button-overlay)) - (pressed-face (or (widget-get button :pressed-face) - widget-button-pressed-face)) - (face (overlay-get overlay 'face)) - (mouse-face (overlay-get overlay 'mouse-face))) - (unwind-protect - ;; Read events, including mouse-movement - ;; events, waiting for a release event. If we - ;; began with a mouse-1 event and receive a - ;; movement event, that means the user wants - ;; to perform drag-selection, so cancel the - ;; button press and do the default mouse-1 - ;; action. For mouse-2, just highlight/ - ;; unhighlight the button the mouse was - ;; initially on when we move over it. - (save-excursion - (when face ; avoid changing around image - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (unless (widget-apply button :mouse-down-action event) - (let ((track-mouse t)) - (while (not (widget-button-release-event-p event)) - (setq event (read-event)) - (when (and mouse-1 (mouse-movement-p event)) - (push event unread-command-events) - (setq event oevent) - (throw 'button-press-cancelled t)) - (unless (or (integerp event) - (memq (car event) '(switch-frame select-window)) - (eq (car event) 'scroll-bar-movement)) - (setq pos (widget-event-point event)) - (if (and pos - (eq (get-char-property pos 'button) - button)) - (when face - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))))) - - ;; When mouse is released over the button, run - ;; its action function. - (when (and pos (eq (get-char-property pos 'button) button)) - (goto-char pos) - (widget-apply-action button event) - (if widget-button-click-moves-point - (setq newpoint (point))))) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))) - - (if newpoint (goto-char newpoint)) - ;; This loses if the widget action switches windows. -- cyd - ;; (unless (pos-visible-in-window-p (widget-event-point event)) - ;; (mouse-set-point event) - ;; (beginning-of-line) - ;; (recenter)) - ) - nil)) - (let ((up t) command) + (window-buffer (posn-window start)))))) + + (when (and (widget-get button :button-overlay) + (or (null button) + (widget-button--check-and-call-button event button))) + (let ((up t) + command) ;; Mouse click not on a widget button. Find the global ;; command to run, and check whether it is bound to an ;; up event. commit 11f03d7476c385f83530f8a635ea362216fa8af8 Author: Juri Linkov Date: Thu Sep 17 20:10:17 2020 +0200 Allow binding keys in `query-replace-map' * lisp/replace.el (perform-replace): Allow binding keys in `query-replace-map' (bug#20687). diff --git a/lisp/replace.el b/lisp/replace.el index a751822c79..dc6e67ff40 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2953,6 +2953,8 @@ characters." (replace-dehighlight) (save-excursion (recursive-edit)) (setq replaced t)) + ((commandp def t) + (call-interactively def)) ;; Note: we do not need to treat `exit-prefix' ;; specially here, since we reread ;; any unrecognized character. commit ccd555f04b1c3e2f1af0f4302313355c13f9b708 Author: Eli Zaretskii Date: Thu Sep 17 21:41:58 2020 +0300 ; * src/keyboard (make_lispy_event): Fix a typo. diff --git a/src/keyboard.c b/src/keyboard.c index d82d323f63..8525d3b8de 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -6042,7 +6042,7 @@ make_lispy_event (struct input_event *event) } #endif -#ifdef USE_FILE_NO101TIFY +#ifdef USE_FILE_NOTIFY case FILE_NOTIFY_EVENT: #ifdef HAVE_W32NOTIFY /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */ @@ -10442,6 +10442,7 @@ DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1, "(list (read-number \"new-size: \" (lossage-size)))", doc: /* Return or set the maximum number of keystrokes to save. If called with a non-nil ARG, set the limit to ARG and return it. +Otherwise, return the current limit. The saved keystrokes are shown by `view-lossage'. */) (Lisp_Object arg) commit 5e031c5e7095789d18743c1a915d3b252434bbc4 Author: Lars Ingebrigtsen Date: Thu Sep 17 18:09:01 2020 +0200 Fix up previous autoload-find-generated-file change * lisp/emacs-lisp/autoload.el (autoload-find-generated-file): Use the correct name for find-file-hook. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 80ac90895a..0bcd7b7dcd 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -258,7 +258,7 @@ expression, in which case we want to handle forms differently." "Visit the autoload file for the current buffer, and return its buffer." (let ((enable-local-variables :safe) (enable-local-eval nil) - (find-file-hooks nil) + (find-file-hook nil) (delay-mode-hooks t) (file (autoload-generated-file))) ;; We used to use `raw-text' to read this file, but this causes commit 64ba14f3661f163ebac431293c92e8b22bb31f9c Author: Lars Ingebrigtsen Date: Thu Sep 17 18:02:44 2020 +0200 Make package install not bug out on weird stuff in find-file-hooks * lisp/emacs-lisp/autoload.el (autoload-find-generated-file): Users may have read-only-mode in find-file-hooks (bug#43460) so just disable all the hooks here. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 2eef451200..80ac90895a 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -258,6 +258,7 @@ expression, in which case we want to handle forms differently." "Visit the autoload file for the current buffer, and return its buffer." (let ((enable-local-variables :safe) (enable-local-eval nil) + (find-file-hooks nil) (delay-mode-hooks t) (file (autoload-generated-file))) ;; We used to use `raw-text' to read this file, but this causes commit f7e68759d033e2a503f47cd7d97b760bd92e375f Author: Harald Jörg Date: Thu Sep 17 17:35:04 2020 +0200 cperl-mode: Add new value "PBP" for 'cperl-set-style' * lisp/progmodes/cperl-mode.el (cperl-style-alist) (cperl-set-style): Add indentation style recommended by Damian Conway's book "Perl Best Practices". * test/lisp/progmodes/cperl-mode-tests.el (cperl-mode-test-indent-styles): Add a test to verify indentation and unraveling of conditionals (bug#43457). diff --git a/etc/NEWS b/etc/NEWS index 5b69e2f423..3a7180cacf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1179,6 +1179,14 @@ non-nil, even if protected by 'dbus-ignore-errors' otherwise. --- *** D-Bus events keep the type information of their arguments. +** CPerl Mode + +--- +*** The command 'cperl-set-style' offers the new value "PBP". +This value customizes Emacs to use the style recommended in Damian +Conway's book "Perl Best Practices" for indentation and formatting +of conditionals. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index af179e2797..8804e83fce 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1234,6 +1234,7 @@ versions of Emacs." ["Auto fill" auto-fill-mode t]) ("Indent styles..." ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-set-style "PBP") t] ["PerlStyle" (cperl-set-style "PerlStyle") t] ["GNU" (cperl-set-style "GNU") t] ["C++" (cperl-set-style "C++") t] @@ -1553,12 +1554,12 @@ Variables controlling indentation style: `cperl-min-label-indent' Minimal indentation for line that is a label. -Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith - `cperl-indent-level' 5 4 2 4 - `cperl-brace-offset' 0 0 0 0 - `cperl-continued-brace-offset' -5 -4 0 0 - `cperl-label-offset' -5 -4 -2 -4 - `cperl-continued-statement-offset' 5 4 2 4 +Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith + `cperl-indent-level' 5 4 2 4 4 + `cperl-brace-offset' 0 0 0 0 0 + `cperl-continued-brace-offset' -5 -4 0 0 0 + `cperl-label-offset' -5 -4 -2 -2 -4 + `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the corresponding variables. Use \\[cperl-set-style] to do this. Use @@ -6046,7 +6047,19 @@ if (foo) { stop; } -### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil +### PBP (=Perl Best Practices) 4/0/0/-4/4/nil/nil +if (foo) { + bar + baz; + label: + { + boon; + } +} +else { + stop; +} +### PerlStyle (=CPerl with 4 as indent) 4/0/0/-2/4/t/nil if (foo) { bar baz; @@ -6149,6 +6162,18 @@ else (cperl-extra-newline-before-brace-multiline . nil) (cperl-merge-trailing-else . t)) + ("PBP" ;; Perl Best Practices by Damian Conway + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-continued-statement-offset . 4) + (cperl-extra-newline-before-brace . nil) + (cperl-extra-newline-before-brace-multiline . nil) + (cperl-merge-trailing-else . nil) + (cperl-indent-parens-as-block . t) + (cperl-tab-always-indent . t)) + ("PerlStyle" ; CPerl with 4 as indent (cperl-indent-level . 4) (cperl-brace-offset . 0) @@ -6220,7 +6245,7 @@ See examples in `cperl-style-examples'.") "Set CPerl mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles -are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. +are CPerl, PBP, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. The current value of style is memorized (unless there is a memorized data already), may be restored by `cperl-set-style-back'. diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl new file mode 100644 index 0000000000..0832f86828 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl @@ -0,0 +1,44 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.020; + +# This file contains test input and expected output for the tests in +# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is +# syntactically valid, but doesn't make much sense. + +# -------- PBP indent: input -------- +for my $foo (@ARGV) +{ +...; +} +# -------- PBP indent: expected output -------- +for my $foo (@ARGV) { + ...; +} +# -------- PBP indent: end -------- + +# -------- PBP uncuddle else: input -------- +{ +if (1 < 2) +{ +say "Seems ok"; +} elsif (1 == 2) { +say "Strange things are happening"; +} else { +die "This world is backwards"; +} +} +# -------- PBP uncuddle else: expected output -------- +{ + if (1 < 2) { + say "Seems ok"; + } + elsif (1 == 2) { + say "Strange things are happening"; + } + else { + die "This world is backwards"; + } +} +# -------- PBP uncuddle else: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 2eaf633d17..f0ff8e9005 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -172,4 +172,35 @@ end of the statement." (setq got (concat "test case " name ":\n" (buffer-string))) (should (equal got expected)))))))) +(ert-deftest cperl-mode-test-indent-styles () + "Verify correct indentation by style \"PBP\". +Perl Best Practices sets some indentation values different from + the defaults, and also wants an \"else\" or \"elsif\" keyword + to align with the \"if\"." + (let ((file (expand-file-name "cperl-indent-styles.pl" + cperl-mode-tests-data-directory))) + (with-temp-buffer + (cperl-set-style "PBP") + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward + (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n" + "\\(?2:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: expected output ?-+\n" + "\\(?3:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: end ?-+") + nil t) + (let ((name (match-string 1)) + (code (match-string 2)) + (expected (match-string 3)) + got) + (with-temp-buffer + (insert code) + (cperl-mode) + (indent-region (point-min) (point-max)) ; here we go! + (setq expected (concat "test case " name ":\n" expected)) + (setq got (concat "test case " name ":\n" (buffer-string))) + (should (equal got expected))))) + (cperl-set-style "CPerl")))) + ;;; cperl-mode-tests.el ends here commit fa0859fda997962a567bba46f8388a445ed2524f Author: Eli Zaretskii Date: Thu Sep 17 18:24:22 2020 +0300 Fix documentation of a recent change * src/keyboard.c (update_recent_keys): Fix commentary. (Flossage_size): Fix doc string. * etc/NEWS: Move and fix wording of the recently added entry. diff --git a/etc/NEWS b/etc/NEWS index 1ee86de128..5b69e2f423 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,10 +85,6 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 -+++ -** The new command 'lossage-size' allow users to set the maximum -number of keystrokes and commands recorded. - +++ *** Emacs now defaults to UTF-8 instead of ISO-8859-1. This is only for the default, where the user has set no 'LANG' (or @@ -481,6 +477,11 @@ authentication mechanism by setting a value for the key 'smtp-auth'. +++ *** New command 'describe-keymap' describes keybindings in a keymap. ++++ +** New command 'lossage-size'. +It allows users to set the maximum number of keystrokes and commands +recorded for the purpose of 'view-lossage'. + --- *** The command 'view-lossage' can now be invoked from the menu bar. The menu-bar Help menu now has a "Show Recent Inputs" item under the diff --git a/src/keyboard.c b/src/keyboard.c index c0a41e6c4c..d82d323f63 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -6042,7 +6042,7 @@ make_lispy_event (struct input_event *event) } #endif -#ifdef USE_FILE_NOTIFY +#ifdef USE_FILE_NO101TIFY case FILE_NOTIFY_EVENT: #ifdef HAVE_W32NOTIFY /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */ @@ -10414,7 +10414,8 @@ If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */) ? Qt : Qnil); } -/* Reallocate recent_keys copying the keystrokes in the right order */ +/* Reallocate recent_keys copying the recorded keystrokes + in the right order. */ static void update_recent_keys (int new_size, int kept_keys) { @@ -10439,10 +10440,10 @@ update_recent_keys (int new_size, int kept_keys) DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1, "(list (read-number \"new-size: \" (lossage-size)))", - doc: /* Return the maximum number of saved keystrokes. -Called with ARG, then set this limit to ARG and return it. + doc: /* Return or set the maximum number of keystrokes to save. +If called with a non-nil ARG, set the limit to ARG and return it. -The saved keystrokes are the records shown by `view-lossage'. */) +The saved keystrokes are shown by `view-lossage'. */) (Lisp_Object arg) { if (NILP(arg)) commit 8af0fe243f3dd91c0836db4de3c7aeeac4a54a89 Author: Masahiro Nakamura Date: Thu Sep 17 17:15:05 2020 +0200 etc/refcards/refcard.tex: Fix some grouping regexps * etc/refcards/refcard.tex (section{Regular Expressions}): Fix the shy/numbered grouping examples (bug#43429). diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex index afae238c78..c8f07540e5 100644 --- a/etc/refcards/refcard.tex +++ b/etc/refcards/refcard.tex @@ -562,8 +562,8 @@ \section{Regular Expressions} \key{quote regular expression special character {\it c\/}}{\\{\it c}} \key{alternative (``or'')}{\\|} \key{grouping}{\\( {\rm$\ldots$} \\)} -\key{shy grouping}{\\(:? {\rm$\ldots$} \\)} -\key{explicit numbered grouping}{\\(:NUM {\rm$\ldots$} \\)} +\key{shy grouping}{\\(?: {\rm$\ldots$} \\)} +\key{explicit numbered grouping}{\\(?NUM: {\rm$\ldots$} \\)} \key{same text as {\it n\/}th group}{\\{\it n}} \key{at word break}{\\b} \key{not at word break}{\\B} commit 6d6ef7b1d00696e38080b8b158d8b9b196bc8bcb Author: Michael Albinus Date: Thu Sep 17 17:13:55 2020 +0200 Work on D-Bus properties etc * lisp/net/dbus.el (seq, subr-x): Require. (dbus-error-disconnected, dbus-error-service-unknown): New defconst. (dbus-set-property, dbus-register-property): Use `keywordp'. Fix proper value sending a signal. * test/lisp/net/dbus-tests.el (dbus-test04-register-method): Extend test. (dbus--test-signal-received): New defvar. (dbus--test-signal-handler): New defun. (dbus-test05-register-signal) (dbus-test06-register-property-emits-signal): New tests. (dbus-test06-register-property) (dbus-test06-register-property-several-paths): Rename tests. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index fa910643a3..aab08dd0d4 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -51,6 +51,8 @@ (unless (boundp 'dbus-debug) (defvar dbus-debug nil)) +(require 'seq) +(require 'subr-x) (require 'xml) ;;; D-Bus constants. @@ -169,12 +171,15 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter "The namespace for default error names. See /usr/include/dbus-1.0/dbus/dbus-protocol.h.") -(defconst dbus-error-failed (concat dbus-error-dbus ".Failed") - "A generic error; \"something went wrong\" - see the error message for more.") - (defconst dbus-error-access-denied (concat dbus-error-dbus ".AccessDenied") "Security restrictions don't allow doing what you're trying to do.") +(defconst dbus-error-disconnected (concat dbus-error-dbus ".Disconnected") + "The connection is disconnected and you're trying to use it.") + +(defconst dbus-error-failed (concat dbus-error-dbus ".Failed") + "A generic error; \"something went wrong\" - see the error message for more.") + (defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs") "Invalid arguments passed to a method call.") @@ -185,6 +190,9 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.") (concat dbus-error-dbus ".PropertyReadOnly") "Property you tried to set is read-only.") +(defconst dbus-error-service-unknown (concat dbus-error-dbus ".ServiceUnknown") + "The bus doesn't know how to launch a service to supply the bus name you wanted.") + (defconst dbus-error-unknown-interface (concat dbus-error-dbus ".UnknownInterface") "Interface you invoked a method on isn't known by the object.") @@ -1526,7 +1534,7 @@ return nil. "Set" :timeout 500 interface property (cons :variant args)) ;; Return VALUE. (or (dbus-get-property bus service path interface property) - (if (symbolp (car args)) (cadr args) (car args))))) + (if (keywordp (car args)) (cadr args) (car args))))) (defun dbus-get-all-properties (bus service path interface) "Return all properties of INTERFACE at BUS, SERVICE, PATH. @@ -1603,7 +1611,7 @@ clients from discovering the still incomplete interface. \(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \ [TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)" (let (;; Read basic type symbol. - (type (when (symbolp (car args)) (pop args))) + (type (when (keywordp (car args)) (pop args))) (value (pop args)) (emits-signal (pop args)) (dont-register-service (pop args))) @@ -1646,10 +1654,7 @@ clients from discovering the still incomplete interface. ;; changed_properties. (if (eq access :write) '(:array: :signature "{sv}") - `(:array - (:dict-entry - ,property - ,(if type (list :variant type value) (list :variant value))))) + `(:array (:dict-entry ,property ,value))) ;; invalidated_properties. (if (eq access :write) `(:array ,property) diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index d470bca226..18c2a2ad6d 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -219,6 +219,17 @@ This includes initialization and closing the bus." (handler #'dbus--test-method-handler) registered) + ;; The service is not registered yet. + (should + (equal + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method1 :timeout 10 "foo")) + `(dbus-error + ,dbus-error-service-unknown "The name is not activatable"))) + + ;; Register. (should (equal (setq @@ -283,8 +294,61 @@ This includes initialization and closing the bus." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) -;; TODO: Test emits-signal. -(ert-deftest dbus-test05-register-property () +(defvar dbus--test-signal-received nil + "Received signal value in `dbus--test-signal-handler'.") + +(defun dbus--test-signal-handler (&rest args) + "Signal handler for `dbus-test05-register-signal'." + (setq dbus--test-signal-received args)) + +(ert-deftest dbus-test05-register-signal () + "Check signal registration for an own service." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((member "Member") + (handler #'dbus--test-signal-handler) + registered) + + ;; Register signal handler. + (should + (equal + (setq + registered + (dbus-register-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member handler)) + `((:signal :session ,dbus--test-interface ,member) + (,dbus--test-service ,dbus--test-path ,handler)))) + + ;; Send one argument, basic type. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member "foo") + (while (null dbus--test-signal-received) + (read-event nil nil 0.1)) + (should (equal dbus--test-signal-received '("foo"))) + + ;; Send two arguments, compound types. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member + '(:array :byte 1 :byte 2 :byte 3) '(:variant :string "bar")) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1)) + (should (equal dbus--test-signal-received '((1 2 3) ("bar")))) + + ;; Unregister signal. + (should (dbus-unregister-object registered)) + (should-not (dbus-unregister-object registered))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test06-register-property () "Check property registration for an own service." (skip-unless dbus--test-enabled-session-bus) (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) @@ -470,7 +534,7 @@ This includes initialization and closing the bus." (dbus-unregister-service :session dbus--test-service))) ;; The following test is inspired by Bug#43146. -(ert-deftest dbus-test05-register-property-several-paths () +(ert-deftest dbus-test06-register-property-several-paths () "Check property registration for an own service at several paths." (skip-unless dbus--test-enabled-session-bus) (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) @@ -625,6 +689,72 @@ This includes initialization and closing the bus." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(ert-deftest dbus-test06-register-property-emits-signal () + "Check property registration for an own service, including signalling." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((property "Property") + (handler #'dbus--test-signal-handler)) + + ;; Register signal handler. + (should + (equal + (dbus-register-signal + :session dbus--test-service dbus--test-path + dbus-interface-properties "PropertiesChanged" handler) + `((:signal :session ,dbus-interface-properties "PropertiesChanged") + (,dbus--test-service ,dbus--test-path ,handler)))) + + ;; Register property. + (setq dbus--test-signal-received nil) + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property :readwrite "foo" 'emits-signal) + `((:property :session ,dbus--test-interface ,property) + (,dbus--test-service ,dbus--test-path)))) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1)) + ;; It returns two arguments, "changed_properties" (an array of + ;; dict entries) and "invalidated_properties" (an array of + ;; strings). + (should (equal dbus--test-signal-received `(((,property ("foo"))) ()))) + + (should + (equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property) + "foo")) + + ;; Set property. The new value shall be signalled. + (setq dbus--test-signal-received nil) + (should + (equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property + '(:array :byte 1 :byte 2 :byte 3)) + '(1 2 3))) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1)) + (should + (equal + dbus--test-signal-received `(((,property ((((1) (2) (3)))))) ()))) + + (should + (equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property) + '(1 2 3)))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + (defun dbus-test-all (&optional interactive) "Run all tests for \\[dbus]." (interactive "p") commit 12aea1fa80f6db85dc58a54fa7486c58928206e7 Author: Alex Bochannek Date: Thu Sep 17 17:02:48 2020 +0200 Allow user-defined scoring in Gnus * lisp/gnus/gnus-score.el (gnus-score-func): New function (bug#43413). * doc/misc/gnus.texi (Score File Format): Document it. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 50eeb3efa3..76aaca1699 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -20394,6 +20394,36 @@ key will lead to creation of @file{ADAPT} files.) @end enumerate @cindex score file atoms +@item score-fn +The value of this entry should be one or more user-defined function +names in parentheses. Each function will be called in order and the +returned value is required to be an integer. + +@example +(score-fn (custom-scoring)) +@end example + +The user-defined function is called with an associative list with the +keys @code{number subject from date id refs chars lines xref extra} +followed by the article's score before the function is run. + +The following (somewhat contrived) example shows how to use a +user-defined function that increases an article's score by 10 if the +year of the article's date is also mentioned in its subject. + +@example +(defun custom-scoring (article-alist score) + (let ((subject (cdr (assoc 'subject article-alist))) + (date (cdr (assoc 'date article-alist)))) + (if (string-match (number-to-string + (nth 5 (parse-time-string date))) + subject) + 10))) +@end example + +@code{score-fn} entries are permanent and can only be added or +modified directly in the @code{SCORE} file. + @item mark The value of this entry should be a number. Any articles with a score lower than this number will be marked as read. diff --git a/etc/NEWS b/etc/NEWS index 721da44811..1ee86de128 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -365,6 +365,11 @@ tags to be considered as well. You can now score based on the relative age of an article with the new '<' and '>' date scoring types. ++++ +*** User-defined scoring is now possible. +The new type is 'score-fn'. More information in +(Gnus)Score File Format. + +++ *** New backend 'nnselect'. The newly added 'nnselect' backend allows creating groups from an diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index ffc6b8ca34..2e3abe7832 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -25,8 +25,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-sum) (require 'gnus-art) @@ -35,6 +33,7 @@ (require 'message) (require 'score-mode) (require 'gmm-utils) +(require 'cl-lib) (defcustom gnus-global-score-files nil "List of global score files and directories. @@ -497,6 +496,7 @@ of the last successful match.") ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) + (score-fn -1 nil) ("followup" 2 gnus-score-followup) ("thread" 5 gnus-score-thread))) @@ -1175,14 +1175,19 @@ If FORMAT, also format the current score file." (when format (gnus-score-pretty-print)) (when (consp rule) ;; the rule exists - (setq rule (mapconcat #'(lambda (obj) - (regexp-quote (format "%S" obj))) - rule - sep)) + (setq rule (if (symbolp (car rule)) + (format "(%S)" (car rule)) + (mapconcat #'(lambda (obj) + (regexp-quote (format "%S" obj))) + rule + sep))) (goto-char (point-min)) - (re-search-forward rule nil t) - ;; make it easy to use `kill-sexp': - (goto-char (1- (match-beginning 0))))))) + (let ((move (if (string-match "(.*)" rule) + 0 + -1))) + (re-search-forward rule nil t) + ;; make it easy to use `kill-sexp': + (goto-char (+ move (match-beginning 0)))))))) (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. @@ -1232,6 +1237,7 @@ If FORMAT, also format the current score file." (let ((mark (car (gnus-score-get 'mark alist))) (expunge (car (gnus-score-get 'expunge alist))) (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) + (score-fn (car (gnus-score-get 'score-fn alist))) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) (orphan (car (gnus-score-get 'orphan alist))) @@ -1567,10 +1573,14 @@ If FORMAT, also format the current score file." (gnus-message 7 "Scoring on headers or body skipped.") nil) + ;; Run score-fn + (if (eq header 'score-fn) + (setq new (gnus-score-func scores trace)) ;; Call the scoring function for this type of "header". (setq new (funcall (nth 2 entry) scores header - now expire trace))) + now expire trace)))) (push new news)))) + (when (gnus-buffer-live-p gnus-summary-buffer) (let ((scored gnus-newsgroup-scored)) (with-current-buffer gnus-summary-buffer @@ -1636,6 +1646,30 @@ score in `gnus-newsgroup-scored' by SCORE." (not (string= id ""))) (gnus-score-lower-thread thread score))))) +(defun gnus-score-func (scores &optional trace) + (dolist (alist scores) + (let ((articles gnus-scores-articles) + (entries (assoc 'score-fn alist))) + (dolist (score-fn (cdr entries)) + (let ((score-fn (car score-fn)) + article-alist score fn-score) + (dolist (art articles) + (setq article-alist + (cl-pairlis + '(number subject from date id + refs chars lines xref extra) + (car art)) + score (cdr art)) + (when (integerp (setq fn-score (funcall score-fn + article-alist score))) + (setcdr art (+ score fn-score))) + (setq score (cdr art)) + (when (and trace + (integerp fn-score)) + (push (cons (car-safe (rassq alist gnus-score-cache)) + (list score-fn fn-score)) + gnus-score-trace)))))))) + (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) entries alist) commit 82de8ecc080d91dd05f2432d2d07feb2955aeec4 Author: martin rudalics Date: Thu Sep 17 16:43:45 2020 +0200 Make delete-pair only delete pairs that are part of insert-pair-alist * lisp/emacs-lisp/lisp.el (delete-pair): Only delete pairs that are part of `insert-pair-alist' (bug#4136). diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 8c18557c79..ac4ba78897 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -735,12 +735,37 @@ This command assumes point is not in a string or comment." (insert-pair arg ?\( ?\))) (defun delete-pair (&optional arg) - "Delete a pair of characters enclosing ARG sexps following point. -A negative ARG deletes a pair of characters around preceding ARG sexps." - (interactive "p") - (unless arg (setq arg 1)) - (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1))) - (delete-char (if (> arg 0) 1 -1))) + "Delete a pair of characters enclosing ARG sexps that follow point. +A negative ARG deletes a pair around the preceding ARG sexps instead." + (interactive "P") + (if arg + (setq arg (prefix-numeric-value arg)) + (setq arg 1)) + (if (< arg 0) + (save-excursion + (skip-chars-backward " \t") + (save-excursion + (let ((close-char (char-before))) + (forward-sexp arg) + (unless (member (list (char-after) close-char) + (mapcar (lambda (p) + (if (= (length p) 3) (cdr p) p)) + insert-pair-alist)) + (error "Not after matching pair")) + (delete-char 1))) + (delete-char -1)) + (save-excursion + (skip-chars-forward " \t") + (save-excursion + (let ((open-char (char-after))) + (forward-sexp arg) + (unless (member (list open-char (char-before)) + (mapcar (lambda (p) + (if (= (length p) 3) (cdr p) p)) + insert-pair-alist)) + (error "Not before matching pair")) + (delete-char -1))) + (delete-char 1)))) (defun raise-sexp (&optional arg) "Raise ARG sexps higher up the tree." commit 23a3333b3ef0768f48f64f382ee899050b6103be Author: Tino Calancha Date: Sat Sep 12 14:14:45 2020 +0200 Give Lisp control on the lossage size Add a command 'lossage-size' to set the maximum number or recorded keystrokes (Bug#38796). * src/keyboard.c (lossage_limit): Static variable with the current lossage size limit. (MIN_NUM_RECENT_KEYS): Renamed from NUM_RECENT_KEYS. Set it as 100 and use it as the minimum value for lossage_limit. Keep the same default for the vector size as before (300). (lossage-size): New command. (update_recent_keys): Helper function. (command_loop_1) (record_char) (recent-keys) (syms_of_keyboard): Use lossage_limit as the vector size. * lisp/help.el (view-lossage): Mention the new command in the docstring. * etc/NEWS (Changes in Emacs 28.1): Announce this change. * doc/emacs/help.texi (Misc Help): Update manual. * test/src/keyboard-tests.el (keyboard-lossage-size): Add test. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 06ad5a583d..232b611f41 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -573,10 +573,13 @@ command works depend on the major mode. @kindex C-h l @findex view-lossage +@findex lossage-size If something surprising happens, and you are not sure what you typed, use @kbd{C-h l} (@code{view-lossage}). @kbd{C-h l} displays your last -300 input keystrokes and the commands they invoked. If you see -commands that you are not familiar with, you can use @kbd{C-h k} or +input keystrokes and the commands they invoked. By default, Emacs +stores the last 300 keystrokes; if you wish, you can change this number with +the command @code{lossage-size}. +If you see commands that you are not familiar with, you can use @kbd{C-h k} or @kbd{C-h f} to find out what they do. @kindex C-h e diff --git a/etc/NEWS b/etc/NEWS index e46b3489ce..721da44811 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,6 +85,10 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 ++++ +** The new command 'lossage-size' allow users to set the maximum +number of keystrokes and commands recorded. + +++ *** Emacs now defaults to UTF-8 instead of ISO-8859-1. This is only for the default, where the user has set no 'LANG' (or diff --git a/lisp/help.el b/lisp/help.el index 729684af6b..edef78d207 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -458,6 +458,7 @@ the variable `message-log-max'." "Display last few input keystrokes and the commands run. For convenience this uses the same format as `edit-last-kbd-macro'. +See `lossage-size' to update the number of recorded keystrokes. To record all your input, use `open-dribble-file'." (interactive) diff --git a/src/keyboard.c b/src/keyboard.c index 590d183c4c..c0a41e6c4c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -103,7 +103,8 @@ static KBOARD *all_kboards; /* True in the single-kboard state, false in the any-kboard state. */ static bool single_kboard; -#define NUM_RECENT_KEYS (300) +/* Minimum allowed size of the recent_keys vector. */ +#define MIN_NUM_RECENT_KEYS (100) /* Index for storing next element into recent_keys. */ static int recent_keys_index; @@ -111,7 +112,10 @@ static int recent_keys_index; /* Total number of elements stored into recent_keys. */ static int total_keys; -/* This vector holds the last NUM_RECENT_KEYS keystrokes. */ +/* Size of the recent_keys vector. */ +static int lossage_limit = 3 * MIN_NUM_RECENT_KEYS; + +/* This vector holds the last lossage_limit keystrokes. */ static Lisp_Object recent_keys; /* Vector holding the key sequence that invoked the current command. @@ -1421,10 +1425,10 @@ command_loop_1 (void) /* Execute the command. */ { - total_keys += total_keys < NUM_RECENT_KEYS; + total_keys += total_keys < lossage_limit; ASET (recent_keys, recent_keys_index, Fcons (Qnil, cmd)); - if (++recent_keys_index >= NUM_RECENT_KEYS) + if (++recent_keys_index >= lossage_limit) recent_keys_index = 0; } Vthis_command = cmd; @@ -3248,15 +3252,15 @@ record_char (Lisp_Object c) int ix1, ix2, ix3; if ((ix1 = recent_keys_index - 1) < 0) - ix1 = NUM_RECENT_KEYS - 1; + ix1 = lossage_limit - 1; ev1 = AREF (recent_keys, ix1); if ((ix2 = ix1 - 1) < 0) - ix2 = NUM_RECENT_KEYS - 1; + ix2 = lossage_limit - 1; ev2 = AREF (recent_keys, ix2); if ((ix3 = ix2 - 1) < 0) - ix3 = NUM_RECENT_KEYS - 1; + ix3 = lossage_limit - 1; ev3 = AREF (recent_keys, ix3); if (EQ (XCAR (c), Qhelp_echo)) @@ -3307,12 +3311,12 @@ record_char (Lisp_Object c) { if (!recorded) { - total_keys += total_keys < NUM_RECENT_KEYS; + total_keys += total_keys < lossage_limit; ASET (recent_keys, recent_keys_index, /* Copy the event, in case it gets modified by side-effect by some remapping function (bug#30955). */ CONSP (c) ? Fcopy_sequence (c) : c); - if (++recent_keys_index >= NUM_RECENT_KEYS) + if (++recent_keys_index >= lossage_limit) recent_keys_index = 0; } else if (recorded < 0) @@ -3326,10 +3330,10 @@ record_char (Lisp_Object c) while (recorded++ < 0 && total_keys > 0) { - if (total_keys < NUM_RECENT_KEYS) + if (total_keys < lossage_limit) total_keys--; if (--recent_keys_index < 0) - recent_keys_index = NUM_RECENT_KEYS - 1; + recent_keys_index = lossage_limit - 1; ASET (recent_keys, recent_keys_index, Qnil); } } @@ -10410,6 +10414,62 @@ If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */) ? Qt : Qnil); } +/* Reallocate recent_keys copying the keystrokes in the right order */ +static void +update_recent_keys (int new_size, int kept_keys) +{ + int osize = ASIZE (recent_keys); + eassert (recent_keys_index < osize); + eassert (kept_keys <= min (osize, new_size)); + Lisp_Object v = make_nil_vector (new_size); + int i, idx; + for (i = 0; i < kept_keys; ++i) + { + idx = recent_keys_index - kept_keys + i; + while (idx < 0) + idx += osize; + ASET (v, i, AREF (recent_keys, idx)); + } + recent_keys = v; + total_keys = kept_keys; + recent_keys_index = total_keys % new_size; + lossage_limit = new_size; + +} + +DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1, + "(list (read-number \"new-size: \" (lossage-size)))", + doc: /* Return the maximum number of saved keystrokes. +Called with ARG, then set this limit to ARG and return it. + +The saved keystrokes are the records shown by `view-lossage'. */) + (Lisp_Object arg) +{ + if (NILP(arg)) + return make_fixnum (lossage_limit); + + if (!FIXNATP (arg)) + user_error ("Value must be a positive integer"); + int osize = ASIZE (recent_keys); + eassert (lossage_limit == osize); + int min_size = MIN_NUM_RECENT_KEYS; + int new_size = XFIXNAT (arg); + + if (new_size == osize) + return make_fixnum (lossage_limit); + + if (new_size < min_size) + { + AUTO_STRING (fmt, "Value must be >= %d"); + Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum (min_size)))); + } + + int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys); + update_recent_keys (new_size, kept_keys); + + return make_fixnum (lossage_limit); +} + DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0, doc: /* Return vector of last few events, not counting those from keyboard macros. If INCLUDE-CMDS is non-nil, include the commands that were run, @@ -10419,21 +10479,21 @@ represented as pseudo-events of the form (nil . COMMAND). */) bool cmds = !NILP (include_cmds); if (!total_keys - || (cmds && total_keys < NUM_RECENT_KEYS)) + || (cmds && total_keys < lossage_limit)) return Fvector (total_keys, XVECTOR (recent_keys)->contents); else { Lisp_Object es = Qnil; - int i = (total_keys < NUM_RECENT_KEYS + int i = (total_keys < lossage_limit ? 0 : recent_keys_index); - eassert (recent_keys_index < NUM_RECENT_KEYS); + eassert (recent_keys_index < lossage_limit); do { Lisp_Object e = AREF (recent_keys, i); if (cmds || !CONSP (e) || !NILP (XCAR (e))) es = Fcons (e, es); - if (++i >= NUM_RECENT_KEYS) + if (++i >= lossage_limit) i = 0; } while (i != recent_keys_index); es = Fnreverse (es); @@ -11686,7 +11746,7 @@ syms_of_keyboard (void) staticpro (&modifier_symbols); } - recent_keys = make_nil_vector (NUM_RECENT_KEYS); + recent_keys = make_nil_vector (lossage_limit); staticpro (&recent_keys); this_command_keys = make_nil_vector (40); @@ -11736,6 +11796,7 @@ syms_of_keyboard (void) defsubr (&Srecursive_edit); defsubr (&Sinternal_track_mouse); defsubr (&Sinput_pending_p); + defsubr (&Slossage_size); defsubr (&Srecent_keys); defsubr (&Sthis_command_keys); defsubr (&Sthis_command_keys_vector); diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el index 1988ba51a7..970a53555f 100644 --- a/test/src/keyboard-tests.el +++ b/test/src/keyboard-tests.el @@ -32,5 +32,20 @@ (read-event nil nil 2)) ?\C-b))) +(ert-deftest keyboard-lossage-size () + "Test `lossage-size'." + (let ((min-value 100) + (lossage-orig (lossage-size))) + (dolist (factor (list 1 3 4 5 10 7 3)) + (let ((new-lossage (* factor min-value))) + (should (= new-lossage (lossage-size new-lossage))))) + ;; Wrong type + (should-error (lossage-size -5)) + (should-error (lossage-size "200")) + ;; Less that minimum value + (should-error (lossage-size (1- min-value))) + (should (= lossage-orig (lossage-size lossage-orig))))) + + (provide 'keyboard-tests) ;;; keyboard-tests.el ends here commit cd151d06084bff6fa9ba48f8fa13b6bf24e8778c Author: Lars Ingebrigtsen Date: Thu Sep 17 16:09:30 2020 +0200 Fix up previous change for column/line spec mechanism in the mode line * lisp/bindings.el (column-number-indicator-zero-based): Make obsolete (bug#28648). (mode-line-position-column-line-format): New variable. (mode-line-position--column-line-properties): New const. (mode-line-position): Use it. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index b77bcdb5c1..1652cb6989 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2177,11 +2177,18 @@ number. The format used to display column numbers when @code{column-number-mode} (@pxref{Optional Mode Line,,, emacs, The GNU Emacs Manual}) is switched on. @samp{%c} in the format will be -replaced with the line number, and this is zero-based if +replaced with the column number, and this is zero-based if @code{column-number-indicator-zero-based} is non-@code{nil}, and one-based if @code{column-number-indicator-zero-based} is @code{nil}. @end defvar +@defvar mode-line-position-column-line-format +The format used to display column numbers when both +@code{line-number-mode} and @code{column-number-mode} are switched on. +See the previous two variables for the meaning of the @samp{%l} and +@samp{%c} format specs. +@end defvar + @defvar minor-mode-alist @anchor{Definition of minor-mode-alist} This variable holds an association list whose elements specify how the diff --git a/etc/NEWS b/etc/NEWS index 81a4273b0f..e46b3489ce 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1001,10 +1001,10 @@ window after starting). This variable defaults to nil. +++ *** New user options to control the look of line/column numbers in the mode line. 'mode-line-position-line-format' is the line number format (when -'line-number-mode' is on), and 'mode-line-position-column-format' is -the column number format (when 'column-number-mode' is on). These are -also used if both modes are on, which leads to the default in that -case going from "(5,9)" to "(L5,C9)". +'line-number-mode' is on), 'mode-line-position-column-format' is +the column number format (when 'column-number-mode' is on), and +'mode-line-position-column-line-format' is the combined format (when +both modes are on). +++ *** New command 'submit-emacs-patch'. diff --git a/lisp/bindings.el b/lisp/bindings.el index bc9cccde33..54e171e44b 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -411,6 +411,8 @@ zero, otherwise they start from one." :type 'boolean :group 'mode-line :version "26.1") +(make-obsolete-variable 'column-number-indicator-zero-based + 'mode-line-position-column-format "28.1") (defcustom mode-line-percent-position '(-3 "%p") "Specification of \"percentage offset\" of window through buffer. @@ -431,24 +433,41 @@ displayed in `mode-line-position', a component of the default :group 'mode-line) (put 'mode-line-percent-position 'risky-local-variable t) -(defcustom mode-line-position-line-format "L%l" +(defcustom mode-line-position-line-format '(-6 " L%l") "Format used to display line numbers in the mode line. This is used when `line-number-mode' is switched on. The \"%l\" format spec will be replaced by the line number." - :type 'string + :type 'form :version "28.1" :group 'mode-line) -(defcustom mode-line-position-column-format "C%c" +(defcustom mode-line-position-column-format '(-6 " C%c") "Format used to display column numbers in the mode line. This is used when `column-number-mode' is switched on. The \"%c\" format spec will be replaced by the column number, which is zero-based if `column-number-indicator-zero-based' is non-nil, -and one-based if `column-number-indicator-zero-based' is nil." - :type 'string +and one-based if `column-number-indicator-zero-based' is nil.." + :type 'form :version "28.1" :group 'mode-line) +(defcustom mode-line-position-column-line-format '(-10 " (%l,%c)") + "Format used to display combined line/column numbers in the mode line. +This is used when `column-number-mode' and `line-number-mode' are +switched on. The \"%c\" format spec will be replaced by the +column number, which is zero-based if +`column-number-indicator-zero-based' is non-nil, and one-based if +`column-number-indicator-zero-based' is nil." + :type 'form + :version "28.1" + :group 'mode-line) + +(defconst mode-line-position--column-line-properties + (list 'local-map mode-line-column-line-number-mode-map + 'mouse-face 'mode-line-highlight + 'help-echo "Line number and Column number\n\ +mouse-1: Display Line and Column Mode Menu")) + (defvar mode-line-position `((:propertize mode-line-percent-position @@ -468,44 +487,27 @@ mouse-1: Display Line and Column Mode Menu"))) (line-number-mode ((column-number-mode (column-number-indicator-zero-based - (10 ,(propertize - (format " (%s,%s)" - mode-line-position-line-format - mode-line-position-column-format) - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Line number and Column number\n\ -mouse-1: Display Line and Column Mode Menu")) - (10 ,(propertize - (format " (%s,%s)" - mode-line-position-line-format - (replace-in-string "%c" "%C" - mode-line-position-column-format)) - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Line number and Column number\n\ -mouse-1: Display Line and Column Mode Menu"))) - (6 ,(propertize - (format " %s" mode-line-position-line-format) - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Line Number\n\ -mouse-1: Display Line and Column Mode Menu")))) - ((column-number-mode - (column-number-indicator-zero-based - (5 ,(propertize - (format " %s" mode-line-position-column-format) - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Column number\n\ -mouse-1: Display Line and Column Mode Menu")) - (5 ,(propertize - (format " %s" (replace-in-string "%c" "%C" - mode-line-position-column-format)) - 'local-map mode-line-column-line-number-mode-map - 'mouse-face 'mode-line-highlight - 'help-echo "Column number\n\ -mouse-1: Display Line and Column Mode Menu"))))))) + (:propertize + mode-line-position-column-line-format + ,@mode-line-position--column-line-properties) + (:propertize + (,(car mode-line-position-column-line-format) + (:eval (replace-in-string + "%c" "%C" (cadr mode-line-position-column-line-format)))) + ,@mode-line-position--column-line-properties)) + (:propertize + mode-line-position-line-format + ,@mode-line-position--column-line-properties))) + (column-number-mode + (column-number-indicator-zero-based + (:propertize + mode-line-position-column-format + ,@mode-line-position--column-line-properties) + (:propertize + (,(car mode-line-position-column-format) + (:eval (replace-in-string + "%c" "%C" (cadr mode-line-position-column-format)))) + ,@mode-line-position--column-line-properties))))) "Mode line construct for displaying the position in the buffer. Normally displays the buffer percentage and, optionally, the buffer size, the line number and the column number.") commit c6291d6efec74a73cf01e8573aaa26f6c2201c3c Author: Andreas Schwab Date: Thu Sep 17 10:54:09 2020 +0200 Remove pointless use of intern * lisp/mwheel.el (mouse-wheel-left-event) (mouse-wheel-right-event): Replace use of intern with quoted symbol. * lisp/profiler.el (profiler-calltree-build-unified): Likewise. * lisp/vc/ediff-util.el (ediff-debug-info): Likewise. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 3b93bd1d5e..32fde0dd05 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -203,13 +203,13 @@ Also see `mouse-wheel-tilt-scroll'." (defvar mouse-wheel-left-event (if (or (featurep 'w32-win) (featurep 'ns-win)) 'wheel-left - (intern "mouse-6")) + 'mouse-6) "Event used for scrolling left.") (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win)) 'wheel-right - (intern "mouse-7")) + 'mouse-7) "Event used for scrolling right.") (defun mouse-wheel--get-scroll-window (event) diff --git a/lisp/profiler.el b/lisp/profiler.el index 0a5ddc1df4..bf8aacccc3 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -305,7 +305,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (let ((fun-map (make-hash-table :test 'profiler-function-equal)) (parent-map (make-hash-table :test 'eq)) (leftover-tree (profiler-make-calltree - :entry (intern "...") :parent tree))) + :entry '... :parent tree))) (push leftover-tree (profiler-calltree-children tree)) (maphash (lambda (backtrace _count) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 52878bad8a..e28d8574b1 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -4129,10 +4129,10 @@ Mail anyway? (y or n) ") (ediff-with-current-buffer standard-output (fundamental-mode)) (princ (format "\nCtl buffer: %S\n" ediff-control-buffer)) - (ediff-print-diff-vector (intern "ediff-difference-vector-A")) - (ediff-print-diff-vector (intern "ediff-difference-vector-B")) - (ediff-print-diff-vector (intern "ediff-difference-vector-C")) - (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor")) + (ediff-print-diff-vector 'ediff-difference-vector-A) + (ediff-print-diff-vector 'ediff-difference-vector-B) + (ediff-print-diff-vector 'ediff-difference-vector-C) + (ediff-print-diff-vector 'ediff-difference-vector-Ancestor) ))