From dafebe37ebe08d581506864e96058807d1aec56b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 Nov 2021 15:38:12 +0800 Subject: [PATCH 001/367] Use GTK native file choosers in xwidget callback * src/xwidget.c (run_file_chooser_cb): Use GtkFileChooserNative instead. --- src/xwidget.c | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index e5a5d9008d5..ca0392a44d6 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -791,7 +791,7 @@ run_file_chooser_cb (WebKitWebView *webview, gpointer user_data) { struct frame *f = SELECTED_FRAME (); - GtkWidget *chooser; + GtkFileChooserNative *chooser; GtkFileFilter *filter; bool select_multiple_p; guint response; @@ -806,25 +806,21 @@ run_file_chooser_cb (WebKitWebView *webview, if (!FRAME_WINDOW_P (f)) return TRUE; - chooser = gtk_file_chooser_dialog_new ("Select file", + chooser = gtk_file_chooser_native_new ("Select file", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - GTK_FILE_CHOOSER_ACTION_OPEN, - "Cancel", - GTK_RESPONSE_CANCEL, - "Select", - GTK_RESPONSE_ACCEPT, - NULL); + GTK_FILE_CHOOSER_ACTION_OPEN, "Select", + "Cancel"); filter = webkit_file_chooser_request_get_mime_types_filter (request); select_multiple_p = webkit_file_chooser_request_get_select_multiple (request); gtk_file_chooser_set_select_multiple (GTK_FILE_CHOOSER (chooser), select_multiple_p); gtk_file_chooser_add_filter (GTK_FILE_CHOOSER (chooser), filter); - response = gtk_dialog_run (GTK_DIALOG (chooser)); + response = gtk_native_dialog_run (GTK_NATIVE_DIALOG (chooser)); - if (response == GTK_RESPONSE_CANCEL) + if (response != GTK_RESPONSE_ACCEPT) { - gtk_widget_destroy (chooser); + gtk_native_dialog_destroy (GTK_NATIVE_DIALOG (chooser)); webkit_file_chooser_request_cancel (request); return TRUE; @@ -844,7 +840,7 @@ run_file_chooser_cb (WebKitWebView *webview, for (i = 0; i < len; ++i) g_free (files[i]); - gtk_widget_destroy (chooser); + gtk_native_dialog_destroy (GTK_NATIVE_DIALOG (chooser)); return TRUE; } From f32280bfa6342090abaa9f015d4cd70fb81bbfef Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 13 Nov 2021 10:05:36 +0100 Subject: [PATCH 002/367] Don't create links to undefined commands in help--describe-command * lisp/help.el (help--describe-command): Don't create links to commands that aren't defined. --- lisp/help.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index b2772f4389b..4470e6baaa4 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1328,9 +1328,11 @@ Return nil if the key sequence is too long." (defun help--describe-command (definition &optional translation) (cond ((symbolp definition) - (insert-text-button (symbol-name definition) - 'type 'help-function - 'help-args (list definition)) + (if (fboundp definition) + (insert-text-button (symbol-name definition) + 'type 'help-function + 'help-args (list definition)) + (insert (symbol-name definition))) (insert "\n")) ((or (stringp definition) (vectorp definition)) (if translation From 60a85834202dc4e117d3e5086ab210bcd293d659 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 13 Nov 2021 11:58:26 +0000 Subject: [PATCH 003/367] C++ Mode: Fix incoorect background fontification of < Where c-record-found-types gets "bound" to itself, we postpone the calling of c-fontify-new-type on possible new found types until these are confirmed by the return from the function tentatively finding these types, for exmaple c-forward-<>-arglist. We check this "binding" by testing the value of c-record-found-types. Correct the background fontification algorithm. * lisp/progmodes/cc-engine.el (c-record-found-types): Move the definition to earlier in the file. (c-add-type-1): Check additionally c-record-found-types is nil before calling c-fontify-new-found-type. (c-forward-<>-arglist, c-forward-type): On return from a function which collects found types in c-record-found-types, call c-fontify-new-found-types for each such type. * lisp/progmodes/c-fonts.el (c-force-redisplay): Actually fontify the new found type. (c-fontify-new-found-type): Test for font-lock-mode being enabled. Remove the spurious condition on the `fontified' text property being nil before causing c-force-redisplay to get called. --- lisp/progmodes/cc-engine.el | 28 ++++++++++++++++++++++------ lisp/progmodes/cc-fonts.el | 6 ++++-- 2 files changed, 26 insertions(+), 8 deletions(-) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index a4568bd4efc..c7b01de9b98 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6812,6 +6812,13 @@ comment at the start of cc-engine.el for more info." (defvar c-found-types nil) (make-variable-buffer-local 'c-found-types) +;; Dynamically bound variable that instructs `c-forward-type' to +;; record the ranges of types that only are found. Behaves otherwise +;; like `c-record-type-identifiers'. Also when this variable is non-nil, +;; `c-fontify-new-found-type' doesn't get called (yet) for the purported +;; type. +(defvar c-record-found-types nil) + (defsubst c-clear-found-types () ;; Clears `c-found-types'. (setq c-found-types @@ -6825,7 +6832,10 @@ comment at the start of cc-engine.el for more info." (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) (unless (gethash type c-found-types) (puthash type t c-found-types) - (when (and (eq (string-match c-symbol-key type) 0) + (when (and (not c-record-found-types) ; Only call `c-fontify-new-fount-type' + ; when we haven't "bound" c-found-types + ; to itself in c-forward-<>-arglist. + (eq (string-match c-symbol-key type) 0) (eq (match-end 0) (length type))) (c-fontify-new-found-type type))))) @@ -8225,11 +8235,6 @@ multi-line strings (but not C++, for example)." (setq c-record-ref-identifiers (cons range c-record-ref-identifiers)))))) -;; Dynamically bound variable that instructs `c-forward-type' to -;; record the ranges of types that only are found. Behaves otherwise -;; like `c-record-type-identifiers'. -(defvar c-record-found-types nil) - (defmacro c-forward-keyword-prefixed-id (type) ;; Used internally in `c-forward-keyword-clause' to move forward ;; over a type (if TYPE is 'type) or a name (otherwise) which @@ -8459,6 +8464,11 @@ multi-line strings (but not C++, for example)." (c-forward-<>-arglist-recur all-types))) (progn (when (consp c-record-found-types) + (let ((cur c-record-found-types)) + (while (consp (car-safe cur)) + (c-fontify-new-found-type + (buffer-substring-no-properties (caar cur) (cdar cur))) + (setq cur (cdr cur)))) (setq c-record-type-identifiers ;; `nconc' doesn't mind that the tail of ;; `c-record-found-types' is t. @@ -9184,6 +9194,12 @@ multi-line strings (but not C++, for example)." (when (and (eq res t) (consp c-record-found-types)) + ;; Cause the confirmed types to get fontified. + (let ((cur c-record-found-types)) + (while (consp (car-safe cur)) + (c-fontify-new-found-type + (buffer-substring-no-properties (caar cur) (cdar cur))) + (setq cur (cdr cur)))) ;; Merge in the ranges of any types found by the second ;; `c-forward-type'. (setq c-record-type-identifiers diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 9355409b2af..967464ac14d 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -101,6 +101,7 @@ (cc-bytecomp-defun c-font-lock-objc-method) (cc-bytecomp-defun c-font-lock-invalid-string) (cc-bytecomp-defun c-before-context-fl-expand-region) +(cc-bytecomp-defun c-font-lock-fontify-region) ;; Note that font-lock in XEmacs doesn't expand face names as @@ -2428,6 +2429,7 @@ higher." (defun c-force-redisplay (start end) ;; Force redisplay immediately. This assumes `font-lock-support-mode' is ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. + (save-excursion (c-font-lock-fontify-region start end)) (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) (setq c-re-redisplay-timer nil)) @@ -2436,7 +2438,8 @@ higher." ;; buffer. If TYPE is currently displayed in a window, cause redisplay to ;; happen "instantaneously". These actions are done only when jit-lock-mode ;; is active. - (when (and (boundp 'font-lock-support-mode) + (when (and font-lock-mode + (boundp 'font-lock-support-mode) (eq font-lock-support-mode 'jit-lock-mode)) (c-save-buffer-state ((window-boundaries @@ -2455,7 +2458,6 @@ higher." (dolist (win-boundary window-boundaries) (when (and (< (match-beginning 0) (cdr win-boundary)) (> (match-end 0) (car win-boundary)) - (c-get-char-property (match-beginning 0) 'fontified) (not c-re-redisplay-timer)) (setq c-re-redisplay-timer (run-with-timer 0 nil #'c-force-redisplay From 102406edb1d387bcb3c82ac320c30da5bd705194 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 Nov 2021 20:03:05 +0800 Subject: [PATCH 004/367] Don't emit SELECT_WINDOW_EVENT when an xwidget is scrolled * src/xterm.c (handle_one_event): Don't select xwidget window on button event if the button pressed actually represents the scroll wheel. --- src/xterm.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/xterm.c b/src/xterm.c index 172abe919dd..4492db85029 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9304,7 +9304,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, event->xbutton.button, event->xbutton.state, event->xbutton.time); - if (!EQ (selected_window, xvw->w)) + if (!EQ (selected_window, xvw->w) + && ((event->xbutton.button < 3) + || (event->xbutton.button > 7))) { inev.ie.kind = SELECT_WINDOW_EVENT; inev.ie.frame_or_window = xvw->w; From f740becf8ad1fdd992fb509edb10ff041f163c8f Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 13 Nov 2021 12:58:23 +0000 Subject: [PATCH 005/367] Correct patch from 2021-11-12 on src/fileio.c * src/fileio.c (restore_window_points): Reverse commit 974192413f8a81171b8fd28dfd5c081ce06d3dec and instead replace a < by a <=. This ensures that if w->mpoint is at the top of the middle region being replaced, it gets adjusted and stays at the top after the reinsertion. --- src/fileio.c | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/fileio.c b/src/fileio.c index a7b1649fae8..4015448ecee 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3827,20 +3827,17 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted, Lisp_Object car = XCAR (window_markers); Lisp_Object marker = XCAR (car); Lisp_Object oldpos = XCDR (car); - ptrdiff_t newpos; if (MARKERP (marker) && FIXNUMP (oldpos) && XFIXNUM (oldpos) > same_at_start - && XFIXNUM (oldpos) < same_at_end) + && XFIXNUM (oldpos) <= same_at_end) { ptrdiff_t oldsize = same_at_end - same_at_start; ptrdiff_t newsize = inserted; double growth = newsize / (double)oldsize; - newpos = same_at_start - + growth * (XFIXNUM (oldpos) - same_at_start); + ptrdiff_t newpos + = same_at_start + growth * (XFIXNUM (oldpos) - same_at_start); + Fset_marker (marker, make_fixnum (newpos), Qnil); } - else - newpos = XFIXNUM (oldpos); - Fset_marker (marker, make_fixnum (newpos), Qnil); } } From 89d7a71ce6a7338e4650409f16e419a53fff9723 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Nov 2021 15:22:12 +0200 Subject: [PATCH 006/367] Fix font selection via :family on MS-Windows * src/font.c (font_delete_unmatched) [HAVE_NTGUI]: Allow non-exact matches of :weight when looking for a suitable font. (Bug#51768) --- src/font.c | 29 +++++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/src/font.c b/src/font.c index f70054ea408..420a4f8e70e 100644 --- a/src/font.c +++ b/src/font.c @@ -2759,10 +2759,31 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) continue; } for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++) - if (FIXNUMP (AREF (spec, prop)) - && ((XFIXNUM (AREF (spec, prop)) >> 8) - != (XFIXNUM (AREF (entity, prop)) >> 8))) - prop = FONT_SPEC_MAX; + { + if (FIXNUMP (AREF (spec, prop))) + { + int required = XFIXNUM (AREF (spec, prop)) >> 8; + int candidate = XFIXNUM (AREF (entity, prop)) >> 8; + + if (candidate != required +#ifdef HAVE_NTGUI + /* A kludge for w32 font search, where listing a + family returns only 4 standard weights: regular, + italic, bold, bold-italic. For other values one + must specify the font, not just the family in the + :family attribute of the face. But specifying + :family in the face attributes looks for regular + weight, so if we require exact match, the + non-regular font will be rejected. So we relax + the accuracy of the match here, and let + font_sort_entities find the best match. */ + && (prop != FONT_WEIGHT_INDEX + || eabs (candidate - required) > 100) +#endif + ) + prop = FONT_SPEC_MAX; + } + } if (prop < FONT_SPEC_MAX && size && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) From f7abc04c4002a2fc7dc7c8c9ec2a264e25aaf5f5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 Nov 2021 21:37:06 +0800 Subject: [PATCH 007/367] Fix scroll event test in handle_one_xevent * src/xterm.c (handle_one_xevent): Test for scroll wheel button correctly in xwidget code. --- src/xterm.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 4492db85029..fd498c0e32b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9304,10 +9304,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, event->xbutton.button, event->xbutton.state, event->xbutton.time); - if (!EQ (selected_window, xvw->w) - && ((event->xbutton.button < 3) - || (event->xbutton.button > 7))) - { + if (!EQ (selected_window, xvw->w) && (event->xbutton.button < 4)) + { inev.ie.kind = SELECT_WINDOW_EVENT; inev.ie.frame_or_window = xvw->w; } From aa88845a170fef902fdd7d757b0f178ce41fe816 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 13 Nov 2021 15:14:02 +0100 Subject: [PATCH 008/367] Remove Tramp's `dired-compress-file' handler, not needed anymore * lisp/dired-aux.el (dired-check-process, dired-shell-command): Call `dired-uncache'. (dired-compress-file): Use `file-local-name'. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Remove superfluous comment. * lisp/net/tramp-sh.el (dired-compress-file): Declare. (tramp-sh-handle-dired-compress-file): Call real handler for Emacs >= 29. * lisp/net/tramp.el (tramp-file-name-for-operation): Reorder list. * test/lisp/net/tramp-tests.el (tramp-test45-dired-compress-file) (tramp-test45-dired-compress-dir): Adapt comment. --- lisp/dired-aux.el | 21 ++++--- lisp/icomplete.el | 2 +- lisp/net/tramp-adb.el | 1 - lisp/net/tramp-archive.el | 1 - lisp/net/tramp-crypt.el | 1 - lisp/net/tramp-gvfs.el | 1 - lisp/net/tramp-rclone.el | 1 - lisp/net/tramp-sh.el | 104 ++++++++++++++++++----------------- lisp/net/tramp-smb.el | 1 - lisp/net/tramp-sshfs.el | 1 - lisp/net/tramp-sudoedit.el | 1 - lisp/net/tramp.el | 29 +++++----- test/lisp/net/tramp-tests.el | 6 +- 13 files changed, 86 insertions(+), 84 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 7d81d45326f..92409db33ea 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1007,6 +1007,7 @@ Else returns nil for success." (erase-buffer) (setq default-directory dir ; caller's default-directory err (not (eq 0 (apply #'process-file program nil t nil arguments)))) + (dired-uncache dir) (if err (progn (dired-log (concat program " " (prin1-to-string arguments) "\n")) @@ -1032,6 +1033,7 @@ Return the result of `process-file' - zero for success." nil shell-command-switch cmd))) + (dired-uncache dir) (unless (zerop res) (pop-to-buffer out-buffer)) res)))) @@ -1280,9 +1282,9 @@ Return nil if no change in files." (prog1 (setq newname (file-name-as-directory newname)) (dired-shell-command (replace-regexp-in-string - "%o" (shell-quote-argument newname) + "%o" (shell-quote-argument (file-local-name newname)) (replace-regexp-in-string - "%i" (shell-quote-argument file) + "%i" (shell-quote-argument (file-local-name file)) command nil t) nil t))) @@ -1293,10 +1295,10 @@ Return nil if no change in files." (dired-check-process msg (substring command 0 match) (substring command (1+ match)) - file) + (file-local-name file)) (dired-check-process msg command - file)) + (file-local-name file))) newname)))) (t ;; We don't recognize the file as compressed, so compress it. @@ -1314,7 +1316,8 @@ Return nil if no change in files." (default-directory (file-name-directory file))) (dired-shell-command (replace-regexp-in-string - "%o" (shell-quote-argument out-name) + "%o" (shell-quote-argument + (file-local-name out-name)) (replace-regexp-in-string "%i" (shell-quote-argument (file-name-nondirectory file)) @@ -1344,9 +1347,10 @@ see `dired-compress-file-alist' for the supported suffixes list" out-name))) (dired-shell-command (replace-regexp-in-string - "%o" (shell-quote-argument out-name) + "%o" (shell-quote-argument + (file-local-name out-name)) (replace-regexp-in-string - "%i" (shell-quote-argument file) + "%i" (shell-quote-argument (file-local-name file)) (cdr rule) nil t) nil t)) @@ -1361,7 +1365,8 @@ see `dired-compress-file-alist' for the supported suffixes list" out-name))))) (file-error (if (not (dired-check-process (concat "Compressing " file) - "compress" "-f" file)) + "compress" "-f" + (file-local-name file))) ;; Don't use NEWNAME with `compress'. (concat file ".Z")))))))) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index f909a3b1771..8ead8a6217c 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -418,7 +418,7 @@ if that doesn't produce a completion match." icomplete-show-matches-on-no-input t icomplete-hide-common-prefix nil icomplete-scroll (not (null icomplete-vertical-mode)) - completion-styles '(flex) + completion-styles '(flex basic) completion-flex-nospace nil completion-category-defaults nil completion-ignore-case t diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 374e5db5879..895543d6db9 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -119,7 +119,6 @@ It is used for TCP/IP devices." (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-adb-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . tramp-adb-handle-exec-path) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 578f9fcf913..3e0d876dd9e 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -223,7 +223,6 @@ It must be supported by libarchive(3).") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . tramp-archive-handle-not-implemented) (dired-uncache . tramp-archive-handle-dired-uncache) (exec-path . ignore) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index f431f975633..42b67ac7a8e 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -169,7 +169,6 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (directory-files . tramp-crypt-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 11de71aa0d9..220ce63c0f7 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -756,7 +756,6 @@ It has been changed in GVFS 1.14.") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index c997215a15b..28a1c01aa61 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -83,7 +83,6 @@ (directory-files . tramp-fuse-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 533ddcf66ea..c61025a86b2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -34,6 +34,8 @@ (eval-when-compile (require 'cl-lib)) (require 'tramp) +;; `dired-*' declarations can be removed, starting with Emacs 29.1. +(declare-function dired-compress-file "dired-aux") (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) (defvar process-file-return-signal-string) @@ -952,7 +954,8 @@ Format specifiers \"%s\" are replaced before the script is used.") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-sh-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. + ;; Starting with Emacs 29.1, `dired-compress-file' performed by + ;; default handler. (dired-compress-file . tramp-sh-handle-dired-compress-file) (dired-uncache . tramp-handle-dired-uncache) (exec-path . tramp-sh-handle-exec-path) @@ -2472,57 +2475,60 @@ The method used must be an out-of-band method." ;; Dired. -;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (defun tramp-sh-handle-dired-compress-file (file) "Like `dired-compress-file' for Tramp files." - ;; Code stolen mainly from dired-aux.el. - (with-parsed-tramp-file-name file nil - (tramp-flush-file-properties v localname) - (let ((suffixes dired-compress-file-suffixes) - suffix) - ;; See if any suffix rule matches this file name. - (while suffixes - (let (case-fold-search) - (if (string-match-p (car (car suffixes)) localname) - (setq suffix (car suffixes) suffixes nil)) - (setq suffixes (cdr suffixes)))) + ;; Starting with Emacs 29.1, `dired-compress-file' is performed by + ;; default handler. + (if (>= emacs-major-version 29) + (tramp-run-real-handler #'dired-compress-file (list file)) + ;; Code stolen mainly from dired-aux.el. + (with-parsed-tramp-file-name file nil + (tramp-flush-file-properties v localname) + (let ((suffixes dired-compress-file-suffixes) + suffix) + ;; See if any suffix rule matches this file name. + (while suffixes + (let (case-fold-search) + (if (string-match-p (car (car suffixes)) localname) + (setq suffix (car suffixes) suffixes nil)) + (setq suffixes (cdr suffixes)))) - (cond ((file-symlink-p file) nil) - ((and suffix (nth 2 suffix)) - ;; We found an uncompression rule. - (with-tramp-progress-reporter - v 0 (format "Uncompressing %s" file) - (when (tramp-send-command-and-check - v (if (string-match-p "%[io]" (nth 2 suffix)) - (replace-regexp-in-string - "%i" (tramp-shell-quote-argument localname) - (nth 2 suffix)) - (concat (nth 2 suffix) " " - (tramp-shell-quote-argument localname)))) - (unless (string-match-p "\\.tar\\.gz" file) - (dired-remove-file file)) - (string-match (car suffix) file) - (concat (substring file 0 (match-beginning 0)))))) - (t - ;; We don't recognize the file as compressed, so compress it. - ;; Try gzip. - (with-tramp-progress-reporter v 0 (format "Compressing %s" file) - (when (tramp-send-command-and-check - v (if (file-directory-p file) - (format "tar -cf - %s | gzip -c9 > %s.tar.gz" - (tramp-shell-quote-argument - (file-name-nondirectory localname)) - (tramp-shell-quote-argument localname)) - (concat "gzip -f " - (tramp-shell-quote-argument localname)))) - (unless (file-directory-p file) - (dired-remove-file file)) - (catch 'found nil - (dolist (target (mapcar (lambda (suffix) - (concat file suffix)) - '(".tar.gz" ".gz" ".z"))) - (when (file-exists-p target) - (throw 'found target))))))))))) + (cond ((file-symlink-p file) nil) + ((and suffix (nth 2 suffix)) + ;; We found an uncompression rule. + (with-tramp-progress-reporter + v 0 (format "Uncompressing %s" file) + (when (tramp-send-command-and-check + v (if (string-match-p "%[io]" (nth 2 suffix)) + (replace-regexp-in-string + "%i" (tramp-shell-quote-argument localname) + (nth 2 suffix)) + (concat (nth 2 suffix) " " + (tramp-shell-quote-argument localname)))) + (unless (string-match-p "\\.tar\\.gz" file) + (dired-remove-file file)) + (string-match (car suffix) file) + (concat (substring file 0 (match-beginning 0)))))) + (t + ;; We don't recognize the file as compressed, so + ;; compress it. Try gzip. + (with-tramp-progress-reporter v 0 (format "Compressing %s" file) + (when (tramp-send-command-and-check + v (if (file-directory-p file) + (format "tar -cf - %s | gzip -c9 > %s.tar.gz" + (tramp-shell-quote-argument + (file-name-nondirectory localname)) + (tramp-shell-quote-argument localname)) + (concat "gzip -f " + (tramp-shell-quote-argument localname)))) + (unless (file-directory-p file) + (dired-remove-file file)) + (catch 'found nil + (dolist (target (mapcar (lambda (suffix) + (concat file suffix)) + '(".tar.gz" ".gz" ".z"))) + (when (file-exists-p target) + (throw 'found target)))))))))))) (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index ac567dc0747..0b25164902e 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -234,7 +234,6 @@ See `tramp-actions-before-shell' for more info.") (directory-files . tramp-smb-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index fc77d998aa6..a9d8dc933b3 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -83,7 +83,6 @@ (directory-files . tramp-fuse-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . tramp-sshfs-handle-exec-path) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 842990488ef..7cf0ea451d2 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -75,7 +75,6 @@ See `tramp-actions-before-shell' for more info.") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f4493608a46..876bbb2c545 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2476,28 +2476,25 @@ Must be handled by the callers." '(access-file byte-compiler-base-file-name delete-directory delete-file diff-latest-backup-file directory-file-name directory-files directory-files-and-attributes - dired-uncache file-acl file-accessible-directory-p - file-attributes file-directory-p file-executable-p - file-exists-p file-local-copy file-modes - file-name-as-directory file-name-case-insensitive-p - file-name-directory file-name-nondirectory - file-name-sans-versions file-notify-add-watch - file-ownership-preserved-p file-readable-p - file-regular-p file-remote-p file-selinux-context - file-symlink-p file-truename file-writable-p - find-backup-file-name get-file-buffer insert-directory - insert-file-contents load make-directory - make-directory-internal set-file-acl set-file-modes - set-file-selinux-context set-file-times + dired-compress-file dired-uncache file-acl + file-accessible-directory-p file-attributes + file-directory-p file-executable-p file-exists-p + file-local-copy file-modes file-name-as-directory + file-name-case-insensitive-p file-name-directory + file-name-nondirectory file-name-sans-versions + file-notify-add-watch file-ownership-preserved-p + file-readable-p file-regular-p file-remote-p + file-selinux-context file-symlink-p file-truename + file-writable-p find-backup-file-name get-file-buffer + insert-directory insert-file-contents load + make-directory make-directory-internal set-file-acl + set-file-modes set-file-selinux-context set-file-times substitute-in-file-name unhandled-file-name-directory vc-registered ;; Emacs 27+ only. file-system-info ;; Emacs 28+ only. file-locked-p lock-file make-lock-file-name unlock-file - ;; Starting with Emacs 29.1, `dired-compress-file' isn't - ;; magic anymore. - dired-compress-file ;; Tramp internal magic file name function. tramp-set-file-uid-gid)) (if (file-name-absolute-p (nth 0 args)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 397e707f136..52c6159dc12 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6935,7 +6935,8 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. + ;; Starting with Emacs 29.1, `dired-compress-file' is performed by + ;; default handler. (skip-unless (not (tramp--test-emacs29-p))) (let ((default-directory tramp-test-temporary-file-directory) @@ -6955,7 +6956,8 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) - ;; Starting with Emacs 29.1, `dired-compress-file' isn't magic anymore. + ;; Starting with Emacs 29.1, `dired-compress-file' is performed by + ;; default handler. (skip-unless (not (tramp--test-emacs29-p))) (let ((default-directory tramp-test-temporary-file-directory) From d3666ccdba7c3837ffffe3c50a179c110ed55569 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 13 Nov 2021 15:26:42 +0100 Subject: [PATCH 009/367] Revert accidential commit in icomplete.el --- lisp/icomplete.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 8ead8a6217c..f909a3b1771 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -418,7 +418,7 @@ if that doesn't produce a completion match." icomplete-show-matches-on-no-input t icomplete-hide-common-prefix nil icomplete-scroll (not (null icomplete-vertical-mode)) - completion-styles '(flex basic) + completion-styles '(flex) completion-flex-nospace nil completion-category-defaults nil completion-ignore-case t From a56dd60d2fba9d873748ca3831ba61711628f698 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Nov 2021 16:37:39 +0200 Subject: [PATCH 010/367] Improve style and comments in font-related sources * src/w32font.c (fill_in_logfont): Stylistic changes. * src/font.h (font_property_index, font_select_entity): Add/improve comments. --- src/font.c | 25 ++++++++++++++++++++++--- src/font.h | 7 ++++--- src/w32font.c | 8 ++------ 3 files changed, 28 insertions(+), 12 deletions(-) diff --git a/src/font.c b/src/font.c index 6cd4a6b5c11..c0050a99cfe 100644 --- a/src/font.c +++ b/src/font.c @@ -3151,8 +3151,9 @@ font_clear_prop (Lisp_Object *attrs, enum font_property_index prop) attrs[LFACE_FONT_INDEX] = font; } -/* Select a font from ENTITIES (list of font-entity vectors) that - supports C and is the best match for ATTRS and PIXEL_SIZE. */ +/* Select a font from ENTITIES (list of one or more font-entity + vectors) that supports the character C (if non-negative) and is the + best match for ATTRS and PIXEL_SIZE. */ static Lisp_Object font_select_entity (struct frame *f, Lisp_Object entities, @@ -3162,6 +3163,7 @@ font_select_entity (struct frame *f, Lisp_Object entities, Lisp_Object prefer; int i; + /* If we have a single candidate, return it if it supports C. */ if (NILP (XCDR (entities)) && ASIZE (XCAR (entities)) == 1) { @@ -3171,7 +3173,10 @@ font_select_entity (struct frame *f, Lisp_Object entities, return Qnil; } - /* Sort fonts by properties specified in ATTRS. */ + /* If we have several candidates, find the best match by sorting + them by properties specified in ATTRS. Style attributes (weight, + slant, width, and size) are taken from the font spec in ATTRS (if + that is non-nil), or from ATTRS, or left as nil. */ prefer = scratch_font_prefer; for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++) @@ -3208,6 +3213,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int int i, j, k, l; USE_SAFE_ALLOCA; + /* Registry specification alternatives: from the most specific to + the least specific and finally an unspecified one. */ registry[0] = AREF (spec, FONT_REGISTRY_INDEX); if (NILP (registry[0])) { @@ -3244,6 +3251,9 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int pixel_size = 1; } ASET (work, FONT_SIZE_INDEX, Qnil); + + /* Foundry specification alternatives: from the most specific to the + least specific and finally an unspecified one. */ foundry[0] = AREF (work, FONT_FOUNDRY_INDEX); if (! NILP (foundry[0])) foundry[1] = zero_vector; @@ -3257,6 +3267,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int else foundry[0] = Qnil, foundry[1] = zero_vector; + /* Additional style specification alternatives: from the most + specific to the least specific and finally an unspecified one. */ adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX); if (! NILP (adstyle[0])) adstyle[1] = zero_vector; @@ -3277,6 +3289,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int adstyle[0] = Qnil, adstyle[1] = zero_vector; + /* Family specification alternatives: from the most specific to + the least specific and finally an unspecified one. */ val = AREF (work, FONT_FAMILY_INDEX); if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX])) { @@ -3316,6 +3330,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int } } + /* Now look up suitable fonts, from the most specific spec to the + least specific spec. Accept the first one that matches. */ for (i = 0; SYMBOLP (family[i]); i++) { ASET (work, FONT_FAMILY_INDEX, family[i]); @@ -3328,9 +3344,12 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int for (l = 0; SYMBOLP (adstyle[l]); l++) { ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]); + /* Produce the list of candidates for the spec in WORK. */ entities = font_list_entities (f, work); if (! NILP (entities)) { + /* If there are several candidates, select the + best match for PIXEL_SIZE and attributes in ATTRS. */ val = font_select_entity (f, entities, attrs, pixel_size, c); if (! NILP (val)) diff --git a/src/font.h b/src/font.h index 1da72cca079..6694164e09b 100644 --- a/src/font.h +++ b/src/font.h @@ -69,9 +69,10 @@ INLINE_HEADER_BEGIN enum font_property_index { - /* FONT-TYPE is a symbol indicating a font backend; currently `x' - and `xft' are available on X, `uniscribe' and `gdi' on - Windows, and `ns' under Cocoa / GNUstep. */ + /* FONT-TYPE is a symbol indicating a font backend; currently `x', + `xft', `xfthb', `ftrc', and `ftcrhb' are available on X; + `harfbuzz', `uniscribe', and `gdi' on Windows, and `ns' under + Cocoa / GNUstep. */ FONT_TYPE_INDEX, /* FONT-FOUNDRY is a foundry name (symbol). */ diff --git a/src/w32font.c b/src/w32font.c index 6b9ab0468cd..3025d0efa88 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2019,13 +2019,9 @@ fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec) tmp = AREF (font_spec, FONT_DPI_INDEX); if (FIXNUMP (tmp)) - { - dpi = XFIXNUM (tmp); - } + dpi = XFIXNUM (tmp); else if (FLOATP (tmp)) - { - dpi = (int) (XFLOAT_DATA (tmp) + 0.5); - } + dpi = (int) (XFLOAT_DATA (tmp) + 0.5); /* Height */ tmp = AREF (font_spec, FONT_SIZE_INDEX); From 4df334a0f74700e72bfea7817e660605c3f2a2ee Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Sat, 13 Nov 2021 07:00:30 -0800 Subject: [PATCH 011/367] MH-E threads code: use mh-scan variables correctly * lisp/mh-e/mh-thread.el (mh-thread-current-indentation-level) (mh-thread-find-children): Fix off-by-one error by using 'mh-scan-field-from-start-offset' directly, as 'mh-thread-parse-scan-line' does. Previously, these functions would incorrectly consider the "date note" column as part of the thread indenting. Since that column is almost always a Space character, that almost always worked. (mh-thread-ancestor): Update caller. * test/lisp/mh-e/mh-thread-tests.el: New unit tests for affected code. * lisp/mh-e/mh-scan.el (mh-msg-num-width-to-column): Fix doc string typo. --- lisp/mh-e/mh-scan.el | 2 +- lisp/mh-e/mh-thread.el | 10 +-- test/lisp/mh-e/mh-thread-tests.el | 131 ++++++++++++++++++++++++++++++ 3 files changed, 137 insertions(+), 6 deletions(-) create mode 100644 test/lisp/mh-e/mh-thread-tests.el diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 5a1a671aee2..bf3cfeff5cb 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -509,7 +509,7 @@ with `mh-scan-msg-format-string'." Note that columns in Emacs start with 0. If `mh-scan-format-file' is set to \"Use MH-E scan Format\" this -means that either `mh-scan-format-mh' or `mh-scan-format-nmh' are +means that either `mh-scan-format-mh' or `mh-scan-format-nmh' is in use. This function therefore assumes that the first column is empty (to provide room for the cursor), the following WIDTH columns contain the message number, and the column for notations diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index 21954da6acd..1be2185ecdf 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -139,7 +139,7 @@ to the message that started everything." (cond (thread-root-flag (while (mh-thread-immediate-ancestor)) (mh-maybe-show)) - ((equal current-level 1) + ((equal current-level 0) (message "Message has no ancestor")) (t (mh-thread-immediate-ancestor) (mh-maybe-show))))) @@ -242,8 +242,8 @@ sibling." (defun mh-thread-current-indentation-level () "Find the number of spaces by which current message is indented." (save-excursion - (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width - mh-scan-date-width 1)) + (let ((address-start-offset (+ mh-cmd-note + mh-scan-field-from-start-offset)) (level 0)) (beginning-of-line) (forward-char address-start-offset) @@ -275,8 +275,8 @@ at the end." (beginning-of-line) (if (eobp) nil - (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width - mh-scan-date-width 1)) + (let ((address-start-offset (+ mh-cmd-note + mh-scan-field-from-start-offset)) (level (mh-thread-current-indentation-level)) spaces begin) (setq begin (point)) diff --git a/test/lisp/mh-e/mh-thread-tests.el b/test/lisp/mh-e/mh-thread-tests.el new file mode 100644 index 00000000000..4f09677e53f --- /dev/null +++ b/test/lisp/mh-e/mh-thread-tests.el @@ -0,0 +1,131 @@ +;;; mh-thread-tests.el --- tests for mh-thread.el -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'mh-thread) +(eval-when-compile (require 'cl-lib)) + +(defun mh-thread-tests-before-from () + "Generate the fields of a scan line up to where the 'From' field would start. +The exact contents are not important, but the number of characters is." + (concat (make-string mh-cmd-note ?9) + (make-string mh-scan-cmd-note-width ?A) + (make-string mh-scan-destination-width ?t) + (make-string mh-scan-date-width ?/) + (make-string mh-scan-date-flag-width ?*))) + +;;; Tests of support routines + +(ert-deftest mh-thread-current-indentation-level () + "Test that `mh-thread-current-indentation-level' identifies the level." + (with-temp-buffer + (insert (mh-thread-tests-before-from) "[Sender One] Subject of msg 1\n") + (insert (mh-thread-tests-before-from) " [Sender Two] Subject of msg 2\n") + (goto-char (point-min)) + (should (equal 0 (mh-thread-current-indentation-level))) + (forward-line) + (should (equal 2 (mh-thread-current-indentation-level))))) + +(ert-deftest mh-thread-find-children () + "Test `mh-thread-find-children'." + (let (expected-start expected-end) + (with-temp-buffer + (insert (mh-thread-tests-before-from) "[Sender One] line 1\n") + (setq expected-start (point)) + (insert (mh-thread-tests-before-from) " [Sender Two] line 2\n") + (insert (mh-thread-tests-before-from) " [Sender Three] line 3\n") + (insert (mh-thread-tests-before-from) " [Sender Four] line 4\n") + (setq expected-end (1- (point))) + (insert (mh-thread-tests-before-from) " [Sender Five] line 5\n") + (goto-char (1+ expected-start)) + (should (equal (list expected-start expected-end) + (mh-thread-find-children)))))) + +(ert-deftest mh-thread-immediate-ancestor () + "Test that `mh-thread-immediate-ancestor' moves to the correct message." + (with-temp-buffer + (insert (mh-thread-tests-before-from) "[Sender Other] line 1\n") + (insert (mh-thread-tests-before-from) "[Sender One] line 2\n") + (insert (mh-thread-tests-before-from) " [Sender Two] line 3\n") + (insert (mh-thread-tests-before-from) " [Sender Three] line 4\n") + (insert (mh-thread-tests-before-from) " [Sender Four] line 5\n") + (insert (mh-thread-tests-before-from) " [Sender Five] line 6\n") + (forward-line -1) + (should (equal (line-number-at-pos) 6)) + (mh-thread-immediate-ancestor) + (should (equal (line-number-at-pos) 4)) ;skips over sibling + (mh-thread-immediate-ancestor) + (should (equal (line-number-at-pos) 3)) ;goes up only one level at a time + (mh-thread-immediate-ancestor) + (should (equal (line-number-at-pos) 2)) + (mh-thread-immediate-ancestor) + (should (equal (line-number-at-pos) 2)))) ;no further motion at thread root + +;;; Tests of MH-Folder Commands + +(ert-deftest mh-thread-sibling-and-ancestor () + "Test motion by `mh-thread-ancestor' and `mh-thread-next-sibling'." + (with-temp-buffer + (insert (mh-thread-tests-before-from) "[Sender Other] line 1\n") + (insert (mh-thread-tests-before-from) "[Sender One] line 2\n") + (insert (mh-thread-tests-before-from) " [Sender Two] line 3\n") + (insert (mh-thread-tests-before-from) " [Sender Three] line 4\n") + (insert (mh-thread-tests-before-from) " [Sender Four] line 5\n") + (insert (mh-thread-tests-before-from) " [Sender Five] line 6\n") + (forward-line -1) + (let ((mh-view-ops '(unthread)) + (show-count 0)) + (cl-letf (((symbol-function 'mh-maybe-show) + (lambda () + (setq show-count (1+ show-count))))) + (should (equal (line-number-at-pos) 6)) + ;; test mh-thread-ancestor + (mh-thread-ancestor) + (should (equal (line-number-at-pos) 4)) ;skips over sibling + (should (equal show-count 1)) + (mh-thread-ancestor t) + (should (equal (line-number-at-pos) 2)) ;root flag skips to root + (should (equal show-count 2)) + (mh-thread-ancestor) + (should (equal (line-number-at-pos) 2)) ;do not move from root + (should (equal show-count 2)) ;do not re-show at root + ;; test mh-thread-sibling + (mh-thread-next-sibling) + (should (equal (line-number-at-pos) 2)) ;no next sibling, no motion + (should (equal show-count 2)) ;no sibling, no show + (mh-thread-next-sibling t) + (should (equal (line-number-at-pos) 1)) + (should (equal show-count 3)) + (mh-thread-next-sibling t) + (should (equal (line-number-at-pos) 1)) ;no previous sibling + (should (equal show-count 3)) + (goto-char (point-max)) + (forward-line -1) + (should (equal (line-number-at-pos) 6)) + (mh-thread-next-sibling t) + (should (equal (line-number-at-pos) 5)) + (should (equal show-count 4)) + (mh-thread-next-sibling t) + (should (equal (line-number-at-pos) 5)) ;no previous sibling + (should (equal show-count 4)) + )))) + +;;; mh-thread-tests.el ends here From cc4edea872ca653f3e0631ce50e47b5260c6773a Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Wed, 30 Dec 2020 14:42:01 +0100 Subject: [PATCH 012/367] Use posix_spawn if possible. posix_spawn is less error-prone than vfork + execve, and can make better use of system-specific enhancements like 'clone' on Linux. Use it if we don't need to configure a pseudoterminal. Backported from commit a60053f8368e058229721f1bf1567c2b1676b239. Unlike that commit, only define USABLE_POSIX_SPAWN on macOS, because there posix_spawn is much faster than vfork. Don't merge to master. * configure.ac (HAVE_SPAWN_H, HAVE_POSIX_SPAWN) (HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR) (HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) (HAVE_POSIX_SPAWNATTR_SETFLAGS, HAVE_DECL_POSIX_SPAWN_SETSID): New configuration variables. * src/callproc.c (USABLE_POSIX_SPAWN): New configuration macro. (emacs_posix_spawn_init_actions) (emacs_posix_spawn_init_attributes, emacs_posix_spawn_init): New helper functions. (emacs_spawn): Use posix_spawn if possible. (cherry picked from commit a60053f8368e058229721f1bf1567c2b1676b239) --- configure.ac | 17 +++++ src/callproc.c | 190 ++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 206 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 6bc194d792f..253f5bfcd67 100644 --- a/configure.ac +++ b/configure.ac @@ -4746,6 +4746,23 @@ dnl AC_CHECK_FUNCS_ONCE wouldn’t be right for snprintf, which needs dnl the current CFLAGS etc. AC_CHECK_FUNCS(snprintf) +dnl posix_spawn. The chdir and setsid functionality is relatively +dnl recent, so we check for it specifically. +AC_CHECK_HEADERS([spawn.h]) +AC_SUBST([HAVE_SPAWN_H]) +AC_CHECK_FUNCS([posix_spawn \ + posix_spawn_file_actions_addchdir \ + posix_spawn_file_actions_addchdir_np \ + posix_spawnattr_setflags]) +AC_SUBST([HAVE_POSIX_SPAWN]) +AC_SUBST([HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR]) +AC_SUBST([HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP]) +AC_SUBST([HAVE_POSIX_SPAWNATTR_SETFLAGS]) +AC_CHECK_DECLS([POSIX_SPAWN_SETSID], [], [], [[ + #include + ]]) +AC_SUBST([HAVE_DECL_POSIX_SPAWN_SETSID]) + dnl Check for glib. This differs from other library checks in that dnl Emacs need not link to glib unless some other library is already dnl linking to glib. Although glib provides no facilities that Emacs diff --git a/src/callproc.c b/src/callproc.c index fa43f973844..4aa24636c35 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -28,6 +28,21 @@ along with GNU Emacs. If not, see . */ #include #include +/* In order to be able to use `posix_spawn', it needs to support some + variant of `chdir' as well as `setsid'. */ +#if defined DARWIN_OS \ + && defined HAVE_SPAWN_H && defined HAVE_POSIX_SPAWN \ + && defined HAVE_POSIX_SPAWNATTR_SETFLAGS \ + && (defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR \ + || defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) \ + && defined HAVE_DECL_POSIX_SPAWN_SETSID \ + && HAVE_DECL_POSIX_SPAWN_SETSID == 1 +# include +# define USABLE_POSIX_SPAWN 1 +#else +# define USABLE_POSIX_SPAWN 0 +#endif + #include "lisp.h" #ifdef SETUP_SLAVE_PTY @@ -1247,6 +1262,130 @@ child_setup (int in, int out, int err, char **new_argv, char **env, #endif /* not WINDOWSNT */ } +#if USABLE_POSIX_SPAWN + +/* Set up ACTIONS and ATTRIBUTES for `posix_spawn'. Return an error + number. */ + +static int +emacs_posix_spawn_init_actions (posix_spawn_file_actions_t *actions, + int std_in, int std_out, int std_err, + const char *cwd) +{ + int error = posix_spawn_file_actions_init (actions); + if (error != 0) + return error; + + error = posix_spawn_file_actions_adddup2 (actions, std_in, + STDIN_FILENO); + if (error != 0) + goto out; + + error = posix_spawn_file_actions_adddup2 (actions, std_out, + STDOUT_FILENO); + if (error != 0) + goto out; + + error = posix_spawn_file_actions_adddup2 (actions, + std_err < 0 ? std_out + : std_err, + STDERR_FILENO); + if (error != 0) + goto out; + + error = +#ifdef HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR + posix_spawn_file_actions_addchdir +#else + posix_spawn_file_actions_addchdir_np +#endif + (actions, cwd); + if (error != 0) + goto out; + + out: + if (error != 0) + posix_spawn_file_actions_destroy (actions); + return error; +} + +static int +emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes) +{ + int error = posix_spawnattr_init (attributes); + if (error != 0) + return error; + + error = posix_spawnattr_setflags (attributes, + POSIX_SPAWN_SETSID + | POSIX_SPAWN_SETSIGDEF + | POSIX_SPAWN_SETSIGMASK); + if (error != 0) + goto out; + + sigset_t sigdefault; + sigemptyset (&sigdefault); + +#ifdef DARWIN_OS + /* Work around a macOS bug, where SIGCHLD is apparently + delivered to a vforked child instead of to its parent. See: + https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html + */ + sigaddset (&sigdefault, SIGCHLD); +#endif + + sigaddset (&sigdefault, SIGINT); + sigaddset (&sigdefault, SIGQUIT); +#ifdef SIGPROF + sigaddset (&sigdefault, SIGPROF); +#endif + + /* Emacs ignores SIGPIPE, but the child should not. */ + sigaddset (&sigdefault, SIGPIPE); + /* Likewise for SIGPROF. */ +#ifdef SIGPROF + sigaddset (&sigdefault, SIGPROF); +#endif + + error = posix_spawnattr_setsigdefault (attributes, &sigdefault); + if (error != 0) + goto out; + + /* Stop blocking SIGCHLD in the child. */ + sigset_t oldset; + error = pthread_sigmask (SIG_SETMASK, NULL, &oldset); + if (error != 0) + goto out; + error = posix_spawnattr_setsigmask (attributes, &oldset); + if (error != 0) + goto out; + + out: + if (error != 0) + posix_spawnattr_destroy (attributes); + + return error; +} + +static int +emacs_posix_spawn_init (posix_spawn_file_actions_t *actions, + posix_spawnattr_t *attributes, int std_in, + int std_out, int std_err, const char *cwd) +{ + int error = emacs_posix_spawn_init_actions (actions, std_in, + std_out, std_err, cwd); + if (error != 0) + return error; + + error = emacs_posix_spawn_init_attributes (attributes); + if (error != 0) + return error; + + return 0; +} + +#endif + /* Start a new asynchronous subprocess. If successful, return zero and store the process identifier of the new process in *NEWPID. Use STDIN, STDOUT, and STDERR as standard streams for the new @@ -1266,10 +1405,58 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, char **argv, char **envp, const char *cwd, const char *pty, const sigset_t *oldset) { +#if USABLE_POSIX_SPAWN + /* Prefer the simpler `posix_spawn' if available. `posix_spawn' + doesn't yet support setting up pseudoterminals, so we fall back + to `vfork' if we're supposed to use a pseudoterminal. */ + + bool use_posix_spawn = pty == NULL; + + posix_spawn_file_actions_t actions; + posix_spawnattr_t attributes; + + if (use_posix_spawn) + { + /* Initialize optional attributes before blocking. */ + int error + = emacs_posix_spawn_init (&actions, &attributes, std_in, + std_out, std_err, cwd); + if (error != 0) + return error; + } +#endif + int pid; + int vfork_error; eassert (input_blocked_p ()); +#if USABLE_POSIX_SPAWN + if (use_posix_spawn) + { + vfork_error = posix_spawn (&pid, argv[0], &actions, &attributes, + argv, envp); + if (vfork_error != 0) + pid = -1; + + int error = posix_spawn_file_actions_destroy (&actions); + if (error != 0) + { + errno = error; + emacs_perror ("posix_spawn_file_actions_destroy"); + } + + error = posix_spawnattr_destroy (&attributes); + if (error != 0) + { + errno = error; + emacs_perror ("posix_spawnattr_destroy"); + } + + goto fork_done; + } +#endif + #ifndef WINDOWSNT /* vfork, and prevent local vars from being clobbered by the vfork. */ pid_t *volatile newpid_volatile = newpid; @@ -1413,8 +1600,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, /* Back in the parent process. */ - int vfork_error = pid < 0 ? errno : 0; + vfork_error = pid < 0 ? errno : 0; + fork_done: if (pid < 0) { eassert (0 < vfork_error); From 480241983ea91e31ca4d757fe91df84d1d11d3c9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 31 Dec 2020 20:28:30 +0200 Subject: [PATCH 013/367] Fix compilation on MS-Windows * src/callproc.c (emacs_spawn) : Define the label only if USABLE_POSIX_SPAWN is defined, to avoid a compiler warning. (cherry picked from commit a8fc08085110de00ebcbd67b5273a755a5cb8ea1) --- src/callproc.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/callproc.c b/src/callproc.c index 4aa24636c35..fad81694b0a 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1602,7 +1602,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, vfork_error = pid < 0 ? errno : 0; +#if USABLE_POSIX_SPAWN fork_done: +#endif if (pid < 0) { eassert (0 < vfork_error); From d4536ff2572931b105198a85a452a777d6d3a1ff Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 13 Nov 2021 18:33:17 +0000 Subject: [PATCH 014/367] Fix follow-scroll-down in a small buffer which starts slightly scrolled This fixes bug #51814. * lisp/follow.el (follow-scroll-down): Do away with the optimization of doing vertical-motion over only one window. Instead move over all windows, to checck for being close to point-min, and setting point accordingly. --- lisp/follow.el | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/lisp/follow.el b/lisp/follow.el index 2ca2c1f17ba..3761275bbf6 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -669,24 +669,30 @@ Works like `scroll-down' when not in Follow mode." (t (let* ((orig-point (point)) (windows (follow-all-followers)) - (win (car (reverse windows))) - (start (window-start (car windows)))) + (start (window-start (car windows))) + (lines 0)) (if (eq start (point-min)) (if (or (null scroll-error-top-bottom) (bobp)) (signal 'beginning-of-buffer nil) (goto-char (point-min))) - (select-window win) - (goto-char start) - (vertical-motion (- (- (window-height win) - (if header-line-format 2 1) ; always mode-line - (if tab-line-format 1 0) - next-screen-context-lines))) - (set-window-start win (point)) - (if (< orig-point (window-end win t)) - (goto-char orig-point) - (goto-char start) - (vertical-motion (- next-screen-context-lines 1))) + (select-window (car windows)) + (dolist (win windows) + (setq lines + (+ lines + (- (window-height win) + (if header-line-format 2 1) ; Count mode-line, too. + (if tab-line-format 1 0))))) + (setq lines (- lines next-screen-context-lines)) + (goto-char start) + (let ((at-top (> (vertical-motion (- lines)) (- lines)))) + (set-window-start (car windows) (point)) + (if at-top + (goto-char orig-point) + (goto-char start) + (vertical-motion (- next-screen-context-lines 1)) + (if (< orig-point (point)) + (goto-char orig-point)))) (setq follow-internal-force-redisplay t)))))) (put 'follow-scroll-down 'scroll-command t) From 439a3094ff7fd84d1b1a5c6f5eb87431eec0d7fd Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Sun, 14 Nov 2021 01:51:31 +0100 Subject: [PATCH 015/367] Find most specific backend for `vc-backend-for-registration'. * lisp/vc/vc.el (vc-backend-for-registration): Count file name components instead of the length of the file name string (bug#50572). --- lisp/vc/vc.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4b56f1b795c..64f752f248d 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -944,8 +944,10 @@ use." bk) (dolist (backend vc-handled-backends) (when (not (vc-call-backend backend 'registered file)) - (let* ((path (vc-call-backend backend 'responsible-p file)) - (len (length path))) + (let* ((dir-name (vc-call-backend backend 'responsible-p file)) + (len (and dir-name + (length (file-name-split + (expand-file-name dir-name)))))) (when (and len (> len max)) (setq max len bk backend))))) (when bk @@ -977,7 +979,7 @@ use." (message "arg %s" arg) (and (file-directory-p arg) (string-prefix-p (expand-file-name arg) def-dir))))))) - (let ((default-directory repo-dir)) + (let ((default-directory repo-dir)) (vc-call-backend bk 'create-repo)) (throw 'found bk)))) From 5beed9dfed64fe72ab8678d2706eddbbee3c157b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 02:06:26 +0100 Subject: [PATCH 016/367] Adjust build-dep-zips.py download link * admin/nt/dist-build/build-dep-zips.py (download_source): Adjust the download link (bug#40628). --- admin/nt/dist-build/build-dep-zips.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py index 6bed191cae7..dfff493b640 100755 --- a/admin/nt/dist-build/build-dep-zips.py +++ b/admin/nt/dist-build/build-dep-zips.py @@ -123,7 +123,7 @@ def ntldd_munge(out): ## Currently no packages seem to require this! ARCH_PKGS=[] -SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources" +SRC_REPO="https://repo.msys2.org/mingw/sources" def immediate_deps(pkgs): @@ -169,7 +169,7 @@ def download_source(tarball): if not os.path.exists("../emacs-src-cache/{}".format(tarball)): print("Downloading {}...".format(tarball)) check_output_maybe( - "wget -a ../download.log -O ../emacs-src-cache/{} {}/{}/download" + "wget -a ../download.log -O ../emacs-src-cache/{} {}/{}" .format(tarball, SRC_REPO, tarball), shell=True ) From 08ce17c2c0d32e200af3984d59f0b78ec500dc2c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 02:21:45 +0100 Subject: [PATCH 017/367] Fix Gnus gcc header tokenization * lisp/gnus/gnus-msg.el (gnus-summary-resend-message-insert-gcc) (gnus-inews-do-gcc): Fix tokenization of the gcc header. --- lisp/gnus/gnus-msg.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index e88aa8f7d09..dfadfd39201 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1305,7 +1305,7 @@ For the \"inline\" alternatives, also see the variable (gnus-inews-insert-gcc) (let ((gcc (message-unquote-tokens (message-tokenize-header (mail-fetch-field "gcc" nil t) - " ,"))) + ","))) (self (with-current-buffer gnus-summary-buffer gnus-gcc-self-resent-messages))) (message-remove-header "gcc") @@ -1572,7 +1572,7 @@ this is a reply." (message-remove-header "gcc") (widen) (setq groups (message-unquote-tokens - (message-tokenize-header gcc " ,\n\t"))) + (message-tokenize-header gcc ",\n\t"))) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (setq method (gnus-inews-group-method group)) From 48ffbcf7eb6626dd46b40c3cd1cb9df83720146a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sun, 14 Nov 2021 02:30:06 +0100 Subject: [PATCH 018/367] Fix customization group of python-forward-sexp-function * lisp/progmodes/python.el (python-forward-sexp-function): Move from the "Flymake integration" subsection to the "Navigation" subsection, so that the option is sorted into the 'python' group rather than the 'python-flymake' group (bug#51807). --- lisp/progmodes/python.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b12b22e992e..47d8d1ce8ec 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1427,6 +1427,13 @@ marks the next defun after the ones already marked." ;;; Navigation +(defcustom python-forward-sexp-function #'python-nav-forward-sexp + "Function to use when navigating between expressions." + :version "28.1" + :type '(choice (const :tag "Python blocks" python-nav-forward-sexp) + (const :tag "CC-mode like" nil) + function)) + (defvar python-nav-beginning-of-defun-regexp (python-rx line-start (* space) defun (+ space) (group symbol-name)) "Regexp matching class or function definition. @@ -5572,13 +5579,6 @@ By default messages are considered errors." :type '(alist :key-type (regexp) :value-type (symbol))) -(defcustom python-forward-sexp-function #'python-nav-forward-sexp - "Function to use when navigating between expressions." - :version "28.1" - :type '(choice (const :tag "Python blocks" python-nav-forward-sexp) - (const :tag "CC-mode like" nil) - function)) - (defvar-local python--flymake-proc nil) (defun python--flymake-parse-output (source proc report-fn) From ad442b8887eb08cf125797863bd992792cb4ac4a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 02:38:48 +0100 Subject: [PATCH 019/367] Make all vc-*-responsible-p functions return a string * lisp/vc/vc-sccs.el (vc-sccs-responsible-p): * lisp/vc/vc-rcs.el (vc-rcs-responsible-p): * lisp/vc/vc-dav.el (vc-dav-responsible-p): * lisp/vc/vc-cvs.el (vc-cvs-responsible-p): Return a file name instead of t when we get a match (which is what vc-backend-for-registration expects) (bug#51800). --- lisp/vc/vc-cvs.el | 9 +++++---- lisp/vc/vc-dav.el | 4 ++-- lisp/vc/vc-rcs.el | 9 +++++---- lisp/vc/vc-sccs.el | 10 +++++++--- 4 files changed, 19 insertions(+), 13 deletions(-) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 6f921ac2a04..7062c4971f8 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -309,10 +309,11 @@ to the CVS command." (defun vc-cvs-responsible-p (file) "Return non-nil if CVS thinks it is responsible for FILE." - (file-directory-p (expand-file-name "CVS" - (if (file-directory-p file) - file - (file-name-directory file))))) + (let ((dir (if (file-directory-p file) + file + (file-name-directory file)))) + (and (file-directory-p (expand-file-name "CVS" dir)) + dir))) (defun vc-cvs-could-register (file) "Return non-nil if FILE could be registered in CVS. diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index fe631ee09a7..49a8af10e78 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -136,10 +136,10 @@ It should return a status of either 0 (no differences found), or "Find the version control state of all files in DIR in a fast way." ) -(defun vc-dav-responsible-p (_url) +(defun vc-dav-responsible-p (url) "Return non-nil if DAV considers itself `responsible' for URL." ;; Check for DAV support on the web server. - t) + (and t url)) ;;; Unimplemented functions ;; diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index e38469ba9f0..226e162d8ba 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -290,10 +290,11 @@ to the RCS command." (defun vc-rcs-responsible-p (file) "Return non-nil if RCS thinks it would be responsible for registering FILE." ;; TODO: check for all the patterns in vc-rcs-master-templates - (file-directory-p (expand-file-name "RCS" - (if (file-directory-p file) - file - (file-name-directory file))))) + (let ((dir (if (file-directory-p file) + file + (file-name-directory file)))) + (and (file-directory-p (expand-file-name "RCS" dir)) + dir))) (defun vc-rcs-receive-file (file rev) "Implementation of receive-file for RCS." diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index bcbb87eba8e..d59ccb37b3b 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -214,9 +214,13 @@ to the SCCS command." (defun vc-sccs-responsible-p (file) "Return non-nil if SCCS thinks it would be responsible for registering FILE." ;; TODO: check for all the patterns in vc-sccs-master-templates - (or (file-directory-p (expand-file-name "SCCS" (file-name-directory file))) - (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "") - (file-name-nondirectory file))))) + (or (and (file-directory-p + (expand-file-name "SCCS" (file-name-directory file))) + file) + (let ((dir (vc-sccs-search-project-dir (or (file-name-directory file) "") + (file-name-nondirectory file)))) + (and (stringp dir) + dir)))) (defun vc-sccs-checkin (files comment &optional rev) "SCCS-specific version of `vc-backend-checkin'." From e29c9308b14893622c257a1c106ec734e2e70dc7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 02:46:38 +0100 Subject: [PATCH 020/367] Fix `C-h k' in gnus-article-mode * lisp/gnus/gnus-art.el (gnus-article-describe-key): (gnus-article-describe-key-briefly): Fix `describe-key' calling convention (bug#51796). --- lisp/gnus/gnus-art.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 78ce89dde3c..23f1431b80f 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6897,8 +6897,8 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key (cons (read-key-sequence nil t) - (this-single-command-raw-keys)) + (describe-key (list (cons (read-key-sequence nil t) + (this-single-command-raw-keys))) (current-buffer)))) (describe-key key))) @@ -6922,8 +6922,8 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key-briefly (cons (read-key-sequence nil t) - (this-single-command-raw-keys)) + (describe-key-briefly (list (cons (read-key-sequence nil t) + (this-single-command-raw-keys))) insert (current-buffer)))) (describe-key-briefly key insert))) From 9627b731c0611fd14850edd2e045f2c606fc151e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 14 Nov 2021 09:58:21 +0800 Subject: [PATCH 021/367] Fix crash in xwidget_end_redisplay * src/xwidget.c (xwidget_end_redisplay): Always test if xv is NULL. --- src/xwidget.c | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index ca0392a44d6..609a231d4bb 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2643,19 +2643,16 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) xwidget_end_redisplay (w->current_matrix); */ struct xwidget_view *xv = xwidget_view_lookup (xwidget_from_id (glyph->u.xwidget), w); -#ifdef USE_GTK - /* FIXME: Is it safe to assume xwidget_view_lookup - always succeeds here? If so, this comment can be removed. - If not, the code probably needs fixing. */ - eassume (xv); - xwidget_touch (xv); -#elif defined NS_IMPL_COCOA - /* In NS xwidget, xv can be NULL for the second or + + /* In NS xwidget, xv can be NULL for the second or later views for a model, the result of 1 to 1 - model view relation enforcement. */ + model view relation enforcement. `xwidget_view_lookup' + has also been observed to return NULL here on X-Windows + at least once, so stay safe and only touch it if it's + not NULL. */ + if (xv) xwidget_touch (xv); -#endif } } } From 370d4038c5a671d3b9e3a4d28d849948c1a96f53 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 03:14:35 +0100 Subject: [PATCH 022/367] Explain in the manual how to make `cursor-intangible' work * doc/lispref/text.texi (Special Properties): Explain how to make `cursor-intangible' work (bug#51095). --- doc/lispref/text.texi | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 937680c200d..32773818e5b 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3653,6 +3653,16 @@ property is obsolete; use the @code{cursor-intangible} property instead. When the minor mode @code{cursor-intangible-mode} is turned on, point is moved away from any position that has a non-@code{nil} @code{cursor-intangible} property, just before redisplay happens. +Note that @code{rear-nonsticky} is taken into account when computing +allowed cursor positions, so (for instance) to insert a stretch of +five @samp{x} characters you can't put point on, you have to do +something like: + +@lisp +(insert + (propertize "xxxx" 'cursor-intangible t) + (propertize "x" 'cursor-intangible t 'rear-nonsticky t)) +@end lisp @vindex cursor-sensor-inhibit When the variable @code{cursor-sensor-inhibit} is non-@code{nil}, the From 5dbad52cbfa81585111edd67631af632ac13fdea Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 04:54:40 +0100 Subject: [PATCH 023/367] gnus-summary-line-format doc string clarification * lisp/gnus/gnus.el (gnus-summary-line-format): Clarify the Date part of the doc string (bug#51823). --- lisp/gnus/gnus.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index f558360361d..1d19a2ac565 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2717,7 +2717,7 @@ with some simple extensions. %F Contents of the From: header (string) %f Contents of the From: or To: headers (string) %x Contents of the Xref: header (string) -%D Date of the article (string) +%D Contents of the Date: header article (string) %d Date of the article (string) in DD-MMM format %o Date of the article (string) in YYYYMMDD`T'HHMMSS format From 06632fbaf81900143aec988a846ee18e33a85e50 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 09:41:22 +0100 Subject: [PATCH 024/367] Fix previous -responsible-p change * lisp/vc/vc-sccs.el (vc-sccs-responsible-p): * lisp/vc/vc-rcs.el (vc-rcs-responsible-p): * lisp/vc/vc-cvs.el (vc-cvs-responsible-p): Make the previous change work with relative file names, too. --- lisp/vc/vc-cvs.el | 2 +- lisp/vc/vc-rcs.el | 2 +- lisp/vc/vc-sccs.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 7062c4971f8..c8954472245 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -313,7 +313,7 @@ to the CVS command." file (file-name-directory file)))) (and (file-directory-p (expand-file-name "CVS" dir)) - dir))) + (file-name-directory (expand-file-name "CVS" dir))))) (defun vc-cvs-could-register (file) "Return non-nil if FILE could be registered in CVS. diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 226e162d8ba..2422e99d3da 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -294,7 +294,7 @@ to the RCS command." file (file-name-directory file)))) (and (file-directory-p (expand-file-name "RCS" dir)) - dir))) + (file-name-directory (expand-file-name "RCS" dir))))) (defun vc-rcs-receive-file (file rev) "Implementation of receive-file for RCS." diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index d59ccb37b3b..4b56fbf28ef 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -216,7 +216,7 @@ to the SCCS command." ;; TODO: check for all the patterns in vc-sccs-master-templates (or (and (file-directory-p (expand-file-name "SCCS" (file-name-directory file))) - file) + (file-name-directory file)) (let ((dir (vc-sccs-search-project-dir (or (file-name-directory file) "") (file-name-nondirectory file)))) (and (stringp dir) From 609bc1d33ad81f9f2ffa0ff34522cfdb743d2dbb Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 14 Nov 2021 13:02:41 +0800 Subject: [PATCH 025/367] Add `kill-xwidget' * doc/lispref/display.texi (Xwidgets): Document 'kill-xwidget'. * src/xwidget.c (kill_xwidget, Fkill_xwidget): New function. (syms_of_xwidget): Define new subr. (kill_buffer_xwidgets): Use `kill_xwidget' instead. --- doc/lispref/display.texi | 14 +++++-- src/xwidget.c | 81 ++++++++++++++++++++++++++++------------ 2 files changed, 67 insertions(+), 28 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index a8a7837a4a0..3ab29dc5912 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6806,10 +6806,11 @@ widget that the newly created widget should share settings and subprocesses with. The xwidget that is returned will be killed alongside its buffer -(@pxref{Killing Buffers}). Once it is killed, the xwidget may -continue to exist as a Lisp object and act as a @code{display} -property until all references to it are gone, but most actions that -can be performed on live xwidgets will no longer be available. +(@pxref{Killing Buffers}). You can also kill it using +@code{xwidget-kill}. Once it is killed, the xwidget may continue to +exist as a Lisp object and act as a @code{display} property until all +references to it are gone, but most actions that can be performed on +live xwidgets will no longer be available. @end defun @defun xwidgetp object @@ -6822,6 +6823,11 @@ This function returns @code{t} if @var{object} is an xwidget that hasn't been killed, and @code{nil} otherwise. @end defun +@defun kill-xwidget xwidget +This function kills @var{xwidget}, by removing it from its buffer and +releasing window system resources it holds. +@end defun + @defun xwidget-plist xwidget This function returns the property list of @var{xwidget}. @end defun diff --git a/src/xwidget.c b/src/xwidget.c index 609a231d4bb..344016ed744 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -76,6 +76,8 @@ allocate_xwidget_view (void) static struct xwidget_view *xwidget_view_lookup (struct xwidget *, struct window *); +static void kill_xwidget (struct xwidget *); + #ifdef USE_GTK static void webkit_view_load_changed_cb (WebKitWebView *, WebKitLoadEvent, @@ -2386,6 +2388,25 @@ using `xwidget-webkit-search'. */) return Qnil; } +DEFUN ("kill-xwidget", Fkill_xwidget, Skill_xwidget, + 1, 1, 0, + doc: /* Kill the specified XWIDGET. +This releases all window system resources associated with XWIDGET, +removes it from `xwidget-list', and detaches it from its buffer. */) + (Lisp_Object xwidget) +{ + struct xwidget *xw; + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + block_input (); + kill_xwidget (xw); + unblock_input (); + + return Qnil; +} + #ifdef USE_GTK DEFUN ("xwidget-webkit-load-html", Fxwidget_webkit_load_html, Sxwidget_webkit_load_html, 2, 3, 0, @@ -2468,6 +2489,7 @@ syms_of_xwidget (void) #ifdef USE_GTK defsubr (&Sxwidget_webkit_load_html); #endif + defsubr (&Skill_xwidget); DEFSYM (QCxwidget, ":xwidget"); DEFSYM (QCtitle, ":title"); @@ -2708,6 +2730,40 @@ kill_frame_xwidget_views (struct frame *f) } #endif +static void +kill_xwidget (struct xwidget *xw) +{ +#ifdef USE_GTK + xw->buffer = Qnil; + + if (xw->widget_osr && xw->widgetwindow_osr) + { + gtk_widget_destroy (xw->widget_osr); + gtk_widget_destroy (xw->widgetwindow_osr); + } + + if (xw->find_text) + xfree (xw->find_text); + + if (!NILP (xw->script_callbacks)) + { + for (ptrdiff_t idx = 0; idx < ASIZE (xw->script_callbacks); idx++) + { + Lisp_Object cb = AREF (xw->script_callbacks, idx); + if (!NILP (cb)) + xfree (xmint_pointer (XCAR (cb))); + ASET (xw->script_callbacks, idx, Qnil); + } + } + + xw->widget_osr = NULL; + xw->widgetwindow_osr = NULL; + xw->find_text = NULL; +#elif defined NS_IMPL_COCOA + nsxwidget_kill (xw); +#endif +} + /* Kill all xwidget in BUFFER. */ void kill_buffer_xwidgets (Lisp_Object buffer) @@ -2721,31 +2777,8 @@ kill_buffer_xwidgets (Lisp_Object buffer) { CHECK_LIVE_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); - xw->buffer = Qnil; -#ifdef USE_GTK - if (xw->widget_osr && xw->widgetwindow_osr) - { - gtk_widget_destroy (xw->widget_osr); - gtk_widget_destroy (xw->widgetwindow_osr); - } - if (xw->find_text) - xfree (xw->find_text); - if (!NILP (xw->script_callbacks)) - for (ptrdiff_t idx = 0; idx < ASIZE (xw->script_callbacks); idx++) - { - Lisp_Object cb = AREF (xw->script_callbacks, idx); - if (!NILP (cb)) - xfree (xmint_pointer (XCAR (cb))); - ASET (xw->script_callbacks, idx, Qnil); - } - - xw->widget_osr = NULL; - xw->widgetwindow_osr = NULL; - xw->find_text = NULL; -#elif defined NS_IMPL_COCOA - nsxwidget_kill (xw); -#endif + kill_xwidget (xw); } } } From c3f53d26043a4e4a91a3f1d140f080b6c8d190d2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 11 Nov 2021 09:01:38 +0800 Subject: [PATCH 026/367] Expose xwidget navigation history to Lisp code * doc/lispref/display.texi (Xwidgets): Document changes. * etc/NEWS: Announce new function. * src/xwidget.c (Fxwidget_webkit_back_forward_list): New function. (syms_of_xwidget): Define new subr. --- doc/lispref/display.texi | 33 ++++++++++++++ etc/NEWS | 5 +++ src/xwidget.c | 95 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 133 insertions(+) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 3ab29dc5912..dd2c6e003f4 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6971,6 +6971,39 @@ the absolute location of the web resources referenced by @var{text}, to be used for resolving relative links in @var{text}. @end defun +@defun xwidget-webkit-goto-history xwidget rel-pos +Make @var{xwidget}, a WebKit widget, load the @var{rel-pos}th element +in its navigation history. + +If @var{rel-pos} is zero, the current page will be reloaded instead. +@end defun + +@defun xwidget-webkit-back-forward-list xwidget &optional limit +Return the navigation history of @var{xwidget}, up to @var{limit} +items in each direction. If not specified, @var{limit} defaults to +50. + +The returned value is a list of the form @w{@code{(@var{back} +@var{here} @var{forward})}}, where @var{here} is the current +navigation item, while @var{back} is a list of items containing the +items recorded by WebKit before the current navigation item, and +@var{forward} is a list of items recorded after the current navigation +item. @var{back}, @var{here} and @var{forward} can all be @code{nil}. + +When @var{here} is @code{nil}, it means that no items have been +recorded yet; if @var{back} or @var{forward} are @code{nil}, it means +that there is no history recorded before or after the current item +respectively. + +Navigation items are themselves lists of the form @w{@code{(@var{idx} +@var{title} @var{uri})}}. In these lists, @var{idx} is an index that +can be passed to @code{xwidget-webkit-goto-history}, @var{title} is +the human-readable title of the item, and @var{uri} is the URI of the +item. The user should normally have no reason to load @var{uri} +manually to reach a specific history item. Instead, @var{idx} should +be passed as an index to @code{xwidget-webkit-goto-history}. +@end defun + @node Buttons @section Buttons @cindex buttons in buffers diff --git a/etc/NEWS b/etc/NEWS index c362e56ceeb..312fc18f4f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -781,6 +781,11 @@ markup, and passing the URI of the file as an argument to Some new functions, such as 'xwidget-webkit-search', have been added for performing searches on WebKit xwidgets. ++++ +*** New function 'xwidget-webkit-back-forward-list'. +This function is used to obtain the history of page-loads in a given +WebKit xwidget. + +++ *** 'load-changed' xwidget events are now more detailed. In particular, they can now have different arguments based on the diff --git a/src/xwidget.c b/src/xwidget.c index 344016ed744..0e8bf13715f 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see . */ #include #include "buffer.h" +#include "coding.h" #include "xwidget.h" #include "lisp.h" @@ -2444,6 +2445,99 @@ to "about:blank". */) return Qnil; } + +DEFUN ("xwidget-webkit-back-forward-list", Fxwidget_webkit_back_forward_list, + Sxwidget_webkit_back_forward_list, 1, 2, 0, + doc: /* Return the navigation history of XWIDGET, a WebKit xwidget. + +Return the history as a list of the form (BACK HERE FORWARD), where +HERE is the current navigation item, while BACK and FORWARD are lists +of history items of the form (IDX TITLE URI). Here, IDX is an index +that can be passed to `xwidget-webkit-goto-history', TITLE is a string +containing the human-readable title of the history item, and URI is +the URI of the history item. + +BACK, HERE, and FORWARD can all be nil depending on the state of the +navigation history. + +BACK and FORWARD will each not contain more elements than LIMIT. If +LIMIT is not specified or nil, it is treated as `50'. */) + (Lisp_Object xwidget, Lisp_Object limit) +{ + struct xwidget *xw; + Lisp_Object back, here, forward; + WebKitWebView *webview; + WebKitBackForwardList *list; + WebKitBackForwardListItem *item; + GList *parent, *tem; + int i; + unsigned int lim; + Lisp_Object title, uri; + const gchar *item_title, *item_uri; + + back = Qnil; + here = Qnil; + forward = Qnil; + + if (NILP (limit)) + limit = make_fixnum (50); + else + CHECK_FIXNAT (limit); + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + list = webkit_web_view_get_back_forward_list (webview); + item = webkit_back_forward_list_get_current_item (list); + lim = XFIXNAT (limit); + + if (item) + { + item_title = webkit_back_forward_list_item_get_title (item); + item_uri = webkit_back_forward_list_item_get_uri (item); + here = list3 (make_fixnum (0), + build_string_from_utf8 (item_title ? item_title : ""), + build_string_from_utf8 (item_uri ? item_uri : "")); + } + parent = webkit_back_forward_list_get_back_list_with_limit (list, lim); + + if (parent) + { + for (i = 1, tem = parent; parent; parent = parent->next, ++i) + { + item = tem->data; + item_title = webkit_back_forward_list_item_get_title (item); + item_uri = webkit_back_forward_list_item_get_uri (item); + title = build_string_from_utf8 (item_title ? item_title : ""); + uri = build_string_from_utf8 (item_uri ? item_uri : ""); + back = Fcons (list3 (make_fixnum (-i), title, uri), back); + } + } + + back = Fnreverse (back); + g_list_free (parent); + + parent = webkit_back_forward_list_get_forward_list_with_limit (list, lim); + + if (parent) + { + for (i = 1, tem = parent; parent; parent = parent->next, ++i) + { + item = tem->data; + item_title = webkit_back_forward_list_item_get_title (item); + item_uri = webkit_back_forward_list_item_get_uri (item); + title = build_string_from_utf8 (item_title ? item_title : ""); + uri = build_string_from_utf8 (item_uri ? item_uri : ""); + forward = Fcons (list3 (make_fixnum (i), title, uri), forward); + } + } + + forward = Fnreverse (forward); + g_list_free (parent); + + return list3 (back, here, forward); +} #endif void @@ -2488,6 +2582,7 @@ syms_of_xwidget (void) defsubr (&Sset_xwidget_buffer); #ifdef USE_GTK defsubr (&Sxwidget_webkit_load_html); + defsubr (&Sxwidget_webkit_back_forward_list); #endif defsubr (&Skill_xwidget); From 289f3a9e5f47bcc70391f0a36c556d964542ee80 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 14 Nov 2021 14:46:27 +0200 Subject: [PATCH 027/367] Add more files to be natively-compiled AOT * src/Makefile.in (elnlisp): Add emacs-lisp/gv.eln and other missing dependencies of comp.el. --- src/Makefile.in | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/Makefile.in b/src/Makefile.in index 6d75e3537a6..954d5482162 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -796,6 +796,16 @@ elnlisp := \ international/charscript.eln \ emacs-lisp/comp.eln \ emacs-lisp/comp-cstr.eln \ + emacs-lisp/cl-macs.eln \ + emacs-lisp/rx.eln \ + emacs-lisp/cl-seq.eln \ + help-mode.eln \ + emacs-lisp/cl-extra.eln \ + emacs-lisp/gv.eln \ + emacs-lisp/seq.eln \ + emacs-lisp/cl-lib.eln \ + emacs-lisp/warnings.eln \ + emacs-lisp/subr-x.eln \ international/emoji-zwj.eln elnlisp := $(addprefix ${lispsource}/,${elnlisp}) $(lisp:.elc=.eln) From 8aba549263e2660b4ac4f1026b23fbc5caef8168 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 14 Nov 2021 14:41:58 +0100 Subject: [PATCH 028/367] Improve Tramp error handling * doc/misc/tramp.texi (Frequently Asked Questions): Add another `remote-file-error'. * lisp/net/tramp.el (tramp-find-foreign-file-name-handler): Improve error handling. --- doc/misc/tramp.texi | 22 ++++++++++++++++++++++ lisp/net/tramp.el | 11 +++++++++-- 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 819670a5088..0825e85e4d3 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5222,6 +5222,28 @@ time being you can suppress this error by the following code in your @end lisp +@item +I get an error @samp{Remote file error: Not a valid Tramp file name +function `tramp-FOO-file-name-p'} + +@value{tramp} has changed the signature of an internal function. +External packages implementing an own @value{tramp} backend must +follow this change. Please report this problem to the author of that +package. + +For the running session, @value{tramp} disables the external package, +and you can continue to work. If you don't want to see this error +while activating @value{tramp}, you can suppress it by the same code +as above in your @file{~/.emacs}: + +@lisp +@group +(setq debug-ignored-errors + (cons 'remote-file-error debug-ignored-errors)) +@end group +@end lisp + + @item How to disable other packages from calling @value{tramp}? diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 876bbb2c545..5fcf7f9b650 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2552,13 +2552,20 @@ Must be handled by the callers." (when (tramp-tramp-file-p filename) (let ((handler tramp-foreign-file-name-handler-alist) (vec (tramp-dissect-file-name filename)) - elt res) + elt func res) (while handler (setq elt (car handler) handler (cdr handler)) ;; Previously, this function was called with FILENAME, but now ;; it's called with the VEC. - (when (with-demoted-errors "Error: %S" (funcall (car elt) vec)) + (when (condition-case nil + (funcall (setq func (car elt)) vec) + (error + (setcar elt #'ignore) + (unless (member 'remote-file-error debug-ignored-errors) + (tramp-error + vec 'remote-file-error + "Not a valid Tramp file name function `%s'" func)))) (setq handler nil res (cdr elt)))) res))) From 85ac0efe7c8c43627b2db7aabed18125eb4cb535 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= Date: Sun, 14 Nov 2021 15:30:52 +0100 Subject: [PATCH 029/367] Fix semantic-symref-perform-search doc string * lisp/cedet/semantic/symref/cscope.el (semantic-symref-perform-search): Fix the docstring to refer to the correct tool (bug#51846). --- lisp/cedet/semantic/symref/cscope.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el index e63b7a7e914..bc3f4a248b7 100644 --- a/lisp/cedet/semantic/symref/cscope.el +++ b/lisp/cedet/semantic/symref/cscope.el @@ -43,7 +43,7 @@ the hit list. See the function `cedet-cscope-search' for more details.") (cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope)) - "Perform a search with GNU Global." + "Perform a search with CScope." (let* ((rootproj (when (and (featurep 'ede) ede-minor-mode) (ede-toplevel))) (default-directory (if rootproj From acbc7239021e902470d36d99e6c607080fff8fc5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 14 Nov 2021 18:55:37 +0200 Subject: [PATCH 030/367] Fix recent documentation updates * doc/lispref/text.texi (Special Properties): Improve wording. Add cross-reference and index entry. (Sticky Properties): Add indexing. --- doc/lispref/text.texi | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 32773818e5b..863b318c205 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3650,13 +3650,14 @@ property is obsolete; use the @code{cursor-intangible} property instead. @item cursor-intangible @kindex cursor-intangible @r{(text property)} @findex cursor-intangible-mode +@cindex rear-nonsticky, and cursor-intangible property When the minor mode @code{cursor-intangible-mode} is turned on, point is moved away from any position that has a non-@code{nil} @code{cursor-intangible} property, just before redisplay happens. -Note that @code{rear-nonsticky} is taken into account when computing -allowed cursor positions, so (for instance) to insert a stretch of -five @samp{x} characters you can't put point on, you have to do -something like: +Note that ``stickiness'' of the property (@pxref{Sticky Properties}) +is taken into account when computing allowed cursor positions, so (for +instance) to insert a stretch of five @samp{x} characters into which +the cursor can't enter, you should do something like: @lisp (insert @@ -3960,6 +3961,8 @@ of the kill ring. To insert with inheritance, use the special primitives described in this section. Self-inserting characters inherit properties because they work using these primitives. +@cindex front-sticky text property +@cindex rear-nonsticky text property When you do insertion with inheritance, @emph{which} properties are inherited, and from where, depends on which properties are @dfn{sticky}. Insertion after a character inherits those of its properties that are From e6e29b435273ee9821b6536581bd151f3e50737d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 14 Nov 2021 18:58:57 +0200 Subject: [PATCH 031/367] ; * lisp/progmodes/python.el (python-forward-sexp-function): :version fix. --- lisp/progmodes/python.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 47d8d1ce8ec..329e6542266 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1429,7 +1429,7 @@ marks the next defun after the ones already marked." (defcustom python-forward-sexp-function #'python-nav-forward-sexp "Function to use when navigating between expressions." - :version "28.1" + :version "29.1" :type '(choice (const :tag "Python blocks" python-nav-forward-sexp) (const :tag "CC-mode like" nil) function)) From d75ba220e0a5a4ed26d086c305bc4ea4e4647e5d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 14 Nov 2021 19:42:37 +0200 Subject: [PATCH 032/367] ; Revert "* lisp/progmodes/python.el (python-forward-sexp-function): :version fix." This reverts commit e6e29b435273ee9821b6536581bd151f3e50737d. The commit was a mistake. --- lisp/progmodes/python.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 329e6542266..47d8d1ce8ec 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1429,7 +1429,7 @@ marks the next defun after the ones already marked." (defcustom python-forward-sexp-function #'python-nav-forward-sexp "Function to use when navigating between expressions." - :version "29.1" + :version "28.1" :type '(choice (const :tag "Python blocks" python-nav-forward-sexp) (const :tag "CC-mode like" nil) function)) From 97059bcdffe722ab92ca39209c3a3b62144b19a1 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 14 Nov 2021 02:46:38 +0100 Subject: [PATCH 033/367] Fix `C-h k' in gnus-article-mode (don't merge) * lisp/gnus/gnus-art.el (gnus-article-describe-key): (gnus-article-describe-key-briefly): Fix `describe-key' calling convention (bug#51796). --- lisp/gnus/gnus-art.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index cce0fc32b70..b97cd711c4e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6867,8 +6867,8 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key (cons (read-key-sequence nil t) - (this-single-command-raw-keys)) + (describe-key (list (cons (read-key-sequence nil t) + (this-single-command-raw-keys))) (current-buffer)))) (describe-key key))) @@ -6892,8 +6892,8 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key-briefly (cons (read-key-sequence nil t) - (this-single-command-raw-keys)) + (describe-key-briefly (list (cons (read-key-sequence nil t) + (this-single-command-raw-keys))) insert (current-buffer)))) (describe-key-briefly key insert))) From 572eed83fcce65c3f81cbbfd777f5020bed1d81a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Nov 2021 12:56:11 -0500 Subject: [PATCH 034/367] * src/lread.c (read_escape): Fix handling of ?\C- for chars 128-255 --- src/lread.c | 2 +- test/src/lread-tests.el | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index 3052bcbd063..2e63ec48912 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2709,7 +2709,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) c = read_escape (readcharfun, 0); if ((c & ~CHAR_MODIFIER_MASK) == '?') return 0177 | (c & CHAR_MODIFIER_MASK); - else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) + else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) return c | ctrl_modifier; /* ASCII control chars are made from letters (both cases), as well as the non-letters within 0100...0137. */ diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index be685fe999f..c635c592b28 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -115,6 +115,10 @@ (should-error (read "#24r") :type 'invalid-read-syntax) (should-error (read "#") :type 'invalid-read-syntax)) +(ert-deftest lread-char-modifiers () + (should (eq ?\C-\M-é (+ (- ?\M-a ?a) ?\C-é))) + (should (eq (- ?\C-ŗ ?ŗ) (- ?\C-é ?é)))) + (ert-deftest lread-record-1 () (should (equal '(#s(foo) #s(foo)) (read "(#1=#s(foo) #1#)")))) From e6df5a32d07564115488643206396ba0c28decf2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 14 Nov 2021 20:35:42 +0200 Subject: [PATCH 035/367] * lisp/tab-line.el (tab-line-mode): Preserve existing value of tab-line-format Keep the old value of tab-line-format when enabling tab-line-mode and don't overwrite it with nil when disabling tab-line-mode (bug#51830). --- lisp/tab-line.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 5affae79138..110c6e96969 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -893,7 +893,14 @@ sight of the tab line." (define-minor-mode tab-line-mode "Toggle display of tab line in the windows displaying the current buffer." :lighter nil - (setq tab-line-format (when tab-line-mode '(:eval (tab-line-format))))) + (let ((default-value '(:eval (tab-line-format)))) + (if tab-line-mode + ;; Preserve the existing tab-line set outside of this mode + (unless tab-line-format + (setq tab-line-format default-value)) + ;; Reset only values set by this mode + (when (equal tab-line-format default-value) + (setq tab-line-format nil))))) (defcustom tab-line-exclude-modes '(completion-list-mode) From 044dd1e21028fad3cf8d976dae887503dbab6ae3 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 14 Nov 2021 19:41:31 +0100 Subject: [PATCH 036/367] * rcirc.el (rcirc-define-command): Fix interactive-spec generation * rcirc.el (rcirc-define-command): Wrap interactive spec in a list call. --- lisp/net/rcirc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 52d74a33945..5c92c60eda2 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2583,7 +2583,7 @@ that, an interactive form can specified." ,(concat documentation "\n\nNote: If PROCESS or TARGET are nil, the values given" "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - (interactive ,interactive-spec) + (interactive (list ,interactive-spec)) (unless (if (listp ,argument) (<= ,required (length ,argument) ,total) (string-match ,regexp ,argument)) From 364cf2494c9b94e1d265b637394c80c4eecfb505 Mon Sep 17 00:00:00 2001 From: Ken Brown Date: Sun, 14 Nov 2021 10:30:44 -0500 Subject: [PATCH 037/367] Prefer POSIX timers to timerfd timers * src/atimer.c (set_alarm): Try to start a POSIX timer before starting a timerfd timer. On Cygwin, return if the POSIX timer is started successfully. (Bug#51734) --- src/atimer.c | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/src/atimer.c b/src/atimer.c index 9bde9c2446f..df35603f324 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -309,24 +309,29 @@ set_alarm (void) struct itimerspec ispec; ispec.it_value = atimers->expiration; ispec.it_interval.tv_sec = ispec.it_interval.tv_nsec = 0; + if (alarm_timer_ok + && timer_settime (alarm_timer, TIMER_ABSTIME, &ispec, 0) == 0) + exit = true; + + /* Don't start both timerfd and POSIX timers on Cygwin; this + causes a slowdown (bug#51734). Prefer POSIX timers + because the timerfd notifications aren't delivered while + Emacs is busy, which prevents things like the hourglass + pointer from being displayed reliably (bug#19776). */ +# ifdef CYGWIN + if (exit) + return; +# endif + # ifdef HAVE_TIMERFD - if (timerfd_settime (timerfd, TFD_TIMER_ABSTIME, &ispec, 0) == 0) + if (0 <= timerfd + && timerfd_settime (timerfd, TFD_TIMER_ABSTIME, &ispec, 0) == 0) { add_timer_wait_descriptor (timerfd); exit = true; } # endif -# ifdef CYGWIN - /* Don't start both timerfd and alarms on Cygwin; this - causes a slowdown (bug#51734). */ - if (exit) - return; -# endif - if (alarm_timer_ok - && timer_settime (alarm_timer, TIMER_ABSTIME, &ispec, 0) == 0) - exit = true; - if (exit) return; } From d9e91da7690a7872a27d9fcb652a170d84e4d891 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 15 Nov 2021 09:27:31 +0800 Subject: [PATCH 038/367] Stop assuming xwidget views will only be displayed in TEXT_AREA * src/xterm.c (x_scroll_run): Use view->area when calculating xwidget view clipping. * src/xwidget.c (x_draw_xwidget_glyph_string): Set view->area to s->area and use that instead. * src/xwidget.h (struct xwidget_view): Add glyph row area field. --- src/xterm.c | 2 +- src/xwidget.c | 4 +++- src/xwidget.h | 2 ++ 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index fd498c0e32b..5988d3a15fb 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4439,7 +4439,7 @@ x_scroll_run (struct window *w, struct run *run) int text_area_x, text_area_y, text_area_width, text_area_height; int clip_top, clip_bottom; - window_box (w, TEXT_AREA, &text_area_x, &text_area_y, + window_box (w, view->area, &text_area_x, &text_area_y, &text_area_width, &text_area_height); view->y = y; diff --git a/src/xwidget.c b/src/xwidget.c index 0e8bf13715f..48927524320 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -1631,7 +1631,9 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) } #endif - window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y, + xv->area = s->area; + + window_box (s->w, xv->area, &text_area_x, &text_area_y, &text_area_width, &text_area_height); clip_left = max (0, text_area_x - x); diff --git a/src/xwidget.h b/src/xwidget.h index 4377b50e840..df55dacffef 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -104,6 +104,8 @@ struct xwidget_view /* The "live" instance isn't drawn. */ bool hidden; + enum glyph_row_area area; + #if defined (USE_GTK) Display *dpy; Window wdesc; From d5a4772712334851921e0c11326b27b3744f9f04 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 15 Nov 2021 13:43:55 +0800 Subject: [PATCH 039/367] Fix xwidget-webkit-back-forward-list * src/xwidget.c (Fxwidget_webkit_back_forward_list): Use correct list variable in loop. --- src/xwidget.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index 48927524320..aae2479134a 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2506,7 +2506,7 @@ LIMIT is not specified or nil, it is treated as `50'. */) if (parent) { - for (i = 1, tem = parent; parent; parent = parent->next, ++i) + for (i = 1, tem = parent; tem; tem = tem->next, ++i) { item = tem->data; item_title = webkit_back_forward_list_item_get_title (item); @@ -2524,7 +2524,7 @@ LIMIT is not specified or nil, it is treated as `50'. */) if (parent) { - for (i = 1, tem = parent; parent; parent = parent->next, ++i) + for (i = 1, tem = parent; tem; tem = tem->next, ++i) { item = tem->data; item_title = webkit_back_forward_list_item_get_title (item); From a7c9695835a15bb5510a5938d9a664982170be5f Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 15 Nov 2021 06:52:38 +0100 Subject: [PATCH 040/367] Fix handling of changed prefix keys in tutorial * lisp/tutorial.el (tutorial--find-changed-keys): Use keymapp to detect prefix definitions rather than hard-coding them. A notable omission from the hard-coded list was mode-specific-command-prefix, whose subcommands are often rebound (bug#40725). --- lisp/tutorial.el | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 186bf35fe7e..bf985280d80 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -423,11 +423,9 @@ where ;; Handle prefix definitions specially ;; so that a mode that rebinds some subcommands ;; won't make it appear that the whole prefix is gone. - (key-fun (if (eq def-fun 'ESC-prefix) - (lookup-key global-map [27]) - (if (eq def-fun 'Control-X-prefix) - (lookup-key global-map [24]) - (key-binding key)))) + (key-fun (if (keymapp def-fun) + (lookup-key global-map key) + (key-binding key))) (where (where-is-internal (if rem-fun rem-fun def-fun))) cwhere) From 6aeaf12551bc63c92cd85cd936c40b2f6a99e944 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Nov 2021 07:16:49 +0100 Subject: [PATCH 041/367] Allow mm-external-terminal-program to be a list of strings * doc/misc/emacs-mime.texi (Display Customization): Document it. * lisp/gnus/mm-decode.el (mm-external-terminal-program): Allow being a list. --- doc/misc/emacs-mime.texi | 3 ++- lisp/gnus/mm-decode.el | 23 +++++++++++++++-------- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 7cd3e5f5828..96a4ad556f6 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -454,7 +454,8 @@ setting this option to non-@code{nil}. The default value is @code{t}. @item mm-external-terminal-program @vindex mm-external-terminal-program -The program used to start an external terminal. +This should be a list of strings; typically something like +@samp{("xterm" "-e")} or @samp{("gnome-terminal" "--")}. @item mm-enable-external @vindex mm-enable-external diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index aca4bf2062d..d781407cdcd 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -446,10 +446,11 @@ If not set, `default-directory' will be used." :type 'integer :group 'mime-display) -(defcustom mm-external-terminal-program "xterm" - "The program to start an external terminal." - :version "22.1" - :type 'string +(defcustom mm-external-terminal-program '("xterm" "-e") + "The program to start an external terminal. +This should be a list of strings." + :version "29.1" + :type '(choice string (repeat string)) :group 'mime-display) ;;; Internal variables. @@ -957,10 +958,16 @@ external if displayed external." (unwind-protect (if window-system (set-process-sentinel - (start-process "*display*" nil - mm-external-terminal-program - "-e" shell-file-name - shell-command-switch command) + (apply #'start-process "*display*" nil + (append + (if (listp mm-external-terminal-program) + mm-external-terminal-program + ;; Be backwards-compatible. + (list mm-external-terminal-program + "-e")) + (list shell-file-name + shell-command-switch + command))) (lambda (process _state) (if (eq 'exit (process-status process)) (run-at-time From 2a3c8f3d2e8a9b58c8b6c93168096ed096bcc5d6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Nov 2021 07:38:07 +0100 Subject: [PATCH 042/367] Fix outline-cycle-buffer issue in `C-h b' buffers * lisp/outline.el (outline--fix-up-all-buttons): Fix issue when called after collapsing a buffer (bug#51855). --- lisp/outline.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/outline.el b/lisp/outline.el index cefb8117035..9a2e4324b22 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1014,7 +1014,10 @@ If non-nil, EVENT should be a mouse event." (when outline-minor-mode-use-buttons (outline-map-region (lambda () - (if (eq (outline--cycle-state) 'show-all) + ;; `outline--cycle-state' will fail if we're in a totally + ;; collapsed buffer -- but in that case, we're not in a + ;; `show-all' situation. + (if (eq (ignore-errors (outline--cycle-state)) 'show-all) (outline--insert-open-button) (outline--insert-close-button))) (or from (point-min)) (or to (point-max))))) From cff1702a52d9f116d9180a1a1597130474574fd8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 15 Nov 2021 09:42:48 +0100 Subject: [PATCH 043/367] Fix hanging wdired test * test/lisp/wdired-tests.el (wdired-test-bug34915): Fix hanging test. Don't start the Emacs Server just to create a socket; just create the socket manually. --- test/lisp/wdired-tests.el | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index e768a165529..9678fce84d0 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el @@ -22,6 +22,7 @@ (require 'ert) (require 'ert-x) (require 'dired) +(require 'dired-x) (require 'wdired) (defvar dired-query) ; Pacify byte compiler. @@ -124,10 +125,6 @@ wdired-mode." (set-buffer-modified-p nil) (kill-buffer buf)))))))) -(defvar server-socket-dir) -(declare-function dired-smart-shell-command "dired-x" - (command &optional output-buffer error-buffer)) - (ert-deftest wdired-test-bug34915 () "Test editing when dired-listing-switches includes -F. Appended file indicators should not count as part of the file @@ -137,10 +134,10 @@ suffices to compare the return values of dired-get-filename and wdired-get-filename before and after editing." ;; FIXME: Add a test for a door (indicator ">") only under Solaris? (ert-with-temp-directory test-dir - (let* ((server-socket-dir test-dir) - (dired-listing-switches "-Fl") + (let* ((dired-listing-switches "-Fl") (dired-ls-F-marks-symlinks (eq system-type 'darwin)) - (buf (find-file-noselect test-dir))) + (buf (find-file-noselect test-dir)) + proc) (unwind-protect (progn (with-current-buffer buf @@ -148,11 +145,12 @@ wdired-get-filename before and after editing." (set-file-modes "foo" (file-modes-symbolic-to-number "+x")) (make-symbolic-link "foo" "bar") (make-directory "foodir") - (require 'dired-x) (dired-smart-shell-command "mkfifo foopipe") - (server-force-delete) - ;; FIXME? This seems a heavy-handed way of making a socket. - (server-start) ; Add a socket file. + (setq proc (make-network-process + :name "foo" + :family 'local + :server t + :service (expand-file-name "foosocket" test-dir))) (kill-buffer buf)) (dired test-dir) (dired-toggle-read-only) @@ -172,7 +170,7 @@ wdired-get-filename before and after editing." (setq dir (dired-get-filename 'no-dir t))) (should (equal dir (pop names))))))) (kill-buffer (get-buffer test-dir)) - (server-force-delete))))) + (ignore-errors (delete-process proc)))))) (ert-deftest wdired-test-bug39280 () "Test for https://debbugs.gnu.org/39280." From 199e2468d3053d9cb81b5654664d88d4c8cec3ad Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 15 Nov 2021 10:58:53 +0100 Subject: [PATCH 044/367] Doc fix; change recommended file name of custom-file * lisp/cus-edit.el (custom-file): Change file name recommendation to match Info node '(emacs) Saving Customizations'. --- lisp/cus-edit.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index a0bde396735..5c4448ae71a 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4646,8 +4646,8 @@ You can set this option through Custom, if you carefully read the last paragraph below. However, usually it is simpler to write something like the following in your init file: -\(setq custom-file \"~/.emacs-custom.el\") -\(load custom-file) +(setq custom-file \"~/.config/emacs-custom.el\") +(load custom-file) Note that both lines are necessary: the first line tells Custom to save all customizations in this file, but does not load it. From bf505a63f98ed61934a8fb81ec65c96859606b6e Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 15 Nov 2021 13:33:07 +0100 Subject: [PATCH 045/367] Support abbreviating home directory of Tramp filenames * doc/lispref/files.texi (Magic File Names): Mention 'abbreviate-file-name' in the list of magic file name handlers. * etc/NEWS: Announce the change. * lisp/files.el (file-name-non-special): * lisp/net/tramp.el (tramp-file-name-for-operation): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add 'abbreviate-file-name'. * lisp/files.el (directory-abbrev-make-regexp): (directory-abbrev-apply): New functions. (abbreviate-file-name): Check for file name handler. * test/lisp/net/tramp-tests.el (tramp-test07-abbreviate-file-name): New test. --- doc/lispref/files.texi | 7 +- etc/NEWS | 11 +++ lisp/files.el | 141 ++++++++++++++++++----------------- lisp/net/tramp-sh.el | 3 +- lisp/net/tramp-smb.el | 3 +- lisp/net/tramp-sudoedit.el | 3 +- lisp/net/tramp.el | 19 +++++ test/lisp/net/tramp-tests.el | 25 +++++++ 8 files changed, 139 insertions(+), 73 deletions(-) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index d93770a0d2f..4b114ba111d 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3308,8 +3308,8 @@ first, before handlers for jobs such as remote file access. @ifnottex @noindent -@code{access-file}, @code{add-name-to-file}, -@code{byte-compiler-base-file-name},@* +@code{abbreviate-file-name}, @code{access-file}, +@code{add-name-to-file}, @code{byte-compiler-base-file-name},@* @code{copy-directory}, @code{copy-file}, @code{delete-directory}, @code{delete-file}, @code{diff-latest-backup-file}, @@ -3368,7 +3368,8 @@ first, before handlers for jobs such as remote file access. @iftex @noindent @flushleft -@code{access-file}, @code{add-name-to-file}, +@code{abbreviate-file-name}, @code{access-file}, +@code{add-name-to-file}, @code{byte-com@discretionary{}{}{}piler-base-file-name}, @code{copy-directory}, @code{copy-file}, @code{delete-directory}, @code{delete-file}, diff --git a/etc/NEWS b/etc/NEWS index 312fc18f4f1..0a19dcaf7ab 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -497,6 +497,14 @@ The newly created buffer will be displayed via 'display-buffer', which can be customized through the usual mechanism of 'display-buffer-alist' and friends. +** Tramp + +--- +*** Tramp supports abbreviating remote home directories now. +When calling 'abbreviate-file-name' on a Tramp filename, the result +will abbreviate the user's home directory, for example by abbreviating +"/ssh:user@host:/home/user" to "/ssh:user@host:~". + * New Modes and Packages in Emacs 29.1 @@ -632,6 +640,9 @@ This convenience function is useful when writing code that parses files at run-time, and allows Lisp programs to re-parse files only when they have changed. ++++ +** 'abbreviate-file-name' now respects magic file name handlers. + --- ** New function 'font-has-char-p'. This can be used to check whether a specific font has a glyph for a diff --git a/lisp/files.el b/lisp/files.el index 3490d0428a0..49bf06bfc1b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -68,6 +68,31 @@ a regexp matching the name it is linked to." :group 'abbrev :group 'find-file) +(defun directory-abbrev-make-regexp (directory) + "Create a regexp to match DIRECTORY for `directory-abbrev-alist'." + (let ((regexp + ;; We include a slash at the end, to avoid spurious + ;; matches such as `/usr/foobar' when the home dir is + ;; `/usr/foo'. + (concat "\\`" (regexp-quote directory) "\\(/\\|\\'\\)"))) + ;; The value of regexp could be multibyte or unibyte. In the + ;; latter case, we need to decode it. + (if (multibyte-string-p regexp) + regexp + (decode-coding-string regexp + (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system))))) + +(defun directory-abbrev-apply (filename) + "Apply the abbreviations in `directory-abbrev-alist' to FILENAME. +Note that when calling this, you should set `case-fold-search' as +appropriate for the filesystem used for FILENAME." + (dolist (dir-abbrev directory-abbrev-alist filename) + (when (string-match (car dir-abbrev) filename) + (setq filename (concat (cdr dir-abbrev) + (substring filename (match-end 0))))))) + (defcustom make-backup-files t "Non-nil means make a backup of a file the first time it is saved. This can be done by renaming the file or by copying. @@ -2015,73 +2040,54 @@ if you want to permanently change your home directory after having started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." ;; Get rid of the prefixes added by the automounter. (save-match-data ;FIXME: Why? - (if (and automount-dir-prefix - (string-match automount-dir-prefix filename) - (file-exists-p (file-name-directory - (substring filename (1- (match-end 0)))))) - (setq filename (substring filename (1- (match-end 0))))) - ;; Avoid treating /home/foo as /home/Foo during `~' substitution. - (let ((case-fold-search (file-name-case-insensitive-p filename))) - ;; If any elt of directory-abbrev-alist matches this name, - ;; abbreviate accordingly. - (dolist (dir-abbrev directory-abbrev-alist) - (if (string-match (car dir-abbrev) filename) - (setq filename - (concat (cdr dir-abbrev) - (substring filename (match-end 0)))))) - ;; Compute and save the abbreviated homedir name. - ;; We defer computing this until the first time it's needed, to - ;; give time for directory-abbrev-alist to be set properly. - ;; We include a slash at the end, to avoid spurious matches - ;; such as `/usr/foobar' when the home dir is `/usr/foo'. - (unless abbreviated-home-dir - (put 'abbreviated-home-dir 'home (expand-file-name "~")) - (setq abbreviated-home-dir - (let* ((abbreviated-home-dir "\\`\\'.") ;Impossible regexp. - (regexp - (concat "\\`" - (regexp-quote - (abbreviate-file-name - (get 'abbreviated-home-dir 'home))) - "\\(/\\|\\'\\)"))) - ;; Depending on whether default-directory does or - ;; doesn't include non-ASCII characters, the value - ;; of abbreviated-home-dir could be multibyte or - ;; unibyte. In the latter case, we need to decode - ;; it. Note that this function is called for the - ;; first time (from startup.el) when - ;; locale-coding-system is already set up. - (if (multibyte-string-p regexp) - regexp - (decode-coding-string regexp - (if (eq system-type 'windows-nt) - 'utf-8 - locale-coding-system)))))) + (if-let ((handler (find-file-name-handler filename 'abbreviate-file-name))) + (funcall handler 'abbreviate-file-name filename) + (if (and automount-dir-prefix + (string-match automount-dir-prefix filename) + (file-exists-p (file-name-directory + (substring filename (1- (match-end 0)))))) + (setq filename (substring filename (1- (match-end 0))))) + ;; Avoid treating /home/foo as /home/Foo during `~' substitution. + (let ((case-fold-search (file-name-case-insensitive-p filename))) + ;; If any elt of directory-abbrev-alist matches this name, + ;; abbreviate accordingly. + (setq filename (directory-abbrev-apply filename)) - ;; If FILENAME starts with the abbreviated homedir, - ;; and ~ hasn't changed since abbreviated-home-dir was set, - ;; make it start with `~' instead. - ;; If ~ has changed, we ignore abbreviated-home-dir rather than - ;; invalidating it, on the assumption that a change in HOME - ;; is likely temporary (eg for testing). - ;; FIXME Is it even worth caching abbreviated-home-dir? - ;; Ref: https://debbugs.gnu.org/19657#20 - (let (mb1) - (if (and (string-match abbreviated-home-dir filename) - (setq mb1 (match-beginning 1)) - ;; If the home dir is just /, don't change it. - (not (and (= (match-end 0) 1) - (= (aref filename 0) ?/))) - ;; MS-DOS root directories can come with a drive letter; - ;; Novell Netware allows drive letters beyond `Z:'. - (not (and (memq system-type '(ms-dos windows-nt cygwin)) - (string-match "\\`[a-zA-`]:/\\'" filename))) - (equal (get 'abbreviated-home-dir 'home) - (expand-file-name "~"))) - (setq filename - (concat "~" - (substring filename mb1)))) - filename)))) + ;; Compute and save the abbreviated homedir name. + ;; We defer computing this until the first time it's needed, to + ;; give time for directory-abbrev-alist to be set properly. + (unless abbreviated-home-dir + (put 'abbreviated-home-dir 'home (expand-file-name "~")) + (setq abbreviated-home-dir + (directory-abbrev-make-regexp + (let ((abbreviated-home-dir "\\`\\'.")) ;Impossible regexp. + (abbreviate-file-name + (get 'abbreviated-home-dir 'home)))))) + + ;; If FILENAME starts with the abbreviated homedir, + ;; and ~ hasn't changed since abbreviated-home-dir was set, + ;; make it start with `~' instead. + ;; If ~ has changed, we ignore abbreviated-home-dir rather than + ;; invalidating it, on the assumption that a change in HOME + ;; is likely temporary (eg for testing). + ;; FIXME Is it even worth caching abbreviated-home-dir? + ;; Ref: https://debbugs.gnu.org/19657#20 + (let (mb1) + (if (and (string-match abbreviated-home-dir filename) + (setq mb1 (match-beginning 1)) + ;; If the home dir is just /, don't change it. + (not (and (= (match-end 0) 1) + (= (aref filename 0) ?/))) + ;; MS-DOS root directories can come with a drive letter; + ;; Novell Netware allows drive letters beyond `Z:'. + (not (and (memq system-type '(ms-dos windows-nt cygwin)) + (string-match "\\`[a-zA-`]:/\\'" filename))) + (equal (get 'abbreviated-home-dir 'home) + (expand-file-name "~"))) + (setq filename + (concat "~" + (substring filename mb1)))) + filename))))) (defun find-buffer-visiting (filename &optional predicate) "Return the buffer visiting file FILENAME (a string). @@ -7836,10 +7842,11 @@ only these files will be asked to be saved." ;; Get a list of the indices of the args that are file names. (file-arg-indices (cdr (or (assq operation - '(;; The first seven are special because they + '(;; The first eight are special because they ;; return a file name. We want to include ;; the /: in the return value. So just ;; avoid stripping it in the first place. + (abbreviate-file-name) (directory-file-name) (expand-file-name) (file-name-as-directory) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c61025a86b2..b83569f3ded 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -942,7 +942,8 @@ Format specifiers \"%s\" are replaced before the script is used.") ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-sh-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '((abbreviate-file-name . tramp-handle-abbreviate-file-name) + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-sh-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-sh-handle-copy-directory) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 0b25164902e..24119539db0 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -222,7 +222,8 @@ See `tramp-actions-before-shell' for more info.") ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-smb-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '((abbreviate-file-name . tramp-handle-abbreviate-file-name) + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-smb-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-smb-handle-copy-directory) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 7cf0ea451d2..c91bced656c 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -63,7 +63,8 @@ See `tramp-actions-before-shell' for more info.") ;;;###tramp-autoload (defconst tramp-sudoedit-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '((abbreviate-file-name . tramp-handle-abbreviate-file-name) + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-sudoedit-handle-add-name-to-file) (byte-compiler-base-file-name . ignore) (copy-directory . tramp-handle-copy-directory) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5fcf7f9b650..d314df7b00a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2495,6 +2495,8 @@ Must be handled by the callers." file-system-info ;; Emacs 28+ only. file-locked-p lock-file make-lock-file-name unlock-file + ;; Emacs 29+ only. + abbreviate-file-name ;; Tramp internal magic file name function. tramp-set-file-uid-gid)) (if (file-name-absolute-p (nth 0 args)) @@ -3282,6 +3284,23 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") +(defun tramp-handle-abbreviate-file-name (filename) + "Like `abbreviate-file-name' for Tramp files." + (let* ((case-fold-search (file-name-case-insensitive-p filename)) + (home-dir + (with-parsed-tramp-file-name filename nil + (with-tramp-connection-property v "home-directory" + (directory-abbrev-apply (expand-file-name + (tramp-make-tramp-file-name v "~"))))))) + ;; If any elt of directory-abbrev-alist matches this name, + ;; abbreviate accordingly. + (setq filename (directory-abbrev-apply filename)) + (if (string-match (directory-abbrev-make-regexp home-dir) filename) + (with-parsed-tramp-file-name filename nil + (tramp-make-tramp-file-name + v (concat "~" (substring filename (match-beginning 1))))) + filename))) + (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (setq filename (file-truename filename)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 52c6159dc12..698d18b5282 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2289,6 +2289,31 @@ This checks also `file-name-as-directory', `file-name-directory', (should (string-equal (file-name-directory file) file)) (should (string-equal (file-name-nondirectory file) ""))))))) +(ert-deftest tramp-test07-abbreviate-file-name () + "Check that Tramp abbreviates file names correctly." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-emacs29-p)) + + (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory)) + (home-dir (expand-file-name (concat remote-host "~")))) + ;; Check home-dir abbreviation. + (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) + (concat remote-host "~/foo/bar"))) + (should (equal (abbreviate-file-name (concat remote-host + "/nowhere/special")) + (concat remote-host "/nowhere/special"))) + ;; Check `directory-abbrev-alist' abbreviation. + (let ((directory-abbrev-alist + `((,(concat "\\`" (regexp-quote home-dir) "/foo") + . ,(concat home-dir "/f")) + (,(concat "\\`" (regexp-quote remote-host) "/nowhere") + . ,(concat remote-host "/nw"))))) + (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) + (concat remote-host "~/f/bar"))) + (should (equal (abbreviate-file-name (concat remote-host + "/nowhere/special")) + (concat remote-host "/nw/special")))))) + (ert-deftest tramp-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." (skip-unless (tramp--test-enabled)) From 83023117de77c3c41286b0eeb56e2e5417080c43 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 15 Nov 2021 13:34:00 +0100 Subject: [PATCH 046/367] Add another 'abbreviate-file-name' test * test/lisp/files-tests.el (files-tests-file-name-non-special-abbreviate-file-name): New test. --- test/lisp/files-tests.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index d00f1ce3263..2c4557ead61 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -465,6 +465,15 @@ unquoted file names." (let (file-name-handler-alist) (concat (file-name-sans-extension name) part (file-name-extension name t)))) +(ert-deftest files-tests-file-name-non-special-abbreviate-file-name () + (let* ((homedir temporary-file-directory) + (process-environment (cons (format "HOME=%s" homedir) + process-environment)) + (abbreviated-home-dir nil)) + ;; Check that abbreviation doesn't occur for quoted file names. + (should (equal (concat "/:" homedir "foo/bar") + (abbreviate-file-name (concat "/:" homedir "foo/bar")))))) + (ert-deftest files-tests-file-name-non-special-access-file () (files-tests--with-temp-non-special (tmpfile nospecial) ;; Both versions of the file name work. From 5044151486cfd88edceb841d2bf8378dcc906e34 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 15 Nov 2021 15:35:31 +0200 Subject: [PATCH 047/367] Avoid segfaults due to freed face cache * src/xfaces.c (face_at_buffer_position): Make sure DEFAULT_FACE is usable. (Bug#51864) --- src/xfaces.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/xfaces.c b/src/xfaces.c index 5e63e87d751..18e65d07e20 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6423,7 +6423,10 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, else face_id = lookup_basic_face (w, f, DEFAULT_FACE_ID); - default_face = FACE_FROM_ID (f, face_id); + default_face = FACE_FROM_ID_OR_NULL (f, face_id); + if (!default_face) + default_face = FACE_FROM_ID (f, + lookup_basic_face (w, f, DEFAULT_FACE_ID)); } /* Optimize common cases where we can use the default face. */ From 5b250ca79b9aeeeea0b521db9645882240f08c9f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 15 Nov 2021 17:50:15 +0100 Subject: [PATCH 048/367] Fix minor problems resulting from Tramp regression tests * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): Add comment. * lisp/net/tramp-cache.el (tramp-flush-file-upper-properties): FILE can be "~". * lisp/net/tramp.el ('tramp-ensure-dissected-file-name): Add `tramp-suppress-trace' property. (tramp-get-debug-buffer): Add local key for debugging. (tramp-handle-abbreviate-file-name): Adapt implementation. * test/lisp/net/tramp-tests.el (tramp-test07-abbreviate-file-name): Adapt test. (tramp-test17-insert-directory-one-file) (tramp--test-check-files): Use proper `no-dir' argument for `dired-get-filename'. --- lisp/net/tramp-adb.el | 3 ++- lisp/net/tramp-archive.el | 3 ++- lisp/net/tramp-cache.el | 4 +++- lisp/net/tramp-crypt.el | 3 ++- lisp/net/tramp-gvfs.el | 3 ++- lisp/net/tramp-rclone.el | 3 ++- lisp/net/tramp-sshfs.el | 3 ++- lisp/net/tramp.el | 31 ++++++++++++++++++++----------- test/lisp/net/tramp-tests.el | 24 +++++++++++++----------- 9 files changed, 48 insertions(+), 29 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 895543d6db9..341357d404c 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -107,7 +107,8 @@ It is used for TCP/IP devices." ;;;###tramp-autoload (defconst tramp-adb-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-handle-copy-directory) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 3e0d876dd9e..efd38e6b4b7 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -211,7 +211,8 @@ It must be supported by libarchive(3).") ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-archive-file-name-handler-alist - '((access-file . tramp-archive-handle-access-file) + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-archive-handle-access-file) (add-name-to-file . tramp-archive-handle-not-implemented) ;; `byte-compiler-base-file-name' performed by default handler. ;; `copy-directory' performed by default handler. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 5e7d24ff72b..f2be297d59c 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -224,7 +224,9 @@ Return VALUE." (defun tramp-flush-file-upper-properties (key file) "Remove some properties of FILE's upper directory." (when (file-name-absolute-p file) - (let ((file (directory-file-name (file-name-directory file)))) + ;; `file-name-directory' can return nil, for example for "~". + (when-let ((file (file-name-directory file)) + (file (directory-file-name file))) ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq file (tramp-compat-file-name-unquote file) key (copy-tramp-file-name key)) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 42b67ac7a8e..f60841cf8c1 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -157,7 +157,8 @@ If NAME doesn't belong to a crypted remote directory, retun nil." ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-crypt-file-name-handler-alist - '((access-file . tramp-crypt-handle-access-file) + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-crypt-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-handle-copy-directory) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 220ce63c0f7..a4a7bacd8ac 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -744,7 +744,8 @@ It has been changed in GVFS 1.14.") ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-gvfs-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-handle-copy-directory) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 28a1c01aa61..09862c6a04c 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -71,7 +71,8 @@ ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-rclone-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-handle-copy-directory) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index a9d8dc933b3..a19c99316e6 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -71,7 +71,8 @@ ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-sshfs-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-handle-copy-directory) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d314df7b00a..26425199bfa 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1677,6 +1677,8 @@ If it's not a Tramp filename, return nil." ((tramp-tramp-file-p vec-or-filename) (tramp-dissect-file-name vec-or-filename)))) +(put #'tramp-ensure-dissected-file-name 'tramp-suppress-trace t) + (defun tramp-dissect-hop-name (name &optional nodefault) "Return a `tramp-file-name' structure of `hop' part of NAME. See `tramp-dissect-file-name' for details." @@ -1924,7 +1926,9 @@ The outline level is equal to the verbosity of the Tramp message." `(t (eval ,tramp-debug-font-lock-keywords t) ,(eval tramp-debug-font-lock-keywords t))) ;; Do not edit the debug buffer. - (use-local-map special-mode-map)) + (use-local-map special-mode-map) + ;; For debugging purposes. + (define-key (current-local-map) "\M-n" 'clone-buffer)) (current-buffer))) (put #'tramp-get-debug-buffer 'tramp-suppress-trace t) @@ -3284,21 +3288,26 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") +;; `directory-abbrev-apply' and `directory-abbrev-make-regexp' exists +;; since Emacs 29.1. Since this handler isn't called for older +;; Emacsen, it is save to invoke them via `tramp-compat-funcall'. (defun tramp-handle-abbreviate-file-name (filename) "Like `abbreviate-file-name' for Tramp files." (let* ((case-fold-search (file-name-case-insensitive-p filename)) + (vec (tramp-dissect-file-name filename)) (home-dir - (with-parsed-tramp-file-name filename nil - (with-tramp-connection-property v "home-directory" - (directory-abbrev-apply (expand-file-name - (tramp-make-tramp-file-name v "~"))))))) - ;; If any elt of directory-abbrev-alist matches this name, + (with-tramp-connection-property vec "home-directory" + (tramp-compat-funcall + 'directory-abbrev-apply + (expand-file-name (tramp-make-tramp-file-name vec "~")))))) + ;; If any elt of `directory-abbrev-alist' matches this name, ;; abbreviate accordingly. - (setq filename (directory-abbrev-apply filename)) - (if (string-match (directory-abbrev-make-regexp home-dir) filename) - (with-parsed-tramp-file-name filename nil - (tramp-make-tramp-file-name - v (concat "~" (substring filename (match-beginning 1))))) + (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename)) + ;; Abbreviate home directory. + (if (string-match + (tramp-compat-funcall 'directory-abbrev-make-regexp home-dir) filename) + (tramp-make-tramp-file-name + vec (concat "~" (substring filename (match-beginning 1)))) filename))) (defun tramp-handle-access-file (filename string) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 698d18b5282..150ea29838c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2297,11 +2297,13 @@ This checks also `file-name-as-directory', `file-name-directory', (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory)) (home-dir (expand-file-name (concat remote-host "~")))) ;; Check home-dir abbreviation. - (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) - (concat remote-host "~/foo/bar"))) - (should (equal (abbreviate-file-name (concat remote-host - "/nowhere/special")) - (concat remote-host "/nowhere/special"))) + (unless (string-suffix-p "~" home-dir) + (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) + (concat remote-host "~/foo/bar"))) + (should (equal (abbreviate-file-name + (concat remote-host "/nowhere/special")) + (concat remote-host "/nowhere/special")))) + ;; Check `directory-abbrev-alist' abbreviation. (let ((directory-abbrev-alist `((,(concat "\\`" (regexp-quote home-dir) "/foo") @@ -2310,8 +2312,8 @@ This checks also `file-name-as-directory', `file-name-directory', . ,(concat remote-host "/nw"))))) (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) (concat remote-host "~/f/bar"))) - (should (equal (abbreviate-file-name (concat remote-host - "/nowhere/special")) + (should (equal (abbreviate-file-name + (concat remote-host "/nowhere/special")) (concat remote-host "/nw/special")))))) (ert-deftest tramp-test07-file-exists-p () @@ -3327,7 +3329,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (while (not (or (eobp) (string-equal - (dired-get-filename 'localp 'no-error) + (dired-get-filename 'no-dir 'no-error) (file-name-nondirectory tmp-name2)))) (forward-line 1)) (should-not (eobp)) @@ -3337,14 +3339,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Point shall still be the recent file. (should (string-equal - (dired-get-filename 'localp 'no-error) + (dired-get-filename 'no-dir 'no-error) (file-name-nondirectory tmp-name2))) (should-not (re-search-forward "dired" nil t)) ;; The copied file has been inserted the line before. (forward-line -1) (should (string-equal - (dired-get-filename 'localp 'no-error) + (dired-get-filename 'no-dir 'no-error) (file-name-nondirectory tmp-name3)))) (kill-buffer buffer)) @@ -6329,7 +6331,7 @@ This requires restrictions of file name syntax." (setq buffer (dired-noselect tmp-name1 "--dired -al")) (goto-char (point-min)) (while (not (eobp)) - (when-let ((name (dired-get-filename 'localp 'no-error))) + (when-let ((name (dired-get-filename 'no-dir 'no-error))) (unless (string-match-p name directory-files-no-dot-files-regexp) (should (member name files)))) From c840bfe7e13200b12e3d96eb83f3972f5d25cd0c Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 15 Nov 2021 19:39:37 +0200 Subject: [PATCH 049/367] * lisp/repeat.el: Detect changes in the minibuffer state (bug#47566) (repeat--prev-mb): New internal variable. (repeat-post-hook): Check the property 'repeat-map' on the symbol from 'this-command' in addition to 'real-this-command'. Don't allow repeatable maps in the activated minibuffer or in the minibuffer from another command. Set 'repeat--prev-mb' at the end. --- lisp/repeat.el | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index ac08952eaa8..4ad6019a04d 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -402,12 +402,17 @@ See `describe-repeat-maps' for a list of all repeatable commands." (length commands) (length (delete-dups keymaps)))))) +(defvar repeat--prev-mb '(0) + "Previous minibuffer state.") + (defun repeat-post-hook () "Function run after commands to set transient keymap for repeatable keys." (let ((was-in-progress repeat-in-progress)) (setq repeat-in-progress nil) (when repeat-mode (let ((rep-map (or repeat-map + (and (symbolp this-command) + (get this-command 'repeat-map)) (and (symbolp real-this-command) (get real-this-command 'repeat-map))))) (when rep-map @@ -415,11 +420,16 @@ See `describe-repeat-maps' for a list of all repeatable commands." (setq rep-map (symbol-value rep-map))) (let ((map (copy-keymap rep-map))) - ;; Exit when the last char is not among repeatable keys, - ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. - (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts - (or (lookup-key map (this-command-keys-vector)) - prefix-arg)) + (when (and + ;; Detect changes in the minibuffer state to allow repetitions + ;; in the same minibuffer, but not when the minibuffer is activated + ;; in the middle of repeating sequence (bug#47566). + (or (< (minibuffer-depth) (car repeat--prev-mb)) + (eq current-minibuffer-command (cdr repeat--prev-mb))) + ;; Exit when the last char is not among repeatable keys, + ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. + (or (lookup-key map (this-command-keys-vector)) + prefix-arg)) ;; Messaging (unless prefix-arg @@ -449,6 +459,7 @@ See `describe-repeat-maps' for a list of all repeatable commands." (funcall repeat-echo-function nil))))))))))) (setq repeat-map nil) + (setq repeat--prev-mb (cons (minibuffer-depth) current-minibuffer-command)) (when (and was-in-progress (not repeat-in-progress)) (when repeat-exit-timer (cancel-timer repeat-exit-timer) From fe2ac7cb7cf206c86f80304906beb58302c0d31f Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Mon, 15 Nov 2021 19:50:30 +0200 Subject: [PATCH 050/367] * lisp/repeat.el (describe-repeat-maps): Use help-fns--analyze-function. Print keys bound to commands in every keymap (bug#49265) --- lisp/repeat.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index 4ad6019a04d..96ea8a02501 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -507,10 +507,13 @@ See `describe-repeat-maps' for a list of all repeatable commands." repeat-echo-mode-line-string))) (force-mode-line-update t))) +(declare-function help-fns--analyze-function "help-fns" (function)) + (defun describe-repeat-maps () "Describe mappings of commands repeatable by symbol property `repeat-map'. Used in `repeat-mode'." (interactive) + (require 'help-fns) (help-setup-xref (list #'describe-repeat-maps) (called-interactively-p 'interactive)) (let ((keymaps nil)) @@ -527,7 +530,12 @@ Used in `repeat-mode'." (princ (format-message "`%s' keymap is repeatable by these commands:\n" (car keymap))) (dolist (command (sort (cdr keymap) 'string-lessp)) - (princ (format-message " `%s'\n" command))) + (let* ((info (help-fns--analyze-function command)) + (map (list (symbol-value (car keymap)))) + (desc (key-description + (or (where-is-internal command map t) + (where-is-internal (nth 3 info) map t))))) + (princ (format-message " `%s' (bound to '%s')\n" command desc)))) (princ "\n")))))) (provide 'repeat) From b418aad85a3d62aa427e7af72c96ca1d644dbc02 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 15 Nov 2021 19:53:29 +0200 Subject: [PATCH 051/367] * lisp/repeat.el (repeat-echo-message): Bind message-log-max to nil. Don't insert messages about repeatable keys in the *Messages* buffer. --- lisp/repeat.el | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index 96ea8a02501..45201ad1aa6 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -481,19 +481,20 @@ See `describe-repeat-maps' for a list of all repeatable commands." (defun repeat-echo-message (keymap) "Display available repeating keys in the echo area." - (if keymap - (let ((message (repeat-echo-message-string keymap))) - (if (current-message) - (message "%s [%s]" (current-message) message) - (message "%s" message))) - (let ((message (current-message))) - (when message - (cond - ((string-prefix-p "Repeat with " message) - (message nil)) - ((string-search " [Repeat with " message) - (message "%s" (replace-regexp-in-string - " \\[Repeat with .*\\'" "" message)))))))) + (let ((message-log-max nil)) + (if keymap + (let ((message (repeat-echo-message-string keymap))) + (if (current-message) + (message "%s [%s]" (current-message) message) + (message "%s" message))) + (let ((message (current-message))) + (when message + (cond + ((string-prefix-p "Repeat with " message) + (message nil)) + ((string-search " [Repeat with " message) + (message "%s" (replace-regexp-in-string + " \\[Repeat with .*\\'" "" message))))))))) (defvar repeat-echo-mode-line-string (propertize "[Repeating...] " 'face 'mode-line-emphasis) From e852822f3db469c985bf022651f184d6ff2c518a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 15 Nov 2021 20:20:30 +0200 Subject: [PATCH 052/367] Fix removal of fringe marks of deleted bookmarks * lisp/bookmark.el (bookmark--remove-fringe-mark): The fringe overlay is at BOL, not at POS. (Bug#51233) --- lisp/bookmark.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index fb90f01456e..623f0acd28a 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -479,7 +479,10 @@ See user option `bookmark-set-fringe'." (dolist (buf (buffer-list)) (with-current-buffer buf (when (equal filename buffer-file-name) - (setq overlays (overlays-in pos (1+ pos))) + (setq overlays + (save-excursion + (goto-char pos) + (overlays-in (point-at-bol) (1+ (point-at-bol))))) (while (and (not found) (setq temp (pop overlays))) (when (eq 'bookmark (overlay-get temp 'category)) (delete-overlay (setq found temp)))))))))) From 367cf464a120d4c57d32322e98f3372294f68f4d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Nov 2021 09:08:43 +0800 Subject: [PATCH 053/367] Fix documentation string * src/xwidget.c (Vxwidget_list, Vxwidget_views_list): Fix horrid doc string. --- src/xwidget.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index aae2479134a..3bf4f12799a 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2600,11 +2600,11 @@ syms_of_xwidget (void) DEFSYM (QCplist, ":plist"); DEFVAR_LISP ("xwidget-list", Vxwidget_list, - doc: /* xwidgets list. */); + doc: /* List of all xwidgets that have not been killed. */); Vxwidget_list = Qnil; DEFVAR_LISP ("xwidget-view-list", Vxwidget_view_list, - doc: /* xwidget views list. */); + doc: /* List of all xwidget views. */); Vxwidget_view_list = Qnil; Fprovide (intern ("xwidget-internal"), Qnil); From a17e3976a8dcbc0eb2034fe3cf62562d8d2494bf Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Nov 2021 09:25:55 +0800 Subject: [PATCH 054/367] Fix xwidget isearch for queries that look like format strings * lisp/xwidget.el (xwidget-webkit-isearch--update): Give special treatment to messages. --- lisp/xwidget.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 485d995f418..a587fe85dbc 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -911,8 +911,8 @@ WebKit widget. The query will be set to the contents of (xwidget-webkit-current-session) t xwidget-webkit-isearch--is-reverse t)) (let ((message-log-max nil)) - (message (concat (propertize "Search contents: " 'face 'minibuffer-prompt) - xwidget-webkit-isearch--string)))) + (message "%s" (concat (propertize "Search contents: " 'face 'minibuffer-prompt) + xwidget-webkit-isearch--string)))) (defun xwidget-webkit-isearch-erasing-char (count) "Erase the last COUNT characters of the current query." From 7cfc3f34bb138def9a1e5b5bce2173b7bb884ad5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Nov 2021 09:30:32 +0800 Subject: [PATCH 055/367] Prevent xwidget windows from obscuring child frames * src/xwidget.c (x_draw_xwidget_glyph_string): Lower view window when creating it. --- src/xwidget.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/xwidget.c b/src/xwidget.c index 3bf4f12799a..008eb07bcae 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -1683,6 +1683,7 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) clip_bottom - clip_top, 0, CopyFromParent, CopyFromParent, CopyFromParent, CWEventMask, &a); + XLowerWindow (xv->dpy, xv->wdesc); XDefineCursor (xv->dpy, xv->wdesc, xv->cursor); xv->cr_surface = cairo_xlib_surface_create (xv->dpy, xv->wdesc, From 1d3381ae352d97f69d649a5140286cf8f39e0d2b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 16 Nov 2021 05:06:48 +0100 Subject: [PATCH 056/367] Fix recently changed wdired test on MS-Windows * test/lisp/wdired-tests.el (wdired-test-bug34915): Don't try to create a local socket on MS-Windows, as it is not supported on that platform. Problem reported by Robert Pluim . --- test/lisp/wdired-tests.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index 9678fce84d0..47ed26f609d 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el @@ -146,11 +146,12 @@ wdired-get-filename before and after editing." (make-symbolic-link "foo" "bar") (make-directory "foodir") (dired-smart-shell-command "mkfifo foopipe") - (setq proc (make-network-process - :name "foo" - :family 'local - :server t - :service (expand-file-name "foosocket" test-dir))) + (when (featurep 'make-network-process '(:family local)) + (setq proc (make-network-process + :name "foo" + :family 'local + :server t + :service (expand-file-name "foosocket" test-dir)))) (kill-buffer buf)) (dired test-dir) (dired-toggle-read-only) From cb0aa89bcfb801ec2737e9b1a534bb87d3363dd9 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Mon, 15 Nov 2021 21:55:53 -0800 Subject: [PATCH 057/367] Fix checkdoc complaints in MH-E * lisp/mh-e/mh-compat.el (mh-flet): Rewrite most of the docstring. (mh-write-file-functions): Remove trailing space. * lisp/mh-e-mh-scan.el (mh-scan-cmd-note-width): Break up a line that was too long. --- lisp/mh-e/mh-compat.el | 9 ++++----- lisp/mh-e/mh-scan.el | 6 +++++- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 19be5afd790..23dc48a574c 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -46,10 +46,9 @@ ;; cl-letf. This macro is based upon gmm-flet from Gnus. (defmacro mh-flet (bindings &rest body) "Make temporary overriding function definitions. -This is an analogue of a dynamically scoped `let' that operates on -the function cell of FUNCs rather than their value cell. - -\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" +That is, temporarily rebind the functions listed in BINDINGS and then +execute BODY. BINDINGS is a list containing one or more lists of the +form (FUNCNAME ARGLIST BODY...), similar to defun." (declare (indent 1) (debug ((&rest (sexp sexp &rest form)) &rest form))) (if (fboundp 'cl-letf) `(cl-letf ,(mapcar (lambda (binding) @@ -138,7 +137,7 @@ This is taken from RFC 2396.") #'window-full-height-p "29.1") (defmacro mh-write-file-functions () - "Return `write-file-functions'. " + "Return `write-file-functions'." (declare (obsolete nil "29.1")) ''write-file-functions) diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index bf3cfeff5cb..9ac251e8b71 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -327,7 +327,11 @@ Note that columns in Emacs start with 0.") (defvar mh-scan-cmd-note-width 1 "Number of columns consumed by the cmd-note field in `mh-scan-format'. -This column will have one of the values: \" \", \"^\", \"D\", \"B\", \"A\", \"+\", where +This column will have one of the values: + + \" \", \"^\", \"D\", \"B\", \"A\", \"+\" + +where \" \" is the default value, \"^\" is the `mh-note-refiled' character, From d89d5e0f9466b9823fe31d02a374d654163594e4 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Mon, 15 Nov 2021 22:03:54 -0800 Subject: [PATCH 058/367] Fix handling of folder "+/" in MH-E * lisp/mh-e/mh-utils.el (mh-sub-folders): Fix handling of "+/". * test/lisp/mh-e/mh-utils-tests.el (mh-folder-completion-function-08-plus-slash) (mh-folder-completion-function-09-plus-slash-tmp): Fix errors made importing tests from mh-unit.el; remove declaration that these tests are expected to fail. --- lisp/mh-e/mh-utils.el | 7 ++++++- test/lisp/mh-e/mh-utils-tests.el | 6 ++---- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index feebf6416fe..1c322b80340 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -531,7 +531,12 @@ results of the actual folders call. If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a slash is added to each of the sub-folder names that may have nested folders within them." - (let* ((folder (mh-normalize-folder-name folder nil nil t)) + ;; In most cases we want to remove a trailing slash. We keep the + ;; slash for "+/", because it refers to folders in the system root + ;; directory, whereas "+" refers to the user's top-level folders. + (let* ((folder (mh-normalize-folder-name folder nil + (string= folder "+/") + t)) (match (gethash folder mh-sub-folders-cache 'no-result)) (sub-folders (cond ((eq match 'no-result) (setf (gethash folder mh-sub-folders-cache) diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index d9a26e58959..0df4d44646f 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -437,8 +437,7 @@ and the `should' macro requires idempotent evaluation anyway." (ert-deftest mh-folder-completion-function-08-plus-slash () "Test `mh-folder-completion-function' with `+/'." - :expected-result :failed ;to be fixed in a patch by mkupfer - (mh-test-folder-completion-1 "+/" "+/" "tmp/" nil) + (mh-test-folder-completion-1 "+/" "+/" "tmp/" t) ;; case "bb" (with-mh-test-env (should (equal nil @@ -447,8 +446,7 @@ and the `should' macro requires idempotent evaluation anyway." (ert-deftest mh-folder-completion-function-09-plus-slash-tmp () "Test `mh-folder-completion-function' with `+/tmp'." - :expected-result :failed ;to be fixed in a patch by mkupfer - (mh-test-folder-completion-1 "+/tmp" "+/tmp" "tmp/" t)) + (mh-test-folder-completion-1 "+/tmp" "+/tmp/" "tmp/" t)) (ert-deftest mh-folder-completion-function-10-plus-slash-abs-folder () "Test `mh-folder-completion-function' with `+/abso-folder'." From aa4cffccac0794870985c9d6cec82a0eb7bab137 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 15 Nov 2021 10:07:11 +0100 Subject: [PATCH 059/367] Make erc-mode noninteractive * lisp/erc/erc.el (erc-mode): Mark it as noninteractive, because using it from `M-x' will only lead to problems (bug#51841). --- lisp/erc/erc.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index abb1f64a822..c5a4fbe5a09 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1479,6 +1479,7 @@ Defaults to the server buffer." (define-derived-mode erc-mode fundamental-mode "ERC" "Major mode for Emacs IRC." + :interactive nil (setq local-abbrev-table erc-mode-abbrev-table) (setq-local next-line-add-newlines nil) (setq line-move-ignore-invisible t) From 560c921ed8d2d14e593aaee68b8be57b189128e5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Nov 2021 08:02:22 +0100 Subject: [PATCH 060/367] Allow removing keymap definitions * src/keymap.c (initial_define_lispy_key): Adjust caller. (store_in_keymap): Allow removing definitions in addition to setting them to nil. (Fdefine_key): Ditto. (define_as_prefix): Adjust caller. * src/term.c (term_get_fkeys_1): Adjust caller. --- etc/NEWS | 6 +++++ src/keymap.c | 58 +++++++++++++++++++++++++++++----------- src/term.c | 16 ++++++----- test/src/keymap-tests.el | 34 +++++++++++++++++++++++ 4 files changed, 92 insertions(+), 22 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 0a19dcaf7ab..ed95f891db7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -593,6 +593,12 @@ Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 ++++ +** 'define-key' now takes an optional REMOVE argument. +If non-nil, remove the definition from the keymap. This is subtly +different from setting a definition to nil (when the keymap has a +parent). + +++ ** New function 'file-name-split'. This returns a list of all the components of a file name. diff --git a/src/keymap.c b/src/keymap.c index 29d2ca7ab7e..c6990cffaf6 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -73,7 +73,8 @@ static Lisp_Object where_is_cache; /* Which keymaps are reverse-stored in the cache. */ static Lisp_Object where_is_cache_keymaps; -static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); +static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object, + bool); static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object, @@ -130,7 +131,8 @@ in case you use it as a menu with `x-popup-menu'. */) void initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname) { - store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname)); + store_in_keymap (keymap, intern_c_string (keyname), + intern_c_string (defname), Qnil); } DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, @@ -729,7 +731,8 @@ get_keyelt (Lisp_Object object, bool autoload) } static Lisp_Object -store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) +store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, + Lisp_Object def, bool remove) { /* Flush any reverse-map cache. */ where_is_cache = Qnil; @@ -805,21 +808,26 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) } else if (CHAR_TABLE_P (elt)) { + Lisp_Object sdef = def; + if (remove) + sdef = Qnil; + /* nil has a special meaning for char-tables, so + we use something else to record an explicitly + unbound entry. */ + else if (NILP (sdef)) + sdef = Qt; + /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ if (FIXNATP (idx) && !(XFIXNAT (idx) & CHAR_MODIFIER_MASK)) { - Faset (elt, idx, - /* nil has a special meaning for char-tables, so - we use something else to record an explicitly - unbound entry. */ - NILP (def) ? Qt : def); + Faset (elt, idx, sdef); return def; } else if (CONSP (idx) && CHARACTERP (XCAR (idx))) { - Fset_char_table_range (elt, idx, NILP (def) ? Qt : def); + Fset_char_table_range (elt, idx, sdef); return def; } insertion_point = tail; @@ -838,7 +846,12 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) else if (EQ (idx, XCAR (elt))) { CHECK_IMPURE (elt, XCONS (elt)); - XSETCDR (elt, def); + if (remove) + /* Remove the element. */ + insertion_point = Fdelq (elt, insertion_point); + else + /* Just set the definition. */ + XSETCDR (elt, def); return def; } else if (CONSP (idx) @@ -851,7 +864,10 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) if (from <= XFIXNAT (XCAR (elt)) && to >= XFIXNAT (XCAR (elt))) { - XSETCDR (elt, def); + if (remove) + insertion_point = Fdelq (elt, insertion_point); + else + XSETCDR (elt, def); if (from == to) return def; } @@ -1054,8 +1070,11 @@ possibly_translate_key_sequence (Lisp_Object key, ptrdiff_t *length) /* GC is possible in this function if it autoloads a keymap. */ -DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, +DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 4, 0, doc: /* In KEYMAP, define key sequence KEY as DEF. +This is a legacy function; see `keymap-set' for the recommended +function to use instead. + KEYMAP is a keymap. KEY is a string or a vector of symbols and characters, representing a @@ -1082,10 +1101,16 @@ DEF is anything that can be a key's definition: or an extended menu item definition. (See info node `(elisp)Extended Menu Items'.) +If REMOVE is non-nil, the definition will be removed. This is almost +the same as setting the definition to nil, but makes a difference if +the KEYMAP has a parent, and KEY is shadowing the same binding in the +parent. With REMOVE, subsequent lookups will return the binding in +the parent, and with a nil DEF, the lookups will return nil. + If KEYMAP is a sparse keymap with a binding for KEY, the existing binding is altered. If there is no binding for KEY, the new pair binding KEY to DEF is added at the front of KEYMAP. */) - (Lisp_Object keymap, Lisp_Object key, Lisp_Object def) + (Lisp_Object keymap, Lisp_Object key, Lisp_Object def, Lisp_Object remove) { bool metized = false; @@ -1155,7 +1180,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) message_with_string ("Key sequence contains invalid event %s", c, 1); if (idx == length) - return store_in_keymap (keymap, c, def); + return store_in_keymap (keymap, c, def, !NILP (remove)); Lisp_Object cmd = access_keymap (keymap, c, 0, 1, 1); @@ -1260,6 +1285,9 @@ lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, doc: /* Look up key sequence KEY in KEYMAP. Return the definition. +This is a legacy function; see `keymap-lookup' for the recommended +function to use instead. + A value of nil means undefined. See doc of `define-key' for kinds of definitions. @@ -1413,7 +1441,7 @@ static Lisp_Object define_as_prefix (Lisp_Object keymap, Lisp_Object c) { Lisp_Object cmd = Fmake_sparse_keymap (Qnil); - store_in_keymap (keymap, c, cmd); + store_in_keymap (keymap, c, cmd, Qnil); return cmd; } diff --git a/src/term.c b/src/term.c index b4f3dfc25e4..8e106e7c639 100644 --- a/src/term.c +++ b/src/term.c @@ -1358,7 +1358,7 @@ term_get_fkeys_1 (void) char *sequence = tgetstr (keys[i].cap, address); if (sequence) Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), - make_vector (1, intern (keys[i].name))); + make_vector (1, intern (keys[i].name)), Qnil); } /* The uses of the "k0" capability are inconsistent; sometimes it @@ -1377,13 +1377,13 @@ term_get_fkeys_1 (void) /* Define f0 first, so that f10 takes precedence in case the key sequences happens to be the same. */ Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), - make_vector (1, intern ("f0"))); + make_vector (1, intern ("f0")), Qnil); Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi), - make_vector (1, intern ("f10"))); + make_vector (1, intern ("f10")), Qnil); } else if (k0) Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), - make_vector (1, intern (k0_name))); + make_vector (1, intern (k0_name)), Qnil); } /* Set up cookies for numbered function keys above f10. */ @@ -1405,8 +1405,10 @@ term_get_fkeys_1 (void) if (sequence) { sprintf (fkey, "f%d", i); - Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), - make_vector (1, intern (fkey))); + Fdefine_key (KVAR (kboard, Vinput_decode_map), + build_string (sequence), + make_vector (1, intern (fkey)), + Qnil); } } } @@ -1422,7 +1424,7 @@ term_get_fkeys_1 (void) char *sequence = tgetstr (cap2, address); \ if (sequence) \ Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), \ - make_vector (1, intern (sym))); \ + make_vector (1, intern (sym)), Qnil); \ } /* if there's no key_next keycap, map key_npage to `next' keysym */ diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 8e28faf2b26..629d6c55849 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -373,6 +373,40 @@ g .. h foo (should (eq (lookup-key (current-global-map) ["C-x C-f"]) 'find-file)) (should (eq (lookup-key (current-global-map) [?\C-x ?\C-f]) 'find-file))) +(ert-deftest keymap-removal () + ;; Set to nil. + (let ((map (define-keymap "a" 'foo))) + (should (equal map '(keymap (97 . foo)))) + (define-key map "a" nil) + (should (equal map '(keymap (97))))) + ;; Remove. + (let ((map (define-keymap "a" 'foo))) + (should (equal map '(keymap (97 . foo)))) + (define-key map "a" nil t) + (should (equal map '(keymap))))) + +(ert-deftest keymap-removal-inherit () + ;; Set to nil. + (let ((parent (make-sparse-keymap)) + (child (make-keymap))) + (set-keymap-parent child parent) + (define-key parent [?a] 'foo) + (define-key child [?a] 'bar) + + (should (eq (lookup-key child [?a]) 'bar)) + (define-key child [?a] nil) + (should (eq (lookup-key child [?a]) nil))) + ;; Remove. + (let ((parent (make-sparse-keymap)) + (child (make-keymap))) + (set-keymap-parent child parent) + (define-key parent [?a] 'foo) + (define-key child [?a] 'bar) + + (should (eq (lookup-key child [?a]) 'bar)) + (define-key child [?a] nil t) + (should (eq (lookup-key child [?a]) 'foo)))) + (provide 'keymap-tests) ;;; keymap-tests.el ends here From de477ec683482a5dd27d791d7fdcfc4021ed3cb7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Nov 2021 08:15:43 +0100 Subject: [PATCH 061/367] Add new 'keymap-*' functions * lisp/keymap.el: New file with all the new keymap-* functions. * lisp/loadup.el ("keymap"): Load. * lisp/subr.el (kbd): Refactor out all the code to key-parse. (define-key-after, keyboard-translate, global-set-key) (local-set-key, global-unset-key, local-unset-key) (local-key-binding, global-key-binding) (substitute-key-definition): Note in doc strings that these are legacy functions. (define-keymap--define): Use keymap-set. * lisp/emacs-lisp/byte-opt.el: Remove the optimizations for defvar-keymap and define-keymap since the macros now only understand the kbd syntax. * lisp/emacs-lisp/bytecomp.el (byte-compile-define-keymap) (byte-compile-define-keymap--define): Warn about invalid key definitions in all keymap-* functions. * lisp/emacs-lisp/shortdoc.el (keymaps): Add shortdocs form keymap* functions. * src/keymap.c (possibly_translate_key_sequence): Adjust callers to key-valid-p and key-parse. (syms_of_keymap): Adjust defs. --- etc/NEWS | 66 ++++-- lisp/emacs-lisp/byte-opt.el | 66 ------ lisp/emacs-lisp/bytecomp.el | 65 ++++++ lisp/emacs-lisp/shortdoc.el | 33 +++ lisp/keymap.el | 437 ++++++++++++++++++++++++++++++++++++ lisp/loadup.el | 1 + lisp/subr.el | 207 ++++------------- src/keymap.c | 16 +- test/lisp/subr-tests.el | 196 ++++++++-------- 9 files changed, 731 insertions(+), 356 deletions(-) create mode 100644 lisp/keymap.el diff --git a/etc/NEWS b/etc/NEWS index ed95f891db7..68b5cc82b49 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -593,12 +593,62 @@ Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 +** Keymaps and key definitions + +++ -** 'define-key' now takes an optional REMOVE argument. +*** New functions for defining and manipulating keystrokes have been added. +These all take just the syntax defined by 'key-valid-p'. None of the +older functions have been depreciated or altered, but are deemphasised +in the documentation. + ++++ +*** Use 'keymap-set' instead of 'define-key'. + ++++ +*** Use 'keymap-global-set' instead of 'global-set-key'. + ++++ +*** Use 'keymap-local-set' instead of 'local-set-key'. + ++++ +*** Use 'keymap-global-unset' instead of 'global-unset-key'. + ++++ +*** Use 'keymap-local-unset' instead of 'local-unset-key'. + ++++ +*** Use 'keymap-substitute' instead of 'substitute-key-definition'. + ++++ +*** Use 'keymap-set-after' instead of 'define-key-after'. + ++++ +*** Use 'keymap-lookup' instead of 'lookup-keymap' and 'key-binding'. + ++++ +*** Use 'keymap-local-lookup' instead of 'local-key-binding'. + ++++ +*** Use 'keymap-global-lookup' instead of 'global-key-binding'. + ++++ +*** 'define-key' now takes an optional REMOVE argument. If non-nil, remove the definition from the keymap. This is subtly different from setting a definition to nil (when the keymap has a parent). ++++ +*** New function 'key-valid-p'. +The 'kbd' function is quite permissive, and will try to return +something usable even if the syntax of the argument isn't completely +correct. The 'key-valid-p' predicate does a stricter check of the +syntax. + +--- +*** New function 'key-parse'. +This is like 'kbd', but only returns vectors instead of a mix of +vectors and strings. + +++ ** New function 'file-name-split'. This returns a list of all the components of a file name. @@ -691,13 +741,6 @@ The 'tabulated-list-entries' variable now supports using an image descriptor, which means to insert an image in that column instead of text. See the documentation string of that variable for details. -+++ -** 'define-key' now understands a new strict 'kbd' representation for keys. -The '(define-key map ["C-c M-f"] #'some-command)' syntax is now -supported, and is like the 'kbd' representation, but is stricter. If -the string doesn't represent a valid key sequence, an error is -signalled (both when evaluating and byte compiling). - +++ ** :keys in 'menu-item' can now be a function. If so, it is called whenever the menu is computed, and can be used to @@ -734,13 +777,6 @@ This macro allows defining keymap variables more conveniently. ** 'kbd' can now be used in built-in, preloaded libraries. It no longer depends on edmacro.el and cl-lib.el. -+++ -** New function 'kbd-valid-p'. -The 'kbd' function is quite permissive, and will try to return -something usable even if the syntax of the argument isn't completely -correct. The 'kbd-valid-p' predicate does a stricter check of the -syntax. - +++ ** New function 'image-at-point-p'. This function returns t if point is on a valid image, and nil diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 9c64083b64b..f6db803b78e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1186,72 +1186,6 @@ See Info node `(elisp) Integer Basics'." (put 'concat 'byte-optimizer #'byte-optimize-concat) -(defun byte-optimize-define-key (form) - "Expand key bindings in FORM." - (let ((key (nth 2 form))) - (if (and (vectorp key) - (= (length key) 1) - (stringp (aref key 0))) - ;; We have key on the form ["C-c C-c"]. - (if (not (kbd-valid-p (aref key 0))) - (error "Invalid `kbd' syntax: %S" key) - (list (nth 0 form) (nth 1 form) - (kbd (aref key 0)) (nth 4 form))) - ;; No improvement. - form))) - -(put 'define-key 'byte-optimizer #'byte-optimize-define-key) - -(defun byte-optimize-define-keymap (form) - "Expand key bindings in FORM." - (let ((result nil) - (orig-form form) - improved) - (push (pop form) result) - (while (and form - (keywordp (car form)) - (not (eq (car form) :menu))) - (unless (memq (car form) - '(:full :keymap :parent :suppress :name :prefix)) - (error "Invalid keyword: %s" (car form))) - (push (pop form) result) - (when (null form) - (error "Uneven number of keywords in %S" form)) - (push (pop form) result)) - ;; Bindings. - (while form - (let ((key (pop form))) - (if (and (vectorp key) - (= (length key) 1) - (stringp (aref key 0))) - (progn - (unless (kbd-valid-p (aref key 0)) - (error "Invalid `kbd' syntax: %S" key)) - (push (kbd (aref key 0)) result) - (setq improved t)) - ;; No improvement. - (push key result))) - (when (null form) - (error "Uneven number of key bindings in %S" form)) - (push (pop form) result)) - (if improved - (nreverse result) - orig-form))) - -(defun byte-optimize-define-keymap--define (form) - "Expand key bindings in FORM." - (if (not (consp (nth 1 form))) - form - (let ((optimized (byte-optimize-define-keymap (nth 1 form)))) - (if (eq optimized (nth 1 form)) - ;; No improvement. - form - (list (car form) optimized))))) - -(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap) -(put 'define-keymap--define 'byte-optimizer - #'byte-optimize-define-keymap--define) - ;; I'm not convinced that this is necessary. Doesn't the optimizer loop ;; take care of this? - Jamie ;; I think this may some times be necessary to reduce ie (quote 5) to 5, diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 471a0b623ad..4078a7314f3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5043,6 +5043,71 @@ binding slots have been popped." nil)) (_ (byte-compile-keep-pending form)))) + + + +;; Key syntax warnings. + +(mapc + (lambda (elem) + (put (car elem) 'byte-hunk-handler + (lambda (form) + (dolist (idx (cdr elem)) + (let ((key (elt form idx))) + (when (or (vectorp key) + (and (stringp key) + (not (key-valid-p key)))) + (byte-compile-warn "Invalid `kbd' syntax: %S" key)))) + form))) + ;; Functions and the place(s) for the key definition(s). + '((keymap-set 2) + (keymap-global-set 1) + (keymap-local-set 1) + (keymap-unset 2) + (keymap-global-unset 1) + (keymap-local-unset 1) + (keymap-substitute 1 2) + (keymap-set-after 2) + (key-translate 1 2) + (keymap-lookup 2) + (keymap-global-lookup 1) + (keymap-local-lookup 1))) + +(put 'define-keymap 'byte-hunk-handler #'byte-compile-define-keymap) +(defun byte-compile-define-keymap (form) + (let ((result nil) + (orig-form form)) + (push (pop form) result) + (while (and form + (keywordp (car form)) + (not (eq (car form) :menu))) + (unless (memq (car form) + '(:full :keymap :parent :suppress :name :prefix)) + (byte-compile-warn "Invalid keyword: %s" (car form))) + (push (pop form) result) + (when (null form) + (byte-compile-warn "Uneven number of keywords in %S" form)) + (push (pop form) result)) + ;; Bindings. + (while form + (let ((key (pop form))) + (when (stringp key) + (unless (key-valid-p key) + (byte-compile-warn "Invalid `kbd' syntax: %S" key))) + ;; No improvement. + (push key result)) + (when (null form) + (byte-compile-warn "Uneven number of key bindings in %S" form)) + (push (pop form) result)) + orig-form)) + +(put 'define-keymap--define 'byte-hunk-handler + #'byte-compile-define-keymap--define) +(defun byte-compile-define-keymap--define (form) + (when (consp (nth 1 form)) + (byte-compile-define-keymap (nth 1 form))) + form) + ;;; tags diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index a9f548b104e..228d1e05513 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1222,6 +1222,39 @@ There can be any number of :example/:result elements." (text-property-search-backward :no-eval (text-property-search-backward 'face nil t))) +(define-short-documentation-group keymaps + "Defining keymaps" + (define-keymap + :no-eval (define-keymap "C-c C-c" #'quit-buffer)) + (defvar-keymap + :no-eval (defvar-keymap my-keymap "C-c C-c" map #'quit-buffer)) + "Setting keys" + (keymap-set + :no-eval (keymap-set map "C-c C-c" #'quit-buffer)) + (keymap-local-set + :no-eval (keymap-local-set "C-c C-c" #'quit-buffer)) + (keymap-global-set + :no-eval (keymap-global-set "C-c C-c" #'quit-buffer)) + (keymap-unset + :no-eval (keymap-unset map "C-c C-c")) + (keymap-local-unset + :no-eval (keymap-local-unset "C-c C-c")) + (keymap-global-unset + :no-eval (keymap-global-unset "C-c C-c")) + (keymap-substitute + :no-eval (keymap-substitute "C-c C-c" "M-a" map)) + (keymap-set-after + :no-eval (keymap-set-after map "" menu-bar-separator)) + "Predicates" + (keymapp + :eval (keymapp (define-keymap))) + (key-valid-p + :eval (key-valid-p "C-c C-c") + :eval (key-valid-p "C-cC-c")) + "Lookup" + (keymap-lookup + :eval (keymap-lookup (current-global-map) "C-x x g"))) + ;;;###autoload (defun shortdoc-display-group (group &optional function) "Pop to a buffer with short documentation summary for functions in GROUP. diff --git a/lisp/keymap.el b/lisp/keymap.el new file mode 100644 index 00000000000..8938197ecf0 --- /dev/null +++ b/lisp/keymap.el @@ -0,0 +1,437 @@ +;;; keymap.el --- Keymap functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This library deals with the "new" keymap binding interface: The +;; only key syntax allowed by these functions is the `kbd' one. + +;;; Code: + + + +(defun keymap--check (key) + "Signal an error if KEY doesn't have a valid syntax." + (unless (key-valid-p key) + (error "%S is not a valid key definition; see `key-valid-p'" key))) + +(defun keymap-set (keymap key definition) + "Set key sequence KEY to DEFINITION in KEYMAP. +KEY is a string that satisfies `key-valid-p'. + +DEFINITION is anything that can be a key's definition: + nil (means key is undefined in this keymap), + a command (a Lisp function suitable for interactive calling), + a string (treated as a keyboard macro), + a keymap (to define a prefix key), + a symbol (when the key is looked up, the symbol will stand for its + function definition, which should at that time be one of the above, + or another symbol whose function definition is used, etc.), + a cons (STRING . DEFN), meaning that DEFN is the definition + (DEFN should be a valid definition in its own right) and + STRING is the menu item name (which is used only if the containing + keymap has been created with a menu name, see `make-keymap'), + or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP, + or an extended menu item definition. + (See info node `(elisp)Extended Menu Items'.)" + (keymap--check key) + (define-key keymap (key-parse key) definition)) + +(defun keymap-global-set (key command) + "Give KEY a global binding as COMMAND. +COMMAND is the command definition to use; usually it is +a symbol naming an interactively-callable function. + +KEY is a string that satisfies `key-valid-p'. + +Note that if KEY has a local binding in the current buffer, +that local binding will continue to shadow any global binding +that you make with this function." + (interactive + (let* ((menu-prompting nil) + (key (read-key-sequence "Set key globally: " nil t))) + (list key + (read-command (format "Set key %s to command: " + (key-description key)))))) + (keymap-set (current-global-map) key command)) + +(defun keymap-local-set (key command) + "Give KEY a local binding as COMMAND. +COMMAND is the command definition to use; usually it is +a symbol naming an interactively-callable function. + +KEY is a string that satisfies `key-valid-p'. + +The binding goes in the current buffer's local map, which in most +cases is shared with all other buffers in the same major mode." + (interactive "KSet key locally: \nCSet key %s locally to command: ") + (let ((map (current-local-map))) + (unless map + (use-local-map (setq map (make-sparse-keymap)))) + (keymap-set map key command))) + +(defun keymap-global-unset (key &optional remove) + "Remove global binding of KEY (if any). +KEY is a string that satisfies `key-valid-p'. + +If REMOVE (interactively, the prefix arg), remove the binding +instead of unsetting it. See `keymap-unset' for details." + (interactive + (list (key-description (read-key-sequence "Set key locally: ")) + current-prefix-arg)) + (keymap-unset (current-global-map) key remove)) + +(defun keymap-local-unset (key &optional remove) + "Remove local binding of KEY (if any). +KEY is a string that satisfies `key-valid-p'. + +If REMOVE (interactively, the prefix arg), remove the binding +instead of unsetting it. See `keymap-unset' for details." + (interactive + (list (key-description (read-key-sequence "Unset key locally: ")) + current-prefix-arg)) + (when (current-local-map) + (keymap-unset (current-local-map) key remove))) + +(defun keymap-unset (keymap key &optional remove) + "Remove key sequence KEY from KEYMAP. +KEY is a string that satisfies `key-valid-p'. + +If REMOVE, remove the binding instead of unsetting it. This only +makes a difference when there's a parent keymap. When unsetting +a key in a child map, it will still shadow the same key in the +parent keymap. Removing the binding will allow the key in the +parent keymap to be used." + (keymap--check key) + (define-key keymap key nil remove)) + +(defun keymap-substitute (olddef newdef keymap &optional oldmap prefix) + "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. +In other words, OLDDEF is replaced with NEWDEF wherever it appears. +Alternatively, if optional fourth argument OLDMAP is specified, we redefine +in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP. + +If you don't specify OLDMAP, you can usually get the same results +in a cleaner way with command remapping, like this: + (define-key KEYMAP [remap OLDDEF] NEWDEF) +\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" + ;; Don't document PREFIX in the doc string because we don't want to + ;; advertise it. It's meant for recursive calls only. Here's its + ;; meaning + + ;; If optional argument PREFIX is specified, it should be a key + ;; prefix, a string. Redefined bindings will then be bound to the + ;; original key, with PREFIX added at the front. + (unless prefix + (setq prefix "")) + (keymap--check olddef) + (keymap--check newdef) + (setq olddef (key-parse olddef)) + (setq newdef (key-parse newdef)) + (let* ((scan (or oldmap keymap)) + (prefix1 (vconcat prefix [nil])) + (key-substitution-in-progress + (cons scan key-substitution-in-progress))) + ;; Scan OLDMAP, finding each char or event-symbol that + ;; has any definition, and act on it with hack-key. + (map-keymap + (lambda (char defn) + (aset prefix1 (length prefix) char) + (substitute-key-definition-key defn olddef newdef prefix1 keymap)) + scan))) + +(defun keymap-set-after (keymap key definition &optional after) + "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. +This is like `keymap-set' except that the binding for KEY is placed +just after the binding for the event AFTER, instead of at the beginning +of the map. Note that AFTER must be an event type (like KEY), NOT a command +\(like DEFINITION). + +If AFTER is t or omitted, the new binding goes at the end of the keymap. +AFTER should be a single event type--a symbol or a character, not a sequence. + +Bindings are always added before any inherited map. + +The order of bindings in a keymap matters only when it is used as +a menu, so this function is not useful for non-menu keymaps." + (declare (indent defun)) + (keymap--check key) + (when after + (keymap--check after)) + (define-key-after keymap (key-parse key) definition + (and after (key-parse after)))) + +(defun key-parse (keys) + "Convert KEYS to the internal Emacs key representation. +See `kbd' for a descripion of KEYS." + (declare (pure t) (side-effect-free t)) + ;; A pure function is expected to preserve the match data. + (save-match-data + (let ((case-fold-search nil) + (len (length keys)) ; We won't alter keys in the loop below. + (pos 0) + (res [])) + (while (and (< pos len) + (string-match "[^ \t\n\f]+" keys pos)) + (let* ((word-beg (match-beginning 0)) + (word-end (match-end 0)) + (word (substring keys word-beg len)) + (times 1) + key) + ;; Try to catch events of the form "". + (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) + (setq word (match-string 0 word) + pos (+ word-beg (match-end 0))) + (setq word (substring keys word-beg word-end) + pos word-end)) + (when (string-match "\\([0-9]+\\)\\*." word) + (setq times (string-to-number (substring word 0 (match-end 1)))) + (setq word (substring word (1+ (match-end 1))))) + (cond ((string-match "^<<.+>>$" word) + (setq key (vconcat (if (eq (key-binding [?\M-x]) + 'execute-extended-command) + [?\M-x] + (or (car (where-is-internal + 'execute-extended-command)) + [?\M-x])) + (substring word 2 -2) "\r"))) + ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) + (progn + (setq word (concat (match-string 1 word) + (match-string 3 word))) + (not (string-match + "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" + word)))) + (setq key (list (intern word)))) + ((or (equal word "REM") (string-match "^;;" word)) + (setq pos (string-match "$" keys pos))) + (t + (let ((orig-word word) (prefix 0) (bits 0)) + (while (string-match "^[ACHMsS]-." word) + (setq bits (+ bits + (cdr + (assq (aref word 0) + '((?A . ?\A-\^@) (?C . ?\C-\^@) + (?H . ?\H-\^@) (?M . ?\M-\^@) + (?s . ?\s-\^@) (?S . ?\S-\^@)))))) + (setq prefix (+ prefix 2)) + (setq word (substring word 2))) + (when (string-match "^\\^.$" word) + (setq bits (+ bits ?\C-\^@)) + (setq prefix (1+ prefix)) + (setq word (substring word 1))) + (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") + ("LFD" . "\n") ("TAB" . "\t") + ("ESC" . "\e") ("SPC" . " ") + ("DEL" . "\177"))))) + (when found (setq word (cdr found)))) + (when (string-match "^\\\\[0-7]+$" word) + (let ((n 0)) + (dolist (ch (cdr (string-to-list word))) + (setq n (+ (* n 8) ch -48))) + (setq word (vector n)))) + (cond ((= bits 0) + (setq key word)) + ((and (= bits ?\M-\^@) (stringp word) + (string-match "^-?[0-9]+$" word)) + (setq key (mapcar (lambda (x) (+ x bits)) + (append word nil)))) + ((/= (length word) 1) + (error "%s must prefix a single character, not %s" + (substring orig-word 0 prefix) word)) + ((and (/= (logand bits ?\C-\^@) 0) (stringp word) + ;; We used to accept . and ? here, + ;; but . is simply wrong, + ;; and C-? is not used (we use DEL instead). + (string-match "[@-_a-z]" word)) + (setq key (list (+ bits (- ?\C-\^@) + (logand (aref word 0) 31))))) + (t + (setq key (list (+ bits (aref word 0))))))))) + (when key + (dolist (_ (number-sequence 1 times)) + (setq res (vconcat res key)))))) + (if (and (>= (length res) 4) + (eq (aref res 0) ?\C-x) + (eq (aref res 1) ?\() + (eq (aref res (- (length res) 2)) ?\C-x) + (eq (aref res (- (length res) 1)) ?\))) + (apply #'vector (let ((lres (append res nil))) + ;; Remove the first and last two elements. + (setq lres (cdr (cdr lres))) + (nreverse lres) + (setq lres (cdr (cdr lres))) + (nreverse lres))) + res)))) + +(defun key-valid-p (keys) + "Say whether KEYS is a valid `kbd' sequence. +A `kbd' sequence is a string consisting of one and more key +strokes. The key strokes are separated by a space character. + +Each key stroke is either a single character, or the name of an +event, surrounded by angle brackets. In addition, any key stroke +may be preceded by one or more modifier keys. Finally, a limited +number of characters have a special shorthand syntax. + +Here's some example key sequences. + + \"f\" (the key 'f') + \"S o m\" (a three key sequence of the keys 'S', 'o' and 'm') + \"C-c o\" (a two key sequence of the keys 'c' with the control modifier + and then the key 'o') + \"H-\" (the key named \"left\" with the hyper modifier) + \"M-RET\" (the \"return\" key with a meta modifier) + \"C-M-\" (the \"space\" key with both the control and meta modifiers) + +These are the characters that have shorthand syntax: +NUL, RET, TAB, LFD, ESC, SPC, DEL. + +Modifiers have to be specified in this order: + + A-C-H-M-S-s + +which is + + Alt-Control-Hyper-Meta-Shift-super" + (declare (pure t) (side-effect-free t)) + (and + (stringp keys) + (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) + (save-match-data + (catch 'exit + (let ((prefixes + "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?") + (case-fold-search nil)) + (dolist (key (split-string keys " ")) + ;; Every key might have these modifiers, and they should be + ;; in this order. + (when (string-match (concat "\\`" prefixes) key) + (setq key (substring key (match-end 0)))) + (unless (or (and (= (length key) 1) + ;; Don't accept control characters as keys. + (not (< (aref key 0) ?\s)) + ;; Don't accept Meta'd characters as keys. + (or (multibyte-string-p key) + (not (<= 127 (aref key 0) 255)))) + (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key) + ;; Don't allow . + (= (progn + (string-match + (concat "\\`<" prefixes) key) + (match-end 0)) + 1)) + (string-match-p + "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" + key)) + ;; Invalid. + (throw 'exit nil))) + t))))) + +(defun key-translate (from to) + "Translate character FROM to TO on the current terminal. +This function creates a `keyboard-translate-table' if necessary +and then modifies one entry in it. + +Both KEY and TO are strings that satisfy `key-valid-p'." + (keymap--check from) + (keymap--check to) + (or (char-table-p keyboard-translate-table) + (setq keyboard-translate-table + (make-char-table 'keyboard-translate-table nil))) + (aset keyboard-translate-table (key-parse from) (key-parse to))) + +(defun keymap-lookup (keymap key &optional accept-default no-remap position) + "Return the binding for command KEY. +KEY is a string that satisfies `key-valid-p'. + +If KEYMAP is nil, look up in the current keymaps. If non-nil, it +should either be a keymap or a list of keymaps, and only these +keymap(s) will be consulted. + +The binding is probably a symbol with a function definition. + +Normally, `keymap-lookup' ignores bindings for t, which act as +default bindings, used when nothing else in the keymap applies; +this makes it usable as a general function for probing keymaps. +However, if the optional second argument ACCEPT-DEFAULT is +non-nil, `keymap-lookup' does recognize the default bindings, +just as `read-key-sequence' does. + +Like the normal command loop, `keymap-lookup' will remap the +command resulting from looking up KEY by looking up the command +in the current keymaps. However, if the optional third argument +NO-REMAP is non-nil, `keymap-lookup' returns the unmapped +command. + +If KEY is a key sequence initiated with the mouse, the used keymaps +will depend on the clicked mouse position with regard to the buffer +and possible local keymaps on strings. + +If the optional argument POSITION is non-nil, it specifies a mouse +position as returned by `event-start' and `event-end', and the lookup +occurs in the keymaps associated with it instead of KEY. It can also +be a number or marker, in which case the keymap properties at the +specified buffer position instead of point are used." + (keymap--check key) + (when (and keymap (not position)) + (error "Can't pass in both keymap and position")) + (if keymap + (let ((value (lookup-key (key-parse key) keymap accept-default))) + (when (and (not no-remap) + (symbolp value)) + (or (command-remapping value) value))) + (key-binding (kbd key) accept-default no-remap position))) + +(defun keymap-local-lookup (keys &optional accept-default) + "Return the binding for command KEYS in current local keymap only. +KEY is a string that satisfies `key-valid-p'. + +The binding is probably a symbol with a function definition. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `keymap-lookup' for more details +about this." + (when-let ((map (current-local-map))) + (keymap-lookup map keys accept-default))) + +(defun keymap-global-lookup (keys &optional accept-default message) + "Return the binding for command KEYS in current global keymap only. +KEY is a string that satisfies `key-valid-p'. + +The binding is probably a symbol with a function definition. +This function's return values are the same as those of `keymap-lookup' +\(which see). + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `keymap-lookup' for more details +about this. + +If MESSAGE (and interactively), message the result." + (interactive + (list (key-description (read-key-sequence "Look up key in global keymap: ")) + nil t)) + (let ((def (keymap-lookup (current-global-map) keys accept-default))) + (when message + (message "%s is bound to %s globally" keys def)) + def)) + +(provide 'keymap) + +;;; keymap.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el index e8ecb67d564..15a71ef244e 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -131,6 +131,7 @@ (load "emacs-lisp/byte-run") (load "emacs-lisp/backquote") (load "subr") +(load "keymap") ;; Do it after subr, since both after-load-functions and add-hook are ;; implemented in subr.el. diff --git a/lisp/subr.el b/lisp/subr.el index 3902251586e..7ba764880ef 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -925,69 +925,6 @@ side-effects, and the argument LIST is not modified." ;;;; Keymap support. -(defun kbd-valid-p (keys) - "Say whether KEYS is a valid `kbd' sequence. -A `kbd' sequence is a string consisting of one and more key -strokes. The key strokes are separated by a space character. - -Each key stroke is either a single character, or the name of an -event, surrounded by angle brackets. In addition, any key stroke -may be preceded by one or more modifier keys. Finally, a limited -number of characters have a special shorthand syntax. - -Here's some example key sequences. - - \"f\" (the key 'f') - \"S o m\" (a three key sequence of the keys 'S', 'o' and 'm') - \"C-c o\" (a two key sequence of the keys 'c' with the control modifier - and then the key 'o') - \"H-\" (the key named \"left\" with the hyper modifier) - \"M-RET\" (the \"return\" key with a meta modifier) - \"C-M-\" (the \"space\" key with both the control and meta modifiers) - -These are the characters that have shorthand syntax: -NUL, RET, TAB, LFD, ESC, SPC, DEL. - -Modifiers have to be specified in this order: - - A-C-H-M-S-s - -which is - - Alt-Control-Hyper-Meta-Shift-super" - (declare (pure t) (side-effect-free t)) - (and (stringp keys) - (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) - (save-match-data - (catch 'exit - (let ((prefixes - "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?") - (case-fold-search nil)) - (dolist (key (split-string keys " ")) - ;; Every key might have these modifiers, and they should be - ;; in this order. - (when (string-match (concat "\\`" prefixes) key) - (setq key (substring key (match-end 0)))) - (unless (or (and (= (length key) 1) - ;; Don't accept control characters as keys. - (not (< (aref key 0) ?\s)) - ;; Don't accept Meta'd characters as keys. - (or (multibyte-string-p key) - (not (<= 127 (aref key 0) 255)))) - (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key) - ;; Don't allow . - (= (progn - (string-match - (concat "\\`<" prefixes) key) - (match-end 0)) - 1)) - (string-match-p - "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" - key)) - ;; Invalid. - (throw 'exit nil))) - t))))) - (defun kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such @@ -1006,110 +943,15 @@ Here's some example key sequences: For an approximate inverse of this, see `key-description'." (declare (pure t) (side-effect-free t)) - ;; A pure function is expected to preserve the match data. - (save-match-data - (let ((case-fold-search nil) - (len (length keys)) ; We won't alter keys in the loop below. - (pos 0) - (res [])) - (while (and (< pos len) - (string-match "[^ \t\n\f]+" keys pos)) - (let* ((word-beg (match-beginning 0)) - (word-end (match-end 0)) - (word (substring keys word-beg len)) - (times 1) - key) - ;; Try to catch events of the form "". - (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) - (setq word (match-string 0 word) - pos (+ word-beg (match-end 0))) - (setq word (substring keys word-beg word-end) - pos word-end)) - (when (string-match "\\([0-9]+\\)\\*." word) - (setq times (string-to-number (substring word 0 (match-end 1)))) - (setq word (substring word (1+ (match-end 1))))) - (cond ((string-match "^<<.+>>$" word) - (setq key (vconcat (if (eq (key-binding [?\M-x]) - 'execute-extended-command) - [?\M-x] - (or (car (where-is-internal - 'execute-extended-command)) - [?\M-x])) - (substring word 2 -2) "\r"))) - ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) - (progn - (setq word (concat (match-string 1 word) - (match-string 3 word))) - (not (string-match - "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" - word)))) - (setq key (list (intern word)))) - ((or (equal word "REM") (string-match "^;;" word)) - (setq pos (string-match "$" keys pos))) - (t - (let ((orig-word word) (prefix 0) (bits 0)) - (while (string-match "^[ACHMsS]-." word) - (setq bits (+ bits (cdr (assq (aref word 0) - '((?A . ?\A-\^@) (?C . ?\C-\^@) - (?H . ?\H-\^@) (?M . ?\M-\^@) - (?s . ?\s-\^@) (?S . ?\S-\^@)))))) - (setq prefix (+ prefix 2)) - (setq word (substring word 2))) - (when (string-match "^\\^.$" word) - (setq bits (+ bits ?\C-\^@)) - (setq prefix (1+ prefix)) - (setq word (substring word 1))) - (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") - ("LFD" . "\n") ("TAB" . "\t") - ("ESC" . "\e") ("SPC" . " ") - ("DEL" . "\177"))))) - (when found (setq word (cdr found)))) - (when (string-match "^\\\\[0-7]+$" word) - (let ((n 0)) - (dolist (ch (cdr (string-to-list word))) - (setq n (+ (* n 8) ch -48))) - (setq word (vector n)))) - (cond ((= bits 0) - (setq key word)) - ((and (= bits ?\M-\^@) (stringp word) - (string-match "^-?[0-9]+$" word)) - (setq key (mapcar (lambda (x) (+ x bits)) - (append word nil)))) - ((/= (length word) 1) - (error "%s must prefix a single character, not %s" - (substring orig-word 0 prefix) word)) - ((and (/= (logand bits ?\C-\^@) 0) (stringp word) - ;; We used to accept . and ? here, - ;; but . is simply wrong, - ;; and C-? is not used (we use DEL instead). - (string-match "[@-_a-z]" word)) - (setq key (list (+ bits (- ?\C-\^@) - (logand (aref word 0) 31))))) - (t - (setq key (list (+ bits (aref word 0))))))))) - (when key - (dolist (_ (number-sequence 1 times)) - (setq res (vconcat res key)))))) - (when (and (>= (length res) 4) - (eq (aref res 0) ?\C-x) - (eq (aref res 1) ?\() - (eq (aref res (- (length res) 2)) ?\C-x) - (eq (aref res (- (length res) 1)) ?\))) - (setq res (apply #'vector (let ((lres (append res nil))) - ;; Remove the first and last two elements. - (setq lres (cdr (cdr lres))) - (nreverse lres) - (setq lres (cdr (cdr lres))) - (nreverse lres) - lres)))) - (if (not (memq nil (mapcar (lambda (ch) - (and (numberp ch) - (<= 0 ch 127))) - res))) - ;; Return a string. - (concat (mapcar #'identity res)) - ;; Return a vector. - res)))) + (let ((res (key-parse keys))) + (if (not (memq nil (mapcar (lambda (ch) + (and (numberp ch) + (<= 0 ch 127))) + res))) + ;; Return a string. + (concat (mapcar #'identity res)) + ;; Return a vector. + res))) (defun undefined () "Beep to tell the user this binding is undefined." @@ -1160,6 +1002,9 @@ PARENT if non-nil should be a keymap." (defun define-key-after (keymap key definition &optional after) "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. +This is a legacy function; see `keymap-set-after' for the +recommended function to use instead. + This is like `define-key' except that the binding for KEY is placed just after the binding for the event AFTER, instead of at the beginning of the map. Note that AFTER must be an event type (like KEY), NOT a command @@ -1330,6 +1175,9 @@ Subkeymaps may be modified but are not canonicalized." (defun keyboard-translate (from to) "Translate character FROM to TO on the current terminal. +This is a legacy function; see `keymap-translate' for the +recommended function to use instead. + This function creates a `keyboard-translate-table' if necessary and then modifies one entry in it." (or (char-table-p keyboard-translate-table) @@ -1341,6 +1189,9 @@ and then modifies one entry in it." (defun global-set-key (key command) "Give KEY a global binding as COMMAND. +This is a legacy function; see `keymap-global-set' for the +recommended function to use instead. + COMMAND is the command definition to use; usually it is a symbol naming an interactively-callable function. KEY is a key sequence; noninteractively, it is a string or vector @@ -1362,6 +1213,9 @@ that you make with this function." (defun local-set-key (key command) "Give KEY a local binding as COMMAND. +This is a legacy function; see `keymap-local-set' for the +recommended function to use instead. + COMMAND is the command definition to use; usually it is a symbol naming an interactively-callable function. KEY is a key sequence; noninteractively, it is a string or vector @@ -1380,12 +1234,18 @@ cases is shared with all other buffers in the same major mode." (defun global-unset-key (key) "Remove global binding of KEY. +This is a legacy function; see `keymap-global-unset' for the +recommended function to use instead. + KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key globally: ") (global-set-key key nil)) (defun local-unset-key (key) "Remove local binding of KEY. +This is a legacy function; see `keymap-local-unset' for the +recommended function to use instead. + KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key locally: ") (if (current-local-map) @@ -1394,6 +1254,9 @@ KEY is a string or vector representing a sequence of keystrokes." (defun local-key-binding (keys &optional accept-default) "Return the binding for command KEYS in current local keymap only. +This is a legacy function; see `keymap-local-binding' for the +recommended function to use instead. + KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. @@ -1405,6 +1268,9 @@ about this." (defun global-key-binding (keys &optional accept-default) "Return the binding for command KEYS in current global keymap only. +This is a legacy function; see `keymap-global-binding' for the +recommended function to use instead. + KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. This function's return values are the same as those of `lookup-key' @@ -1423,6 +1289,9 @@ about this." (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. +This is a legacy function; see `keymap-substitute' for the +recommended function to use instead. + In other words, OLDDEF is replaced with NEWDEF wherever it appears. Alternatively, if optional fourth argument OLDMAP is specified, we redefine in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP. @@ -6683,7 +6552,7 @@ pairs. Available keywords are: command (see `define-prefix-command'). If this is the case, this symbol is returned instead of the map itself. -KEY/DEFINITION pairs are as KEY and DEF in `define-key'. KEY can +KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can also be the special symbol `:menu', in which case DEFINITION should be a MENU form as accepted by `easy-menu-define'. @@ -6735,7 +6604,7 @@ should be a MENU form as accepted by `easy-menu-define'. (let ((def (pop definitions))) (if (eq key :menu) (easy-menu-define nil keymap "" def) - (define-key keymap key def))))) + (keymap-set keymap key def))))) keymap))) (defmacro defvar-keymap (variable-name &rest defs) diff --git a/src/keymap.c b/src/keymap.c index c6990cffaf6..7993e31ac6d 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1053,16 +1053,16 @@ possibly_translate_key_sequence (Lisp_Object key, ptrdiff_t *length) { /* KEY is on the ["C-c"] format, so translate to internal format. */ - if (NILP (Ffboundp (Qkbd_valid_p))) + if (NILP (Ffboundp (Qkey_valid_p))) xsignal2 (Qerror, - build_string ("`kbd-valid-p' is not defined, so this syntax can't be used: %s"), + build_string ("`key-valid-p' is not defined, so this syntax can't be used: %s"), key); - if (NILP (call1 (Qkbd_valid_p, AREF (key, 0)))) - xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); - key = call1 (Qkbd, AREF (key, 0)); + if (NILP (call1 (Qkey_valid_p, AREF (key, 0)))) + xsignal2 (Qerror, build_string ("Invalid `key-parse' syntax: %S"), key); + key = call1 (Qkey_parse, AREF (key, 0)); *length = CHECK_VECTOR_OR_STRING (key); if (*length == 0) - xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + xsignal2 (Qerror, build_string ("Invalid `key-parse' syntax: %S"), key); } return key; @@ -3458,6 +3458,6 @@ that describe key bindings. That is why the default is nil. */); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_buffer_bindings); - DEFSYM (Qkbd, "kbd"); - DEFSYM (Qkbd_valid_p, "kbd-valid-p"); + DEFSYM (Qkey_parse, "key-parse"); + DEFSYM (Qkey_valid_p, "key-valid-p"); } diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 238c9be1ab0..ca0ded1ea3d 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -198,123 +198,123 @@ ;; These should be equivalent: (should (equal (kbd "\C-xf") (kbd "C-x f")))) -(ert-deftest subr-test-kbd-valid-p () - (should (not (kbd-valid-p ""))) - (should (kbd-valid-p "f")) - (should (kbd-valid-p "X")) - (should (not (kbd-valid-p " X"))) - (should (kbd-valid-p "X f")) - (should (not (kbd-valid-p "a b"))) - (should (not (kbd-valid-p "foobar"))) - (should (not (kbd-valid-p "return"))) +(ert-deftest subr-test-key-valid-p () + (should (not (key-valid-p ""))) + (should (key-valid-p "f")) + (should (key-valid-p "X")) + (should (not (key-valid-p " X"))) + (should (key-valid-p "X f")) + (should (not (key-valid-p "a b"))) + (should (not (key-valid-p "foobar"))) + (should (not (key-valid-p "return"))) - (should (kbd-valid-p "")) - (should (kbd-valid-p " TAB")) - (should (kbd-valid-p " RET")) - (should (kbd-valid-p " SPC")) - (should (kbd-valid-p "")) - (should (not (kbd-valid-p "[f1]"))) - (should (kbd-valid-p "")) - (should (not (kbd-valid-p "< right >"))) + (should (key-valid-p "")) + (should (key-valid-p " TAB")) + (should (key-valid-p " RET")) + (should (key-valid-p " SPC")) + (should (key-valid-p "")) + (should (not (key-valid-p "[f1]"))) + (should (key-valid-p "")) + (should (not (key-valid-p "< right >"))) ;; Modifiers: - (should (kbd-valid-p "C-x")) - (should (kbd-valid-p "C-x a")) - (should (kbd-valid-p "C-;")) - (should (kbd-valid-p "C-a")) - (should (kbd-valid-p "C-c SPC")) - (should (kbd-valid-p "C-c TAB")) - (should (kbd-valid-p "C-c c")) - (should (kbd-valid-p "C-x 4 C-f")) - (should (kbd-valid-p "C-x C-f")) - (should (kbd-valid-p "C-M-")) - (should (not (kbd-valid-p ""))) - (should (kbd-valid-p "C-RET")) - (should (kbd-valid-p "C-SPC")) - (should (kbd-valid-p "C-TAB")) - (should (kbd-valid-p "C-")) - (should (kbd-valid-p "C-c C-c C-c")) + (should (key-valid-p "C-x")) + (should (key-valid-p "C-x a")) + (should (key-valid-p "C-;")) + (should (key-valid-p "C-a")) + (should (key-valid-p "C-c SPC")) + (should (key-valid-p "C-c TAB")) + (should (key-valid-p "C-c c")) + (should (key-valid-p "C-x 4 C-f")) + (should (key-valid-p "C-x C-f")) + (should (key-valid-p "C-M-")) + (should (not (key-valid-p ""))) + (should (key-valid-p "C-RET")) + (should (key-valid-p "C-SPC")) + (should (key-valid-p "C-TAB")) + (should (key-valid-p "C-")) + (should (key-valid-p "C-c C-c C-c")) - (should (kbd-valid-p "M-a")) - (should (kbd-valid-p "M-")) - (should (not (kbd-valid-p "M-C-a"))) - (should (kbd-valid-p "C-M-a")) - (should (kbd-valid-p "M-ESC")) - (should (kbd-valid-p "M-RET")) - (should (kbd-valid-p "M-SPC")) - (should (kbd-valid-p "M-TAB")) - (should (kbd-valid-p "M-x a")) - (should (kbd-valid-p "M-")) - (should (kbd-valid-p "M-c M-c M-c")) + (should (key-valid-p "M-a")) + (should (key-valid-p "M-")) + (should (not (key-valid-p "M-C-a"))) + (should (key-valid-p "C-M-a")) + (should (key-valid-p "M-ESC")) + (should (key-valid-p "M-RET")) + (should (key-valid-p "M-SPC")) + (should (key-valid-p "M-TAB")) + (should (key-valid-p "M-x a")) + (should (key-valid-p "M-")) + (should (key-valid-p "M-c M-c M-c")) - (should (kbd-valid-p "s-SPC")) - (should (kbd-valid-p "s-a")) - (should (kbd-valid-p "s-x a")) - (should (kbd-valid-p "s-c s-c s-c")) + (should (key-valid-p "s-SPC")) + (should (key-valid-p "s-a")) + (should (key-valid-p "s-x a")) + (should (key-valid-p "s-c s-c s-c")) - (should (not (kbd-valid-p "S-H-a"))) - (should (kbd-valid-p "S-a")) - (should (kbd-valid-p "S-x a")) - (should (kbd-valid-p "S-c S-c S-c")) + (should (not (key-valid-p "S-H-a"))) + (should (key-valid-p "S-a")) + (should (key-valid-p "S-x a")) + (should (key-valid-p "S-c S-c S-c")) - (should (kbd-valid-p "H-")) - (should (kbd-valid-p "H-DEL")) - (should (kbd-valid-p "H-a")) - (should (kbd-valid-p "H-x a")) - (should (kbd-valid-p "H-c H-c H-c")) + (should (key-valid-p "H-")) + (should (key-valid-p "H-DEL")) + (should (key-valid-p "H-a")) + (should (key-valid-p "H-x a")) + (should (key-valid-p "H-c H-c H-c")) - (should (kbd-valid-p "A-H-a")) - (should (kbd-valid-p "A-SPC")) - (should (kbd-valid-p "A-TAB")) - (should (kbd-valid-p "A-a")) - (should (kbd-valid-p "A-c A-c A-c")) + (should (key-valid-p "A-H-a")) + (should (key-valid-p "A-SPC")) + (should (key-valid-p "A-TAB")) + (should (key-valid-p "A-a")) + (should (key-valid-p "A-c A-c A-c")) - (should (kbd-valid-p "C-M-a")) - (should (kbd-valid-p "C-M-")) + (should (key-valid-p "C-M-a")) + (should (key-valid-p "C-M-")) ;; Special characters. - (should (kbd-valid-p "DEL")) - (should (kbd-valid-p "ESC C-a")) - (should (kbd-valid-p "ESC")) - (should (kbd-valid-p "LFD")) - (should (kbd-valid-p "NUL")) - (should (kbd-valid-p "RET")) - (should (kbd-valid-p "SPC")) - (should (kbd-valid-p "TAB")) - (should (not (kbd-valid-p "\^i"))) - (should (not (kbd-valid-p "^M"))) + (should (key-valid-p "DEL")) + (should (key-valid-p "ESC C-a")) + (should (key-valid-p "ESC")) + (should (key-valid-p "LFD")) + (should (key-valid-p "NUL")) + (should (key-valid-p "RET")) + (should (key-valid-p "SPC")) + (should (key-valid-p "TAB")) + (should (not (key-valid-p "\^i"))) + (should (not (key-valid-p "^M"))) ;; With numbers. - (should (not (kbd-valid-p "\177"))) - (should (not (kbd-valid-p "\000"))) - (should (not (kbd-valid-p "\\177"))) - (should (not (kbd-valid-p "\\000"))) - (should (not (kbd-valid-p "C-x \\150"))) + (should (not (key-valid-p "\177"))) + (should (not (key-valid-p "\000"))) + (should (not (key-valid-p "\\177"))) + (should (not (key-valid-p "\\000"))) + (should (not (key-valid-p "C-x \\150"))) ;; Multibyte - (should (kbd-valid-p "ñ")) - (should (kbd-valid-p "ü")) - (should (kbd-valid-p "ö")) - (should (kbd-valid-p "ğ")) - (should (kbd-valid-p "ա")) - (should (not (kbd-valid-p "üüöö"))) - (should (kbd-valid-p "C-ü")) - (should (kbd-valid-p "M-ü")) - (should (kbd-valid-p "H-ü")) + (should (key-valid-p "ñ")) + (should (key-valid-p "ü")) + (should (key-valid-p "ö")) + (should (key-valid-p "ğ")) + (should (key-valid-p "ա")) + (should (not (key-valid-p "üüöö"))) + (should (key-valid-p "C-ü")) + (should (key-valid-p "M-ü")) + (should (key-valid-p "H-ü")) ;; Handle both new and old style key descriptions (bug#45536). - (should (kbd-valid-p "s-")) - (should (not (kbd-valid-p ""))) - (should (kbd-valid-p "C-M-")) - (should (not (kbd-valid-p ""))) + (should (key-valid-p "s-")) + (should (not (key-valid-p ""))) + (should (key-valid-p "C-M-")) + (should (not (key-valid-p ""))) - (should (kbd-valid-p "")) - (should (kbd-valid-p "")) + (should (key-valid-p "")) + (should (key-valid-p "")) - (should (not (kbd-valid-p "c-x"))) - (should (not (kbd-valid-p "C-xx"))) - (should (not (kbd-valid-p "M-xx"))) - (should (not (kbd-valid-p "M-x")))) + (should (not (key-valid-p "c-x"))) + (should (not (key-valid-p "C-xx"))) + (should (not (key-valid-p "M-xx"))) + (should (not (key-valid-p "M-x")))) (ert-deftest subr-test-define-prefix-command () (define-prefix-command 'foo-prefix-map) From 2daffe3550ff829396f13dd21d5cb573fede30d9 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Nov 2021 08:18:30 +0100 Subject: [PATCH 062/367] Adjust `defvar-keymap' and `define-keymap' to the new syntax * lisp/vc/smerge-mode.el (smerge-basic-map): * lisp/vc/pcvs.el (cvs-mode-map): (cvs-minor-mode-prefix): * lisp/vc/log-view.el (log-view-mode-map): * lisp/vc/log-edit.el (log-edit-mode-map): * lisp/vc/diff-mode.el (diff-mode-shared-map): (diff-minor-mode-prefix): * lisp/vc/cvs-status.el (cvs-status-mode-map): * lisp/simple.el (special-mode-map): * lisp/outline.el (outline--insert-open-button): (outline--insert-close-button): * lisp/net/shr.el (shr-map): * lisp/net/eww.el (eww-link-keymap): (eww-mode-map): (eww-submit-map): (eww-bookmark-mode-map): (eww-history-mode-map): (eww-buffers-mode-map): * lisp/mh-e/mh-speed.el (:keymap): * lisp/mh-e/mh-show.el (:keymap): * lisp/mh-e/mh-search.el (:keymap): * lisp/mh-e/mh-letter.el (:keymap): * lisp/mh-e/mh-folder.el (:keymap): * lisp/international/emoji.el (emoji-list-mode-map): * lisp/gnus/spam.el (:keymap): * lisp/gnus/mml.el (mml-mode-map): * lisp/gnus/message.el (message-mode-map): * lisp/gnus/gnus-undo.el (gnus-undo-mode-map): * lisp/gnus/gnus-topic.el (gnus-topic-mode-map): * lisp/gnus/gnus-sum.el (:keymap): * lisp/gnus/gnus-srvr.el (gnus-server-mode-map): (gnus-browse-mode-map): * lisp/gnus/gnus-salt.el (gnus-pick-mode-map): (gnus-tree-mode-map): * lisp/gnus/gnus-msg.el (:prefix): * lisp/gnus/gnus-ml.el (gnus-mailing-list-mode-map): * lisp/gnus/gnus-kill.el (gnus-kill-file-mode-map): * lisp/gnus/gnus-html.el (gnus-html-displayed-image-map): * lisp/gnus/gnus-group.el (:keymap): * lisp/gnus/gnus-eform.el (gnus-edit-form-mode-map): * lisp/gnus/gnus-draft.el (gnus-draft-mode-map): * lisp/gnus/gnus-dired.el (gnus-dired-mode-map): * lisp/gnus/gnus-bookmark.el (gnus-bookmark-bmenu-mode-map): * lisp/gnus/gnus-art.el (:keymap): (gnus-article-edit-mode-map): * lisp/gnus/gnus-agent.el (gnus-agent-group-mode-map): (gnus-agent-summary-mode-map): (gnus-agent-server-mode-map): (gnus-category-mode-map): Adjust `defvar-keymap' and `define-keymap' to the new syntax. --- lisp/gnus/gnus-agent.el | 42 ++++---- lisp/gnus/gnus-art.el | 101 ++++++++++--------- lisp/gnus/gnus-bookmark.el | 10 +- lisp/gnus/gnus-dired.el | 6 +- lisp/gnus/gnus-draft.el | 8 +- lisp/gnus/gnus-eform.el | 4 +- lisp/gnus/gnus-group.el | 74 +++++++------- lisp/gnus/gnus-html.el | 4 +- lisp/gnus/gnus-kill.el | 14 +-- lisp/gnus/gnus-ml.el | 12 +-- lisp/gnus/gnus-msg.el | 14 +-- lisp/gnus/gnus-salt.el | 14 +-- lisp/gnus/gnus-srvr.el | 34 +++---- lisp/gnus/gnus-sum.el | 192 ++++++++++++++++++------------------ lisp/gnus/gnus-topic.el | 42 ++++---- lisp/gnus/gnus-undo.el | 8 +- lisp/gnus/message.el | 110 ++++++++++----------- lisp/gnus/mml.el | 76 +++++++------- lisp/gnus/spam.el | 10 +- lisp/international/emoji.el | 6 +- lisp/mh-e/mh-folder.el | 36 +++---- lisp/mh-e/mh-letter.el | 120 +++++++++++----------- lisp/mh-e/mh-search.el | 26 ++--- lisp/mh-e/mh-show.el | 28 +++--- lisp/mh-e/mh-speed.el | 2 +- lisp/net/eww.el | 84 ++++++++-------- lisp/net/shr.el | 12 +-- lisp/outline.el | 8 +- lisp/simple.el | 6 +- lisp/vc/cvs-status.el | 4 +- lisp/vc/diff-mode.el | 58 +++++------ lisp/vc/log-edit.el | 24 ++--- lisp/vc/log-view.el | 10 +- lisp/vc/pcvs.el | 35 +++---- lisp/vc/smerge-mode.el | 7 +- 35 files changed, 618 insertions(+), 623 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 20da295aca9..169a351c2c7 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -476,15 +476,15 @@ manipulated as follows: (intern (format "gnus-agent-%s-mode-hook" buffer))))) (defvar-keymap gnus-agent-group-mode-map - "Ju" #'gnus-agent-fetch-groups - "Jc" #'gnus-enter-category-buffer - "Jj" #'gnus-agent-toggle-plugged - "Js" #'gnus-agent-fetch-session - "JY" #'gnus-agent-synchronize-flags - "JS" #'gnus-group-send-queue - "Ja" #'gnus-agent-add-group - "Jr" #'gnus-agent-remove-group - "Jo" #'gnus-agent-toggle-group-plugged) + "J u" #'gnus-agent-fetch-groups + "J c" #'gnus-enter-category-buffer + "J j" #'gnus-agent-toggle-plugged + "J s" #'gnus-agent-fetch-session + "J Y" #'gnus-agent-synchronize-flags + "J S" #'gnus-group-send-queue + "J a" #'gnus-agent-add-group + "J r" #'gnus-agent-remove-group + "J o" #'gnus-agent-toggle-group-plugged) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -504,14 +504,14 @@ manipulated as follows: )))) (defvar-keymap gnus-agent-summary-mode-map - "Jj" #'gnus-agent-toggle-plugged - "Ju" #'gnus-agent-summary-fetch-group - "JS" #'gnus-agent-fetch-group - "Js" #'gnus-agent-summary-fetch-series - "J#" #'gnus-agent-mark-article - "J\M-#" #'gnus-agent-unmark-article + "J j" #'gnus-agent-toggle-plugged + "J u" #'gnus-agent-summary-fetch-group + "J S" #'gnus-agent-fetch-group + "J s" #'gnus-agent-summary-fetch-series + "J #" #'gnus-agent-mark-article + "J M-#" #'gnus-agent-unmark-article "@" #'gnus-agent-toggle-mark - "Jc" #'gnus-agent-catchup) + "J c" #'gnus-agent-catchup) (defun gnus-agent-summary-make-menu-bar () (unless (boundp 'gnus-agent-summary-menu) @@ -526,9 +526,9 @@ manipulated as follows: ["Catchup undownloaded" gnus-agent-catchup t])))) (defvar-keymap gnus-agent-server-mode-map - "Jj" #'gnus-agent-toggle-plugged - "Ja" #'gnus-agent-add-server - "Jr" #'gnus-agent-remove-server) + "J j" #'gnus-agent-toggle-plugged + "J a" #'gnus-agent-add-server + "J r" #'gnus-agent-remove-server) (defun gnus-agent-server-make-menu-bar () (unless (boundp 'gnus-agent-server-menu) @@ -2606,8 +2606,8 @@ General format specifiers can also be used. See Info node "s" #'gnus-category-edit-score "l" #'gnus-category-list - "\C-c\C-i" #'gnus-info-find-node - "\C-c\C-b" #'gnus-bug) + "C-c C-i" #'gnus-info-find-node + "C-c C-b" #'gnus-bug) (defcustom gnus-category-menu-hook nil "Hook run after the creation of the menu." diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 23f1431b80f..9594c32e816 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4419,36 +4419,36 @@ If variable `gnus-use-long-file-name' is non-nil, it is (define-keymap :keymap gnus-article-mode-map :suppress t :parent button-buffer-map - " " #'gnus-article-goto-next-page - [?\S-\ ] #'gnus-article-goto-prev-page - "\177" #'gnus-article-goto-prev-page - [delete] #'gnus-article-goto-prev-page - "\C-c^" #'gnus-article-refer-article + "SPC" #'gnus-article-goto-next-page + "S-SPC" #'gnus-article-goto-prev-page + "DEL" #'gnus-article-goto-prev-page + "" #'gnus-article-goto-prev-page + "C-c ^" #'gnus-article-refer-article "h" #'gnus-article-show-summary "s" #'gnus-article-show-summary - "\C-c\C-m" #'gnus-article-mail + "C-c C-m" #'gnus-article-mail "?" #'gnus-article-describe-briefly "<" #'beginning-of-buffer ">" #'end-of-buffer - "\C-c\C-i" #'gnus-info-find-node - "\C-c\C-b" #'gnus-bug + "C-c TAB" #'gnus-info-find-node + "C-c C-b" #'gnus-bug "R" #'gnus-article-reply-with-original "F" #'gnus-article-followup-with-original - "\C-hk" #'gnus-article-describe-key - "\C-hc" #'gnus-article-describe-key-briefly - "\C-hb" #'gnus-article-describe-bindings + "C-h k" #'gnus-article-describe-key + "C-h c" #'gnus-article-describe-key-briefly + "C-h b" #'gnus-article-describe-bindings "e" #'gnus-article-read-summary-keys - "\C-d" #'gnus-article-read-summary-keys - "\C-c\C-f" #'gnus-summary-mail-forward - "\M-*" #'gnus-article-read-summary-keys - "\M-#" #'gnus-article-read-summary-keys - "\M-^" #'gnus-article-read-summary-keys - "\M-g" #'gnus-article-read-summary-keys + "C-d" #'gnus-article-read-summary-keys + "C-c C-f" #'gnus-summary-mail-forward + "M-*" #'gnus-article-read-summary-keys + "M-#" #'gnus-article-read-summary-keys + "M-^" #'gnus-article-read-summary-keys + "M-g" #'gnus-article-read-summary-keys "S" (define-keymap :prefix 'gnus-article-send-map "W" #'gnus-article-wide-reply-with-original - [t] #'gnus-article-read-summary-send-keys)) + "" #'gnus-article-read-summary-send-keys)) (substitute-key-definition #'undefined #'gnus-article-read-summary-keys gnus-article-mode-map) @@ -7254,41 +7254,40 @@ other groups." (defvar-keymap gnus-article-edit-mode-map :full t :parent text-mode-map - "\C-c?" #'describe-mode - "\C-c\C-c" #'gnus-article-edit-done - "\C-c\C-k" #'gnus-article-edit-exit - "\C-c\C-f\C-t" #'message-goto-to - "\C-c\C-f\C-o" #'message-goto-from - "\C-c\C-f\C-b" #'message-goto-bcc - ;;"\C-c\C-f\C-w" message-goto-fcc - "\C-c\C-f\C-c" #'message-goto-cc - "\C-c\C-f\C-s" #'message-goto-subject - "\C-c\C-f\C-r" #'message-goto-reply-to - "\C-c\C-f\C-n" #'message-goto-newsgroups - "\C-c\C-f\C-d" #'message-goto-distribution - "\C-c\C-f\C-f" #'message-goto-followup-to - "\C-c\C-f\C-m" #'message-goto-mail-followup-to - "\C-c\C-f\C-k" #'message-goto-keywords - "\C-c\C-f\C-u" #'message-goto-summary - "\C-c\C-f\C-i" #'message-insert-or-toggle-importance - "\C-c\C-f\C-a" #'message-generate-unsubscribed-mail-followup-to - "\C-c\C-b" #'message-goto-body - "\C-c\C-i" #'message-goto-signature + "C-c ?" #'describe-mode + "C-c C-c" #'gnus-article-edit-done + "C-c C-k" #'gnus-article-edit-exit + "C-c C-f C-t" #'message-goto-to + "C-c C-f C-o" #'message-goto-from + "C-c C-f C-b" #'message-goto-bcc + "C-c C-f C-c" #'message-goto-cc + "C-c C-f C-s" #'message-goto-subject + "C-c C-f C-r" #'message-goto-reply-to + "C-c C-f C-n" #'message-goto-newsgroups + "C-c C-f C-d" #'message-goto-distribution + "C-c C-f C-f" #'message-goto-followup-to + "C-c C-f RET" #'message-goto-mail-followup-to + "C-c C-f C-k" #'message-goto-keywords + "C-c C-f C-u" #'message-goto-summary + "C-c C-f TAB" #'message-insert-or-toggle-importance + "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to + "C-c C-b" #'message-goto-body + "C-c TAB" #'message-goto-signature - "\C-c\C-t" #'message-insert-to - "\C-c\C-n" #'message-insert-newsgroups - "\C-c\C-o" #'message-sort-headers - "\C-c\C-e" #'message-elide-region - "\C-c\C-v" #'message-delete-not-region - "\C-c\C-z" #'message-kill-to-signature - "\M-\r" #'message-newline-and-reformat - "\C-c\C-a" #'mml-attach-file - "\C-a" #'message-beginning-of-line - "\t" #'message-tab - "\M-;" #'comment-region + "C-c C-t" #'message-insert-to + "C-c C-n" #'message-insert-newsgroups + "C-c C-o" #'message-sort-headers + "C-c C-e" #'message-elide-region + "C-c C-v" #'message-delete-not-region + "C-c C-z" #'message-kill-to-signature + "M-RET" #'message-newline-and-reformat + "C-c C-a" #'mml-attach-file + "C-a" #'message-beginning-of-line + "TAB" #'message-tab + "M-;" #'comment-region - "\C-c\C-w" (define-keymap :prefix 'gnus-article-edit-wash-map - "f" #'gnus-article-edit-full-stops)) + "C-c C-w" (define-keymap :prefix 'gnus-article-edit-wash-map + "f" #'gnus-article-edit-full-stops)) (easy-menu-define gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 171da9d17a0..e9696b66a9f 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -423,16 +423,16 @@ That is, all information but the name." :full t :suppress 'nodigits "q" #'quit-window - "\C-m" #'gnus-bookmark-bmenu-select + "RET" #'gnus-bookmark-bmenu-select "v" #'gnus-bookmark-bmenu-select "d" #'gnus-bookmark-bmenu-delete "k" #'gnus-bookmark-bmenu-delete - "\C-d" #'gnus-bookmark-bmenu-delete-backwards + "C-d" #'gnus-bookmark-bmenu-delete-backwards "x" #'gnus-bookmark-bmenu-execute-deletions - " " #'next-line + "SPC" #'next-line "n" #'next-line "p" #'previous-line - "\177" #'gnus-bookmark-bmenu-backup-unmark + "DEL" #'gnus-bookmark-bmenu-backup-unmark "?" #'describe-mode "u" #'gnus-bookmark-bmenu-unmark "m" #'gnus-bookmark-bmenu-mark @@ -440,7 +440,7 @@ That is, all information but the name." "s" #'gnus-bookmark-bmenu-save "t" #'gnus-bookmark-bmenu-toggle-infos "a" #'gnus-bookmark-bmenu-show-details - [mouse-2] #'gnus-bookmark-bmenu-select-by-mouse) + "" #'gnus-bookmark-bmenu-select-by-mouse) ;; Bookmark Buffer Menu mode is suitable only for specially formatted ;; data. diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index be46d3a341d..1d16e007007 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -54,9 +54,9 @@ (autoload 'gnus-print-buffer "gnus-sum") (defvar-keymap gnus-dired-mode-map - "\C-c\C-m\C-a" #'gnus-dired-attach - "\C-c\C-m\C-l" #'gnus-dired-find-file-mailcap - "\C-c\C-m\C-p" #'gnus-dired-print) + "C-c C-m C-a" #'gnus-dired-attach + "C-c C-m C-l" #'gnus-dired-find-file-mailcap + "C-c C-m C-p" #'gnus-dired-print) ;; FIXME: Make it customizable, change the default to `mail-user-agent' when ;; this file is renamed (e.g. to `dired-mime.el'). diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 756e6d2d362..7c56db0ba45 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -34,11 +34,11 @@ ;;; Draft minor mode (defvar-keymap gnus-draft-mode-map - "Dt" #'gnus-draft-toggle-sending + "D t" #'gnus-draft-toggle-sending "e" #' gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' - "De" #'gnus-draft-edit-message - "Ds" #'gnus-draft-send-message - "DS" #'gnus-draft-send-all-messages) + "D e" #'gnus-draft-edit-message + "D s" #'gnus-draft-send-message + "D S" #'gnus-draft-send-all-messages) (defun gnus-draft-make-menu-bar () (unless (boundp 'gnus-draft-menu) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index b0aa58f0f28..c727926731b 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -50,8 +50,8 @@ (defvar-keymap gnus-edit-form-mode-map :parent emacs-lisp-mode-map - "\C-c\C-c" #'gnus-edit-form-done - "\C-c\C-k" #'gnus-edit-form-exit) + "C-c C-c" #'gnus-edit-form-done + "C-c C-k" #'gnus-edit-form-exit) (defun gnus-edit-form-make-menu-bar () (unless (boundp 'gnus-edit-form-menu) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index ddc819877c1..f0b0ca58796 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -574,79 +574,79 @@ simple manner." ;;; (define-keymap :keymap gnus-group-mode-map - " " #'gnus-group-read-group + "SPC" #'gnus-group-read-group "=" #'gnus-group-select-group - "\r" #'gnus-group-select-group - "\M-\r" #'gnus-group-quick-select-group - "\M- " #'gnus-group-visible-select-group - [(meta control return)] #'gnus-group-select-group-ephemerally + "RET" #'gnus-group-select-group + "M-RET" #'gnus-group-quick-select-group + "M-SPC" #'gnus-group-visible-select-group + "C-M-" #'gnus-group-select-group-ephemerally "j" #'gnus-group-jump-to-group "n" #'gnus-group-next-unread-group "p" #'gnus-group-prev-unread-group - "\177" #'gnus-group-prev-unread-group - [delete] #'gnus-group-prev-unread-group + "DEL" #'gnus-group-prev-unread-group + "" #'gnus-group-prev-unread-group "N" #'gnus-group-next-group "P" #'gnus-group-prev-group - "\M-n" #'gnus-group-next-unread-group-same-level - "\M-p" #'gnus-group-prev-unread-group-same-level + "M-n" #'gnus-group-next-unread-group-same-level + "M-p" #'gnus-group-prev-unread-group-same-level "," #'gnus-group-best-unread-group "." #'gnus-group-first-unread-group "u" #'gnus-group-toggle-subscription-at-point "U" #'gnus-group-toggle-subscription "c" #'gnus-group-catchup-current "C" #'gnus-group-catchup-current-all - "\M-c" #'gnus-group-clear-data + "M-c" #'gnus-group-clear-data "l" #'gnus-group-list-groups "L" #'gnus-group-list-all-groups "m" #'gnus-group-mail "i" #'gnus-group-news "g" #'gnus-group-get-new-news - "\M-g" #'gnus-group-get-new-news-this-group + "M-g" #'gnus-group-get-new-news-this-group "R" #'gnus-group-restart "r" #'gnus-group-read-init-file "B" #'gnus-group-browse-foreign-server "b" #'gnus-group-check-bogus-groups "F" #'gnus-group-find-new-groups - "\C-c\C-d" #'gnus-group-describe-group - "\M-d" #'gnus-group-describe-all-groups - "\C-c\C-a" #'gnus-group-apropos - "\C-c\M-\C-a" #'gnus-group-description-apropos + "C-c C-d" #'gnus-group-describe-group + "M-d" #'gnus-group-describe-all-groups + "C-c C-a" #'gnus-group-apropos + "C-c C-M-a" #'gnus-group-description-apropos "a" #'gnus-group-post-news - "\ek" #'gnus-group-edit-local-kill - "\eK" #'gnus-group-edit-global-kill - "\C-k" #'gnus-group-kill-group - "\C-y" #'gnus-group-yank-group - "\C-w" #'gnus-group-kill-region - "\C-x\C-t" #'gnus-group-transpose-groups - "\C-c\C-l" #'gnus-group-list-killed - "\C-c\C-x" #'gnus-group-expire-articles - "\C-c\M-\C-x" #'gnus-group-expire-all-groups + "ESC k" #'gnus-group-edit-local-kill + "ESC K" #'gnus-group-edit-global-kill + "C-k" #'gnus-group-kill-group + "C-y" #'gnus-group-yank-group + "C-w" #'gnus-group-kill-region + "C-x C-t" #'gnus-group-transpose-groups + "C-c C-l" #'gnus-group-list-killed + "C-c C-x" #'gnus-group-expire-articles + "C-c C-M-x" #'gnus-group-expire-all-groups "V" #'gnus-version "s" #'gnus-group-save-newsrc "z" #'gnus-group-suspend "q" #'gnus-group-exit "Q" #'gnus-group-quit "?" #'gnus-group-describe-briefly - "\C-c\C-i" #'gnus-info-find-node - "\M-e" #'gnus-group-edit-group-method + "C-c C-i" #'gnus-info-find-node + "M-e" #'gnus-group-edit-group-method "^" #'gnus-group-enter-server-mode - [mouse-2] #'gnus-mouse-pick-group - [follow-link] 'mouse-face + "" #'gnus-mouse-pick-group + "" 'mouse-face "<" #'beginning-of-buffer ">" #'end-of-buffer - "\C-c\C-b" #'gnus-bug - "\C-c\C-s" #'gnus-group-sort-groups + "C-c C-b" #'gnus-bug + "C-c C-s" #'gnus-group-sort-groups "t" #'gnus-topic-mode - "\C-c\M-g" #'gnus-activate-all-groups - "\M-&" #'gnus-group-universal-argument + "C-c M-g" #'gnus-activate-all-groups + "M-&" #'gnus-group-universal-argument "#" #'gnus-group-mark-group - "\M-#" #'gnus-group-unmark-group + "M-#" #'gnus-group-unmark-group "~" (define-keymap :prefix 'gnus-group-cloud-map "u" #'gnus-cloud-upload-all-data "~" #'gnus-cloud-upload-all-data "d" #'gnus-cloud-download-all-data - "\r" #'gnus-cloud-download-all-data) + "RET" #'gnus-cloud-download-all-data) "M" (define-keymap :prefix 'gnus-group-mark-map "m" #'gnus-group-mark-group @@ -682,8 +682,8 @@ simple manner." "c" #'gnus-group-customize "z" #'gnus-group-compact-group "x" #'gnus-group-expunge-group - "\177" #'gnus-group-delete-group - [delete] #'gnus-group-delete-group + "DEL" #'gnus-group-delete-group + "" #'gnus-group-delete-group "S" (define-keymap :prefix 'gnus-group-sort-map "s" #'gnus-group-sort-groups @@ -774,7 +774,7 @@ simple manner." "k" #'gnus-group-kill-group "y" #'gnus-group-yank-group "w" #'gnus-group-kill-region - "\C-k" #'gnus-group-kill-level + "C-k" #'gnus-group-kill-level "z" #'gnus-group-kill-all-zombies)) (defun gnus-topic-mode-p () diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index c1815d3486c..ef376f138e7 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -79,9 +79,9 @@ fit these criteria." (defvar-keymap gnus-html-displayed-image-map "a" #'gnus-html-show-alt-text "i" #'gnus-html-browse-image - "\r" #'gnus-html-browse-url + "RET" #'gnus-html-browse-url "u" #'gnus-article-copy-string - [tab] #'forward-button) + "" #'forward-button) (defun gnus-html-encode-url (url) "Encode URL." diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 7e589c54e97..7137efd7309 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -68,13 +68,13 @@ of time." (defvar-keymap gnus-kill-file-mode-map :parent emacs-lisp-mode-map - "\C-c\C-k\C-s" #'gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" #'gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" #'gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" #'gnus-kill-file-kill-by-xref - "\C-c\C-a" #'gnus-kill-file-apply-buffer - "\C-c\C-e" #'gnus-kill-file-apply-last-sexp - "\C-c\C-c" #'gnus-kill-file-exit) + "C-c C-k C-s" #'gnus-kill-file-kill-by-subject + "C-c C-k C-a" #'gnus-kill-file-kill-by-author + "C-c C-k C-t" #'gnus-kill-file-kill-by-thread + "C-c C-k C-x" #'gnus-kill-file-kill-by-xref + "C-c C-a" #'gnus-kill-file-apply-buffer + "C-c C-e" #'gnus-kill-file-apply-last-sexp + "C-c C-c" #'gnus-kill-file-exit) (define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill" "Major mode for editing kill files. diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index bf33194cf75..a5358e9ff42 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -32,12 +32,12 @@ ;;; Mailing list minor mode (defvar-keymap gnus-mailing-list-mode-map - "\C-c\C-nh" #'gnus-mailing-list-help - "\C-c\C-ns" #'gnus-mailing-list-subscribe - "\C-c\C-nu" #'gnus-mailing-list-unsubscribe - "\C-c\C-np" #'gnus-mailing-list-post - "\C-c\C-no" #'gnus-mailing-list-owner - "\C-c\C-na" #'gnus-mailing-list-archive) + "C-c C-n h" #'gnus-mailing-list-help + "C-c C-n s" #'gnus-mailing-list-subscribe + "C-c C-n u" #'gnus-mailing-list-unsubscribe + "C-c C-n p" #'gnus-mailing-list-post + "C-c C-n o" #'gnus-mailing-list-owner + "C-c C-n a" #'gnus-mailing-list-archive) (defvar gnus-mailing-list-menu) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index dfadfd39201..bb265642bc6 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -369,13 +369,13 @@ only affect the Gcc copy, but not the original message." "m" #'gnus-summary-mail-other-window "u" #'gnus-uu-post-news "A" #'gnus-summary-attach-article - "\M-c" #'gnus-summary-mail-crosspost-complaint - "Br" #'gnus-summary-reply-broken-reply-to - "BR" #'gnus-summary-reply-broken-reply-to-with-original - "om" #'gnus-summary-mail-forward - "op" #'gnus-summary-post-forward - "Om" #'gnus-uu-digest-mail-forward - "Op" #'gnus-uu-digest-post-forward + "M-c" #'gnus-summary-mail-crosspost-complaint + "B r" #'gnus-summary-reply-broken-reply-to + "B R" #'gnus-summary-reply-broken-reply-to-with-original + "o m" #'gnus-summary-mail-forward + "o p" #'gnus-summary-post-forward + "O m" #'gnus-uu-digest-mail-forward + "O p" #'gnus-uu-digest-post-forward "D" (define-keymap :prefix 'gnus-send-bounce-map "b" #'gnus-summary-resend-bounced-mail diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 8ffe4a4c573..205e936bc7e 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -65,11 +65,11 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;;; Internal variables. (defvar-keymap gnus-pick-mode-map - " " #'gnus-pick-next-page + "SPC" #'gnus-pick-next-page "u" #'gnus-pick-unmark-article-or-thread "." #'gnus-pick-article-or-thread - [down-mouse-2] #'gnus-pick-mouse-pick-region - "\r" #'gnus-pick-start-reading) + "" #'gnus-pick-mouse-pick-region + "RET" #'gnus-pick-start-reading) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) @@ -420,12 +420,12 @@ Two predefined functions are available: (defvar-keymap gnus-tree-mode-map :full t :suppress t - "\r" #'gnus-tree-select-article - [mouse-2] #'gnus-tree-pick-article - "\C-?" #'gnus-tree-read-summary-keys + "RET" #'gnus-tree-select-article + "" #'gnus-tree-pick-article + "DEL" #'gnus-tree-read-summary-keys "h" #'gnus-tree-show-summary - "\C-c\C-i" #'gnus-info-find-node) + "C-c C-i" #'gnus-info-find-node) (substitute-key-definition 'undefined #'gnus-tree-read-summary-keys gnus-tree-mode-map) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index f2ffb067b8e..fa880b7eddb 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -105,9 +105,9 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar-keymap gnus-server-mode-map :full t :suppress t - " " #'gnus-server-read-server-in-server-buffer - "\r" #'gnus-server-read-server - [mouse-2] #'gnus-server-pick-server + "SPC" #'gnus-server-read-server-in-server-buffer + "RET" #'gnus-server-read-server + "" #'gnus-server-pick-server "q" #'gnus-server-exit "l" #'gnus-server-list-servers "k" #'gnus-server-kill-server @@ -119,9 +119,9 @@ If nil, a faster, but more primitive, buffer is used instead." "s" #'gnus-server-scan-server "O" #'gnus-server-open-server - "\M-o" #'gnus-server-open-all-servers + "M-o" #'gnus-server-open-all-servers "C" #'gnus-server-close-server - "\M-c" #'gnus-server-close-all-servers + "M-c" #'gnus-server-close-all-servers "D" #'gnus-server-deny-server "L" #'gnus-server-offline-server "R" #'gnus-server-remove-denials @@ -138,8 +138,8 @@ If nil, a faster, but more primitive, buffer is used instead." "i" #'gnus-server-toggle-cloud-server "I" #'gnus-server-set-cloud-method-server - "\C-c\C-i" #'gnus-info-find-node - "\C-c\C-b" #'gnus-bug) + "C-c C-i" #'gnus-info-find-node + "C-c C-b" #'gnus-bug) (defcustom gnus-server-menu-hook nil "Hook run after the creation of the server mode menu." @@ -694,29 +694,29 @@ claim them." (defvar-keymap gnus-browse-mode-map :full t :suppress t - " " #'gnus-browse-read-group + "SPC" #'gnus-browse-read-group "=" #'gnus-browse-select-group "n" #'gnus-browse-next-group "p" #'gnus-browse-prev-group - "\177" #'gnus-browse-prev-group - [delete] #'gnus-browse-prev-group + "DEL" #'gnus-browse-prev-group + "" #'gnus-browse-prev-group "N" #'gnus-browse-next-group "P" #'gnus-browse-prev-group - "\M-n" #'gnus-browse-next-group - "\M-p" #'gnus-browse-prev-group - "\r" #'gnus-browse-select-group + "M-n" #'gnus-browse-next-group + "M-p" #'gnus-browse-prev-group + "RET" #'gnus-browse-select-group "u" #'gnus-browse-toggle-subscription-at-point "l" #'gnus-browse-exit "L" #'gnus-browse-exit "q" #'gnus-browse-exit "Q" #'gnus-browse-exit "d" #'gnus-browse-describe-group - [delete] #'gnus-browse-delete-group - "\C-c\C-c" #'gnus-browse-exit + "" #'gnus-browse-delete-group + "C-c C-c" #'gnus-browse-exit "?" #'gnus-browse-describe-briefly - "\C-c\C-i" #'gnus-info-find-node - "\C-c\C-b" #'gnus-bug) + "C-c C-i" #'gnus-info-find-node + "C-c C-b" #'gnus-bug) (defun gnus-browse-make-menu-bar () (gnus-turn-off-edit-menu 'browse) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index f06661209bd..dcdf3d977df 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1908,129 +1908,129 @@ increase the score of each group you read." ;; Non-orthogonal keys (define-keymap :keymap gnus-summary-mode-map - " " #'gnus-summary-next-page - [?\S-\ ] #'gnus-summary-prev-page - "\177" #'gnus-summary-prev-page - [delete] #'gnus-summary-prev-page - "\r" #'gnus-summary-scroll-up - "\M-\r" #'gnus-summary-scroll-down + "SPC" #'gnus-summary-next-page + "S-SPC" #'gnus-summary-prev-page + "DEL" #'gnus-summary-prev-page + "" #'gnus-summary-prev-page + "RET" #'gnus-summary-scroll-up + "M-RET" #'gnus-summary-scroll-down "n" #'gnus-summary-next-unread-article "p" #'gnus-summary-prev-unread-article "N" #'gnus-summary-next-article "P" #'gnus-summary-prev-article - "\M-\C-n" #'gnus-summary-next-same-subject - "\M-\C-p" #'gnus-summary-prev-same-subject - "\M-n" #'gnus-summary-next-unread-subject - "\M-p" #'gnus-summary-prev-unread-subject + "C-M-n" #'gnus-summary-next-same-subject + "C-M-p" #'gnus-summary-prev-same-subject + "M-n" #'gnus-summary-next-unread-subject + "M-p" #'gnus-summary-prev-unread-subject "." #'gnus-summary-first-unread-article "," #'gnus-summary-best-unread-article "[" #'gnus-summary-prev-unseen-article "]" #'gnus-summary-next-unseen-article - "\M-s\M-s" #'gnus-summary-search-article-forward - "\M-s\M-r" #'gnus-summary-search-article-backward - "\M-r" #'gnus-summary-search-article-backward - "\M-S" #'gnus-summary-repeat-search-article-forward - "\M-R" #'gnus-summary-repeat-search-article-backward + "M-s M-s" #'gnus-summary-search-article-forward + "M-s M-r" #'gnus-summary-search-article-backward + "M-r" #'gnus-summary-search-article-backward + "M-S" #'gnus-summary-repeat-search-article-forward + "M-R" #'gnus-summary-repeat-search-article-backward "<" #'gnus-summary-beginning-of-article ">" #'gnus-summary-end-of-article "j" #'gnus-summary-goto-article "^" #'gnus-summary-refer-parent-article - "\M-^" #'gnus-summary-refer-article + "M-^" #'gnus-summary-refer-article "u" #'gnus-summary-tick-article-forward "!" #'gnus-summary-tick-article-forward "U" #'gnus-summary-tick-article-backward "d" #'gnus-summary-mark-as-read-forward "D" #'gnus-summary-mark-as-read-backward "E" #'gnus-summary-mark-as-expirable - "\M-u" #'gnus-summary-clear-mark-forward - "\M-U" #'gnus-summary-clear-mark-backward + "M-u" #'gnus-summary-clear-mark-forward + "M-U" #'gnus-summary-clear-mark-backward "k" #'gnus-summary-kill-same-subject-and-select - "\C-k" #'gnus-summary-kill-same-subject - "\M-\C-k" #'gnus-summary-kill-thread - "\M-\C-l" #'gnus-summary-lower-thread + "C-k" #'gnus-summary-kill-same-subject + "C-M-k" #'gnus-summary-kill-thread + "C-M-l" #'gnus-summary-lower-thread "e" #'gnus-summary-edit-article "#" #'gnus-summary-mark-as-processable - "\M-#" #'gnus-summary-unmark-as-processable - "\M-\C-t" #'gnus-summary-toggle-threads - "\M-\C-s" #'gnus-summary-show-thread - "\M-\C-h" #'gnus-summary-hide-thread - "\M-\C-f" #'gnus-summary-next-thread - "\M-\C-b" #'gnus-summary-prev-thread - [(meta down)] #'gnus-summary-next-thread - [(meta up)] #'gnus-summary-prev-thread - "\M-\C-u" #'gnus-summary-up-thread - "\M-\C-d" #'gnus-summary-down-thread + "M-#" #'gnus-summary-unmark-as-processable + "C-M-t" #'gnus-summary-toggle-threads + "C-M-s" #'gnus-summary-show-thread + "C-M-h" #'gnus-summary-hide-thread + "C-M-f" #'gnus-summary-next-thread + "C-M-b" #'gnus-summary-prev-thread + "M-" #'gnus-summary-next-thread + "M-" #'gnus-summary-prev-thread + "C-M-u" #'gnus-summary-up-thread + "C-M-d" #'gnus-summary-down-thread "&" #'gnus-summary-execute-command "c" #'gnus-summary-catchup-and-exit - "\C-w" #'gnus-summary-mark-region-as-read - "\C-t" #'toggle-truncate-lines + "C-w" #'gnus-summary-mark-region-as-read + "C-t" #'toggle-truncate-lines "?" #'gnus-summary-mark-as-dormant - "\C-c\M-\C-s" #'gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" #'gnus-summary-sort-by-number - "\C-c\C-s\C-m\C-n" #'gnus-summary-sort-by-most-recent-number - "\C-c\C-s\C-l" #'gnus-summary-sort-by-lines - "\C-c\C-s\C-c" #'gnus-summary-sort-by-chars - "\C-c\C-s\C-m\C-m" #'gnus-summary-sort-by-marks - "\C-c\C-s\C-a" #'gnus-summary-sort-by-author - "\C-c\C-s\C-t" #'gnus-summary-sort-by-recipient - "\C-c\C-s\C-s" #'gnus-summary-sort-by-subject - "\C-c\C-s\C-d" #'gnus-summary-sort-by-date - "\C-c\C-s\C-m\C-d" #'gnus-summary-sort-by-most-recent-date - "\C-c\C-s\C-i" #'gnus-summary-sort-by-score - "\C-c\C-s\C-o" #'gnus-summary-sort-by-original - "\C-c\C-s\C-r" #'gnus-summary-sort-by-random - "\C-c\C-s\C-u" #'gnus-summary-sort-by-newsgroups - "\C-c\C-s\C-x" #'gnus-summary-sort-by-extra + "C-c C-M-s" #'gnus-summary-limit-include-expunged + "C-c C-s C-n" #'gnus-summary-sort-by-number + "C-c C-s C-m C-n" #'gnus-summary-sort-by-most-recent-number + "C-c C-s C-l" #'gnus-summary-sort-by-lines + "C-c C-s C-c" #'gnus-summary-sort-by-chars + "C-c C-s C-m C-m" #'gnus-summary-sort-by-marks + "C-c C-s C-a" #'gnus-summary-sort-by-author + "C-c C-s C-t" #'gnus-summary-sort-by-recipient + "C-c C-s C-s" #'gnus-summary-sort-by-subject + "C-c C-s C-d" #'gnus-summary-sort-by-date + "C-c C-s C-m C-d" #'gnus-summary-sort-by-most-recent-date + "C-c C-s C-i" #'gnus-summary-sort-by-score + "C-c C-s C-o" #'gnus-summary-sort-by-original + "C-c C-s C-r" #'gnus-summary-sort-by-random + "C-c C-s C-u" #'gnus-summary-sort-by-newsgroups + "C-c C-s C-x" #'gnus-summary-sort-by-extra "=" #'gnus-summary-expand-window - "\C-x\C-s" #'gnus-summary-reselect-current-group - "\M-g" #'gnus-summary-rescan-group - "\C-c\C-r" #'gnus-summary-caesar-message + "C-x C-s" #'gnus-summary-reselect-current-group + "M-g" #'gnus-summary-rescan-group + "C-c C-r" #'gnus-summary-caesar-message "f" #'gnus-summary-followup "F" #'gnus-summary-followup-with-original "C" #'gnus-summary-cancel-article "r" #'gnus-summary-reply "R" #'gnus-summary-reply-with-original - "\C-c\C-f" #'gnus-summary-mail-forward + "C-c C-f" #'gnus-summary-mail-forward "o" #'gnus-summary-save-article - "\C-o" #'gnus-summary-save-article-mail + "C-o" #'gnus-summary-save-article-mail "|" #'gnus-summary-pipe-output - "\M-k" #'gnus-summary-edit-local-kill - "\M-K" #'gnus-summary-edit-global-kill + "M-k" #'gnus-summary-edit-local-kill + "M-K" #'gnus-summary-edit-global-kill ;; "V" gnus-version - "\C-c\C-d" #'gnus-summary-describe-group - "\C-c\C-p" #'gnus-summary-make-group-from-search + "C-c C-d" #'gnus-summary-describe-group + "C-c C-p" #'gnus-summary-make-group-from-search "q" #'gnus-summary-exit "Q" #'gnus-summary-exit-no-update - "\C-c\C-i" #'gnus-info-find-node - [mouse-2] #'gnus-mouse-pick-article - [follow-link] 'mouse-face + "C-c C-i" #'gnus-info-find-node + "" #'gnus-mouse-pick-article + "" 'mouse-face "m" #'gnus-summary-mail-other-window "a" #'gnus-summary-post-news "x" #'gnus-summary-limit-to-unread "s" #'gnus-summary-isearch-article - "\t" #'gnus-summary-button-forward - [backtab] #'gnus-summary-button-backward + "TAB" #'gnus-summary-button-forward + "" #'gnus-summary-button-backward "w" #'gnus-summary-browse-url "t" #'gnus-summary-toggle-header "g" #'gnus-summary-show-article "l" #'gnus-summary-goto-last-article - "\C-c\C-v\C-v" #'gnus-uu-decode-uu-view - "\C-d" #'gnus-summary-enter-digest-group - "\M-\C-d" #'gnus-summary-read-document - "\M-\C-e" #'gnus-summary-edit-parameters - "\M-\C-a" #'gnus-summary-customize-parameters - "\C-c\C-b" #'gnus-bug + "C-c C-v C-v" #'gnus-uu-decode-uu-view + "C-d" #'gnus-summary-enter-digest-group + "C-M-d" #'gnus-summary-read-document + "C-M-e" #'gnus-summary-edit-parameters + "C-M-a" #'gnus-summary-customize-parameters + "C-c C-b" #'gnus-bug "*" #'gnus-cache-enter-article - "\M-*" #'gnus-cache-remove-article - "\M-&" #'gnus-summary-universal-argument - "\C-l" #'gnus-recenter + "M-*" #'gnus-cache-remove-article + "M-&" #'gnus-summary-universal-argument + "C-l" #'gnus-recenter "I" #'gnus-summary-increase-score "L" #'gnus-summary-lower-score - "\M-i" #'gnus-symbolic-argument + "M-i" #'gnus-symbolic-argument "h" #'gnus-summary-select-article-buffer "b" #'gnus-article-view-part - "\M-t" #'gnus-summary-toggle-display-buttonized + "M-t" #'gnus-summary-toggle-display-buttonized "S" #'gnus-summary-send-map @@ -2041,19 +2041,19 @@ increase the score of each group you read." "d" #'gnus-summary-mark-as-read-forward "r" #'gnus-summary-mark-as-read-forward "c" #'gnus-summary-clear-mark-forward - " " #'gnus-summary-clear-mark-forward + "SPC" #'gnus-summary-clear-mark-forward "e" #'gnus-summary-mark-as-expirable "x" #'gnus-summary-mark-as-expirable "?" #'gnus-summary-mark-as-dormant "b" #'gnus-summary-set-bookmark "B" #'gnus-summary-remove-bookmark "#" #'gnus-summary-mark-as-processable - "\M-#" #'gnus-summary-unmark-as-processable + "M-#" #'gnus-summary-unmark-as-processable "S" #'gnus-summary-limit-include-expunged "C" #'gnus-summary-catchup "H" #'gnus-summary-catchup-to-here "h" #'gnus-summary-catchup-from-here - "\C-c" #'gnus-summary-catchup-all + "C-c" #'gnus-summary-catchup-all "k" #'gnus-summary-kill-same-subject-and-select "K" #'gnus-summary-kill-same-subject @@ -2118,10 +2118,10 @@ increase the score of each group you read." "p" #'gnus-summary-prev-unread-article "N" #'gnus-summary-next-article "P" #'gnus-summary-prev-article - "\C-n" #'gnus-summary-next-same-subject - "\C-p" #'gnus-summary-prev-same-subject - "\M-n" #'gnus-summary-next-unread-subject - "\M-p" #'gnus-summary-prev-unread-subject + "C-n" #'gnus-summary-next-same-subject + "C-p" #'gnus-summary-prev-same-subject + "M-n" #'gnus-summary-next-unread-subject + "M-p" #'gnus-summary-prev-unread-subject "f" #'gnus-summary-first-unread-article "b" #'gnus-summary-best-unread-article "u" #'gnus-summary-next-unseen-article @@ -2139,7 +2139,7 @@ increase the score of each group you read." "T" #'gnus-summary-toggle-threads "t" #'gnus-summary-rethread-current "^" #'gnus-summary-reparent-thread - "\M-^" #'gnus-summary-reparent-children + "M-^" #'gnus-summary-reparent-children "s" #'gnus-summary-show-thread "S" #'gnus-summary-show-all-threads "h" #'gnus-summary-hide-thread @@ -2150,7 +2150,7 @@ increase the score of each group you read." "o" #'gnus-summary-top-thread "d" #'gnus-summary-down-thread "#" #'gnus-uu-mark-thread - "\M-#" #'gnus-uu-unmark-thread) + "M-#" #'gnus-uu-unmark-thread) "Y" (define-keymap :prefix 'gnus-summary-buffer-map "g" #'gnus-summary-prepare @@ -2173,14 +2173,14 @@ increase the score of each group you read." "P" #'gnus-summary-prev-group) "A" (define-keymap :prefix 'gnus-summary-article-map - " " #'gnus-summary-next-page + "SPC" #'gnus-summary-next-page "n" #'gnus-summary-next-page - [?\S-\ ] #'gnus-summary-prev-page - "\177" #'gnus-summary-prev-page - [delete] #'gnus-summary-prev-page + "S-SPC" #'gnus-summary-prev-page + "DEL" #'gnus-summary-prev-page + "" #'gnus-summary-prev-page "p" #'gnus-summary-prev-page - "\r" #'gnus-summary-scroll-up - "\M-\r" #'gnus-summary-scroll-down + "RET" #'gnus-summary-scroll-up + "M-RET" #'gnus-summary-scroll-down "<" #'gnus-summary-beginning-of-article ">" #'gnus-summary-end-of-article "b" #'gnus-summary-beginning-of-article @@ -2194,8 +2194,8 @@ increase the score of each group you read." "W" #'gnus-warp-to-article "g" #'gnus-summary-show-article "s" #'gnus-summary-isearch-article - "\t" #'gnus-summary-button-forward - [backtab] #'gnus-summary-button-backward + "TAB" #'gnus-summary-button-forward + "" #'gnus-summary-button-backward "w" #'gnus-summary-browse-url "P" #'gnus-summary-print-article "S" #'gnus-sticky-article @@ -2250,7 +2250,7 @@ increase the score of each group you read." "l" #'gnus-article-hide-list-identifiers "B" #'gnus-article-strip-banner "P" #'gnus-article-hide-pem - "\C-c" #'gnus-article-hide-citation-maybe) + "C-c" #'gnus-article-hide-citation-maybe) "H" (define-keymap :prefix 'gnus-summary-wash-highlight-map "a" #'gnus-article-highlight @@ -2312,10 +2312,10 @@ increase the score of each group you read." "B" (define-keymap :prefix 'gnus-summary-backend-map "e" #'gnus-summary-expire-articles - "\M-\C-e" #'gnus-summary-expire-articles-now - "\177" #'gnus-summary-delete-article - [delete] #'gnus-summary-delete-article - [backspace] #'gnus-summary-delete-article + "C-M-e" #'gnus-summary-expire-articles-now + "DEL" #'gnus-summary-delete-article + "" #'gnus-summary-delete-article + "" #'gnus-summary-delete-article "m" #'gnus-summary-move-article "r" #'gnus-summary-respool-article "w" #'gnus-summary-edit-article diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index e78dd1542c8..0855e98917f 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1059,26 +1059,26 @@ articles in the topic and its subtopics." (defvar-keymap gnus-topic-mode-map ;; Override certain group mode keys. "=" #'gnus-topic-select-group - "\r" #'gnus-topic-select-group - " " #'gnus-topic-read-group - "\C-c\C-x" #'gnus-topic-expire-articles + "RET" #'gnus-topic-select-group + "SPC" #'gnus-topic-read-group + "C-c C-x" #'gnus-topic-expire-articles "c" #'gnus-topic-catchup-articles - "\C-k" #'gnus-topic-kill-group - "\C-y" #'gnus-topic-yank-group - "\M-g" #'gnus-topic-get-new-news-this-topic - "AT" #'gnus-topic-list-active - "Gp" #'gnus-topic-edit-parameters + "C-k" #'gnus-topic-kill-group + "C-y" #'gnus-topic-yank-group + "M-g" #'gnus-topic-get-new-news-this-topic + "A T" #'gnus-topic-list-active + "G p" #'gnus-topic-edit-parameters "#" #'gnus-topic-mark-topic - "\M-#" #'gnus-topic-unmark-topic - [tab] #'gnus-topic-indent - [(meta tab)] #'gnus-topic-unindent - "\C-i" #'gnus-topic-indent - "\M-\C-i" #'gnus-topic-unindent - [mouse-2] #'gnus-mouse-pick-topic + "M-#" #'gnus-topic-unmark-topic + "" #'gnus-topic-indent + "M-" #'gnus-topic-unindent + "TAB" #'gnus-topic-indent + "C-M-i" #'gnus-topic-unindent + "" #'gnus-mouse-pick-topic "T" (define-keymap :prefix 'gnus-group-topic-map "#" #'gnus-topic-mark-topic - "\M-#" #'gnus-topic-unmark-topic + "M-#" #'gnus-topic-unmark-topic "n" #'gnus-topic-create-topic "m" #'gnus-topic-move-group "D" #'gnus-topic-remove-group @@ -1088,13 +1088,13 @@ articles in the topic and its subtopics." "j" #'gnus-topic-jump-to-topic "M" #'gnus-topic-move-matching "C" #'gnus-topic-copy-matching - "\M-p" #'gnus-topic-goto-previous-topic - "\M-n" #'gnus-topic-goto-next-topic - "\C-i" #'gnus-topic-indent - [tab] #'gnus-topic-indent + "M-p" #'gnus-topic-goto-previous-topic + "M-n" #'gnus-topic-goto-next-topic + "TAB" #'gnus-topic-indent + "" #'gnus-topic-indent "r" #'gnus-topic-rename - "\177" #'gnus-topic-delete - [delete] #'gnus-topic-delete + "DEL" #'gnus-topic-delete + "" #'gnus-topic-delete "H" #'gnus-topic-toggle-display-empty-topics "S" (define-keymap :prefix 'gnus-topic-sort-map diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index 0717a7ccfba..a82b1f87a3e 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -76,11 +76,11 @@ ;;; Minor mode definition. (defvar-keymap gnus-undo-mode-map - "\M-\C-_" #'gnus-undo - "\C-_" #'gnus-undo - "\C-xu" #'gnus-undo + "C-M-_" #'gnus-undo + "C-_" #'gnus-undo + "C-x u" #'gnus-undo ;; many people are used to type `C-/' on GUI frames and get `C-_'. - [(control /)] #'gnus-undo) + "C-/" #'gnus-undo) (defun gnus-undo-make-menu-bar () ;; This is disabled for the time being. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 77e8fcdfd16..4a0ea59586c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2875,75 +2875,75 @@ Consider adding this function to `message-header-setup-hook'" (defvar-keymap message-mode-map :full t :parent text-mode-map :doc "Message Mode keymap." - "\C-c?" #'describe-mode + "C-c ?" #'describe-mode - "\C-c\C-f\C-t" #'message-goto-to - "\C-c\C-f\C-o" #'message-goto-from - "\C-c\C-f\C-b" #'message-goto-bcc - "\C-c\C-f\C-w" #'message-goto-fcc - "\C-c\C-f\C-c" #'message-goto-cc - "\C-c\C-f\C-s" #'message-goto-subject - "\C-c\C-f\C-r" #'message-goto-reply-to - "\C-c\C-f\C-n" #'message-goto-newsgroups - "\C-c\C-f\C-d" #'message-goto-distribution - "\C-c\C-f\C-f" #'message-goto-followup-to - "\C-c\C-f\C-m" #'message-goto-mail-followup-to - "\C-c\C-f\C-k" #'message-goto-keywords - "\C-c\C-f\C-u" #'message-goto-summary - "\C-c\C-f\C-i" #'message-insert-or-toggle-importance - "\C-c\C-f\C-a" #'message-generate-unsubscribed-mail-followup-to + "C-c C-f C-t" #'message-goto-to + "C-c C-f C-o" #'message-goto-from + "C-c C-f C-b" #'message-goto-bcc + "C-c C-f C-w" #'message-goto-fcc + "C-c C-f C-c" #'message-goto-cc + "C-c C-f C-s" #'message-goto-subject + "C-c C-f C-r" #'message-goto-reply-to + "C-c C-f C-n" #'message-goto-newsgroups + "C-c C-f C-d" #'message-goto-distribution + "C-c C-f C-f" #'message-goto-followup-to + "C-c C-f C-m" #'message-goto-mail-followup-to + "C-c C-f C-k" #'message-goto-keywords + "C-c C-f C-u" #'message-goto-summary + "C-c C-f C-i" #'message-insert-or-toggle-importance + "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to ;; modify headers (and insert notes in body) - "\C-c\C-fs" #'message-change-subject + "C-c C-f s" #'message-change-subject ;; - "\C-c\C-fx" #'message-cross-post-followup-to + "C-c C-f x" #'message-cross-post-followup-to ;; prefix+message-cross-post-followup-to = same w/o cross-post - "\C-c\C-ft" #'message-reduce-to-to-cc - "\C-c\C-fa" #'message-add-archive-header + "C-c C-f t" #'message-reduce-to-to-cc + "C-c C-f a" #'message-add-archive-header ;; mark inserted text - "\C-c\M-m" #'message-mark-inserted-region - "\C-c\M-f" #'message-mark-insert-file + "C-c M-m" #'message-mark-inserted-region + "C-c M-f" #'message-mark-insert-file - "\C-c\C-b" #'message-goto-body - "\C-c\C-i" #'message-goto-signature + "C-c C-b" #'message-goto-body + "C-c C-i" #'message-goto-signature - "\C-c\C-t" #'message-insert-to - "\C-c\C-fw" #'message-insert-wide-reply - "\C-c\C-n" #'message-insert-newsgroups - "\C-c\C-l" #'message-to-list-only - "\C-c\C-f\C-e" #'message-insert-expires - "\C-c\C-u" #'message-insert-or-toggle-importance - "\C-c\M-n" #'message-insert-disposition-notification-to + "C-c C-t" #'message-insert-to + "C-c C-f w" #'message-insert-wide-reply + "C-c C-n" #'message-insert-newsgroups + "C-c C-l" #'message-to-list-only + "C-c C-f C-e" #'message-insert-expires + "C-c C-u" #'message-insert-or-toggle-importance + "C-c M-n" #'message-insert-disposition-notification-to - "\C-c\C-y" #'message-yank-original - "\C-c\M-\C-y" #'message-yank-buffer - "\C-c\C-q" #'message-fill-yanked-message - "\C-c\C-w" #'message-insert-signature - "\C-c\M-h" #'message-insert-headers - "\C-c\C-r" #'message-caesar-buffer-body - "\C-c\C-o" #'message-sort-headers - "\C-c\M-r" #'message-rename-buffer + "C-c C-y" #'message-yank-original + "C-c C-M-y" #'message-yank-buffer + "C-c C-q" #'message-fill-yanked-message + "C-c C-w" #'message-insert-signature + "C-c M-h" #'message-insert-headers + "C-c C-r" #'message-caesar-buffer-body + "C-c C-o" #'message-sort-headers + "C-c M-r" #'message-rename-buffer - "\C-c\C-c" #'message-send-and-exit - "\C-c\C-s" #'message-send - "\C-c\C-k" #'message-kill-buffer - "\C-c\C-d" #'message-dont-send - "\C-c\n" #'gnus-delay-article + "C-c C-c" #'message-send-and-exit + "C-c C-s" #'message-send + "C-c C-k" #'message-kill-buffer + "C-c C-d" #'message-dont-send + "C-c C-j" #'gnus-delay-article - "\C-c\M-k" #'message-kill-address - "\C-c\C-e" #'message-elide-region - "\C-c\C-v" #'message-delete-not-region - "\C-c\C-z" #'message-kill-to-signature - "\M-\r" #'message-newline-and-reformat - [remap split-line] #'message-split-line + "C-c M-k" #'message-kill-address + "C-c C-e" #'message-elide-region + "C-c C-v" #'message-delete-not-region + "C-c C-z" #'message-kill-to-signature + "M-RET" #'message-newline-and-reformat + " " #'message-split-line - "\C-c\C-a" #'mml-attach-file - "\C-c\C-p" #'message-insert-screenshot + "C-c C-a" #'mml-attach-file + "C-c C-p" #'message-insert-screenshot - "\C-a" #'message-beginning-of-line - "\t" #'message-tab + "C-a" #'message-beginning-of-line + "TAB" #'message-tab - "\M-n" #'message-display-abbrev) + "M-n" #'message-display-abbrev) (easy-menu-define message-mode-menu message-mode-map "Message Menu." diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 079c1b51225..e60d777e0d2 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1143,48 +1143,40 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ;;; Mode for inserting and editing MML forms ;;; -(defvar mml-mode-map - (let ((sign (make-sparse-keymap)) - (encrypt (make-sparse-keymap)) - (signpart (make-sparse-keymap)) - (encryptpart (make-sparse-keymap)) - (map (make-sparse-keymap)) - (main (make-sparse-keymap))) - (define-key map "\C-s" 'mml-secure-message-sign) - (define-key map "\C-c" 'mml-secure-message-encrypt) - (define-key map "\C-e" 'mml-secure-message-sign-encrypt) - (define-key map "\C-p\C-s" 'mml-secure-sign) - (define-key map "\C-p\C-c" 'mml-secure-encrypt) - (define-key sign "p" 'mml-secure-message-sign-pgpmime) - (define-key sign "o" 'mml-secure-message-sign-pgp) - (define-key sign "s" 'mml-secure-message-sign-smime) - (define-key signpart "p" 'mml-secure-sign-pgpmime) - (define-key signpart "o" 'mml-secure-sign-pgp) - (define-key signpart "s" 'mml-secure-sign-smime) - (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime) - (define-key encrypt "o" 'mml-secure-message-encrypt-pgp) - (define-key encrypt "s" 'mml-secure-message-encrypt-smime) - (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime) - (define-key encryptpart "o" 'mml-secure-encrypt-pgp) - (define-key encryptpart "s" 'mml-secure-encrypt-smime) - (define-key map "\C-n" 'mml-unsecure-message) - (define-key map "f" 'mml-attach-file) - (define-key map "b" 'mml-attach-buffer) - (define-key map "e" 'mml-attach-external) - (define-key map "q" 'mml-quote-region) - (define-key map "m" 'mml-insert-multipart) - (define-key map "p" 'mml-insert-part) - (define-key map "v" 'mml-validate) - (define-key map "P" 'mml-preview) - (define-key map "s" sign) - (define-key map "S" signpart) - (define-key map "c" encrypt) - (define-key map "C" encryptpart) - ;;(define-key map "n" 'mml-narrow-to-part) - ;; `M-m' conflicts with `back-to-indentation'. - ;; (define-key main "\M-m" map) - (define-key main "\C-c\C-m" map) - main)) +(defvar-keymap mml-mode-map + "C-c C-m" + (define-keymap + "C-s" #'mml-secure-message-sign + "C-c" #'mml-secure-message-encrypt + "C-e" #'mml-secure-message-sign-encrypt + "C-p C-s" #'mml-secure-sign + "C-p C-c" #'mml-secure-encrypt + + "s" (define-keymap + "p" #'mml-secure-message-sign-pgpmime + "o" #'mml-secure-message-sign-pgp + "s" #'mml-secure-message-sign-smime) + "S" (define-keymap + "p" #'mml-secure-sign-pgpmime + "o" #'mml-secure-sign-pgp + "s" #'mml-secure-sign-smime) + "c" (define-keymap + "p" #'mml-secure-message-encrypt-pgpmime + "o" #'mml-secure-message-encrypt-pgp + "s" #'mml-secure-message-encrypt-smime) + "C" (define-keymap + "p" #'mml-secure-encrypt-pgpmime + "o" #'mml-secure-encrypt-pgp + "s" #'mml-secure-encrypt-smime) + "C-n" #'mml-unsecure-message + "f" #'mml-attach-file + "b" #'mml-attach-buffer + "e" #'mml-attach-external + "q" #'mml-quote-region + "m" #'mml-insert-multipart + "p" #'mml-insert-part + "v" #'mml-validate + "P" #'mml-preview)) (easy-menu-define mml-menu mml-mode-map "" diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index cfef69f1031..508ef5424ea 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -664,11 +664,11 @@ order for SpamAssassin to recognize the new registered spam." ;;; Key bindings for spam control. (define-keymap :keymap gnus-summary-mode-map - "St" #'spam-generic-score - "Sx" #'gnus-summary-mark-as-spam - "Mst" #'spam-generic-score - "Msx" #'gnus-summary-mark-as-spam - "\M-d" #'gnus-summary-mark-as-spam + "S t" #'spam-generic-score + "S x" #'gnus-summary-mark-as-spam + "M s t" #'spam-generic-score + "M s x" #'gnus-summary-mark-as-spam + "M-d" #'gnus-summary-mark-as-spam "$" #'gnus-summary-mark-as-spam) (defvar spam-cache-lookups t diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index d2570e99111..5f8c358caab 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -184,10 +184,10 @@ character) under point is." (get-char-code-property (aref glyph 0) 'name))) (defvar-keymap emoji-list-mode-map - ["RET"] #'emoji-list-select - [""] #'emoji-list-select + "RET" #'emoji-list-select + "" #'emoji-list-select "h" #'emoji-list-help - [follow-link] 'mouse-face) + "" 'mouse-face) (define-derived-mode emoji-list-mode special-mode "Emoji" "Mode to display emojis." diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index c700b3348df..ddf13d193ed 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -212,7 +212,7 @@ annotation.") ;; Save the "b" binding for a future `back'. Maybe? (define-keymap :keymap mh-folder-mode-map - " " #'mh-page-msg + "SPC" #'mh-page-msg "!" #'mh-refile-or-write-again "'" #'mh-toggle-tick "," #'mh-header-display @@ -223,15 +223,15 @@ annotation.") "?" #'mh-help "E" #'mh-extract-rejected-mail "M" #'mh-modify - "\177" #'mh-previous-page - "\C-d" #'mh-delete-msg-no-motion - "\t" #'mh-index-next-folder - [backtab] #'mh-index-previous-folder - "\M-\t" #'mh-index-previous-folder - "\e<" #'mh-first-msg - "\e>" #'mh-last-msg - "\ed" #'mh-redistribute - "\r" #'mh-show + "DEL" #'mh-previous-page + "C-d" #'mh-delete-msg-no-motion + "TAB" #'mh-index-next-folder + "" #'mh-index-previous-folder + "C-M-i" #'mh-index-previous-folder + "ESC <" #'mh-first-msg + "ESC >" #'mh-last-msg + "ESC d" #'mh-redistribute + "RET" #'mh-show "^" #'mh-alt-refile-msg "c" #'mh-copy-msg "d" #'mh-delete-msg @@ -242,10 +242,10 @@ annotation.") "k" #'mh-delete-subject-or-thread "m" #'mh-alt-send "n" #'mh-next-undeleted-msg - "\M-n" #'mh-next-unread-msg + "M-n" #'mh-next-unread-msg "o" #'mh-refile-msg "p" #'mh-previous-undeleted-msg - "\M-p" #'mh-previous-unread-msg + "M-p" #'mh-previous-unread-msg "q" #'mh-quit "r" #'mh-reply "s" #'mh-send @@ -324,9 +324,9 @@ annotation.") "u" #'mh-store-msg) ;uuencode "D" (define-keymap :prefix 'mh-digest-map - " " #'mh-page-digest + "SPC" #'mh-page-digest "?" #'mh-prefix-help - "\177" #'mh-page-digest-backwards + "DEL" #'mh-page-digest-backwards "b" #'mh-burst-digest) "K" (define-keymap :prefix 'mh-mime-map @@ -337,11 +337,11 @@ annotation.") "o" #'mh-folder-save-mime-part "t" #'mh-toggle-mime-buttons "v" #'mh-folder-toggle-mime-part - "\t" #'mh-next-button - [backtab] #'mh-prev-button - "\M-\t" #'mh-prev-button) + "TAB" #'mh-next-button + "" #'mh-prev-button + "C-M-i" #'mh-prev-button) - [mouse-2] #'mh-show-mouse) + "" #'mh-show-mouse) ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 1f7902640a1..ebe94a7af83 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -115,67 +115,67 @@ ;; If this changes, modify mh-letter-mode-help-messages accordingly, above. (define-keymap :keymap mh-letter-mode-map - " " #'mh-letter-complete-or-space + "SPC" #'mh-letter-complete-or-space "," #'mh-letter-confirm-address - "\C-c?" #'mh-help - "\C-c\C-\\" #'mh-fully-kill-draft ;if no C-q - "\C-c\C-^" #'mh-insert-signature ;if no C-s - "\C-c\C-c" #'mh-send-letter - "\C-c\C-d" #'mh-insert-identity - "\C-c\C-e" #'mh-mh-to-mime - "\C-c\C-f\C-a" #'mh-to-field - "\C-c\C-f\C-b" #'mh-to-field - "\C-c\C-f\C-c" #'mh-to-field - "\C-c\C-f\C-d" #'mh-to-field - "\C-c\C-f\C-f" #'mh-to-fcc - "\C-c\C-f\C-l" #'mh-to-field - "\C-c\C-f\C-m" #'mh-to-field - "\C-c\C-f\C-r" #'mh-to-field - "\C-c\C-f\C-s" #'mh-to-field - "\C-c\C-f\C-t" #'mh-to-field - "\C-c\C-fa" #'mh-to-field - "\C-c\C-fb" #'mh-to-field - "\C-c\C-fc" #'mh-to-field - "\C-c\C-fd" #'mh-to-field - "\C-c\C-ff" #'mh-to-fcc - "\C-c\C-fl" #'mh-to-field - "\C-c\C-fm" #'mh-to-field - "\C-c\C-fr" #'mh-to-field - "\C-c\C-fs" #'mh-to-field - "\C-c\C-ft" #'mh-to-field - "\C-c\C-i" #'mh-insert-letter - "\C-c\C-m\C-e" #'mh-mml-secure-message-encrypt - "\C-c\C-m\C-f" #'mh-compose-forward - "\C-c\C-m\C-g" #'mh-mh-compose-anon-ftp - "\C-c\C-m\C-i" #'mh-compose-insertion - "\C-c\C-m\C-m" #'mh-mml-to-mime - "\C-c\C-m\C-n" #'mh-mml-unsecure-message - "\C-c\C-m\C-s" #'mh-mml-secure-message-sign - "\C-c\C-m\C-t" #'mh-mh-compose-external-compressed-tar - "\C-c\C-m\C-u" #'mh-mh-to-mime-undo - "\C-c\C-m\C-x" #'mh-mh-compose-external-type - "\C-c\C-mee" #'mh-mml-secure-message-encrypt - "\C-c\C-mes" #'mh-mml-secure-message-signencrypt - "\C-c\C-mf" #'mh-compose-forward - "\C-c\C-mg" #'mh-mh-compose-anon-ftp - "\C-c\C-mi" #'mh-compose-insertion - "\C-c\C-mm" #'mh-mml-to-mime - "\C-c\C-mn" #'mh-mml-unsecure-message - "\C-c\C-mse" #'mh-mml-secure-message-signencrypt - "\C-c\C-mss" #'mh-mml-secure-message-sign - "\C-c\C-mt" #'mh-mh-compose-external-compressed-tar - "\C-c\C-mu" #'mh-mh-to-mime-undo - "\C-c\C-mx" #'mh-mh-compose-external-type - "\C-c\C-o" #'mh-open-line - "\C-c\C-q" #'mh-fully-kill-draft - "\C-c\C-s" #'mh-insert-signature - "\C-c\C-t" #'mh-letter-toggle-header-field-display - "\C-c\C-w" #'mh-check-whom - "\C-c\C-y" #'mh-yank-cur-msg - "\C-c\M-d" #'mh-insert-auto-fields - "\M-\t" #'completion-at-point - "\t" #'mh-letter-next-header-field-or-indent - [backtab] #'mh-letter-previous-header-field) + "C-c ?" #'mh-help + "C-c C-\\" #'mh-fully-kill-draft ;if no C-q + "C-c C-^" #'mh-insert-signature ;if no C-s + "C-c C-c" #'mh-send-letter + "C-c C-d" #'mh-insert-identity + "C-c C-e" #'mh-mh-to-mime + "C-c C-f C-a" #'mh-to-field + "C-c C-f C-b" #'mh-to-field + "C-c C-f C-c" #'mh-to-field + "C-c C-f C-d" #'mh-to-field + "C-c C-f C-f" #'mh-to-fcc + "C-c C-f C-l" #'mh-to-field + "C-c C-f C-m" #'mh-to-field + "C-c C-f C-r" #'mh-to-field + "C-c C-f C-s" #'mh-to-field + "C-c C-f C-t" #'mh-to-field + "C-c C-f a" #'mh-to-field + "C-c C-f b" #'mh-to-field + "C-c C-f c" #'mh-to-field + "C-c C-f d" #'mh-to-field + "C-c C-f f" #'mh-to-fcc + "C-c C-f l" #'mh-to-field + "C-c C-f m" #'mh-to-field + "C-c C-f r" #'mh-to-field + "C-c C-f s" #'mh-to-field + "C-c C-f t" #'mh-to-field + "C-c C-i" #'mh-insert-letter + "C-c C-m C-e" #'mh-mml-secure-message-encrypt + "C-c C-m C-f" #'mh-compose-forward + "C-c C-m C-g" #'mh-mh-compose-anon-ftp + "C-c C-m TAB" #'mh-compose-insertion + "C-c C-m C-m" #'mh-mml-to-mime + "C-c C-m C-n" #'mh-mml-unsecure-message + "C-c C-m C-s" #'mh-mml-secure-message-sign + "C-c C-m C-t" #'mh-mh-compose-external-compressed-tar + "C-c C-m C-u" #'mh-mh-to-mime-undo + "C-c C-m C-x" #'mh-mh-compose-external-type + "C-c C-m e e" #'mh-mml-secure-message-encrypt + "C-c C-m e s" #'mh-mml-secure-message-signencrypt + "C-c C-m f" #'mh-compose-forward + "C-c C-m g" #'mh-mh-compose-anon-ftp + "C-c C-m i" #'mh-compose-insertion + "C-c C-m m" #'mh-mml-to-mime + "C-c C-m n" #'mh-mml-unsecure-message + "C-c C-m s e" #'mh-mml-secure-message-signencrypt + "C-c C-m s s" #'mh-mml-secure-message-sign + "C-c C-m t" #'mh-mh-compose-external-compressed-tar + "C-c C-m u" #'mh-mh-to-mime-undo + "C-c C-m x" #'mh-mh-compose-external-type + "C-c C-o" #'mh-open-line + "C-c C-q" #'mh-fully-kill-draft + "C-c C-s" #'mh-insert-signature + "C-c C-t" #'mh-letter-toggle-header-field-display + "C-c C-w" #'mh-check-whom + "C-c C-y" #'mh-yank-cur-msg + "C-c M-d" #'mh-insert-auto-fields + "C-M-i" #'completion-at-point + "TAB" #'mh-letter-next-header-field-or-indent + "" #'mh-letter-previous-header-field) ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index ef84c5eb283..8012e624f16 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -550,19 +550,19 @@ group of results." ;; If this changes, modify mh-search-mode-help-messages accordingly, below. (define-keymap :keymap mh-search-mode-map - "\C-c?" #'mh-help - "\C-c\C-c" #'mh-index-do-search - "\C-c\C-p" #'mh-pick-do-search - "\C-c\C-f\C-b" #'mh-to-field - "\C-c\C-f\C-c" #'mh-to-field - "\C-c\C-f\C-m" #'mh-to-field - "\C-c\C-f\C-s" #'mh-to-field - "\C-c\C-f\C-t" #'mh-to-field - "\C-c\C-fb" #'mh-to-field - "\C-c\C-fc" #'mh-to-field - "\C-c\C-fm" #'mh-to-field - "\C-c\C-fs" #'mh-to-field - "\C-c\C-ft" #'mh-to-field) + "C-c ?" #'mh-help + "C-c C-c" #'mh-index-do-search + "C-c C-p" #'mh-pick-do-search + "C-c C-f C-b" #'mh-to-field + "C-c C-f C-c" #'mh-to-field + "C-c C-f C-m" #'mh-to-field + "C-c C-f C-s" #'mh-to-field + "C-c C-f C-t" #'mh-to-field + "C-c C-f b" #'mh-to-field + "C-c C-f c" #'mh-to-field + "C-c C-f m" #'mh-to-field + "C-c C-f s" #'mh-to-field + "C-c C-f t" #'mh-to-field) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 524179648dc..0f85cd6f69a 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -560,7 +560,7 @@ still visible.\n") ;;; MH-Show Keys (define-keymap :keymap mh-show-mode-map - " " #'mh-show-page-msg + "SPC" #'mh-show-page-msg "!" #'mh-show-refile-or-write-again "'" #'mh-show-toggle-tick "," #'mh-show-header-display @@ -570,12 +570,12 @@ still visible.\n") "?" #'mh-help "E" #'mh-show-extract-rejected-mail "M" #'mh-show-modify - "\177" #'mh-show-previous-page - "\C-d" #'mh-show-delete-msg-no-motion - "\t" #'mh-show-next-button - [backtab] #'mh-show-prev-button - "\M-\t" #'mh-show-prev-button - "\ed" #'mh-show-redistribute + "DEL" #'mh-show-previous-page + "C-d" #'mh-show-delete-msg-no-motion + "TAB" #'mh-show-next-button + "" #'mh-show-prev-button + "C-M-i" #'mh-show-prev-button + "ESC d" #'mh-show-redistribute "^" #'mh-show-refile-msg "c" #'mh-show-copy-msg "d" #'mh-show-delete-msg @@ -586,10 +586,10 @@ still visible.\n") "k" #'mh-show-delete-subject-or-thread "m" #'mh-show-send "n" #'mh-show-next-undeleted-msg - "\M-n" #'mh-show-next-unread-msg + "M-n" #'mh-show-next-unread-msg "o" #'mh-show-refile-msg "p" #'mh-show-previous-undeleted-msg - "\M-p" #'mh-show-previous-unread-msg + "M-p" #'mh-show-previous-unread-msg "q" #'mh-show-quit "r" #'mh-show-reply "s" #'mh-show-send @@ -670,8 +670,8 @@ still visible.\n") "D" (define-keymap :prefix 'mh-show-digest-map "?" #'mh-prefix-help - " " #'mh-show-page-digest - "\177" #'mh-show-page-digest-backwards + "SPC" #'mh-show-page-digest + "DEL" #'mh-show-page-digest-backwards "b" #'mh-show-burst-digest) "K" (define-keymap :prefix 'mh-show-mime-map @@ -682,9 +682,9 @@ still visible.\n") "o" #'mh-show-save-mime-part "i" #'mh-show-inline-mime-part "t" #'mh-show-toggle-mime-buttons - "\t" #'mh-show-next-button - [backtab] #'mh-show-prev-button - "\M-\t" #'mh-show-prev-button)) + "TAB" #'mh-show-next-button + "" #'mh-show-prev-button + "C-M-i" #'mh-show-prev-button)) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 82b108c8c8d..bf3a9e5774b 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -86,7 +86,7 @@ (define-keymap :keymap mh-folder-speedbar-key-map "+" #'mh-speed-expand-folder "-" #'mh-speed-contract-folder - "\r" #'mh-speed-view + "RET" #'mh-speed-view "r" #'mh-speed-refresh) (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 70ebc1d2ec6..031a73143e4 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -314,11 +314,11 @@ parameter, and should return the (possibly) transformed URL." (defvar-keymap eww-link-keymap :parent shr-map - "\r" #'eww-follow-link) + "RET" #'eww-follow-link) (defvar-keymap eww-image-link-keymap :parent shr-map - "\r" #'eww-follow-link) + "RET" #'eww-follow-link) (defun eww-suggested-uris nil "Return the list of URIs to suggest at the `eww' prompt. @@ -1045,11 +1045,11 @@ the like." (defvar-keymap eww-mode-map "g" #'eww-reload ;FIXME: revert-buffer-function instead! "G" #'eww - [?\M-\r] #'eww-open-in-new-buffer - [?\t] #'shr-next-link - [?\M-\t] #'shr-previous-link - [backtab] #'shr-previous-link - [delete] #'scroll-down-command + "M-RET" #'eww-open-in-new-buffer + "TAB" #'shr-next-link + "C-M-i" #'shr-previous-link + "" #'shr-previous-link + "" #'scroll-down-command "l" #'eww-back-url "r" #'eww-forward-url "n" #'eww-next-url @@ -1068,16 +1068,16 @@ the like." "S" #'eww-list-buffers "F" #'eww-toggle-fonts "D" #'eww-toggle-paragraph-direction - [(meta C)] #'eww-toggle-colors - [(meta I)] #'eww-toggle-images + "M-C" #'eww-toggle-colors + "M-I" #'eww-toggle-images "b" #'eww-add-bookmark "B" #'eww-list-bookmarks - [(meta n)] #'eww-next-bookmark - [(meta p)] #'eww-previous-bookmark + "M-n" #'eww-next-bookmark + "M-p" #'eww-previous-bookmark - [(mouse-8)] #'eww-back-url - [(mouse-9)] #'eww-forward-url + "" #'eww-back-url + "" #'eww-forward-url :menu '("Eww" ["Exit" quit-window t] @@ -1300,42 +1300,42 @@ just re-display the HTML already fetched." (defvar eww-form nil) (defvar-keymap eww-submit-map - "\r" #'eww-submit - [(control c) (control c)] #'eww-submit) + "RET" #'eww-submit + "C-c C-c" #'eww-submit) (defvar-keymap eww-submit-file - "\r" #'eww-select-file - [(control c) (control c)] #'eww-submit) + "RET" #'eww-select-file + "C-c C-c" #'eww-submit) (defvar-keymap eww-checkbox-map - " " #'eww-toggle-checkbox - "\r" #'eww-toggle-checkbox - [(control c) (control c)] #'eww-submit) + "SPC" #'eww-toggle-checkbox + "RET" #'eww-toggle-checkbox + "C-c C-c" #'eww-submit) (defvar-keymap eww-text-map :full t :parent text-mode-map - "\r" #'eww-submit - [(control a)] #'eww-beginning-of-text - [(control c) (control c)] #'eww-submit - [(control e)] #'eww-end-of-text - [?\t] #'shr-next-link - [?\M-\t] #'shr-previous-link - [backtab] #'shr-previous-link) + "RET" #'eww-submit + "C-a" #'eww-beginning-of-text + "C-c C-c" #'eww-submit + "C-e" #'eww-end-of-text + "TAB" #'shr-next-link + "M-TAB" #'shr-previous-link + "" #'shr-previous-link) (defvar-keymap eww-textarea-map :full t :parent text-mode-map - "\r" #'forward-line - [(control c) (control c)] #'eww-submit - [?\t] #'shr-next-link - [?\M-\t] #'shr-previous-link - [backtab] #'shr-previous-link) + "RET" #'forward-line + "C-c C-c" #'eww-submit + "TAB" #'shr-next-link + "M-TAB" #'shr-previous-link + "" #'shr-previous-link) (defvar-keymap eww-select-map :doc "Map for select buttons" - "\r" #'eww-change-select - [follow-link] 'mouse-face - [mouse-2] #'eww-change-select - [(control c) (control c)] #'eww-submit) + "RET" #'eww-change-select + "" 'mouse-face + "" #'eww-change-select + "C-c C-c" #'eww-submit) (defun eww-beginning-of-text () "Move to the start of the input field." @@ -2171,9 +2171,9 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (eww-browse-url (plist-get bookmark :url)))) (defvar-keymap eww-bookmark-mode-map - [(control k)] #'eww-bookmark-kill - [(control y)] #'eww-bookmark-yank - "\r" #'eww-bookmark-browse + "C-k" #'eww-bookmark-kill + "C-y" #'eww-bookmark-yank + "RET" #'eww-bookmark-browse :menu '("Eww Bookmark" ["Exit" quit-window t] ["Browse" eww-bookmark-browse @@ -2247,7 +2247,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (eww-restore-history history))) (defvar-keymap eww-history-mode-map - "\r" #'eww-history-browse + "RET" #'eww-history-browse "n" #'next-line "p" #'previous-line :menu '("Eww History" @@ -2366,8 +2366,8 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (eww-buffer-show)) (defvar-keymap eww-buffers-mode-map - [(control k)] #'eww-buffer-kill - "\r" #'eww-buffer-select + "C-k" #'eww-buffer-kill + "RET" #'eww-buffer-select "n" #'eww-buffer-show-next "p" #'eww-buffer-show-previous :menu '("Eww Buffers" diff --git a/lisp/net/shr.el b/lisp/net/shr.el index fd7469389ad..b9e8a18e25a 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -251,17 +251,17 @@ and other things: "a" #'shr-show-alt-text "i" #'shr-browse-image "z" #'shr-zoom-image - [?\t] #'shr-next-link - [?\M-\t] #'shr-previous-link - [follow-link] 'mouse-face - [mouse-2] #'shr-browse-url - [C-down-mouse-1] #'shr-mouse-browse-url-new-window + "TAB" #'shr-next-link + "C-M-i" #'shr-previous-link + "" 'mouse-face + "" #'shr-browse-url + "C-" #'shr-mouse-browse-url-new-window "I" #'shr-insert-image "w" #'shr-maybe-probe-and-copy-url "u" #'shr-maybe-probe-and-copy-url "v" #'shr-browse-url "O" #'shr-save-contents - "\r" #'shr-browse-url) + "RET" #'shr-browse-url) (defvar shr-image-map (let ((map (copy-keymap shr-map))) diff --git a/lisp/outline.el b/lisp/outline.el index 9a2e4324b22..a4d2a3b7d74 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -992,8 +992,8 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'keymap (define-keymap :parent outline-minor-mode-cycle-map - ["RET"] #'outline-hide-subtree - [""] #'outline-hide-subtree))))) + "RET" #'outline-hide-subtree + "" #'outline-hide-subtree))))) (defun outline--insert-close-button () (save-excursion @@ -1003,8 +1003,8 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'keymap (define-keymap :parent outline-minor-mode-cycle-map - ["RET"] #'outline-show-subtree - [""] #'outline-show-subtree))))) + "RET" #'outline-show-subtree + "" #'outline-show-subtree))))) (defun outline--fix-up-all-buttons (&optional from to) (when from diff --git a/lisp/simple.el b/lisp/simple.el index ad6d28cb14d..58283e7b7fd 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -541,9 +541,9 @@ Other major modes are defined by comparison with this one." (defvar-keymap special-mode-map :suppress t "q" #'quit-window - " " #'scroll-up-command - [?\S-\ ] #'scroll-down-command - "\C-?" #'scroll-down-command + "SPC" #'scroll-up-command + "S-SPC" #'scroll-down-command + "DEL" #'scroll-down-command "?" #'describe-mode "h" #'describe-mode ">" #'end-of-buffer diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 86b62eb1ce6..7886cc1eae2 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -40,8 +40,8 @@ "p" #'previous-line "N" #'cvs-status-next "P" #'cvs-status-prev - ["M-n"] #'cvs-status-next - ["M-p"] #'cvs-status-prev + "M-n" #'cvs-status-next + "M-p" #'cvs-status-prev "t" #'cvs-status-cvstrees "T" #'cvs-status-trees ">" #'cvs-mode-checkout) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index e68aa2257d2..87d30666da0 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -169,49 +169,49 @@ and hunk-based syntax highlighting otherwise as a fallback." "N" #'diff-file-next "p" #'diff-hunk-prev "P" #'diff-file-prev - ["TAB"] #'diff-hunk-next - [backtab] #'diff-hunk-prev + "TAB" #'diff-hunk-next + "" #'diff-hunk-prev "k" #'diff-hunk-kill "K" #'diff-file-kill "}" #'diff-file-next ; From compilation-minor-mode. "{" #'diff-file-prev - ["RET"] #'diff-goto-source - [mouse-2] #'diff-goto-source + "RET" #'diff-goto-source + "" #'diff-goto-source "W" #'widen "o" #'diff-goto-source ; other-window "A" #'diff-ediff-patch "r" #'diff-restrict-view "R" #'diff-reverse-direction - [remap undo] #'diff-undo) + " " #'diff-undo) (defvar-keymap diff-mode-map :doc "Keymap for `diff-mode'. See also `diff-mode-shared-map'." - ["ESC"] (let ((map (define-keymap :parent diff-mode-shared-map))) - ;; We want to inherit most bindings from - ;; `diff-mode-shared-map', but not all since they may hide - ;; useful `M-' global bindings when editing. - (dolist (key '("A" "r" "R" "g" "q" "W" "z")) - (define-key map key nil)) - map) + "ESC" (let ((map (define-keymap :parent diff-mode-shared-map))) + ;; We want to inherit most bindings from + ;; `diff-mode-shared-map', but not all since they may hide + ;; useful `M-' global bindings when editing. + (dolist (key '("A" "r" "R" "g" "q" "W" "z")) + (keymap-set map key nil)) + map) ;; From compilation-minor-mode. - ["C-c C-c"] #'diff-goto-source + "C-c C-c" #'diff-goto-source ;; By analogy with the global C-x 4 a binding. - ["C-x 4 A"] #'diff-add-change-log-entries-other-window + "C-x 4 A" #'diff-add-change-log-entries-other-window ;; Misc operations. - ["C-c C-a"] #'diff-apply-hunk - ["C-c C-e"] #'diff-ediff-patch - ["C-c C-n"] #'diff-restrict-view - ["C-c C-s"] #'diff-split-hunk - ["C-c C-t"] #'diff-test-hunk - ["C-c C-r"] #'diff-reverse-direction - ["C-c C-u"] #'diff-context->unified + "C-c C-a" #'diff-apply-hunk + "C-c C-e" #'diff-ediff-patch + "C-c C-n" #'diff-restrict-view + "C-c C-s" #'diff-split-hunk + "C-c C-t" #'diff-test-hunk + "C-c C-r" #'diff-reverse-direction + "C-c C-u" #'diff-context->unified ;; `d' because it duplicates the context :-( --Stef - ["C-c C-d"] #'diff-unified->context - ["C-c C-w"] #'diff-ignore-whitespace-hunk + "C-c C-d" #'diff-unified->context + "C-c C-w" #'diff-ignore-whitespace-hunk ;; `l' because it "refreshes" the hunk like C-l refreshes the screen - ["C-c C-l"] #'diff-refresh-hunk - ["C-c C-b"] #'diff-refine-hunk ;No reason for `b' :-( - ["C-c C-f"] #'next-error-follow-minor-mode) + "C-c C-l" #'diff-refresh-hunk + "C-c C-b" #'diff-refine-hunk ;No reason for `b' :-( + "C-c C-f" #'next-error-follow-minor-mode) (easy-menu-define diff-mode-menu diff-mode-map "Menu for `diff-mode'." @@ -264,9 +264,11 @@ and hunk-based syntax highlighting otherwise as a fallback." :help "Go to the next count'th file"] )) -(defcustom diff-minor-mode-prefix "\C-c=" +(defcustom diff-minor-mode-prefix "C-c =" "Prefix key for `diff-minor-mode' commands." - :type '(choice (string "\e") (string "C-c=") string)) + :type '(choice (string "ESC") + (string "C-c =") string) + :version "29.1") (defvar-keymap diff-minor-mode-map :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index c8d089e4113..6e3f302263b 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -55,18 +55,18 @@ (define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1") (defvar-keymap log-edit-mode-map - (kbd "C-c C-c") #'log-edit-done - (kbd "C-c C-a") #'log-edit-insert-changelog - (kbd "C-c C-w") #'log-edit-generate-changelog-from-diff - (kbd "C-c C-d") #'log-edit-show-diff - (kbd "C-c C-f") #'log-edit-show-files - (kbd "C-c C-k") #'log-edit-kill-buffer - (kbd "C-a") #'log-edit-beginning-of-line - (kbd "M-n") #'log-edit-next-comment - (kbd "M-p") #'log-edit-previous-comment - (kbd "M-r") #'log-edit-comment-search-backward - (kbd "M-s") #'log-edit-comment-search-forward - (kbd "C-c ?") #'log-edit-mode-help) + "C-c C-c" #'log-edit-done + "C-c C-a" #'log-edit-insert-changelog + "C-c C-w" #'log-edit-generate-changelog-from-diff + "C-c C-d" #'log-edit-show-diff + "C-c C-f" #'log-edit-show-files + "C-c C-k" #'log-edit-kill-buffer + "C-a" #'log-edit-beginning-of-line + "M-n" #'log-edit-next-comment + "M-p" #'log-edit-previous-comment + "M-r" #'log-edit-comment-search-backward + "M-s" #'log-edit-comment-search-forward + "C-c ?" #'log-edit-mode-help) (easy-menu-define log-edit-menu log-edit-mode-map "Menu used for `log-edit-mode'." diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 2c78000e38b..d45c1696a2f 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -123,7 +123,7 @@ :prefix "log-view-") (defvar-keymap log-view-mode-map - (kbd "RET") #'log-view-toggle-entry-display + "RET" #'log-view-toggle-entry-display "m" #'log-view-toggle-mark-entry "e" #'log-view-modify-change-comment "d" #'log-view-diff @@ -133,12 +133,12 @@ "f" #'log-view-find-revision "n" #'log-view-msg-next "p" #'log-view-msg-prev - (kbd "TAB") #'log-view-msg-next - (kbd "") #'log-view-msg-prev + "TAB" #'log-view-msg-next + "" #'log-view-msg-prev "N" #'log-view-file-next "P" #'log-view-file-prev - (kbd "M-n") #'log-view-file-next - (kbd "M-p") #'log-view-file-prev) + "M-n" #'log-view-file-next + "M-p" #'log-view-file-prev) (easy-menu-define log-view-mode-menu log-view-mode-map "Log-View Display Menu." diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 2daa42fbf8f..fa28d074a98 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -164,33 +164,33 @@ "z" #'kill-this-buffer "F" #'cvs-mode-set-flags "!" #'cvs-mode-force-command - ["C-c C-c"] #'cvs-mode-kill-process + "C-c C-c" #'cvs-mode-kill-process ;; marking "m" #'cvs-mode-mark "M" #'cvs-mode-mark-all-files "S" #'cvs-mode-mark-on-state "u" #'cvs-mode-unmark - ["DEL"] #'cvs-mode-unmark-up + "DEL" #'cvs-mode-unmark-up "%" #'cvs-mode-mark-matching-files "T" #'cvs-mode-toggle-marks - ["M-DEL"] #'cvs-mode-unmark-all-files + "M-DEL" #'cvs-mode-unmark-all-files ;; navigation keys - " " #'cvs-mode-next-line + "SPC" #'cvs-mode-next-line "n" #'cvs-mode-next-line "p" #'cvs-mode-previous-line - "\t" #'cvs-mode-next-line - [backtab] #'cvs-mode-previous-line + "TAB" #'cvs-mode-next-line + "" #'cvs-mode-previous-line ;; M- keys are usually those that operate on modules - ["M-c"] #'cvs-checkout - ["M-e"] #'cvs-examine + "M-c" #'cvs-checkout + "M-e" #'cvs-examine "g" #'cvs-mode-revert-buffer - ["M-u"] #'cvs-update - ["M-s"] #'cvs-status + "M-u" #'cvs-update + "M-s" #'cvs-status ;; diff commands "=" #'cvs-mode-diff "d" cvs-mode-diff-map ;; keys that operate on individual files - ["C-k"] #'cvs-mode-acknowledge + "C-k" #'cvs-mode-acknowledge "A" #'cvs-mode-add-change-log-entry-other-window "C" #'cvs-mode-commit-setup "O" #'cvs-mode-update @@ -202,7 +202,7 @@ "c" #'cvs-mode-commit "e" #'cvs-mode-examine "f" #'cvs-mode-find-file - ["RET"] #'cvs-mode-find-file + "RET" #'cvs-mode-find-file "i" #'cvs-mode-ignore "l" #'cvs-mode-log "o" #'cvs-mode-find-file-other-window @@ -214,12 +214,12 @@ ;; cvstree bindings "+" #'cvs-mode-tree ;; mouse bindings - [mouse-2] #'cvs-mode-find-file - [follow-link] (lambda (pos) + "" #'cvs-mode-find-file + "" (lambda (pos) (eq (get-char-property pos 'face) 'cvs-filename)) - [(down-mouse-3)] #'cvs-menu + "" #'cvs-menu ;; dired-like bindings - "\C-o" #'cvs-mode-display-file) + "C-o" #'cvs-mode-display-file) (easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." '("CVS" @@ -266,9 +266,10 @@ ;;;; CVS-Minor mode ;;;; -(defcustom cvs-minor-mode-prefix "\C-xc" +(defcustom cvs-minor-mode-prefix "C-x c" "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." :type 'string + :version "29.1" :group 'pcl-cvs) (defvar-keymap cvs-minor-mode-map diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 2cc5ee739fd..ee6ddf15881 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -156,16 +156,17 @@ Used in `smerge-diff-base-upper' and related functions." "E" #'smerge-ediff "C" #'smerge-combine-with-next "R" #'smerge-refine - ["C-m"] #'smerge-keep-current + "C-m" #'smerge-keep-current "=" (define-keymap :name "Diff" "<" (cons "base-upper" #'smerge-diff-base-upper) ">" (cons "base-lower" #'smerge-diff-base-lower) "=" (cons "upper-lower" #'smerge-diff-upper-lower))) -(defcustom smerge-command-prefix "\C-c^" +(defcustom smerge-command-prefix "C-c ^" "Prefix for `smerge-mode' commands." + :version "29.1" :type '(choice (const :tag "ESC" "\e") - (const :tag "C-c ^" "\C-c^" ) + (const :tag "C-c ^" "C-c ^") (const :tag "none" "") string)) From 331366395e80affec9637cec3759d49135b94844 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Nov 2021 08:23:53 +0100 Subject: [PATCH 063/367] Start adjusting the manuals to talk about the keymap-* functions * lisp/dired.el (dired--make-directory-clickable): * doc/lispref/keymaps.texi (Keymaps): (Key Sequences): (Prefix Keys): (Active Keymaps): (Key Lookup): (Functions for Key Lookup): (Changing Key Bindings): (Key Binding Commands): (Tool Bar): * doc/lispref/commands.texi (Interactive Codes): (Event Examples): (Event Mod): * doc/emacs/kmacro.texi (Save Keyboard Macro): * doc/emacs/custom.texi (Keymaps): (Keymaps): (Minibuffer Maps): (Rebinding): (Init Rebinding): (Modifier Keys): (Mouse Buttons): (Init Examples): (Init Non-ASCII): Adjust the documentation to remove description of the old syntaxes, and use the new keymap-* functions. * doc/lispref/keymaps.texi (Low-Level Key Binding): New node that describes `define-key' and the old key syntaxes. --- doc/emacs/custom.texi | 135 +++++---------- doc/emacs/kmacro.texi | 2 +- doc/lispref/commands.texi | 18 +- doc/lispref/elisp.texi | 1 + doc/lispref/keymaps.texi | 335 +++++++++++++++++++------------------- lisp/dired.el | 6 +- 6 files changed, 225 insertions(+), 272 deletions(-) diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index d9d6a680057..917f6f49214 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1584,7 +1584,7 @@ which overrides the global definitions of some keys. self-inserting because the global keymap binds it to the command @code{self-insert-command}. The standard Emacs editing characters such as @kbd{C-a} also get their standard meanings from the global -keymap. Commands to rebind keys, such as @kbd{M-x global-set-key}, +keymap. Commands to rebind keys, such as @kbd{M-x keymap-global-set}, work by storing the new binding in the proper place in the global map (@pxref{Rebinding}). To view the current key bindings, use the @kbd{C-h b} command. @@ -1736,8 +1736,8 @@ them, it may be convenient to disable completion on those keys by putting this in your init file: @lisp -(define-key minibuffer-local-completion-map " " 'self-insert-command) -(define-key minibuffer-local-completion-map "?" 'self-insert-command) +(keymap-set minibuffer-local-completion-map "SPC" 'self-insert-command) +(keymap-set minibuffer-local-completion-map "?" 'self-insert-command) @end lisp @node Rebinding @@ -1756,19 +1756,19 @@ local keymap, which affects all buffers using the same major mode. Emacs session. @xref{Init Rebinding}, for a description of how to make key rebindings affect future Emacs sessions. -@findex global-set-key -@findex local-set-key -@findex global-unset-key -@findex local-unset-key +@findex keymap-global-set +@findex keymap-local-set +@findex keymap-global-unset +@findex keymap-local-unset @table @kbd -@item M-x global-set-key @key{RET} @var{key} @var{cmd} @key{RET} +@item M-x keymap-global-set @key{RET} @var{key} @var{cmd} @key{RET} Define @var{key} globally to run @var{cmd}. -@item M-x local-set-key @key{RET} @var{key} @var{cmd} @key{RET} +@item M-x keymap-local-set @key{RET} @var{key} @var{cmd} @key{RET} Define @var{key} locally (in the major mode now in effect) to run @var{cmd}. -@item M-x global-unset-key @key{RET} @var{key} +@item M-x keymap-global-unset @key{RET} @var{key} Make @var{key} undefined in the global map. -@item M-x local-unset-key @key{RET} @var{key} +@item M-x keymap-local-unset @key{RET} @var{key} Make @var{key} undefined locally (in the major mode now in effect). @end table @@ -1777,11 +1777,11 @@ command (@pxref{Interactive Shell}), replacing the normal global definition of @kbd{C-z}: @example -M-x global-set-key @key{RET} C-z shell @key{RET} +M-x keymap-global-set @key{RET} C-z shell @key{RET} @end example @noindent -The @code{global-set-key} command reads the command name after the +The @code{keymap-global-set} command reads the command name after the key. After you press the key, a message like this appears so that you can confirm that you are binding the key you want: @@ -1802,7 +1802,7 @@ reads another character; if that is @kbd{4}, another prefix character, it reads one more character, and so on. For example, @example -M-x global-set-key @key{RET} C-x 4 $ spell-other-window @key{RET} +M-x keymap-global-set @key{RET} C-x 4 $ spell-other-window @key{RET} @end example @noindent @@ -1810,8 +1810,8 @@ redefines @kbd{C-x 4 $} to run the (fictitious) command @code{spell-other-window}. You can remove the global definition of a key with -@code{global-unset-key}. This makes the key @dfn{undefined}; if you -type it, Emacs will just beep. Similarly, @code{local-unset-key} makes +@code{keymap-global-unset}. This makes the key @dfn{undefined}; if you +type it, Emacs will just beep. Similarly, @code{keymap-local-unset} makes a key undefined in the current major mode keymap, which makes the global definition (or lack of one) come back into effect in that major mode. @@ -1844,11 +1844,11 @@ you can specify them in your initialization file by writing Lisp code. simplest is to use the @code{kbd} function, which converts a textual representation of a key sequence---similar to how we have written key sequences in this manual---into a form that can be passed as an -argument to @code{global-set-key}. For example, here's how to bind +argument to @code{keymap-global-set}. For example, here's how to bind @kbd{C-z} to the @code{shell} command (@pxref{Interactive Shell}): @example -(global-set-key (kbd "C-z") 'shell) +(keymap-global-set "C-z" 'shell) @end example @noindent @@ -1861,69 +1861,24 @@ causes an error; it certainly isn't what you want. and mouse events: @example -(global-set-key (kbd "C-c y") 'clipboard-yank) -(global-set-key (kbd "C-M-q") 'query-replace) -(global-set-key (kbd "") 'flyspell-mode) -(global-set-key (kbd "C-") 'display-line-numbers-mode) -(global-set-key (kbd "C-") 'forward-sentence) -(global-set-key (kbd "") 'mouse-save-then-kill) -@end example - - Instead of using @code{kbd}, you can use a Lisp string or vector to -specify the key sequence. Using a string is simpler, but only works -for @acronym{ASCII} characters and Meta-modified @acronym{ASCII} -characters. For example, here's how to bind @kbd{C-x M-l} to -@code{make-symbolic-link} (@pxref{Copying and Naming}): - -@example -(global-set-key "\C-x\M-l" 'make-symbolic-link) -@end example - - To bind a key sequence including @key{TAB}, @key{RET}, @key{ESC}, or -@key{DEL}, the string should contain the Emacs Lisp escape sequence -@samp{\t}, @samp{\r}, @samp{\e}, or @samp{\d} respectively. Here is -an example which binds @kbd{C-x @key{TAB}} to @code{indent-rigidly} -(@pxref{Indentation}): - -@example -(global-set-key "\C-x\t" 'indent-rigidly) -@end example - - When the key sequence includes function keys or mouse button events, -or non-@acronym{ASCII} characters such as @code{C-=} or @code{H-a}, -you can use a vector to specify the key sequence. Each element in the -vector stands for an input event; the elements are separated by spaces -and surrounded by a pair of square brackets. If a vector element is a -character, write it as a Lisp character constant: @samp{?} followed by -the character as it would appear in a string. Function keys are -represented by symbols (@pxref{Function Keys}); simply write the -symbol's name, with no other delimiters or punctuation. Here are some -examples: - -@example -(global-set-key [?\C-=] 'make-symbolic-link) -(global-set-key [?\M-\C-=] 'make-symbolic-link) -(global-set-key [?\H-a] 'make-symbolic-link) -(global-set-key [f7] 'make-symbolic-link) -(global-set-key [C-mouse-1] 'make-symbolic-link) -@end example - -@noindent -You can use a vector for the simple cases too: - -@example -(global-set-key [?\C-z ?\M-l] 'make-symbolic-link) +(keymap-global-set "C-c y" 'clipboard-yank) +(keymap-global-set "C-M-q" 'query-replace) +(keymap-global-set "" 'flyspell-mode) +(keymap-global-set "C-" 'display-line-numbers-mode) +(keymap-global-set "C-" 'forward-sentence) +(keymap-global-set "" 'mouse-save-then-kill) @end example Language and coding systems may cause problems with key bindings for non-@acronym{ASCII} characters. @xref{Init Non-ASCII}. -@findex define-key +@findex keymap-set +@findex keymap-unset As described in @ref{Local Keymaps}, major modes and minor modes can define local keymaps. These keymaps are constructed when the mode is -loaded for the first time in a session. The function @code{define-key} -can be used to make changes in a specific keymap. This function can -also unset keys, when passed @code{nil} as the binding. +loaded for the first time in a session. The function @code{keymap-set} +can be used to make changes in a specific keymap. To remove a key +binding, use @code{keymap-unset}. Since a mode's keymaps are not constructed until it has been loaded, you must delay running code which modifies them, e.g., by putting it @@ -1935,11 +1890,11 @@ the one for @kbd{C-c C-x x} in Texinfo mode: @example (add-hook 'texinfo-mode-hook (lambda () - (define-key texinfo-mode-map "\C-cp" + (keymap-set texinfo-mode-map "C-c p" 'backward-paragraph) - (define-key texinfo-mode-map "\C-cn" + (keymap-set texinfo-mode-map "C-c n" 'forward-paragraph))) - (define-key texinfo-mode-map "\C-c\C-xx" nil) + (keymap-set texinfo-mode-map "C-c C-x x" nil) @end example @node Modifier Keys @@ -1961,7 +1916,7 @@ between those keystrokes. However, you can bind shifted @key{Control} alphabetical keystrokes in GUI frames: @lisp -(global-set-key (kbd "C-S-n") #'previous-line) +(keymap-global-set "C-S-n" #'previous-line) @end lisp For all other modifiers, you can make the modified alphabetical @@ -2115,7 +2070,7 @@ button, @code{mouse-2} for the next, and so on. Here is how you can redefine the second mouse button to split the current window: @example -(global-set-key [mouse-2] 'split-window-below) +(keymap-global-set "" 'split-window-below) @end example The symbols for drag events are similar, but have the prefix @@ -2198,7 +2153,7 @@ Thus, here is how to define the command for clicking the first button in a mode line to run @code{scroll-up-command}: @example -(global-set-key [mode-line mouse-1] 'scroll-up-command) +(keymap-global-set " " 'scroll-up-command) @end example Here is the complete list of these dummy prefix keys and their @@ -2589,13 +2544,13 @@ Rebind the key @kbd{C-x l} to run the function @code{make-symbolic-link} (@pxref{Init Rebinding}). @example -(global-set-key "\C-xl" 'make-symbolic-link) +(keymap-global-set "C-x l" 'make-symbolic-link) @end example or @example -(define-key global-map "\C-xl" 'make-symbolic-link) +(keymap-set global-map "C-x l" 'make-symbolic-link) @end example Note once again the single-quote used to refer to the symbol @@ -2605,7 +2560,7 @@ Note once again the single-quote used to refer to the symbol Do the same thing for Lisp mode only. @example -(define-key lisp-mode-map "\C-xl" 'make-symbolic-link) +(keymap-set lisp-mode-map "C-x l" 'make-symbolic-link) @end example @item @@ -2622,7 +2577,7 @@ so that they run @code{forward-line} instead. Make @kbd{C-x C-v} undefined. @example -(global-unset-key "\C-x\C-v") +(keymap-global-unset "C-x C-v") @end example One reason to undefine a key is so that you can make it a prefix. @@ -2798,18 +2753,6 @@ strings incorrectly. You should then avoid adding Emacs Lisp code that modifies the coding system in other ways, such as calls to @code{set-language-environment}. - To bind non-@acronym{ASCII} keys, you must use a vector (@pxref{Init -Rebinding}). The string syntax cannot be used, since the -non-@acronym{ASCII} characters will be interpreted as meta keys. For -instance: - -@example -(global-set-key [?@var{char}] 'some-function) -@end example - -@noindent -Type @kbd{C-q}, followed by the key you want to bind, to insert @var{char}. - @node Early Init File @subsection The Early Init File @cindex early init file diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi index 78964bb903f..e0533f049ea 100644 --- a/doc/emacs/kmacro.texi +++ b/doc/emacs/kmacro.texi @@ -439,7 +439,7 @@ name to execute the last keyboard macro, in its current form. (If you later add to the definition of this macro, that does not alter the name's definition as a macro.) The macro name is a Lisp symbol, and defining it in this way makes it a valid command name for calling with -@kbd{M-x} or for binding a key to with @code{global-set-key} +@kbd{M-x} or for binding a key to with @code{keymap-global-set} (@pxref{Keymaps}). If you specify a name that has a prior definition other than a keyboard macro, an error message is shown and nothing is changed. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6ed46fa6a27..1509c200e0d 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -451,7 +451,7 @@ reads and discards the following up-event. You can get access to that up-event with the @samp{U} code character. This kind of input is used by commands such as @code{describe-key} and -@code{global-set-key}. +@code{keymap-global-set}. @item K A key sequence on a form that can be used as input to functions like @@ -2147,7 +2147,7 @@ bind it to the @code{signal usr1} event sequence: (defun usr1-handler () (interactive) (message "Got USR1 signal")) -(global-set-key [signal usr1] 'usr1-handler) +(keymap-global-set " " 'usr1-handler) @end smallexample @node Classifying Events @@ -3016,7 +3016,7 @@ supplied to input methods (@pxref{Input Methods}). Use if you want to translate characters after input methods operate. @end defvar -@defun keyboard-translate from to +@defun key-translate from to This function modifies @code{keyboard-translate-table} to translate character code @var{from} into character code @var{to}. It creates the keyboard translate table if necessary. @@ -3027,12 +3027,12 @@ make @kbd{C-x}, @kbd{C-c} and @kbd{C-v} perform the cut, copy and paste operations: @example -(keyboard-translate ?\C-x 'control-x) -(keyboard-translate ?\C-c 'control-c) -(keyboard-translate ?\C-v 'control-v) -(global-set-key [control-x] 'kill-region) -(global-set-key [control-c] 'kill-ring-save) -(global-set-key [control-v] 'yank) +(key-translate "C-x" "") +(key-translate "C-c" "") +(key-translate "C-v" "") +(keymap-global-set "" 'kill-region) +(keymap-global-set "" 'kill-ring-save) +(keymap-global-set "" 'yank) @end example @noindent diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 1c0b0fa1b5a..4f47a1d1bbd 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -840,6 +840,7 @@ Keymaps * Key Lookup:: Finding a key's binding in one keymap. * Functions for Key Lookup:: How to request key lookup. * Changing Key Bindings:: Redefining a key in a keymap. +* Low-Level Key Binding:: Legacy key syntax description. * Remapping Commands:: A keymap can translate one command to another. * Translation Keymaps:: Keymaps for translating sequences of events. * Key Binding Commands:: Interactive interfaces for redefining keys. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 899499ed46e..86faba26190 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -30,6 +30,7 @@ is found. The whole process is called @dfn{key lookup}. * Key Lookup:: Finding a key's binding in one keymap. * Functions for Key Lookup:: How to request key lookup. * Changing Key Bindings:: Redefining a key in a keymap. +* Low-Level Key Binding:: Legacy key syntax description. * Remapping Commands:: A keymap can translate one command to another. * Translation Keymaps:: Keymaps for translating sequences of events. * Key Binding Commands:: Interactive interfaces for redefining keys. @@ -95,21 +96,11 @@ Manual}. (kbd "C-M-") @result{} [C-M-down] @end example -@findex kbd-valid-p +@findex key-valid-p The @code{kbd} function is very permissive, and will try to return something sensible even if the syntax used isn't completely conforming. To check whether the syntax is actually valid, use the -@code{kbd-valid-p} function. - -@code{define-key} also supports using the shorthand syntax -@samp{["..."]} syntax to define a key. The string has to be a -strictly valid @code{kbd} sequence, and if it's not valid, an error -will be signalled. For instance, to bind @key{C-c f}, you can say: - -@lisp -(define-key global-map ["C-c f"] #'find-file-literally) -@end lisp - +@code{key-valid-p} function. @end defun @@ -627,16 +618,16 @@ active keymap. @result{} nil @end group @group -(local-set-key "\C-p" ctl-x-map) +(keymap-local-set "C-p" ctl-x-map) @result{} nil @end group @group -(key-binding "\C-p\C-f") +(keymap-binding "C-p C-f") @result{} find-file @end group @group -(key-binding "\C-p6") +(keymap-binding "C-p 6") @result{} nil @end group @end example @@ -699,7 +690,7 @@ use, in place of the buffer's default local keymap. @cindex major mode keymap The local keymap is normally set by the buffer's major mode, and every buffer with the same major mode shares the same local keymap. -Hence, if you call @code{local-set-key} (@pxref{Key Binding Commands}) +Hence, if you call @code{keymap-local-set} (@pxref{Key Binding Commands}) to change the local keymap in one buffer, that also affects the local keymaps in other buffers with the same major mode. @@ -733,39 +724,7 @@ Normally it ignores @code{overriding-local-map} and then it pays attention to them. @var{position} can optionally be either an event position as returned by @code{event-start} or a buffer position, and may change the keymaps as described for -@code{key-binding}. -@end defun - -@defun key-binding key &optional accept-defaults no-remap position -This function returns the binding for @var{key} according to the -current active keymaps. The result is @code{nil} if @var{key} is -undefined in the keymaps. - -The argument @var{accept-defaults} controls checking for default -bindings, as in @code{lookup-key} (@pxref{Functions for Key Lookup}). - -When commands are remapped (@pxref{Remapping Commands}), -@code{key-binding} normally processes command remappings so as to -return the remapped command that will actually be executed. However, -if @var{no-remap} is non-@code{nil}, @code{key-binding} ignores -remappings and returns the binding directly specified for @var{key}. - -If @var{key} starts with a mouse event (perhaps following a prefix -event), the maps to be consulted are determined based on the event's -position. Otherwise, they are determined based on the value of point. -However, you can override either of them by specifying @var{position}. -If @var{position} is non-@code{nil}, it should be either a buffer -position or an event position like the value of @code{event-start}. -Then the maps consulted are determined based on @var{position}. - -Emacs signals an error if @var{key} is not a string or a vector. - -@example -@group -(key-binding "\C-x\C-f") - @result{} find-file -@end group -@end example +@code{keymap-binding}. @end defun @node Searching Keymaps @@ -1042,7 +1001,7 @@ keymap. Let's use the term @dfn{keymap entry} to describe the value found by looking up an event type in a keymap. (This doesn't include the item string and other extra elements in a keymap element for a menu item, because -@code{lookup-key} and other key lookup functions don't include them in +@code{keymap-lookup} and other key lookup functions don't include them in the returned value.) While any Lisp object may be stored in a keymap as a keymap entry, not all make sense for key lookup. Here is a table of the meaningful types of keymap entries: @@ -1193,7 +1152,7 @@ Used in keymaps to undefine keys. It calls @code{ding}, but does not cause an error. @end deffn -@defun local-key-binding key &optional accept-defaults +@defun keymap-local-binding key &optional accept-defaults This function returns the binding for @var{key} in the current local keymap, or @code{nil} if it is undefined there. @@ -1201,7 +1160,7 @@ The argument @var{accept-defaults} controls checking for default bindings, as in @code{lookup-key} (above). @end defun -@defun global-key-binding key &optional accept-defaults +@defun keymap-global-binding key &optional accept-defaults This function returns the binding for command @var{key} in the current global keymap, or @code{nil} if it is undefined there. @@ -1284,65 +1243,55 @@ change a binding in the global keymap, the change is effective in all buffers (though it has no direct effect in buffers that shadow the global binding with a local one). If you change the current buffer's local map, that usually affects all buffers using the same major mode. -The @code{global-set-key} and @code{local-set-key} functions are +The @code{keymap-global-set} and @code{keymap-local-set} functions are convenient interfaces for these operations (@pxref{Key Binding -Commands}). You can also use @code{define-key}, a more general +Commands}). You can also use @code{keymap-set}, a more general function; then you must explicitly specify the map to change. When choosing the key sequences for Lisp programs to rebind, please follow the Emacs conventions for use of various keys (@pxref{Key Binding Conventions}). -@cindex meta character key constants -@cindex control character key constants - @code{define-key} (and other functions that are used to rebind keys) -understand a number of different syntaxes for the keys. + The functions below signal an error if @var{keymap} is not a keymap, +or if @var{key} is not a valid key. -@table @asis -@item A vector containing a single string. -This is the preferred way to represent a key sequence. Here's a -couple of examples: +@var{key} is a string representing a single key or a series of key +strokes. Key strokes are separated by a single space character. -@example -["C-c M-f"] -["S-"] -@end example +Each key stroke is either a single character, or the name of an +event, surrounded by angle brackets. In addition, any key stroke +may be preceded by one or more modifier keys. Finally, a limited +number of characters have a special shorthand syntax. Here's some +example key sequences: -The syntax is the same as the one used by Emacs when displaying key -bindings, for instance in @samp{*Help*} buffers and help texts. +@table @kbd +@item f +The key @kbd{f}. -If the syntax isn't valid, an error will be raised when running -@code{define-key}, or when byte-compiling code that has these calls. +@item S o m +A three key sequence of the keys @kbd{S}, @kbd{o} and @kbd{m}. -@item A vector containing lists of keys. -You can use a list containing modifier names plus one base event (a -character or function key name). For example, @code{[(control ?a) -(meta b)]} is equivalent to @kbd{C-a M-b} and @code{[(hyper control -left)]} is equivalent to @kbd{C-H-left}. +@item C-c o +A two key sequence of the keys @kbd{c} with the control modifier and +then the key @kbd{o} -@item A string with control and meta characters. -Internally, key sequences are often represented as strings using the -special escape sequences for control and meta characters -(@pxref{String Type}), but this representation can also be used by -users when rebinding keys. A string like @code{"\M-x"} is read as -containing a single @kbd{M-x}, @code{"\C-f"} is read as containing a -single @kbd{C-f}, and @code{"\M-\C-x"} and @code{"\C-\M-x"} are both -read as containing a single @kbd{C-M-x}. +@item H- +The key named @kbd{left} with the hyper modifier. -@item a vector of characters. -This is the other internal representation of key sequences, and -supports a fuller range of modifiers than the string representation. -One example is @samp{[?\C-\H-x home]}, which represents the @kbd{C-H-x -home} key sequence. @xref{Character Type}. +@item M-RET +The @kbd{return} key with a meta modifier. + +@item C-M- +The @kbd{space} key with both the control and meta modifiers. @end table - The functions below signal an error if @var{keymap} is not a keymap, -or if @var{key} is not a string or vector representing a key sequence. -You can use event types (symbols) as shorthand for events that are -lists. The @code{kbd} function (@pxref{Key Sequences}) is a -convenient way to specify the key sequence. +The only keys that have a special shorthand syntax are @kbd{NUL}, +@kbd{RET}, @kbd{TAB}, @kbd{LFD}, @kbd{ESC}, @kbd{SPC} and @kbd{DEL}. -@defun define-key keymap key binding +The modifiers have to be specified in alphabetical order: +@samp{A-C-H-M-S-s}, which is @samp{Alt-Control-Hyper-Meta-Shift-super}. + +@defun keymap-set keymap key binding This function sets the binding for @var{key} in @var{keymap}. (If @var{key} is more than one event long, the change is actually made in another keymap reached from @var{keymap}.) The argument @@ -1350,7 +1299,7 @@ in another keymap reached from @var{keymap}.) The argument meaningful. (For a list of meaningful types, see @ref{Key Lookup}.) The value returned by @code{define-key} is @var{binding}. -If @var{key} is @code{[t]}, this sets the default binding in +If @var{key} is @kbd{}, this sets the default binding in @var{keymap}. When an event has no binding of its own, the Emacs command loop uses the keymap's default binding, if there is one. @@ -1358,7 +1307,7 @@ command loop uses the keymap's default binding, if there is one. @cindex key sequence error Every prefix of @var{key} must be a prefix key (i.e., bound to a keymap) or undefined; otherwise an error is signaled. If some prefix of -@var{key} is undefined, then @code{define-key} defines it as a prefix +@var{key} is undefined, then @code{keymap-set} defines it as a prefix key so that the rest of @var{key} can be defined as specified. If there was previously no binding for @var{key} in @var{keymap}, the @@ -1376,7 +1325,7 @@ bindings in it: @result{} (keymap) @end group @group -(define-key map ["C-f"] 'forward-char) +(keymap-set map "C-f" 'forward-char) @result{} forward-char @end group @group @@ -1386,7 +1335,7 @@ map @group ;; @r{Build sparse submap for @kbd{C-x} and bind @kbd{f} in that.} -(define-key map ["C-x f"] 'forward-word) +(keymap-set map "C-x f" 'forward-word) @result{} forward-word @end group @group @@ -1399,14 +1348,14 @@ map @group ;; @r{Bind @kbd{C-p} to the @code{ctl-x-map}.} -(define-key map ["C-p"] ctl-x-map) +(keymap-set map "C-p" ctl-x-map) ;; @code{ctl-x-map} @result{} [nil @dots{} find-file @dots{} backward-kill-sentence] @end group @group ;; @r{Bind @kbd{C-f} to @code{foo} in the @code{ctl-x-map}.} -(define-key map ["C-p C-f"] 'foo) +(keymap-set map "C-p C-f" 'foo) @result{} 'foo @end group @group @@ -1426,9 +1375,9 @@ changing the bindings of both @kbd{C-p C-f} and @kbd{C-x C-f} in the default global map. @defun define-keymap &key options... &rest pairs... -@code{define-key} is the general work horse for defining a key in a +@code{keymap-set} is the general work horse for defining a key in a keymap. When writing modes, however, you frequently have to bind a -large number of keys at once, and using @code{define-key} on them all +large number of keys at once, and using @code{keymap-set} on them all can be tedious and error-prone. Instead you can use @code{define-keymap}, which creates a keymaps and binds a number of keys. Here's a very basic example: @@ -1437,14 +1386,14 @@ keys. Here's a very basic example: (define-keymap "n" #'forward-line "f" #'previous-line - ["C-c C-c"] #'quit-window) + "C-c C-c" #'quit-window) @end lisp This function creates a new sparse keymap, defines the two keystrokes in @var{pairs}, and returns the new keymap. @var{pairs} is a list of alternating key bindings and key definitions, -as accepted by @code{define-key}. In addition the key can be the +as accepted by @code{keymap-set}. In addition the key can be the special symbol @code{:menu}, in which case the definition should be a menu definition as accepted by @code{easy-menu-define} (@pxref{Easy Menu}). Here's a brief example: @@ -1513,8 +1462,8 @@ Here's an example: @lisp (defvar-keymap eww-textarea-map :parent text-mode-map - "\r" #'forward-line - [?\t] #'shr-next-link) + "RET" #'forward-line + "TAB" #'shr-next-link) @end lisp @end defmac @@ -1617,13 +1566,112 @@ Modes}); then its keymap will automatically inherit from (defvar special-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - (define-key map "q" 'quit-window) + (keymap-set map "q" 'quit-window) @dots{} map)) @end group @end smallexample @end defun +@node Low-Level Key Binding +@section Low-Level Key Binding + + Historically, Emacs has supported a number of different syntaxes for +defining keys. The documented way to bind a key today is to use the +syntax supported by @code{key-valid-p}, which is what all the +functions like @code{keymap-set} and @code{keymap-lookup} supports. +This section of the manual documents the old syntax and interface +functions, and should not be used in new code. + +@cindex meta character key constants +@cindex control character key constants + @code{define-key} (and other low-level functions that are used to +rebind keys) understand a number of different syntaxes for the keys. + +@table @asis +@item A vector containing lists of keys. +You can use a list containing modifier names plus one base event (a +character or function key name). For example, @code{[(control ?a) +(meta b)]} is equivalent to @kbd{C-a M-b} and @code{[(hyper control +left)]} is equivalent to @kbd{C-H-left}. + +@item A string with control and meta characters. +Internally, key sequences are often represented as strings using the +special escape sequences for control and meta characters +(@pxref{String Type}), but this representation can also be used by +users when rebinding keys. A string like @code{"\M-x"} is read as +containing a single @kbd{M-x}, @code{"\C-f"} is read as containing a +single @kbd{C-f}, and @code{"\M-\C-x"} and @code{"\C-\M-x"} are both +read as containing a single @kbd{C-M-x}. + +@item a vector of characters. +This is the other internal representation of key sequences, and +supports a fuller range of modifiers than the string representation. +One example is @samp{[?\C-\H-x home]}, which represents the @kbd{C-H-x +home} key sequence. @xref{Character Type}. +@end table + +@defun define-key keymap key binding &optional remove +This function is like @code{keymap-set} (@pxref{Changing Key +Bindings}, but understands only the legacy key syntaxes. + +In addition, this function also has a @var{remove} argument. If it is +non-@code{nil}, the definition will be removed. This is almost the +same as setting the definition to @code{nil}, but makes a difference +if the @var{keymap} has a parent, and @var{key} is shadowing the same +binding in the parent. With @var{remove}, subsequent lookups will +return the binding in the parent, and with a nil @var{def}, the +lookups will return @code{nil}. +@end defun + +There's a number of other legacy key definition functions. Below is a +list of them, with the equivalent modern function to use instead. + +@table @code +@findex global-set-key +@item global-set-key +Use @code{keymap-global-set} instead. + +@findex local-set-key +@item local-set-key +Use @code{keymap-local-set} instead. + +@findex global-unset-key +@item global-unset-key +Use @code{keymap-global-unset} instead. + +@findex local-unset-key +@item local-unset-key +Use @code{keymap-local-unset} instead. + +@findex substitute-key-definition +@item substitute-key-definition +Use @code{keymap-substitute} instead. + +@findex define-key-after +@item define-key-after +Use @code{keymap-set-after} instead. + +@findex keyboard-translate +@item keyboard-translate +Use @code{key-translate} instead. + +@findex lookup-keymap +@findex key-binding +@item lookup-keymap +@itemx key-binding +Use @code{keymap-lookup} instead. + +@findex local-key-binding +@item local-key-binding +Use @code{keymap-local-lookup} instead. + +@findex global-key-binding +@item gobal-key-binding +Use @code{keymap-global-lookup} instead. +@end table + + @node Remapping Commands @section Remapping Commands @cindex remapping commands @@ -1834,32 +1882,18 @@ problematic suffixes/prefixes are @kbd{@key{ESC}}, @kbd{M-O} (which is really This section describes some convenient interactive interfaces for changing key bindings. They work by calling @code{define-key}. - People often use @code{global-set-key} in their init files + People often use @code{keymap-global-set} in their init files (@pxref{Init File}) for simple customization. For example, @smallexample -(global-set-key (kbd "C-x C-\\") 'next-line) -@end smallexample - -@noindent -or - -@smallexample -(global-set-key [?\C-x ?\C-\\] 'next-line) -@end smallexample - -@noindent -or - -@smallexample -(global-set-key [(control ?x) (control ?\\)] 'next-line) +(keymap-global-set "C-x C-\\" 'next-line) @end smallexample @noindent redefines @kbd{C-x C-\} to move down a line. @smallexample -(global-set-key [M-mouse-1] 'mouse-set-point) +(keymap-global-set "M-" 'mouse-set-point) @end smallexample @noindent @@ -1873,14 +1907,7 @@ they usually will be in a Lisp file (@pxref{Loading Non-ASCII}), you must type the keys as multibyte too. For instance, if you use this: @smallexample -(global-set-key "ö" 'my-function) ; bind o-umlaut -@end smallexample - -@noindent -or - -@smallexample -(global-set-key ?ö 'my-function) ; bind o-umlaut +(keymap-global-set "ö" 'my-function) ; bind o-umlaut @end smallexample @noindent @@ -1891,20 +1918,20 @@ binding, you need to teach Emacs how to decode the keyboard by using an appropriate input method (@pxref{Input Methods, , Input Methods, emacs, The GNU Emacs Manual}). -@deffn Command global-set-key key binding +@deffn Command keymap-global-set key binding This function sets the binding of @var{key} in the current global map to @var{binding}. @smallexample @group -(global-set-key @var{key} @var{binding}) +(keymap-global-set @var{key} @var{binding}) @equiv{} -(define-key (current-global-map) @var{key} @var{binding}) +(keymap-set (current-global-map) @var{key} @var{binding}) @end group @end smallexample @end deffn -@deffn Command global-unset-key key +@deffn Command keymap-global-unset key @cindex unbinding keys This function removes the binding of @var{key} from the current global map. @@ -1915,50 +1942,32 @@ that uses @var{key} as a prefix---which would not be allowed if @smallexample @group -(global-unset-key "\C-l") +(keymap-global-unset "C-l") @result{} nil @end group @group -(global-set-key "\C-l\C-l" 'redraw-display) +(keymap-global-set "C-l C-l" 'redraw-display) @result{} nil @end group @end smallexample - -This function is equivalent to using @code{define-key} as follows: - -@smallexample -@group -(global-unset-key @var{key}) -@equiv{} -(define-key (current-global-map) @var{key} nil) -@end group -@end smallexample @end deffn -@deffn Command local-set-key key binding +@deffn Command keymap-local-set key binding This function sets the binding of @var{key} in the current local keymap to @var{binding}. @smallexample @group -(local-set-key @var{key} @var{binding}) +(keymap-local-set @var{key} @var{binding}) @equiv{} -(define-key (current-local-map) @var{key} @var{binding}) +(keymap-set (current-local-map) @var{key} @var{binding}) @end group @end smallexample @end deffn -@deffn Command local-unset-key key +@deffn Command keymap-local-unset key This function removes the binding of @var{key} from the current local map. - -@smallexample -@group -(local-unset-key @var{key}) -@equiv{} -(define-key (current-local-map) @var{key} nil) -@end group -@end smallexample @end deffn @node Scanning Keymaps @@ -2813,9 +2822,9 @@ using an indirection through @code{tool-bar-map}. By default, the global map binds @code{[tool-bar]} as follows: @example -(global-set-key [tool-bar] - `(menu-item ,(purecopy "tool bar") ignore - :filter tool-bar-make-keymap)) +(keymap-global-set "" + `(menu-item ,(purecopy "tool bar") ignore + :filter tool-bar-make-keymap)) @end example @noindent diff --git a/lisp/dired.el b/lisp/dired.el index 40dfc39b9ad..8650fb9baa8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1672,9 +1672,9 @@ see `dired-use-ls-dired' for more details.") (dired-goto-subdir current-dir) (dired current-dir))))) (define-keymap - [mouse-2] click - [follow-link] 'mouse-face - ["RET"] click)))) + "" click + "" 'mouse-face + "RET" click)))) (setq segment-start (point))))))) From 977f102a49749e09cec1766158ec617704606089 Mon Sep 17 00:00:00 2001 From: Michael Herstine Date: Tue, 16 Nov 2021 08:48:24 +0100 Subject: [PATCH 064/367] Make results details in ert-run-tests-batch configurable * lisp/emacs-lisp/ert.el (ert-batch-print-length) (ert-batch-print-level,.ert-batch-backtrace-line-length) (ert-batch-test, ert-run-tests-interactively): Added the three variables, bound them to these settings when formatting batch test results including backtraces. Removed the optional parameters output-buffer & message-fn from ert-run-tests-interactively. * test/lisp/emacs-lisp/ert-tests.el (ert-test-run-tests-interactively, ert-test-run-tests-batch): use cl-letf to capture output, new tests resp. * test/lisp/ert-x-tests.el (ert-test-run-tests-interactively-2): Changed to use cl-letf to capture output instead of using message-fn. * lisp/emacs-lisp/backtrace.el (backtrace--line-length-or-nil) (backtrace--print-func-and-args): Fixed a bug when setting backtrace-line-length to nil by adding a new function to check for that case & having backtrace--print-func-and-args use it. * doc/misc/ert.texi: document the new variables & their usage (bug#51037). --- doc/misc/ert.texi | 27 ++++++++- etc/NEWS | 7 +++ lisp/emacs-lisp/backtrace.el | 24 ++++++-- lisp/emacs-lisp/ert.el | 87 +++++++++++++++++++---------- test/lisp/emacs-lisp/ert-tests.el | 82 ++++++++++++++++++++++++--- test/lisp/emacs-lisp/ert-x-tests.el | 44 ++++++++------- 6 files changed, 204 insertions(+), 67 deletions(-) diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 440c61add8e..af215482f41 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -390,12 +390,37 @@ summary as shown below: emacs -batch -l ert -f ert-summarize-tests-batch-and-exit output.log @end example +@vindex ert-batch-print-level +@vindex ert-batch-print-length +ERT attempts to limit the output size for failed tests by choosing +conservative values for @code{print-level} and @code{print-length} +when printing Lisp values. This can in some cases make it difficult +to see which portions of those values are incorrect. Use +@code{ert-batch-print-level} and @code{ert-batch-print-length} +to customize that: + +@example +emacs -batch -l ert -l my-tests.el \ + --eval "(let ((ert-batch-print-level 10) \ + (ert-batch-print-length 120)) \ + (ert-run-tests-batch-and-exit))" +@end example + +@vindex ert-batch-backtrace-line-length +Even modest settings for @code{print-level} and @code{print-length} can +produce extremely long lines in backtraces, however, with attendant +pauses in execution progress. Set +@code{ert-batch-backtrace-line-length} to t to use the value of +@code{backtrace-line-length}, @code{nil} to stop any limitations on backtrace +line lengths (that is, to get full backtraces), or a positive integer to +limit backtrace line length to that number. + @vindex ert-quiet By default, ERT in batch mode is quite verbose, printing a line with result after each test. This gives you progress information: how many tests have been executed and how many there are. However, in some cases this much output may be undesirable. In this case, set -@code{ert-quiet} variable to a non-nil value: +@code{ert-quiet} variable to a non-@code{nil} value: @example emacs -batch -l ert -l my-tests.el \ diff --git a/etc/NEWS b/etc/NEWS index 68b5cc82b49..92ae8ac6243 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -54,6 +54,13 @@ This is in addition to previously-supported ways of discovering 24-bit color support: either via the "RGB" or "setf24" capabilities, or if the 'COLORTERM' environment variable is set to the value "truecolor". ++++ +** New ERT variables 'ert-batch-print-length' and 'ert-batch-print-level'. +These variables will override 'print-length' and 'print-level' when +printing Lisp values in ERT batch test results. + +** Emacs now supports Unicode Standard version 14.0. + ** Emoji +++ diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index a5721aa3193..a8b484aee0b 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -55,9 +55,9 @@ order to debug the code that does fontification." (defcustom backtrace-line-length 5000 "Target length for lines in Backtrace buffers. Backtrace mode will attempt to abbreviate printing of backtrace -frames to make them shorter than this, but success is not -guaranteed. If set to nil or zero, Backtrace mode will not -abbreviate the forms it prints." +frames by setting `print-level' and `print-length' to make them +shorter than this, but success is not guaranteed. If set to nil +or zero, backtrace mode will not abbreviate the forms it prints." :type 'integer :group 'backtrace :version "27.1") @@ -751,6 +751,13 @@ property for use by navigation." (insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s)) (put-text-property beg (point) 'backtrace-section 'func))) +(defun backtrace--line-length-or-nil () + "Return `backtrace-line-length' if valid, nil else." + ;; mirror the logic in `cl-print-to-string-with-limits' + (and (natnump backtrace-line-length) + (not (zerop backtrace-line-length)) + backtrace-line-length)) + (defun backtrace--print-func-and-args (frame _view) "Print the function, arguments and buffer position of a backtrace FRAME. Format it according to VIEW." @@ -769,11 +776,16 @@ Format it according to VIEW." (if (atom fun) (funcall backtrace-print-function fun) (insert - (backtrace--print-to-string fun (when args (/ backtrace-line-length 2))))) + (backtrace--print-to-string + fun + (when (and args (backtrace--line-length-or-nil)) + (/ backtrace-line-length 2))))) (if args (insert (backtrace--print-to-string - args (max (truncate (/ backtrace-line-length 5)) - (- backtrace-line-length (- (point) beg))))) + args + (if (backtrace--line-length-or-nil) + (max (truncate (/ backtrace-line-length 5)) + (- backtrace-line-length (- (point) beg)))))) ;; The backtrace-form property is so that backtrace-multi-line ;; will find it. backtrace-multi-line doesn't do anything ;; useful with it, just being consistent. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 8ebc81fd418..36b4408dc8e 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -77,6 +77,37 @@ Use nil for no limit (caution: backtrace lines can be very long)." :type '(choice (const :tag "No truncation" nil) integer)) +(defvar ert-batch-print-length 10 + "`print-length' setting used in `ert-run-tests-batch'. + +When formatting lists in test conditions, `print-length' will be +temporarily set to this value. See also +`ert-batch-backtrace-line-length' for its effect on stack +traces.") + +(defvar ert-batch-print-level 5 + "`print-level' setting used in `ert-run-tests-batch'. + +When formatting lists in test conditions, `print-level' will be +temporarily set to this value. See also +`ert-batch-backtrace-line-length' for its effect on stack +traces.") + +(defvar ert-batch-backtrace-line-length t + "Target length for lines in ERT batch backtraces. + +Even modest settings for `print-length' and `print-level' can +produce extremely long lines in backtraces and lengthy delays in +forming them. This variable governs the target maximum line +length by manipulating these two variables while printing stack +traces. Setting this variable to t will re-use the value of +`backtrace-line-length' while print stack traces in ERT batch +mode. A value of nil will short-circuit this mechanism; line +lengths will be completely determined by `ert-batch-line-length' +and `ert-batch-line-level'. Any other value will be temporarily +bound to `backtrace-line-length' when producing stack traces +in batch mode.") + (defface ert-test-result-expected '((((class color) (background light)) :background "green1") (((class color) (background dark)) @@ -1402,8 +1433,7 @@ Returns the stats object." (ert-reason-for-test-result result) "")))) (message "%s" ""))))) - (test-started - ) + (test-started) (test-ended (cl-destructuring-bind (stats test result) event-args (unless (ert-test-result-expected-p test result) @@ -1413,8 +1443,18 @@ Returns the stats object." (ert-test-result-with-condition (message "Test %S backtrace:" (ert-test-name test)) (with-temp-buffer - (insert (backtrace-to-string - (ert-test-result-with-condition-backtrace result))) + (let ((backtrace-line-length + (cond + ((eq ert-batch-backtrace-line-length t) + backtrace-line-length) + ((eq ert-batch-backtrace-line-length nil) + nil) + (t + ert-batch-backtrace-line-length))) + (print-level ert-batch-print-level) + (print-length ert-batch-print-length)) + (insert (backtrace-to-string + (ert-test-result-with-condition-backtrace result)))) (if (not ert-batch-backtrace-right-margin) (message "%s" (buffer-substring-no-properties (point-min) @@ -1433,8 +1473,8 @@ Returns the stats object." (ert--insert-infos result) (insert " ") (let ((print-escape-newlines t) - (print-level 5) - (print-length 10)) + (print-level ert-batch-print-level) + (print-length ert-batch-print-length)) (ert--pp-with-indentation-and-newline (ert-test-result-with-condition-condition result))) (goto-char (1- (point-max))) @@ -1962,13 +2002,13 @@ otherwise." (ewoc-refresh ert--results-ewoc) (font-lock-default-function enabledp)) -(defun ert--setup-results-buffer (stats listener buffer-name) +(defvar ert--output-buffer-name "*ert*") + +(defun ert--setup-results-buffer (stats listener) "Set up a test results buffer. -STATS is the stats object; LISTENER is the results listener; -BUFFER-NAME, if non-nil, is the buffer name to use." - (unless buffer-name (setq buffer-name "*ert*")) - (let ((buffer (get-buffer-create buffer-name))) +STATS is the stats object; LISTENER is the results listener." + (let ((buffer (get-buffer-create ert--output-buffer-name))) (with-current-buffer buffer (let ((inhibit-read-only t)) (buffer-disable-undo) @@ -2000,18 +2040,11 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (defvar ert--selector-history nil "List of recent test selectors read from terminal.") -;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here? -;; They are needed only for our automated self-tests at the moment. -;; Or should there be some other mechanism? ;;;###autoload -(defun ert-run-tests-interactively (selector - &optional output-buffer-name message-fn) +(defun ert-run-tests-interactively (selector) "Run the tests specified by SELECTOR and display the results in a buffer. -SELECTOR works as described in `ert-select-tests'. -OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they -are used for automated self-tests and specify which buffer to use -and how to display message." +SELECTOR works as described in `ert-select-tests'." (interactive (list (let ((default (if ert--selector-history ;; Can't use `first' here as this form is @@ -2024,23 +2057,17 @@ and how to display message." obarray #'ert-test-boundp nil nil 'ert--selector-history default nil))) nil)) - (unless message-fn (setq message-fn 'message)) - (let ((output-buffer-name output-buffer-name) - buffer - listener - (message-fn message-fn)) + (let (buffer listener) (setq listener (lambda (event-type &rest event-args) (cl-ecase event-type (run-started (cl-destructuring-bind (stats) event-args - (setq buffer (ert--setup-results-buffer stats - listener - output-buffer-name)) + (setq buffer (ert--setup-results-buffer stats listener)) (pop-to-buffer buffer))) (run-ended (cl-destructuring-bind (stats abortedp) event-args - (funcall message-fn + (message "%sRan %s tests, %s results were as expected%s%s" (if (not abortedp) "" @@ -2394,7 +2421,7 @@ To be used in the ERT results buffer." (interactive nil ert-results-mode) (cl-assert (eql major-mode 'ert-results-mode)) (let ((selector (ert--stats-selector ert--results-stats))) - (ert-run-tests-interactively selector (buffer-name)))) + (ert-run-tests-interactively selector))) (defun ert-results-rerun-test-at-point () "Re-run the test at point. diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 79576d24032..1a8c9bf4f08 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -39,10 +39,11 @@ (defun ert-self-test () "Run ERT's self-tests and make sure they actually ran." (let ((window-configuration (current-window-configuration))) - (let ((ert--test-body-was-run nil)) + (let ((ert--test-body-was-run nil) + (ert--output-buffer-name " *ert self-tests*")) ;; The buffer name chosen here should not compete with the default ;; results buffer name for completion in `switch-to-buffer'. - (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) + (let ((stats (ert-run-tests-interactively "^ert-"))) (cl-assert ert--test-body-was-run) (if (zerop (ert-stats-completed-unexpected stats)) ;; Hide results window only when everything went well. @@ -519,17 +520,18 @@ This macro is used to test if macroexpansion in `should' works." :body (lambda () (ert-skip "skip message"))))) (let ((ert-debug-on-error nil)) - (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*")) - (messages nil) - (mock-message-fn - (lambda (format-string &rest args) - (push (apply #'format format-string args) messages)))) + (cl-letf* ((buffer-name (generate-new-buffer-name + " *ert-test-run-tests*")) + (ert--output-buffer-name buffer-name) + (messages nil) + ((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) (save-window-excursion (unwind-protect (let ((case-fold-search nil)) (ert-run-tests-interactively - `(member ,passing-test ,failing-test, skipped-test) buffer-name - mock-message-fn) + `(member ,passing-test ,failing-test, skipped-test)) (should (equal messages `(,(concat "Ran 3 tests, 1 results were " "as expected, 1 unexpected, " @@ -551,6 +553,68 @@ This macro is used to test if macroexpansion in `should' works." (when (get-buffer buffer-name) (kill-buffer buffer-name)))))))) +(ert-deftest ert-test-run-tests-batch () + (let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc")))))))) + (long-list (make-list 11 1)) + (failing-test-1 + (make-ert-test :name 'failing-test-1 + :body (lambda () (should (equal complex-list 1))))) + (failing-test-2 + (make-ert-test :name 'failing-test-2 + :body (lambda () (should (equal long-list 1)))))) + (let ((ert-debug-on-error nil) + messages) + (cl-letf* (((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (save-window-excursion + (unwind-protect + (let ((case-fold-search nil) + (ert-batch-backtrace-right-margin nil) + (ert-batch-print-level 10) + (ert-batch-print-length 11)) + (ert-run-tests-batch + `(member ,failing-test-1 ,failing-test-2)))))) + (let ((long-text "(different-types[ \t\n]+(1 1 1 1 1 1 1 1 1 1 1)[ \t\n]+1)))[ \t\n]*$") + (complex-text "(different-types[ \t\n]+((:1[ \t\n]+(:2[ \t\n]+(:3[ \t\n]+(:4[ \t\n]+(:5[ \t\n]+(:6[ \t\n]+\"abc\")))))))[ \t\n]+1)))[ \t\n]*$") + found-long + found-complex) + (cl-loop for msg in (reverse messages) + do + (unless found-long + (setq found-long (string-match long-text msg))) + (unless found-complex + (setq found-complex (string-match complex-text msg)))) + (should found-long) + (should found-complex))))) + +(ert-deftest ert-test-run-tests-batch-expensive () + (let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc")))))))) + (failing-test-1 + (make-ert-test :name 'failing-test-1 + :body (lambda () (should (equal complex-list 1)))))) + (let ((ert-debug-on-error nil) + messages) + (cl-letf* (((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (save-window-excursion + (unwind-protect + (let ((case-fold-search nil) + (ert-batch-backtrace-right-margin nil) + (ert-batch-backtrace-line-length nil) + (ert-batch-print-level 6) + (ert-batch-print-length 11)) + (ert-run-tests-batch + `(member ,failing-test-1)))))) + (let ((frame "ert-fail(((should (equal complex-list 1)) :form (equal ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1) :value nil :explanation (different-types ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1)))") + found-frame) + (cl-loop for msg in (reverse messages) + do + (unless found-frame + (setq found-frame (cl-search frame msg :test 'equal)))) + (should found-frame))))) + (ert-deftest ert-test-special-operator-p () (should (ert--special-operator-p 'if)) (should-not (ert--special-operator-p 'car)) diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 9baa9941586..7106b7abc0c 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -103,23 +103,27 @@ (ert-deftest ert-test-run-tests-interactively-2 () :tags '(:causes-redisplay) - (let* ((passing-test (make-ert-test :name 'passing-test - :body (lambda () (ert-pass)))) - (failing-test (make-ert-test :name 'failing-test - :body (lambda () - (ert-info ((propertize "foo\nbar" - 'a 'b)) - (ert-fail - "failure message"))))) - (skipped-test (make-ert-test :name 'skipped-test - :body (lambda () (ert-skip - "skip message")))) - (ert-debug-on-error nil) - (buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) - (messages nil) - (mock-message-fn - (lambda (format-string &rest args) - (push (apply #'format format-string args) messages)))) + (cl-letf* ((passing-test (make-ert-test + :name 'passing-test + :body (lambda () (ert-pass)))) + (failing-test (make-ert-test + :name 'failing-test + :body (lambda () + (ert-info ((propertize "foo\nbar" + 'a 'b)) + (ert-fail + "failure message"))))) + (skipped-test (make-ert-test + :name 'skipped-test + :body (lambda () (ert-skip + "skip message")))) + (ert-debug-on-error nil) + (messages nil) + (buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) + ((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages))) + (ert--output-buffer-name buffer-name)) (cl-flet ((expected-string (with-font-lock-p) (ert-propertized-string "Selector: (member " @@ -152,14 +156,12 @@ "failing-test" nil "\n Info: " '(a b) "foo\n" nil " " '(a b) "bar" - nil "\n (ert-test-failed \"failure message\")\n\n\n" - ))) + nil "\n (ert-test-failed \"failure message\")\n\n\n"))) (save-window-excursion (unwind-protect (let ((case-fold-search nil)) (ert-run-tests-interactively - `(member ,passing-test ,failing-test ,skipped-test) buffer-name - mock-message-fn) + `(member ,passing-test ,failing-test ,skipped-test)) (should (equal messages `(,(concat "Ran 3 tests, 1 results were " "as expected, 1 unexpected, " From 24a817ccad7e67bd2bb0f23ea572073f36bdc3d9 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Tue, 16 Nov 2021 09:00:24 +0100 Subject: [PATCH 065/367] New X resource to control the border thickness of menus * lwlib/xlwmenu.h (XtNborderThickness, XtCBorderThickness): New X resource name. * lwlib/xlwmenuP.h (XlwMenuPart): New border_thickness field. * lwlib/xlwmenu.c (xlwMenuResources): Access the new resource. (draw_shadow_rectangle): Use the new resource value. * doc/emacs/xresources.texi (Lucid Resources): Document the new resource (bug#51867). --- doc/emacs/xresources.texi | 3 +++ etc/NEWS | 5 +++++ lwlib/xlwmenu.c | 5 ++++- lwlib/xlwmenu.h | 2 ++ lwlib/xlwmenuP.h | 1 + 5 files changed, 15 insertions(+), 1 deletion(-) diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 00fa6c0aa31..0e0070829c1 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -406,6 +406,9 @@ the associated text. Default is 10. @item shadowThickness Thickness of shadow lines for 3D buttons, arrows, and other graphical elements. Default is 1. +@item borderThickness +Thickness of the external borders of the menu bars and pop-up menus. +Default is 1. @end ifnottex @item margin Margin of the menu bar, in characters. Default is 1. diff --git a/etc/NEWS b/etc/NEWS index 92ae8ac6243..ce4c86b0c8b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,6 +46,11 @@ time. * Changes in Emacs 29.1 ++++ +** New X resource: "borderThickness". +This controls the thickness of the external borders of the menu bars +and pop-up menus. + ** Terminal Emacs --- diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index cc73d9aa498..702fad49ba6 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -157,6 +157,9 @@ xlwMenuResources[] = offset(menu.cursor_shape), XtRString, (XtPointer)"right_ptr"}, {XtNhorizontal, XtCHorizontal, XtRInt, sizeof(int), offset(menu.horizontal), XtRImmediate, (XtPointer)True}, + {XtNborderThickness, XtCBorderThickness, XtRDimension, + sizeof (Dimension), offset (menu.border_thickness), + XtRImmediate, (XtPointer)1} }; #undef offset @@ -635,7 +638,7 @@ draw_shadow_rectangle (XlwMenuWidget mw, Display *dpy = XtDisplay (mw); GC top_gc = !erase_p ? mw->menu.shadow_top_gc : mw->menu.background_gc; GC bottom_gc = !erase_p ? mw->menu.shadow_bottom_gc : mw->menu.background_gc; - int thickness = mw->menu.shadow_thickness; + int thickness = !x && !y ? mw->menu.border_thickness : mw->menu.shadow_thickness; XPoint points [4]; if (!erase_p && down_p) diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h index 9143edba9a2..89e548bc8da 100644 --- a/lwlib/xlwmenu.h +++ b/lwlib/xlwmenu.h @@ -56,6 +56,8 @@ along with GNU Emacs. If not, see . */ #define XtCResizeToPreferred "ResizeToPreferred" #define XtNallowResize "allowResize" #define XtCAllowResize "AllowResize" +#define XtNborderThickness "borderThickness" +#define XtCBorderThickness "BorderThickness" /* Motif-compatible resource names */ #define XmNshadowThickness "shadowThickness" diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h index fc77ec4bfd1..bb37b0dee2f 100644 --- a/lwlib/xlwmenuP.h +++ b/lwlib/xlwmenuP.h @@ -75,6 +75,7 @@ typedef struct _XlwMenu_part Dimension vertical_spacing; Dimension arrow_spacing; Dimension shadow_thickness; + Dimension border_thickness; Pixel top_shadow_color; Pixel bottom_shadow_color; Pixmap top_shadow_pixmap; From 1657e0fb177d6a107479306e17ffbb9016a9a40c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 15 Nov 2021 13:12:45 +0800 Subject: [PATCH 066/367] Add command to browse xwidget history * doc/emacs/misc.texi (Embedded WebKit Widgets) * etc/NEWS: Document `xwidget-webkit-browse-history'. * lisp/xwidget.el (xwidget-webkit-mode-map): Bind "H" to xwidget-webkit-browse-history. (xwidget-webkit-import-widget): Set last session buffer correctly. (xwidget-webkit-browse-history): New command. (xwidget-webkit-history--session): New variable. (xwidget-webkit-history--insert-item) (xwidget-webkit-history-select-item) (xwidget-webkit-history-reload): New functions. (xwidget-webkit-history-mode): New major mode. --- doc/emacs/misc.texi | 8 +++++ etc/NEWS | 5 +++ lisp/xwidget.el | 76 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 89 insertions(+) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 3d423d7675b..1f2c852fac1 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -3011,6 +3011,14 @@ the WebKit widget to display the next search result, while typing To leave incremental search, you can type @kbd{C-g}. +@findex xwidget-webkit-browse-history +@cindex history of webkit buffers + The command @code{xwidget-webkit-browse-history} displays a buffer +containing a list of pages previously loaded by the current WebKit +buffer, and lets you navigate to those pages by hitting @kbd{RET}. + +It is bound to @kbd{H}. + @node Browse-URL @subsection Following URLs @cindex World Wide Web diff --git a/etc/NEWS b/etc/NEWS index ce4c86b0c8b..80be6c0e498 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -498,6 +498,11 @@ This mode acts similarly to incremental search, and allows to search the contents of a WebKit widget. In xwidget-webkit mode, it is bound to 'C-s' and 'C-r'. ++++ +*** New command 'xwidget-webkit-browse-history'. +This command displays a buffer containing the page load history of +the current WebKit widget, and allows you to navigate it. + --- *** On X11, the WebKit inspector is now available inside xwidgets. To access the inspector, right click on the widget and select "Inspect diff --git a/lisp/xwidget.el b/lisp/xwidget.el index a587fe85dbc..c1d0cd66a93 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -55,6 +55,7 @@ (declare-function delete-xwidget-view "xwidget.c" (xwidget-view)) (declare-function get-buffer-xwidgets "xwidget.c" (buffer)) (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget)) +(declare-function xwidget-webkit-back-forward-list "xwidget.c" (xwidget &optional limit)) (defgroup xwidget nil "Displaying native widgets in Emacs buffers." @@ -194,6 +195,7 @@ for the actual events that will be sent." (define-key map "e" 'xwidget-webkit-edit-mode) (define-key map "\C-r" 'xwidget-webkit-isearch-mode) (define-key map "\C-s" 'xwidget-webkit-isearch-mode) + (define-key map "H" 'xwidget-webkit-browse-history) ;;similar to image mode bindings (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) @@ -228,6 +230,7 @@ for the actual events that will be sent." ["Back" xwidget-webkit-back t] ["Forward" xwidget-webkit-forward t] ["Reload" xwidget-webkit-reload t] + ["History" xwidget-webkit-browse-history t] ["Insert String" xwidget-webkit-insert-string :active t :help "Insert a string into the currently active field"] @@ -396,6 +399,9 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (when (or (string-equal (nth 3 last-input-event) "load-finished") (> (length title) 0)) + (when-let ((buffer (get-buffer "*Xwidget WebKit History*"))) + (with-current-buffer buffer + (revert-buffer))) (with-current-buffer (xwidget-buffer xwidget) (setq xwidget-webkit--title title) (force-mode-line-update) @@ -775,6 +781,7 @@ Return the buffer." (callback #'xwidget-webkit-callback) (buffer (get-buffer-create bufname))) (with-current-buffer buffer + (setq xwidget-webkit-last-session-buffer buffer) (save-excursion (erase-buffer) (insert ".") @@ -821,6 +828,15 @@ Return the buffer." (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session)))) (message "URL: %s" (kill-new (or url ""))))) +(defun xwidget-webkit-browse-history () + "Display a buffer containing the history of page loads." + (interactive) + (setq xwidget-webkit-last-session-buffer (current-buffer)) + (let ((buffer (get-buffer-create "*Xwidget WebKit History*"))) + (with-current-buffer buffer + (xwidget-webkit-history-mode)) + (display-buffer buffer))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xwidget-webkit-get-selection (proc) "Get the webkit selection and pass it to PROC." @@ -1059,6 +1075,66 @@ Press \\\\[xwidget-webkit-isearch-exit] to exit (concat xwidget-webkit-isearch--string (current-kill 0))) (xwidget-webkit-isearch--update)) + +(defvar-local xwidget-webkit-history--session nil + "The xwidget this history buffer controls.") + +(define-button-type 'xwidget-webkit-history 'action #'xwidget-webkit-history-select-item) + +(defun xwidget-webkit-history--insert-item (item) + "Insert specified ITEM into the current buffer." + (let ((idx (car item)) + (title (cadr item)) + (uri (caddr item))) + (push (list idx (vector (list (number-to-string idx) + :type 'xwidget-webkit-history) + (list title :type 'xwidget-webkit-history) + (list uri :type 'xwidget-webkit-history))) + tabulated-list-entries))) + +(defun xwidget-webkit-history-select-item (pos) + "Navigate to the history item underneath POS." + (interactive "P") + (let ((id (tabulated-list-get-id pos))) + (xwidget-webkit-goto-history xwidget-webkit-history--session id)) + (xwidget-webkit-history-reload)) + +(defun xwidget-webkit-history-reload (&rest ignored) + "Reload the current history buffer." + (interactive) + (setq tabulated-list-entries nil) + (let* ((back-forward-list + (xwidget-webkit-back-forward-list xwidget-webkit-history--session)) + (back-list (car back-forward-list)) + (here (cadr back-forward-list)) + (forward-list (caddr back-forward-list))) + (mapc #'xwidget-webkit-history--insert-item (nreverse forward-list)) + (xwidget-webkit-history--insert-item here) + (mapc #'xwidget-webkit-history--insert-item back-list) + (tabulated-list-print t nil) + (goto-char (point-min)) + (let ((position (line-beginning-position (1+ (length back-list))))) + (goto-char position) + (setq-local overlay-arrow-position (make-marker)) + (set-marker overlay-arrow-position position)))) + +(define-derived-mode xwidget-webkit-history-mode tabulated-list-mode + "Xwidget Webkit History" + "Major mode for browsing the history of an Xwidget Webkit buffer. +Each line describes an entry in history." + (setq truncate-lines t) + (setq buffer-read-only t) + (setq tabulated-list-format [("Index" 10 nil) + ("Title" 50 nil) + ("URL" 100 nil)]) + (setq tabulated-list-entries nil) + (setq xwidget-webkit-history--session (xwidget-webkit-current-session)) + (xwidget-webkit-history-reload) + (setq-local revert-buffer-function #'xwidget-webkit-history-reload) + (tabulated-list-init-header)) + +(define-key xwidget-webkit-history-mode-map (kbd "RET") + #'xwidget-webkit-history-select-item) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar xwidget-view-list) ; xwidget.c From 8d0c19fb0c368692f4b17728c0eaf3e16e0c70f7 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Nov 2021 17:51:07 +0800 Subject: [PATCH 067/367] Lower xwidget views owned by parent when lowering frame * src/xterm.c (x_lower_frame): Lower parent frame's xwidget views as well. * src/xwidget.h (lower_frame_xwidget_views): * src/xwidget.c (lower_frame_xwidget_views): New function. --- src/xterm.c | 7 +++++++ src/xwidget.c | 14 ++++++++++++++ src/xwidget.h | 1 + 3 files changed, 22 insertions(+) diff --git a/src/xterm.c b/src/xterm.c index 5988d3a15fb..816b6dc5a8b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11723,6 +11723,13 @@ x_lower_frame (struct frame *f) XFlush (FRAME_X_DISPLAY (f)); unblock_input (); } +#ifdef HAVE_XWIDGETS + /* Make sure any X windows owned by xwidget views of the parent + still display below the lowered frame. */ + + if (FRAME_PARENT_FRAME (f)) + lower_frame_xwidget_views (FRAME_PARENT_FRAME (f)); +#endif } static void diff --git a/src/xwidget.c b/src/xwidget.c index 008eb07bcae..650572a8896 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2810,6 +2810,20 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) } #ifdef USE_GTK +void +lower_frame_xwidget_views (struct frame *f) +{ + struct xwidget_view *xv; + + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); + tail = XCDR (tail)) + { + xv = XXWIDGET_VIEW (XCAR (tail)); + if (xv->frame == f && xv->wdesc != None) + XLowerWindow (xv->dpy, xv->wdesc); + } +} + void kill_frame_xwidget_views (struct frame *f) { diff --git a/src/xwidget.h b/src/xwidget.h index df55dacffef..2f6d0442e20 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -188,6 +188,7 @@ extern struct xwidget *xwidget_from_id (uint32_t id); #ifdef HAVE_X_WINDOWS struct xwidget_view *xwidget_view_from_window (Window wdesc); void xwidget_expose (struct xwidget_view *xv); +extern void lower_frame_xwidget_views (struct frame *f); extern void kill_frame_xwidget_views (struct frame *f); extern void xwidget_button (struct xwidget_view *, bool, int, int, int, int, Time); From ee2a5784561431b9bf23efa752523cca9e229e9f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Nov 2021 14:10:50 +0100 Subject: [PATCH 068/367] Fix compilation error in previous keymap.c change * src/keymap.c (initial_define_lispy_key, define_as_prefix): Fix --enable-checking error. --- src/keymap.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/keymap.c b/src/keymap.c index 7993e31ac6d..0b882958b94 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -132,7 +132,7 @@ void initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname) { store_in_keymap (keymap, intern_c_string (keyname), - intern_c_string (defname), Qnil); + intern_c_string (defname), false); } DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, @@ -1441,7 +1441,7 @@ static Lisp_Object define_as_prefix (Lisp_Object keymap, Lisp_Object c) { Lisp_Object cmd = Fmake_sparse_keymap (Qnil); - store_in_keymap (keymap, c, cmd, Qnil); + store_in_keymap (keymap, c, cmd, false); return cmd; } From 6e93cb0954285b16054d07e420cf3bdc5d93c1c2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 16 Nov 2021 15:04:27 +0100 Subject: [PATCH 069/367] Some minor Tramp updates * lisp/net/tramp-crypt.el (tramp-crypt-add-directory): Add comment. * lisp/net/tramp.el (tramp-debug-buffer-command-completion-p) (tramp-setup-debug-buffer): New defuns. (tramp-get-debug-buffer): Call `tramp-setup-debug-buffer. * test/lisp/net/tramp-tests.el (tramp-test07-abbreviate-file-name): Extend test. --- lisp/net/tramp-crypt.el | 1 + lisp/net/tramp.el | 66 ++++++++++++++++++++++++------------ test/lisp/net/tramp-tests.el | 11 +++++- 3 files changed, 56 insertions(+), 22 deletions(-) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index f60841cf8c1..4ff8e6bbf12 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -486,6 +486,7 @@ See `tramp-crypt-do-encrypt-or-decrypt-file'." Files in that directory and all subdirectories will be encrypted before copying to, and decrypted after copying from that directory. File names will be also encrypted." + ;; (declare (completion tramp-crypt-command-completion-p)) (interactive "DRemote directory name: ") (unless tramp-crypt-enabled (tramp-user-error nil "Feature is not enabled.")) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 26425199bfa..7927ddd1072 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1904,31 +1904,55 @@ The outline level is equal to the verbosity of the Tramp message." (put #'tramp-debug-outline-level 'tramp-suppress-trace t) +;; This function takes action since Emacs 28.1, when +;; `read-extended-command-predicate' is set to +;; `command-completion-default-include-p'. +(defun tramp-debug-buffer-command-completion-p (_symbol buffer) + "A predicate for Tramp interactive commands. +They are completed by \"M-x TAB\" only in Tramp debug buffers." + (with-current-buffer buffer + (string-equal (buffer-substring 1 10) ";; Emacs:"))) + +(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t) + +(defun tramp-setup-debug-buffer () + "Function to setup debug buffers." + ;; (declare (completion tramp-debug-buffer-command-completion-p)) + (interactive) + (set-buffer-file-coding-system 'utf-8) + (setq buffer-undo-list t) + ;; Activate `outline-mode'. This runs `text-mode-hook' and + ;; `outline-mode-hook'. We must prevent that local processes die. + ;; Yes: I've seen `flyspell-mode', which starts "ispell". + ;; `(custom-declare-variable outline-minor-mode-prefix ...)' raises + ;; on error in `(outline-mode)', we don't want to see it in the + ;; traces. + (let ((default-directory tramp-compat-temporary-file-directory)) + (outline-mode)) + (setq-local outline-level 'tramp-debug-outline-level) + (setq-local font-lock-keywords + ;; FIXME: This `(t FOO . BAR)' representation in + ;; `font-lock-keywords' is supposed to be an internal + ;; implementation "detail". Don't abuse it here! + `(t (eval ,tramp-debug-font-lock-keywords t) + ,(eval tramp-debug-font-lock-keywords t))) + ;; Do not edit the debug buffer. + (use-local-map special-mode-map) + ;; For debugging purposes. + (local-set-key "\M-n" 'clone-buffer) + (add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local)) + +(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t) + +(function-put + #'tramp-setup-debug-buffer 'completion-predicate + #'tramp-debug-buffer-command-completion-p) + (defun tramp-get-debug-buffer (vec) "Get the debug buffer for VEC." (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec)) (when (bobp) - (set-buffer-file-coding-system 'utf-8) - (setq buffer-undo-list t) - ;; Activate `outline-mode'. This runs `text-mode-hook' and - ;; `outline-mode-hook'. We must prevent that local processes - ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". - ;; `(custom-declare-variable outline-minor-mode-prefix ...)' - ;; raises on error in `(outline-mode)', we don't want to see it - ;; in the traces. - (let ((default-directory tramp-compat-temporary-file-directory)) - (outline-mode)) - (setq-local outline-level 'tramp-debug-outline-level) - (setq-local font-lock-keywords - ;; FIXME: This `(t FOO . BAR)' representation in - ;; `font-lock-keywords' is supposed to be an - ;; internal implementation "detail". Don't abuse it here! - `(t (eval ,tramp-debug-font-lock-keywords t) - ,(eval tramp-debug-font-lock-keywords t))) - ;; Do not edit the debug buffer. - (use-local-map special-mode-map) - ;; For debugging purposes. - (define-key (current-local-map) "\M-n" 'clone-buffer)) + (tramp-setup-debug-buffer)) (current-buffer))) (put #'tramp-get-debug-buffer 'tramp-suppress-trace t) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 150ea29838c..482d3ff554f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2314,7 +2314,16 @@ This checks also `file-name-as-directory', `file-name-directory', (concat remote-host "~/f/bar"))) (should (equal (abbreviate-file-name (concat remote-host "/nowhere/special")) - (concat remote-host "/nw/special")))))) + (concat remote-host "/nw/special")))) + + ;; Check that home-dir abbreviation doesn't occur when home-dir is just "/". + (setq home-dir (concat remote-host "/")) + ;; The remote home directory is kept in the connection property + ;; "home-directory". We fake this setting. + (tramp-set-connection-property tramp-test-vec "home-directory" home-dir) + (should (equal (concat home-dir "foo/bar") + (abbreviate-file-name (concat home-dir "foo/bar")))) + (tramp-flush-connection-property tramp-test-vec "home-directory"))) (ert-deftest tramp-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." From 9e2f59132dd0df8338dc315621fa23341857f07c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 16 Nov 2021 16:17:10 +0200 Subject: [PATCH 070/367] Minor copyedits of recent documentation changes * doc/lispref/keymaps.texi (Low-Level Key Binding): Minor changes in wording and markup. --- doc/lispref/keymaps.texi | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 86faba26190..38e688ab61f 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1575,13 +1575,14 @@ Modes}); then its keymap will automatically inherit from @node Low-Level Key Binding @section Low-Level Key Binding +@cindex low-level key bindings Historically, Emacs has supported a number of different syntaxes for defining keys. The documented way to bind a key today is to use the syntax supported by @code{key-valid-p}, which is what all the functions like @code{keymap-set} and @code{keymap-lookup} supports. -This section of the manual documents the old syntax and interface -functions, and should not be used in new code. +This section documents the old-style syntax and interface functions; +they should not be used in new code. @cindex meta character key constants @cindex control character key constants @@ -1595,20 +1596,21 @@ character or function key name). For example, @code{[(control ?a) (meta b)]} is equivalent to @kbd{C-a M-b} and @code{[(hyper control left)]} is equivalent to @kbd{C-H-left}. -@item A string with control and meta characters. +@item A string of characters with modifiers Internally, key sequences are often represented as strings using the -special escape sequences for control and meta characters +special escape sequences for shift, control and meta modifiers (@pxref{String Type}), but this representation can also be used by users when rebinding keys. A string like @code{"\M-x"} is read as containing a single @kbd{M-x}, @code{"\C-f"} is read as containing a single @kbd{C-f}, and @code{"\M-\C-x"} and @code{"\C-\M-x"} are both read as containing a single @kbd{C-M-x}. -@item a vector of characters. -This is the other internal representation of key sequences, and -supports a fuller range of modifiers than the string representation. -One example is @samp{[?\C-\H-x home]}, which represents the @kbd{C-H-x -home} key sequence. @xref{Character Type}. +@item A vector of characters and key symbols +This is the other internal representation of key sequences. It +supports a fuller range of modifiers than the string representation, +and also support function keys. An example is @w{@samp{[?\C-\H-x +home]}}, which represents the @w{@kbd{C-H-x @key{home}}} key sequence. +@xref{Character Type}. @end table @defun define-key keymap key binding &optional remove From 4f47f10d9f8f3864fd37685b290e4ca5d339ba35 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 16 Nov 2021 19:14:04 +0200 Subject: [PATCH 071/367] Put back documentation of legacy keymap functions * doc/lispref/keymaps.texi (Low-Level Key Binding): Reinstate documentation of legacy commands and functions. --- doc/lispref/keymaps.texi | 124 +++++++++++++++++++++++++++------------ 1 file changed, 88 insertions(+), 36 deletions(-) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 38e688ab61f..d893e22b8b9 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1626,53 +1626,105 @@ return the binding in the parent, and with a nil @var{def}, the lookups will return @code{nil}. @end defun -There's a number of other legacy key definition functions. Below is a -list of them, with the equivalent modern function to use instead. +Here are other legacy key definition functions and commands, with the +equivalent modern function to use instead in new code. -@table @code -@findex global-set-key -@item global-set-key -Use @code{keymap-global-set} instead. +@deffn Command global-set-key key binding +This function sets the binding of @var{key} in the current global map +to @var{binding}. Use @code{keymap-global-set} instead. +@end deffn -@findex local-set-key -@item local-set-key -Use @code{keymap-local-set} instead. +@deffn Command global-unset-key key +This function removes the binding of @var{key} from the current +global map. Use @code{keymap-global-unset} instead. +@end deffn -@findex global-unset-key -@item global-unset-key -Use @code{keymap-global-unset} instead. +@deffn Command local-set-key key binding +This function sets the binding of @var{key} in the current local +keymap to @var{binding}. Use @code{keymap-local-set} instead. +@end deffn -@findex local-unset-key -@item local-unset-key -Use @code{keymap-local-unset} instead. +@deffn Command local-unset-key key +This function removes the binding of @var{key} from the current +local map. Use @code{keymap-local-unset} instead. +@end deffn -@findex substitute-key-definition -@item substitute-key-definition -Use @code{keymap-substitute} instead. +@defun substitute-key-definition olddef newdef keymap &optional oldmap +This function replaces @var{olddef} with @var{newdef} for any keys in +@var{keymap} that were bound to @var{olddef}. In other words, +@var{olddef} is replaced with @var{newdef} wherever it appears. The +function returns @code{nil}. Use @code{keymap-substitute} instead. +@end defun -@findex define-key-after -@item define-key-after -Use @code{keymap-set-after} instead. +@defun define-key-after map key binding &optional after +Define a binding in @var{map} for @var{key}, with value @var{binding}, +just like @code{define-key}, but position the binding in @var{map} after +the binding for the event @var{after}. The argument @var{key} should be +of length one---a vector or string with just one element. But +@var{after} should be a single event type---a symbol or a character, not +a sequence. The new binding goes after the binding for @var{after}. If +@var{after} is @code{t} or is omitted, then the new binding goes last, at +the end of the keymap. However, new bindings are added before any +inherited keymap. Use @code{keymap-set-after} instead of this function. +@end defun -@findex keyboard-translate -@item keyboard-translate -Use @code{key-translate} instead. +@defun keyboard-translate from to +This function modifies @code{keyboard-translate-table} to translate +character code @var{from} into character code @var{to}. It creates +the keyboard translate table if necessary. Use @code{key-translate} +instead. +@end defun -@findex lookup-keymap -@findex key-binding -@item lookup-keymap -@itemx key-binding -Use @code{keymap-lookup} instead. +@defun key-binding key &optional accept-defaults no-remap position +This function returns the binding for @var{key} according to the +current active keymaps. The result is @code{nil} if @var{key} is +undefined in the keymaps. The argument @var{accept-defaults} controls +checking for default bindings, as in @code{lookup-key} +(@pxref{Functions for Key Lookup}). If @var{no-remap} is +non-@code{nil}, @code{key-binding} ignores command remappings +(@pxref{Remapping Commands}) and returns the binding directly +specified for @var{key}. The optional argument @var{position} should +be either a buffer position or an event position like the value of +@code{event-start}; it tells the function to consult the maps +determined based on that @var{position}. -@findex local-key-binding -@item local-key-binding -Use @code{keymap-local-lookup} instead. +Emacs signals an error if @var{key} is not a string or a vector. -@findex global-key-binding -@item gobal-key-binding -Use @code{keymap-global-lookup} instead. -@end table +Use @code{keymap-lookup} instead of this function. +@end defun +@defun lookup-key keymap key &optional accept-defaults +This function returns the definition of @var{key} in @var{keymap}. If +the string or vector @var{key} is not a valid key sequence according +to the prefix keys specified in @var{keymap}, it must be too long and +have extra events at the end that do not fit into a single key +sequence. Then the value is a number, the number of events at the +front of @var{key} that compose a complete key. + +If @var{accept-defaults} is non-@code{nil}, then @code{lookup-key} +considers default bindings as well as bindings for the specific events +in @var{key}. Otherwise, @code{lookup-key} reports only bindings for +the specific sequence @var{key}, ignoring default bindings except when +you explicitly ask about them. + +Use @code{keymap-lookup} instead of this function. +@end defun + +@defun local-key-binding key &optional accept-defaults +This function returns the binding for @var{key} in the current +local keymap, or @code{nil} if it is undefined there. + +The argument @var{accept-defaults} controls checking for default bindings, +as in @code{lookup-key} (above). +@end defun + +@defun global-key-binding key &optional accept-defaults +This function returns the binding for command @var{key} in the +current global keymap, or @code{nil} if it is undefined there. + +The argument @var{accept-defaults} controls checking for default bindings, +as in @code{lookup-key} (above). +@end defun @node Remapping Commands @section Remapping Commands From 97c23204b981d5ad88ea3c8ddff0f726798aff1b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Nov 2021 19:41:56 +0100 Subject: [PATCH 072/367] Make keymap-unset work * lisp/keymap.el (keymap-unset): Fix key syntax (bug#51897). --- lisp/keymap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/keymap.el b/lisp/keymap.el index 8938197ecf0..b634487ba61 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -119,7 +119,7 @@ a key in a child map, it will still shadow the same key in the parent keymap. Removing the binding will allow the key in the parent keymap to be used." (keymap--check key) - (define-key keymap key nil remove)) + (define-key keymap (key-parse key) nil remove)) (defun keymap-substitute (olddef newdef keymap &optional oldmap prefix) "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. From 38d905abf9eecbb1eef33c1d7df184f2f6faeeb3 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 Nov 2021 22:40:45 +0200 Subject: [PATCH 073/367] * lisp/tab-bar.el: Doc fixes for commands bound to modifier keys. (tab-bar-select-tab-modifiers) (tab-bar-select-tab, tab-bar-switch-to-last-tab): Doc fixes. --- lisp/tab-bar.el | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 10f26875db5..9fba70f34da 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -91,9 +91,10 @@ (defcustom tab-bar-select-tab-modifiers '() "List of modifier keys for selecting tab-bar tabs by their numbers. Possible modifier keys are `control', `meta', `shift', `hyper', `super' and -`alt'. Pressing one of the modifiers in the list and a digit selects -the tab whose number equals the digit. Negative numbers count from -the end of the tab bar. The digit 9 selects the last (rightmost) tab. +`alt'. Pressing one of the modifiers in the list and a digit selects the +tab whose number equals the digit (see `tab-bar-select-tab'). +The digit 9 selects the last (rightmost) tab (see `tab-last'). +The digit 0 selects the most recently visited tab (see `tab-recent'). For easier selection of tabs by their numbers, consider customizing `tab-bar-tab-hints', which will show tab numbers alongside the tab name." :type '(set :tag "Tab selection modifier keys" @@ -1060,11 +1061,14 @@ inherits the current tab's `explicit-name' parameter." (defun tab-bar-select-tab (&optional tab-number) "Switch to the tab by its absolute position TAB-NUMBER in the tab bar. -When this command is bound to a numeric key (with a prefix or modifier key +When this command is bound to a numeric key (with a key prefix or modifier key using `tab-bar-select-tab-modifiers'), calling it without an argument will translate its bound numeric key to the numeric argument. -TAB-NUMBER counts from 1. Negative TAB-NUMBER counts tabs from the end of -the tab bar." +Also the prefix argument TAB-NUMBER can be used to override +the numeric key, so it takes precedence over the bound digit key. +For example, `-2' will select the second tab, but `C-u 15 +-2' will select the 15th tab. TAB-NUMBER counts from 1. +Negative TAB-NUMBER counts tabs from the end of the tab bar." (interactive "P") (unless (integerp tab-number) (let ((key (event-basic-type last-command-event))) @@ -1161,7 +1165,8 @@ Interactively, ARG is the prefix numeric argument and defaults to 1." (defun tab-bar-switch-to-last-tab (&optional arg) "Switch to the last tab or ARGth tab from the end of the tab bar. Interactively, ARG is the prefix numeric argument; it defaults to 1, -which means the last tab on the tab bar." +which means the last tab on the tab bar. For example, `C-u 2 +-9' selects the tab before the last tab." (interactive "p") (tab-bar-select-tab (- (length (funcall tab-bar-tabs-function)) (1- (or arg 1))))) From c25be3e7bb91f932a1d620bef08e16872dcf04d5 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 Nov 2021 22:45:33 +0200 Subject: [PATCH 074/367] * lisp/tab-bar.el (tab-bar-select-tab): Add check for wc-frame (bug#51883). --- lisp/tab-bar.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 9fba70f34da..871ed1c9817 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1096,7 +1096,11 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." ;; its value of window-configuration is unreadable, ;; so restore its saved window-state. (cond - ((window-configuration-p wc) + ((and (window-configuration-p wc) + ;; Check for such cases as cloning a frame with tabs. + ;; When tabs were cloned to another frame, then fall back + ;; to using `window-state-put' below. + (eq (window-configuration-frame wc) (selected-frame))) (let ((wc-point (alist-get 'wc-point to-tab)) (wc-bl (seq-filter #'buffer-live-p (alist-get 'wc-bl to-tab))) (wc-bbl (seq-filter #'buffer-live-p (alist-get 'wc-bbl to-tab))) From 058c012f73d4abe014ace44b46c23babd48aebbc Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sun, 14 Nov 2021 15:09:43 +0000 Subject: [PATCH 075/367] Only set LANG if the ID is valid * src/nsterm.m (ns_init_locale): Check the provided locale identifier is available before trying to use it. --- src/nsterm.m | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index 1f17a30272c..e29dda684a0 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -535,8 +535,11 @@ - (NSColor *)colorUsingDefaultColorSpace NSTRACE ("ns_init_locale"); - @try + /* If we were run from a terminal then assume an unset LANG variable + is intentional and don't try to "fix" it. */ + if (!isatty (STDIN_FILENO)) { + char *oldLocale = setlocale (LC_ALL, NULL); /* It seems macOS should probably use UTF-8 everywhere. 'localeIdentifier' does not specify the encoding, and I can't find any way to get the OS to tell us which encoding to use, @@ -544,12 +547,12 @@ - (NSColor *)colorUsingDefaultColorSpace NSString *localeID = [NSString stringWithFormat:@"%@.UTF-8", [locale localeIdentifier]]; - /* Set LANG to locale, but not if LANG is already set. */ - setenv("LANG", [localeID UTF8String], 0); - } - @catch (NSException *e) - { - NSLog (@"Locale detection failed: %@: %@", [e name], [e reason]); + /* Check the locale ID is valid and if so set LANG, but not if + it is already set. */ + if (setlocale (LC_ALL, [localeID UTF8String])) + setenv("LANG", [localeID UTF8String], 0); + + setlocale (LC_ALL, oldLocale); } } From 2a99138f1766c23cfdbbc86ea5c277b0fbeed7e2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 17 Nov 2021 09:10:10 +0800 Subject: [PATCH 076/367] Update xwidget webkit history buffer more eagerly * lisp/xwidget.el (xwidget-webkit-callback): Update history buffer on each load-changed event. --- lisp/xwidget.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index c1d0cd66a93..37cf2e5816a 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -393,15 +393,15 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (cond ((eq xwidget-event-type 'load-changed) (let ((title (xwidget-webkit-title xwidget)) (uri (xwidget-webkit-uri xwidget))) + (when-let ((buffer (get-buffer "*Xwidget WebKit History*"))) + (with-current-buffer buffer + (revert-buffer))) ;; This funciton will be called multi times, so only ;; change buffer name when the load actually completes ;; this can limit buffer-name flicker in mode-line. (when (or (string-equal (nth 3 last-input-event) "load-finished") (> (length title) 0)) - (when-let ((buffer (get-buffer "*Xwidget WebKit History*"))) - (with-current-buffer buffer - (revert-buffer))) (with-current-buffer (xwidget-buffer xwidget) (setq xwidget-webkit--title title) (force-mode-line-update) From 4c467e4aff12e65fa4fa62d7f4bdcbf4a2bcd92c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 04:14:33 +0100 Subject: [PATCH 077/367] * admin/gitmerge.el (gitmerge-mode-map): Convert to defvar-keymap. --- admin/gitmerge.el | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 67fca87c119..5aae6b40a0c 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -96,16 +96,13 @@ If nil, the function `gitmerge-default-branch' guesses.") (defvar gitmerge-log-regexp "^\\([A-Z ]\\)\\s-*\\([0-9a-f]+\\) \\(.+?\\): \\(.*\\)$") -(defvar gitmerge-mode-map - (let ((map (make-keymap))) - (define-key map [(l)] 'gitmerge-show-log) - (define-key map [(d)] 'gitmerge-show-diff) - (define-key map [(f)] 'gitmerge-show-files) - (define-key map [(s)] 'gitmerge-toggle-skip) - (define-key map [(m)] 'gitmerge-start-merge) - map) - "Keymap for gitmerge major mode.") - +(defvar-keymap gitmerge-mode-map + :doc "Keymap for gitmerge major mode." + "l" #'gitmerge-show-log + "d" #'gitmerge-show-diff + "f" #'gitmerge-show-files + "s" #'gitmerge-toggle-skip + "m" #'gitmerge-start-merge) (defvar gitmerge-mode-font-lock-keywords `((,gitmerge-log-regexp From fa0b34b716ba31a6414d12de67c8f30706caad96 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 04:44:38 +0100 Subject: [PATCH 078/367] * admin/authors.el (authors-ignored-files): Ignore some NEWS files. --- admin/authors.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/admin/authors.el b/admin/authors.el index fd46dabaa3a..23990fee708 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -323,7 +323,8 @@ Changes to files matching one of the regexps in this list are not listed.") "NEWS.unicode" "COPYING.DJ" "Makefile.old" "Makefile.am" "NEWS.1" "OOOOONEWS...OONEWS" "OOOONEWS" "etc/NEWS" "NEWS.1-17" "NEWS.18" "NEWS.19" "NEWS.20" "NEWS.21" "NEWS.22" - "MAINTAINERS" "MH-E-NEWS" + "NEWS.23" "NEWS.24" "NEWS.25" "NEWS.26" "NEWS.27" "NEWS.28" + "MAINTAINERS" "ERC-NEWS" "MH-E-NEWS" "NXML-NEWS" "install.sh" "install-sh" "missing" "mkinstalldirs" "termcap.dat" "termcap.src" "termcap.ucb" "termcap" "ChangeLog.nextstep" "Emacs.clr" "spec.txt" From 1a4f210c246688519f85db72bdc3bea536cb5dbe Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 16 Nov 2021 22:48:37 -0500 Subject: [PATCH 079/367] * lisp/rot13.el (rot13-translate-table): Make it a `translation-table` (rot13-display-table): Use `dotimes`. --- lisp/rot13.el | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) diff --git a/lisp/rot13.el b/lisp/rot13.el index 4e4e60fea3f..e509b22529f 100644 --- a/lisp/rot13.el +++ b/lisp/rot13.el @@ -46,29 +46,23 @@ ;;; Code: -(defvar rot13-display-table - (let ((table (make-display-table)) - (i 0)) - (while (< i 26) +(defconst rot13-display-table + (let ((table (make-display-table))) + (dotimes (i 26) (aset table (+ i ?a) (vector (+ (% (+ i 13) 26) ?a))) - (aset table (+ i ?A) (vector (+ (% (+ i 13) 26) ?A))) - (setq i (1+ i))) + (aset table (+ i ?A) (vector (+ (% (+ i 13) 26) ?A)))) table) "Char table for ROT13 display.") -(defvar rot13-translate-table - (let ((str (make-string 127 0)) - (i 0)) - (while (< i 127) - (aset str i i) - (setq i (1+ i))) - (setq i 0) - (while (< i 26) - (aset str (+ i ?a) (+ (% (+ i 13) 26) ?a)) - (aset str (+ i ?A) (+ (% (+ i 13) 26) ?A)) - (setq i (1+ i))) - str) - "String table for ROT13 translation.") +(put 'plain-char-table 'char-table-extra-slots 0) + +(defconst rot13-translate-table + (let ((table (make-char-table 'translation-table))) + (dotimes (i 26) + (aset table (+ i ?a) (+ (% (+ i 13) 26) ?a)) + (aset table (+ i ?A) (+ (% (+ i 13) 26) ?A))) + table) + "Char table for ROT13 translation.") ;;;###autoload (defun rot13 (object &optional start end) From 0fd79ee039de664bc06b0dbcaee786f88a2b079c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 05:49:05 +0100 Subject: [PATCH 080/367] Convert keymaps in bookmark.el to defvar-keymap * lisp/bookmark.el (bookmark-map) (bookmark-minibuffer-read-name-map) (bookmark-edit-annotation-mode-map, bookmark-bmenu-mode-map): Convert to defvar-keymap. --- lisp/bookmark.el | 133 ++++++++++++++++++++++------------------------- 1 file changed, 62 insertions(+), 71 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 58fd0021f54..5176d7aa8d2 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -214,31 +214,28 @@ A non-nil value may result in truncated bookmark names." ;;;###autoload (define-key ctl-x-r-map "l" 'bookmark-bmenu-list) ;;;###autoload -(defvar bookmark-map - (let ((map (make-sparse-keymap))) - ;; Read the help on all of these functions for details... - (define-key map "x" 'bookmark-set) - (define-key map "m" 'bookmark-set) ;"m"ark - (define-key map "M" 'bookmark-set-no-overwrite) ;"M"aybe mark - (define-key map "j" 'bookmark-jump) - (define-key map "g" 'bookmark-jump) ;"g"o - (define-key map "o" 'bookmark-jump-other-window) - (define-key map "5" 'bookmark-jump-other-frame) - (define-key map "i" 'bookmark-insert) - (define-key map "e" 'edit-bookmarks) - (define-key map "f" 'bookmark-insert-location) ;"f"ind - (define-key map "r" 'bookmark-rename) - (define-key map "d" 'bookmark-delete) - (define-key map "D" 'bookmark-delete-all) - (define-key map "l" 'bookmark-load) - (define-key map "w" 'bookmark-write) - (define-key map "s" 'bookmark-save) - map) - "Keymap containing bindings to bookmark functions. +(defvar-keymap bookmark-map + :doc "Keymap containing bindings to bookmark functions. It is not bound to any key by default: to bind it so that you have a bookmark prefix, just use `global-set-key' and bind a key of your choice to variable `bookmark-map'. All interactive bookmark -functions have a binding in this keymap.") +functions have a binding in this keymap." + "x" #'bookmark-set + "m" #'bookmark-set ;"m"ark + "M" #'bookmark-set-no-overwrite ;"M"aybe mark + "j" #'bookmark-jump + "g" #'bookmark-jump ;"g"o + "o" #'bookmark-jump-other-window + "5" #'bookmark-jump-other-frame + "i" #'bookmark-insert + "e" #'edit-bookmarks + "f" #'bookmark-insert-location ;"f"ind + "r" #'bookmark-rename + "d" #'bookmark-delete + "D" #'bookmark-delete-all + "l" #'bookmark-load + "w" #'bookmark-write + "s" #'bookmark-save) ;;;###autoload (fset 'bookmark-map bookmark-map) @@ -813,11 +810,9 @@ CODING is the symbol of the coding-system in which the file is encoded." (define-obsolete-function-alias 'bookmark-maybe-message 'message "27.1") -(defvar bookmark-minibuffer-read-name-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map "\C-w" 'bookmark-yank-word) - map)) +(defvar-keymap bookmark-minibuffer-read-name-map + :parent minibuffer-local-map + ["C-w"] #'bookmark-yank-word) (defun bookmark-set-internal (prompt name overwrite-or-push) "Set a bookmark using specified NAME or prompting with PROMPT. @@ -992,12 +987,10 @@ annotations." "Function to return default text to use for a bookmark annotation. It takes one argument, the name of the bookmark, as a string.") -(defvar bookmark-edit-annotation-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map text-mode-map) - (define-key map "\C-c\C-c" 'bookmark-send-edited-annotation) - map) - "Keymap for editing an annotation of a bookmark.") +(defvar-keymap bookmark-edit-annotation-mode-map + :doc "Keymap for editing an annotation of a bookmark." + :parent text-mode-map + ["C-c C-c"] #'bookmark-send-edited-annotation) (defun bookmark-insert-annotation (bookmark-name-or-record) "Insert annotation for BOOKMARK-NAME-OR-RECORD at point." @@ -1700,44 +1693,42 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (defvar bookmark-bmenu-hidden-bookmarks ()) - -(defvar bookmark-bmenu-mode-map - (let ((map (make-keymap))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map "v" 'bookmark-bmenu-select) - (define-key map "w" 'bookmark-bmenu-locate) - (define-key map "5" 'bookmark-bmenu-other-frame) - (define-key map "2" 'bookmark-bmenu-2-window) - (define-key map "1" 'bookmark-bmenu-1-window) - (define-key map "j" 'bookmark-bmenu-this-window) - (define-key map "\C-c\C-c" 'bookmark-bmenu-this-window) - (define-key map "f" 'bookmark-bmenu-this-window) - (define-key map "\C-m" 'bookmark-bmenu-this-window) - (define-key map "o" 'bookmark-bmenu-other-window) - (define-key map "\C-o" 'bookmark-bmenu-switch-other-window) - (define-key map "s" 'bookmark-bmenu-save) - (define-key map "\C-x\C-s" 'bookmark-bmenu-save) - (define-key map "k" 'bookmark-bmenu-delete) - (define-key map "\C-d" 'bookmark-bmenu-delete-backwards) - (define-key map "x" 'bookmark-bmenu-execute-deletions) - (define-key map "d" 'bookmark-bmenu-delete) - (define-key map "D" 'bookmark-bmenu-delete-all) - (define-key map " " 'next-line) - (define-key map "\177" 'bookmark-bmenu-backup-unmark) - (define-key map "u" 'bookmark-bmenu-unmark) - (define-key map "U" 'bookmark-bmenu-unmark-all) - (define-key map "m" 'bookmark-bmenu-mark) - (define-key map "M" 'bookmark-bmenu-mark-all) - (define-key map "l" 'bookmark-bmenu-load) - (define-key map "r" 'bookmark-bmenu-rename) - (define-key map "R" 'bookmark-bmenu-relocate) - (define-key map "t" 'bookmark-bmenu-toggle-filenames) - (define-key map "a" 'bookmark-bmenu-show-annotation) - (define-key map "A" 'bookmark-bmenu-show-all-annotations) - (define-key map "e" 'bookmark-bmenu-edit-annotation) - (define-key map "/" 'bookmark-bmenu-search) - (define-key map [mouse-2] 'bookmark-bmenu-other-window-with-mouse) - map)) +(defvar-keymap bookmark-bmenu-mode-map + :doc "Keymap for `bookmark-bmenu-mode'." + :parent tabulated-list-mode-map + "v" #'bookmark-bmenu-select + "w" #'bookmark-bmenu-locate + "5" #'bookmark-bmenu-other-frame + "2" #'bookmark-bmenu-2-window + "1" #'bookmark-bmenu-1-window + "j" #'bookmark-bmenu-this-window + ["C-c C-c"] #'bookmark-bmenu-this-window + "f" #'bookmark-bmenu-this-window + ["C-m"] #'bookmark-bmenu-this-window + "o" #'bookmark-bmenu-other-window + ["C-o"] #'bookmark-bmenu-switch-other-window + "s" #'bookmark-bmenu-save + ["C-x C-s"] #'bookmark-bmenu-save + "k" #'bookmark-bmenu-delete + ["C-d"] #'bookmark-bmenu-delete-backwards + "x" #'bookmark-bmenu-execute-deletions + "d" #'bookmark-bmenu-delete + "D" #'bookmark-bmenu-delete-all + [? ] #'next-line + "\177" #'bookmark-bmenu-backup-unmark + "u" #'bookmark-bmenu-unmark + "U" #'bookmark-bmenu-unmark-all + "m" #'bookmark-bmenu-mark + "M" #'bookmark-bmenu-mark-all + "l" #'bookmark-bmenu-load + "r" #'bookmark-bmenu-rename + "R" #'bookmark-bmenu-relocate + "t" #'bookmark-bmenu-toggle-filenames + "a" #'bookmark-bmenu-show-annotation + "A" #'bookmark-bmenu-show-all-annotations + "e" #'bookmark-bmenu-edit-annotation + "/" #'bookmark-bmenu-search + [mouse-2] #'bookmark-bmenu-other-window-with-mouse) (easy-menu-define bookmark-menu bookmark-bmenu-mode-map "Menu for `bookmark-bmenu'." From 3be2a6b8b4098e5cf118d196e4cba37054d8292b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 06:05:12 +0100 Subject: [PATCH 081/367] Make mh-funcall-if-exists obsolete * lisp/mh-e/mh-acros.el (mh-funcall-if-exists): Make obsolete. * lisp/mh-e/mh-alias.el (mh-read-address): * lisp/mh-e/mh-folder.el (mh-folder-mode): * lisp/mh-e/mh-mime.el (mh-mm-display-part): * lisp/mh-e/mh-show.el (mh-defun-show-buffer): * lisp/mh-e/mh-speed.el (mh-speedbar-change-expand-button-char): * lisp/mh-e/mh-tool-bar.el (mh-tool-bar-define): * lisp/mh-e/mh-utils.el (mh-logo-display): * lisp/mh-e/mh-xface.el (mh-face-display-function): Don't use above obsolete macro. --- lisp/mh-e/mh-acros.el | 3 ++- lisp/mh-e/mh-alias.el | 10 +--------- lisp/mh-e/mh-folder.el | 2 +- lisp/mh-e/mh-mime.el | 3 +-- lisp/mh-e/mh-show.el | 3 ++- lisp/mh-e/mh-speed.el | 4 ++-- lisp/mh-e/mh-tool-bar.el | 3 +-- lisp/mh-e/mh-utils.el | 3 +-- lisp/mh-e/mh-xface.el | 3 +-- 9 files changed, 12 insertions(+), 22 deletions(-) diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 0669f5bb22c..25fff6a8e1b 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -59,7 +59,8 @@ ;;;###mh-autoload (defmacro mh-funcall-if-exists (function &rest args) "Call FUNCTION with ARGS as parameters if it exists." - (declare (debug (symbolp body))) + (declare (obsolete "use `(when (fboundp 'foo) (foo))' instead." "29.1") + (debug (symbolp body))) ;; FIXME: Not clear when this should be used. If the function happens ;; not to exist at compile-time (e.g. because the corresponding package ;; wasn't loaded), then it won't ever be used :-( diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 5761df5297c..8087df97c94 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -258,15 +258,7 @@ Blind aliases or users from /etc/passwd are not expanded." (read-string prompt) (let* ((minibuffer-local-completion-map mh-alias-read-address-map) (completion-ignore-case mh-alias-completion-ignore-case-flag) - (the-answer - (cond ((fboundp 'completing-read-multiple) - (mh-funcall-if-exists - completing-read-multiple prompt mh-alias-alist nil nil)) - ((featurep 'multi-prompt) - (mh-funcall-if-exists - multi-prompt "," nil prompt mh-alias-alist nil nil)) - (t (split-string - (completing-read prompt mh-alias-alist nil nil) ","))))) + (the-answer (completing-read-multiple prompt mh-alias-alist nil nil))) (if (not mh-alias-expand-aliases-flag) (mapconcat #'identity the-answer ", ") ;; Loop over all elements, checking if in passwd alias or blind first diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index ddf13d193ed..132ac33d269 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -631,7 +631,7 @@ perform the operation on all messages in that region. (add-hook 'write-file-functions #'mh-execute-commands nil t) (make-local-variable 'revert-buffer-function) (make-local-variable 'hl-line-mode) ; avoid pollution - (mh-funcall-if-exists hl-line-mode 1) + (hl-line-mode 1) (setq revert-buffer-function #'mh-undo-folder) (add-to-list 'minor-mode-alist '(mh-showing-mode " Show")) (mh-inc-spool-make) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 0b58d7ba1f4..3698dd33ec9 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -700,8 +700,7 @@ buttons for alternative parts that are usually suppressed." ;; Delete the button and displayed part (if any) (let ((region (get-text-property point 'mh-region))) (when region - (mh-funcall-if-exists - remove-images (car region) (cdr region))) + (remove-images (car region) (cdr region))) (mm-display-part handle) (when region (delete-region (car region) (cdr region)))) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 0f85cd6f69a..16489bf0172 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -367,7 +367,8 @@ still visible.\n") (setq normal-exit t)) (deactivate-mark) (when (eq major-mode 'mh-folder-mode) - (mh-funcall-if-exists hl-line-highlight)) + (when (fboundp 'hl-line-highlight) + (hl-line-highlight))) (cond ((not normal-exit) (set-window-configuration config)) ,(if dont-return diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index bf3a9e5774b..d9909a034d9 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -535,8 +535,8 @@ be handled next." (insert-char char 1 t) (put-text-property (point) (1- (point)) 'invisible nil) ;; make sure we fix the image on the text here. - (mh-funcall-if-exists - speedbar-insert-image-button-maybe (- (point) 2) 3))))) + (when (fboundp 'speedbar-insert-image-button-maybe) + (speedbar-insert-image-button-maybe (- (point) 2) 3)))))) ;;;###mh-autoload (defun mh-speed-add-folder (folder) diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index 0200d232c33..d451ae34d29 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -182,8 +182,7 @@ where, (add-to-list vector-list `(vector nil ',function t ,full-doc)) (add-to-list setter `(when (member ',name ,list) - (mh-funcall-if-exists - tool-bar-add-item ,icon ',function ',key + (tool-bar-add-item ,icon ',function ',key :help ,doc :enable ',enable-expr))) (add-to-list mbuttons name) (if docs (add-to-list docs doc)))))) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 1c322b80340..992943e3042 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -139,8 +139,7 @@ Ignores case when searching for OLD." 0 2 `(display ,(or mh-logo-cache (setq mh-logo-cache - (mh-funcall-if-exists - find-image '(( :type xpm :ascent center + (find-image '(( :type xpm :ascent center :file "mh-logo.xpm" )))))) (car mode-line-buffer-identification)))) diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 0c1bcdfefd5..8350f3d0fbb 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -73,8 +73,7 @@ in this order is used." (when (re-search-forward "^from:" (point-max) t) (if (eq type 'url) (mh-x-image-url-display url) - (mh-funcall-if-exists - insert-image (create-image + (insert-image (create-image raw type t :foreground (face-foreground 'mh-show-xface nil t) From 9e79575486fb6aeb0deb23e17cb2ce9ec02b5fd7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 06:25:50 +0100 Subject: [PATCH 082/367] Remove some references to XEmacs * lisp/emulation/viper-cmd.el (viper-start-R-mode): * lisp/emulation/viper-init.el (viper-window-display-p): * lisp/emulation/viper-mous.el (viper-surrounding-word): * lisp/mail/footnote.el (footnote-mode): * lisp/textmodes/reftex-index.el: Remove some comments referring to XEmacs. --- lisp/emulation/viper-cmd.el | 1 - lisp/emulation/viper-init.el | 1 - lisp/emulation/viper-mous.el | 3 +-- lisp/mail/footnote.el | 2 +- lisp/textmodes/reftex-index.el | 2 -- 5 files changed, 2 insertions(+), 7 deletions(-) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 59be3f48462..849ad3d8241 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -2311,7 +2311,6 @@ problems." (viper-downgrade-to-insert)) (defun viper-start-R-mode () - ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number (overwrite-mode 1) (add-hook 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index e3790b74534..368a5dc40a6 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -44,7 +44,6 @@ (define-obsolete-function-alias 'viper-device-type #'window-system "27.1") -;; in XEmacs: device-type is tty on tty and stream in batch. (defun viper-window-display-p () (and window-system (not (memq window-system '(tty stream pc))))) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 3d55690bd6f..879d8edca6f 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -198,8 +198,7 @@ is ignored." (setq result (buffer-substring word-beg (point)))) ) ; if - ;; XEmacs doesn't have set-text-properties, but there buffer-substring - ;; doesn't return properties together with the string, so it's not needed. + ;; FIXME: Use `buffer-substring-no-properties' above instead? (set-text-properties 0 (length result) nil result) result)) diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 716348a9c19..ef040ca90b3 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -898,7 +898,7 @@ play around with the following keys: (make-local-variable 'footnote-end-tag) (make-local-variable 'adaptive-fill-function) - ;; Filladapt was an XEmacs package which is now in GNU ELPA. + ;; Filladapt is a GNU ELPA package. (when (boundp 'filladapt-token-table) ;; add tokens to filladapt to match footnotes ;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 9d9eab4d7b5..357f7da2f9d 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -29,9 +29,7 @@ (require 'reftex) -;; START remove for XEmacs release (defvar TeX-master) -;; END remove for XEmacs release ;;;###autoload (defun reftex-index-selection-or-word (&optional arg phrase) From e72061c262226bbacaa11457d3014ef148185bf3 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Nov 2021 07:04:22 +0100 Subject: [PATCH 083/367] Fix bookmark-bmenu-mode-map syntax * lisp/bookmark.el (bookmark-bmenu-mode-map): Fix syntax in defvar-keymap. --- lisp/bookmark.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 5176d7aa8d2..89c9125a60d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -812,7 +812,7 @@ CODING is the symbol of the coding-system in which the file is encoded." (defvar-keymap bookmark-minibuffer-read-name-map :parent minibuffer-local-map - ["C-w"] #'bookmark-yank-word) + "C-w" #'bookmark-yank-word) (defun bookmark-set-internal (prompt name overwrite-or-push) "Set a bookmark using specified NAME or prompting with PROMPT. @@ -990,7 +990,7 @@ It takes one argument, the name of the bookmark, as a string.") (defvar-keymap bookmark-edit-annotation-mode-map :doc "Keymap for editing an annotation of a bookmark." :parent text-mode-map - ["C-c C-c"] #'bookmark-send-edited-annotation) + "C-c C-c" #'bookmark-send-edited-annotation) (defun bookmark-insert-annotation (bookmark-name-or-record) "Insert annotation for BOOKMARK-NAME-OR-RECORD at point." @@ -1702,20 +1702,20 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." "2" #'bookmark-bmenu-2-window "1" #'bookmark-bmenu-1-window "j" #'bookmark-bmenu-this-window - ["C-c C-c"] #'bookmark-bmenu-this-window + "C-c C-c" #'bookmark-bmenu-this-window "f" #'bookmark-bmenu-this-window - ["C-m"] #'bookmark-bmenu-this-window + "C-m" #'bookmark-bmenu-this-window "o" #'bookmark-bmenu-other-window - ["C-o"] #'bookmark-bmenu-switch-other-window + "C-o" #'bookmark-bmenu-switch-other-window "s" #'bookmark-bmenu-save - ["C-x C-s"] #'bookmark-bmenu-save + "C-x C-s" #'bookmark-bmenu-save "k" #'bookmark-bmenu-delete - ["C-d"] #'bookmark-bmenu-delete-backwards + "C-d" #'bookmark-bmenu-delete-backwards "x" #'bookmark-bmenu-execute-deletions "d" #'bookmark-bmenu-delete "D" #'bookmark-bmenu-delete-all - [? ] #'next-line - "\177" #'bookmark-bmenu-backup-unmark + "SPC" #'next-line + "DEL" #'bookmark-bmenu-backup-unmark "u" #'bookmark-bmenu-unmark "U" #'bookmark-bmenu-unmark-all "m" #'bookmark-bmenu-mark @@ -1728,7 +1728,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." "A" #'bookmark-bmenu-show-all-annotations "e" #'bookmark-bmenu-edit-annotation "/" #'bookmark-bmenu-search - [mouse-2] #'bookmark-bmenu-other-window-with-mouse) + "" #'bookmark-bmenu-other-window-with-mouse) (easy-menu-define bookmark-menu bookmark-bmenu-mode-map "Menu for `bookmark-bmenu'." From 6f52a1ba2c756ae60609d9c56fa7dc5160b3bcd2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 07:37:38 +0100 Subject: [PATCH 084/367] ; * admin/automerge: Maintain. --- admin/automerge | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/automerge b/admin/automerge index 227a404b7a3..81082f7dc68 100755 --- a/admin/automerge +++ b/admin/automerge @@ -4,7 +4,7 @@ ## Copyright (C) 2018-2021 Free Software Foundation, Inc. ## Author: Glenn Morris -## Maintainer: emacs-devel@gnu.org +## Maintainer: Stefan Kangas ## This file is part of GNU Emacs. From fc8c976298e22b50d4c0fb6b06b61271306aa8b2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 07:59:00 +0100 Subject: [PATCH 085/367] Temporarily mark two failing tests as unstable * test/lisp/mh-e/mh-utils-tests.el (mh-folder-completion-function-08-plus-slash) (mh-folder-completion-function-09-plus-slash-tmp): Temporarily mark two failing tests as unstable. --- test/lisp/mh-e/mh-utils-tests.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index 0df4d44646f..3a03d817f5f 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -437,15 +437,17 @@ and the `should' macro requires idempotent evaluation anyway." (ert-deftest mh-folder-completion-function-08-plus-slash () "Test `mh-folder-completion-function' with `+/'." + :tags '(:unstable) (mh-test-folder-completion-1 "+/" "+/" "tmp/" t) - ;; case "bb" - (with-mh-test-env - (should (equal nil - (member (format "+%s/" mh-test-rel-folder) - (mh-folder-completion-function "+/" nil t)))))) + ;; case "bb" + (with-mh-test-env + (should (equal nil + (member (format "+%s/" mh-test-rel-folder) + (mh-folder-completion-function "+/" nil t)))))) (ert-deftest mh-folder-completion-function-09-plus-slash-tmp () "Test `mh-folder-completion-function' with `+/tmp'." + :tags '(:unstable) (mh-test-folder-completion-1 "+/tmp" "+/tmp/" "tmp/" t)) (ert-deftest mh-folder-completion-function-10-plus-slash-abs-folder () From 8e67cf41e3a15d81812b4098ce06f5badee74a3f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Nov 2021 08:14:23 +0100 Subject: [PATCH 086/367] Fix mh-mime build problem * lisp/mh-e/mh-mime.el (mh-acros): Require to get mh-dlet*. --- lisp/mh-e/mh-mime.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 3698dd33ec9..714bf029bb7 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -39,6 +39,7 @@ ;;; Code: (require 'mh-e) +(require 'mh-acros) (require 'mh-gnus) ;needed because mh-gnus.el not compiled (require 'font-lock) From 90ac2db9ed9b2bab6f40508f6302996d5b8a725d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Nov 2021 08:16:58 +0100 Subject: [PATCH 087/367] Make bookmark-set prompt less confusing * lisp/bookmark.el (bookmark-set): Make the prompt less confusing (bug#51876). --- lisp/bookmark.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 89c9125a60d..a8fa9ae7749 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -916,7 +916,7 @@ it removes only the first instance of a bookmark with that name from the list of bookmarks.)" (interactive (list nil current-prefix-arg)) (let ((prompt - (if no-overwrite "Set bookmark" "Set bookmark unconditionally"))) + (if no-overwrite "Append bookmark named" "Set bookmark named"))) (bookmark-set-internal prompt name (if no-overwrite 'push 'overwrite)))) ;;;###autoload From cde5dcd441b5db79f39b8664221866566c400b05 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Nov 2021 08:34:32 +0100 Subject: [PATCH 088/367] Change the call signature to keymap-substitute * lisp/keymap.el (keymap-substitute): Make the keymap the first parameter for symmetry with the other functions. * lisp/emacs-lisp/shortdoc.el (keymaps): * lisp/emacs-lisp/bytecomp.el (lambda): Adjust. --- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/shortdoc.el | 2 +- lisp/keymap.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4078a7314f3..3338c383171 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5066,7 +5066,7 @@ binding slots have been popped." (keymap-unset 2) (keymap-global-unset 1) (keymap-local-unset 1) - (keymap-substitute 1 2) + (keymap-substitute 2 3) (keymap-set-after 2) (key-translate 1 2) (keymap-lookup 2) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 228d1e05513..157209fcf74 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1242,7 +1242,7 @@ There can be any number of :example/:result elements." (keymap-global-unset :no-eval (keymap-global-unset "C-c C-c")) (keymap-substitute - :no-eval (keymap-substitute "C-c C-c" "M-a" map)) + :no-eval (keymap-substitute map "C-c C-c" "M-a")) (keymap-set-after :no-eval (keymap-set-after map "" menu-bar-separator)) "Predicates" diff --git a/lisp/keymap.el b/lisp/keymap.el index b634487ba61..a9331e16049 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -121,7 +121,7 @@ parent keymap to be used." (keymap--check key) (define-key keymap (key-parse key) nil remove)) -(defun keymap-substitute (olddef newdef keymap &optional oldmap prefix) +(defun keymap-substitute (keymap olddef newdef &optional oldmap prefix) "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. In other words, OLDDEF is replaced with NEWDEF wherever it appears. Alternatively, if optional fourth argument OLDMAP is specified, we redefine From 2caa06eab58753fa9cef14739aa9adfcffe8e5ff Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 10:49:19 +0100 Subject: [PATCH 089/367] ; * admin/MAINTAINERS: Add myself. --- admin/MAINTAINERS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 02b8cf39bd6..b881e76e25a 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -138,6 +138,9 @@ Andrea Corallo lisp/emacs-lisp/comp-cstr.el test/src/comp-*.el +Stefan Kangas + admin/automerge + ============================================================================== 2. Areas that someone is willing to maintain, although he would not necessarily mind if someone else was the official maintainer. From e0261d4a0cf2a23d32b51b84870a3a75f8273c7c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 11:46:14 +0100 Subject: [PATCH 090/367] * lisp/image-dired.el: Remove unnecessary 'declare-function'. --- lisp/image-dired.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 852ef0f1035..047be5a2156 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1739,8 +1739,6 @@ Note that n, p and and will be hijacked and bound to `image-dired-dired-next-line' and `image-dired-dired-previous-line'." :keymap image-dired-minor-mode-map) -(declare-function clear-image-cache "image.c" (&optional filter)) - (defun image-dired-create-thumbs (&optional arg) "Create thumbnail images for all marked files in Dired. With prefix argument ARG, create thumbnails even if they already exist From b6ea007f9dc02f2699d5d772032344fbd189c55d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 17 Nov 2021 12:08:56 +0100 Subject: [PATCH 091/367] Ignore some externally maintained files in AUTHORS * admin/authors.el (authors-ignored-files): Ignore externally maintained files. --- admin/authors.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/admin/authors.el b/admin/authors.el index 23990fee708..1e8bf0364d6 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -360,6 +360,8 @@ Changes to files matching one of the regexps in this list are not listed.") "autogen/missing" "autogen" "autogen/copy_autogen" ; not generated, but trivial and now removed "dir_top" + ;; Imported into Emacs but externally maintained. + "publicsuffix.txt" "SKK-JISYO.L" ;; Only existed briefly, then renamed: "images/icons/allout-widgets-dark-bg" "images/icons/allout-widgets-light-bg" From 9ae741750cc3e96cacb3c496f7c941e5fc3f1052 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 17 Nov 2021 20:31:41 +0800 Subject: [PATCH 092/367] Don't draw xwidgets that have just been resized This serves to eliminate the huge black bar displayed when the offscreen widget has been resized (and as such the damage event signal is sent), but the X window hasn't. * src/xwidget.c (xv_do_draw): Don't draw xwidgets that have just been resized. (x_draw_xwidget_glyph_string) (xwidget_init_view): Clear just_resized. (Fxwidget_resize): Set just_resized first, then queue allocate. --- src/xwidget.c | 44 +++++++++++++++++++++++++++++--------------- src/xwidget.h | 1 + 2 files changed, 30 insertions(+), 15 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index 650572a8896..e1d54d43b74 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -1062,6 +1062,9 @@ xv_do_draw (struct xwidget_view *xw, struct xwidget *w) GtkOffscreenWindow *wnd; cairo_surface_t *surface; + if (xw->just_resized) + return; + if (NILP (w->buffer)) { XClearWindow (xw->dpy, xw->wdesc); @@ -1578,6 +1581,7 @@ xwidget_init_view (struct xwidget *xww, xv->wdesc = None; xv->frame = s->f; xv->cursor = cursor_for_hit (xww->hit_result, s->f); + xv->just_resized = false; #elif defined NS_IMPL_COCOA nsxwidget_init_view (xv, xww, s, x, y); nsxwidget_resize_view(xv, xww->width, xww->height); @@ -1609,6 +1613,8 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) #ifdef USE_GTK if (!xv) xv = xwidget_init_view (xww, s, x, y); + + xv->just_resized = false; #elif defined NS_IMPL_COCOA if (!xv) { @@ -1970,6 +1976,28 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, xw->width = w; xw->height = h; + block_input (); + + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); + tail = XCDR (tail)) + { + if (XWIDGET_VIEW_P (XCAR (tail))) + { + struct xwidget_view *xv = XXWIDGET_VIEW (XCAR (tail)); + if (XXWIDGET (xv->model) == xw) + { +#ifdef USE_GTK + xv->just_resized = true; + SET_FRAME_GARBAGED (xv->frame); +#else + wset_redisplay (XWINDOW (xv->w)); +#endif + } + } + } + + redisplay (); + /* If there is an offscreen widget resize it first. */ #ifdef USE_GTK if (xw->widget_osr) @@ -1984,21 +2012,7 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, #elif defined NS_IMPL_COCOA nsxwidget_resize (xw); #endif - - for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); - tail = XCDR (tail)) - { - if (XWIDGET_VIEW_P (XCAR (tail))) - { - struct xwidget_view *xv = XXWIDGET_VIEW (XCAR (tail)); - if (XXWIDGET (xv->model) == xw) - { - wset_redisplay (XWINDOW (xv->w)); - } - } - } - - redisplay (); + unblock_input (); return Qnil; } diff --git a/src/xwidget.h b/src/xwidget.h index 2f6d0442e20..78fe865dd84 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -114,6 +114,7 @@ struct xwidget_view cairo_surface_t *cr_surface; cairo_t *cr_context; + int just_resized; #elif defined (NS_IMPL_COCOA) # ifdef __OBJC__ XvWindow *xvWindow; From 0fbe543bc1a7cc3e9198eb0d8fc4b248ff0701e6 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Mar 2021 10:56:51 +0100 Subject: [PATCH 093/367] Use substitute-command-keys in some messages * lisp/dired.el (dired-get-file-for-visit): * lisp/doc-view.el (doc-view-buffer-message): * lisp/help.el (help-window-setup): * lisp/ibuf-ext.el (ibuffer-do-kill-lines): * lisp/vc/ediff.el (ediff-documentation): Use 'substitute-command-keys'. --- lisp/dired.el | 4 +++- lisp/doc-view.el | 10 +++++----- lisp/help.el | 12 ++++++------ lisp/ibuf-ext.el | 5 ++++- lisp/vc/ediff.el | 4 +++- 5 files changed, 21 insertions(+), 14 deletions(-) diff --git a/lisp/dired.el b/lisp/dired.el index 8650fb9baa8..a0fa9178911 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2449,7 +2449,9 @@ directory in another window." file-name (if (file-symlink-p file-name) (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update Dired buffer"))))) + (error (substitute-command-keys + (concat "File no longer exists; type \\" + "\\[revert-buffer] to update Dired buffer"))))))) ;; Force C-m keybinding rather than `f' or `e' in the mode doc: (define-obsolete-function-alias 'dired-advertised-find-file diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 088ca5bfeae..32e2ec1688c 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1530,16 +1530,16 @@ have the page we want to view." (overlay-put (doc-view-current-overlay) 'display (concat (propertize "Welcome to DocView!" 'face 'bold) "\n" - " + (substitute-command-keys " If you see this buffer it means that the document you want to view is being converted to PNG and the conversion of the first page hasn't finished yet or `doc-view-conversion-refresh-interval' is set to nil. For now these keys are useful: - -`q' : Bury this buffer. Conversion will go on in background. -`k' : Kill the conversion process and this buffer. -`K' : Kill the conversion process.\n")))) +\\ +\\[quit-window] : Bury this buffer. Conversion will go on in background. +\\[image-kill-buffer] : Kill the conversion process and this buffer. +\\[doc-view-kill-proc] : Kill the conversion process.\n"))))) (declare-function tooltip-show "tooltip" (text &optional use-echo-area)) diff --git a/lisp/help.el b/lisp/help.el index 4470e6baaa4..68b6d930c9a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1833,13 +1833,13 @@ Return VALUE." (cond ((eq help-setup 'window) ;; ... and is new, ... - "Type \"q\" to delete help window") + "Type \\\\[help-quit] to delete help window") ((eq help-setup 'frame) ;; ... on a new frame, ... - "Type \"q\" to quit the help frame") + "Type \\\\[help-quit] to quit the help frame") ((eq help-setup 'other) ;; ... or displayed some other buffer before. - "Type \"q\" to restore previous buffer")) + "Type \\\\[help-quit] to restore previous buffer")) window t)) ((and (eq (window-frame window) help-window-old-frame) (= (length (window-list nil 'no-mini)) 2)) @@ -1850,7 +1850,7 @@ Return VALUE." ((eq help-setup 'window) "Type \\[delete-other-windows] to delete the help window") ((eq help-setup 'other) - "Type \"q\" in help window to restore its previous buffer")) + "Type \\\\[help-quit] in help window to restore its previous buffer")) window 'other)) (t ;; The help window is not selected ... @@ -1858,10 +1858,10 @@ Return VALUE." (cond ((eq help-setup 'window) ;; ... and is new, ... - "Type \"q\" in help window to delete it") + "Type \\\\[help-quit] in help window to delete it") ((eq help-setup 'other) ;; ... or displayed some other buffer before. - "Type \"q\" in help window to restore previous buffer")) + "Type \\\\[help-quit] in help window to restore previous buffer")) window)))) ;; Return VALUE. value)) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 5b69a878e21..2d2365dc34d 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1597,7 +1597,10 @@ to move by. The default is `ibuffer-marked-char'." "Hide all of the currently marked lines." (interactive) (if (= (ibuffer-count-marked-lines) 0) - (message "No buffers marked; use `m' to mark a buffer") + (message (substitute-command-keys + (concat + "No buffers marked; use \\" + "\\[ibuffer-mark-forward] to mark a buffer"))) (let ((count (ibuffer-map-marked-lines (lambda (_buf _mark) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 97c84ae5a18..cb4c8d93052 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -1558,7 +1558,9 @@ With optional NODE, goes to that node." (info "ediff") (if node (Info-goto-node node) - (message "Type `i' to search for a specific topic")) + (message (substitute-command-keys + (concat "Type \\\\[Info-index] to" + " search for a specific topic")))) (raise-frame)) (error (beep 1) (with-output-to-temp-buffer ediff-msg-buffer From 3b2421e6a7218b128c45ec2dd1f65a24d178093a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 17 Nov 2021 21:30:20 +0800 Subject: [PATCH 094/367] Prevent subprocess hangs in xwidget * src/xwidget.c (Fmake_xwidget, Fxwidget_webkit_goto_url): Use `catch_child_signal' instead of trying to preserve the previous signal handler. --- src/xwidget.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index e1d54d43b74..e1bf40ea437 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -32,6 +32,7 @@ along with GNU Emacs. If not, see . */ #include "sysstdio.h" #include "termhooks.h" #include "window.h" +#include "process.h" /* Include xwidget bottom end headers. */ #ifdef USE_GTK @@ -189,14 +190,12 @@ fails. */) { xw->widget_osr = webkit_web_view_new (); + webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), + "about:blank"); /* webkitgtk uses GSubprocess which sets sigaction causing Emacs to not catch SIGCHLD with its usual handle setup in 'catch_child_signal'. This resets the SIGCHLD sigaction. */ - struct sigaction old_action; - sigaction (SIGCHLD, NULL, &old_action); - webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), - "about:blank"); - sigaction (SIGCHLD, &old_action, NULL); + catch_child_signal (); } else { @@ -1841,6 +1840,7 @@ DEFUN ("xwidget-webkit-goto-uri", uri = ENCODE_FILE (uri); #ifdef USE_GTK webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (uri)); + catch_child_signal (); #elif defined NS_IMPL_COCOA nsxwidget_webkit_goto_uri (xw, SSDATA (uri)); #endif From 5896ca8925b65d86a392269c0696c96755890b1a Mon Sep 17 00:00:00 2001 From: Ken Brown Date: Wed, 17 Nov 2021 11:55:39 -0500 Subject: [PATCH 095/367] Avoid delays waiting for input on systems without SIGIO * src/process.c (wait_reading_process_output) [!USABLE_SIGIO]: If we're waiting for input, don't use a timeout of more than 25 msec in the call to select. (Bug#50043) --- src/process.c | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/process.c b/src/process.c index f923aff1cb3..808bf6f1ff9 100644 --- a/src/process.c +++ b/src/process.c @@ -5588,6 +5588,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, timeout = make_timespec (0, 0); #endif +#ifndef USABLE_SIGIO + /* If we're polling for input, don't get stuck in select for + more than 25 msec. */ + struct timespec short_timeout = make_timespec (0, 25000000); + if ((read_kbd || !NILP (wait_for_cell)) + && timespec_cmp (short_timeout, timeout) < 0) + timeout = short_timeout; +#endif + /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */ #if defined HAVE_GLIB && !defined HAVE_NS nfds = xg_select (max_desc + 1, From d4e2915dab13da38ce2b7ab63b5c8b0ffb9b9df8 Mon Sep 17 00:00:00 2001 From: Ken Brown Date: Wed, 17 Nov 2021 13:02:44 -0500 Subject: [PATCH 096/367] Make process_pending_signals useful on systems without SIGIO * src/keyboard.c (handle_async_input): Call gobble_input unconditionally, not just if USABLE_SIGIO is defined. This makes process_pending_signals do something useful on systems that have to poll for input. (Bug#51820) --- src/keyboard.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index de9805df327..5a43e9a46aa 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7180,7 +7180,6 @@ tty_read_avail_input (struct terminal *terminal, static void handle_async_input (void) { -#ifdef USABLE_SIGIO while (1) { int nread = gobble_input (); @@ -7190,7 +7189,6 @@ handle_async_input (void) if (nread <= 0) break; } -#endif } void From bf04c19cdd08baa5e5e90ccdba8aa9c0449c7fab Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 17 Nov 2021 20:33:40 +0200 Subject: [PATCH 097/367] Fix recent changes related to USABLE_SIGIO * src/process.c (wait_reading_process_output) [WINDOWSNT]: * src/keyboard.c (handle_async_input) [DOS_NT]: Ifdef away the code that is not needed on MS-Windows. (Bug#50403) (Bug#51820) --- src/keyboard.c | 2 ++ src/process.c | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/keyboard.c b/src/keyboard.c index 5a43e9a46aa..c3bc8307d7f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7180,6 +7180,7 @@ tty_read_avail_input (struct terminal *terminal, static void handle_async_input (void) { +#ifndef DOS_NT while (1) { int nread = gobble_input (); @@ -7189,6 +7190,7 @@ handle_async_input (void) if (nread <= 0) break; } +#endif } void diff --git a/src/process.c b/src/process.c index 808bf6f1ff9..a00426795b8 100644 --- a/src/process.c +++ b/src/process.c @@ -5588,7 +5588,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, timeout = make_timespec (0, 0); #endif -#ifndef USABLE_SIGIO +#if !defined USABLE_SIGIO && !defined WINDOWSNT /* If we're polling for input, don't get stuck in select for more than 25 msec. */ struct timespec short_timeout = make_timespec (0, 25000000); From 38322419e4d32ff9f3d5505360f2714c31aa2e8d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 18 Nov 2021 00:58:26 +0100 Subject: [PATCH 098/367] Revert "* lisp/image-dired.el: Remove unnecessary 'declare-function'." This reverts commit e0261d4a0cf2a23d32b51b84870a3a75f8273c7c. This commit gives warnings on builds --without-x. Problem pointed out by Glenn Morris in: https://lists.gnu.org/r/emacs-devel/2021-11/msg01278.html --- lisp/image-dired.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 047be5a2156..852ef0f1035 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1739,6 +1739,8 @@ Note that n, p and and will be hijacked and bound to `image-dired-dired-next-line' and `image-dired-dired-previous-line'." :keymap image-dired-minor-mode-map) +(declare-function clear-image-cache "image.c" (&optional filter)) + (defun image-dired-create-thumbs (&optional arg) "Create thumbnail images for all marked files in Dired. With prefix argument ARG, create thumbnails even if they already exist From b48cbaf5c7e47c002fd274aea21554245075bfe8 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Wed, 17 Nov 2021 20:25:50 -0800 Subject: [PATCH 099/367] Fix two failing tests in mh-utils-tests * test/lisp/mh-e/mh-utils-tests.el (mh-test-utils-mock-call-process): Add mock for root folders. (mh-folder-completion-function-08-plus-slash) (mh-folder-completion-function-09-plus-slash-tmp): Skip these tests with Mailutils, which doesn't handle root folders. (Bug#51902) --- test/lisp/mh-e/mh-utils-tests.el | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index 3a03d817f5f..0066c00b5b2 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -211,6 +211,10 @@ The tests use this method if no configured MH variant is found." "/abso-folder/bar has no messages." "/abso-folder/foo has no messages." "/abso-folder/food has no messages.")) + (("folders" "-noheader" "-norecurse" "-nototal" "+/") . + ("/+ has no messages ; (others)." + "//abso-folder has no messages ; (others)." + "//tmp has no messages ; (others).")) )) (arglist (cons (file-name-base program) args))) (let ((response-list-cons (assoc arglist argument-responses))) @@ -437,7 +441,10 @@ and the `should' macro requires idempotent evaluation anyway." (ert-deftest mh-folder-completion-function-08-plus-slash () "Test `mh-folder-completion-function' with `+/'." - :tags '(:unstable) + ;; This test fails with Mailutils 3.5, 3.7, and 3.13. + (with-mh-test-env + (skip-unless (not (and (stringp mh-variant-in-use) + (string-search "GNU Mailutils" mh-variant-in-use))))) (mh-test-folder-completion-1 "+/" "+/" "tmp/" t) ;; case "bb" (with-mh-test-env @@ -447,7 +454,10 @@ and the `should' macro requires idempotent evaluation anyway." (ert-deftest mh-folder-completion-function-09-plus-slash-tmp () "Test `mh-folder-completion-function' with `+/tmp'." - :tags '(:unstable) + ;; This test fails with Mailutils 3.5, 3.7, and 3.13. + (with-mh-test-env + (skip-unless (not (and (stringp mh-variant-in-use) + (string-search "GNU Mailutils" mh-variant-in-use))))) (mh-test-folder-completion-1 "+/tmp" "+/tmp/" "tmp/" t)) (ert-deftest mh-folder-completion-function-10-plus-slash-abs-folder () From 7404f4b4e0bf472d5f161957ff23e30df0e8b96d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Nov 2021 08:46:17 +0200 Subject: [PATCH 100/367] Improve doc string of 'highlight-nonselected-windows' * src/xdisp.c (syms_of_xdisp) : Clarify the doc string. (Bug#51927) --- src/xdisp.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index c05e7edbc97..0316408d927 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35205,7 +35205,9 @@ line number may be omitted from the mode line. */); line_number_display_limit_width = 200; DEFVAR_BOOL ("highlight-nonselected-windows", highlight_nonselected_windows, - doc: /* Non-nil means highlight region even in nonselected windows. */); + doc: /* Non-nil means highlight active region even in nonselected windows. +When nil (the default), the active region is only highlighted when +the window is selected. */); highlight_nonselected_windows = false; DEFVAR_BOOL ("multiple-frames", multiple_frames, From f596f0db82c0b1ff3fe8e8f1d8b07d2fe7504ab6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= Date: Wed, 17 Nov 2021 09:12:21 +0100 Subject: [PATCH 101/367] Don't ignore restriction in indent-region-line-by-line * lisp/indent.el (indent-according-to-mode): Don't widen if the new optional argument is non-nil. (indent-region): Explicitly widen before calling indent-region-line-by-line. (indent-region-line-by-line): Don't widen (bug#51892). Emacs convention is that low-level functions should respect restriction so that their callers can set restriction according to their needs. For example, 'c-indent-region' is a lower-level function which respects the current restriction and 'indent-region' is a higher-level user command which sets the restriction for lower-level functions, it calls "(widen)". 'indent-region-line-by-line' is a low-level function on a similar level as 'c-indent-region'. This patch makes it respect the current restriction instead of having it call "(widen)". --- lisp/indent.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/lisp/indent.el b/lisp/indent.el index aa6b8d17c4a..ec01733d123 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -88,16 +88,20 @@ This variable has no effect unless `tab-always-indent' is `complete'." indent-relative-first-indent-point) "Values that are ignored by `indent-according-to-mode'.") -(defun indent-according-to-mode () +(defun indent-according-to-mode (&optional inhibit-widen) "Indent line in proper way for current major mode. Normally, this is done by calling the function specified by the variable `indent-line-function'. However, if the value of that variable is present in the `indent-line-ignored-functions' variable, handle it specially (since those functions are used for tabbing); -in that case, indent by aligning to the previous non-blank line." +in that case, indent by aligning to the previous non-blank line. + +Ignore restriction, unless the optional argument INHIBIT-WIDEN is +non-nil." (interactive) (save-restriction - (widen) + (unless inhibit-widen + (widen)) (syntax-propertize (line-end-position)) (if (memq indent-line-function indent-line-ignored-functions) ;; These functions are used for tabbing, but can't be used for @@ -601,7 +605,10 @@ column to indent to; if it is nil, use one of the three methods above." (funcall indent-region-function start end))) ;; Else, use a default implementation that calls indent-line-function on ;; each line. - (t (indent-region-line-by-line start end))) + (t + (save-restriction + (widen) + (indent-region-line-by-line start end)))) ;; In most cases, reindenting modifies the buffer, but it may also ;; leave it unmodified, in which case we have to deactivate the mark ;; by hand. @@ -615,7 +622,7 @@ column to indent to; if it is nil, use one of the three methods above." (make-progress-reporter "Indenting region..." (point) end)))) (while (< (point) end) (or (and (bolp) (eolp)) - (indent-according-to-mode)) + (indent-according-to-mode t)) (forward-line 1) (and pr (progress-reporter-update pr (point)))) (and pr (progress-reporter-done pr)) From ce2f7335f1f4ec8d276e47de79b3c9bd9797233d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Nov 2021 09:29:06 +0100 Subject: [PATCH 102/367] Make the optional describe-map-tree parameters optional * lisp/help.el (describe-map-tree): Make the optional parameters optional. This makes testing easier. --- lisp/help.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index 68b6d930c9a..bc3d4773dad 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1226,8 +1226,8 @@ Otherwise, return a new string." (buffer-string))))) (defvar help--keymaps-seen nil) -(defun describe-map-tree (startmap partial shadow prefix title no-menu - transl always-title mention-shadow) +(defun describe-map-tree (startmap &optional partial shadow prefix title + no-menu transl always-title mention-shadow) "Insert a description of the key bindings in STARTMAP. This is followed by the key bindings of all maps reachable through STARTMAP. From 5eeaf857678d617560efa6a99bb6fd54c0ceddec Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Nov 2021 10:25:58 +0200 Subject: [PATCH 103/367] Improve documentation of window hooks * doc/lispref/windows.texi (Window Hooks): Clarify "buffer-local functions". (Bug#51930) --- doc/lispref/windows.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 57cd2274d4b..a3a37bc60d2 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6375,7 +6375,9 @@ changed. @xref{Other Font Lock Variables}. during redisplay provided a significant, non-scrolling change of a window has been detected. For simplicity, these hooks and the functions they call will be collectively referred to as @dfn{window -change functions}. +change functions}. As any hook, these hooks can be set either +globally of buffer-locally via the @var{local} argument of +@code{add-hook} (@pxref{Setting Hooks}) when the hook is installed. @cindex window buffer change The first of these hooks is run after a @dfn{window buffer change} is From d7f52c64666cbd0b91ece1231c235b5c74acd0a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Nov 2021 10:01:17 +0100 Subject: [PATCH 104/367] ; * src/macfont.m: fix typing errors --- src/macfont.m | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/macfont.m b/src/macfont.m index 1426cae6dc4..ce7a5ec8cda 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -2928,7 +2928,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no { if (s->hl == DRAW_CURSOR) { - CGColorRef *colorref = get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (f), f); + CGColorRef colorref = get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (f), f); CGContextSetFillColorWithColor (context, colorref); CGColorRelease (colorref); } @@ -2944,7 +2944,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no CGContextScaleCTM (context, 1, -1); if (s->hl == DRAW_CURSOR) { - CGColorRef *colorref = get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (f), f); + CGColorRef colorref = get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (f), f); CGContextSetFillColorWithColor (context, colorref); CGColorRelease (colorref); } From 1625123e4ceb8d23eef00f3944341ecf0a75dc77 Mon Sep 17 00:00:00 2001 From: Greg Minshall Date: Thu, 18 Nov 2021 10:32:34 +0100 Subject: [PATCH 105/367] Fix eldoc usage of newly introduced variable * lisp/emacs-lisp/eldoc.el (eldoc-display-message-no-interference-p): Make this function work in older Emacs versions again (bug#51939). --- lisp/emacs-lisp/eldoc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index b30d3fc30f4..cd0e7dca7cf 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -385,7 +385,8 @@ Also store it in `eldoc-last-message' and return that value." ;; The following configuration shows "Matches..." in the ;; echo area when point is after a closing bracket, which ;; conflicts with eldoc. - (and show-paren-context-when-offscreen + (and (boundp 'show-paren-context-when-offscreen) + show-paren-context-when-offscreen (not (pos-visible-in-window-p (overlay-end show-paren--overlay))))))) From 6cad3dc75e19669ba43bdc69a617ad14dec5643f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 18 Nov 2021 11:25:18 +0100 Subject: [PATCH 106/367] Fix `narrow-to-defun' in "async function" in js-mode * lisp/progmodes/js.el (js--plain-method-re): (js--function-prologue-beginning): (js--ensure-cache): Allow "async" before "function" (bug#51926). This makes `narrow-to-defun' work as expected. --- lisp/progmodes/js.el | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f11995127d4..e5e83beff6c 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -91,7 +91,7 @@ name.") (defconst js--plain-method-re (concat "^\\s-*?\\(" js--dotted-name-re "\\)\\.prototype" - "\\.\\(" js--name-re "\\)\\s-*?=\\s-*?\\(function\\)\\_>") + "\\.\\(" js--name-re "\\)\\s-*?=\\s-*?\\(\\(:?async[ \t\n]+\\)function\\)\\_>") "Regexp matching an explicit JavaScript prototype \"method\" declaration. Group 1 is a (possibly-dotted) class name, group 2 is a method name, and group 3 is the `function' keyword.") @@ -914,9 +914,10 @@ This puts point at the `function' keyword. If this is a syntactically-correct non-expression function, return the name of the function, or t if the name could not be determined. Otherwise, return nil." - (cl-assert (looking-at "\\_")) + (unless (looking-at "\\(\\_[ \t\n]+\\)?\\_") + (error "Invalid position")) (let ((name t)) - (forward-word-strictly) + (goto-char (match-end 0)) (forward-comment most-positive-fixnum) (when (eq (char-after) ?*) (forward-char) @@ -952,14 +953,17 @@ If POS is not in a function prologue, return nil." (goto-char (match-end 0)))) (skip-syntax-backward "w_") - (and (or (looking-at "\\_") - (js--re-search-backward "\\_" nil t)) - - (save-match-data (goto-char (match-beginning 0)) - (js--forward-function-decl)) - - (<= pos (point)) - (or prologue-begin (match-beginning 0)))))) + (let ((start nil)) + (and (or (looking-at "\\_") + (js--re-search-backward "\\_" nil t)) + (progn + (setq start (match-beginning 0)) + (goto-char start) + (when (looking-back "\\_[ \t\n]+" (- (point) 30)) + (setq start (match-beginning 0))) + (js--forward-function-decl)) + (<= pos (point)) + (or prologue-begin start)))))) (defun js--beginning-of-defun-raw () "Helper function for `js-beginning-of-defun'. @@ -1229,7 +1233,6 @@ LIMIT defaults to point." ;; Regular function declaration ((and (looking-at "\\_") (setq name (js--forward-function-decl))) - (when (eq name t) (setq name (js--guess-function-name orig-match-end)) (if name @@ -1241,6 +1244,11 @@ LIMIT defaults to point." (cl-assert (eq (char-after) ?{)) (forward-char) + (save-excursion + (goto-char orig-match-start) + (when (looking-back "\\_[ \t\n]+" + (- (point) 3)) + (setq orig-match-start (match-beginning 0)))) (make-js--pitem :paren-depth orig-depth :h-begin orig-match-start From 44faf546592a0c063d5044322f11bb0f006e613c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 18 Nov 2021 12:11:35 +0100 Subject: [PATCH 107/367] Revert VC-related prefix user options to previous values * lisp/vc/smerge-mode.el (smerge-command-prefix): * lisp/vc/pcvs.el (cvs-minor-mode-prefix): * lisp/vc/diff-mode.el (diff-minor-mode-prefix): Revert to previous values, as external packages rely on those values. --- lisp/vc/diff-mode.el | 7 +++---- lisp/vc/pcvs.el | 7 +++---- lisp/vc/smerge-mode.el | 7 +++---- 3 files changed, 9 insertions(+), 12 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 87d30666da0..1cffd88a56f 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -264,15 +264,14 @@ and hunk-based syntax highlighting otherwise as a fallback." :help "Go to the next count'th file"] )) -(defcustom diff-minor-mode-prefix "C-c =" +(defcustom diff-minor-mode-prefix "\C-c ==" "Prefix key for `diff-minor-mode' commands." :type '(choice (string "ESC") - (string "C-c =") string) - :version "29.1") + (string "\C-c=") string)) (defvar-keymap diff-minor-mode-map :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." - diff-minor-mode-prefix diff-mode-shared-map) + (key-description diff-minor-mode-prefix) diff-mode-shared-map) (define-minor-mode diff-auto-refine-mode "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index fa28d074a98..2d7b8cb2ef7 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -266,14 +266,13 @@ ;;;; CVS-Minor mode ;;;; -(defcustom cvs-minor-mode-prefix "C-x c" +(defcustom cvs-minor-mode-prefix "\C-xc" "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." :type 'string - :version "29.1" - :group 'pcl-cvs) + :group 'pcl-cvs) (defvar-keymap cvs-minor-mode-map - cvs-minor-mode-prefix 'cvs-mode-map + (key-description cvs-minor-mode-prefix) 'cvs-mode-map "e" '(menu-item nil cvs-mode-edit-log :filter (lambda (x) (and (derived-mode-p 'log-view-mode) x)))) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index ee6ddf15881..6c1b8cc95b3 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -162,16 +162,15 @@ Used in `smerge-diff-base-upper' and related functions." ">" (cons "base-lower" #'smerge-diff-base-lower) "=" (cons "upper-lower" #'smerge-diff-upper-lower))) -(defcustom smerge-command-prefix "C-c ^" +(defcustom smerge-command-prefix "\C-c^" "Prefix for `smerge-mode' commands." - :version "29.1" :type '(choice (const :tag "ESC" "\e") - (const :tag "C-c ^" "C-c ^") + (const :tag "C-c ^" "\C-c^") (const :tag "none" "") string)) (defvar-keymap smerge-mode-map - smerge-command-prefix smerge-basic-map) + (key-description smerge-command-prefix) smerge-basic-map) (defvar-local smerge-check-cache nil) (defun smerge-check (n) From f41c6a70e7ce100b13ff0b662a054f6a0cd11cb2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Nov 2021 11:26:21 +0100 Subject: [PATCH 108/367] Avoid adding duplicates to Xref history * lisp/progmodes/xref.el (xref--push-backward, xref--push-forward): New functions. (xref-push-marker-stack, xref-go-back, xref-go-forward): Use them. --- lisp/progmodes/xref.el | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index edb98aa5fe6..ca3594d253b 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -414,19 +414,29 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) -(defvar xref--history (cons nil nil) - "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.") - (make-obsolete-variable 'xref-marker-ring nil "29.1") (defun xref-set-marker-ring-length (_var _val) (declare (obsolete nil "29.1")) nil) +(defvar xref--history (cons nil nil) + "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.") + +(defun xref--push-backward (m) + "Push marker M onto the backward history stack." + (unless (equal m (caar xref--history)) + (push m (car xref--history)))) + +(defun xref--push-forward (m) + "Push marker M onto the forward history stack." + (unless (equal m (cadr xref--history)) + (push m (cdr xref--history)))) + (defun xref-push-marker-stack (&optional m) "Add point M (defaults to `point-marker') to the marker stack. The future stack is erased." - (push (or m (point-marker)) (car xref--history)) + (xref--push-backward (or m (point-marker))) (dolist (mk (cdr xref--history)) (set-marker mk nil nil)) (setcdr xref--history nil)) @@ -442,7 +452,7 @@ To undo, use \\[xref-go-forward]." (if (null (car xref--history)) (user-error "At start of xref history") (let ((marker (pop (car xref--history)))) - (push (point-marker) (cdr xref--history)) + (xref--push-forward (point-marker)) (switch-to-buffer (or (marker-buffer marker) (user-error "The marked buffer has been deleted"))) (goto-char (marker-position marker)) @@ -456,7 +466,7 @@ To undo, use \\[xref-go-forward]." (if (null (cdr xref--history)) (user-error "At end of xref history") (let ((marker (pop (cdr xref--history)))) - (push (point-marker) (car xref--history)) + (xref--push-backward (point-marker)) (switch-to-buffer (or (marker-buffer marker) (user-error "The marked buffer has been deleted"))) (goto-char (marker-position marker)) From 67ffcc5c7f5e1adcc6f662b01c7904f977dd4f51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Nov 2021 12:18:24 +0100 Subject: [PATCH 109/367] Signal an error for duplicated ERT tests (bug#51941) Make `ert-deftest` fail with an error (in batch mode only) if an existing test is redefined, because that is an easy mistake to make and which leads to a test being discarded silently. lisp/emacs-lisp/ert.el (ert-set-test, ert-deftest): Add check. etc/NEWS: Announce. --- etc/NEWS | 7 +++++++ lisp/emacs-lisp/ert.el | 7 +++++++ 2 files changed, 14 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 80be6c0e498..cee2844be3a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -64,6 +64,13 @@ the 'COLORTERM' environment variable is set to the value "truecolor". These variables will override 'print-length' and 'print-level' when printing Lisp values in ERT batch test results. +--- +** Redefining an ERT test in batch mode now signals an error +Executing 'ert-deftest' with the same name as an existing test causes +the previous definition to be discarded, which was probably not +intended when this occurs in batch mode. To remedy the error, rename +tests so that they all have unique names. + ** Emacs now supports Unicode Standard version 14.0. ** Emoji diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 36b4408dc8e..dc9cbc47458 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -151,6 +151,10 @@ in batch mode.") ;; Note that nil is still a valid value for the `name' slot in ;; ert-test objects. It designates an anonymous test. (error "Attempt to define a test named nil")) + (when (and noninteractive (get symbol 'ert--test)) + ;; Make sure duplicated tests are discovered since the older test would + ;; be ignored silently otherwise. + (error "Test `%s' redefined" symbol)) (define-symbol-prop symbol 'ert--test definition) definition) @@ -206,6 +210,9 @@ Macros in BODY are expanded when the test is defined, not when it is run. If a macro (possibly with side effects) is to be tested, it has to be wrapped in `(eval (quote ...))'. +If NAME is already defined as a test and Emacs is running +in batch mode, an error is signalled. + \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \ [:tags \\='(TAG...)] BODY...)" (declare (debug (&define [&name "test@" symbolp] From 7a1e5ac8b29b731e89cc9d5b498e31bd90840b9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Nov 2021 12:47:35 +0100 Subject: [PATCH 110/367] Eliminate ERT test name clashes (bug#51941) * test/lisp/electric-tests.el (js-mode-braces-with-layout-and-indent): * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-test-fifth): * test/lisp/thingatpt-tests.el (test-symbol-thing-2): Remove duplicated tests. * test/lisp/emacs-lisp/generator-tests.el (cps-loop): * test/lisp/emacs-lisp/ring-tests.el (ring-tests-insert): * test/lisp/help-tests.el (help-tests-substitute-command-keys/no-change): * test/lisp/net/netrc-tests.el (test-netrc-credentials): * test/lisp/progmodes/elisp-mode-tests.el (elisp-completes-functions-after-let-bindings): * test/lisp/thingatpt-tests.el (test-symbol-thing-3): * test/src/buffer-tests.el (deftest-overlayp-1, buffer-tests--*): * test/src/buffer-tests.el (test-buffer-swap-text-1): * test/src/data-tests.el (binding-test-set-constant-nil) (data-tests-logcount): Rename clashing tests. --- test/lisp/electric-tests.el | 10 ---- test/lisp/emacs-lisp/cl-lib-tests.el | 7 --- test/lisp/emacs-lisp/generator-tests.el | 2 +- test/lisp/emacs-lisp/ring-tests.el | 2 +- test/lisp/help-tests.el | 2 +- test/lisp/net/netrc-tests.el | 2 +- test/lisp/progmodes/elisp-mode-tests.el | 2 +- test/lisp/thingatpt-tests.el | 10 +--- test/src/buffer-tests.el | 78 ++++++++++++------------- test/src/data-tests.el | 4 +- 10 files changed, 47 insertions(+), 72 deletions(-) diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 1e32dbfb609..feeae2b82ad 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -550,16 +550,6 @@ baz\"\"" (electric-indent-mode 1) (electric-layout-mode 1))) -(define-electric-pair-test js-mode-braces-with-layout-and-indent - "" "{" :expected-string "{\n \n}" :expected-point 7 - :modes '(js-mode) - :test-in-comments nil - :test-in-strings nil - :fixture-fn (lambda () - (electric-pair-mode 1) - (electric-indent-mode 1) - (electric-layout-mode 1))) - ;;; Backspacing ;;; TODO: better tests diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index a132d736383..854e371b32f 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -353,13 +353,6 @@ (should (= 5 (cl-fifth '(1 2 3 4 5 6)))) (should-error (cl-fifth "12345") :type 'wrong-type-argument)) -(ert-deftest cl-lib-test-fifth () - (should (null (cl-fifth '()))) - (should (null (cl-fifth '(1 2 3 4)))) - (should (= 5 (cl-fifth '(1 2 3 4 5)))) - (should (= 5 (cl-fifth '(1 2 3 4 5 6)))) - (should-error (cl-fifth "12345") :type 'wrong-type-argument)) - (ert-deftest cl-lib-test-sixth () (should (null (cl-sixth '()))) (should (null (cl-sixth '(1 2 3 4 5)))) diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index c81d3d09e7d..50b8cc53a28 100644 --- a/test/lisp/emacs-lisp/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el @@ -219,7 +219,7 @@ identical output." (should (eql (iter-next it -1) 42)) (should (eql (iter-next it -1) -1)))) -(ert-deftest cps-loop () +(ert-deftest cps-loop-2 () (should (equal (cl-loop for x iter-by (mygenerator 42) collect x) diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el index 55df4f36685..3ec20a1e8ef 100644 --- a/test/lisp/emacs-lisp/ring-tests.el +++ b/test/lisp/emacs-lisp/ring-tests.el @@ -199,7 +199,7 @@ (should (= (ring-size ring) 3)) (should (equal (ring-elements ring) '(5 4 3))))) -(ert-deftest ring-tests-insert () +(ert-deftest ring-tests-insert-2 () (let ((ring (make-ring 2))) (ring-insert+extend ring :a) (ring-insert+extend ring :b) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index a331ec440a8..982750f479e 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -174,7 +174,7 @@ M-g M-c switch-to-completions (let ((text-quoting-style 'grave)) (test "\\=`x\\='" "`x'")))) -(ert-deftest help-tests-substitute-command-keys/no-change () +(ert-deftest help-tests-substitute-command-keys/no-change-2 () (with-substitute-command-keys-test (test "\\[foobar" "\\[foobar") (test "\\=" "\\="))) diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el index f75328a59f7..2f68b9bbb24 100644 --- a/test/lisp/net/netrc-tests.el +++ b/test/lisp/net/netrc-tests.el @@ -48,7 +48,7 @@ (should (equal (netrc-credentials "ftp.example.org") '("jrh" "*baz*"))))) -(ert-deftest test-netrc-credentials () +(ert-deftest test-netrc-credentials-2 () (let ((netrc-file (ert-resource-file "netrc-folding"))) (should (equal (netrc-parse netrc-file) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 7f1cd6795ef..b91f7331a8d 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -109,7 +109,7 @@ (should (member "backup-inhibited" comps)) (should-not (member "backup-buffer" comps)))))) -(ert-deftest elisp-completes-functions-after-let-bindings () +(ert-deftest elisp-completes-functions-after-let-bindings-2 () (with-temp-buffer (emacs-lisp-mode) (insert "(let ((bar 1) (baz 2)) (ba") diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 2a32dc57b1c..f2031fa79ab 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -170,21 +170,13 @@ position to retrieve THING.") (forward-char -1) (should (eq (symbol-at-point) 'bar)))) -(ert-deftest test-symbol-thing-2 () - (with-temp-buffer - (insert " bar ") - (goto-char (point-max)) - (should (eq (symbol-at-point) nil)) - (forward-char -1) - (should (eq (symbol-at-point) 'bar)))) - (ert-deftest test-symbol-thing-3 () (with-temp-buffer (insert "bar") (goto-char 2) (should (eq (symbol-at-point) 'bar)))) -(ert-deftest test-symbol-thing-3 () +(ert-deftest test-symbol-thing-4 () (with-temp-buffer (insert "`[[`(") (goto-char 2) diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 7943ac2ec26..9b7023d18b9 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -147,7 +147,7 @@ with parameters from the *Messages* buffer modification." (defmacro deftest-overlayp-1 (id arg-expr should-expr) (declare (indent 1)) - `(ert-deftest ,(buffer-tests--make-test-name 'overlay-buffer 1 id) () + `(ert-deftest ,(buffer-tests--make-test-name 'overlayp 1 id) () (with-temp-buffer (should (equal ,should-expr (overlayp ,arg-expr)))))) @@ -436,14 +436,14 @@ with parameters from the *Messages* buffer modification." (deftest-next-overlay-change-1 I 10 (point-max) (10 10)) (deftest-next-overlay-change-1 J 20 (point-max) (10 10)) ;; 2 non-empty, non-intersecting -(deftest-next-overlay-change-1 D 10 20 (20 30) (40 50)) -(deftest-next-overlay-change-1 E 35 40 (20 30) (40 50)) -(deftest-next-overlay-change-1 F 60 (point-max) (20 30) (40 50)) -(deftest-next-overlay-change-1 G 30 40 (20 30) (40 50)) -(deftest-next-overlay-change-1 H 50 (point-max) (20 30) (40 50)) +(deftest-next-overlay-change-1 D2 10 20 (20 30) (40 50)) +(deftest-next-overlay-change-1 E2 35 40 (20 30) (40 50)) +(deftest-next-overlay-change-1 F2 60 (point-max) (20 30) (40 50)) +(deftest-next-overlay-change-1 G2 30 40 (20 30) (40 50)) +(deftest-next-overlay-change-1 H2 50 (point-max) (20 30) (40 50)) ;; 2 non-empty, intersecting -(deftest-next-overlay-change-1 I 10 20 (20 30) (25 35)) -(deftest-next-overlay-change-1 J 20 25 (20 30) (25 35)) +(deftest-next-overlay-change-1 I2 10 20 (20 30) (25 35)) +(deftest-next-overlay-change-1 J2 20 25 (20 30) (25 35)) (deftest-next-overlay-change-1 K 23 25 (20 30) (25 35)) (deftest-next-overlay-change-1 L 25 30 (20 30) (25 35)) (deftest-next-overlay-change-1 M 28 30 (20 30) (25 35)) @@ -473,11 +473,11 @@ with parameters from the *Messages* buffer modification." (deftest-next-overlay-change-1 k 30 (point-max) (20 20) (20 30)) (deftest-next-overlay-change-1 l 40 (point-max) (20 20) (20 30)) ;; 1 empty, 1 non-empty, intersecting at end -(deftest-next-overlay-change-1 h 10 20 (30 30) (20 30)) -(deftest-next-overlay-change-1 i 20 30 (30 30) (20 30)) -(deftest-next-overlay-change-1 j 25 30 (30 30) (20 30)) -(deftest-next-overlay-change-1 k 30 (point-max) (20 20) (20 30)) -(deftest-next-overlay-change-1 l 40 (point-max) (20 20) (20 30)) +(deftest-next-overlay-change-1 h2 10 20 (30 30) (20 30)) +(deftest-next-overlay-change-1 i2 20 30 (30 30) (20 30)) +(deftest-next-overlay-change-1 j2 25 30 (30 30) (20 30)) +(deftest-next-overlay-change-1 k2 30 (point-max) (20 20) (20 30)) +(deftest-next-overlay-change-1 l2 40 (point-max) (20 20) (20 30)) ;; 1 empty, 1 non-empty, intersecting in the middle (deftest-next-overlay-change-1 m 10 20 (25 25) (20 30)) (deftest-next-overlay-change-1 n 20 25 (25 25) (20 30)) @@ -524,14 +524,14 @@ with parameters from the *Messages* buffer modification." (deftest-previous-overlay-change-1 I 10 1 (10 10)) (deftest-previous-overlay-change-1 J 20 10 (10 10)) ;; 2 non-empty, non-intersecting -(deftest-previous-overlay-change-1 D 10 1 (20 30) (40 50)) -(deftest-previous-overlay-change-1 E 35 30 (20 30) (40 50)) -(deftest-previous-overlay-change-1 F 60 50 (20 30) (40 50)) -(deftest-previous-overlay-change-1 G 30 20 (20 30) (40 50)) -(deftest-previous-overlay-change-1 H 50 40 (20 30) (40 50)) +(deftest-previous-overlay-change-1 D2 10 1 (20 30) (40 50)) +(deftest-previous-overlay-change-1 E2 35 30 (20 30) (40 50)) +(deftest-previous-overlay-change-1 F2 60 50 (20 30) (40 50)) +(deftest-previous-overlay-change-1 G2 30 20 (20 30) (40 50)) +(deftest-previous-overlay-change-1 H2 50 40 (20 30) (40 50)) ;; 2 non-empty, intersecting -(deftest-previous-overlay-change-1 I 10 1 (20 30) (25 35)) -(deftest-previous-overlay-change-1 J 20 1 (20 30) (25 35)) +(deftest-previous-overlay-change-1 I2 10 1 (20 30) (25 35)) +(deftest-previous-overlay-change-1 J2 20 1 (20 30) (25 35)) (deftest-previous-overlay-change-1 K 23 20 (20 30) (25 35)) (deftest-previous-overlay-change-1 L 25 20 (20 30) (25 35)) (deftest-previous-overlay-change-1 M 28 25 (20 30) (25 35)) @@ -621,28 +621,28 @@ with parameters from the *Messages* buffer modification." (deftest-overlays-at-1 P 50 () (a 10 20) (b 30 40)) ;; 2 non-empty overlays intersecting -(deftest-overlays-at-1 G 1 () (a 10 30) (b 20 40)) -(deftest-overlays-at-1 H 10 (a) (a 10 30) (b 20 40)) -(deftest-overlays-at-1 I 15 (a) (a 10 30) (b 20 40)) -(deftest-overlays-at-1 K 20 (a b) (a 10 30) (b 20 40)) -(deftest-overlays-at-1 L 25 (a b) (a 10 30) (b 20 40)) -(deftest-overlays-at-1 M 30 (b) (a 10 30) (b 20 40)) -(deftest-overlays-at-1 N 35 (b) (a 10 30) (b 20 40)) -(deftest-overlays-at-1 O 40 () (a 10 30) (b 20 40)) -(deftest-overlays-at-1 P 50 () (a 10 30) (b 20 40)) +(deftest-overlays-at-1 G2 1 () (a 10 30) (b 20 40)) +(deftest-overlays-at-1 H2 10 (a) (a 10 30) (b 20 40)) +(deftest-overlays-at-1 I2 15 (a) (a 10 30) (b 20 40)) +(deftest-overlays-at-1 K2 20 (a b) (a 10 30) (b 20 40)) +(deftest-overlays-at-1 L2 25 (a b) (a 10 30) (b 20 40)) +(deftest-overlays-at-1 M2 30 (b) (a 10 30) (b 20 40)) +(deftest-overlays-at-1 N2 35 (b) (a 10 30) (b 20 40)) +(deftest-overlays-at-1 O2 40 () (a 10 30) (b 20 40)) +(deftest-overlays-at-1 P2 50 () (a 10 30) (b 20 40)) ;; 2 non-empty overlays continuous -(deftest-overlays-at-1 G 1 () (a 10 20) (b 20 30)) -(deftest-overlays-at-1 H 10 (a) (a 10 20) (b 20 30)) -(deftest-overlays-at-1 I 15 (a) (a 10 20) (b 20 30)) -(deftest-overlays-at-1 K 20 (b) (a 10 20) (b 20 30)) -(deftest-overlays-at-1 L 25 (b) (a 10 20) (b 20 30)) -(deftest-overlays-at-1 M 30 () (a 10 20) (b 20 30)) +(deftest-overlays-at-1 G3 1 () (a 10 20) (b 20 30)) +(deftest-overlays-at-1 H3 10 (a) (a 10 20) (b 20 30)) +(deftest-overlays-at-1 I3 15 (a) (a 10 20) (b 20 30)) +(deftest-overlays-at-1 K3 20 (b) (a 10 20) (b 20 30)) +(deftest-overlays-at-1 L3 25 (b) (a 10 20) (b 20 30)) +(deftest-overlays-at-1 M3 30 () (a 10 20) (b 20 30)) ;; overlays-at never returns empty overlays. -(deftest-overlays-at-1 N 1 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) -(deftest-overlays-at-1 O 20 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) -(deftest-overlays-at-1 P 30 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) +(deftest-overlays-at-1 N3 1 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) +(deftest-overlays-at-1 O3 20 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) +(deftest-overlays-at-1 P3 30 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) (deftest-overlays-at-1 Q 40 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) (deftest-overlays-at-1 R 50 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50)) (deftest-overlays-at-1 S 60 () (a 1 60) (c 1 1) (b 30 30) (d 50 50)) @@ -1109,7 +1109,7 @@ with parameters from the *Messages* buffer modification." (should (eq ov (car (overlays-in 1 1))))))))) ;; properties -(ert-deftest test-buffer-swap-text-1 () +(ert-deftest test-buffer-swap-text-2 () (buffer-tests--with-temp-buffers (buffer other) (with-current-buffer other (overlay-put (make-overlay 1 1) 'buffer 'other)) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 756c41b6ff3..dfc12735bda 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -419,7 +419,7 @@ comparing the subr with a much slower Lisp implementation." "Test setting a keyword constant." (with-no-warnings (should-error (setq :keyword 'bob) :type 'setting-constant))) -(ert-deftest binding-test-set-constant-nil () +(ert-deftest binding-test-set-constant-itself () "Test setting a keyword to itself." (with-no-warnings (should (setq :keyword :keyword)))) @@ -690,7 +690,7 @@ comparing the subr with a much slower Lisp implementation." (let ((n (* 2 most-negative-fixnum))) (should (= (logand -1 n) n)))) -(ert-deftest data-tests-logcount () +(ert-deftest data-tests-logcount-2 () (should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128))) (ert-deftest data-tests-logior () From f8478dc133839fc9e2b395bef0c8e8f1d7d18b35 Mon Sep 17 00:00:00 2001 From: Filipp Gunbin Date: Thu, 18 Nov 2021 17:03:43 +0300 Subject: [PATCH 111/367] Fixup for bug#51037 * lisp/emacs-lisp/ert.el (ert-batch-backtrace-line-length): Fix docstring. (ert-run-tests-batch): Remove redundand let-binding. (ert-run-tests-interactively): Fix interactive spec. --- lisp/emacs-lisp/ert.el | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index dc9cbc47458..946193e40dc 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -101,12 +101,10 @@ produce extremely long lines in backtraces and lengthy delays in forming them. This variable governs the target maximum line length by manipulating these two variables while printing stack traces. Setting this variable to t will re-use the value of -`backtrace-line-length' while print stack traces in ERT batch -mode. A value of nil will short-circuit this mechanism; line -lengths will be completely determined by `ert-batch-line-length' -and `ert-batch-line-level'. Any other value will be temporarily -bound to `backtrace-line-length' when producing stack traces -in batch mode.") +`backtrace-line-length' while printing stack traces in ERT batch +mode. Any other value will be temporarily bound to +`backtrace-line-length' when producing stack traces in batch +mode.") (defface ert-test-result-expected '((((class color) (background light)) :background "green1") @@ -1451,13 +1449,9 @@ Returns the stats object." (message "Test %S backtrace:" (ert-test-name test)) (with-temp-buffer (let ((backtrace-line-length - (cond - ((eq ert-batch-backtrace-line-length t) - backtrace-line-length) - ((eq ert-batch-backtrace-line-length nil) - nil) - (t - ert-batch-backtrace-line-length))) + (if (eq ert-batch-backtrace-line-length t) + backtrace-line-length + ert-batch-backtrace-line-length)) (print-level ert-batch-print-level) (print-length ert-batch-print-length)) (insert (backtrace-to-string @@ -2062,8 +2056,7 @@ SELECTOR works as described in `ert-select-tests'." (read (completing-read (format-prompt "Run tests" default) obarray #'ert-test-boundp nil nil - 'ert--selector-history default nil))) - nil)) + 'ert--selector-history default nil))))) (let (buffer listener) (setq listener (lambda (event-type &rest event-args) From 6c1190c74936f132cb4173335cb037de89ef8aa7 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 18 Nov 2021 15:06:26 +0100 Subject: [PATCH 112/367] Extend abbreviate-file-name for further Tramp methods. * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add 'abbreviate-file-name'. (tramp-gvfs-handle-expand-file-name): * lisp/net/tramp.el (tramp-handle-expand-file-name): Handle case that tilde cannot be expanded. * test/lisp/net/tramp-tests.el (tramp-test07-abbreviate-file-name): Extend test. --- lisp/net/tramp-gvfs.el | 25 ++++++++++++------------- lisp/net/tramp.el | 9 ++++++--- test/lisp/net/tramp-tests.el | 5 ++++- 3 files changed, 22 insertions(+), 17 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index a4a7bacd8ac..ab71c9cd13f 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -744,7 +744,7 @@ It has been changed in GVFS 1.14.") ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-gvfs-file-name-handler-alist - '(;; `abbreviate-file-name' performed by default handler. + '((abbreviate-file-name . tramp-handle-abbreviate-file-name) (access-file . tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. @@ -1149,15 +1149,12 @@ file names." (make-tramp-file-name :method method :user user :domain domain :host host :port port :localname "/" :hop hop))) - (setq localname - (replace-match - (tramp-get-connection-property v "default-location" "~") - nil t localname 1))) - ;; Tilde expansion is not possible. - (when (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) - (tramp-error - v 'file-error - "Cannot expand tilde in file `%s'" name)) + (unless (string-empty-p + (tramp-get-connection-property v "default-location" "")) + (setq localname + (replace-match + (tramp-get-connection-property v "default-location" "~") + nil t localname 1)))) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; We do not pass "/..". @@ -1172,10 +1169,12 @@ file names." ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (tramp-run-real-handler #'expand-file-name (list localname)))))) + v (if (string-match-p "\\`~" localname) + localname + (tramp-run-real-handler #'expand-file-name (list localname))))))) (defun tramp-gvfs-get-directory-attributes (directory) "Return GVFS attributes association list of all files in DIRECTORY." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7927ddd1072..f43c1d84b87 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3454,13 +3454,16 @@ User is always nil." ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; Do normal `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. ;; `default-directory' is bound, because on Windows there would ;; be problems with UNC shares or Cygwin mounts. (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name - v (tramp-drop-volume-letter - (tramp-run-real-handler #'expand-file-name (list localname)))))))) + v (if (string-match-p "\\`~" localname) + localname + (tramp-drop-volume-letter + (tramp-run-real-handler #'expand-file-name (list localname))))))))) (defun tramp-handle-file-accessible-directory-p (filename) "Like `file-accessible-directory-p' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 482d3ff554f..98269d5fa39 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2295,7 +2295,10 @@ This checks also `file-name-as-directory', `file-name-directory', (skip-unless (tramp--test-emacs29-p)) (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory)) - (home-dir (expand-file-name (concat remote-host "~")))) + ;; Not all methods can expand "~". + (home-dir (ignore-errors (expand-file-name (concat remote-host "~"))))) + (skip-unless home-dir) + ;; Check home-dir abbreviation. (unless (string-suffix-p "~" home-dir) (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) From ce33ad8bae71b29d2561904e0c3ed68ff410c427 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Thu, 18 Nov 2021 13:24:30 +0200 Subject: [PATCH 113/367] Update modus-themes to version 1.7.0 * doc/misc/modus-themes.org (File): Use new version and add release date. (How do the themes look like, Learn about the latest changes): Update link to new URL. (Enable and load): Update text of internal reference. (Sample configuration for use-package): Add sample configuration without the 'use-package' infrastructure. (Differences between loading and enabling): Minor rewordings. (Customization Options): Update sample code to cover latest changes. (Option for inhibiting theme reload) (Option for color-coding success state (deuteranopia)) (Option for more bold constructs) (Option for more italic constructs) (Option for syntax highlighting) (Option for links) (Option for command prompt styles) (Option for mode line presentation) (Option for accented background in tab interfaces) (Option for completion framework aesthetics) (Option for mail citations) (Option for fringe visibility) (Option for language checkers) (Option for line highlighting (hl-line-mode)) (Option for line numbers (display-line-numbers-mode)) (Option for parenthesis matching (show-paren-mode)) (Option for active region) (Option for diff buffer looks) (Option for org-mode block styles) (Option for Org agenda constructs) (Option for scaled headings) (Control the scale of headings) (Option for variable-pitch font in UI elements) (Option for variable-pitch font in headings): Write brief description, document the type of the user option, and make any other relevant adjustments. (Option for font mixing): Document new 'modus-themes-mixed-fonts' user option, which supersedes the old 'modus-themes-no-mixed-fonts'. (Option for mode line padding): Document new user option 'modus-themes-mode-line-padding'. (Option for language checkers): Include new available property for the user option 'modus-themes-lang-checkers'. Reword the rest of the entry. (Option for intense markup in Org and others): Describe new boolean option 'modus-themes-intense-markup'. (Option for Org agenda constructs): Include new available property for the 'event' key in the alist 'modus-themes-org-agenda'. (Option for the headings' overall style): Describe the new style of explicitly specifying an optional font weight other than the implied bold. (Font configurations for Org and others (DIY)) (Configure bold and italic faces (DIY)): Reword and clarify some statements. (Decrease mode line height (DIY)): Add new Do-It-Yourself section on tweaking the mode line's :box attribute. (Full support for packages or face groups): Include new packages. (Acknowledgements): Update list of contributors to code, user feedback, etc. Does not affect the status of copyright assignment. (Meta): Update URLs to protesilaos.com (my website). * etc/themes/modus-themes.el (modus-themes-variable-pitch) (modus-themes-fixed-pitch, modus-themes-no-mixed-fonts): Reference the new 'modus-themes-mixed-fonts' user option. (modus-themes--headings-choice): Include new font weight styles. (modus-themes-headings): Document the new feature of accepting an explicit font weight. (modus-themes-org-agenda): Document the refinements to the 'event' key of the alist and the new 'varied' property it accepts. (modus-themes-lang-checkers): Describe the new 'faint' property. (modus-themes-mode-line-padding): Include new user option. (modus-themes-intense-hl-line): Remove old-deprecated user option. (modus-themes-intense-markup): Add new option. (modus-themes-success-deuteranopia): Update doc string. (modus-themes--fixed-pitch): Work with 'modus-themes-mixed-fonts'. (modus-themes--lang-check): Update internal function to add the 'faint' property of 'modus-themes-lang-checkers'. (modus-themes--markup): Add helper function. (modus-themes--heading-weights): Private variable with available font weights. (modus-themes--heading-weight): New helper function to pick the desired font weight. (modus-themes--heading): Update helper function to implement the aforementioned change to 'modus-themes-headings'. (modus-themes--agenda-event): Update helper function to apply the new styles of 'modus-themes-org-agenda'. (modus-themes--mode-line-padding): Add helper function for 'modus-themes-mode-line-padding'. (modus-themes--mode-line-attrs): Minor refinements. (modus-themes-load-operandi, modus-themes-load-vivendi): Make these functions interactive. (modus-themes-faces): Update faces. * etc/themes/modus-operandi-theme.el: Bump version number. * etc/themes/modus-vivendi-theme.el: Same. * * * A detailed change log entry is available here: . --- doc/misc/modus-themes.org | 577 ++++++++++++++++++++++------- etc/themes/modus-operandi-theme.el | 4 +- etc/themes/modus-themes.el | 470 +++++++++++++++-------- etc/themes/modus-vivendi-theme.el | 4 +- 4 files changed, 758 insertions(+), 297 deletions(-) diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 675144d5177..f3c2e37b7dd 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -5,9 +5,9 @@ #+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 1.6.0 -#+macro: release-date 2021-09-29 -#+macro: development-version 1.7.0-dev +#+macro: stable-version 1.7.0 +#+macro: release-date 2021-11-18 +#+macro: development-version 1.8.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -95,7 +95,7 @@ Emacs. :end: #+cindex: Screenshots -Check the web page with [[https://protesilaos.com/modus-themes-pictures/][the screen shots]]. There are lots of scenarios +Check the web page with [[https://protesilaos.com/emacs/modus-themes-pictures/][the screen shots]]. There are lots of scenarios on display that draw attention to details and important aspects in the design of the themes. They also showcase the numerous customization options. @@ -108,7 +108,7 @@ options. :end: #+cindex: Changelog -Please refer to the [[https://protesilaos.com/modus-themes-changelog][web page with the change log]]. It is comprehensive +Please refer to the [[https://protesilaos.com/emacs/modus-themes-changelog][web page with the change log]]. It is comprehensive and covers everything that goes into every tagged release of the themes. * Installation @@ -268,7 +268,7 @@ could look like: (define-key global-map (kbd "") #'modus-themes-toggle) #+end_src -[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration for use-package]]. +[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and without use-package]]. With those granted, bear in mind a couple of technical points on ~modus-themes-load-operandi~ and ~modus-themes-load-vivendi~, as well as @@ -283,11 +283,12 @@ With those granted, bear in mind a couple of technical points on wish to rely on such a hook and the functions that run it: they may prefer a custom solution ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]). -** Sample configuration for use-package +** Sample configuration with and without use-package :properties: :custom_id: h:e979734c-a9e1-4373-9365-0f2cd36107b8 :end: #+cindex: use-package configuration +#+cindex: sample configuration It is common for Emacs users to rely on ~use-package~ for declaring package configurations in their setup. We use this as an example: @@ -309,6 +310,25 @@ package configurations in their setup. We use this as an example: :bind ("" . modus-themes-toggle)) #+end_src +The same without ~use-package~: + +#+begin_src emacs-lisp +(require 'modus-themes) + +;; Add all your customizations prior to loading the themes +(setq modus-themes-italic-constructs t + modus-themes-bold-constructs nil + modus-themes-region '(bg-only no-extend)) + +;; Load the theme files before enabling a theme +(modus-themes-load-themes) + +;; Load the theme of your choice: +(modus-themes-load-operandi) ;; OR (modus-themes-load-vivendi) + +(define-key global-map (kbd "") #'modus-themes-toggle) +#+end_src + [[#h:e68560b3-7fb0-42bc-a151-e015948f8a35][Differences between loading and enabling]]. Note: make sure not to customize the variable ~custom-theme-load-path~ @@ -325,7 +345,7 @@ package declaration of the themes. The reason we recommend ~load-theme~ instead of the other option of ~enable-theme~ is that the former does a kind of "reset" on the face -specs. It quite literally loads (or re-loads) the theme. Whereas the +specs. It quite literally loads (or reloads) the theme. Whereas the latter simply puts an already loaded theme at the top of the list of enabled items, re-using whatever state was last loaded. @@ -352,7 +372,7 @@ session, are better off using something like this: (enable-theme 'modus-operandi) ;; OR (enable-theme 'modus-vivendi) #+end_src -[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration for use-package]]. +[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and without use-package]]. With the above granted, other sections of the manual discuss how to configure custom faces, where ~load-theme~ is expected, though @@ -372,7 +392,8 @@ without any further tweaks. By default, all customization options are set to nil, unless otherwise noted in this manual. Remember that all customization options must be evaluated before loading -a theme ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). +a theme ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). If the theme is already active, it must be +reloaded for changes in user options to come into force. Below is a summary of what you will learn in the subsequent sections of this manual. @@ -380,8 +401,9 @@ this manual. #+begin_src emacs-lisp (setq modus-themes-italic-constructs t modus-themes-bold-constructs nil - modus-themes-no-mixed-fonts nil + modus-themes-mixed-fonts nil modus-themes-subtle-line-numbers nil + modus-themes-intense-markup t modus-themes-success-deuteranopia t modus-themes-tabs-accented t modus-themes-inhibit-reload t ; only applies to `customize-set-variable' and related @@ -391,7 +413,7 @@ this manual. ;; Options for `modus-themes-lang-checkers' are either nil (the ;; default), or a list of properties that may include any of those ;; symbols: `straight-underline', `text-also', `background', - ;; `intense' + ;; `intense' OR `faint'. modus-themes-lang-checkers nil ;; Options for `modus-themes-mode-line' are either nil, or a list @@ -399,6 +421,10 @@ this manual. ;; `accented', `padded'. modus-themes-mode-line '(padded accented borderless) + ;; This one only works when `modus-themes-mode-line' (above) has + ;; the `padded' property. It takes a positive integer. + modus-themes-mode-line-padding 3 + ;; Options for `modus-themes-syntax' are either nil (the default), ;; or a list of properties that may include any of those symbols: ;; `faint', `yellow-comments', `green-strings', `alt-syntax' @@ -450,7 +476,7 @@ this manual. modus-themes-headings ; this is an alist: read the manual or its doc string '((1 . (overline background)) (2 . (rainbow overline)) - (t . (no-bold))) + (t . (semibold))) modus-themes-variable-pitch-ui nil modus-themes-variable-pitch-headings t @@ -470,7 +496,10 @@ this manual. :end: #+vindex: modus-themes-inhibit-reload -Symbol: ~modus-themes-inhibit-reload~ +Brief: Toggle reloading of the active theme when an option is changed +through the Customize UI. + +Symbol: ~modus-themes-inhibit-reload~ (=boolean= type) Possible values: @@ -483,6 +512,9 @@ currently active Modus theme. Enable this behaviour by setting this variable to ~nil~. +Regardless of this option, the active theme must be reloaded for changes +to user options to take effect ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). + ** Option for color-coding success state (deuteranopia) :properties: :alt_title: Success' color-code @@ -491,25 +523,27 @@ Enable this behaviour by setting this variable to ~nil~. :end: #+vindex: modus-themes-success-deuteranopia -Symbol: ~modus-themes-success-deuteranopia~ +Brief: Toggle the use of blue instead of green in places which +color-code green as "success" and red as "failure". + +Symbol: ~modus-themes-success-deuteranopia~ (=boolean= type) Possible values: 1. ~nil~ (default) 2. ~t~ -The default is to colorise all faces that denote "success", "done", or -similar with a variant of green. +The default is to colorise a passing state in a green hue. This affects +all faces that denote "success", "done", marking a selection as opposed +to marking for deletion, the current search match in contrast to lazily +highlighted ones, and the like. With a non-nil value (~t~), use variants of blue instead of green. This is meant to empower users with red-green color deficiency. -The present customization option should apply to all contexts where -there can be a color-coded distinction between success and failure, -to-do and done, and so on. - -Diffs, which have a red/green dichotomy by default, can also be -configured to conform with deuteranopia. +Diffs, which rely on a red/green dichotomy by default, can also be +configured to meet the needs of users with deuteranopia via the option +~modus-themes-diffs~. [[#h:ea7ac54f-5827-49bd-b09f-62424b3b6427][Option for diff buffer looks]]. @@ -521,7 +555,9 @@ configured to conform with deuteranopia. :end: #+vindex: modus-themes-bold-constructs -Symbol: ~modus-themes-bold-constructs~ +Brief: Use bold for code syntax highlighting and related. + +Symbol: ~modus-themes-bold-constructs~ (=boolean= type) Possible values: @@ -549,7 +585,9 @@ Advanced users may also want to configure the exact attributes of the :end: #+vindex: modus-themes-italic-constructs -Symbol: ~modus-themes-italic-constructs~ +Brief: Use italics for code syntax highlighting and related. + +Symbol: ~modus-themes-italic-constructs~ (=boolean= type) Possible values: @@ -575,7 +613,9 @@ Advanced users may also want to configure the exact attributes of the :end: #+vindex: modus-themes-syntax -Symbol: ~modus-themes-syntax~ +Brief: Set the overall style of code syntax highlighting. + +Symbol: ~modus-themes-syntax~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: @@ -629,36 +669,41 @@ weight or italic text: ~modus-themes-bold-constructs~ and [[#h:977c900d-0d6d-4dbb-82d9-c2aae69543d6][Option for more italic constructs]]. -** Option for no font mixing +** Option for font mixing :properties: -:alt_title: No mixed fonts +:alt_title: Mixed fonts :description: Toggle mixing of font families :custom_id: h:115e6c23-ee35-4a16-8cef-e2fcbb08e28b :end: -#+vindex: modus-themes-no-mixed-fonts +#+vindex: modus-themes-mixed-fonts -Symbol: ~modus-themes-no-mixed-fonts~ +Brief: Toggle the use of monospaced fonts for spacing-sensitive +constructs (affects font families). + +Symbol: ~modus-themes-mixed-fonts~ (=boolean= type) Possible values: 1. ~nil~ (default) 2. ~t~ -By default, the themes configure some spacing-sensitive faces like Org +When set to non-nil (~t~), configure some spacing-sensitive faces like Org tables and code blocks to always inherit from the ~fixed-pitch~ face. -This is to ensure that those constructs remain monospaced even when -users opt for a mode that remaps typeface families, such as the built-in -{{{kbd(M-x variable-pitch-mode)}}}. Otherwise the layout would appear -broken, due to how spacing is done. To disable this behaviour, set the -option to ~t~. +This is to ensure that certain constructs like code blocks and tables +remain monospaced even when users opt for a mode that remaps typeface +families, such as the built-in {{{kbd(M-x variable-pitch-mode)}}}. Otherwise +the layout would appear broken, due to how spacing is done. -Users may prefer to use another package for handling mixed typeface -configurations, rather than letting the theme do it, perhaps because a -purpose-specific package has extra functionality. Two possible options -are ~org-variable-pitch~ and ~mixed-pitch~. +For a consistent experience, user may need to specify the font family of +the ~fixed-pitch~ face. [[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. +Furthermore, users may prefer to use another package for handling mixed +typeface configurations, rather than letting the theme do it, perhaps +because a purpose-specific package has extra functionality. Two +possible options are ~org-variable-pitch~ and ~mixed-pitch~. + ** Option for links :properties: :alt_title: Link styles @@ -667,7 +712,9 @@ are ~org-variable-pitch~ and ~mixed-pitch~. :end: #+vindex: modus-themes-links -Symbol: ~modus-themes-links~ +Brief: Control the style of links to web pages, files, buffers... + +Symbol: ~modus-themes-links~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: @@ -738,7 +785,10 @@ their documentation strings. :end: #+vindex: modus-themes-prompts -Symbol: ~modus-themes-prompts~ +Brief: Control the style of command prompts (e.g. minibuffer, shell, IRC +clients). + +Symbol: ~modus-themes-prompts~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: @@ -794,7 +844,9 @@ In user configuration files the form may look like this: :end: #+vindex: modus-themes-mode-line -Symbol: ~modus-themes-mode-line~ +Brief: Control the style of the mode lines. + +Symbol: ~modus-themes-mode-line~ (=choice= type, list of properties) Possible values, which can be expressed as a list of combinations of box effect, color, and border visibility: @@ -836,7 +888,10 @@ This is done by applying box effects and combining them with an underline and overline. To ensure that the underline is placed at the bottom, set ~x-underline-at-descent-line~ to non-nil. The ~padded~ property has no effect when the ~moody~ property is also used, because Moody -already applies its own padding. +already applies its own padding. The exact value of the padding is +controlled by the variable ~modus-themes-mode-line-padding~. + +[[#h:a12b4d3c-e66b-42ed-99ab-4ea039b69e2e][Option for mode line padding]]. Combinations of any of those properties are expressed as a list, like in these examples: @@ -877,6 +932,28 @@ Furthermore, because Moody expects an underline and overline instead of a box style, it is advised to set ~x-underline-at-descent-line~ to a non-nil value. +Finally, note that various packages which heavily modify the mode line, +such as =doom-modeline=, =nano-modeline=, =powerline=, =spaceline= may not look +as intended with all possible combinations of this user option. + +*** Option for mode line padding +:properties: +:custom_id: h:a12b4d3c-e66b-42ed-99ab-4ea039b69e2e +:end: +#+vindex: modus-themes-mode-line-padding + +Brief: Set the padding of the mode lines. + +Symbol: ~modus-themes-mode-line-padding~ (=natnum= type) + +Controls the exact width of the mode line's padding. Possible values +are positive integers. The default value is =6=. + +This customization option applies only when ~modus-themes-mode-line~ is +configured with the ~padded~ property. + +[[#h:27943af6-d950-42d0-bc23-106e43f50a24][Option for mode line presentation]]. + ** Option for accented background in tab interfaces :properties: :alt_title: Tab style @@ -885,7 +962,9 @@ non-nil value. :end: #+vindex: modus-themes-tabs-accented -Symbol: ~modus-themes-tabs-accented~ +Brief: Toggle accent colors for tabbed interfaces. + +Symbol: ~modus-themes-tabs-accented~ (=boolean= type) Possible values: @@ -906,7 +985,9 @@ Centaur tabs package. :end: #+vindex: modus-themes-completions -Symbol: ~modus-themes-completions~ +Brief: Set the overall style of completion framework interfaces. + +Symbol: ~modus-themes-completions~ (=choice= type) Possible values: @@ -951,7 +1032,10 @@ possibilities. :end: #+vindex: modus-themes-mail-citations -Symbol: ~modus-themes-mail-citations~ +Brief: Set the overall style of citations/quotes when composing +emails. + +Symbol: ~modus-themes-mail-citations~ (=choice= type) Possible values: @@ -980,7 +1064,9 @@ not touch. :end: #+vindex: modus-themes-fringes -Symbol: ~modus-themes-fringes~ +Brief: Control the overall coloration of the fringes. + +Symbol: ~modus-themes-fringes~ (=choice= type) Possible values: @@ -1004,7 +1090,10 @@ names imply. :end: #+vindex: modus-themes-lang-checkers -Symbol: ~modus-themes-lang-checkers~ +Brief: Control the style of in-buffer warnings and errors produced by +spell checkers, code linters, and the like. + +Symbol: ~modus-themes-lang-checkers~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: @@ -1012,7 +1101,9 @@ an empty list). The list can include any of the following symbols: + ~straight-underline~ + ~text-also~ + ~background~ -+ ~intense~ ++ Overall coloration: + - ~intense~ + - ~faint~ The default (a ~nil~ value or an empty list) applies a color-coded underline to the affected text, while it leaves the original foreground @@ -1028,15 +1119,15 @@ affected text. The property ~background~ adds a color-coded background. The property ~intense~ amplifies the applicable colors if ~background~ -and/or ~text-only~ are set. If ~intense~ is set on its own, then it implies -~text-only~. +and/or ~text-also~ are set. If ~intense~ is set on its own, then it implies +~text-also~. -To disable fringe indicators for Flymake or Flycheck, refer to variables -~flymake-fringe-indicator-position~ and ~flycheck-indication-mode~, -respectively. +The property ~faint~ uses nuanced colors for the underline and for the +foreground when ~text-also~ is included. If both ~faint~ and ~intense~ are +specified, the former takes precedence. -Combinations of any of those properties can be expressed in a -list, as in those examples: +Combinations of any of those properties can be expressed in a list, as +in those examples: #+begin_src emacs-lisp (background) @@ -1056,6 +1147,10 @@ NOTE: The placement of the straight underline, though not the wave style, is controlled by the built-in variables ~underline-minimum-offset~, ~x-underline-at-descent-line~, ~x-use-underline-position-properties~. +To disable fringe indicators for Flymake or Flycheck, refer to variables +~flymake-fringe-indicator-position~ and ~flycheck-indication-mode~, +respectively. + ** Option for line highlighting (hl-line-mode) :properties: :alt_title: Line highlighting @@ -1064,7 +1159,9 @@ style, is controlled by the built-in variables ~underline-minimum-offset~, :end: #+vindex: modus-themes-hl-line -Symbol: ~modus-themes-hl-line~ +Brief: Control the style of the current line of ~hl-line-mode~. + +Symbol: ~modus-themes-hl-line~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: @@ -1116,7 +1213,9 @@ This style affects several packages that enable ~hl-line-mode~, such as :end: #+vindex: modus-themes-subtle-line-numbers -Symbol: ~modus-themes-subtle-line-numbers~ +Brief: Toggle subtle line numbers. + +Symbol: ~modus-themes-subtle-line-numbers~ (=boolean= type) Possible value: @@ -1137,6 +1236,30 @@ Instead they retain the primary background of the theme, blending with the rest of the buffer. Foreground values for all relevant faces are updated to accommodate this aesthetic. +** Option for intense markup in Org and others +:properties: +:alt_title: Intense markup +:description: Toggle intense style for markup in Org and others +:custom_id: h:9d9a4e64-99ac-4018-8f66-3051b9c43fd7 +:end: +#+vindex: modus-themes-intense-markup + +Brief: Toggle intense style for inline code and related markup. + +Symbol: ~modus-themes-intense-markup~ (=boolean= type) + +Possible value: + +1. ~nil~ (default) +2. ~t~ + +The default style for certain markup types like inline code and verbatim +constructs in Org and related major modes is a subtle foreground color +combined with a subtle background. + +With a non-nil value (~t~), these constructs will use a more prominent +background and foreground color combination instead. + ** Option for parenthesis matching (show-paren-mode) :properties: :alt_title: Matching parentheses @@ -1145,7 +1268,10 @@ updated to accommodate this aesthetic. :end: #+vindex: modus-themes-paren-match -Symbol: ~modus-themes-paren-match~ +Brief: Control the style of matching delimiters produced by +~show-paren-mode~. + +Symbol: ~modus-themes-paren-match~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: @@ -1192,7 +1318,9 @@ This customization variable affects the built-in ~show-paren-mode~ and the :end: #+vindex: modus-themes-region -Symbol: ~modus-themes-region~ +Brief: Control the style of the region. + +Symbol: ~modus-themes-region~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: @@ -1238,7 +1366,9 @@ In user configuration files the form may look like this: :end: #+vindex: modus-themes-diffs -Symbol: ~modus-themes-diffs~ +Bried: Set the overall style of diffs. + +Symbol: ~modus-themes-diffs~ (=choice= type) Possible values: @@ -1284,7 +1414,9 @@ interest of backward compatibility. :end: #+vindex: modus-themes-org-blocks -Symbol: ~modus-themes-org-blocks~ +Brief: Set the overall style of Org code blocks, quotes, and the like. + +Symbol: ~modus-themes-org-blocks~ (=choice= type) Possible values: @@ -1325,7 +1457,10 @@ and ~rainbow~. Those will continue to work as they are aliases for :end: #+vindex: modus-themes-org-agenda -Symbol: ~modus-themes-org-agenda~ +Brief: Control the style of the Org agenda. Multiple parameters are +available, each with its own options. + +Symbol: ~modus-themes-org-agenda~ (=alist= type, multiple styles) This is an alist that accepts a =(key . value)= combination. Some values are specified as a list. Here is a sample, followed by a description of @@ -1335,7 +1470,7 @@ all possible combinations: (setq modus-themes-org-agenda '((header-block . (variable-pitch scale-title)) (header-date . (grayscale workaholic bold-today)) - (event . (accented scale-small)) + (event . (accented italic varied)) (scheduled . uniform) (habit . traffic-light))) #+end_src @@ -1394,28 +1529,41 @@ For example: (header-date . (grayscale workaholic bold-today scale-heading)) #+end_src -An ~event~ key covers events from the diary and other entries that derive -from a symbolic expression or sexp (e.g. phases of the moon, holidays). -This key accepts a list of values. By default (a nil value or an empty -list) those have a gray foreground, while sexp events are additionally -presented using slanted text (italics). The properties that can form a -list of possible values are: +An ~event~ key covers (i) headings with a plain time stamp that are +shown on the agenda, also known as events, (ii) entries imported from +the diary, and (iii) other items that derive from a symbolic expression +or sexp (phases of the moon, holidays, etc.). By default all those look +the same and have a subtle foreground color (the default is a nil value +or an empty list). This key accepts a list of properties. Those are: -- ~scale-small~ reduces the height of the entries to the value of the user - option ~modus-themes-scale-small~ (0.9 the height of the main font size - by default). -- ~accented~ applies an accent value to the event's foreground, replacing - the original gray. +- ~scale-small~ reduces the height of the entries to the value of + the user option ~modus-themes-scale-small~ (0.9 the height of + the main font size by default). This work best when the + relevant entries have no tags associated with them and when the + user is interested in reducing their presence in the agenda + view. +- ~accented~ applies an accent value to the event's foreground, + replacing the original gray. It makes all entries stand out more. - ~italic~ adds a slant to the font's forms (italic or oblique forms, depending on the typeface). +- ~varied~ differentiates between events with a plain time stamp and + entries that are generated from either the diary or a symbolic + expression. It generally puts more emphasis on events. When ~varied~ + is combined with ~accented~, it makes only events use an accent color, + while diary/sexp entries retain their original subtle foreground. + When ~varied~ is used in tandem with ~italic~, it applies a slant only + to diary and sexp entries, not events. And when ~varied~ is the sole + property passed to the ~event~ key, it has the same meaning as the + list (italic varied). The combination of ~varied~, ~accented~, + ~italic~ covers all of the aforementioned cases. For example: #+begin_src emacs-lisp (event . nil) -(event . (scale-small)) -(event . (scale-small accented)) -(event . (scale-small accented italic)) +(event . (italic)) +(event . (accented italic)) +(event . (accented italic varied)) #+end_src A ~scheduled~ key applies to tasks with a scheduled date. By default (a @@ -1498,7 +1646,10 @@ Putting it all together, the alist can look like this: :end: #+vindex: modus-themes-headings -Symbol: ~modus-themes-headings~ +Brief: Control the style of headings. This can be particularised for +each level of heading (e.g. Org has eight levels). + +Symbol: ~modus-themes-headings~ (=alist= type, multiple properties) This is an alist that accepts a =(key . list-of-values)= combination. The key is either a number, representing the heading's level or ~t~, which @@ -1518,8 +1669,21 @@ Properties: + ~rainbow~ + ~overline~ + ~background~ -+ ~no-bold~ + ~monochrome~ ++ A font weight, which must be supported by the underlying typeface: + - ~thin~ + - ~ultralight~ + - ~extralight~ + - ~light~ + - ~semilight~ + - ~regular~ + - ~medium~ + - ~semibold~ + - ~bold~ + - ~heavy~ + - ~extrabold~ + - ~ultrabold~ ++ ~no-bold~ By default (a ~nil~ value for this variable), all headings have a bold typographic weight and use a desaturated text color. @@ -1531,20 +1695,27 @@ An ~overline~ property draws a line above the area of the heading. A ~background~ property adds a subtle tinted color to the background of the heading. -A ~no-bold~ property removes the bold weight from the heading's text. - A ~monochrome~ property makes all headings the same base color, which is that of the default for the active theme (black/white). When ~background~ is also set, ~monochrome~ changes its color to gray. If both ~monochrome~ and ~rainbow~ are set, the former takes precedence. +The symbol of a weight attribute adjusts the font of the heading +accordingly, such as ~light~, ~semibold~, etc. Valid symbols are defined in +the internal variable ~modus-themes--heading-weights~. The absence of a +weight means that bold will be used by virtue of inheriting the ~bold~ +face. For backward compatibility, the ~no-bold~ value is accepted, though +users are encouraged to specify a ~regular~ weight instead. + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. + Combinations of any of those properties are expressed as a list, like in these examples: #+begin_src emacs-lisp -(no-bold) +(semibold) (rainbow background) -(overline monochrome no-bold) +(overline monochrome semibold) #+end_src The order in which the properties are set is not significant. @@ -1555,7 +1726,7 @@ In user configuration files the form may look like this: (setq modus-themes-headings '((1 . (background overline rainbow)) (2 . (background overline)) - (t . (overline no-bold)))) + (t . (overline semibold)))) #+end_src When defining the styles per heading level, it is possible to pass a @@ -1570,7 +1741,7 @@ original aesthetic for that level. For example: (setq modus-themes-headings '((1 . (background overline)) - (2 . (rainbow no-bold)) + (2 . (rainbow semibold)) (t . t))) ; default style for all other levels #+end_src @@ -1591,7 +1762,9 @@ others, such as ~org-fontify-done-headline~. :end: #+vindex: modus-themes-scale-headings -Symbol: ~modus-themes-scale-headings~ +Brief: Toggle the scaling of headings. + +Symbol: ~modus-themes-scale-headings~ (=boolean= type) Possible values: @@ -1610,6 +1783,17 @@ main text. This is noticeable in modes like Org, Markdown, and Info. :custom_id: h:6868baa1-beba-45ed-baa5-5fd68322ccb3 :end: +Brief: Specify the height for individual heading scales. + +Symbols (all are =number= type): + ++ ~modus-themes-scale-1~ ++ ~modus-themes-scale-2~ ++ ~modus-themes-scale-3~ ++ ~modus-themes-scale-4~ ++ ~modus-themes-scale-title~ ++ ~modus-themes-scale-small~ + In addition to the toggle for enabling scaled headings, users can also specify a number of their own. @@ -1681,7 +1865,10 @@ size of the heading, but not of keywords that were added to it, like :end: #+vindex: modus-themes-variable-pitch-ui -Symbol: ~modus-themes-variable-pitch-ui~ +Brief: Toggle the use of proportionately spaced (~variable-pitch~) fonts +in the User Interface. + +Symbol: ~modus-themes-variable-pitch-ui~ (=boolean= type) Possible values: @@ -1708,7 +1895,10 @@ is done by assigning the ~variable-pitch~ face to the relevant items. :end: #+vindex: modus-themes-variable-pitch-headings -Symbol: ~modus-themes-variable-pitch-headings~ +Brief: Toggle the use of proportionately spaced (~variable-pitch~) fonts +in headings. + +Symbol: ~modus-themes-variable-pitch-headings~ (=boolean= type) Possible values: @@ -2460,17 +2650,16 @@ inspiration from the ~modus-themes-toggle~ we already provide: :end: #+cindex: Font configurations -The themes are designed to cope well with mixed font configurations. +The themes are designed to optionally cope well with mixed font +configurations. This mostly concerns ~org-mode~ and ~markdown-mode~, though +expect to find it elsewhere like in ~Info-mode~. -[[#h:115e6c23-ee35-4a16-8cef-e2fcbb08e28b][Option for no font mixing]]. - -This mostly concerns ~org-mode~ and ~markdown-mode~, though expect to find -it elsewhere like in ~Info-mode~. +[[#h:115e6c23-ee35-4a16-8cef-e2fcbb08e28b][Option for font mixing]]. In practice it means that the user can safely opt for a more prose-friendly proportionately spaced typeface as their default, while -letting spacing-sensitive elements like tables and inline code always -use a monospaced font, by inheriting from the ~fixed-pitch~ face. +spacing-sensitive elements like tables and inline code always use a +monospaced font, by inheriting from the ~fixed-pitch~ face. Users can try the built-in {{{kbd(M-x variable-pitch-mode)}}} to see the effect in action. @@ -2491,7 +2680,14 @@ reading the doc string of ~set-face-attribute~): (set-face-attribute 'variable-pitch nil :family "DejaVu Serif" :height 1.0) ;; Monospaced typeface -(set-face-attribute 'fixed-pitch nil :family "DejaVu Sans Mono" :height 1.0) +(set-face-attribute 'fixed-pitch nil :family "DejaVu Sans Mono" :height 1.5) +#+end_src + +Or employ the ~face-attribute~ function to read an existing value, such as +if you want to make ~fixed-pitch~ use the font family of the ~default~ face: + +#+begin_src emacs-lisp +(set-face-attribute 'fixed-pitch nil :family (face-attribute 'default :family)) #+end_src The next section shows how to make those work in a more elaborate setup @@ -2504,12 +2700,13 @@ specify an absolute value, which is the point size × 10. So if you want to use a font at point size =11=, you set the height to =110=.[fn:: ~:height~ values do not need to be rounded to multiples of ten: the likes of =115= are perfectly valid—some typefaces will change to account for those -finer increments.] Whereas every other face must have a value that is -relative to the default, represented as a floating point (if you use an -integer, then that means an absolute height). This is of paramount -importance: it ensures that all fonts can scale gracefully when using -something like the ~text-scale-adjust~ command which only operates on the -base font size (i.e. the ~default~ face's absolute height). +finer increments.] Whereas every other face must either not specify a +height or have a value that is relative to the default, represented as a +floating point. If you use an integer, then that means an absolute +height. This is of paramount importance: it ensures that all fonts can +scale gracefully when using something like the ~text-scale-adjust~ command +which only operates on the base font size (i.e. the ~default~ face's +absolute height). [[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts (SHR fonts)]]. @@ -2545,7 +2742,7 @@ it means for a construct to be bold/italic, by tweaking the ~bold~ and To achieve those effects, one must first be sure that the fonts they use have support for those features. It then is a matter of following the -instructions for all face tweaks. +instructions for all typeface tweaks. [[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. @@ -2573,19 +2770,20 @@ To reset the font family, one can use this: To ensure that the effects persist after switching between the Modus themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to -write their configurations to a function and hook it up to the -~modus-themes-after-load-theme-hook~. This is necessary because the -themes set the default styles of faces (otherwise changing themes would -not be possible). +write their configurations to a function and pass it to the +~modus-themes-after-load-theme-hook~. This is necessary because themes +set the styles of faces upon activation, overriding prior values where +conflicts occur between the previous and the current states (otherwise +changing themes would not be possible). [[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]. This is a minimal setup to preserve font configurations across theme -load phases. For a more permanent setup, it is better to employ the +load phases. For a more permanent setup, it is better to rely on the ~custom-set-faces~ function: ~set-face-attribute~ works just fine, though it -is more convenient for quick previews or for smaller scale operations -(~custom-set-faces~ follows the format used in the source code of the -themes). +probably is better suited for quick previews or for smaller scale +operations (~custom-set-faces~ follows the format used in the source code +of the themes, which can make it easier to redefine faces in bulk). #+begin_src emacs-lisp ;; our generic function @@ -2605,6 +2803,8 @@ themes). (add-hook 'modus-themes-after-load-theme-hook #'my-modes-themes-bold-italic-faces) #+end_src +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. + ** Custom Org user faces (DIY) :properties: :custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad @@ -2897,6 +3097,101 @@ With those in place, PDFs have a distinct backdrop for their page, while they automatically switch to their dark mode when ~modus-themes-toggle~ is called from inside a buffer whose major-mode is ~pdf-view-mode~. +** Decrease mode line height (DIY) +:properties: +:custom_id: h:03be4438-dae1-4961-9596-60a307c070b5 +:end: +#+cindex: Decrease mode line height + +By default, the mode line of the Modus themes is set to 1 pixel width +for its =:box= attribute. In contrast, the mode line of stock Emacs is -1 +pixel. This small difference is considered necessary for the purposes +of accessibility as our out-of-the-box design has a prominent color +around the mode line (a border) to make its boundaries clear. With a +negative width the border and the text on the mode line can feel a bit +more difficult to read under certain scenaria. + +Furthermore, the user option ~modus-themes-mode-line~ ([[#h:27943af6-d950-42d0-bc23-106e43f50a24][Mode line]]) does not +allow for such a negative value because there are many edge cases that +simply make for a counter-intuitive set of possibilities, such as a =0= +value not being acceptable by the underlying face infrastructure, and +negative values greater than =-2= not being particularly usable. + +For these reasons, users who wish to decrease the overall height of the +mode line must handle things on their own by implementing the methods +for face customization documented herein. + +[[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Basic face customization]]. + +One such method is to create a function that configures the desired +faces and hook it to ~modus-themes-after-load-theme-hook~ so that it +persists while switching between the Modus themes with the command +~modus-themes-toggle~. + +This one simply disables the box altogether, which will reduce the +height of the mode lines, but also remove their border: + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (set-face-attribute 'mode-line nil :box nil) + (set-face-attribute 'mode-line-inactive nil :box nil)) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +#+end_src + +The above relies on the ~set-face-attribute~ function, though users who +plan to re-use colors from the theme and do so at scale are better off +with the more streamlined combination of the ~modus-themes-with-colors~ +macro and ~custom-set-faces~. + +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face customization at scale]]. + +As explained before in this document, this approach has a syntax that is +consistent with the source code of the themes, so it probably is easier +to re-use parts of the design. + +The following emulates the stock Emacs style, while still using the +colors of the Modus themes (whichever attribute is not explicitly stated +is inherited from the underlying theme): + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (modus-themes-with-colors + (custom-set-faces + `(mode-line ((,class :box (:line-width -1 :style released-button)))) + `(mode-line-inactive ((,class :box (:line-width -1 :color ,bg-region))))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +#+end_src + +And this one is like the out-of-the-box style of the Modus themes, but +with the -1 height instead of 1: + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (modus-themes-with-colors + (custom-set-faces + `(mode-line ((,class :box (:line-width -1 :color ,fg-alt)))) + `(mode-line-inactive ((,class :box (:line-width -1 :color ,bg-region))))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +#+end_src + +Finally, to also change the background color of the active mode line, +such as that it looks like the "accented" variant which is possible via +the user option ~modus-themes-mode-line~, the =:background= attribute needs +to be specified as well: + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (modus-themes-with-colors + (custom-set-faces + `(mode-line ((,class :box (:line-width -1 :color ,fg-alt) :background ,bg-active-accent))) + `(mode-line-inactive ((,class :box (:line-width -1 :color ,bg-region))))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +#+end_src + ** A theme-agnostic hook for theme loading (DIY) :properties: :custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776 @@ -3121,6 +3416,7 @@ have lots of extensions, so the "full support" may not be 100% true… + ido-mode + iedit + iflipb ++ image-dired + imenu-list + indium + info @@ -3162,6 +3458,7 @@ have lots of extensions, so the "full support" may not be 100% true… + mu4e + mu4e-conversation + multiple-cursors ++ nano-modeline + neotree + no-emoji + notmuch @@ -3263,6 +3560,7 @@ have lots of extensions, so the "full support" may not be 100% true… + vc-annotate (the output of {{{kbd(C-x v g)}}}) + vdiff + vertico ++ vertico-quick + vimish-fold + visible-mark + visual-regexp @@ -3314,7 +3612,6 @@ supported by the themes. + tide + vertico-indexed + vertico-mouse -+ vertico-quick * Notes on individual packages :properties: @@ -4219,7 +4516,7 @@ The source code of the themes is [[https://gitlab.com/protesilaos/modus-themes/] being. A [[https://github.com/protesilaos/modus-themes/][mirror on Github]] is also on offer. An HTML version of this manual is provided as an extension of the -[[https://protesilaos.com/modus-themes/][author's personal website]] (does not rely on any non-free code). +[[https://protesilaos.com/emacs/modus-themes/][author's personal website]] (does not rely on any non-free code). ** Issues you can help with :properties: @@ -4323,11 +4620,11 @@ The Modus themes are a collective effort. Every bit of work matters. + Author/maintainer :: Protesilaos Stavrou. + Contributions to code or documentation :: Anders Johansson, Basil - L.{{{space()}}} Contovounesios, Carlo Zancanaro, Eli Zaretskii, Fritz Grabo, - Kévin Le Gouguec, Kostadin Ninev, Madhavan Krishnan, Markus Beppler, - Matthew Stevenson, Mauro Aranda, Nicolas De Jaeghere, Philip - Kaludercic, Rudolf Adamkovič, Stephen Gildea, Shreyas Ragavan, Stefan - Kangas, Vincent Murphy, Xinglu Chen. + L.{{{space()}}} Contovounesios, Carlo Zancanaro, Christian Tietze, Daniel + Mendler, Eli Zaretskii, Fritz Grabo, Kévin Le Gouguec, Kostadin Ninev, + Madhavan Krishnan, Markus Beppler, Matthew Stevenson, Mauro Aranda, + Nicolas De Jaeghere, Philip Kaludercic, Rudolf Adamkovič, Stephen + Gildea, Shreyas Ragavan, Stefan Kangas, Vincent Murphy, Xinglu Chen. + Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers, Adrian Manea, Alex Griffin, Alex Peitsinis, Alexey Shmalko, Alok @@ -4336,19 +4633,20 @@ The Modus themes are a collective effort. Every bit of work matters. Dimech, Damien Cassou, Daniel Mendler, Dario Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Eliraz Kedmi, Emanuele Michele Alberto Monterosso, Farasha Euker, Feng Shu, Gautier Ponsinet, Gerry - Agbobada, Gianluca Recchia, Gustavo Barros, Hörmetjan Yiltiz, Ilja - Kocken, Iris Garcia, Jeremy Friesen, Jerry Zhang, John Haman, Joshua - O'Connor, Kevin Fleming, Kévin Le Gouguec, Kostadin Ninev, Len Trigg, - Manuel Uberti, Mark Burton, Markus Beppler, Mauro Aranda, Michael - Goldenberg, Morgan Smith, Murilo Pereira, Nicky van Foreest, Nicolas - De Jaeghere, Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, - Philip Kaludercic, Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, - Rudolf Adamkovič, Sam Kleinman, Shreyas Ragavan, Simon Pugnet, Tassilo - Horn, Thibaut Verron, Thomas Heartman, Trey Merkley, Togan Muftuoglu, - Toon Claes, Uri Sharf, Utkarsh Singh, Vincent Foley. As well as - users: Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, - Moesasji, Nick, TheBlob42, Trey, bepolymathe, doolio, fleimgruber, - iSeeU, jixiuf, okamsn, pRot0ta1p. + Agbobada, Gianluca Recchia, Guilherme Semente, Gustavo Barros, + Hörmetjan Yiltiz, Ilja Kocken, Iris Garcia, Jeremy Friesen, Jerry + Zhang, Johannes Grødem, John Haman, Joshua O'Connor, Kevin Fleming, + Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Manuel Uberti, Mark + Burton, Markus Beppler, Mauro Aranda, Michael Goldenberg, Morgan + Smith, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Paul + Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic, + Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, Rudolf Adamkovič, + Sam Kleinman, Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut + Verron, Thomas Heartman, Trey Merkley, Togan Muftuoglu, Toon Claes, + Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben, + CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, + Nick, TheBlob42, Trey, bepolymathe, doolio, fleimgruber, iSeeU, + jixiuf, okamsn, pRot0ta1p. + Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core Emacs), @@ -4358,9 +4656,10 @@ The Modus themes are a collective effort. Every bit of work matters. + Inspiration for certain features :: Bozhidar Batsov (zenburn-theme), Fabrice Niessen (leuven-theme). -Special thanks, in no particular order, to Manuel Uberti, Gustavo -Barros, and Omar Antolín Camarena for their long time contributions and -insightful commentary. +Special thanks (from A-Z) to Gustavo Barros, Manuel Uberti, Nicolas De +Jaeghere, and Omar Antolín Camarena for their long time contributions +and insightful commentary on key aspects of the themes' design and/or +aspects of their functionality. * Meta :properties: @@ -4388,9 +4687,9 @@ of this sort): And here are the canonical sources of this project's documentation: -+ Manual :: -+ Change Log :: -+ Screenshots :: ++ Manual :: ++ Change Log :: ++ Screenshots :: * GNU Free Documentation License :properties: diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index 350524779d6..5a73e655f30 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -4,8 +4,8 @@ ;; Author: Protesilaos Stavrou ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 1.6.0 -;; Package-Requires: ((emacs "26.1")) +;; Version: 1.7.0 +;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 7ab985c0771..f7d38ac2dea 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -4,8 +4,8 @@ ;; Author: Protesilaos Stavrou ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 1.6.0 -;; Last-Modified: <2021-09-29 08:47:03 +0300> +;; Version: 1.7.0 +;; Last-Modified: <2021-11-18 12:28:22 +0200> ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -31,7 +31,7 @@ ;; This file contains all customization variables, helper functions, ;; interactive commands, and face specifications. Please refer to the ;; official Info manual for further documentation (distributed with the -;; themes, or available at: ). +;; themes, or available at: ). ;; ;; The themes share the following customization variables: ;; @@ -39,8 +39,9 @@ ;; modus-themes-org-agenda (alist) ;; modus-themes-bold-constructs (boolean) ;; modus-themes-inhibit-reload (boolean) +;; modus-themes-intense-markup (boolean) ;; modus-themes-italic-constructs (boolean) -;; modus-themes-no-mixed-fonts (boolean) +;; modus-themes-mixed-fonts (boolean) ;; modus-themes-scale-headings (boolean) ;; modus-themes-subtle-line-numbers (boolean) ;; modus-themes-success-deuteranopia (boolean) @@ -59,6 +60,7 @@ ;; modus-themes-prompts (choice) ;; modus-themes-region (choice) ;; modus-themes-syntax (choice) +;; modus-themes-mode-line-padding (natnum) ;; ;; The default scale for headings is as follows (it can be customized as ;; well---remember, no scaling takes place by default): @@ -238,6 +240,7 @@ ;; ido-mode ;; iedit ;; iflipb +;; image-dired ;; imenu-list ;; indium ;; info @@ -278,6 +281,7 @@ ;; mu4e ;; mu4e-conversation ;; multiple-cursors +;; nano-modeline ;; neotree ;; no-emoji ;; notmuch @@ -378,6 +382,7 @@ ;; vc-annotate (C-x v g) ;; vdiff ;; vertico +;; vertico-quick ;; vimish-fold ;; visible-mark ;; visual-regexp @@ -1475,7 +1480,7 @@ The actual styling of the face is done by `modus-themes-faces'." (defface modus-themes-variable-pitch nil "Generic face for applying a conditional `variable-pitch'. -This behaves in accordance with `modus-themes-no-mixed-fonts', +This behaves in accordance with `modus-themes-mixed-fonts', `modus-themes-variable-pitch-headings' for all heading levels, and `modus-themes-variable-pitch-ui'. @@ -1484,7 +1489,7 @@ The actual styling of the face is done by `modus-themes-faces'." (defface modus-themes-fixed-pitch nil "Generic face for applying a conditional `fixed-pitch'. -This behaves in accordance with `modus-themes-no-mixed-fonts'. +This behaves in accordance with `modus-themes-mixed-fonts'. The actual styling of the face is done by `modus-themes-faces'." :group 'modus-theme-faces) @@ -1782,30 +1787,43 @@ This includes the mode line, header line, tab bar, and tab line." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) UI typeface")) -(defcustom modus-themes-no-mixed-fonts nil - "Disable inheritance from `fixed-pitch' in some faces. +(define-obsolete-variable-alias + 'modus-themes-no-mixed-fonts + 'modus-themes-mixed-fonts "On 2021-10-02 for version 1.7.0") -This is done by default to allow spacing-sensitive constructs, -such as Org tables and code blocks, to remain monospaced when -users opt for something like the command `variable-pitch-mode'. -The downside with the default is that users need to explicitly -configure the font family of `fixed-pitch' in order to get a -consistent experience. That may be something they do not want to -do. Hence this option to disable any kind of technique for -mixing fonts." +(defcustom modus-themes-mixed-fonts nil + "Non-nil to enable inheritance from `fixed-pitch' in some faces. + +This is done to allow spacing-sensitive constructs, such as Org +tables and code blocks, to remain monospaced when users opt for +something like the command `variable-pitch-mode'. + +Users may need to explicitly configure the font family of +`fixed-pitch' in order to get a consistent experience." :group 'modus-themes - :package-version '(modus-themes . "1.0.0") - :version "28.1" + :package-version '(modus-themes . "1.7.0") + :version "29.1" :type 'boolean :set #'modus-themes--set-option :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) No mixed fonts")) + :link '(info-link "(modus-themes) Mixed fonts")) (defconst modus-themes--headings-choice '(set :tag "Properties" :greedy t (const :tag "Background color" background) (const :tag "Overline" overline) - (const :tag "No bold weight" no-bold) + (choice :tag "Font weight (must be supported by the typeface)" + (const :tag "Bold (default)" nil) + (const :tag "Thin" thin) + (const :tag "Ultra-light" ultralight) + (const :tag "Extra-light" extralight) + (const :tag "Light" light) + (const :tag "Semi-light" semilight) + (const :tag "Regular" regular) + (const :tag "Medium" medium) + (const :tag "Semi-bold" semibold) + (const :tag "Extra-bold" extrabold) + (const :tag "Ultra-bold" ultrabold)) (choice :tag "Colors" (const :tag "Subtle colors" nil) (const :tag "Rainbow colors" rainbow) @@ -1839,21 +1857,27 @@ heading. A `background' property adds a subtle tinted color to the background of the heading. -A `no-bold' property removes the bold weight from the heading's -text. - A `monochrome' property makes all headings the same base color, which is that of the default for the active theme (black/white). When `background' is also set, `monochrome' changes its color to gray. If both `monochrome' and `rainbow' are set, the former takes precedence. +The symbol of a weight attribute adjusts the font of the heading +accordingly, such as `light', `semibold', etc. Valid symbols are +defined in the internal variable `modus-themes--heading-weights'. +The absence of a weight means that bold will be used by virtue of +inheriting the `bold' face (check the manual for tweaking bold +and italic faces). For backward compatibility, the `no-bold' +value is accepted, though users are encouraged to specify a +`regular' weight instead. + Combinations of any of those properties are expressed as a list, like in these examples: - (no-bold) + (semibold) (rainbow background) - (overline monochrome no-bold) + (overline monochrome semibold) The order in which the properties are set is not significant. @@ -1862,7 +1886,7 @@ In user configuration files the form may look like this: (setq modus-themes-headings '((1 . (background overline rainbow)) (2 . (background overline)) - (t . (overline no-bold)))) + (t . (overline semibold)))) When defining the styles per heading level, it is possible to pass a non-nil value (t) instead of a list of properties. This @@ -1875,7 +1899,7 @@ will retain the original aesthetic for that level. For example: (setq modus-themes-headings '((1 . (background overline)) - (2 . (rainbow no-bold)) + (2 . (rainbow semibold)) (t . t))) ; default style for all other levels For Org users, the extent of the heading depends on the variable @@ -1887,8 +1911,8 @@ Also read `modus-themes-scale-headings' to change the height of headings and `modus-themes-variable-pitch-headings' to make them use a proportionately spaced font." :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" + :package-version '(modus-themes . "1.7.0") + :version "29.1" :type `(alist :options ,(mapcar (lambda (el) (list el modus-themes--headings-choice)) @@ -1909,7 +1933,7 @@ combinations: (setq modus-themes-org-agenda '((header-block . (variable-pitch scale-title)) (header-date . (grayscale workaholic bold-today)) - (event . (accented scale-small)) + (event . (accented italic varied)) (scheduled . uniform) (habit . traffic-light))) @@ -1963,26 +1987,42 @@ For example: (header-date . (grayscale workaholic bold-today)) (header-date . (grayscale workaholic bold-today scale-heading)) -An `event' key covers events from the diary and other entries -that derive from a symbolic expression or sexp (e.g. phases of -the moon, holidays). By default those have a gray -foreground (the default is a nil value or an empty list). This -key accepts a list of properties. Those are: +An `event' key covers (i) headings with a plain time stamp that +are shown on the agenda, also known as events, (ii) entries +imported from the diary, and (iii) other items that derive from a +symbolic expression or sexp (phases of the moon, holidays, etc.). +By default all those look the same and have a subtle foreground +color (the default is a nil value or an empty list). This key +accepts a list of properties. Those are: - `scale-small' reduces the height of the entries to the value of the user option `modus-themes-scale-small' (0.9 the height of - the main font size by default). + the main font size by default). This work best when the + relevant entries have no tags associated with them and when the + user is interested in reducing their presence in the agenda + view. - `accented' applies an accent value to the event's foreground, - replacing the original gray. + replacing the original gray. It makes all entries stand out more. - `italic' adds a slant to the font's forms (italic or oblique - forms, depending on the typeface) + forms, depending on the typeface). +- `varied' differentiates between events with a plain time stamp + and entries that are generated from either the diary or a + symbolic expression. It generally puts more emphasis on + events. When `varied' is combined with `accented', it makes + only events use an accent color, while diary/sexp entries + retain their original subtle foreground. When `varied' is used + in tandem with `italic', it applies a slant only to diary and + sexp entries, not events. And when `varied' is the sole + property passed to the `event' key, it has the same meaning as + the list (italic varied). The combination of `varied', + `accented', `italic' covers all of the aforementioned cases. For example: (event . nil) - (event . (scale-small)) - (event . (scale-small accented)) - (event . (scale-small accented italic)) + (event . (italic)) + (event . (accented italic)) + (event . (accented italic varied)) A `scheduled' key applies to tasks with a scheduled date. By default (a nil value), these use varying shades of yellow to @@ -2038,8 +2078,8 @@ For example: (habit . simplified) (habit . traffic-light)" :group 'modus-themes - :package-version '(modus-themes . "1.6.0") - :version "28.1" + :package-version '(modus-themes . "1.7.0") + :version "29.1" :type '(set (cons :tag "Block header" (const header-block) @@ -2065,7 +2105,8 @@ For example: (set :tag "Text presentation" :greedy t (const :tag "Use smaller font size (`modus-themes-scale-small')" scale-small) (const :tag "Apply an accent color" accented) - (const :tag "Italic font slant (oblique forms)" italic))) + (const :tag "Italic font slant (oblique forms)" italic) + (const :tag "Differentiate events from diary/sexp entries" varied))) (cons :tag "Scheduled tasks" (const scheduled) (choice (const :tag "Yellow colors to distinguish current and future tasks (default)" nil) @@ -2289,12 +2330,12 @@ to the affected text. The property `background' adds a color-coded background. The property `intense' amplifies the applicable colors if -`background' and/or `text-only' are set. If `intense' is set on -its own, then it implies `text-only'. +`background' and/or `text-also' are set. If `intense' is set on +its own, then it implies `text-also'. -To disable fringe indicators for Flymake or Flycheck, refer to -variables `flymake-fringe-indicator-position' and -`flycheck-indication-mode', respectively. +The property `faint' uses nuanced colors for the underline and +for the foreground when `text-also' is included. If both `faint' +and `intense' are specified, the former takes precedence. Combinations of any of those properties can be expressed in a list, as in those examples: @@ -2312,15 +2353,21 @@ In user configuration files the form may look like this: NOTE: The placement of the straight underline, though not the wave style, is controlled by the built-in variables `underline-minimum-offset', `x-underline-at-descent-line', -`x-use-underline-position-properties'." +`x-use-underline-position-properties'. + +To disable fringe indicators for Flymake or Flycheck, refer to +variables `flymake-fringe-indicator-position' and +`flycheck-indication-mode', respectively." :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" + :package-version '(modus-themes . "1.7.0") + :version "29.1" :type '(set :tag "Properties" :greedy t (const :tag "Straight underline" straight-underline) (const :tag "Colorise text as well" text-also) - (const :tag "Increase color intensity" intense) - (const :tag "With background" background)) + (const :tag "With background" background) + (choice :tag "Overall coloration" + (const :tag "Intense colors" intense) + (const :tag "Faint colors" faint))) :set #'modus-themes--set-option :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Language checkers")) @@ -2502,6 +2549,17 @@ instead of a box style, it is advised to set :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Mode line")) +(defcustom modus-themes-mode-line-padding 6 + "Padding for `modus-themes-mode-line'. +The value is expressed as a positive integer." + :group 'modus-themes + :package-version '(modus-themes . "1.7.0") + :version "29.1" + :type 'natnum + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Mode line")) + (defcustom modus-themes-diffs nil "Adjust the overall style of diffs. @@ -2643,16 +2701,6 @@ In user configuration files the form may look like this: :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Command prompts")) -(defcustom modus-themes-intense-hl-line nil - "Use a more prominent background for command `hl-line-mode'." - :group 'modus-themes - :package-version '(modus-themes . "1.0.0") - :version "28.1" - :type 'boolean - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Line highlighting")) - (make-obsolete 'modus-themes-intense-hl-line 'modus-themes-hl-line "1.3.0") (defcustom modus-themes-hl-line nil @@ -2708,6 +2756,22 @@ results with underlines." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Line numbers")) +(defcustom modus-themes-intense-markup nil + "Use more intense markup in Org, Markdown, and related. +The default style for certain markup types like inline code and +verbatim constructs in Org and related major modes is a subtle +foreground color combined with a subtle background. + +With a non-nil value (t), these constructs will use a more +prominent background and foreground color combination instead." + :group 'modus-themes + :package-version '(modus-themes . "1.7.0") + :version "29.1" + :type 'boolean + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Intense markup")) + (defcustom modus-themes-paren-match nil "Control the style of matching parentheses or delimiters. @@ -2913,12 +2977,14 @@ In user configuration files the form may look like this: This is to account for red-green color deficiency. -The present customization option should apply to all contexts where -there can be a color-coded distinction between success and failure, -to-do and done, and so on. +The present customization option applies to all contexts where +there can be a color-coded distinction between success or +failure, to-do or done, mark for selection or deletion (e.g. in +Dired), current and lazily highlighted search matches, and so on. -Diffs, which have a red/green dichotomy by default, can also be -configured to conform with deuteranopia: `modus-themes-diffs'." +Diffs, which rely on a red/green dichotomy by default, can also +be configured to meet the needs of users with deuteranopia via +the option `modus-themes-diffs'." :group 'modus-themes :package-version '(modus-themes . "1.4.0") :version "28.1" @@ -3024,7 +3090,7 @@ Those are stored in `modus-themes-faces' and (defun modus-themes--fixed-pitch () "Conditional application of `fixed-pitch' inheritance." - (unless modus-themes-no-mixed-fonts + (when modus-themes-mixed-fonts (list :inherit 'fixed-pitch))) (defun modus-themes--variable-pitch () @@ -3054,14 +3120,23 @@ combines with the theme's primary background (white/black)." (list :background (or altbg 'unspecified) :foreground altfg) (list :background mainbg :foreground mainfg))) -(defun modus-themes--lang-check (underline subtlefg intensefg intensefg-alt subtlebg intensebg) +(defun modus-themes--markup (mainfg intensefg &optional mainbg intensebg) + "Conditional use of colors for markup in Org and others. +MAINBG is the default background. MAINFG is the default +foreground. INTENSEBG and INTENSEFG must be more colorful +variants." + (if modus-themes-intense-markup + (list :background (or intensebg 'unspecified) :foreground intensefg) + (list :background (or mainbg 'unspecified) :foreground mainfg))) + +(defun modus-themes--lang-check (underline subtlefg intensefg intensefg-alt subtlebg intensebg faintfg) "Conditional use of foreground colors for language checkers. UNDERLINE is a color-code value for the affected text's underline property. SUBTLEFG and INTENSEFG follow the same color-coding pattern and represent a value that is faint or vibrant respectively. INTENSEFG-ALT is used when the intensity is high. SUBTLEBG and INTENSEBG are color-coded background colors that -differ in overall intensity." +differ in overall intensity. FAINTFG is a nuanced color." (let ((modus-themes-lang-checkers (if (listp modus-themes-lang-checkers) modus-themes-lang-checkers @@ -3074,12 +3149,16 @@ differ in overall intensity." ('straight-underline '(straight-underline)))))) (list :underline (list :color - underline + (if (memq 'faint modus-themes-lang-checkers) + faintfg underline) :style (if (memq 'straight-underline modus-themes-lang-checkers) 'line 'wave)) :background (cond + ((and (memq 'background modus-themes-lang-checkers) + (memq 'faint modus-themes-lang-checkers)) + subtlebg) ((and (memq 'background modus-themes-lang-checkers) (memq 'intense modus-themes-lang-checkers)) intensebg) @@ -3087,6 +3166,9 @@ differ in overall intensity." subtlebg)) :foreground (cond + ((and (memq 'faint modus-themes-lang-checkers) + (memq 'text-also modus-themes-lang-checkers)) + faintfg) ((and (memq 'background modus-themes-lang-checkers) (memq 'intense modus-themes-lang-checkers)) intensefg-alt) @@ -3312,6 +3394,18 @@ an alternative to the default value." "Get cdr of KEY in ALIST." (cdr (assoc key alist))) +(defvar modus-themes--heading-weights + '( thin ultralight extralight light semilight regular medium + semibold bold heavy extrabold ultrabold) + "List of font weights used by `modus-themes--heading'.") + +(defun modus-themes--heading-weight (list) + "Search for `modus-themes--heading' weight in LIST." + (catch 'found + (dolist (elt list) + (when (memq elt modus-themes--heading-weights) + (throw 'found elt))))) + (defun modus-themes--heading (level fg fg-alt bg bg-gray border) "Conditional styles for `modus-themes-headings'. @@ -3323,8 +3417,9 @@ values. BG-GRAY is a gray background. BORDER is a color value that combines well with the background and foreground." (let* ((key (modus-themes--key-cdr level modus-themes-headings)) (style (or key (modus-themes--key-cdr t modus-themes-headings))) + (style-listp (listp style)) (modus-themes-headings - (if (listp style) + (if style-listp style ;; translation layer for legacy values (pcase style @@ -3345,15 +3440,16 @@ that combines well with the background and foreground." ('rainbow-section-no-bold '(no-bold rainbow background overline)) ('section '(background overline)) ('section-no-bold '(background overline no-bold))))) - (var (if modus-themes-variable-pitch-headings - 'variable-pitch - 'unspecified)) + (var (when modus-themes-variable-pitch-headings 'variable-pitch)) (varbold (if var (append (list 'bold) (list var)) - 'bold))) + 'bold)) + (weight (when style-listp (modus-themes--heading-weight style)))) (list :inherit (cond - ((memq 'no-bold modus-themes-headings) + ;; `no-bold' is for backward compatibility because we cannot + ;; deprecate a variable's value. + ((or weight (memq 'no-bold modus-themes-headings)) var) (varbold)) :background @@ -3371,6 +3467,8 @@ that combines well with the background and foreground." ((memq 'rainbow modus-themes-headings) fg-alt) (fg)) + :weight + (or weight 'unspecified) :overline (if (memq 'overline modus-themes-headings) border @@ -3430,24 +3528,42 @@ weight. Optional UL applies an underline." t 'unspecified)))) -(defun modus-themes--agenda-event (fg) +(defun modus-themes--agenda-event (fg-accent &optional varied) "Control the style of the Org agenda events. -FG is the accent color to use." +FG-ACCENT is the accent color to use. Optional VARIED is a +toggle to behave in accordance with the semantics of the `varied' +property that the `event' key accepts in +`modus-themes-org-agenda'." (let ((properties (modus-themes--key-cdr 'event modus-themes-org-agenda))) (list :height (if (memq 'scale-small properties) modus-themes-scale-small 'unspecified) :foreground - (if (memq 'accented properties) - fg + (cond + ((or (and (memq 'varied properties) varied) + (and (memq 'accented properties) + (memq 'varied properties) + varied)) 'unspecified) + ((memq 'accented properties) + fg-accent) + ('unspecified)) :inherit (cond + ((and (memq 'italic properties) + (memq 'varied properties) + varied) + '(shadow italic)) ((and (memq 'accented properties) - (memq 'italic properties)) - 'italic) - ((memq 'italic properties) + (memq 'varied properties) + varied) + 'shadow) + ((or (and (memq 'varied properties) varied) + (and (memq 'italic properties) varied)) + '(shadow italic)) + ((and (memq 'italic properties) + (not (memq 'varied properties))) '(shadow italic)) ('shadow))))) @@ -3512,6 +3628,13 @@ set to `rainbow'." ('rainbow (list :background bgaccent :foreground fgaccent)) (_ (list :background bg :foreground fg)))) +(defun modus-themes--mode-line-padding () + "Determine mode line padding value. +See `modus-themes--mode-line-attrs'." + (if (natnump modus-themes-mode-line-padding) + modus-themes-mode-line-padding + 6)) ; the default value + (defun modus-themes--mode-line-attrs (fg bg fg-alt bg-alt fg-accent bg-accent border border-3d &optional alt-style fg-distant) "Color combinations for `modus-themes-mode-line'. @@ -3528,7 +3651,8 @@ line's box property. Optional FG-DISTANT should be close to the main background values. It is intended to be used as a distant-foreground property." - (let ((modus-themes-mode-line + (let ((padding (modus-themes--mode-line-padding)) + (modus-themes-mode-line (if (listp modus-themes-mode-line) modus-themes-mode-line ;; translation layer for legacy values @@ -3552,10 +3676,10 @@ property." (cons fg-alt bg-alt)) ((cons fg bg)))) (box (cond ((memq 'moody modus-themes-mode-line) - nil) + 'unspecified) ((and (memq '3d modus-themes-mode-line) (memq 'padded modus-themes-mode-line)) - (list :line-width 4 + (list :line-width padding :color (cond ((and (memq 'accented modus-themes-mode-line) (memq 'borderless modus-themes-mode-line)) @@ -3567,9 +3691,9 @@ property." :style (when alt-style 'released-button))) ((and (memq 'accented modus-themes-mode-line) (memq 'padded modus-themes-mode-line)) - (list :line-width 6 :color bg-accent)) + (list :line-width padding :color bg-accent)) ((memq 'padded modus-themes-mode-line) - (list :line-width 6 :color bg)) + (list :line-width padding :color bg)) ((memq '3d modus-themes-mode-line) (list :line-width 1 :color @@ -3579,14 +3703,17 @@ property." ((memq 'borderless modus-themes-mode-line) bg) (border-3d)) :style (when alt-style 'released-button))) + ((and (memq 'accented modus-themes-mode-line) + (memq 'borderless modus-themes-mode-line)) + bg-accent) ((memq 'borderless modus-themes-mode-line) bg) ((memq 'padded modus-themes-mode-line) - (list :line-width 6 :color bg)) + (list :line-width padding :color bg)) (border))) (line (cond ((not (or (memq 'moody modus-themes-mode-line) (memq 'padded modus-themes-mode-line))) - nil) + 'unspecified) ((and (memq 'borderless modus-themes-mode-line) (memq 'accented modus-themes-mode-line)) bg-accent) @@ -4007,6 +4134,7 @@ as when they are declared in the `:config' phase)." (defun modus-themes-load-operandi () "Load `modus-operandi' and disable `modus-vivendi'. Also run `modus-themes-after-load-theme-hook'." + (interactive) (disable-theme 'modus-vivendi) (load-theme 'modus-operandi t) (run-hooks 'modus-themes-after-load-theme-hook)) @@ -4015,6 +4143,7 @@ Also run `modus-themes-after-load-theme-hook'." (defun modus-themes-load-vivendi () "Load `modus-vivendi' and disable `modus-operandi'. Also run `modus-themes-after-load-theme-hook'." + (interactive) (disable-theme 'modus-operandi) (load-theme 'modus-vivendi t) (run-hooks 'modus-themes-after-load-theme-hook)) @@ -4169,7 +4298,11 @@ by virtue of calling either of `modus-themes-load-operandi' and `(modus-themes-pseudo-header ((,class :inherit bold :foreground ,fg-main))) `(modus-themes-mark-alt ((,class :inherit bold :background ,bg-mark-alt :foreground ,fg-mark-alt))) `(modus-themes-mark-del ((,class :inherit bold :background ,bg-mark-del :foreground ,fg-mark-del))) - `(modus-themes-mark-sel ((,class :inherit bold :background ,bg-mark-sel :foreground ,fg-mark-sel))) + `(modus-themes-mark-sel ((,class :inherit bold + :background ,@(modus-themes--success-deuteran + cyan-refine-bg + bg-mark-sel) + :foreground ,fg-mark-sel))) `(modus-themes-mark-symbol ((,class :inherit bold :foreground ,blue-alt))) ;;;;; heading levels ;; styles for regular headings used in Org, Markdown, Info, etc. @@ -4225,13 +4358,13 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; language checkers `(modus-themes-lang-error ((,class ,@(modus-themes--lang-check fg-lang-underline-error fg-lang-error - red red-refine-fg red-nuanced-bg red-refine-bg)))) + red red-refine-fg red-nuanced-bg red-refine-bg red-faint)))) `(modus-themes-lang-note ((,class ,@(modus-themes--lang-check fg-lang-underline-note fg-lang-note - blue-alt blue-refine-fg blue-nuanced-bg blue-refine-bg)))) + blue-alt blue-refine-fg blue-nuanced-bg blue-refine-bg blue-faint)))) `(modus-themes-lang-warning ((,class ,@(modus-themes--lang-check fg-lang-underline-warning fg-lang-warning - yellow yellow-refine-fg yellow-nuanced-bg yellow-refine-bg)))) + yellow yellow-refine-fg yellow-nuanced-bg yellow-refine-bg yellow-faint)))) ;;;;; other custom faces `(modus-themes-bold ((,class ,@(modus-themes--bold-weight)))) `(modus-themes-hl-line ((,class ,@(modus-themes--hl-line @@ -4276,15 +4409,16 @@ by virtue of calling either of `modus-themes-load-operandi' and `(buffer-menu-buffer ((,class :inherit bold))) `(comint-highlight-input ((,class :inherit bold))) `(comint-highlight-prompt ((,class :inherit modus-themes-prompt))) + `(confusingly-reordered ((,class :inherit modus-themes-lang-error))) `(error ((,class :inherit bold :foreground ,red))) `(escape-glyph ((,class :foreground ,fg-escape-char-construct))) - `(file-name-shadow ((,class :foreground ,fg-unfocused))) + `(file-name-shadow ((,class :inherit (shadow italic)))) `(header-line ((,class ,@(modus-themes--variable-pitch-ui) :background ,bg-header :foreground ,fg-header))) `(header-line-highlight ((,class :inherit modus-themes-active-blue))) `(help-argument-name ((,class :inherit modus-themes-slant :foreground ,cyan))) - `(help-key-binding ((,class :box (:line-width (1 . -1) :color ,bg-region) ; NOTE: box syntax is for Emacs28 - :background ,bg-inactive))) + `(help-key-binding ((,class :box (:line-width (-1 . -1) :color ,bg-active) ; NOTE: box syntax is for Emacs28 + :background ,bg-alt))) `(homoglyph ((,class :foreground ,red-alt-faint))) `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other-faint))) `(italic ((,class :slant italic))) @@ -4316,7 +4450,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(widget-button-pressed ((,class :inherit widget-button :foreground ,magenta))) `(widget-documentation ((,class :foreground ,green))) `(widget-field ((,class :background ,bg-alt :foreground ,fg-dim))) - `(widget-inactive ((,class :foreground ,fg-alt))) + `(widget-inactive ((,class :inherit shadow :background ,bg-dim))) `(widget-single-line-field ((,class :inherit widget-field))) ;;;;; ag `(ag-hit-face ((,class :foreground ,fg-special-cold))) @@ -4505,7 +4639,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(bongo-marked-track ((,class :foreground ,fg-mark-alt))) `(bongo-marked-track-line ((,class :background ,bg-mark-alt))) `(bongo-played-track ((,class :foreground ,fg-unfocused :strike-through t))) - `(bongo-track-length ((,class :foreground ,fg-alt))) + `(bongo-track-length ((,class :inherit shadow))) `(bongo-track-title ((,class :foreground ,blue-active))) `(bongo-unfilled-seek-bar ((,class :background ,bg-special-cold :foreground ,fg-main))) ;;;;; boon @@ -4569,7 +4703,7 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; cfrs `(cfrs-border-color ((,class :background ,fg-window-divider-inner))) ;;;;; change-log and log-view (`vc-print-log' and `vc-print-root-log') - `(change-log-acknowledgment ((,class :foreground ,fg-alt))) + `(change-log-acknowledgment ((,class :inherit shadow))) `(change-log-conditionals ((,class :foreground ,yellow))) `(change-log-date ((,class :foreground ,cyan))) `(change-log-email ((,class :foreground ,cyan-alt-other))) @@ -4609,7 +4743,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(cider-stacktrace-filter-active-face ((,class :foreground ,cyan-alt :underline t))) `(cider-stacktrace-filter-inactive-face ((,class :foreground ,cyan-alt))) `(cider-stacktrace-fn-face ((,class :inherit bold :foreground ,fg-main))) - `(cider-stacktrace-ns-face ((,class :inherit italic :foreground ,fg-alt))) + `(cider-stacktrace-ns-face ((,class :inherit (shadow italic)))) `(cider-stacktrace-promoted-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,red))) `(cider-stacktrace-suppressed-button-face ((,class :box (:line-width 3 :color ,fg-alt :style pressed-button) :background ,bg-alt :foreground ,fg-alt))) @@ -4658,6 +4792,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(company-tooltip-annotation-selection ((,class :inherit bold :foreground ,fg-main))) `(company-tooltip-common ((,class :inherit bold :foreground ,blue-alt))) `(company-tooltip-common-selection ((,class :foreground ,fg-main))) + `(company-tooltip-deprecated ((,class :inherit company-tooltip :strike-through t))) `(company-tooltip-mouse ((,class :inherit modus-themes-intense-blue))) `(company-tooltip-search ((,class :inherit (modus-themes-search-success-lazy bold)))) `(company-tooltip-search-selection ((,class :inherit (modus-themes-search-success bold) :underline t))) @@ -4698,10 +4833,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(consult-preview-error ((,class :inherit modus-themes-intense-red))) `(consult-preview-line ((,class :background ,bg-hl-alt-intense))) ;;;;; corfu - `(corfu-background ((,class :background ,bg-alt))) `(corfu-current ((,class :inherit bold :background ,cyan-subtle-bg))) `(corfu-bar ((,class :background ,fg-alt))) `(corfu-border ((,class :background ,bg-active))) + `(corfu-default ((,class :background ,bg-alt))) ;;;;; counsel `(counsel-active-mode ((,class :foreground ,magenta-alt-other))) `(counsel-application-name ((,class :foreground ,red-alt-other))) @@ -4758,7 +4893,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(custom-comment ((,class :inherit shadow))) `(custom-comment-tag ((,class :background ,bg-alt :foreground ,yellow-alt-other))) `(custom-face-tag ((,class :inherit bold :foreground ,blue-intense))) - `(custom-group-tag ((,class :inherit bold :foreground ,green-intense))) + `(custom-group-tag ((,class :inherit modus-themes-pseudo-header :foreground ,magenta-alt))) `(custom-group-tag-1 ((,class :inherit modus-themes-special-warm))) `(custom-invalid ((,class :inherit (modus-themes-intense-red bold)))) `(custom-modified ((,class :inherit modus-themes-subtle-cyan))) @@ -4814,7 +4949,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(deft-filter-string-face ((,class :foreground ,green-intense))) `(deft-header-face ((,class :inherit bold :foreground ,fg-special-warm))) `(deft-separator-face ((,class :inherit shadow))) - `(deft-summary-face ((,class :inherit modus-themes-slant :foreground ,fg-alt))) + `(deft-summary-face ((,class :inherit (shadow modus-themes-slant)))) `(deft-time-face ((,class :foreground ,fg-special-cold))) `(deft-title-face ((,class :inherit bold :foreground ,fg-main))) ;;;;; dictionary @@ -4862,7 +4997,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(dir-treeview-audio-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt))) `(dir-treeview-control-face ((,class :inherit shadow))) `(dir-treeview-control-mouse-face ((,class :inherit highlight))) - `(dir-treeview-default-icon-face ((,class :inherit bold :family "Font Awesome" :foreground ,fg-alt))) + `(dir-treeview-default-icon-face ((,class :inherit (shadow bold) :family "Font Awesome"))) `(dir-treeview-default-filename-face ((,class :foreground ,fg-main))) `(dir-treeview-directory-face ((,class :foreground ,blue))) `(dir-treeview-directory-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,blue-alt))) @@ -5484,8 +5619,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(git-gutter-fr:modified ((,class :inherit modus-themes-fringe-yellow))) ;;;;; git-{gutter,fringe}+ `(git-gutter+-added ((,class :inherit ,@(modus-themes--diff-deuteran - 'modus-themes-fringe-blue - 'modus-themes-fringe-green)))) + 'modus-themes-fringe-blue + 'modus-themes-fringe-green)))) `(git-gutter+-deleted ((,class :inherit modus-themes-fringe-red))) `(git-gutter+-modified ((,class :inherit modus-themes-fringe-yellow))) `(git-gutter+-separator ((,class :inherit modus-themes-fringe-cyan))) @@ -5851,6 +5986,11 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; iflipb `(iflipb-current-buffer-face ((,class :inherit bold :foreground ,cyan-alt))) `(iflipb-other-buffer-face ((,class :inherit shadow))) +;;;;; image-dired + `(image-dired-thumb-flagged ((,class :background ,red-intense-bg))) + `(image-dired-thumb-mark ((,class :background ,@(modus-themes--success-deuteran + cyan-intense-bg + green-intense-bg)))) ;;;;; imenu-list `(imenu-list-entry-face-0 ((,class :foreground ,cyan))) `(imenu-list-entry-face-1 ((,class :foreground ,blue))) @@ -5862,7 +6002,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(imenu-list-entry-subalist-face-3 ((,class :inherit bold :foreground ,red-alt-other :underline t))) ;;;;; indium `(indium-breakpoint-face ((,class :foreground ,red-active))) - `(indium-frame-url-face ((,class :inherit button :foreground ,fg-alt))) + `(indium-frame-url-face ((,class :inherit (shadow button)))) `(indium-keyword-face ((,class :inherit font-lock-keyword-face))) `(indium-litable-face ((,class :inherit modus-themes-slant :foreground ,fg-special-warm))) `(indium-repl-error-face ((,class :inherit error))) @@ -5870,8 +6010,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(indium-repl-stdout-face ((,class :foreground ,fg-main))) ;;;;; info `(Info-quoted ((,class :inherit modus-themes-fixed-pitch ; the capitalization is canonical - :background ,bg-alt :foreground ,fg-special-calm))) - `(info-header-node ((,class :inherit bold :foreground ,fg-alt))) + ,@(modus-themes--markup fg-special-calm magenta-alt + bg-alt magenta-nuanced-bg)))) + `(info-header-node ((,class :inherit (shadow bold)))) `(info-header-xref ((,class :foreground ,blue-active))) `(info-index-match ((,class :inherit match))) `(info-menu-header ((,class :inherit modus-themes-heading-3))) @@ -5882,7 +6023,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(info-title-3 ((,class :inherit modus-themes-heading-3))) `(info-title-4 ((,class :inherit modus-themes-heading-4))) ;;;;; info-colors - `(info-colors-lisp-code-block ((,class :inherit fixed-pitch))) + `(info-colors-lisp-code-block ((,class :inherit modus-themes-fixed-pitch))) `(info-colors-ref-item-command ((,class :inherit font-lock-function-name-face))) `(info-colors-ref-item-constant ((,class :inherit font-lock-constant-face))) `(info-colors-ref-item-function ((,class :inherit font-lock-function-name-face))) @@ -6089,7 +6230,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(lsp-face-semhl-variable ((,class :foreground ,cyan))) `(lsp-face-semhl-variable-local ((,class :foreground ,cyan))) `(lsp-face-semhl-variable-parameter ((,class :foreground ,cyan-alt-other))) - `(lsp-lens-face ((,class :height 0.8 :foreground ,fg-alt))) + `(lsp-lens-face ((,class :inherit shadow :height 0.8))) `(lsp-lens-mouse-face ((,class :height 0.8 :foreground ,blue-alt-other :underline t))) `(lsp-ui-doc-background ((,class :background ,bg-alt))) `(lsp-ui-doc-header ((,class :background ,bg-header :foreground ,fg-header))) @@ -6309,13 +6450,14 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markdown-html-tag-name-face ((,class :inherit modus-themes-fixed-pitch :foreground ,magenta-alt))) `(markdown-inline-code-face ((,class :inherit modus-themes-fixed-pitch - :background ,bg-alt :foreground ,fg-special-calm))) + ,@(modus-themes--markup fg-special-calm magenta-alt + bg-alt magenta-nuanced-bg)))) `(markdown-italic-face ((,class :inherit italic))) `(markdown-language-info-face ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) `(markdown-language-keyword-face ((,class :inherit modus-themes-fixed-pitch - :background ,bg-alt - :foreground ,fg-alt))) + ,@(modus-themes--markup fg-alt red-alt + bg-alt red-nuanced-bg)))) `(markdown-line-break-face ((,class :inherit modus-themes-refine-cyan :underline t))) `(markdown-link-face ((,class :inherit button))) `(markdown-link-title-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) @@ -6349,7 +6491,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markup-meta-face ((,class :inherit shadow))) `(markup-meta-hide-face ((,class :foreground "gray50"))) `(markup-reference-face ((,class :foreground ,blue-alt :underline ,bg-region))) - `(markup-replacement-face ((,class :inherit fixed-pitch :foreground ,red-alt))) + `(markup-replacement-face ((,class :inherit modus-themes-fixed-pitch :foreground ,red-alt))) `(markup-secondary-text-face ((,class :height 0.9 :foreground ,cyan-alt-other))) `(markup-small-face ((,class :inherit markup-gen-face :height 0.9))) `(markup-strong-face ((,class :inherit markup-bold-face))) @@ -6479,7 +6621,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(mu4e-title-face ((,class :foreground ,fg-main))) `(mu4e-trashed-face ((,class :foreground ,red))) `(mu4e-unread-face ((,class :inherit bold))) - `(mu4e-url-number-face ((,class :foreground ,fg-alt))) + `(mu4e-url-number-face ((,class :inherit shadow))) `(mu4e-view-body-face ((,class :foreground ,fg-main))) `(mu4e-warning-face ((,class :inherit warning))) ;;;;; mu4e-conversation @@ -6498,6 +6640,17 @@ by virtue of calling either of `modus-themes-load-operandi' and `(mc/cursor-bar-face ((,class :height 1 :background ,fg-main))) `(mc/cursor-face ((,class :inverse-video t))) `(mc/region-face ((,class :inherit region))) +;;;;; nano-modeline + `(nano-modeline-active-primary ((,class :inherit mode-line :foreground ,fg-special-mild))) + `(nano-modeline-active-secondary ((,class :inherit mode-line :foreground ,fg-special-cold))) + `(nano-modeline-active-status-** ((,class :inherit mode-line :background ,yellow-subtle-bg))) + `(nano-modeline-active-status-RO ((,class :inherit mode-line :background ,red-subtle-bg))) + `(nano-modeline-active-status-RW ((,class :inherit mode-line :background ,cyan-subtle-bg))) + `(nano-modeline-inactive-primary ((,class :inherit mode-line-inactive :foreground ,fg-inactive))) + `(nano-modeline-inactive-secondary ((,class :inherit mode-line-inactive :foreground ,fg-inactive))) + `(nano-modeline-inactive-status-** ((,class :inherit mode-line-inactive :foreground ,yellow-active))) + `(nano-modeline-inactive-status-RO ((,class :inherit mode-line-inactive :foreground ,red-active))) + `(nano-modeline-inactive-status-RW ((,class :inherit mode-line-inactive :foreground ,cyan-active))) ;;;;; neotree `(neo-banner-face ((,class :foreground ,magenta))) `(neo-button-face ((,class :inherit button))) @@ -6507,7 +6660,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(neo-header-face ((,class :inherit bold :foreground ,fg-main))) `(neo-root-dir-face ((,class :inherit bold :foreground ,cyan-alt))) `(neo-vc-added-face ((,class :foreground ,@(modus-themes--diff-deuteran blue green)))) - `(neo-vc-conflict-face ((,class :inherit bold :foreground ,red))) + `(neo-vc-conflict-face ((,class :inherit error))) `(neo-vc-default-face ((,class :foreground ,fg-main))) `(neo-vc-edited-face ((,class :foreground ,yellow))) `(neo-vc-ignored-face ((,class :foreground ,fg-inactive))) @@ -6601,17 +6754,20 @@ by virtue of calling either of `modus-themes-load-operandi' and yellow-refine-bg yellow-refine-fg)))) ;;;;; org `(org-agenda-calendar-event ((,class ,@(modus-themes--agenda-event blue-alt)))) - `(org-agenda-calendar-sexp ((,class :inherit org-agenda-calendar-event))) + `(org-agenda-calendar-sexp ((,class ,@(modus-themes--agenda-event blue-alt t)))) `(org-agenda-clocking ((,class :inherit modus-themes-special-cold :extend t))) `(org-agenda-column-dateline ((,class :background ,bg-alt))) `(org-agenda-current-time ((,class :foreground ,blue-alt-other-faint))) `(org-agenda-date ((,class ,@(modus-themes--agenda-date cyan fg-main)))) - `(org-agenda-date-today ((,class ,@(modus-themes--agenda-date blue-active fg-main - cyan-active fg-main - bg-active t t)))) - `(org-agenda-date-weekend ((,class ,@(modus-themes--agenda-date cyan-alt-other fg-alt + `(org-agenda-date-today ((,class ,@(modus-themes--agenda-date cyan fg-main + nil nil + bg-inactive t t)))) + `(org-agenda-date-weekend ((,class ,@(modus-themes--agenda-date cyan-alt-other-faint fg-alt cyan fg-main)))) - `(org-agenda-diary ((,class :inherit org-agenda-calendar-event))) + `(org-agenda-date-weekend-today ((,class ,@(modus-themes--agenda-date cyan-alt-other-faint fg-alt + cyan fg-main + bg-inactive t t)))) + `(org-agenda-diary ((,class :inherit org-agenda-calendar-sexp))) `(org-agenda-dimmed-todo-face ((,class :inherit shadow))) `(org-agenda-done ((,class :foreground ,@(modus-themes--success-deuteran blue-nuanced-fg @@ -6622,6 +6778,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-agenda-filter-tags ((,class :inherit bold :foreground ,cyan-active))) `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim))) `(org-agenda-structure ((,class ,@(modus-themes--agenda-structure blue-alt)))) + `(org-agenda-structure-filter ((,class :inherit org-agenda-structure :foreground ,yellow))) + `(org-agenda-structure-secondary ((,class :foreground ,cyan))) `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt))) `(org-block ((,class :inherit modus-themes-fixed-pitch ,@(modus-themes--org-block bg-dim fg-main)))) @@ -6636,23 +6794,24 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-checkbox-statistics-todo ((,class :inherit org-todo))) `(org-clock-overlay ((,class :inherit modus-themes-special-cold))) `(org-code ((,class :inherit modus-themes-fixed-pitch - :background ,bg-alt :foreground ,fg-special-mild + ,@(modus-themes--markup fg-special-mild green-alt-other + bg-alt green-nuanced-bg) :extend t))) `(org-column ((,class :background ,bg-alt))) `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt))) - `(org-date ((,class :inherit ,(if modus-themes-no-mixed-fonts - 'button - '(button fixed-pitch)) + `(org-date ((,class :inherit ,(if modus-themes-mixed-fonts + '(button fixed-pitch) + 'button) ,@(modus-themes--link-color cyan cyan-faint)))) `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t))) `(org-dispatcher-highlight ((,class :inherit (bold modus-themes-mark-alt)))) `(org-document-info ((,class :foreground ,fg-special-cold))) - `(org-document-info-keyword ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) + `(org-document-info-keyword ((,class :inherit (shadow modus-themes-fixed-pitch)))) `(org-document-title ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,fg-special-cold ,@(modus-themes--scale modus-themes-scale-title)))) `(org-done ((,class :foreground ,@(modus-themes--success-deuteran blue green)))) - `(org-drawer ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) + `(org-drawer ((,class :inherit (shadow modus-themes-fixed-pitch)))) `(org-ellipsis (())) ; inherits from the heading's color `(org-footnote ((,class :inherit button ,@(modus-themes--link-color @@ -6701,6 +6860,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-headline-todo ((,class :inherit modus-themes-variable-pitch :foreground ,red-nuanced-fg))) `(org-hide ((,class :foreground ,bg-main))) `(org-indent ((,class :inherit (fixed-pitch org-hide)))) + `(org-imminent-deadline ((,class :foreground ,red-intense))) `(org-latex-and-related ((,class :foreground ,magenta-refine-fg))) `(org-level-1 ((,class :inherit modus-themes-heading-1))) `(org-level-2 ((,class :inherit modus-themes-heading-2))) @@ -6713,8 +6873,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-link ((,class :inherit button))) `(org-list-dt ((,class :inherit bold))) `(org-macro ((,class :inherit modus-themes-fixed-pitch - :background ,cyan-nuanced-bg :foreground ,cyan-nuanced-fg))) - `(org-meta-line ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) + ,@(modus-themes--markup cyan-nuanced-fg cyan + cyan-nuanced-bg cyan-nuanced-bg)))) + `(org-meta-line ((,class :inherit (shadow modus-themes-fixed-pitch)))) `(org-mode-line-clock ((,class :foreground ,fg-main))) `(org-mode-line-clock-overrun ((,class :inherit bold :foreground ,red-active))) `(org-priority ((,class :foreground ,magenta))) @@ -6724,18 +6885,19 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-scheduled-previously ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm yellow-alt-other)))) `(org-scheduled-today ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm magenta-alt-other)))) `(org-sexp-date ((,class :inherit org-date))) - `(org-special-keyword ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt))) + `(org-special-keyword ((,class :inherit (shadow modus-themes-fixed-pitch)))) `(org-table ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) `(org-table-header ((,class :inherit (fixed-pitch modus-themes-intense-neutral)))) `(org-tag ((,class :foreground ,magenta-nuanced-fg))) `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced-fg))) `(org-target ((,class :underline t))) - `(org-time-grid ((,class :foreground ,fg-unfocused))) + `(org-time-grid ((,class :inherit shadow))) `(org-todo ((,class :foreground ,red))) `(org-upcoming-deadline ((,class :foreground ,red-alt-other))) `(org-upcoming-distant-deadline ((,class :foreground ,red-faint))) `(org-verbatim ((,class :inherit modus-themes-fixed-pitch - :background ,bg-alt :foreground ,fg-special-calm))) + ,@(modus-themes--markup fg-special-calm magenta-alt + bg-alt magenta-nuanced-bg)))) `(org-verse ((,class :inherit org-quote))) `(org-warning ((,class :inherit bold :foreground ,red-alt-other))) ;;;;; org-journal @@ -6764,7 +6926,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-roam-link-shielded ((,class :inherit button ,@(modus-themes--link-color yellow yellow-faint)))) - `(org-roam-tag ((,class :inherit italic :foreground ,fg-alt))) + `(org-roam-tag ((,class :inherit (shadow italic)))) ;;;;; org-superstar `(org-superstar-item ((,class :foreground ,fg-main))) `(org-superstar-leading ((,class :foreground ,fg-whitespace))) @@ -6863,7 +7025,7 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; pomidor `(pomidor-break-face ((,class :foreground ,blue-alt-other))) `(pomidor-overwork-face ((,class :foreground ,red-alt-other))) - `(pomidor-skip-face ((,class :inherit modus-themes-slant :foreground ,fg-alt))) + `(pomidor-skip-face ((,class :inherit (shadow modus-themes-slant)))) `(pomidor-work-face ((,class :foreground ,@(modus-themes--success-deuteran blue-alt green-alt-other)))) @@ -6914,7 +7076,7 @@ by virtue of calling either of `modus-themes-load-operandi' and :foreground ,green))) `(racket-here-string-face ((,class :foreground ,blue-alt))) `(racket-keyword-argument-face ((,class :foreground ,red-alt))) - `(racket-logger-config-face ((,class :inherit modus-themes-slant :foreground ,fg-alt))) + `(racket-logger-config-face ((,class :inherit (shadow modus-themes-slant)))) `(racket-logger-debug-face ((,class :foreground ,blue-alt-other))) `(racket-logger-info-face ((,class :foreground ,fg-lang-note))) `(racket-logger-topic-face ((,class :inherit modus-themes-slant :foreground ,magenta))) @@ -7208,7 +7370,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(spray-base-face ((,class :inherit default :foreground ,fg-special-cold))) ;;;;; stripes `(stripes ((,class :background ,bg-alt))) -;;;;; success +;;;;; suggest `(suggest-heading ((,class :inherit bold :foreground ,yellow-alt-other))) ;;;;; switch-window `(switch-window-background ((,class :background ,bg-dim))) @@ -7255,7 +7417,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(sx-question-mode-score-downvoted ((,class :foreground ,yellow))) `(sx-question-mode-score-upvoted ((,class :inherit bold :foreground ,magenta))) `(sx-question-mode-title ((,class :inherit bold :foreground ,fg-main))) - `(sx-question-mode-title-comments ((,class :inherit bold :foreground ,fg-alt))) + `(sx-question-mode-title-comments ((,class :inherit (shadow bold)))) `(sx-tag ((,class :foreground ,magenta-alt))) `(sx-user-name ((,class :foreground ,blue-alt))) `(sx-user-reputation ((,class :inherit shadow))) @@ -7318,9 +7480,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(telega-button-active ((,class :box ,blue-intense-bg :background ,blue-intense-bg :foreground ,fg-main))) `(telega-button-highlight ((,class :inherit modus-themes-subtle-magenta))) `(telega-chat-prompt ((,class :inherit bold))) - `(telega-entity-type-code ((,class :inherit fixed-pitch))) + `(telega-entity-type-code ((,class :inherit modus-themes-fixed-pitch))) `(telega-entity-type-mention ((,class :foreground ,cyan))) - `(telega-entity-type-pre ((,class :inherit fixed-pitch))) + `(telega-entity-type-pre ((,class :inherit modus-themes-fixed-pitch))) `(telega-msg-heading ((,class :background ,bg-alt))) `(telega-msg-self-title ((,class :inherit bold))) `(telega-root-heading ((,class :inherit modus-themes-subtle-neutral))) @@ -7329,9 +7491,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(telega-user-online-status ((,class :foreground ,cyan-active))) `(telega-username ((,class :foreground ,cyan-alt-other))) `(telega-webpage-chat-link ((,class :background ,bg-alt))) - `(telega-webpage-fixed ((,class :inherit fixed-pitch :height 0.85))) + `(telega-webpage-fixed ((,class :inherit modus-themes-fixed-pitch :height 0.85))) `(telega-webpage-header ((,class :inherit modus-themes-variable-pitch :height 1.3))) - `(telega-webpage-preformatted ((,class :inherit fixed-pitch :background ,bg-alt))) + `(telega-webpage-preformatted ((,class :inherit modus-themes-fixed-pitch :background ,bg-alt))) `(telega-webpage-subheader ((,class :inherit modus-themes-variable-pitch :height 1.15))) ;;;;; telephone-line `(telephone-line-accent-active ((,class :background ,fg-inactive :foreground ,bg-inactive))) @@ -7383,10 +7545,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(transient-heading ((,class :inherit bold :foreground ,fg-main))) `(transient-inactive-argument ((,class :inherit shadow))) `(transient-inactive-value ((,class :inherit shadow))) - ;; FIXME 2021-08-28: using `modus-themes-key-binding' leads to - ;; misalignments because of the added box property. - ;; `(transient-key ((,class :inherit modus-themes-key-binding))) - `(transient-key ((,class :inherit bold :foreground ,blue-alt-other))) + `(transient-key ((,class :inherit modus-themes-key-binding))) `(transient-mismatched-key ((,class :underline t))) `(transient-nonstandard-key ((,class :underline t))) `(transient-pink ((,class :inherit bold :foreground ,magenta-alt-faint))) @@ -7473,10 +7632,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(vc-dir-header-value ((,class :foreground ,magenta-alt-other))) `(vc-dir-mark-indicator ((,class :foreground ,blue-alt-other))) `(vc-dir-status-edited ((,class :foreground ,yellow))) - `(vc-dir-status-ignored ((,class :foreground ,fg-unfocused))) + `(vc-dir-status-ignored ((,class :inherit shadow))) `(vc-dir-status-up-to-date ((,class :foreground ,cyan))) - `(vc-dir-status-warning ((,class :foreground ,red))) - `(vc-conflict-state ((,class :inherit modus-themes-slant :foreground ,red-active))) + `(vc-dir-status-warning ((,class :inherit error))) + `(vc-conflict-state ((,class :inherit bold :foreground ,red-active))) `(vc-edited-state ((,class :foreground ,yellow-active))) `(vc-locally-added-state ((,class :foreground ,cyan-active))) `(vc-locked-state ((,class :foreground ,blue-active))) @@ -7498,6 +7657,9 @@ by virtue of calling either of `modus-themes-load-operandi' and :background ,@(pcase modus-themes-completions ('opinionated (list bg-active)) (_ (list bg-inactive)))))) +;;;;; vertico-quick + `(vertico-quick1 ((,class :inherit (modus-themes-intense-magenta bold)))) + `(vertico-quick2 ((,class :inherit (modus-themes-refine-cyan bold)))) ;;;;; vimish-fold `(vimish-fold-fringe ((,class :foreground ,cyan-active))) `(vimish-fold-mouse-face ((,class :inherit modus-themes-intense-blue))) diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 919009278b1..6dffbf07e94 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -4,8 +4,8 @@ ;; Author: Protesilaos Stavrou ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 1.6.0 -;; Package-Requires: ((emacs "26.1")) +;; Version: 1.7.0 +;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. From 71f237d668044d613546cb3cbf82a8c66c2cf4db Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Nov 2021 19:13:48 +0200 Subject: [PATCH 114/367] * lisp/vc/diff-mode.el (diff-minor-mode-prefix): Fix typo from 44faf54659 --- lisp/vc/diff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 1cffd88a56f..8f83aa580e4 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -264,7 +264,7 @@ and hunk-based syntax highlighting otherwise as a fallback." :help "Go to the next count'th file"] )) -(defcustom diff-minor-mode-prefix "\C-c ==" +(defcustom diff-minor-mode-prefix "\C-c=" "Prefix key for `diff-minor-mode' commands." :type '(choice (string "ESC") (string "\C-c=") string)) From 4da785ec9826edd0d7effb46309a8593133896f2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Nov 2021 19:17:52 +0200 Subject: [PATCH 115/367] ; Minor fixes of doc strings in xdisp.c * src/xdisp.c (syms_of_xdisp) : Doc fix. --- src/xdisp.c | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index d7ad5489171..ef49297e0fe 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35934,11 +35934,13 @@ message displayed by its counterpart function specified by Vclear_message_function = Qnil; DEFVAR_LISP ("redisplay--all-windows-cause", Vredisplay__all_windows_cause, - doc: /* */); + doc: /* Code of the cause for redisplaying all windows. +Internal use only. */); Vredisplay__all_windows_cause = Fmake_hash_table (0, NULL); DEFVAR_LISP ("redisplay--mode-lines-cause", Vredisplay__mode_lines_cause, - doc: /* */); + doc: /* Code of the cause for redisplaying mode lines. +Internal use only. */); Vredisplay__mode_lines_cause = Fmake_hash_table (0, NULL); DEFVAR_BOOL ("redisplay--inhibit-bidi", redisplay__inhibit_bidi, @@ -35964,10 +35966,11 @@ mouse stays within the extent of a single glyph (except for images). */); tab_bar__dragging_in_progress = false; DEFVAR_BOOL ("redisplay-skip-initial-frame", redisplay_skip_initial_frame, - doc: /* Non-nil to skip redisplay in initial frame. -The initial frame is not displayed anywhere, so skipping it is -best except in special circumstances such as running redisplay tests -in batch mode. */); + doc: /* Non-nil means skip redisplay of the initial frame. +The initial frame is the text-mode frame used by Emacs internally during +the early stages of startup. That frame is not displayed anywhere, so +skipping it is best except in special circumstances such as running +redisplay tests in batch mode. */); redisplay_skip_initial_frame = true; DEFVAR_BOOL ("redisplay-skip-fontification-on-input", From 5c8c3d59ead75df199f31b892f17f8a0a101a62c Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Nov 2021 19:24:35 +0200 Subject: [PATCH 116/367] * lisp/tab-bar.el: Avoid micro-steps in tab-bar-history-back/forward. * lisp/tab-bar.el (tab-bar-history-pre-command) (tab-bar-history-done-command): New variables. (tab-bar--history-pre-change): Set 'tab-bar-history-omit' and 'tab-bar-history-pre-command'. (tab-bar--history-change): Use 'tab-bar-history-done-command' and 'tab-bar-history-pre-command' (bug#51370). --- lisp/tab-bar.el | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 871ed1c9817..9e554f718f3 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1802,10 +1802,19 @@ Interactively, prompt for GROUP-NAME." (defvar tab-bar-history-old nil "Window configuration before the current command.") +(defvar tab-bar-history-pre-command nil + "Command set to `this-command' by `pre-command-hook'.") + +(defvar tab-bar-history-done-command nil + "Command handled by `window-configuration-change-hook'.") + (defvar tab-bar-history-old-minibuffer-depth 0 "Minibuffer depth before the current command.") (defun tab-bar--history-pre-change () + ;; Reset before the command could set it + (setq tab-bar-history-omit nil) + (setq tab-bar-history-pre-command this-command) (setq tab-bar-history-old-minibuffer-depth (minibuffer-depth)) ;; Store window-configuration before possibly entering the minibuffer. (when (zerop tab-bar-history-old-minibuffer-depth) @@ -1814,8 +1823,10 @@ Interactively, prompt for GROUP-NAME." (wc-point . ,(point-marker)))))) (defun tab-bar--history-change () - (when (and (not tab-bar-history-omit) - tab-bar-history-old + (when (and (not tab-bar-history-omit) tab-bar-history-old + ;; Don't register changes performed by the same command + ;; repeated in sequence, such as incremental window resizing. + (not (eq tab-bar-history-done-command tab-bar-history-pre-command)) ;; Store window-configuration before possibly entering ;; the minibuffer. (zerop tab-bar-history-old-minibuffer-depth)) @@ -1824,8 +1835,8 @@ Interactively, prompt for GROUP-NAME." (gethash (selected-frame) tab-bar-history-back)) tab-bar-history-limit) tab-bar-history-back)) - (when tab-bar-history-omit - (setq tab-bar-history-omit nil))) + (setq tab-bar-history-old nil) + (setq tab-bar-history-done-command tab-bar-history-pre-command)) (defun tab-bar-history-back () "Restore a previous window configuration used in the current tab. From a4e789c2e32dd16898529ece30bd2a90cef40c10 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Nov 2021 19:27:46 +0200 Subject: [PATCH 117/367] * lisp/tab-bar.el: Optimize data usage for nil tab-bar-history-mode. * lisp/tab-bar.el (tab-bar--tab): Add wc-history-back and wc-history-forward only when tab-bar-history-mode is non-nil. (tab-bar-select-tab): Use wc-history-back and wc-history-forward only when tab-bar-history-mode is non-nil. (tab-bar-new-tab-to): Reset tab-bar-history-back and tab-bar-history-forward to nil. --- lisp/tab-bar.el | 34 +++++++++++++++++++++------------- 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 9e554f718f3..c2bf3021b08 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -980,10 +980,11 @@ on the tab bar instead." (wc-point . ,(point-marker)) (wc-bl . ,bl) (wc-bbl . ,bbl) - (wc-history-back . ,(gethash (or frame (selected-frame)) - tab-bar-history-back)) - (wc-history-forward . ,(gethash (or frame (selected-frame)) - tab-bar-history-forward)) + ,@(when tab-bar-history-mode + `((wc-history-back . ,(gethash (or frame (selected-frame)) + tab-bar-history-back)) + (wc-history-forward . ,(gethash (or frame (selected-frame)) + tab-bar-history-forward)))) ;; Copy other possible parameters ,@(mapcan (lambda (param) (unless (memq (car param) @@ -1124,19 +1125,21 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (when wc-bl (set-frame-parameter nil 'buffer-list wc-bl)) (when wc-bbl (set-frame-parameter nil 'buried-buffer-list wc-bbl)) - (puthash (selected-frame) - (and (window-configuration-p (alist-get 'wc (car wc-history-back))) - wc-history-back) - tab-bar-history-back) - (puthash (selected-frame) - (and (window-configuration-p (alist-get 'wc (car wc-history-forward))) - wc-history-forward) - tab-bar-history-forward))) + (when tab-bar-history-mode + (puthash (selected-frame) + (and (window-configuration-p (alist-get 'wc (car wc-history-back))) + wc-history-back) + tab-bar-history-back) + (puthash (selected-frame) + (and (window-configuration-p (alist-get 'wc (car wc-history-forward))) + wc-history-forward) + tab-bar-history-forward)))) (ws (window-state-put ws nil 'safe))) - (setq tab-bar-history-omit t) + (when tab-bar-history-mode + (setq tab-bar-history-omit t)) (when from-index (setf (nth from-index tabs) from-tab)) @@ -1386,6 +1389,11 @@ After the tab is created, the hooks in ;; `pushnew' handles the head of tabs but not frame-parameter (tab-bar-tabs-set tabs)) + (when tab-bar-history-mode + (puthash (selected-frame) nil tab-bar-history-back) + (puthash (selected-frame) nil tab-bar-history-forward) + (setq tab-bar-history-omit t)) + (run-hook-with-args 'tab-bar-tab-post-open-functions (nth to-index tabs))) From 6fc94fb99e38960a24ee3a3dc441f85f786a654e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Nov 2021 19:36:42 +0200 Subject: [PATCH 118/367] * lisp/tab-bar.el: Use 'mouse-1' for history buttons like for 'add-tab' button * lisp/tab-bar.el (tab-bar-mouse-down-1, tab-bar-mouse-1): Handle clicks for 'history-back' and 'history-forward' the same way as 'add-tab' clicks. --- lisp/tab-bar.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 871ed1c9817..ca1087e827d 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -284,7 +284,8 @@ existing tab." (setq tab-bar--dragging-in-progress t) ;; Don't close the tab when clicked on the close button. Also ;; don't add new tab on down-mouse. Let `tab-bar-mouse-1' do this. - (unless (or (eq (car item) 'add-tab) (nth 2 item)) + (unless (or (memq (car item) '(add-tab history-back history-forward)) + (nth 2 item)) (if (functionp (nth 1 item)) (call-interactively (nth 1 item)) (unless (eq tab-number t) @@ -298,7 +299,8 @@ regardless of where you click on it. Also add a new tab." (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) (cond - ((and (eq (car item) 'add-tab) (functionp (nth 1 item))) + ((and (memq (car item) '(add-tab history-back history-forward)) + (functionp (nth 1 item))) (call-interactively (nth 1 item))) ((and (nth 2 item) (not (eq tab-number t))) (tab-bar-close-tab tab-number))))) From bf824843f40a8235e2cdfc6d84d67ea2e2e96acb Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 18 Nov 2021 19:42:44 +0200 Subject: [PATCH 119/367] * lisp/repeat.el (describe-repeat-maps): Print all bound keys (bug#49265). --- lisp/repeat.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index 45201ad1aa6..4dcd353e346 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -533,10 +533,12 @@ Used in `repeat-mode'." (dolist (command (sort (cdr keymap) 'string-lessp)) (let* ((info (help-fns--analyze-function command)) (map (list (symbol-value (car keymap)))) - (desc (key-description - (or (where-is-internal command map t) - (where-is-internal (nth 3 info) map t))))) - (princ (format-message " `%s' (bound to '%s')\n" command desc)))) + (desc (mapconcat (lambda (key) + (format-message "`%s'" (key-description key))) + (or (where-is-internal command map) + (where-is-internal (nth 3 info) map)) + ", "))) + (princ (format-message " `%s' (bound to %s)\n" command desc)))) (princ "\n")))))) (provide 'repeat) From 14271d050a30b8121358361ba671ba29493e03dd Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Nov 2021 20:23:58 +0200 Subject: [PATCH 120/367] Fix flyspell-correct-word selected from context menu opened with the keyboard * lisp/mouse.el (context-menu-open): Call interactively a command returned by `context-menu-map' such as `flyspell-correct-word' (bug#50067). * lisp/textmodes/flyspell.el (flyspell-correct-word): Handle the case when it's called by a key bound to `context-menu-open'. Then it should work the same way as `C-c $' typed on misspelled word where the arg `event' of `flyspell-correct-word-before-point' is nil. --- lisp/mouse.el | 7 +++++-- lisp/textmodes/flyspell.el | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index 091383bf110..b6448a13f3a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -541,8 +541,11 @@ activates the menu whose contents depends on its surrounding context." "Start key navigation of the context menu. This is the keyboard interface to \\[context-menu-map]." (interactive) - (let ((inhibit-mouse-event-check t)) - (popup-menu (context-menu-map) (point)))) + (let ((inhibit-mouse-event-check t) + (map (context-menu-map))) + (if (commandp map) + (call-interactively map) + (popup-menu map (point))))) (global-set-key [S-f10] 'context-menu-open) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 1d450b50012..258e5fde674 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -2160,7 +2160,7 @@ The word checked is the word at the mouse position." (interactive "e") (let ((save (point))) (mouse-set-point event) - (flyspell-correct-word-before-point event save))) + (flyspell-correct-word-before-point (and (consp event) event) save))) (defun flyspell-correct-word-before-point (&optional event opoint) "Pop up a menu of possible corrections for misspelled word before point. From 03fba4da8fc689dabc65e693631cd17d819b5135 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 18 Nov 2021 19:35:13 +0100 Subject: [PATCH 121/367] Do not exclude emacs-module-tests.el on emba * test/infra/gitlab-ci.yml (test-native-comp-speed0) (test-all-inotify): Do not exclude emacs-module-tests.el. * test/src/emacs-module-tests.el (module--test-assertions--load-non-live-object) (module--test-assertions--load-non-live-object-with-global-copy) (module--test-assertions--call-emacs-from-gc) (module--test-assertions--globref-invalid-free): Tag them as :unstable on emba. (Bug#50902) --- test/infra/gitlab-ci.yml | 6 ++---- test/src/emacs-module-tests.el | 6 +++++- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 001c7795725..096a293b302 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -302,9 +302,7 @@ test-native-comp-speed0: extends: [.job-template, .test-template, .native-comp-template] variables: target: emacs-native-comp-speed0 - make_params: >- - -C test check EXCLUDE_TESTS=%emacs-module-tests.el - SELECTOR='(not (tag :unstable))' + make_params: "-C test check SELECTOR='(not (tag :unstable))'" test-all-inotify: # This tests also file monitor libraries inotify and inotifywatch. @@ -317,7 +315,7 @@ test-all-inotify: - if: '$CI_PIPELINE_SOURCE == "schedule"' variables: target: emacs-inotify - make_params: check-expensive EXCLUDE_TESTS=%emacs-module-tests.el + make_params: check-expensive # Two hours. EMACS_TEST_TIMEOUT: 7200 diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 442bca5facb..988b311f5b5 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -247,6 +247,7 @@ must evaluate to a regular expression string." (ert-deftest module--test-assertions--load-non-live-object () "Check that -module-assertions verify that non-live objects aren't accessed." + :tags (if (getenv "EMACS_EMBA_CI") '(:unstable)) (skip-unless (or (file-executable-p mod-test-emacs) (and (eq system-type 'windows-nt) (file-executable-p (concat mod-test-emacs ".exe"))))) @@ -265,6 +266,7 @@ must evaluate to a regular expression string." This differs from `module--test-assertions-load-non-live-object' in that it stows away a global reference. The module assertions should nevertheless detect the invalid load." + :tags (if (getenv "EMACS_EMBA_CI") '(:unstable)) (skip-unless (or (file-executable-p mod-test-emacs) (and (eq system-type 'windows-nt) (file-executable-p (concat mod-test-emacs ".exe"))))) @@ -281,6 +283,7 @@ should nevertheless detect the invalid load." (ert-deftest module--test-assertions--call-emacs-from-gc () "Check that -module-assertions prevents calling Emacs functions during garbage collection." + :tags (if (getenv "EMACS_EMBA_CI") '(:unstable)) (skip-unless (or (file-executable-p mod-test-emacs) (and (eq system-type 'windows-nt) (file-executable-p (concat mod-test-emacs ".exe"))))) @@ -292,7 +295,8 @@ during garbage collection." (ert-deftest module--test-assertions--globref-invalid-free () "Check that -module-assertions detects invalid freeing of a local reference." - (skip-unless (or (file-executable-p mod-test-emacs) + :tags (if (getenv "EMACS_EMBA_CI") '(:unstable)) + (skip-unless (or (file-executable-p mod-test-emacs) (and (eq system-type 'windows-nt) (file-executable-p (concat mod-test-emacs ".exe"))))) (module--test-assertion From 02853edba795b0d47201977d3b500e8a46ed5e0f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Nov 2021 20:36:55 +0200 Subject: [PATCH 122/367] Fix sorting of menus in `context-menu-local' (bug#50067). * lisp/menu-bar.el (menu-bar-keymap): Don't use `lookup-key' on the `keymap' arg. * lisp/mouse.el (context-menu-global): Use `lookup-key global-map' for the `keymap' arg of `menu-bar-keymap'. (context-menu-local): Use `menu-bar-keymap' to sort `keymap'. --- lisp/menu-bar.el | 2 +- lisp/mouse.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index f19dc9e7c97..da79aae5295 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2715,7 +2715,7 @@ could provide `global-map' where items are limited to the global map only." ;; sorting. (push (cons pos menu-item) menu-end) (push menu-item menu-bar)))) - (lookup-key (or keymap (menu-bar-current-active-maps)) [menu-bar])) + (or keymap (lookup-key (menu-bar-current-active-maps) [menu-bar]))) `(keymap ,@(nreverse menu-bar) ,@(mapcar #'cdr (sort menu-end (lambda (a b) diff --git a/lisp/mouse.el b/lisp/mouse.el index b6448a13f3a..0a4ab2878ab 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -364,7 +364,7 @@ Some context functions add menu items below the separator." (when (consp binding) (define-key-after menu (vector key) (copy-sequence binding)))) - (menu-bar-keymap global-map)) + (menu-bar-keymap (lookup-key global-map [menu-bar]))) menu) (defun context-menu-local (menu _click) @@ -377,7 +377,7 @@ Some context functions add menu items below the separator." (when (consp binding) (define-key-after menu (vector key) (copy-sequence binding)))) - keymap))) + (menu-bar-keymap keymap)))) menu) (defun context-menu-minor (menu _click) From 09a5dd862832ffe82914baeab0ba7d4a0ab5fb62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Nov 2021 15:05:47 +0100 Subject: [PATCH 123/367] String backslash corrections * lisp/net/shr.el (shr-tag-video): Remove ineffective backslash. * test/lisp/emacs-lisp/package-tests.el (package-test-macro-compilation-gz): Make dot literal as intended. --- lisp/net/shr.el | 2 +- test/lisp/emacs-lisp/package-tests.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index b9e8a18e25a..5a36f19c5f1 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1697,7 +1697,7 @@ The preference is a float determined from `shr-prefer-media-type'." (xwidget-webkit-execute-script widget (format "document.body.innerHTML = %S;" (format - "
" + "
" url))))) ;; No xwidgets. (if (> (length image) 0) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 3b12f57e5ce..efa9f834110 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -383,7 +383,7 @@ but with a different end of line convention (bug#48137)." (mapc #'delete-file (directory-files-recursively dir "\\`[^\\.].*\\.elc\\'")) (mapc (lambda (f) (call-process "gunzip" nil nil nil f)) - (directory-files-recursively dir "\\`[^\\.].*\\.el.gz\\'")))))) + (directory-files-recursively dir "\\`[^\\.].*\\.el\\.gz\\'")))))) (ert-deftest package-test-install-two-dependencies () "Install a package which includes a dependency." From 69f1bc43c026049ed2aab6a6368e2e9a5406b779 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Nov 2021 20:14:02 +0100 Subject: [PATCH 124/367] Turn mistaken functions into tests (bug#51941) * test/lisp/calendar/icalendar-tests.el (icalendar-tests--decode-isodatetime): * test/src/eval-tests.el (eval-tests-19790-backquote-comma-dot-substitution): Change `defun` into `ert-deftest` where this seems to have been the original intention. --- test/lisp/calendar/icalendar-tests.el | 2 +- test/src/eval-tests.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 9e8a8e7b479..10b684aacbe 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -1633,7 +1633,7 @@ SUMMARY:NNN Wwwwwwww Wwwww - Aaaaaa Pppppppp rrrrrr ddd oo Nnnnnnnn 30 (let ((time (icalendar--decode-isodatetime string day zone))) (format-time-string "%FT%T%z" (encode-time time) 0))) -(defun icalendar-tests--decode-isodatetime (_ical-string) +(ert-deftest icalendar-tests--decode-isodatetime () "Test `icalendar--decode-isodatetime'." (should (equal (icalendar-test--format "20040917T050910-0200") "2004-09-17T03:09:10+0000")) diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 3c3e7033419..4f05d99136b 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -179,7 +179,7 @@ are found on the stack and therefore not garbage collected." "Remove the Lisp reference to the byte-compiled object." (setf (symbol-function #'eval-tests-33014-func) nil)) -(defun eval-tests-19790-backquote-comma-dot-substitution () +(ert-deftest eval-tests-19790-backquote-comma-dot-substitution () "Regression test for Bug#19790. Don't handle destructive splicing in backquote expressions (like in Common Lisp). Instead, make sure substitution in backquote From d7a2af593984820763f8597c2ed378d4da869aaa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Nov 2021 22:02:43 -0500 Subject: [PATCH 125/367] * lisp/net/mailcap.el (mailcap-parse-mailcaps): Fix $MAILCAPS case --- lisp/net/mailcap.el | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 2c687557181..14d49251f55 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -55,7 +55,7 @@ you have an entry for \"image/*\" in your ~/.mailcap file." "A syntax table for parsing SGML attributes.") (defvar mailcap-print-command - (mapconcat 'identity + (mapconcat #'identity (cons (if (boundp 'lpr-command) lpr-command "lpr") @@ -116,8 +116,7 @@ is consulted." (regexp :tag "MIME Type") (sexp :tag "Test (optional)"))) :get #'mailcap--get-user-mime-data - :set #'mailcap--set-user-mime-data - :group 'mailcap) + :set #'mailcap--set-user-mime-data) ;; Postpone using defcustom for this as it's so big and we essentially ;; have to have two copies of the data around then. Perhaps just @@ -344,8 +343,7 @@ Same format as `mailcap-mime-data'.") "Directory to which `mailcap-save-binary-file' downloads files by default. nil means your home directory." :type '(choice (const :tag "Home directory" nil) - directory) - :group 'mailcap) + directory)) (defvar mailcap-poor-system-types '(ms-dos windows-nt) @@ -439,6 +437,8 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus ("/etc/mailcap" system) ("/usr/etc/mailcap" system) ("/usr/local/etc/mailcap" system))))) + (when (stringp path) + (setq path (mapcar #'list (split-string path path-separator t)))) (when (seq-some (lambda (f) (file-has-changed-p (car f) 'mail-parse-mailcaps)) path) @@ -451,14 +451,9 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus do (cl-loop for (minor . entry) in minors do (mailcap-add-mailcap-entry major minor entry))) ;; The ~/.mailcap entries will end up first in the resulting data. - (dolist (spec (reverse - (if (stringp path) - (split-string path path-separator t) - path))) - (let ((source (and (consp spec) (cadr spec))) - (file-name (if (stringp spec) - spec - (car spec)))) + (dolist (spec (reverse path)) + (let ((source (cadr spec)) + (file-name (car spec))) (when (and (file-readable-p file-name) (file-regular-p file-name)) (mailcap-parse-mailcap file-name source))))) @@ -639,7 +634,7 @@ the test clause will be unchanged." ((and (listp test) (symbolp (car test))) test) ((or (stringp test) (and (listp test) (stringp (car test)) - (setq test (mapconcat 'identity test " ")))) + (setq test (mapconcat #'identity test " ")))) (with-temp-buffer (insert test) (goto-char (point-min)) @@ -710,12 +705,12 @@ to supply to the test." (symbol-value test)) ((and (listp test) ; List to be eval'd (symbolp (car test))) - (eval test)) + (eval test t)) (t (setq test (mailcap-unescape-mime-test test type-info) test (list shell-file-name nil nil nil shell-command-switch test) - status (apply 'call-process test)) + status (apply #'call-process test)) (eq 0 status)))) (push (list otest result) mailcap-viewer-test-cache) result)))) @@ -840,7 +835,7 @@ If NO-DECODE is non-nil, don't decode STRING." (dolist (entry viewers) (when (mailcap-viewer-passes-test entry info) (push entry passed))) - (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) + (setq passed (sort (nreverse passed) #'mailcap-viewer-lessp)) ;; When we want to prefer entries from the user's ;; ~/.mailcap file, then we filter out the system entries ;; and see whether we have anything left. @@ -1070,7 +1065,7 @@ For instance, \"foo.png\" will result in \"image/png\"." ;;;###autoload (defun mailcap-mime-type-to-extension (mime-type) - "Return a file name extension based on a mime type. + "Return a file name extension based on a MIME-TYPE. For instance, `image/png' will result in `png'." (intern (cadr (split-string (if (symbolp mime-type) (symbol-name mime-type) @@ -1082,7 +1077,7 @@ For instance, `image/png' will result in `png'." (mailcap-parse-mimetypes) (delete-dups (nconc - (mapcar 'cdr mailcap-mime-extensions) + (mapcar #'cdr mailcap-mime-extensions) (let (res type) (dolist (data mailcap--computed-mime-data) (dolist (info (cdr data)) From 64497fb8cc62c9c8302a20d54fc52e3113b0983e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Nov 2021 22:06:50 -0500 Subject: [PATCH 126/367] * lisp/files.el (file-has-changed-p): Index the cache with absolute file names --- lisp/files.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 49bf06bfc1b..1979f1bbe3d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6224,8 +6224,7 @@ of `file-has-changed-p' always returns non-nil when FILE exists. The optional argument TAG, which must be a symbol, can be used to limit the comparison to invocations with identical tags; it can be the symbol of the calling function, for example." - (let* (;; FIXME: Shall we use `file-truename'? - (file (directory-file-name file)) + (let* ((file (directory-file-name (expand-file-name file))) (remote-file-name-inhibit-cache t) (fileattr (file-attributes file 'integer)) (attr (and fileattr From 7138e69fdcf2d9f8cfe6bebf750f7f04b6ee6286 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 19 Nov 2021 12:26:08 +0800 Subject: [PATCH 127/367] Fix documentation on xwidgets * doc/lispref/display.texi (Xwidgets): Refer to correct function. --- doc/lispref/display.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index dd2c6e003f4..8decff6fa8f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6807,7 +6807,7 @@ subprocesses with. The xwidget that is returned will be killed alongside its buffer (@pxref{Killing Buffers}). You can also kill it using -@code{xwidget-kill}. Once it is killed, the xwidget may continue to +@code{kill-xwidget}. Once it is killed, the xwidget may continue to exist as a Lisp object and act as a @code{display} property until all references to it are gone, but most actions that can be performed on live xwidgets will no longer be available. From 3f096eb3405b2fce7c35366eb2dcf025dda55783 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 19 Nov 2021 07:42:12 +0100 Subject: [PATCH 128/367] Make UCS compose/decompose functions more understandable * lisp/international/ucs-normalize.el () (ucs-normalize-NFD-region, ucs-normalize-NFD-string) (ucs-normalize-NFC-region, ucs-normalize-NFC-string) (ucs-normalize-NFKD-region, ucs-normalize-NFKD-string) (ucs-normalize-NFKC-region, ucs-normalize-NFKC-string): Make the doc strings say what they actually do. --- lisp/emacs-lisp/shortdoc.el | 9 +++- lisp/international/ucs-normalize.el | 75 +++++++++++++++++++++-------- 2 files changed, 61 insertions(+), 23 deletions(-) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 157209fcf74..ba08e68af57 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -159,8 +159,6 @@ There can be any number of :example/:result elements." :eval (split-string-and-unquote "foo \"bar zot\"")) (split-string-shell-command :eval (split-string-shell-command "ls /tmp/'foo bar'")) - (string-glyph-split - :eval (string-glyph-split "Hello, 👼🏻🧑🏼‍🤝‍🧑🏻")) (string-lines :eval (string-lines "foo\n\nbar") :eval (string-lines "foo\n\nbar" t)) @@ -198,6 +196,13 @@ There can be any number of :example/:result elements." :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) (try-completion :eval (try-completion "foo" '("foobar" "foozot" "gazonk"))) + "Unicode Strings" + (string-glyph-split + :eval (string-glyph-split "Hello, 👼🏻🧑🏼‍🤝‍🧑🏻")) + (string-glyph-compose + :eval (string-glyph-compose "Å")) + (string-glyph-decompose + :eval (string-glyph-decompose "Å")) "Predicates for Strings" (string-equal :eval (string-equal "foo" "foo")) diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index 0f8dedfc09b..c6a562e3f52 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -536,55 +536,88 @@ COMPOSITION-PREDICATE will be used to compose region." (,ucs-normalize-region (point-min) (point-max)) (buffer-string))) -;;;###autoload (defun ucs-normalize-NFD-region (from to) - "Normalize the current region by the Unicode NFD." + "Decompose the current region according to the Unicode NFD. +This is the canonical decomposed form." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfd-quick-check-regexp 'ucs-normalize-nfd-table nil)) -;;;###autoload + (defun ucs-normalize-NFD-string (str) - "Normalize the string STR by the Unicode NFD." + "Decompose the string STR according to the Unicode NFD. +This is the canonical decomposed form. For instance: + + (ucs-normalize-NFD-string \"Å\") => \"Å\"" (ucs-normalize-string ucs-normalize-NFD-region)) -;;;###autoload (defun ucs-normalize-NFC-region (from to) - "Normalize the current region by the Unicode NFC." + "Compose the current region according to the Unicode NFC. +This is the canonical composed form." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfc-quick-check-regexp 'ucs-normalize-nfd-table t)) -;;;###autoload -(defun ucs-normalize-NFC-string (str) - "Normalize the string STR by the Unicode NFC." - (ucs-normalize-string ucs-normalize-NFC-region)) ;;;###autoload +(defun string-glyph-compose (string) + "Compose the string STR by according to the Unicode NFC. +This is the canonical composed form. For instance: + + (string-glyph-compose \"Å\") => \"Å\"" + (ucs-normalize-NFC-string string)) + +;;;###autoload +(defun string-glyph-decompose (string) + "Decompose the string STR according to the Unicode NFD. +This is the canonical decomposed form. For instance: + + (string-glyph-decompose \"Å\") => \"Å\"" + (ucs-normalize-NFD-string string)) + +(defun ucs-normalize-NFC-string (str) + "Compose the string STR by according to the Unicode NFC. +This is the canonical composed form. For instance: + + (ucs-normalize-NFC-string \"Å\") => \"Å\"" + (ucs-normalize-string ucs-normalize-NFC-region)) + (defun ucs-normalize-NFKD-region (from to) - "Normalize the current region by the Unicode NFKD." + "Decompose the current region according to the Unicode NFKD. +This is the compatibility decomposed form." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfkd-quick-check-regexp 'ucs-normalize-nfkd-table nil)) -;;;###autoload + (defun ucs-normalize-NFKD-string (str) - "Normalize the string STR by the Unicode NFKD." + "Decompose the string STR according to the Unicode NFKD. +This is the compatibility decomposed form. This is much like the +NFD (canonical decomposed) form, but mainly differs in glyphs +with formatting distinctions. For instance: + + (ucs-normalize-NFD-string \"fi\") => \"fi\" + (ucs-normalize-NFKD-string \"fi\") = \"fi\"" (ucs-normalize-string ucs-normalize-NFKD-region)) -;;;###autoload (defun ucs-normalize-NFKC-region (from to) - "Normalize the current region by the Unicode NFKC." + "Compose the current region according to the Unicode NFKC. +The is the compatibility composed form." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfkc-quick-check-regexp 'ucs-normalize-nfkd-table t)) -;;;###autoload + (defun ucs-normalize-NFKC-string (str) - "Normalize the string STR by the Unicode NFKC." + "Compose the string STR according to the Unicode NFKC. +This is the compatibility composed form. This is much like the +NFC (canonical composed) form, but mainly differs in glyphs +with formatting distinctions. For instance: + + (ucs-normalize-NFC-string \"fi\") => \"fi\" + (ucs-normalize-NFKC-string \"fi\") = \"fi\"" (ucs-normalize-string ucs-normalize-NFKC-region)) -;;;###autoload (defun ucs-normalize-HFS-NFD-region (from to) "Normalize the current region by the Unicode NFD and Mac OS's HFS Plus." (interactive "r") @@ -592,18 +625,18 @@ COMPOSITION-PREDICATE will be used to compose region." ucs-normalize-hfs-nfd-quick-check-regexp 'ucs-normalize-hfs-nfd-table 'ucs-normalize-hfs-nfd-comp-p)) -;;;###autoload + (defun ucs-normalize-HFS-NFD-string (str) "Normalize the string STR by the Unicode NFD and Mac OS's HFS Plus." (ucs-normalize-string ucs-normalize-HFS-NFD-region)) -;;;###autoload + (defun ucs-normalize-HFS-NFC-region (from to) "Normalize the current region by the Unicode NFC and Mac OS's HFS Plus." (interactive "r") (ucs-normalize-region from to ucs-normalize-hfs-nfc-quick-check-regexp 'ucs-normalize-hfs-nfd-table t)) -;;;###autoload + (defun ucs-normalize-HFS-NFC-string (str) "Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus." (ucs-normalize-string ucs-normalize-HFS-NFC-region)) From 19e78601a03c96731f4c01c38a0966b5e27e57f3 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 19 Nov 2021 07:42:25 +0100 Subject: [PATCH 129/367] Regenerate ldefs-boot --- lisp/ldefs-boot.el | 123 +++++++++++++++++++-------------------------- 1 file changed, 53 insertions(+), 70 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 2eae134e3d1..613d9734ae5 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -1,4 +1,5 @@ ;;; loaddefs.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; This file will be copied to ldefs-boot.el and checked in periodically. ;; ;;; Code: @@ -2381,12 +2382,7 @@ a reflection. (define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite) (define-key ctl-x-r-map "l" 'bookmark-bmenu-list) -(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "D" 'bookmark-delete-all) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\ -Keymap containing bindings to bookmark functions. -It is not bound to any key by default: to bind it -so that you have a bookmark prefix, just use `global-set-key' and bind a -key of your choice to variable `bookmark-map'. All interactive bookmark -functions have a binding in this keymap.") +(defvar-keymap bookmark-map :doc "Keymap containing bindings to bookmark functions.\nIt is not bound to any key by default: to bind it\nso that you have a bookmark prefix, just use `global-set-key' and bind a\nkey of your choice to variable `bookmark-map'. All interactive bookmark\nfunctions have a binding in this keymap." "x" #'bookmark-set "m" #'bookmark-set "M" #'bookmark-set-no-overwrite "j" #'bookmark-jump "g" #'bookmark-jump "o" #'bookmark-jump-other-window "5" #'bookmark-jump-other-frame "i" #'bookmark-insert "e" #'edit-bookmarks "f" #'bookmark-insert-location "r" #'bookmark-rename "d" #'bookmark-delete "D" #'bookmark-delete-all "l" #'bookmark-load "w" #'bookmark-write "s" #'bookmark-save) (fset 'bookmark-map bookmark-map) (autoload 'bookmark-set "bookmark" "\ @@ -4772,6 +4768,14 @@ space at the end of each line. \(fn &optional NO-ERROR)" t nil) +(autoload 'checkdoc-dired "checkdoc" "\ +In Dired, run `checkdoc' on marked files. +Skip anything that doesn't have the Emacs Lisp library file +extension (\".el\"). +When called from Lisp, FILES is a list of filenames. + +\(fn FILES)" '(dired-mode) nil) + (autoload 'checkdoc-ispell "checkdoc" "\ Check the style and spelling of everything interactively. Calls `checkdoc' with spell-checking turned on. @@ -6755,7 +6759,7 @@ You can set this option through Custom, if you carefully read the last paragraph below. However, usually it is simpler to write something like the following in your init file: -\(setq custom-file \"~/.emacs-custom.el\") +\(setq custom-file \"~/.config/emacs-custom.el\") \(load custom-file) Note that both lines are necessary: the first line tells Custom to @@ -11135,6 +11139,9 @@ Macros in BODY are expanded when the test is defined, not when it is run. If a macro (possibly with side effects) is to be tested, it has to be wrapped in `(eval (quote ...))'. +If NAME is already defined as a test and Emacs is running +in batch mode, an error is signalled. + \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] BODY...)" nil t) (function-put 'ert-deftest 'doc-string-elt '3) @@ -11167,11 +11174,8 @@ the tests). Run the tests specified by SELECTOR and display the results in a buffer. SELECTOR works as described in `ert-select-tests'. -OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they -are used for automated self-tests and specify which buffer to use -and how to display message. -\(fn SELECTOR &optional OUTPUT-BUFFER-NAME MESSAGE-FN)" t nil) +\(fn SELECTOR)" t nil) (defalias 'ert #'ert-run-tests-interactively) @@ -13301,7 +13305,7 @@ retrieval with `flymake-diagnostic-data'. If LOCUS is a buffer BEG and END should be buffer positions inside it. If LOCUS designates a file, BEG and END should be a cons (LINE . COL) indicating a file position. In this second -case, END may be ommited in which case the region is computed +case, END may be omitted in which case the region is computed using `flymake-diag-region' if the diagnostic is appended to an actual buffer. @@ -30412,6 +30416,29 @@ only these files will be asked to be saved. \(fn ARG)" nil nil) +(autoload 'server-stop-automatically "server" "\ +Automatically stop server as specified by ARG. + +If ARG is the symbol `empty', stop the server when it has no +remaining clients, no remaining unsaved file-visiting buffers, +and no running processes with a `query-on-exit' flag. + +If ARG is the symbol `delete-frame', ask the user when the last +frame is deleted whether each unsaved file-visiting buffer must +be saved and each running process with a `query-on-exit' flag +can be stopped, and if so, stop the server itself. + +If ARG is the symbol `kill-terminal', ask the user when the +terminal is killed with \\[save-buffers-kill-terminal] whether each unsaved file-visiting +buffer must be saved and each running process with a `query-on-exit' +flag can be stopped, and if so, stop the server itself. + +Any other value of ARG will cause this function to signal an error. + +This function is meant to be called from the user init file. + +\(fn ARG)" nil nil) + (register-definition-prefixes "server" '("server-")) ;;;*** @@ -30748,7 +30775,7 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any). \(fn GROUP &optional FUNCTION)" t nil) -(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "overlay" "process" "regexp" "sequence" "shortdoc-" "string" "text-properties" "vector")) +(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "keymaps" "list" "number" "overlay" "process" "regexp" "sequence" "shortdoc-" "string" "text-properties" "vector")) ;;;*** @@ -35146,7 +35173,7 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive ;;;;;; 0)) ;;; Generated autoloads from net/tramp-compat.el -(register-definition-prefixes "tramp-compat" '("tramp-")) +(register-definition-prefixes "tramp-compat" '("tramp-compat-")) ;;;*** @@ -35232,7 +35259,7 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 5 2 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 6 0 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -35555,65 +35582,21 @@ You might need to set `uce-mail-reader' before using this. ;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/ucs-normalize.el -(autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ -Normalize the current region by the Unicode NFD. +(autoload 'string-glyph-compose "ucs-normalize" "\ +Compose the string STR by according to the Unicode NFC. +This is the canonical composed form. For instance: -\(fn FROM TO)" t nil) + (ucs-normalize-NFC-string \"Å\") => \"Å\" -(autoload 'ucs-normalize-NFD-string "ucs-normalize" "\ -Normalize the string STR by the Unicode NFD. +\(fn STRING)" nil nil) -\(fn STR)" nil nil) +(autoload 'string-glyph-decompose "ucs-normalize" "\ +Decompose the string STR according to the Unicode NFD. +This is the canonical decomposed form. For instance: -(autoload 'ucs-normalize-NFC-region "ucs-normalize" "\ -Normalize the current region by the Unicode NFC. + (ucs-normalize-NFD-string \"Å\") => \"Å\" -\(fn FROM TO)" t nil) - -(autoload 'ucs-normalize-NFC-string "ucs-normalize" "\ -Normalize the string STR by the Unicode NFC. - -\(fn STR)" nil nil) - -(autoload 'ucs-normalize-NFKD-region "ucs-normalize" "\ -Normalize the current region by the Unicode NFKD. - -\(fn FROM TO)" t nil) - -(autoload 'ucs-normalize-NFKD-string "ucs-normalize" "\ -Normalize the string STR by the Unicode NFKD. - -\(fn STR)" nil nil) - -(autoload 'ucs-normalize-NFKC-region "ucs-normalize" "\ -Normalize the current region by the Unicode NFKC. - -\(fn FROM TO)" t nil) - -(autoload 'ucs-normalize-NFKC-string "ucs-normalize" "\ -Normalize the string STR by the Unicode NFKC. - -\(fn STR)" nil nil) - -(autoload 'ucs-normalize-HFS-NFD-region "ucs-normalize" "\ -Normalize the current region by the Unicode NFD and Mac OS's HFS Plus. - -\(fn FROM TO)" t nil) - -(autoload 'ucs-normalize-HFS-NFD-string "ucs-normalize" "\ -Normalize the string STR by the Unicode NFD and Mac OS's HFS Plus. - -\(fn STR)" nil nil) - -(autoload 'ucs-normalize-HFS-NFC-region "ucs-normalize" "\ -Normalize the current region by the Unicode NFC and Mac OS's HFS Plus. - -\(fn FROM TO)" t nil) - -(autoload 'ucs-normalize-HFS-NFC-string "ucs-normalize" "\ -Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. - -\(fn STR)" nil nil) +\(fn STRING)" nil nil) (register-definition-prefixes "ucs-normalize" '("ucs-normalize-" "utf-8-hfs")) @@ -39738,7 +39721,7 @@ Zone out, completely." t nil) ;;;;;; "international/uni-special-lowercase.el" "international/uni-special-titlecase.el" ;;;;;; "international/uni-special-uppercase.el" "international/uni-titlecase.el" ;;;;;; "international/uni-uppercase.el" "isearch.el" "jit-lock.el" -;;;;;; "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el" +;;;;;; "jka-cmpr-hook.el" "keymap.el" "language/burmese.el" "language/cham.el" ;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el" ;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el" ;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el" From 023dc2ac8fb004c16748fa98223a1fb88cfa2186 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 19 Nov 2021 07:42:55 +0100 Subject: [PATCH 130/367] Make puny-encode-string normalize first * lisp/net/puny.el (puny-encode-string): Normalize before encoding (bug#51954). --- lisp/net/puny.el | 1 + test/lisp/net/puny-tests.el | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/lisp/net/puny.el b/lisp/net/puny.el index 42a7e796798..c1833ffdb0b 100644 --- a/lisp/net/puny.el +++ b/lisp/net/puny.el @@ -43,6 +43,7 @@ For instance, \"fśf.org\" => \"xn--ff-2sa.org\"." "Encode STRING according to the IDNA/punycode algorithm. This is used to encode non-ASCII domain names. For instance, \"bücher\" => \"xn--bcher-kva\"." + (setq string (downcase (string-glyph-compose string))) (let ((ascii (seq-filter (lambda (char) (< char 128)) string))) diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el index 28c0d49cbee..9119084209e 100644 --- a/test/lisp/net/puny-tests.el +++ b/test/lisp/net/puny-tests.el @@ -61,4 +61,11 @@ ;; Only allowed in unrestricted. (should-not (puny-highly-restrictive-domain-p "I♥NY.org"))) +(ert-deftest puny-normalize () + (should (equal (puny-encode-string (string-glyph-compose "Bä.com")) + "xn--b.com-gra")) + (should (equal (puny-encode-string "Bä.com") + "xn--b.com-gra")) + (should (equal (puny-encode-string "Bä.com") "xn--b.com-gra"))) + ;;; puny-tests.el ends here From 5bab11348602b7f5281d3dd76cc7f93f48b18696 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 19 Nov 2021 17:45:03 +0800 Subject: [PATCH 131/367] Add `xwidget-webkit-estimated-load-progress' * doc/lispref/display.texi (Xwidgets): Document new function. * etc/NEWS: Announce new function. * src/xwidget.c (Fxwidget_webkit_estimated_load_progress): New function. (syms_of_xwidget): Define new subr. --- doc/lispref/display.texi | 8 ++++++++ etc/NEWS | 5 +++++ src/xwidget.c | 24 ++++++++++++++++++++++++ 3 files changed, 37 insertions(+) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 8decff6fa8f..e9b50707ded 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7004,6 +7004,14 @@ manually to reach a specific history item. Instead, @var{idx} should be passed as an index to @code{xwidget-webkit-goto-history}. @end defun +@defun xwidget-webkit-estimated-load-progress xwidget +Return an estimate of how much data is remaining to be transferred +before the page displayed by the WebKit widget @var{xwidget} is fully +loaded. + +The value returned is a float ranging between 0.0 and 1.0. +@end defun + @node Buttons @section Buttons @cindex buttons in buffers diff --git a/etc/NEWS b/etc/NEWS index cee2844be3a..ad31b232714 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -863,6 +863,11 @@ for performing searches on WebKit xwidgets. This function is used to obtain the history of page-loads in a given WebKit xwidget. ++++ +*** New function 'xwidget-webkit-estimated-load-progress'. +This function is used to obtain the estimated progress of page loading +in a given WebKit xwidget. + +++ *** 'load-changed' xwidget events are now more detailed. In particular, they can now have different arguments based on the diff --git a/src/xwidget.c b/src/xwidget.c index e1bf40ea437..62b01b741cd 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2555,6 +2555,29 @@ LIMIT is not specified or nil, it is treated as `50'. */) return list3 (back, here, forward); } + +DEFUN ("xwidget-webkit-estimated-load-progress", + Fxwidget_webkit_estimated_load_progress, Sxwidget_webkit_estimated_load_progress, + 1, 1, 0, doc: /* Get the estimated load progress of XWIDGET, a WebKit widget. +Return a value ranging from 0.0 to 1.0, based on how close XWIDGET +is to completely loading its page. */) + (Lisp_Object xwidget) +{ + struct xwidget *xw; + WebKitWebView *webview; + double value; + + CHECK_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + value = webkit_web_view_get_estimated_load_progress (webview); + unblock_input (); + + return make_float (value); +} #endif void @@ -2600,6 +2623,7 @@ syms_of_xwidget (void) #ifdef USE_GTK defsubr (&Sxwidget_webkit_load_html); defsubr (&Sxwidget_webkit_back_forward_list); + defsubr (&Sxwidget_webkit_estimated_load_progress); #endif defsubr (&Skill_xwidget); From 3ec1ab609e0e7d359ca72777aefae80c3c8ec39d Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Fri, 19 Nov 2021 11:05:25 +0100 Subject: [PATCH 132/367] ; * lisp/international/ucs-normalize.el: Fix typo. --- lisp/international/ucs-normalize.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index c6a562e3f52..0c85b490c2a 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -561,7 +561,7 @@ This is the canonical composed form." ;;;###autoload (defun string-glyph-compose (string) - "Compose the string STR by according to the Unicode NFC. + "Compose the string STR according to the Unicode NFC. This is the canonical composed form. For instance: (string-glyph-compose \"Å\") => \"Å\"" From 9f2f69803275e3baa24c717be6c0586812c3aa7c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Nov 2021 11:34:28 +0100 Subject: [PATCH 133/367] Improve doc-view-mode menus * lisp/doc-view.el (doc-view-menu): Extend menu. (doc-view-minor-mode-menu): New menu. --- lisp/doc-view.el | 83 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 69 insertions(+), 14 deletions(-) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 32e2ec1688c..7e113e4f34c 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -493,24 +493,69 @@ Typically \"page-%s.png\".") (easy-menu-define doc-view-menu doc-view-mode-map "Menu for Doc View mode." '("DocView" - ["Toggle display" doc-view-toggle-display] - ("Continuous" - ["Off" (setq doc-view-continuous nil) - :style radio :selected (eq doc-view-continuous nil)] - ["On" (setq doc-view-continuous t) - :style radio :selected (eq doc-view-continuous t)] + ["Next page" doc-view-next-page + :help "Go to the next page"] + ["Previous page" doc-view-previous-page + :help "Go to the previous page"] + ("Other Navigation" + ["Go to page..." doc-view-goto-page + :help "Go to specific page"] "---" - ["Save as Default" - (customize-save-variable 'doc-view-continuous doc-view-continuous) t] + ["First page" doc-view-first-page + :help "View the first page"] + ["Last page" doc-view-last-page + :help "View the last page"] + "---" + ["Move forward" doc-view-scroll-up-or-next-page + :help "Scroll page up or go to next page"] + ["Move backward" doc-view-scroll-down-or-previous-page + :help "Scroll page down or go to previous page"]) + ("Continuous Scrolling" + ["Off" (setq doc-view-continuous nil) + :style radio :selected (eq doc-view-continuous nil) + :help "Scrolling stops at page beginning and end"] + ["On" (setq doc-view-continuous t) + :style radio :selected (eq doc-view-continuous t) + :help "Scrolling continues to next or previous page"] + "---" + ["Save as Default" (customize-save-variable 'doc-view-continuous doc-view-continuous) + :help "Save current continuous scrolling option as default"] ) "---" - ["Set Slice" doc-view-set-slice-using-mouse] - ["Set Slice (BoundingBox)" doc-view-set-slice-from-bounding-box] - ["Set Slice (manual)" doc-view-set-slice] - ["Reset Slice" doc-view-reset-slice] + ("Toggle edit/display" + ["Edit document" doc-view-toggle-display + :style radio :selected (eq major-mode 'doc-view--text-view-mode)] + ["Display document" (lambda ()) ; ignore but show no keybinding + :style radio :selected (eq major-mode 'doc-view-mode)]) + ("Adjust Display" + ["Fit to window" doc-view-fit-page-to-window + :help "Fit the image to the window"] + ["Fit width" doc-view-fit-width-to-window + :help "Fit the image width to the window width"] + ["Fit height" doc-view-fit-height-to-window + :help "Fit the image height to the window height"] + "---" + ["Enlarge" doc-view-enlarge + :help "Enlarge the document"] + ["Shrink" doc-view-shrink + :help "Shrink the document"] + "---" + ["Set Slice" doc-view-set-slice-using-mouse + :help "Set the slice of the images that should be displayed"] + ["Set Slice (BoundingBox)" doc-view-set-slice-from-bounding-box + :help "Set the slice from the document's BoundingBox information"] + ["Set Slice (manual)" doc-view-set-slice + :help "Set the slice of the images that should be displayed"] + ["Reset Slice" doc-view-reset-slice + :help "Reset the current slice" + :enabled (image-mode-window-get 'slice)]) "---" - ["Search" doc-view-search] - ["Search Backwards" doc-view-search-backward] + ["New Search" (doc-view-search t) + :help "Initiate a new search"] + ["Search Forward" doc-view-search + :help "Jump to the next match or initiate a new search"] + ["Search Backward" doc-view-search-backward + :help "Jump to the previous match or initiate a new search"] )) (defvar doc-view-minor-mode-map @@ -520,6 +565,16 @@ Typically \"page-%s.png\".") map) "Keymap used by `doc-view-minor-mode'.") +(easy-menu-define doc-view-minor-mode-menu doc-view-minor-mode-map + "Menu for Doc View minor mode." + '("DocView (edit)" + ("Toggle edit/display" + ["Edit document" (lambda ()) ; ignore but show no keybinding + :style radio :selected (eq major-mode 'doc-view--text-view-mode)] + ["Display document" doc-view-toggle-display + :style radio :selected (eq major-mode 'doc-view-mode)]) + ["Exit DocView Mode" doc-view-minor-mode])) + ;;;; Navigation Commands ;; FIXME: The doc-view-current-* definitions below are macros because they From a5e1f8bbddc0cdf3166f3dbdc8760aa0a093db92 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 19 Nov 2021 18:41:53 +0800 Subject: [PATCH 134/367] Display page loading progress in xwidget webkit * lisp/xwidget.el (xwidget-webkit--title): Remove internal variable. (xwidget-webkit--loading-p) (xwidget-webkit--progress-update-timer): New variables. (xwidget-webkit--update-progress-timer-function): New function. (xwidget-webkit-callback): Set up progress update timer during page loads. (xwidget-webkit-mode): Add page load progress to header line format. --- lisp/xwidget.el | 39 ++++++++++++++++++++++++++++++++++----- 1 file changed, 34 insertions(+), 5 deletions(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 37cf2e5816a..b74e332edf8 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -56,6 +56,7 @@ (declare-function get-buffer-xwidgets "xwidget.c" (buffer)) (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget)) (declare-function xwidget-webkit-back-forward-list "xwidget.c" (xwidget &optional limit)) +(declare-function xwidget-webkit-estimated-load-progress "xwidget.c" (xwidget)) (defgroup xwidget nil "Displaying native widgets in Emacs buffers." @@ -106,9 +107,6 @@ It can use the following special constructs: :type 'string :version "29.1") -(defvar-local xwidget-webkit--title "" - "The title of the WebKit widget, used for the header line.") - ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) "Ask xwidget-webkit to browse URL. @@ -150,6 +148,12 @@ in `split-window-right' with a new xwidget webkit session." (defvar xwidget-webkit--input-method-events nil "Internal variable used to store input method events.") +(defvar-local xwidget-webkit--loading-p nil + "Whether or not a page is being loaded.") + +(defvar-local xwidget-webkit--progress-update-timer nil + "Timer that updates the display of page load progress in the header line.") + (defun xwidget-webkit-pass-command-event-with-input-method () "Handle a `with-input-method' event." (interactive) @@ -384,6 +388,11 @@ If N is omitted or nil, scroll backwards by one char." (when xwidget-callback (funcall xwidget-callback xwidget xwidget-event-type)))) +(defun xwidget-webkit--update-progress-timer-function (xwidget) + "Force an update of the header line of XWIDGET's buffer." + (with-current-buffer (xwidget-buffer xwidget) + (force-mode-line-update))) + (defun xwidget-webkit-callback (xwidget xwidget-event-type) "Callback for xwidgets. XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." @@ -396,6 +405,17 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (when-let ((buffer (get-buffer "*Xwidget WebKit History*"))) (with-current-buffer buffer (revert-buffer))) + (with-current-buffer (xwidget-buffer xwidget) + (if (string-equal (nth 3 last-input-event) + "load-finished") + (progn + (setq xwidget-webkit--loading-p nil) + (cancel-timer xwidget-webkit--progress-update-timer)) + (unless xwidget-webkit--loading-p + (setq xwidget-webkit--loading-p t + xwidget-webkit--progress-update-timer + (run-at-time 0.5 0.5 #'xwidget-webkit--update-progress-timer-function + xwidget))))) ;; This funciton will be called multi times, so only ;; change buffer name when the load actually completes ;; this can limit buffer-name flicker in mode-line. @@ -403,7 +423,6 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." "load-finished") (> (length title) 0)) (with-current-buffer (xwidget-buffer xwidget) - (setq xwidget-webkit--title title) (force-mode-line-update) (xwidget-log "webkit finished loading: %s" title) ;; Do not adjust webkit size to window here, the @@ -447,7 +466,17 @@ If non-nil, plugins are enabled. Otherwise, disabled." (setq-local tool-bar-map xwidget-webkit-tool-bar-map) (setq-local bookmark-make-record-function #'xwidget-webkit-bookmark-make-record) - (setq-local header-line-format 'xwidget-webkit--title) + (setq-local header-line-format + (list "WebKit: " + '(:eval + (xwidget-webkit-title (xwidget-webkit-current-session))) + '(:eval + (when xwidget-webkit--loading-p + (let ((session (xwidget-webkit-current-session))) + (format " [%d%%%%]" + (* 100 + (xwidget-webkit-estimated-load-progress + session)))))))) ;; Keep track of [vh]scroll when switching buffers (image-mode-setup-winprops)) From 24c67435ea5f15aa858f4a12b00055ed92baa1d9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 19 Nov 2021 19:18:48 +0800 Subject: [PATCH 135/367] Use CHECK_LIVE_XWIDGET in xwidget-webkit-estimated-load-progress * src/xwidget.c (Fxwidget_webkit_estimated_load_progress): Check for live xwidgets instead. --- src/xwidget.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xwidget.c b/src/xwidget.c index 62b01b741cd..2f930dcbe79 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2567,7 +2567,7 @@ is to completely loading its page. */) WebKitWebView *webview; double value; - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); xw = XXWIDGET (xwidget); CHECK_WEBKIT_WIDGET (xw); From b4f0c4c694e1c00b4025fe16039b8940d97c66aa Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 19 Nov 2021 20:04:08 +0800 Subject: [PATCH 136/367] Allow controlling where xwidget-webkit stores cookies * doc/lispref/display.texi (Xwidgets): Document new function. * etc/NEWS: Announce `xwidget-webkit-cookie-file' and `xwidget-webkit-set-cookie-storage-file'. * lisp/xwidget.el (xwidget-webkit-cookie-file): New user option. (xwidget-webkit-new-session): Set cookie storage file. * src/xwidget.c (Fmake_xwidget): Create new context for each unrelated widget. (Fxwidget_webkit_set_cookie_storage_file): New function. (syms_of_xwidget): Define new subr. --- doc/lispref/display.texi | 12 ++++++++++++ etc/NEWS | 10 ++++++++++ lisp/xwidget.el | 13 +++++++++++++ src/xwidget.c | 38 +++++++++++++++++++++++++++++++++++++- 4 files changed, 72 insertions(+), 1 deletion(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index e9b50707ded..a90be5079e2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7012,6 +7012,18 @@ loaded. The value returned is a float ranging between 0.0 and 1.0. @end defun +@defun xwidget-webkit-set-cookie-storage-file xwidget file +Make the WebKit widget @var{xwidget} store cookies in @var{file}. + +@var{file} must be an absolute file path. The new setting will also +take effect on any xwidget that was created with @var{xwidget} as the +@code{related} argument to @code{make-xwidget}, and widgets related to +those as well. + +If this function is not called at least once on @var{xwidget} or a +related widget, @var{xwidget} will not store cookies on disk at all. +@end defun + @node Buttons @section Buttons @cindex buttons in buffers diff --git a/etc/NEWS b/etc/NEWS index ad31b232714..2d3f9dae5ba 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -493,6 +493,11 @@ This is a convenience function to extract the field data from Using this option you can control how the xwidget-webkit buffers are named. +--- +*** New user option 'xwidget-webkit-cookie-file'. +Using this option you can set where and if the xwidget-webkit buffers +save cookies set by web pages. + +++ *** New minor mode 'xwidget-webkit-edit-mode'. When this mode is enabled, self-inserting characters and other common @@ -882,6 +887,11 @@ These events are sent whenever an xwidget requests that Emacs display another xwidget. The only argument to this event is the xwidget that should be displayed. ++++ +*** New function 'xwidget-webkit-set-cookie-storage-file'. +This function is used to control where and if an xwidget stores +cookies set by web pages on disk. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/xwidget.el b/lisp/xwidget.el index b74e332edf8..056315a4db9 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -57,6 +57,7 @@ (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget)) (declare-function xwidget-webkit-back-forward-list "xwidget.c" (xwidget &optional limit)) (declare-function xwidget-webkit-estimated-load-progress "xwidget.c" (xwidget)) +(declare-function xwidget-webkit-set-cookie-storage-file "xwidget.c" (xwidget file)) (defgroup xwidget nil "Displaying native widgets in Emacs buffers." @@ -107,6 +108,15 @@ It can use the following special constructs: :type 'string :version "29.1") +(defcustom xwidget-webkit-cookie-file + (file-name-concat user-emacs-directory + "xwidget-webkit-cookies.txt") + "A path to the file where xwidget-webkit-browse-url will store cookies. +They will be stored as plain text in Mozilla `cookies.txt' +format. If nil, cookies will not be stored." + :type 'string + :version "29.1") + ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) "Ask xwidget-webkit to browse URL. @@ -794,6 +804,9 @@ For example, use this to display an anchor." (xwidget-window-inside-pixel-width (selected-window)) (xwidget-window-inside-pixel-height (selected-window)) nil current-session))) + (when xwidget-webkit-cookie-file + (xwidget-webkit-set-cookie-storage-file + xw (expand-file-name xwidget-webkit-cookie-file))) (xwidget-put xw 'callback callback) (xwidget-webkit-mode) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) diff --git a/src/xwidget.c b/src/xwidget.c index 2f930dcbe79..4e84d43b2a6 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -188,7 +188,9 @@ fails. */) || !XWIDGETP (related) || !EQ (XXWIDGET (related)->type, Qwebkit)) { - xw->widget_osr = webkit_web_view_new (); + WebKitWebContext *ctx = webkit_web_context_new (); + xw->widget_osr = webkit_web_view_new_with_context (ctx); + g_object_unref (ctx); webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), "about:blank"); @@ -2580,6 +2582,39 @@ is to completely loading its page. */) } #endif +DEFUN ("xwidget-webkit-set-cookie-storage-file", + Fxwidget_webkit_set_cookie_storage_file, Sxwidget_webkit_set_cookie_storage_file, + 2, 2, 0, doc: /* Make the WebKit widget XWIDGET load and store cookies in FILE. + +Cookies will be stored as plain text in FILE, which must be an +absolute file path. All xwidgets related to XWIDGET will also be +changed to store and load cookies in FILE. */) + (Lisp_Object xwidget, Lisp_Object file) +{ +#ifdef USE_GTK + struct xwidget *xw; + WebKitWebView *webview; + WebKitWebContext *context; + WebKitCookieManager *manager; + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + CHECK_STRING (file); + + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + context = webkit_web_view_get_context (webview); + manager = webkit_web_context_get_cookie_manager (context); + webkit_cookie_manager_set_persistent_storage (manager, + SSDATA (ENCODE_UTF_8 (file)), + WEBKIT_COOKIE_PERSISTENT_STORAGE_TEXT); + unblock_input (); +#endif + + return Qnil; +} + void syms_of_xwidget (void) { @@ -2620,6 +2655,7 @@ syms_of_xwidget (void) defsubr (&Sxwidget_webkit_next_result); defsubr (&Sxwidget_webkit_previous_result); defsubr (&Sset_xwidget_buffer); + defsubr (&Sxwidget_webkit_set_cookie_storage_file); #ifdef USE_GTK defsubr (&Sxwidget_webkit_load_html); defsubr (&Sxwidget_webkit_back_forward_list); From eb86c33c46d4bd1af06abcec5d9d97c705c0ce0d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 19 Nov 2021 15:41:48 +0200 Subject: [PATCH 137/367] Fix documentation of last commit * lisp/xwidget.el (xwidget-webkit-cookie-file): Don't use "path" for file names in the doc string. Improve wording and markup of the doc string. * src/xwidget.c (Fxwidget_webkit_set_cookie_storage_file): * doc/lispref/display.texi (Xwidgets): Don't use "path" for file names. * etc/NEWS: Improve the wording of the entry about 'xwidget-webkit-cookie-file'. --- doc/lispref/display.texi | 4 ++-- etc/NEWS | 6 ++++-- lisp/xwidget.el | 6 +++--- src/xwidget.c | 4 ++-- 4 files changed, 11 insertions(+), 9 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index a90be5079e2..12257fda54b 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7015,8 +7015,8 @@ The value returned is a float ranging between 0.0 and 1.0. @defun xwidget-webkit-set-cookie-storage-file xwidget file Make the WebKit widget @var{xwidget} store cookies in @var{file}. -@var{file} must be an absolute file path. The new setting will also -take effect on any xwidget that was created with @var{xwidget} as the +@var{file} must be an absolute file name. The new setting will also +affect any xwidget that was created with @var{xwidget} as the @code{related} argument to @code{make-xwidget}, and widgets related to those as well. diff --git a/etc/NEWS b/etc/NEWS index 2d3f9dae5ba..c38e1aa5ebd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -495,8 +495,10 @@ named. --- *** New user option 'xwidget-webkit-cookie-file'. -Using this option you can set where and if the xwidget-webkit buffers -save cookies set by web pages. +Using this option you can control whether the xwidget-webkit buffers +save cookies set by web pages, and if so, in which file to save them. +the default is the file 'xwidget-webkit-cookies.txt' under +'~/.emacs.d' directory. +++ *** New minor mode 'xwidget-webkit-edit-mode'. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 056315a4db9..a1f992e6598 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -111,9 +111,9 @@ It can use the following special constructs: (defcustom xwidget-webkit-cookie-file (file-name-concat user-emacs-directory "xwidget-webkit-cookies.txt") - "A path to the file where xwidget-webkit-browse-url will store cookies. -They will be stored as plain text in Mozilla `cookies.txt' -format. If nil, cookies will not be stored." + "The name of the file where `xwidget-webkit-browse-url' will store cookies. +They will be stored as plain text in Mozilla \"cookies.txt\" +format. If nil, do not store cookies." :type 'string :version "29.1") diff --git a/src/xwidget.c b/src/xwidget.c index 4e84d43b2a6..8cad2fbc2c1 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2587,8 +2587,8 @@ DEFUN ("xwidget-webkit-set-cookie-storage-file", 2, 2, 0, doc: /* Make the WebKit widget XWIDGET load and store cookies in FILE. Cookies will be stored as plain text in FILE, which must be an -absolute file path. All xwidgets related to XWIDGET will also be -changed to store and load cookies in FILE. */) +absolute file name. All xwidgets related to XWIDGET will also +store cookies in FILE and load them from there. */) (Lisp_Object xwidget, Lisp_Object file) { #ifdef USE_GTK From c496773f377a7154d458d45e1e42f5733b61301c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 19 Nov 2021 17:23:35 +0200 Subject: [PATCH 138/367] Fix doc strings in ucs-normalize.el * lisp/international/ucs-normalize.el (ucs-normalize-NFD-region) (ucs-normalize-NFD-string, string-glyph-compose) (string-glyph-decompose, ucs-normalize-NFC-string) (ucs-normalize-NFKD-region, ucs-normalize-NFKD-string) (ucs-normalize-NFKC-region, ucs-normalize-NFKC-string) (ucs-normalize-HFS-NFD-region, ucs-normalize-HFS-NFC-region): Fix wording and typos. --- lisp/international/ucs-normalize.el | 69 ++++++++++++++++++----------- 1 file changed, 43 insertions(+), 26 deletions(-) diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index 0c85b490c2a..3da47e701ab 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -537,8 +537,9 @@ COMPOSITION-PREDICATE will be used to compose region." (buffer-string))) (defun ucs-normalize-NFD-region (from to) - "Decompose the current region according to the Unicode NFD. -This is the canonical decomposed form." + "Decompose the region between FROM and TO according to the Unicode NFD. +This replaces the text between FROM and TO with its canonical decomposition, +a.k.a. the \"Unicode Normalization Form D\"." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfd-quick-check-regexp @@ -546,14 +547,17 @@ This is the canonical decomposed form." (defun ucs-normalize-NFD-string (str) "Decompose the string STR according to the Unicode NFD. -This is the canonical decomposed form. For instance: +This returns a new string that is the canonical decomposition of STR, +a.k.a. the \"Unicode Normalization Form D\" of STR. For instance: (ucs-normalize-NFD-string \"Å\") => \"Å\"" (ucs-normalize-string ucs-normalize-NFD-region)) (defun ucs-normalize-NFC-region (from to) - "Compose the current region according to the Unicode NFC. -This is the canonical composed form." + "Compose the region between FROM and TO according to the Unicode NFC. +This replaces the text between FROM and TO with the result of its +canonical decomposition (see `ucs-normalize-NFD-region') followed by +canonical composition, a.k.a. the \"Unicode Normalization Form C\"." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfc-quick-check-regexp @@ -561,30 +565,38 @@ This is the canonical composed form." ;;;###autoload (defun string-glyph-compose (string) - "Compose the string STR according to the Unicode NFC. -This is the canonical composed form. For instance: + "Compose STRING according to the Unicode NFC. +This returns a new string obtained by canonical decomposition +of STRING (see `ucs-normalize-NFC-string') followed by canonical +composition, a.k.a. the \"Unicode Normalization Form C\" of STRING. +For instance: (string-glyph-compose \"Å\") => \"Å\"" (ucs-normalize-NFC-string string)) ;;;###autoload (defun string-glyph-decompose (string) - "Decompose the string STR according to the Unicode NFD. -This is the canonical decomposed form. For instance: + "Decompose STRING according to the Unicode NFD. +This returns a new string that is the canonical decomposition of STRING, +a.k.a. the \"Unicode Normalization Form D\" of STRING. For instance: - (string-glyph-decompose \"Å\") => \"Å\"" + (ucs-normalize-NFD-string \"Å\") => \"Å\"" (ucs-normalize-NFD-string string)) (defun ucs-normalize-NFC-string (str) - "Compose the string STR by according to the Unicode NFC. -This is the canonical composed form. For instance: + "Compose STR according to the Unicode NFC. +This returns a new string obtained by canonical decomposition +of STR (see `ucs-normalize-NFC-string') followed by canonical +composition, a.k.a. the \"Unicode Normalization Form C\" of STR. +For instance: - (ucs-normalize-NFC-string \"Å\") => \"Å\"" + (string-glyph-compose \"Å\") => \"Å\"" (ucs-normalize-string ucs-normalize-NFC-region)) (defun ucs-normalize-NFKD-region (from to) - "Decompose the current region according to the Unicode NFKD. -This is the compatibility decomposed form." + "Decompose the region between FROM and TO according to the Unicode NFKD. +This replaces the text between FROM and TO with its compatibility +decomposition, a.k.a. \"Unicode Normalization Form KD\"." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfkd-quick-check-regexp @@ -592,34 +604,39 @@ This is the compatibility decomposed form." (defun ucs-normalize-NFKD-string (str) "Decompose the string STR according to the Unicode NFKD. -This is the compatibility decomposed form. This is much like the -NFD (canonical decomposed) form, but mainly differs in glyphs -with formatting distinctions. For instance: +This returns a new string obtained by compatibility decomposition +of STR. This is much like the NFD (canonical decomposition) form, +see `ucs-normalize-NFD-string', but mainly differs for precomposed +characters. For instance: (ucs-normalize-NFD-string \"fi\") => \"fi\" (ucs-normalize-NFKD-string \"fi\") = \"fi\"" (ucs-normalize-string ucs-normalize-NFKD-region)) (defun ucs-normalize-NFKC-region (from to) - "Compose the current region according to the Unicode NFKC. -The is the compatibility composed form." + "Compose the region between FROM and TO according to the Unicode NFKC. +This replaces the text between FROM and TO with the result of its +compatibility decomposition (see `ucs-normalize-NFC-region') followed by +canonical composition, a.k.a. the \"Unicode Normalization Form KC\"." (interactive "r") (ucs-normalize-region from to ucs-normalize-nfkc-quick-check-regexp 'ucs-normalize-nfkd-table t)) (defun ucs-normalize-NFKC-string (str) - "Compose the string STR according to the Unicode NFKC. -This is the compatibility composed form. This is much like the -NFC (canonical composed) form, but mainly differs in glyphs -with formatting distinctions. For instance: + "Compose STR according to the Unicode NFC. +This returns a new string obtained by compatibility decomposition +of STR (see `ucs-normalize-NFKD-string') followed by canonical +composition, a.k.a. the \"Unicode Normalization Form KC\" of STR. +This is much like the NFC (canonical composition) form, but mainly +differs for precomposed characters. For instance: (ucs-normalize-NFC-string \"fi\") => \"fi\" (ucs-normalize-NFKC-string \"fi\") = \"fi\"" (ucs-normalize-string ucs-normalize-NFKC-region)) (defun ucs-normalize-HFS-NFD-region (from to) - "Normalize the current region by the Unicode NFD and Mac OS's HFS Plus." + "Normalize region between FROM and TO by Unicode NFD and Mac OS's HFS Plus." (interactive "r") (ucs-normalize-region from to ucs-normalize-hfs-nfd-quick-check-regexp @@ -631,7 +648,7 @@ with formatting distinctions. For instance: (ucs-normalize-string ucs-normalize-HFS-NFD-region)) (defun ucs-normalize-HFS-NFC-region (from to) - "Normalize the current region by the Unicode NFC and Mac OS's HFS Plus." + "Normalize region between FROM and TO by Unicode NFC and Mac OS's HFS Plus." (interactive "r") (ucs-normalize-region from to ucs-normalize-hfs-nfc-quick-check-regexp From cb612c51d6c428aa7d8fd01f1b3fde13284c1c16 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 16:50:03 +0100 Subject: [PATCH 139/367] Add more test jobs for emba * test/Makefile.in (SUBDIRS): Suppress "*auto-save-list". (SUBDIR_TARGETS): New variable. (subdir_template): Set it. (subdir-targets): New target. * test/infra/gitlab-ci.yml (variables): Add CI_DEBUG_TRACE. (build-image-inotify): Remove timeout. (generator, test-jobs-pipeline): New jobs. (test-lisp-inotify, test-lisp-net-inotify): Comment. * test/infra/test-jobs-generator.sh: New script. --- test/Makefile.in | 14 +++-- test/infra/gitlab-ci.yml | 46 ++++++++++------ test/infra/test-jobs-generator.sh | 89 +++++++++++++++++++++++++++++++ 3 files changed, 131 insertions(+), 18 deletions(-) create mode 100755 test/infra/test-jobs-generator.sh diff --git a/test/Makefile.in b/test/Makefile.in index 7bef1c36605..39d7b1d4e48 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -31,7 +31,7 @@ SHELL = @SHELL@ srcdir = @srcdir@ -abs_top_srcdir=@abs_top_srcdir@ +abs_top_srcdir = @abs_top_srcdir@ top_builddir = @top_builddir@ VPATH = $(srcdir) @@ -67,7 +67,7 @@ elpa_opts = $(foreach el,$(elpa_els),$(and $(wildcard $(el)),-L $(dir $(el)) -l # directory, we can use emacs --chdir. EMACS = ../src/emacs -EMACS_EXTRAOPT= +EMACS_EXTRAOPT = # Command line flags for Emacs. # Apparently MSYS bash would convert "-L :" to "-L ;" anyway, @@ -252,9 +252,12 @@ endef $(foreach test,${TESTS},$(eval $(call test_template,${test}))) ## Get the tests for only a specific directory. -SUBDIRS = $(sort $(shell cd ${srcdir} && find lib-src lisp misc src -type d ! -path "*resources*" -print)) +SUBDIRS = $(sort $(shell cd ${srcdir} && find lib-src lisp misc src -type d \ + ! \( -path "*resources*" -o -path "*auto-save-list" \) -print)) +SUBDIR_TARGETS = define subdir_template + SUBDIR_TARGETS += check-$(subst /,-,$(1)) .PHONY: check-$(subst /,-,$(1)) check-$(subst /,-,$(1)): @${MAKE} check LOGFILES="$(patsubst %.el,%.log, \ @@ -367,3 +370,8 @@ maintainer-clean: distclean bootstrap-clean check-declare: $(emacs) -l check-declare \ --eval '(check-declare-directory "$(srcdir)")' + +.PHONY: subdir-targets + +subdir-targets: + @echo $(SUBDIR_TARGETS) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 096a293b302..c14af0e3011 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -47,7 +47,7 @@ variables: # Three hours, see below. EMACS_TEST_TIMEOUT: 10800 EMACS_TEST_VERBOSE: 1 - # # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled + # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled # DOCKER_HOST: tcp://docker:2376 # DOCKER_TLS_CERTDIR: "/certs" # Put the configuration for each run in a separate directory to @@ -57,6 +57,8 @@ variables: # We don't use ${CI_COMMIT_SHA} to be able to do one bootstrap # across multiple builds. BUILD_TAG: ${CI_COMMIT_REF_SLUG} + # Disable if you don't need it, it can be a security risk. + CI_DEBUG_TRACE: "true" default: image: docker:19.03.12 @@ -224,8 +226,6 @@ build-image-inotify: extends: [.job-template, .build-template] variables: target: emacs-inotify -# Temporarily. - timeout: 8 hours # test-fast-inotify: # stage: fast @@ -234,19 +234,35 @@ build-image-inotify: # target: emacs-inotify # make_params: "-C test check" -test-lisp-inotify: - stage: normal - extends: [.job-template, .test-template] - variables: - target: emacs-inotify - make_params: "-C test check-lisp" +generator: + stage: generate + script: + - ./test-jobs-generator.sh > test-jobs.yml + artifacts: + paths: + - test-jobs.yml -test-lisp-net-inotify: - stage: normal - extends: [.job-template, .test-template] - variables: - target: emacs-inotify - make_params: "-C test check-lisp-net" +test-jobs-pipeline: + stage: trigger + trigger: + include: + - artifact: test-jobs.yml + job: generator + strategy: depend + +# test-lisp-inotify: +# stage: normal +# extends: [.job-template, .test-template] +# variables: +# target: emacs-inotify +# make_params: "-C test check-lisp" + +# test-lisp-net-inotify: +# stage: normal +# extends: [.job-template, .test-template] +# variables: +# target: emacs-inotify +# make_params: "-C test check-lisp-net" build-image-filenotify-gio: stage: platform-images diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh new file mode 100755 index 00000000000..97346785eaf --- /dev/null +++ b/test/infra/test-jobs-generator.sh @@ -0,0 +1,89 @@ +#!/bin/sh + +# Copyright (C) 2021 Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +# GNU Emacs support for the GitLab-specific build of Docker images. + +# The presence of this file does not imply any FSF/GNU endorsement of +# Docker or any other particular tool. Also, it is intended for +# evaluation purposes, thus possibly temporary. + +# Maintainer: Michael Albinus +# URL: https://emba.gnu.org/emacs/emacs + +for target in $(cd ..; make -s subdir-targets); do + case $target in + check-lib-src) + changes=" + - lib-src/*.{h,c} + - test/lib-src/*.el" + ;; + check-lisp-emacs-lisp) + changes=" + - lisp/emacs-lisp/*.el + - test/lisp/emacs-lisp/*.el" + ;; + check-lisp-emacs-lisp-eieio-tests) + changes=" + - lisp/emacs-lisp/eieio-tests/*.el + - test/lisp/emacs-lisp/eieio-tests/*.el" + ;; + check-lisp-emacs-lisp-faceup-tests) + changes=" + - lisp/emacs-lisp/faceup-tests/*.el + - test/lisp/emacs-lisp/faceup-tests/*.el" + ;; + check-lisp-mh-e) + changes=" + - lisp/mh-e/*.el + - test/lisp/mh-e/*.el" + ;; + check-lisp-so-long-tests) + changes=" + - lisp/so-long-tests/*.el + - test/lisp/so-long-tests/*.el" + ;; + check-misc) + changes=" + - admin/*.el + - test/misc/*.el" + ;; + check-src) + changes=" + - src/*.{h,c} + - test/src/*.el" + ;; + *) + changes=" + - $(echo -n ${target##check-}/*.el | tr '-' '/') + - $(echo -n test${target##check}/*.el | tr '-' '/')" + ;; + esac + + cat < Date: Fri, 19 Nov 2021 17:33:12 +0100 Subject: [PATCH 140/367] Fix stage in gitlab-ci.yml --- test/infra/gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index c14af0e3011..b5222f884a9 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -235,7 +235,7 @@ build-image-inotify: # make_params: "-C test check" generator: - stage: generate + stage: .pre script: - ./test-jobs-generator.sh > test-jobs.yml artifacts: From 408577b402a9e1d288b5d214e397eea22fb8fedc Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 17:46:40 +0100 Subject: [PATCH 141/367] ; Further fixes in gitlab-ci.yml --- test/infra/gitlab-ci.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index b5222f884a9..8937bb72421 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -234,7 +234,7 @@ build-image-inotify: # target: emacs-inotify # make_params: "-C test check" -generator: +test-jobs-generator: stage: .pre script: - ./test-jobs-generator.sh > test-jobs.yml @@ -243,11 +243,11 @@ generator: - test-jobs.yml test-jobs-pipeline: - stage: trigger + stage: .pre trigger: include: - artifact: test-jobs.yml - job: generator + job: test-jobs-generator strategy: depend # test-lisp-inotify: From b11e4320856f88ebf4c3671806a2ffe99ee34803 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 17:54:59 +0100 Subject: [PATCH 142/367] ; Still gitlab-ci.yml fixes * test/infra/gitlab-ci.yml (variables): Add CI_DEBUG_TRACE. (build-image-inotify): Remove timeout. (generator, test-jobs-pipeline): New jobs. (test-lisp-inotify, test-lisp-net-inotify): Comment. --- test/infra/gitlab-ci.yml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 8937bb72421..ac3989a5e49 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -213,6 +213,8 @@ default: stages: - build-images + - generator + - trigger # - fast - normal - platform-images @@ -235,7 +237,7 @@ build-image-inotify: # make_params: "-C test check" test-jobs-generator: - stage: .pre + stage: generator script: - ./test-jobs-generator.sh > test-jobs.yml artifacts: @@ -243,7 +245,7 @@ test-jobs-generator: - test-jobs.yml test-jobs-pipeline: - stage: .pre + stage: trigger trigger: include: - artifact: test-jobs.yml From 9b08846faa55b1d47cd6403e6dd8c53c6ae310b8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 18:57:47 +0100 Subject: [PATCH 143/367] Add upward compatibility entry in Tramp (don't merge) * lisp/net/tramp.el (tramp-file-name-for-operation): Add `abbreviate-file-name'. --- lisp/net/tramp.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b152584c1f8..740cb23ebee 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2493,6 +2493,8 @@ Must be handled by the callers." file-system-info ;; Emacs 28+ only. file-locked-p lock-file make-lock-file-name unlock-file + ;; Emacs 29+ only. + abbreviate-file-name ;; Tramp internal magic file name function. tramp-set-file-uid-gid)) (if (file-name-absolute-p (nth 0 args)) From c1eea85be12df8f874dea61f6b7856ef23ddf689 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 18:58:01 +0100 Subject: [PATCH 144/367] * test/lisp/net/tramp-tests.el (tramp-get-remote-gid): Remove declaration. --- test/lisp/net/tramp-tests.el | 1 - 1 file changed, 1 deletion(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 47ef46f8ec0..1fa8fbea172 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -55,7 +55,6 @@ (declare-function tramp-check-remote-uname "tramp-sh") (declare-function tramp-find-executable "tramp-sh") (declare-function tramp-get-remote-chmod-h "tramp-sh") -(declare-function tramp-get-remote-gid "tramp-sh") (declare-function tramp-get-remote-path "tramp-sh") (declare-function tramp-get-remote-perl "tramp-sh") (declare-function tramp-get-remote-stat "tramp-sh") From 0d9aa424f7de151627ed3efcf06162e968bf96f4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 20:20:31 +0100 Subject: [PATCH 145/367] ; Fix emba scripts --- test/infra/gitlab-ci.yml | 3 +- test/infra/test-jobs-generator.sh | 51 +++++++++---------------------- 2 files changed, 16 insertions(+), 38 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index ac3989a5e49..abc7bddbf73 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -239,7 +239,8 @@ build-image-inotify: test-jobs-generator: stage: generator script: - - ./test-jobs-generator.sh > test-jobs.yml + - pwd + - test/infra/test-jobs-generator.sh > test-jobs.yml artifacts: paths: - test-jobs.yml diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh index 97346785eaf..d5171acbf2c 100755 --- a/test/infra/test-jobs-generator.sh +++ b/test/infra/test-jobs-generator.sh @@ -26,52 +26,29 @@ # Maintainer: Michael Albinus # URL: https://emba.gnu.org/emacs/emacs -for target in $(cd ..; make -s subdir-targets); do +SUBDIRS=$(cd test && \ + (find lib-src lisp misc src -type d \ + ! \( -path "*resources*" -o -path "*auto-save-list" \) \ + -print | sort -)) + +for subdir in $SUBDIRS; do + target=check-$(echo $subdir | tr '/' '-') + case $target in - check-lib-src) + check*-src) changes=" - - lib-src/*.{h,c} - - test/lib-src/*.el" - ;; - check-lisp-emacs-lisp) - changes=" - - lisp/emacs-lisp/*.el - - test/lisp/emacs-lisp/*.el" - ;; - check-lisp-emacs-lisp-eieio-tests) - changes=" - - lisp/emacs-lisp/eieio-tests/*.el - - test/lisp/emacs-lisp/eieio-tests/*.el" - ;; - check-lisp-emacs-lisp-faceup-tests) - changes=" - - lisp/emacs-lisp/faceup-tests/*.el - - test/lisp/emacs-lisp/faceup-tests/*.el" - ;; - check-lisp-mh-e) - changes=" - - lisp/mh-e/*.el - - test/lisp/mh-e/*.el" - ;; - check-lisp-so-long-tests) - changes=" - - lisp/so-long-tests/*.el - - test/lisp/so-long-tests/*.el" + - $subdir/*.{h,c} + - test/$subdir/*.el" ;; check-misc) changes=" - admin/*.el - - test/misc/*.el" - ;; - check-src) - changes=" - - src/*.{h,c} - - test/src/*.el" + - test/$subdir/*.el" ;; *) changes=" - - $(echo -n ${target##check-}/*.el | tr '-' '/') - - $(echo -n test${target##check}/*.el | tr '-' '/')" + - $subdir/*.el + - test/$subdir/*.el" ;; esac From 1dd7a8779031e156801ed66b4d55c785cb2cdb83 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 20:32:29 +0100 Subject: [PATCH 146/367] Fix Tramp test * test/lisp/net/tramp-tests.el (tramp-test07-abbreviate-file-name): Skip Ange FTP test. --- test/lisp/net/tramp-tests.el | 1 + 1 file changed, 1 insertion(+) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 98269d5fa39..5f2241c5f7f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2293,6 +2293,7 @@ This checks also `file-name-as-directory', `file-name-directory', "Check that Tramp abbreviates file names correctly." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-emacs29-p)) + (skip-unless (tramp--test-ange-ftp-p)) (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory)) ;; Not all methods can expand "~". From 54b2bd1be6715cbc6bc87e2a6e65ffa04aff256b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Nov 2021 21:24:08 +0100 Subject: [PATCH 147/367] ; * test/infra/test-jobs-generator.sh: Still fixes. --- test/infra/test-jobs-generator.sh | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh index d5171acbf2c..96b61be9662 100755 --- a/test/infra/test-jobs-generator.sh +++ b/test/infra/test-jobs-generator.sh @@ -17,19 +17,19 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -# GNU Emacs support for the GitLab-specific build of Docker images. +# GNU Emacs support for the gitlab-ci.yml template generation. # The presence of this file does not imply any FSF/GNU endorsement of -# Docker or any other particular tool. Also, it is intended for +# GitLab or any other particular tool. Also, it is intended for # evaluation purposes, thus possibly temporary. # Maintainer: Michael Albinus # URL: https://emba.gnu.org/emacs/emacs -SUBDIRS=$(cd test && \ - (find lib-src lisp misc src -type d \ - ! \( -path "*resources*" -o -path "*auto-save-list" \) \ - -print | sort -)) +cd test +SUBDIRS=\ +$(find lib-src lisp misc src -type d \ + ! \( -path "*resources*" -o -path "*auto-save-list" \) -print | sort -) for subdir in $SUBDIRS; do target=check-$(echo $subdir | tr '/' '-') @@ -55,7 +55,7 @@ for subdir in $SUBDIRS; do cat < Date: Sat, 20 Nov 2021 08:38:04 +0800 Subject: [PATCH 148/367] Make xwidget-webkit default to not storing cookies * etc/NEWS: Update to reflect change. * lisp/xwidget.el (xwidget-webkit-cookie-file): Set default value to nil. --- etc/NEWS | 2 -- lisp/xwidget.el | 4 +--- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c38e1aa5ebd..70ba5341d8a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -497,8 +497,6 @@ named. *** New user option 'xwidget-webkit-cookie-file'. Using this option you can control whether the xwidget-webkit buffers save cookies set by web pages, and if so, in which file to save them. -the default is the file 'xwidget-webkit-cookies.txt' under -'~/.emacs.d' directory. +++ *** New minor mode 'xwidget-webkit-edit-mode'. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index a1f992e6598..e9a0507bbf3 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -108,9 +108,7 @@ It can use the following special constructs: :type 'string :version "29.1") -(defcustom xwidget-webkit-cookie-file - (file-name-concat user-emacs-directory - "xwidget-webkit-cookies.txt") +(defcustom xwidget-webkit-cookie-file nil "The name of the file where `xwidget-webkit-browse-url' will store cookies. They will be stored as plain text in Mozilla \"cookies.txt\" format. If nil, do not store cookies." From 3817ced7ba4c053d6d39b26cc193f122d42f05fb Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 19 Nov 2021 18:36:03 -0800 Subject: [PATCH 149/367] * lisp/xwidget.el (xwidget-webkit-cookie-file): Fix type. --- lisp/xwidget.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index e9a0507bbf3..33b6c16a1d8 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -112,7 +112,7 @@ It can use the following special constructs: "The name of the file where `xwidget-webkit-browse-url' will store cookies. They will be stored as plain text in Mozilla \"cookies.txt\" format. If nil, do not store cookies." - :type 'string + :type '(choice (const :tag "Do not store cookies" nil) file) :version "29.1") ;;;###autoload From 35de4774caaa5d0879ae814f62a889def317601b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 14:11:13 +0800 Subject: [PATCH 150/367] Clarify doc string in xwidget-webkit * lisp/xwidget.el (xwidget-webkit-buffer-name-format): Update doc string. --- lisp/xwidget.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 33b6c16a1d8..3cccfb6bcfa 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -111,8 +111,9 @@ It can use the following special constructs: (defcustom xwidget-webkit-cookie-file nil "The name of the file where `xwidget-webkit-browse-url' will store cookies. They will be stored as plain text in Mozilla \"cookies.txt\" -format. If nil, do not store cookies." - :type '(choice (const :tag "Do not store cookies" nil) file) +format. If nil, do not store cookies. You must kill all xwidget-webkit +buffers for this setting to take effect after setting it to nil." + :type 'string :version "29.1") ;;;###autoload From 0a3b55aca336088ab3c5e77e1b442da2960c23e4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 14:15:46 +0800 Subject: [PATCH 151/367] Fix option type of `xwidget-webkit-cookie-file' again * lisp/xwidget.el (xwidget-webkit-cookie-file): Revert changes caused by rebase. --- lisp/xwidget.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 3cccfb6bcfa..df9625b264f 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -113,7 +113,7 @@ It can use the following special constructs: They will be stored as plain text in Mozilla \"cookies.txt\" format. If nil, do not store cookies. You must kill all xwidget-webkit buffers for this setting to take effect after setting it to nil." - :type 'string + :type '(choice (const :tag "Do not store cookies" nil) file) :version "29.1") ;;;###autoload From 8331916c85016ae1c457b274031475e5aa5ae041 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 14:17:27 +0800 Subject: [PATCH 152/367] Remove nonsensical command in xwidget-webkit-mode-map * lisp/xwidget.el (xwidget-webkit-mode-map): Remove nonsensical command binding. --- lisp/xwidget.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index df9625b264f..89f81bb8164 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -200,7 +200,6 @@ for the actual events that will be sent." (define-key map "b" 'xwidget-webkit-back) (define-key map "f" 'xwidget-webkit-forward) (define-key map "r" 'xwidget-webkit-reload) - (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!? (define-key map "\C-m" 'xwidget-webkit-insert-string) (define-key map "w" 'xwidget-webkit-current-url) (define-key map "+" 'xwidget-webkit-zoom-in) From da508cf4bd437f8fd9a06fce33f6e62590e1e4d9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 14:30:12 +0800 Subject: [PATCH 153/367] Use `xwidget-live-p' inside `xwidget-at'. It should no longer be possible for Lisp code to abuse internal xwidget state, or cause crashes with killed xwidgets and such, so the pedantic checking done in this function is no longer necessary. (In fact, it is even wrong, as it won't catch killed xwidgets.) * lisp/xwidget.el (xwidget-at): Use `xwidget-live-p'. --- lisp/xwidget.el | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 89f81bb8164..91580efa49a 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -58,6 +58,7 @@ (declare-function xwidget-webkit-back-forward-list "xwidget.c" (xwidget &optional limit)) (declare-function xwidget-webkit-estimated-load-progress "xwidget.c" (xwidget)) (declare-function xwidget-webkit-set-cookie-storage-file "xwidget.c" (xwidget file)) +(declare-function xwidget-live-p "xwidget.c" (xwidget)) (defgroup xwidget nil "Displaying native widgets in Emacs buffers." @@ -77,12 +78,9 @@ This returns the result of `make-xwidget'." (defun xwidget-at (pos) "Return xwidget at POS." - ;; TODO this function is a bit tedious because the C layer isn't well - ;; protected yet and xwidgetp apparently doesn't work yet. (let* ((disp (get-text-property pos 'display)) - (xw (car (cdr (cdr disp))))) - ;;(if (xwidgetp xw) xw nil) - (if (equal 'xwidget (car disp)) xw))) + (xw (car (cdr (cdr disp))))) + (when (xwidget-live-p xw) xw))) From 88458f7354e904a50ed1389869266437ba084533 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 14:57:22 +0800 Subject: [PATCH 154/367] Make xwidget-events special and document xwidget callbacks Users have always been supposed to use callbacks for handling xwidget events, but for some reason this has not been documented until now. * doc/lispref/commands.texi (Xwidget Events): Document xwidget callbacks and the special status of `xwidget-event's. * doc/lispref/display.texi (Xwidgets): Add xwidget property list functions to the concept index. * lisp/xwidget.el: Make xwidget events special. --- doc/lispref/commands.texi | 9 +++++++++ doc/lispref/display.texi | 1 + lisp/xwidget.el | 11 +++++++---- 3 files changed, 17 insertions(+), 4 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 1509c200e0d..cc9c41623dc 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1886,6 +1886,15 @@ This event is sent whenever some kind of update occurs in @var{xwidget}. There are several types of updates, identified by their @var{kind}. +@cindex xwidget callbacks +It is a special event (@pxref{Special Events}), which should be +handled by adding a callback to an xwidget that is called whenever an +xwidget event for @var{xwidget} is received. + +You can add a callback by setting the @code{callback} of an xwidget's +property list, which should be a function that accepts @var{xwidget} +and @var{kind} as arguments. + @table @code @cindex @code{load-changed} xwidget event @item load-changed diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 12257fda54b..08426032e09 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6828,6 +6828,7 @@ This function kills @var{xwidget}, by removing it from its buffer and releasing window system resources it holds. @end defun +@cindex xwidget property list @defun xwidget-plist xwidget This function returns the property list of @var{xwidget}. @end defun diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 91580efa49a..5b465dad3d5 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -372,10 +372,13 @@ If N is omitted or nil, scroll backwards by one char." (xwidget-webkit-current-session) "window.scrollTo(pageXOffset, window.document.body.scrollHeight);")) -;; The xwidget event needs to go into a higher level handler -;; since the xwidget can generate an event even if it's offscreen. -;; TODO this needs to use callbacks and consider different xwidget event types. -(define-key (current-global-map) [xwidget-event] #'xwidget-event-handler) +;; The xwidget event needs to go in the special map. To receive +;; xwidget events, you should place a callback in the property list of +;; the xwidget, instead of handling these events manually. +;; +;; See `xwidget-webkit-new-session' for an example of how to do this. +(define-key special-event-map [xwidget-event] #'xwidget-event-handler) + (defun xwidget-log (&rest msg) "Log MSG to a buffer." (let ((buf (get-buffer-create " *xwidget-log*"))) From 354c834fba5806ba873b50bf900c42dce5d9da90 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 15:56:08 +0800 Subject: [PATCH 155/367] Fix `browse-url-interactive-arg' for certain kinds of events * lisp/net/browse-url.el (browse-url-interactive-arg): Don't call `mouse-set-point' unless event is actually a mouse event. --- lisp/net/browse-url.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 3af37e412d9..50d11b4b725 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -730,7 +730,8 @@ position clicked before acting. This function returns a list (URL NEW-WINDOW-FLAG) for use in `interactive'." (let ((event (elt (this-command-keys) 0))) - (and (listp event) (mouse-set-point event))) + (when (mouse-event-p event) + (mouse-set-point event))) (list (read-string prompt (or (and transient-mark-mode mark-active ;; rfc2396 Appendix E. (replace-regexp-in-string From 9f06977782ef58fa40bed69368ab92a080f035ec Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Nov 2021 10:07:48 +0100 Subject: [PATCH 156/367] Continue adaptions of emba files * test/infra/default-gitlab-ci.yml: New file, derived from gitlab-ci.yml. * test/infra/gitlab-ci.yml (top, test-jobs-pipeline): Include default-gitlab-ci.yml. (stages): Remove normal. * test/infra/test-jobs-generator.sh: Generate also stages entry. --- .gitlab-ci.yml | 2 +- test/infra/default-gitlab-ci.yml | 216 ++++++++++++++++++++++++++++++ test/infra/gitlab-ci.yml | 194 +-------------------------- test/infra/test-jobs-generator.sh | 10 +- 4 files changed, 230 insertions(+), 192 deletions(-) create mode 100644 test/infra/default-gitlab-ci.yml diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 3138f4184e6..402c17ddb85 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -15,7 +15,7 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -# GNU Emacs support for the GitLab protocol for CI +# GNU Emacs support for the GitLab protocol for CI. # The presence of this file does not imply any FSF/GNU endorsement of # any particular service that uses that protocol. Also, it is intended for diff --git a/test/infra/default-gitlab-ci.yml b/test/infra/default-gitlab-ci.yml new file mode 100644 index 00000000000..f6fadee27f3 --- /dev/null +++ b/test/infra/default-gitlab-ci.yml @@ -0,0 +1,216 @@ +# Copyright (C) 2017-2021 Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +# GNU Emacs support for the GitLab protocol for CI. + +# The presence of this file does not imply any FSF/GNU endorsement of +# any particular service that uses that protocol. Also, it is intended for +# evaluation purposes, thus possibly temporary. + +# Maintainer: Ted Zlatanov +# URL: https://emba.gnu.org/emacs/emacs + +# Never run merge request pipelines, they usually duplicate push pipelines +# see https://docs.gitlab.com/ee/ci/yaml/README.html#common-if-clauses-for-rules + +# Rules: always run tags and branches named master*, emacs*, feature*, fix* +# Test that it triggers by pushing a tag: `git tag mytag; git push origin mytag` +# Test that it triggers by pushing to: feature/emba, feature1, master, master-2, fix/emba, emacs-299, fix-2 +# Test that it doesn't trigger by pushing to: scratch-2, scratch/emba, oldbranch, dev +workflow: + rules: + - if: '$CI_PIPELINE_SOURCE == "merge_request_event"' + when: never + - if: '$CI_COMMIT_TAG' + when: always + - if: '$CI_COMMIT_BRANCH !~ /^(master|emacs|feature|fix)/' + when: never + - when: always + +variables: + GIT_STRATEGY: fetch + EMACS_EMBA_CI: 1 + # Three hours, see below. + EMACS_TEST_TIMEOUT: 10800 + EMACS_TEST_VERBOSE: 1 + # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled + # DOCKER_HOST: tcp://docker:2376 + # DOCKER_TLS_CERTDIR: "/certs" + # Put the configuration for each run in a separate directory to + # avoid conflicts. + DOCKER_CONFIG: "/.docker-config-${CI_COMMIT_SHA}" + DOCKER_BUILDKIT: 1 + # We don't use ${CI_COMMIT_SHA} to be able to do one bootstrap + # across multiple builds. + BUILD_TAG: ${CI_COMMIT_REF_SLUG} + # Disable if you don't need it, it can be a security risk. + CI_DEBUG_TRACE: "true" + +default: + image: docker:19.03.12 + timeout: 3 hours + before_script: + - docker info + - echo "docker registry is ${CI_REGISTRY}" + - docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY} + +.job-template: + variables: + test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA} + rules: + - changes: + - "**Makefile.in" + - .gitlab-ci.yml + - aclocal.m4 + - autogen.sh + - configure.ac + - lib/*.{h,c} + - lisp/**.el + - src/*.{h,c} + - test/infra/* + - test/lib-src/*.el + - test/lisp/**.el + - test/misc/*.el + - test/src/*.el + - changes: + # gfilemonitor, kqueue + - src/gfilenotify.c + - src/kqueue.c + # MS Windows + - "**w32*" + # GNUstep + - lisp/term/ns-win.el + - src/ns*.{h,m} + - src/macfont.{h,m} + when: never + # These will be cached across builds. + cache: + key: ${CI_COMMIT_SHA} + paths: [] + policy: pull-push + # These will be saved for followup builds. + artifacts: + expire_in: 24 hrs + paths: [] + # Using the variables for each job. + script: + - docker pull ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} + # TODO: with make -j4 several of the tests were failing, for + # example shadowfile-tests, but passed without it. + - 'export PWD=$(pwd)' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' + after_script: + # - docker ps -a + # - printenv + # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) + - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} + - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} + # - ls -alR ${test_name} + +.build-template: + needs: [] + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + when: always + - changes: + - "**Makefile.in" + - .gitlab-ci.yml + - aclocal.m4 + - autogen.sh + - configure.ac + - lib/*.{h,c} + - lisp/emacs-lisp/*.el + - src/*.{h,c} + - test/infra/* + - changes: + # gfilemonitor, kqueue + - src/gfilenotify.c + - src/kqueue.c + # MS Windows + - "**w32*" + # GNUstep + - lisp/term/ns-win.el + - src/ns*.{h,m} + - src/macfont.{h,m} + when: never + script: + - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba . + - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} + +.test-template: + # Do not run fast and normal test jobs when scheduled. + rules: + - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' + when: never + - when: always + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - ${test_name}/**/*.log + - ${test_name}/**/core + - ${test_name}/core + when: always + +.gnustep-template: + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' + changes: + - "**Makefile.in" + - .gitlab-ci.yml + - configure.ac + - src/ns*.{h,m} + - src/macfont.{h,m} + - lisp/term/ns-win.el + - nextstep/** + - test/infra/* + +.filenotify-gio-template: + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' + changes: + - "**Makefile.in" + - .gitlab-ci.yml + - lisp/autorevert.el + - lisp/filenotify.el + - lisp/net/tramp-sh.el + - src/gfilenotify.c + - test/infra/* + - test/lisp/autorevert-tests.el + - test/lisp/filenotify-tests.el + +.native-comp-template: + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' + changes: + - "**Makefile.in" + - .gitlab-ci.yml + - lisp/emacs-lisp/comp.el + - lisp/emacs-lisp/comp-cstr.el + - src/comp.{h,m} + - test/infra/* + - test/src/comp-resources/*.el + - test/src/comp-tests.el + timeout: 8 hours + +# Local Variables: +# add-log-current-defun-header-regexp: "^\\([-_.[:alnum:]]+\\)[ \t]*:" +# End: diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index abc7bddbf73..738e709c6b3 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -15,7 +15,7 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -# GNU Emacs support for the GitLab protocol for CI +# GNU Emacs support for the GitLab protocol for CI. # The presence of this file does not imply any FSF/GNU endorsement of # any particular service that uses that protocol. Also, it is intended for @@ -24,199 +24,15 @@ # Maintainer: Ted Zlatanov # URL: https://emba.gnu.org/emacs/emacs -# Never run merge request pipelines, they usually duplicate push pipelines -# see https://docs.gitlab.com/ee/ci/yaml/README.html#common-if-clauses-for-rules - -# Rules: always run tags and branches named master*, emacs*, feature*, fix* -# Test that it triggers by pushing a tag: `git tag mytag; git push origin mytag` -# Test that it triggers by pushing to: feature/emba, feature1, master, master-2, fix/emba, emacs-299, fix-2 -# Test that it doesn't trigger by pushing to: scratch-2, scratch/emba, oldbranch, dev -workflow: - rules: - - if: '$CI_PIPELINE_SOURCE == "merge_request_event"' - when: never - - if: '$CI_COMMIT_TAG' - when: always - - if: '$CI_COMMIT_BRANCH !~ /^(master|emacs|feature|fix)/' - when: never - - when: always - -variables: - GIT_STRATEGY: fetch - EMACS_EMBA_CI: 1 - # Three hours, see below. - EMACS_TEST_TIMEOUT: 10800 - EMACS_TEST_VERBOSE: 1 - # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled - # DOCKER_HOST: tcp://docker:2376 - # DOCKER_TLS_CERTDIR: "/certs" - # Put the configuration for each run in a separate directory to - # avoid conflicts. - DOCKER_CONFIG: "/.docker-config-${CI_COMMIT_SHA}" - DOCKER_BUILDKIT: 1 - # We don't use ${CI_COMMIT_SHA} to be able to do one bootstrap - # across multiple builds. - BUILD_TAG: ${CI_COMMIT_REF_SLUG} - # Disable if you don't need it, it can be a security risk. - CI_DEBUG_TRACE: "true" - -default: - image: docker:19.03.12 - timeout: 3 hours - before_script: - - docker info - - echo "docker registry is ${CI_REGISTRY}" - - docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY} - -.job-template: - variables: - test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA} - rules: - - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - aclocal.m4 - - autogen.sh - - configure.ac - - lib/*.{h,c} - - lisp/**.el - - src/*.{h,c} - - test/infra/* - - test/lib-src/*.el - - test/lisp/**.el - - test/misc/*.el - - test/src/*.el - - changes: - # gfilemonitor, kqueue - - src/gfilenotify.c - - src/kqueue.c - # MS Windows - - "**w32*" - # GNUstep - - lisp/term/ns-win.el - - src/ns*.{h,m} - - src/macfont.{h,m} - when: never - # These will be cached across builds. - cache: - key: ${CI_COMMIT_SHA} - paths: [] - policy: pull-push - # These will be saved for followup builds. - artifacts: - expire_in: 24 hrs - paths: [] - # Using the variables for each job. - script: - - docker pull ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} - # TODO: with make -j4 several of the tests were failing, for - # example shadowfile-tests, but passed without it. - - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' - after_script: - # - docker ps -a - # - printenv - # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) - - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} - # - ls -alR ${test_name} - -.build-template: - needs: [] - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - when: always - - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - aclocal.m4 - - autogen.sh - - configure.ac - - lib/*.{h,c} - - lisp/emacs-lisp/*.el - - src/*.{h,c} - - test/infra/* - - changes: - # gfilemonitor, kqueue - - src/gfilenotify.c - - src/kqueue.c - # MS Windows - - "**w32*" - # GNUstep - - lisp/term/ns-win.el - - src/ns*.{h,m} - - src/macfont.{h,m} - when: never - script: - - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba . - - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} - -.test-template: - # Do not run fast and normal test jobs when scheduled. - rules: - - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' - when: never - - when: always - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/**/*.log - - ${test_name}/**/core - - ${test_name}/core - when: always - -.gnustep-template: - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - - if: '$CI_PIPELINE_SOURCE == "schedule"' - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - configure.ac - - src/ns*.{h,m} - - src/macfont.{h,m} - - lisp/term/ns-win.el - - nextstep/** - - test/infra/* - -.filenotify-gio-template: - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - - if: '$CI_PIPELINE_SOURCE == "schedule"' - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - lisp/autorevert.el - - lisp/filenotify.el - - lisp/net/tramp-sh.el - - src/gfilenotify.c - - test/infra/* - - test/lisp/autorevert-tests.el - - test/lisp/filenotify-tests.el - -.native-comp-template: - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - - if: '$CI_PIPELINE_SOURCE == "schedule"' - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - lisp/emacs-lisp/comp.el - - lisp/emacs-lisp/comp-cstr.el - - src/comp.{h,m} - - test/infra/* - - test/src/comp-resources/*.el - - test/src/comp-tests.el - timeout: 8 hours +# Include defaults. +include: '/test/infra/default-gitlab-ci.yml' stages: - build-images - generator - trigger # - fast - - normal +# - normal - platform-images - platforms - native-comp-images @@ -239,7 +55,6 @@ build-image-inotify: test-jobs-generator: stage: generator script: - - pwd - test/infra/test-jobs-generator.sh > test-jobs.yml artifacts: paths: @@ -249,6 +64,7 @@ test-jobs-pipeline: stage: trigger trigger: include: + - local: '/test/infra/default-gitlab-ci.yml' - artifact: test-jobs.yml job: test-jobs-generator strategy: depend diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh index 96b61be9662..49f491ea669 100755 --- a/test/infra/test-jobs-generator.sh +++ b/test/infra/test-jobs-generator.sh @@ -20,7 +20,7 @@ # GNU Emacs support for the gitlab-ci.yml template generation. # The presence of this file does not imply any FSF/GNU endorsement of -# GitLab or any other particular tool. Also, it is intended for +# any particular service that uses that protocol. Also, it is intended for # evaluation purposes, thus possibly temporary. # Maintainer: Michael Albinus @@ -52,10 +52,16 @@ for subdir in $SUBDIRS; do ;; esac + cat < Date: Sat, 20 Nov 2021 10:20:43 +0100 Subject: [PATCH 157/367] Fix another narrow-to-defun problem in js-mode * lisp/progmodes/js.el (js--function-prologue-beginning): Fix typo in looking-back form (bug#51926). --- lisp/progmodes/js.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e5e83beff6c..9303f1ecb91 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1247,7 +1247,7 @@ LIMIT defaults to point." (save-excursion (goto-char orig-match-start) (when (looking-back "\\_[ \t\n]+" - (- (point) 3)) + (- (point) 30)) (setq orig-match-start (match-beginning 0)))) (make-js--pitem :paren-depth orig-depth From 2ba7d1e84e76fa4d08fd8ed5a915793d4bf881cd Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 20 Nov 2021 10:37:20 +0100 Subject: [PATCH 158/367] Implement the buttonForeground resource * lwlib/xlwmenu.c (draw_shadow_rectangle, draw_shadow_rhombus): Use the buttonForeground resource color (bug#51988). --- lwlib/xlwmenu.c | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 702fad49ba6..5f8832bb362 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -641,6 +641,21 @@ draw_shadow_rectangle (XlwMenuWidget mw, int thickness = !x && !y ? mw->menu.border_thickness : mw->menu.shadow_thickness; XPoint points [4]; + if (!erase_p && width == height && width == toggle_button_width (mw)) + { + points [0].x = x; + points [0].y = y; + points [1].x = x + width; + points [1].y = y; + points [2].x = x + width; + points [2].y = y + height; + points [3].x = x; + points [3].y = y + height; + XFillPolygon (dpy, window, + down_p ? mw->menu.button_gc : mw->menu.inactive_button_gc, + points, 4, Convex, CoordModeOrigin); + } + if (!erase_p && down_p) { GC temp; @@ -704,6 +719,21 @@ draw_shadow_rhombus (XlwMenuWidget mw, int thickness = mw->menu.shadow_thickness; XPoint points [4]; + if (!erase_p && width == height && width == radio_button_width (mw)) + { + points [0].x = x; + points [0].y = y + width / 2; + points [1].x = x + height / 2; + points [1].y = y + width; + points [2].x = x + height; + points [2].y = y + width / 2; + points [3].x = x + height / 2; + points [3].y = y; + XFillPolygon (dpy, window, + down_p ? mw->menu.button_gc : mw->menu.inactive_button_gc, + points, 4, Convex, CoordModeOrigin); + } + if (!erase_p && down_p) { GC temp; From c22c988b1f3d9ae5d3f504100bf8e1cb79fab334 Mon Sep 17 00:00:00 2001 From: martin rudalics Date: Sat, 20 Nov 2021 10:56:13 +0100 Subject: [PATCH 159/367] Fix mouse events on tab bar or tool bar when 'track-mouse' is t * lisp/mouse.el (mouse-drag-track): * lisp/mouse-drag.el (mouse-drag-drag): Set 'track-mouse' to some value neither t nor nil. * src/keyboard.c (make_lispy_position): If track_mouse is Qt, report event on tool or tab bar (Bug#51794). --- lisp/mouse-drag.el | 2 ++ lisp/mouse.el | 6 +++++- src/keyboard.c | 23 ++++++++++++----------- 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index ecfb359b36f..0cdba6b4d01 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -282,6 +282,8 @@ To test this function, evaluate: (setq window-last-row (- (window-height) 2) window-last-col (- (window-width) 2)) (track-mouse + ;; Set 'track-mouse' to something neither nil nor t (Bug#51794). + (setq track-mouse 'drag-dragging) (while (progn (setq event (read--potential-mouse-event) end (event-end event) diff --git a/lisp/mouse.el b/lisp/mouse.el index 0a4ab2878ab..5c645a4b895 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1618,7 +1618,11 @@ The region will be defined with mark and point." (goto-char (nth 1 range))) (setf (terminal-parameter nil 'mouse-drag-start) start-event) - (setq track-mouse t) + ;; Set 'track-mouse' to something neither nil nor t, so that mouse + ;; events are not reported to have happened on the tool bar or the + ;; tab bar, as that breaks drag events that originate on the window + ;; body below these bars; see make_lispy_position and bug#51794. + (setq track-mouse 'drag-tracking) (setq auto-hscroll-mode nil) (set-transient-map diff --git a/src/keyboard.c b/src/keyboard.c index c608c072f01..1d8d98c9419 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5124,19 +5124,20 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, #endif ) { - /* FIXME: While track_mouse is non-nil, we do not report this + /* While 'track-mouse' is neither nil nor t, do not report this event as something that happened on the tool or tab bar since - that would break mouse dragging operations that originate from - an ordinary window beneath and expect the window to auto-scroll - as soon as the mouse cursor appears above or beneath it - (Bug#50993). Since this "fix" might break track_mouse based - operations originating from the tool or tab bar itself, such - operations should set track_mouse to some special value that - would be recognized by the following check. + that would break mouse drag operations that originate from an + ordinary window beneath that bar and expect the window to + auto-scroll as soon as the mouse cursor appears above or + beneath it (Bug#50993). We do allow reports for t, because + applications may have set 'track-mouse' to t and still expect a + click on the tool or tab bar to get through (Bug#51794). - This issue should be properly handled by 'mouse-drag-track' and - friends, so the below is only a temporary workaround. */ - if (NILP (track_mouse)) + FIXME: This is a preliminary fix for the bugs cited above and + awaits a solution that includes a convention for all special + values of 'track-mouse' and their documentation in the Elisp + manual. */ + if (NILP (track_mouse) || EQ (track_mouse, Qt)) posn = EQ (window_or_frame, f->tab_bar_window) ? Qtab_bar : Qtool_bar; /* Kludge alert: for mouse events on the tab bar and tool bar, keyboard.c wants the frame, not the special-purpose window From fbf361f593df52ff414a4483f105e2e4c1a921e2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 18:23:02 +0800 Subject: [PATCH 160/367] Allow terminating page loading operations in webkit xwidgets * doc/lispref/display.texi (Xwidgets): Document new function. * etc/NEWS: Announce `xwidget-webkit-stop-loading'. * src/xwidget.c (Fxwidget_webkit_stop_loading): New function. (syms_of_xwidget): Define new subr. --- doc/lispref/display.texi | 6 ++++++ etc/NEWS | 5 +++++ src/xwidget.c | 25 +++++++++++++++++++++++++ 3 files changed, 36 insertions(+) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 08426032e09..c093901ea1d 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7025,6 +7025,12 @@ If this function is not called at least once on @var{xwidget} or a related widget, @var{xwidget} will not store cookies on disk at all. @end defun +@defun xwidget-webkit-stop-loading xwidget +Terminate any data transfer still in progress in the WebKit widget +@var{xwidget} as part of a page-loading operation. If a page is not +being loaded, this function does nothing. +@end defun + @node Buttons @section Buttons @cindex buttons in buffers diff --git a/etc/NEWS b/etc/NEWS index 70ba5341d8a..a5ca8fbb2be 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -873,6 +873,11 @@ WebKit xwidget. This function is used to obtain the estimated progress of page loading in a given WebKit xwidget. ++++ +*** New function 'xwidget-webkit-stop-loading'. +This function is used to terminate all data transfer during page loads +in a given WebKit xwidget. + +++ *** 'load-changed' xwidget events are now more detailed. In particular, they can now have different arguments based on the diff --git a/src/xwidget.c b/src/xwidget.c index 8cad2fbc2c1..b1bf291a168 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2615,6 +2615,30 @@ store cookies in FILE and load them from there. */) return Qnil; } +DEFUN ("xwidget-webkit-stop-loading", Fxwidget_webkit_stop_loading, + Sxwidget_webkit_stop_loading, + 1, 1, 0, doc: /* Stop loading data in the WebKit widget XWIDGET. +This will stop any data transfer that may still be in progress inside +XWIDGET as part of loading a page. */) + (Lisp_Object xwidget) +{ +#ifdef USE_GTK + struct xwidget *xw; + WebKitWebView *webview; + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + webkit_web_view_stop_loading (webview); + unblock_input (); +#endif + + return Qnil; +} + void syms_of_xwidget (void) { @@ -2656,6 +2680,7 @@ syms_of_xwidget (void) defsubr (&Sxwidget_webkit_previous_result); defsubr (&Sset_xwidget_buffer); defsubr (&Sxwidget_webkit_set_cookie_storage_file); + defsubr (&Sxwidget_webkit_stop_loading); #ifdef USE_GTK defsubr (&Sxwidget_webkit_load_html); defsubr (&Sxwidget_webkit_back_forward_list); From 487ec3cf2a34496866153474507ab741d8dfea63 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Oct 2021 13:15:36 +0800 Subject: [PATCH 161/367] Add support for event processing via XInput 2 * configure.ac: Add an option to use XInput 2 if available. * src/Makefile.in (XINPUT_LIBS, XINPUT_CFLAGS): New variables. (EMACS_CFLAGS): Add Xinput CFLAGS. (LIBES): Add XInput libs. * src/xmenu.c (popup_activated_flag): Expose flag if XInput 2 is available. * src/xfns.c (x_window): Set XInput 2 event mask. (setup_xi_event_mask): New function. (syms_of_xfns): Provide XInput 2 feature. * src/xterm.c (x_detect_focus_change): Handle XInput 2 GenericEvents. (handle_one_xevent): Handle XInput 2 events. (x_term_init): Ask the server for XInput 2 support and set xkb_desc if available. (x_delete_terminal): Free XKB kb desc if it exists, and free XI2 devices if they exist. (xi_grab_or_ungrab_device) (xi_reset_scroll_valuators_for_device_id) (x_free_xi_devices, x_init_master_valuators): New functions. (x_get_scroll_valuator_delta): New function. (init_xterm): Don't tell GTK to only use Core Input when built with XInput 2 support. * src/xterm.h (struct x_display_info): Add fields for XKB and XI2 support. * src/gtkutil.c (xg_event_is_for_menubar): Handle XIDeviceEvents. (xg_is_menu_window): New function. (xg_event_is_for_scrollbar): Handle XIDeviceEvents. * etc/NEWS: Document changes. * lisp/mwheel.el (mouse-wheel-down-alternate-event) (mouse-wheel-up-alternate-event) (mouse-wheel-left-alternate-event) (mouse-wheel-right-alternate-event): New user options. (mouse-wheel-text-scale) (mwheel-scroll): Test for alternate events. (mouse-wheel--setup-bindings): Set up bindings for alternate buttons. --- configure.ac | 22 + etc/NEWS | 17 + lisp/mwheel.el | 66 ++- src/Makefile.in | 7 +- src/gtkutil.c | 72 ++- src/gtkutil.h | 4 + src/xfns.c | 50 +++ src/xmenu.c | 4 + src/xterm.c | 1107 ++++++++++++++++++++++++++++++++++++++++++++++- src/xterm.h | 44 ++ 10 files changed, 1372 insertions(+), 21 deletions(-) diff --git a/configure.ac b/configure.ac index c231c2ceae2..239bf72f716 100644 --- a/configure.ac +++ b/configure.ac @@ -487,6 +487,7 @@ OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support]) OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support]) OPTION_DEFAULT_OFF([native-compilation],[compile with Emacs Lisp native compiler support]) OPTION_DEFAULT_OFF([cygwin32-native-compilation],[use native compilation on 32-bit Cygwin]) +OPTION_DEFAULT_OFF([xinput2],[use version 2.0 the X Input Extension for input]) AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])], @@ -4237,6 +4238,26 @@ fi AC_SUBST(XFIXES_CFLAGS) AC_SUBST(XFIXES_LIBS) +## Use XInput 2.0 if available +HAVE_XINPUT2=no +if test "${HAVE_X11}" = "yes" && test "${with_xinput2}" != "no"; then + EMACS_CHECK_MODULES([XINPUT], [xi]) + if test $HAVE_XINPUT = yes; then + # Now check for XInput2.h + AC_CHECK_HEADER(X11/extensions/XInput2.h, + [AC_CHECK_LIB(Xi, XIGrabButton, HAVE_XINPUT2=yes)]) + fi + if test $HAVE_XINPUT2 = yes; then + AC_DEFINE(HAVE_XINPUT2, 1, [Define to 1 if the X Input Extension version 2.0 is present.]) + if test "$USE_GTK_TOOLKIT" = "GTK2"; then + AC_MSG_WARN([You are building Emacs with GTK+ 2 and the X Input Extension version 2. +This might lead to problems if your version of GTK+ is not built with support for XInput 2.]) + fi + fi +fi +AC_SUBST(XINPUT_CFLAGS) +AC_SUBST(XINPUT_LIBS) + ### Use Xdbe (-lXdbe) if available HAVE_XDBE=no if test "${HAVE_X11}" = "yes"; then @@ -6011,6 +6032,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs support legacy unexec dumping? ${with_unexec} Which dumping strategy does Emacs use? ${with_dumping} Does Emacs have native lisp compiler? ${HAVE_NATIVE_COMP} + Does Emacs use version 2 of the the X Input Extension? ${HAVE_XINPUT2} "]) if test -n "${EMACSDATA}"; then diff --git a/etc/NEWS b/etc/NEWS index a5ca8fbb2be..3cceac55844 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -30,6 +30,14 @@ The file is typically installed using a file name akin to If a constant file name is required, the file can be renamed to "emacs.pdmp", and Emacs will find it during startup anyway. +** Emacs now supports use of XInput 2 for input events. +If your X server has support and you have the XInput 2 development headers +installed, you can configure Emacs with the option '--with-xinput2' to enable +this support. + +The named feature `xinput2' can be used to test for the presence of +XInput 2 support from Lisp programs. + * Startup Changes in Emacs 29.1 @@ -224,6 +232,15 @@ The user option 'comint-terminfo-terminal' and variable 'system-uses-terminfo' can now be set as connection-local variables to change the terminal used on a remote host. +** Mwheel + +--- +*** New user options for alternate wheel events. +The options 'mouse-wheel-down-alternate-event', 'mouse-wheel-up-alternate-event', +'mouse-wheel-left-alternate-event', and 'mouse-wheel-right-alternate-event' have +been added to better support systems where two kinds of wheel events can be +received. + * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 51410e3ef4c..3d0b8f07cb7 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -63,6 +63,13 @@ :type 'symbol :set 'mouse-wheel-change-button) +(defcustom mouse-wheel-down-alternate-event + (when (featurep 'xinput2) 'wheel-up) + "Alternative wheel down event to consider." + :group 'mouse + :type 'symbol + :set 'mouse-wheel-change-button) + (defcustom mouse-wheel-up-event (if (or (featurep 'w32-win) (featurep 'ns-win)) 'wheel-down @@ -72,6 +79,13 @@ :type 'symbol :set 'mouse-wheel-change-button) +(defcustom mouse-wheel-up-alternate-event + (when (featurep 'xinput2) 'wheel-down) + "Alternative wheel up event to consider." + :group 'mouse + :type 'symbol + :set 'mouse-wheel-change-button) + (defcustom mouse-wheel-click-event 'mouse-2 "Event that should be temporarily inhibited after mouse scrolling. The mouse wheel is typically on the mouse-2 button, so it may easily @@ -226,12 +240,20 @@ Also see `mouse-wheel-tilt-scroll'." 'mouse-6) "Event used for scrolling left.") +(defvar mouse-wheel-left-alternate-event + (when (featurep 'xinput2) 'wheel-left) + "Alternative wheel left event to consider.") + (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win)) 'wheel-right 'mouse-7) "Event used for scrolling right.") +(defvar mouse-wheel-right-alternate-event + (when (featurep 'xinput2) 'wheel-right) + "Alternative wheel right event to consider.") + (defun mouse-wheel--get-scroll-window (event) "Return window for mouse wheel event EVENT. If `mouse-wheel-follow-mouse' is non-nil, return the window that @@ -296,14 +318,16 @@ value of ARG, and the command uses it in subsequent scrolls." (condition-case nil (unwind-protect (let ((button (mwheel-event-button event))) - (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event)) + (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event + mouse-wheel-down-alternate-event))) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function mwheel-scroll-right-function) mouse-wheel-scroll-amount-horizontal)) - ((eq button mouse-wheel-down-event) + ((memq button (list mouse-wheel-down-event + mouse-wheel-down-alternate-event)) (condition-case nil (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. @@ -318,23 +342,27 @@ value of ARG, and the command uses it in subsequent scrolls." ;; for a reason that escapes me. This problem seems ;; to only affect scroll-down. --Stef (set-window-start (selected-window) (point-min)))))) - ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event)) + ((and (eq amt 'hscroll) (memq button (list mouse-wheel-up-event + mouse-wheel-up-alternate-event))) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function mwheel-scroll-left-function) mouse-wheel-scroll-amount-horizontal)) - ((eq button mouse-wheel-up-event) + ((memq button (list mouse-wheel-up-event + mouse-wheel-up-alternate-event)) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) - ((eq button mouse-wheel-left-event) ; for tilt scroll + ((memq button (list mouse-wheel-left-event + mouse-wheel-left-alternate-event)) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function mwheel-scroll-left-function) amt))) - ((eq button mouse-wheel-right-event) ; for tilt scroll + ((memq button (list mouse-wheel-right-event + mouse-wheel-right-alternate-event)) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function @@ -378,9 +406,11 @@ value of ARG, and the command uses it in subsequent scrolls." (button (mwheel-event-button event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect - (cond ((eq button mouse-wheel-down-event) + (cond ((memq button (list mouse-wheel-down-event + mouse-wheel-down-alternate-event)) (text-scale-increase 1)) - ((eq button mouse-wheel-up-event) + ((eq button (list mouse-wheel-up-event + mouse-wheel-up-alternate-event)) (text-scale-decrease 1))) (select-window selected-window)))) @@ -432,15 +462,23 @@ an event used for scrolling, such as `mouse-wheel-down-event'." (cond ;; Bindings for changing font size. ((and (consp binding) (eq (cdr binding) 'text-scale)) - (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) - (mouse-wheel--add-binding `[,(list (caar binding) event)] - 'mouse-wheel-text-scale))) + (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event + mouse-wheel-down-alternate-event + mouse-wheel-up-alternate-event)) + (when event + (mouse-wheel--add-binding `[,(list (caar binding) event)] + 'mouse-wheel-text-scale)))) ;; Bindings for scrolling. (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-left-event mouse-wheel-right-event)) - (dolist (key (mouse-wheel--create-scroll-keys binding event)) - (mouse-wheel--add-binding key 'mwheel-scroll))))))) + mouse-wheel-left-event mouse-wheel-right-event + mouse-wheel-down-alternate-event + mouse-wheel-up-alternate-event + mouse-wheel-left-alternate-event + mouse-wheel-right-alternate-event)) + (when event + (dolist (key (mouse-wheel--create-scroll-keys binding event)) + (mouse-wheel--add-binding key 'mwheel-scroll)))))))) (when mouse-wheel-mode (mouse-wheel--setup-bindings)) diff --git a/src/Makefile.in b/src/Makefile.in index 4c5535f8ad9..0aaaf91d392 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -258,6 +258,9 @@ XINERAMA_CFLAGS = @XINERAMA_CFLAGS@ XFIXES_LIBS = @XFIXES_LIBS@ XFIXES_CFLAGS = @XFIXES_CFLAGS@ +XINPUT_LIBS = @XINPUT_LIBS@ +XINPUT_CFLAGS = @XINPUT_CFLAGS@ + XDBE_LIBS = @XDBE_LIBS@ XDBE_CFLAGS = @XDBE_CFLAGS@ @@ -374,7 +377,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \ $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \ - $(WEBKIT_CFLAGS) $(WEBP_CFLAGS) $(LCMS2_CFLAGS) \ + $(XINPUT_CFLAGS) $(WEBP_CFLAGS) $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \ @@ -524,7 +527,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ - $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) + $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, diff --git a/src/gtkutil.c b/src/gtkutil.c index a9eabf47d8f..9e676cd025b 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -47,6 +47,10 @@ along with GNU Emacs. If not, see . */ #include +#ifdef HAVE_XINPUT2 +#include +#endif + #ifdef HAVE_XFT #include #endif @@ -839,6 +843,23 @@ my_log_handler (const gchar *log_domain, GLogLevelFlags log_level, } #endif +#if defined HAVE_GTK3 && defined HAVE_XINPUT2 +bool +xg_is_menu_window (Display *dpy, Window wdesc) +{ + GtkWidget *gwdesc = xg_win_to_widget (dpy, wdesc); + + if (GTK_IS_WINDOW (gwdesc)) + { + GtkWidget *fw = gtk_bin_get_child (GTK_BIN (gwdesc)); + if (GTK_IS_MENU (fw)) + return true; + } + + return false; +} +#endif + /* Make a geometry string and pass that to GTK. It seems this is the only way to get geometry position right if the user explicitly asked for a position when starting Emacs. @@ -3589,6 +3610,18 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) if (! x->menubar_widget) return 0; +#ifdef HAVE_XINPUT2 + XIDeviceEvent *xev = (XIDeviceEvent *) event->xcookie.data; + if (event->type == GenericEvent) /* XI_ButtonPress or XI_ButtonRelease */ + { + if (! (xev->event_x >= 0 + && xev->event_x < FRAME_PIXEL_WIDTH (f) + && xev->event_y >= 0 + && xev->event_y < FRAME_MENUBAR_HEIGHT (f))) + return 0; + } + else +#endif if (! (event->xbutton.x >= 0 && event->xbutton.x < FRAME_PIXEL_WIDTH (f) && event->xbutton.y >= 0 @@ -3597,7 +3630,12 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) return 0; gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f)); - gw = gdk_x11_window_lookup_for_display (gdpy, event->xbutton.window); +#ifdef HAVE_XINPUT2 + if (event->type == GenericEvent) + gw = gdk_x11_window_lookup_for_display (gdpy, xev->event); + else +#endif + gw = gdk_x11_window_lookup_for_display (gdpy, event->xbutton.window); if (! gw) return 0; gevent.any.window = gw; gevent.any.type = GDK_NOTHING; @@ -4244,7 +4282,20 @@ xg_event_is_for_scrollbar (struct frame *f, const XEvent *event) { bool retval = 0; +#ifdef HAVE_XINPUT2 + XIDeviceEvent *xev = (XIDeviceEvent *) event->xcookie.data; + if (f && ((FRAME_DISPLAY_INFO (f)->supports_xi2 + && event->type == GenericEvent + && (event->xgeneric.extension + == FRAME_DISPLAY_INFO (f)->xi2_opcode) + && ((event->xgeneric.evtype == XI_ButtonPress + && xev->detail < 4) + || (event->xgeneric.evtype == XI_Motion))) + || (event->type == ButtonPress + && event->xbutton.button < 4))) +#else if (f && event->type == ButtonPress && event->xbutton.button < 4) +#endif /* HAVE_XINPUT2 */ { /* Check if press occurred outside the edit widget. */ GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f)); @@ -4262,10 +4313,29 @@ xg_event_is_for_scrollbar (struct frame *f, const XEvent *event) gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL); #endif retval = gwin != gtk_widget_get_window (f->output_data.x->edit_widget); +#ifdef HAVE_XINPUT2 + GtkWidget *grab = gtk_grab_get_current (); + if (event->type == GenericEvent + && event->xgeneric.evtype == XI_Motion) + retval = retval || (grab && GTK_IS_SCROLLBAR (grab)); +#endif } +#ifdef HAVE_XINPUT2 + else if (f && ((FRAME_DISPLAY_INFO (f)->supports_xi2 + && event->type == GenericEvent + && (event->xgeneric.extension + == FRAME_DISPLAY_INFO (f)->xi2_opcode) + && ((event->xgeneric.evtype == XI_ButtonRelease + && xev->detail < 4) + || (event->xgeneric.evtype == XI_Motion))) + || ((event->type == ButtonRelease + && event->xbutton.button < 4) + || event->type == MotionNotify))) +#else else if (f && ((event->type == ButtonRelease && event->xbutton.button < 4) || event->type == MotionNotify)) +#endif /* HAVE_XINPUT2 */ { /* If we are releasing or moving the scroll bar, it has the grab. */ GtkWidget *w = gtk_grab_get_current (); diff --git a/src/gtkutil.h b/src/gtkutil.h index 31a12cd5d3c..95dd75b7fad 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -192,6 +192,10 @@ extern Lisp_Object xg_get_page_setup (void); extern void xg_print_frames_dialog (Lisp_Object); #endif +#if defined HAVE_GTK3 && defined HAVE_XINPUT2 +extern bool xg_is_menu_window (Display *dpy, Window); +#endif + /* Mark all callback data that are Lisp_object:s during GC. */ extern void xg_mark_data (void); diff --git a/src/xfns.c b/src/xfns.c index 785ae3baca5..b33b40b330b 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -57,6 +57,10 @@ along with GNU Emacs. If not, see . */ #include #endif +#ifdef HAVE_XINPUT2 +#include +#endif + #ifdef USE_X_TOOLKIT #include @@ -2912,6 +2916,37 @@ initial_set_up_x_back_buffer (struct frame *f) unblock_input (); } +#if defined HAVE_XINPUT2 && !defined USE_GTK +static void +setup_xi_event_mask (struct frame *f) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + mask.deviceid = XIAllMasterDevices; + + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_KeyPress); + XISetMask (m, XI_KeyRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + XISetMask (m, XI_FocusIn); + XISetMask (m, XI_FocusOut); + XISetMask (m, XI_PropertyEvent); + XISetMask (m, XI_HierarchyChanged); + XISetMask (m, XI_DeviceChanged); + XISelectEvents (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + &mask, 1); +} +#endif + #ifdef USE_X_TOOLKIT /* Create and set up the X widget for frame F. */ @@ -3074,6 +3109,11 @@ x_window (struct frame *f, long window_prompting) class_hints.res_class = SSDATA (Vx_resource_class); XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints); +#ifdef HAVE_XINPUT2 + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + setup_xi_event_mask (f); +#endif + #ifdef HAVE_X_I18N FRAME_XIC (f) = NULL; if (use_xim) @@ -3254,6 +3294,11 @@ x_window (struct frame *f) } #endif /* HAVE_X_I18N */ +#ifdef HAVE_XINPUT2 + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + setup_xi_event_mask (f); +#endif + validate_x_resource_name (); class_hints.res_name = SSDATA (Vx_resource_name); @@ -8038,6 +8083,11 @@ eliminated in future versions of Emacs. */); /* Tell Emacs about this window system. */ Fprovide (Qx, Qnil); +#ifdef HAVE_XINPUT2 + DEFSYM (Qxinput2, "xinput2"); + Fprovide (Qxinput2, Qnil); +#endif + #ifdef USE_X_TOOLKIT Fprovide (intern_c_string ("x-toolkit"), Qnil); #ifdef USE_MOTIF diff --git a/src/xmenu.c b/src/xmenu.c index ea2cbab2030..07255911f97 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -105,7 +105,11 @@ along with GNU Emacs. If not, see . */ /* Flag which when set indicates a dialog or menu has been posted by Xt on behalf of one of the widget sets. */ +#ifndef HAVE_XINPUT2 static int popup_activated_flag; +#else +int popup_activated_flag; +#endif #ifdef USE_X_TOOLKIT diff --git a/src/xterm.c b/src/xterm.c index 816b6dc5a8b..63754a2cb61 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -42,6 +42,10 @@ along with GNU Emacs. If not, see . */ #include #endif +#ifdef HAVE_XINPUT2 +#include +#endif + /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev @@ -223,9 +227,15 @@ static bool x_handle_net_wm_state (struct frame *, const XPropertyEvent *); static void x_check_fullscreen (struct frame *); static void x_check_expected_move (struct frame *, int, int); static void x_sync_with_move (struct frame *, int, int, bool); +#ifndef HAVE_XINPUT2 static int handle_one_xevent (struct x_display_info *, const XEvent *, int *, struct input_event *); +#else +static int handle_one_xevent (struct x_display_info *, + XEvent *, int *, + struct input_event *); +#endif #if ! (defined USE_X_TOOLKIT || defined USE_MOTIF) && defined USE_GTK static int x_dispatch_event (XEvent *, Display *); #endif @@ -335,6 +345,224 @@ x_extension_initialize (struct x_display_info *dpyinfo) dpyinfo->ext_codes = ext_codes; } + +#ifdef HAVE_XINPUT2 + +/* Free all XI2 devices on dpyinfo. */ +static void +x_free_xi_devices (struct x_display_info *dpyinfo) +{ + block_input (); + + if (dpyinfo->num_devices) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, + CurrentTime); + xfree (dpyinfo->devices[i].valuators); + } + + xfree (dpyinfo->devices); + dpyinfo->devices = NULL; + dpyinfo->num_devices = 0; + } + + unblock_input (); +} + +/* Setup valuator tracking for XI2 master devices on + DPYINFO->display. */ + +static void +x_init_master_valuators (struct x_display_info *dpyinfo) +{ + int ndevices; + XIDeviceInfo *infos; + + block_input (); + x_free_xi_devices (dpyinfo); + infos = XIQueryDevice (dpyinfo->display, + XIAllMasterDevices, + &ndevices); + + if (!ndevices) + { + XIFreeDeviceInfo (infos); + unblock_input (); + return; + } + + int actual_devices = 0; + dpyinfo->devices = xmalloc (sizeof *dpyinfo->devices * ndevices); + + for (int i = 0; i < ndevices; ++i) + { + XIDeviceInfo *device = &infos[i]; + + if (device->enabled) + { + int actual_valuator_count = 0; + struct xi_device_t *xi_device = &dpyinfo->devices[actual_devices++]; + xi_device->device_id = device->deviceid; + xi_device->grab = 0; + xi_device->valuators = + xmalloc (sizeof *xi_device->valuators * device->num_classes); + + for (int c = 0; c < device->num_classes; ++c) + { + switch (device->classes[c]->type) + { +#ifdef XIScrollClass /* XInput 2.1 */ + case XIScrollClass: + { + XIScrollClassInfo *info = + (XIScrollClassInfo *) device->classes[c]; + struct xi_scroll_valuator_t *valuator = + &xi_device->valuators[actual_valuator_count++]; + + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; + break; + } +#endif + default: + break; + } + } + xi_device->scroll_valuator_count = actual_valuator_count; + } + } + + dpyinfo->num_devices = actual_devices; + XIFreeDeviceInfo (infos); + unblock_input (); +} + +/* Return the delta of the scroll valuator VALUATOR_NUMBER under + DEVICE_ID in the display DPYINFO with VALUE. The valuator's + valuator will be set to VALUE afterwards. In case no scroll + valuator is found, or if device_id is not known to Emacs, DBL_MAX + is returned. Otherwise, the valuator is returned in + VALUATOR_RETURN. */ +static double +x_get_scroll_valuator_delta (struct x_display_info *dpyinfo, int device_id, + int valuator_number, double value, + struct xi_scroll_valuator_t **valuator_return) +{ + block_input (); + + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + struct xi_device_t *device = &dpyinfo->devices[i]; + + if (device->device_id == device_id) + { + for (int j = 0; j < device->scroll_valuator_count; ++j) + { + struct xi_scroll_valuator_t *sv = &device->valuators[j]; + + if (sv->number == valuator_number) + { + if (sv->invalid_p) + { + sv->current_value = value; + sv->invalid_p = false; + *valuator_return = sv; + + unblock_input (); + return 0.0; + } + else + { + double delta = (sv->current_value - value) / sv->increment; + sv->current_value = value; + *valuator_return = sv; + + unblock_input (); + return delta; + } + } + } + + unblock_input (); + return DBL_MAX; + } + } + + unblock_input (); + return DBL_MAX; +} + +static struct xi_device_t * +xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) +{ + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + if (dpyinfo->devices[i].device_id == deviceid) + return &dpyinfo->devices[i]; + } + + return NULL; +} + +static void +xi_grab_or_ungrab_device (struct xi_device_t *device, + struct x_display_info *dpyinfo, + Window window) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + if (device->grab) + { + XIGrabDevice (dpyinfo->display, device->device_id, window, + CurrentTime, None, GrabModeAsync, + GrabModeAsync, True, &mask); + } + else + { + XIUngrabDevice (dpyinfo->display, device->device_id, CurrentTime); + } +} + +static void +xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id) +{ + struct xi_device_t *device = xi_device_from_id (dpyinfo, id); + struct xi_scroll_valuator_t *valuator; + + if (!device) + return; + + if (!device->scroll_valuator_count) + return; + + for (int i = 0; i < device->scroll_valuator_count; ++i) + { + valuator = &device->valuators[i]; + valuator->invalid_p = true; + } + + return; +} + +#endif + void x_cr_destroy_frame_context (struct frame *f) { @@ -4768,7 +4996,16 @@ static struct frame * x_menubar_window_to_frame (struct x_display_info *dpyinfo, const XEvent *event) { - Window wdesc = event->xany.window; + Window wdesc; +#ifdef HAVE_XINPUT2 + if (event->type == GenericEvent + && dpyinfo->supports_xi2 + && (event->xcookie.evtype == XI_ButtonPress + || event->xcookie.evtype == XI_ButtonRelease)) + wdesc = ((XIDeviceEvent *) event->xcookie.data)->event; + else +#endif + wdesc = event->xany.window; Lisp_Object tail, frame; struct frame *f; struct x_output *x; @@ -4871,6 +5108,29 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, } break; +#ifdef HAVE_XINPUT2 + case GenericEvent: + { + XIEvent *xi_event = (XIEvent *) event; + + struct frame *focus_frame = dpyinfo->x_focus_event_frame; + int focus_state + = focus_frame ? focus_frame->output_data.x->focus_state : 0; + + if (!((xi_event->evtype == XI_Enter + || xi_event->evtype == XI_Leave) + && (focus_state & FOCUS_EXPLICIT))) + x_focus_changed ((xi_event->evtype == XI_Enter + || xi_event->evtype == XI_FocusIn + ? FocusIn : FocusOut), + (xi_event->evtype == XI_Enter + || xi_event->evtype == XI_Leave + ? FOCUS_IMPLICIT : FOCUS_EXPLICIT), + dpyinfo, frame, bufp); + break; + } +#endif + case FocusIn: case FocusOut: /* Ignore transient focus events from hotkeys, window manager @@ -7975,7 +8235,11 @@ mouse_or_wdesc_frame (struct x_display_info *dpyinfo, int wdesc) static int handle_one_xevent (struct x_display_info *dpyinfo, +#ifndef HAVE_XINPUT2 const XEvent *event, +#else + XEvent *event, +#endif int *finish, struct input_event *hold_quit) { union buffered_input_event inev; @@ -8001,7 +8265,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = NO_EVENT; inev.ie.arg = Qnil; - any = x_any_window_to_frame (dpyinfo, event->xany.window); +#ifdef HAVE_XINPUT2 + if (event->type != GenericEvent) +#endif + any = x_any_window_to_frame (dpyinfo, event->xany.window); +#ifdef HAVE_XINPUT2 + else + any = NULL; +#endif if (any && any->wait_event_type == event->type) any->wait_event_type = 0; /* Indicates we got it. */ @@ -8480,6 +8751,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case MapNotify: +#if defined HAVE_XINPUT2 && defined HAVE_GTK3 + if (xg_is_menu_window (dpyinfo->display, event->xmap.window)) + popup_activated_flag = 1; +#endif /* We use x_top_window_to_frame because map events can come for sub-windows and they don't mean that the frame is visible. */ @@ -9518,6 +9793,785 @@ handle_one_xevent (struct x_display_info *dpyinfo, case DestroyNotify: xft_settings_event (dpyinfo, event); break; +#ifdef HAVE_XINPUT2 + case GenericEvent: + { + if (!dpyinfo->supports_xi2) + goto OTHER; + if (event->xgeneric.extension != dpyinfo->xi2_opcode) + /* Not an XI2 event. */ + goto OTHER; + bool must_free_data = false; + XIEvent *xi_event = (XIEvent *) event->xcookie.data; + /* Sometimes the event is already claimed by GTK, which + will free its data in due course. */ + if (!xi_event && XGetEventData (dpyinfo->display, &event->xcookie)) + { + must_free_data = true; + xi_event = (XIEvent *) event->xcookie.data; + } + + XIDeviceEvent *xev = (XIDeviceEvent *) xi_event; + XILeaveEvent *leave = (XILeaveEvent *) xi_event; + XIEnterEvent *enter = (XIEnterEvent *) xi_event; + XIFocusInEvent *focusin = (XIFocusInEvent *) xi_event; + XIFocusOutEvent *focusout = (XIFocusOutEvent *) xi_event; + XIValuatorState *states; + double *values; + bool found_valuator = false; + + /* A fake XMotionEvent for x_note_mouse_movement. */ + XMotionEvent ev; + /* A fake XButtonEvent for x_construct_mouse_click. */ + XButtonEvent bv; + + if (!xi_event) + { + eassert (!must_free_data); + goto OTHER; + } + + switch (event->xcookie.evtype) + { + case XI_FocusIn: + any = x_any_window_to_frame (dpyinfo, focusin->event); +#ifndef USE_GTK + /* Some WMs (e.g. Mutter in Gnome Shell), don't unmap + minimized/iconified windows; thus, for those WMs we won't get + a MapNotify when unminimizing/deconifying. Check here if we + are deiconizing a window (Bug42655). + + But don't do that on GTK since it may cause a plain invisible + frame get reported as iconified, compare + https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html. + That is fixed above but bites us here again. */ + f = any; + if (f && FRAME_ICONIFIED_P (f)) + { + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, false); + f->output_data.x->has_been_visible = true; + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + } +#endif /* USE_GTK */ + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + goto XI_OTHER; + case XI_FocusOut: + any = x_any_window_to_frame (dpyinfo, focusout->event); + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + goto XI_OTHER; + case XI_Enter: + any = x_any_window_to_frame (dpyinfo, enter->event); + ev.x = lrint (enter->event_x); + ev.y = lrint (enter->event_y); + ev.window = leave->event; + + x_display_set_last_user_time (dpyinfo, xi_event->time); + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid); + f = any; + + if (f && x_mouse_click_focus_ignore_position) + ignore_next_mouse_click_timeout = xi_event->time + 200; + + /* EnterNotify counts as mouse movement, + so update things that depend on mouse position. */ + if (f && !f->output_data.x->hourglass_p) + x_note_mouse_movement (f, &ev); +#ifdef USE_GTK + /* We may get an EnterNotify on the buttons in the toolbar. In that + case we moved out of any highlighted area and need to note this. */ + if (!f && dpyinfo->last_mouse_glyph_frame) + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); +#endif + goto XI_OTHER; + case XI_Leave: + ev.x = lrint (leave->event_x); + ev.y = lrint (leave->event_y); + ev.window = leave->event; + any = x_any_window_to_frame (dpyinfo, leave->event); + + x_display_set_last_user_time (dpyinfo, xi_event->time); + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + xi_reset_scroll_valuators_for_device_id (dpyinfo, leave->deviceid); + + f = x_top_window_to_frame (dpyinfo, leave->event); + if (f) + { + if (f == hlinfo->mouse_face_mouse_frame) + { + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; + } + + /* Generate a nil HELP_EVENT to cancel a help-echo. + Do it only if there's something to cancel. + Otherwise, the startup message is cleared when + the mouse leaves the frame. */ + if (any_help_event_p) + do_help = -1; + } +#ifdef USE_GTK + /* See comment in EnterNotify above */ + else if (dpyinfo->last_mouse_glyph_frame) + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); +#endif + goto XI_OTHER; + case XI_Motion: + /* First test if there is some kind of scroll event + here! */ + states = &xev->valuators; + values = states->values; + + x_display_set_last_user_time (dpyinfo, xi_event->time); + + for (int i = 0; i < states->mask_len * 8; i++) + { + if (XIMaskIsSet (states->mask, i)) + { + block_input (); + + struct xi_scroll_valuator_t *val; + double delta; + + delta = x_get_scroll_valuator_delta (dpyinfo, xev->deviceid, + i, *values, &val); + + if (delta != DBL_MAX) + { + f = mouse_or_wdesc_frame (dpyinfo, xev->event); + found_valuator = true; + + if (signbit (delta) != signbit (val->emacs_value)) + val->emacs_value = 0; + + val->emacs_value += delta; + + if (!f) + { + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (!f) + { + unblock_input (); + goto XI_OTHER; + } + } + + bool s = signbit (val->emacs_value); + inev.ie.kind = (val->horizontal + ? HORIZ_WHEEL_EVENT + : WHEEL_EVENT); + inev.ie.timestamp = xev->time; + + XSETINT (inev.ie.x, lrint (xev->event_x)); + XSETINT (inev.ie.y, lrint (xev->event_y)); + XSETFRAME (inev.ie.frame_or_window, f); + + inev.ie.modifiers = !s ? up_modifier : down_modifier; + inev.ie.modifiers + |= x_x_to_emacs_modifiers (dpyinfo, + xev->mods.effective); + inev.ie.arg = Qnil; + + kbd_buffer_store_event_hold (&inev.ie, hold_quit); + + val->emacs_value = 0; + } + unblock_input (); + values++; + } + + inev.ie.kind = NO_EVENT; + } + + if (found_valuator) + goto XI_OTHER; + + ev.x = lrint (xev->event_x); + ev.y = lrint (xev->event_y); + ev.window = xev->event; + + previous_help_echo_string = help_echo_string; + help_echo_string = Qnil; + + if (hlinfo->mouse_face_hidden) + { + hlinfo->mouse_face_hidden = false; + clear_mouse_face (hlinfo); + } + + f = mouse_or_wdesc_frame (dpyinfo, xev->event); + +#ifdef USE_GTK + if (f && xg_event_is_for_scrollbar (f, event)) + f = 0; +#endif + if (f) + { + /* Maybe generate a SELECT_WINDOW_EVENT for + `mouse-autoselect-window' but don't let popup menus + interfere with this (Bug#1261). */ + if (!NILP (Vmouse_autoselect_window) + && !popup_activated () + /* Don't switch if we're currently in the minibuffer. + This tries to work around problems where the + minibuffer gets unselected unexpectedly, and where + you then have to move your mouse all the way down to + the minibuffer to select it. */ + && !MINI_WINDOW_P (XWINDOW (selected_window)) + /* With `focus-follows-mouse' non-nil create an event + also when the target window is on another frame. */ + && (f == XFRAME (selected_frame) + || !NILP (focus_follows_mouse))) + { + static Lisp_Object last_mouse_window; + Lisp_Object window = window_from_coordinates (f, ev.x, ev.y, 0, false, false); + + /* A window will be autoselected only when it is not + selected now and the last mouse movement event was + not in it. The remainder of the code is a bit vague + wrt what a "window" is. For immediate autoselection, + the window is usually the entire window but for GTK + where the scroll bars don't count. For delayed + autoselection the window is usually the window's text + area including the margins. */ + if (WINDOWP (window) + && !EQ (window, last_mouse_window) + && !EQ (window, selected_window)) + { + inev.ie.kind = SELECT_WINDOW_EVENT; + inev.ie.frame_or_window = window; + } + + /* Remember the last window where we saw the mouse. */ + last_mouse_window = window; + } + + if (!x_note_mouse_movement (f, &ev)) + help_echo_string = previous_help_echo_string; + } + else + { +#ifndef USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (xi_event->display, xev->event, 2); + + if (bar) + x_scroll_bar_note_movement (bar, &ev); +#endif /* USE_TOOLKIT_SCROLL_BARS */ + + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + } + + /* If the contents of the global variable help_echo_string + has changed, generate a HELP_EVENT. */ + if (!NILP (help_echo_string) + || !NILP (previous_help_echo_string)) + do_help = 1; + goto XI_OTHER; + case XI_ButtonRelease: + case XI_ButtonPress: + { + /* If we decide we want to generate an event to be seen + by the rest of Emacs, we put it here. */ + Lisp_Object tab_bar_arg = Qnil; + bool tab_bar_p = false; + bool tool_bar_p = false; + struct xi_device_t *device; + + /* Ignore emulated scroll events when XI2 native + scroll events are present. */ + if (dpyinfo->xi2_version >= 1 && xev->detail >= 4 + && xev->detail <= 8) + goto XI_OTHER; + + device = xi_device_from_id (dpyinfo, xev->deviceid); + + bv.button = xev->detail; + bv.type = xev->evtype == XI_ButtonPress ? ButtonPress : ButtonRelease; + bv.x = lrint (xev->event_x); + bv.y = lrint (xev->event_y); + bv.window = xev->event; + bv.state = xev->mods.base + | xev->mods.effective + | xev->mods.latched + | xev->mods.locked; + + memset (&compose_status, 0, sizeof (compose_status)); + dpyinfo->last_mouse_glyph_frame = NULL; + x_display_set_last_user_time (dpyinfo, xev->time); + + f = mouse_or_wdesc_frame (dpyinfo, xev->event); + + if (f && xev->evtype == XI_ButtonPress + && !popup_activated () + && !x_window_to_scroll_bar (xev->display, xev->event, 2) + && !FRAME_NO_ACCEPT_FOCUS (f)) + { + /* When clicking into a child frame or when clicking + into a parent frame with the child frame selected and + `no-accept-focus' is not set, select the clicked + frame. */ + struct frame *hf = dpyinfo->highlight_frame; + + if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf))) + { + block_input (); + XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + RevertToParent, CurrentTime); + if (FRAME_PARENT_FRAME (f)) + XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); + unblock_input (); + } + } + +#ifdef USE_GTK + if (f && xg_event_is_for_scrollbar (f, event)) + f = 0; +#endif + + if (f) + { + /* Is this in the tab-bar? */ + if (WINDOWP (f->tab_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tab_bar_window))) + { + Lisp_Object window; + int x = bv.x; + int y = bv.y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tab_bar_p = EQ (window, f->tab_bar_window); + + if (tab_bar_p) + tab_bar_arg = handle_tab_bar_click + (f, x, y, xev->evtype == XI_ButtonPress, + x_x_to_emacs_modifiers (dpyinfo, bv.state)); + } + +#if ! defined (USE_GTK) + /* Is this in the tool-bar? */ + if (WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) + { + Lisp_Object window; + int x = bv.x; + int y = bv.y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tool_bar_p = EQ (window, f->tool_bar_window); + + if (tool_bar_p && xev->detail < 4) + handle_tool_bar_click + (f, x, y, xev->evtype == XI_ButtonPress, + x_x_to_emacs_modifiers (dpyinfo, bv.state)); + } +#endif /* !USE_GTK */ + + if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + if (! popup_activated ()) +#endif + { + if (ignore_next_mouse_click_timeout) + { + if (xev->evtype == XI_ButtonPress + && xev->time > ignore_next_mouse_click_timeout) + { + ignore_next_mouse_click_timeout = 0; + x_construct_mouse_click (&inev.ie, &bv, f); + } + if (xev->evtype == XI_ButtonRelease) + ignore_next_mouse_click_timeout = 0; + } + else + x_construct_mouse_click (&inev.ie, &bv, f); + + if (!NILP (tab_bar_arg)) + inev.ie.arg = tab_bar_arg; + } + if (FRAME_X_EMBEDDED_P (f)) + xembed_send_message (f, xev->time, + XEMBED_REQUEST_FOCUS, 0, 0, 0); + } + + if (xev->evtype == XI_ButtonPress) + { + dpyinfo->grabbed |= (1 << xev->detail); + device->grab |= (1 << xev->detail); + dpyinfo->last_mouse_frame = f; + if (f && !tab_bar_p) + f->last_tab_bar_item = -1; +#if ! defined (USE_GTK) + if (f && !tool_bar_p) + f->last_tool_bar_item = -1; +#endif /* not USE_GTK */ + + } + else + { + dpyinfo->grabbed &= ~(1 << xev->detail); + device->grab &= ~(1 << xev->detail); + } + + xi_grab_or_ungrab_device (device, dpyinfo, xev->event); + + if (f) + f->mouse_moved = false; + +#if defined (USE_GTK) + /* No Xt toolkit currently available has support for XI2. + So the code here assumes use of GTK. */ + f = x_menubar_window_to_frame (dpyinfo, event); + if (f /* Gtk+ menus only react to the first three buttons. */ + && xev->detail < 3) + { + /* What is done with Core Input ButtonPressed is not + possible here, because GenericEvents cannot be saved. */ + bool was_waiting_for_input = waiting_for_input; + /* This hack was adopted from the NS port. Whether + or not it is actually safe is a different story + altogether. */ + if (waiting_for_input) + waiting_for_input = 0; + set_frame_menubar (f, true); + waiting_for_input = was_waiting_for_input; + } +#endif + goto XI_OTHER; + } + case XI_KeyPress: + { + int state = xev->mods.base + | xev->mods.effective + | xev->mods.latched + | xev->mods.locked; + Lisp_Object c; +#ifdef HAVE_XKB + unsigned int mods_rtrn; +#endif + int keycode = xev->detail; + KeySym keysym; + char copy_buffer[81]; + char *copy_bufptr = copy_buffer; + unsigned char *copy_ubufptr; +#ifdef HAVE_XKB + int copy_bufsiz = sizeof (copy_buffer); +#endif + ptrdiff_t i; + int nchars, len; + +#ifdef HAVE_XKB + if (dpyinfo->xkb_desc) + { + if (!XkbTranslateKeyCode (dpyinfo->xkb_desc, keycode, + state, &mods_rtrn, &keysym)) + goto XI_OTHER; + } + else + { +#endif + int keysyms_per_keycode_return; + KeySym *ksms = XGetKeyboardMapping (dpyinfo->display, keycode, 1, + &keysyms_per_keycode_return); + if (!(keysym = ksms[0])) + { + XFree (ksms); + goto XI_OTHER; + } + XFree (ksms); +#ifdef HAVE_XKB + } +#endif + + if (keysym == NoSymbol) + goto XI_OTHER; + + x_display_set_last_user_time (dpyinfo, xev->time); + ignore_next_mouse_click_timeout = 0; + +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + /* Dispatch XI_KeyPress events when in menu. */ + if (popup_activated ()) + goto XI_OTHER; +#endif + + f = x_any_window_to_frame (dpyinfo, xev->event); + + /* If mouse-highlight is an integer, input clears out + mouse highlighting. */ + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) + && (f == 0 +#if ! defined (USE_GTK) + || !EQ (f->tool_bar_window, hlinfo->mouse_face_window) +#endif + || !EQ (f->tab_bar_window, hlinfo->mouse_face_window)) + ) + { + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = true; + } + + if (f != 0) + { +#ifdef USE_GTK + /* Don't pass keys to GTK. A Tab will shift focus to the + tool bar in GTK 2.4. Keys will still go to menus and + dialogs because in that case popup_activated is nonzero + (see above). */ + *finish = X_EVENT_DROP; +#endif + /* If not using XIM/XIC, and a compose sequence is in progress, + we break here. Otherwise, chars_matched is always 0. */ + if (compose_status.chars_matched > 0 && nbytes == 0) + goto XI_OTHER; + + memset (&compose_status, 0, sizeof (compose_status)); + + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.modifiers + = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), state); + inev.ie.timestamp = xev->time; + + /* First deal with keysyms which have defined + translations to characters. */ + if (keysym >= 32 && keysym < 128) + /* Avoid explicitly decoding each ASCII character. */ + { + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + + goto xi_done_keysym; + } + + /* Keysyms directly mapped to Unicode characters. */ + if (keysym >= 0x01000000 && keysym <= 0x0110FFFF) + { + if (keysym < 0x01000080) + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + else + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.code = keysym & 0xFFFFFF; + goto xi_done_keysym; + } + + /* Now non-ASCII. */ + if (HASH_TABLE_P (Vx_keysym_table) + && (c = Fgethash (make_fixnum (keysym), + Vx_keysym_table, + Qnil), + FIXNATP (c))) + { + inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFIXNAT (c)) + ? ASCII_KEYSTROKE_EVENT + : MULTIBYTE_CHAR_KEYSTROKE_EVENT); + inev.ie.code = XFIXNAT (c); + goto xi_done_keysym; + } + + /* Random non-modifier sorts of keysyms. */ + if (((keysym >= XK_BackSpace && keysym <= XK_Escape) + || keysym == XK_Delete +#ifdef XK_ISO_Left_Tab + || (keysym >= XK_ISO_Left_Tab + && keysym <= XK_ISO_Enter) +#endif + || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ + || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ +#ifdef HPUX + /* This recognizes the "extended function + keys". It seems there's no cleaner way. + Test IsModifierKey to avoid handling + mode_switch incorrectly. */ + || (XK_Select <= keysym && keysym < XK_KP_Space) +#endif +#ifdef XK_dead_circumflex + || keysym == XK_dead_circumflex +#endif +#ifdef XK_dead_grave + || keysym == XK_dead_grave +#endif +#ifdef XK_dead_tilde + || keysym == XK_dead_tilde +#endif +#ifdef XK_dead_diaeresis + || keysym == XK_dead_diaeresis +#endif +#ifdef XK_dead_macron + || keysym == XK_dead_macron +#endif +#ifdef XK_dead_degree + || keysym == XK_dead_degree +#endif +#ifdef XK_dead_acute + || keysym == XK_dead_acute +#endif +#ifdef XK_dead_cedilla + || keysym == XK_dead_cedilla +#endif +#ifdef XK_dead_breve + || keysym == XK_dead_breve +#endif +#ifdef XK_dead_ogonek + || keysym == XK_dead_ogonek +#endif +#ifdef XK_dead_caron + || keysym == XK_dead_caron +#endif +#ifdef XK_dead_doubleacute + || keysym == XK_dead_doubleacute +#endif +#ifdef XK_dead_abovedot + || keysym == XK_dead_abovedot +#endif + || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ + || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ + /* Any "vendor-specific" key is ok. */ + || (keysym & (1 << 28)) + || (keysym != NoSymbol && nbytes == 0)) + && ! (IsModifierKey (keysym) + /* The symbols from XK_ISO_Lock + to XK_ISO_Last_Group_Lock + don't have real modifiers but + should be treated similarly to + Mode_switch by Emacs. */ +#if defined XK_ISO_Lock && defined XK_ISO_Last_Group_Lock + || (XK_ISO_Lock <= keysym + && keysym <= XK_ISO_Last_Group_Lock) +#endif + )) + { + STORE_KEYSYM_FOR_DEBUG (keysym); + /* make_lispy_event will convert this to a symbolic + key. */ + inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + goto xi_done_keysym; + } + +#ifdef HAVE_XKB + int overflow = 0; + KeySym sym = keysym; + + if (dpyinfo->xkb_desc) + { + if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz, &overflow))) + goto XI_OTHER; + } + else +#else + { + block_input (); + char *str = XKeysymToString (keysym); + if (!str) + { + unblock_input (); + goto XI_OTHER; + } + nbytes = strlen (str) + 1; + copy_bufptr = alloca (nbytes); + strcpy (copy_bufptr, str); + unblock_input (); + } +#endif +#ifdef HAVE_XKB + if (overflow) + { + overflow = 0; + copy_bufptr = alloca (copy_bufsiz + overflow); + keysym = sym; + if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz + overflow, &overflow))) + goto XI_OTHER; + + if (overflow) + goto XI_OTHER; + } +#endif + + for (i = 0, nchars = 0; i < nbytes; i++) + { + if (ASCII_CHAR_P (copy_bufptr[i])) + nchars++; + STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); + } + + if (nchars < nbytes) + { + /* Decode the input data. */ + + setup_coding_system (Vlocale_coding_system, &coding); + coding.src_multibyte = false; + coding.dst_multibyte = true; + /* The input is converted to events, thus we can't + handle composition. Anyway, there's no XIM that + gives us composition information. */ + coding.common_flags &= ~CODING_ANNOTATION_MASK; + + SAFE_NALLOCA (coding.destination, MAX_MULTIBYTE_LENGTH, + nbytes); + coding.dst_bytes = MAX_MULTIBYTE_LENGTH * nbytes; + coding.mode |= CODING_MODE_LAST_BLOCK; + decode_coding_c_string (&coding, (unsigned char *) copy_bufptr, + nbytes, Qnil); + nbytes = coding.produced; + nchars = coding.produced_char; + copy_bufptr = (char *) coding.destination; + } + + copy_ubufptr = (unsigned char *) copy_bufptr; + + /* Convert the input data to a sequence of + character events. */ + for (i = 0; i < nbytes; i += len) + { + int ch; + if (nchars == nbytes) + ch = copy_ubufptr[i], len = 1; + else + ch = string_char_and_length (copy_ubufptr + i, &len); + inev.ie.kind = (SINGLE_BYTE_CHAR_P (ch) + ? ASCII_KEYSTROKE_EVENT + : MULTIBYTE_CHAR_KEYSTROKE_EVENT); + inev.ie.code = ch; + kbd_buffer_store_buffered_event (&inev, hold_quit); + } + + inev.ie.kind = NO_EVENT; + goto xi_done_keysym; + } + goto XI_OTHER; + } + case XI_KeyRelease: + x_display_set_last_user_time (dpyinfo, xev->time); + goto XI_OTHER; + case XI_PropertyEvent: + case XI_HierarchyChanged: + case XI_DeviceChanged: + x_init_master_valuators (dpyinfo); + goto XI_OTHER; + default: + goto XI_OTHER; + } + xi_done_keysym: + if (must_free_data) + XFreeEventData (dpyinfo->display, &event->xcookie); + goto done_keysym; + XI_OTHER: + if (must_free_data) + XFreeEventData (dpyinfo->display, &event->xcookie); + goto OTHER; + } +#endif default: OTHER: @@ -13199,6 +14253,40 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->supports_xdbe = true; #endif +#ifdef HAVE_XINPUT2 + dpyinfo->supports_xi2 = false; + int rc; + int major = 2; +#ifdef XI_BarrierHit /* XInput 2.3 */ + int minor = 3; +#elif defined XI_TouchBegin /* XInput 2.2 */ + int minor = 2; +#elif defined XIScrollClass /* XInput 1.1 */ + int minor = 1; +#else /* Some old version of XI2 we're not interested in. */ + int minor = 0; +#endif + int fer, fee; + + if (XQueryExtension (dpyinfo->display, "XInputExtension", + &dpyinfo->xi2_opcode, &fer, &fee)) + { + rc = XIQueryVersion (dpyinfo->display, &major, &minor); + if (rc == Success) + { + dpyinfo->supports_xi2 = true; + x_init_master_valuators (dpyinfo); + } + } + dpyinfo->xi2_version = minor; +#endif + +#ifdef HAVE_XKB + dpyinfo->xkb_desc = XkbGetMap (dpyinfo->display, + XkbAllComponentsMask, + XkbUseCoreKbd); +#endif + #if defined USE_CAIRO || defined HAVE_XFT { /* If we are using Xft, the following precautions should be made: @@ -13631,6 +14719,14 @@ x_delete_terminal (struct terminal *terminal) XrmDestroyDatabase (dpyinfo->rdb); #endif +#ifdef HAVE_XKB + if (dpyinfo->xkb_desc) + XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True); +#endif +#ifdef HAVE_XINPUT2 + if (dpyinfo->supports_xi2) + x_free_xi_devices (dpyinfo); +#endif #ifdef USE_GTK xg_display_close (dpyinfo->display); #else @@ -13790,9 +14886,12 @@ x_initialize (void) void init_xterm (void) { - /* Emacs can handle only core input events, so make sure - Gtk doesn't use Xinput or Xinput2 extensions. */ +#ifndef HAVE_XINPUT2 + /* Emacs can handle only core input events when built without XI2 + support, so make sure Gtk doesn't use Xinput or Xinput2 + extensions. */ xputenv ("GDK_CORE_DEVICE_EVENTS=1"); +#endif } #endif diff --git a/src/xterm.h b/src/xterm.h index 9d9534dd629..7abe168bc6f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -88,6 +88,10 @@ typedef GtkWidget *xt_or_gtk_widget; #include #endif +#ifdef HAVE_XKB +#include +#endif + #include "dispextern.h" #include "termhooks.h" @@ -163,6 +167,28 @@ struct color_name_cache_entry char *name; }; +#ifdef HAVE_XINPUT2 +struct xi_scroll_valuator_t +{ + bool invalid_p; + double current_value; + double emacs_value; + double increment; + + int number; + int horizontal; +}; + +struct xi_device_t +{ + int device_id; + int scroll_valuator_count; + int grab; + + struct xi_scroll_valuator_t *valuators; +}; +#endif + Status x_parse_color (struct frame *f, const char *color_name, XColor *color); @@ -474,6 +500,19 @@ struct x_display_info #ifdef HAVE_XDBE bool supports_xdbe; #endif + +#ifdef HAVE_XINPUT2 + bool supports_xi2; + int xi2_version; + int xi2_opcode; + + int num_devices; + struct xi_device_t *devices; +#endif + +#ifdef HAVE_XKB + XkbDescPtr xkb_desc; +#endif }; #ifdef HAVE_X_I18N @@ -481,6 +520,11 @@ struct x_display_info extern bool use_xim; #endif +#ifdef HAVE_XINPUT2 +/* Defined in xmenu.c. */ +extern int popup_activated_flag; +#endif + /* This is a chain of structures for all the X displays currently in use. */ extern struct x_display_info *x_display_list; From 0c51c1b5ede3521d90a94abdea42dee5078a9432 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Nov 2021 19:39:50 +0800 Subject: [PATCH 162/367] Expose pixel-wise wheel events to Lisp * doc/lispref/commands.texi (Misc Events): Document changes to wheel events. * src/keyboard.c (make_lispy_event): Handle wheel events with pixel delta data. * src/termhooks.h (WHEEL_EVENT): Document changes to WHEEL_EVENT args. * src/xfns.c (syms_of_xfns): Declare new symbols. * src/xterm.c (handle_one_xevent): Give wheel events pixel delta data. (x_coalesce_scroll_events): New user option. --- doc/lispref/commands.texi | 13 ++++++++++++- src/keyboard.c | 6 +++++- src/termhooks.h | 5 ++++- src/xfns.c | 1 + src/xterm.c | 41 ++++++++++++++++++++++++++++----------- 5 files changed, 52 insertions(+), 14 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index cc9c41623dc..5fd7b55a60b 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1994,7 +1994,18 @@ frame has already been made visible, Emacs has no work to do. These kinds of event are generated by moving a mouse wheel. The @var{position} element is a mouse position list (@pxref{Click Events}), specifying the position of the mouse cursor when the event -occurred. +occurred. The event may have additional arguments after +@var{position}. The third argument after @var{position}, if present, +is a pair of the form @w{@code{(@var{x} . @var{y})}}, where @var{x} +and @var{y} are the number of pixels to scroll by in each axis. + +@cindex pixel-resolution wheel events +You can use @var{x} and @var{y} to determine how much the mouse wheel +has actually moved at pixel resolution. + +For example, the pixelwise deltas could be used to scroll the display +at pixel resolution, exactly according to the user's turning the mouse +wheel. @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event diff --git a/src/keyboard.c b/src/keyboard.c index c3bc8307d7f..0c48790ce8d 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5980,7 +5980,11 @@ make_lispy_event (struct input_event *event) ASIZE (wheel_syms)); } - if (NUMBERP (event->arg)) + if (CONSP (event->arg)) + return list5 (head, position, make_fixnum (double_click_count), + XCAR (event->arg), Fcons (XCAR (XCDR (event->arg)), + XCAR (XCDR (XCDR (event->arg))))); + else if (NUMBERP (event->arg)) return list4 (head, position, make_fixnum (double_click_count), event->arg); else if (event->modifiers & (double_modifier | triple_modifier)) diff --git a/src/termhooks.h b/src/termhooks.h index e7539bbce2f..b274be9e3cd 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -119,7 +119,10 @@ enum event_kind .timestamp gives a timestamp (in milliseconds) for the event. .arg may contain the number of - lines to scroll. */ + lines to scroll, or a list of + the form (NUMBER-OF-LINES . (X Y)) where + X and Y are the number of pixels + on each axis to scroll by. */ HORIZ_WHEEL_EVENT, /* A wheel event generated by a second horizontal wheel that is present on some mice. See WHEEL_EVENT. */ diff --git a/src/xfns.c b/src/xfns.c index b33b40b330b..0ea43d13306 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -8085,6 +8085,7 @@ eliminated in future versions of Emacs. */); #ifdef HAVE_XINPUT2 DEFSYM (Qxinput2, "xinput2"); + Fprovide (Qxinput2, Qnil); #endif diff --git a/src/xterm.c b/src/xterm.c index 63754a2cb61..ed3921f2869 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -556,6 +556,7 @@ xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id) { valuator = &device->valuators[i]; valuator->invalid_p = true; + valuator->emacs_value = 0.0; } return; @@ -9921,8 +9922,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif goto XI_OTHER; case XI_Motion: - /* First test if there is some kind of scroll event - here! */ states = &xev->valuators; values = states->values; @@ -9932,10 +9931,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, { if (XIMaskIsSet (states->mask, i)) { - block_input (); - struct xi_scroll_valuator_t *val; - double delta; + double delta, scroll_unit; delta = x_get_scroll_valuator_delta (dpyinfo, xev->deviceid, i, *values, &val); @@ -9943,6 +9940,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (delta != DBL_MAX) { f = mouse_or_wdesc_frame (dpyinfo, xev->event); + scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); found_valuator = true; if (signbit (delta) != signbit (val->emacs_value)) @@ -9950,15 +9948,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, val->emacs_value += delta; + if (x_coalesce_scroll_events + && (fabs (val->emacs_value) < 1)) + continue; + if (!f) { f = x_any_window_to_frame (dpyinfo, xev->event); if (!f) - { - unblock_input (); - goto XI_OTHER; - } + goto XI_OTHER; } bool s = signbit (val->emacs_value); @@ -9975,13 +9974,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.modifiers |= x_x_to_emacs_modifiers (dpyinfo, xev->mods.effective); - inev.ie.arg = Qnil; + + if (val->horizontal) + { + inev.ie.arg + = list3 (Qnil, + make_float (val->emacs_value + * scroll_unit), + make_float (0)); + } + else + { + inev.ie.arg = list3 (Qnil, make_float (0), + make_float (val->emacs_value + * scroll_unit)); + } kbd_buffer_store_event_hold (&inev.ie, hold_quit); val->emacs_value = 0; } - unblock_input (); values++; } @@ -15048,4 +15060,11 @@ gtk_window_move to set or store frame positions and disables some time consuming frame position adjustments. In newer versions of GTK, Emacs always uses gtk_window_move and ignores the value of this variable. */); x_gtk_use_window_move = true; + + DEFVAR_BOOL ("x-coalesce-scroll-events", x_coalesce_scroll_events, + doc: /* Non-nil means send a wheel event only for scrolling at least one screen line. +Otherwise, a wheel event will be sent every time the mouse wheel is +moved. This option is only effective when Emacs is built with XInput +2. */); + x_coalesce_scroll_events = true; } From 6b0424c102b736686caccdc633b6a7126e26dbc0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 18:35:45 +0800 Subject: [PATCH 163/367] Fix a comment in XInput related code * src/xterm.c (x_term_init): Fix comment to say "XInput 2.1" instead of "XInput 1.1". --- src/xterm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xterm.c b/src/xterm.c index ed3921f2869..a023a5f9c89 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14273,7 +14273,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) int minor = 3; #elif defined XI_TouchBegin /* XInput 2.2 */ int minor = 2; -#elif defined XIScrollClass /* XInput 1.1 */ +#elif defined XIScrollClass /* XInput 2.1 */ int minor = 1; #else /* Some old version of XI2 we're not interested in. */ int minor = 0; From 4351722477cda59d88e5b1a90aa92cd6902021a8 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 20 Nov 2021 11:42:38 +0100 Subject: [PATCH 164/367] Make shr render text with superscripts prettier * lisp/net/shr.el (shr-sup): New face. (shr-tag-sup, shr-tag-sub): Use it to make the super/subscripts slightly smaller so that we don't get uneven line heights with text that uses these. --- lisp/net/shr.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 5a36f19c5f1..87bacd4fbf8 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -183,6 +183,11 @@ temporarily blinks with this face." "Face for elements." :version "27.1") +(defface shr-sup + '((t :height 0.8)) + "Face for and elements." + :version "29.1") + (defface shr-h1 '((t :height 1.3 :weight bold)) "Face for

elements." @@ -1464,12 +1469,14 @@ ones, in case fg and bg are nil." (defun shr-tag-sup (dom) (let ((start (point))) (shr-generic dom) - (put-text-property start (point) 'display '(raise 0.2)))) + (put-text-property start (point) 'display '(raise 0.2)) + (add-face-text-property start (point) 'shr-sup))) (defun shr-tag-sub (dom) (let ((start (point))) (shr-generic dom) - (put-text-property start (point) 'display '(raise -0.2)))) + (put-text-property start (point) 'display '(raise -0.2)) + (add-face-text-property start (point) 'shr-sup))) (defun shr-tag-p (dom) (shr-ensure-paragraph) From 9ccfdd54fab1ac23243e211cdda7cec16fe8fd57 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Nov 2021 12:44:13 +0200 Subject: [PATCH 165/367] ; * configure.ac (emacs_config_features): Add XINPUT2. --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 239bf72f716..82661c975e0 100644 --- a/configure.ac +++ b/configure.ac @@ -5955,7 +5955,7 @@ for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \ SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \ - UNEXEC WEBP X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ + UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINPUT2 XPM XWIDGETS X_TOOLKIT \ ZLIB; do case $opt in From 0fbfd4253ece9e5271509454cd2bbab5359e4b67 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Nov 2021 13:00:42 +0200 Subject: [PATCH 166/367] ; Avoid byte-compilation warnings in edmacro.el * lisp/edmacro.el (mouse-wheel-down-event, mouse-wheel-up-event) (mouse-wheel-right-event, mouse-wheel-left-event): Defvar them, to avoid compilation warnings in --without-x builds. --- lisp/edmacro.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index e90b3a006ef..42c164a0881 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -601,6 +601,12 @@ This function assumes that the events can be stored in a string." (setf (aref seq i) (logand (aref seq i) 127)))) seq) +;; These are needed in a --without-x build. +(defvar mouse-wheel-down-event) +(defvar mouse-wheel-up-event) +(defvar mouse-wheel-right-event) +(defvar mouse-wheel-left-event) + (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) From 5cb003c31c2484ec4281631df6a4c84631dbecc8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Nov 2021 12:14:49 +0100 Subject: [PATCH 167/367] ; Rearrange include in emba scripts --- test/infra/gitlab-ci.yml | 1 - test/infra/test-jobs-generator.sh | 3 +++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 738e709c6b3..ebfe9965139 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -64,7 +64,6 @@ test-jobs-pipeline: stage: trigger trigger: include: - - local: '/test/infra/default-gitlab-ci.yml' - artifact: test-jobs.yml job: test-jobs-generator strategy: depend diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh index 49f491ea669..15877dd3e60 100755 --- a/test/infra/test-jobs-generator.sh +++ b/test/infra/test-jobs-generator.sh @@ -53,6 +53,9 @@ for subdir in $SUBDIRS; do esac cat < Date: Sat, 20 Nov 2021 11:00:19 +0100 Subject: [PATCH 168/367] Convert snake and tetris keymaps to defvar-keymap * lisp/play/snake.el (snake-mode-map, snake-null-map): * lisp/play/tetris.el (tetris-mode-map, tetris-null-map): Convert to defvar-keymap. --- lisp/play/snake.el | 41 +++++++++++++++++++---------------------- lisp/play/tetris.el | 34 ++++++++++++++++------------------ 2 files changed, 35 insertions(+), 40 deletions(-) diff --git a/lisp/play/snake.el b/lisp/play/snake.el index 29effa23460..dbdecde973d 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -160,31 +160,28 @@ and then start moving it leftwards.") ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar snake-mode-map - (let ((map (make-sparse-keymap 'snake-mode-map))) +(defvar-keymap snake-mode-map + :doc "Keymap for Snake games." + :name 'snake-mode-map + "n" #'snake-start-game + "q" #'snake-end-game + "p" #'snake-pause-game - (define-key map "n" 'snake-start-game) - (define-key map "q" 'snake-end-game) - (define-key map "p" 'snake-pause-game) + "" #'snake-move-left + "" #'snake-move-right + "" #'snake-move-up + "" #'snake-move-down - (define-key map [left] 'snake-move-left) - (define-key map [right] 'snake-move-right) - (define-key map [up] 'snake-move-up) - (define-key map [down] 'snake-move-down) + "C-b" #'snake-move-left + "C-f" #'snake-move-right + "C-p" #'snake-move-up + "C-n" #'snake-move-down) - (define-key map "\C-b" 'snake-move-left) - (define-key map "\C-f" 'snake-move-right) - (define-key map "\C-p" 'snake-move-up) - (define-key map "\C-n" 'snake-move-down) - map) - "Keymap for Snake games.") - -(defvar snake-null-map - (let ((map (make-sparse-keymap 'snake-null-map))) - (define-key map "n" 'snake-start-game) - (define-key map "q" 'quit-window) - map) - "Keymap for finished Snake games.") +(defvar-keymap snake-null-map + :doc "Keymap for finished Snake games." + :name 'snake-null-map + "n" #'snake-start-game + "q" #'quit-window) (defconst snake--menu-def '("Snake" diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 3d6ddd5307f..693bfe49354 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -236,26 +236,24 @@ each one of its four blocks.") ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar tetris-mode-map - (let ((map (make-sparse-keymap 'tetris-mode-map))) - (define-key map "n" 'tetris-start-game) - (define-key map "q" 'tetris-end-game) - (define-key map "p" 'tetris-pause-game) +(defvar-keymap tetris-mode-map + :doc "Keymap for Tetris games." + :name 'tetris-mode-map + "n" #'tetris-start-game + "q" #'tetris-end-game + "p" #'tetris-pause-game - (define-key map " " 'tetris-move-bottom) - (define-key map [left] 'tetris-move-left) - (define-key map [right] 'tetris-move-right) - (define-key map [up] 'tetris-rotate-prev) - (define-key map [down] 'tetris-move-down) - map) - "Keymap for Tetris games.") + "SPC" #'tetris-move-bottom + "" #'tetris-move-left + "" #'tetris-move-right + "" #'tetris-rotate-prev + "" #'tetris-move-down) -(defvar tetris-null-map - (let ((map (make-sparse-keymap 'tetris-null-map))) - (define-key map "n" 'tetris-start-game) - (define-key map "q" 'quit-window) - map) - "Keymap for finished Tetris games.") +(defvar-keymap tetris-null-map + :doc "Keymap for finished Tetris games." + :name 'tetris-null-map + "n" #'tetris-start-game + "q" #'quit-window) (defconst tetris--menu-def '("Tetris" From 244baa550beb3ca6f6b87cf86e2dae4465a87cbd Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Nov 2021 11:09:23 +0100 Subject: [PATCH 169/367] image-dired: Improve some messages * lisp/image-dired.el (image-dired-dir) (image-dired-create-thumb-1): Improve messages. (image-dired-rotate-original): Signal 'user-error' instead of 'error'. --- lisp/image-dired.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 852ef0f1035..47a44a4a60e 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -520,14 +520,14 @@ Return the last form in BODY." ,@body)) (defun image-dired-dir () - "Return the current thumbnails directory (from variable `image-dired-dir'). -Create the thumbnails directory if it does not exist." + "Return the current thumbnail directory (from variable `image-dired-dir'). +Create the thumbnail directory if it does not exist." (let ((image-dired-dir (file-name-as-directory - (expand-file-name image-dired-dir)))) + (expand-file-name image-dired-dir)))) (unless (file-directory-p image-dired-dir) (with-file-modes #o700 (make-directory image-dired-dir t)) - (message "Creating thumbnails directory")) + (message "Thumbnail directory created: %s" image-dired-dir)) image-dired-dir)) (defun image-dired-insert-image (file type relief margin) @@ -743,9 +743,9 @@ and remove the cached thumbnail files between each trial run.") (thumbnail-dir (file-name-directory thumbnail-file)) process) (when (not (file-exists-p thumbnail-dir)) - (message "Creating thumbnail directory") (with-file-modes #o700 - (make-directory thumbnail-dir t))) + (make-directory thumbnail-dir t)) + (message "Thumbnail directory created: %s" thumbnail-dir)) ;; Thumbnail file creation processes begin here and are marshaled ;; in a queue by `image-dired-create-thumb'. @@ -2013,7 +2013,7 @@ With prefix argument ARG, display image in its original size." (cons ?o (expand-file-name file)) (cons ?t image-dired-temp-rotate-image-file)))) (unless (eq 'jpeg (image-type file)) - (error "Only JPEG images can be rotated!")) + (user-error "Only JPEG images can be rotated")) (if (not (= 0 (apply #'call-process image-dired-cmd-rotate-original-program nil nil nil (mapcar (lambda (arg) (format-spec arg spec)) From a3a3d3dd074850a11ade229fc65a07aaa3e44320 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Nov 2021 12:54:48 +0100 Subject: [PATCH 170/367] Make 'eval' use lexical scoping in most tests * test/lisp/electric-tests.el (electric-pair-define-test-form) (define-electric-pair-test): * test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--uncompiled-functions): * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-test--symbol-macrolet): * test/lisp/emacs-lisp/let-alist-tests.el (let-alist-list-to-sexp): * test/lisp/emacs-lisp/lisp-tests.el (elisp-tests-with-temp-buffer, core-elisp-tests-3-backquote): * test/lisp/emacs-lisp/testcover-resources/testcases.el (testcover-testcase-nth-case): * test/lisp/ffap-tests.el (ffap-ido-mode): * test/lisp/files-tests.el (file-test--do-local-variables-test): * test/lisp/net/tramp-tests.el (tramp--test-utf8): * test/lisp/progmodes/elisp-mode-tests.el (find-defs-defgeneric-eval, find-defs-defun-eval) (find-defs-defvar-eval, find-defs-face-eval) (find-defs-feature-eval): Give 'eval' non-nil LEXICAL argument. * test/lisp/subr-tests.el (subr-tests--dolist--wrong-number-of-args): * test/src/eval-tests.el (eval-tests--if-dot-string) (eval-tests--mutating-cond) (eval-tests-19790-backquote-comma-dot-substitution): Test 'eval' using LEXICAL as both nil and non-nil. (eval-tests--let-with-circular-defs): Give explicit nil to 'eval'. --- test/lisp/electric-tests.el | 6 +++--- test/lisp/emacs-lisp/backtrace-tests.el | 2 +- test/lisp/emacs-lisp/cl-macs-tests.el | 2 +- test/lisp/emacs-lisp/let-alist-tests.el | 2 +- test/lisp/emacs-lisp/lisp-tests.el | 4 ++-- .../emacs-lisp/testcover-resources/testcases.el | 2 +- test/lisp/ffap-tests.el | 2 +- test/lisp/files-tests.el | 2 +- test/lisp/net/tramp-tests.el | 2 +- test/lisp/progmodes/elisp-mode-tests.el | 10 +++++----- test/lisp/subr-tests.el | 13 +++++++------ test/src/eval-tests.el | 17 +++++++++++------ 12 files changed, 35 insertions(+), 29 deletions(-) diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index feeae2b82ad..85727bd0916 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -97,8 +97,8 @@ (with-temp-buffer (cl-progv ;; FIXME: avoid `eval' - (mapcar #'car (eval bindings)) - (mapcar #'cdr (eval bindings)) + (mapcar #'car (eval bindings t)) + (mapcar #'cdr (eval bindings t)) (dlet ((python-indent-guess-indent-offset-verbose nil)) (funcall mode) (insert fixture) @@ -187,7 +187,7 @@ The buffer's contents should %s: (fixture-fn '#'electric-pair-mode)) `(progn ,@(cl-loop - for mode in (eval modes) ;FIXME: avoid `eval' + for mode in (eval modes t) ;FIXME: avoid `eval' append (cl-loop for (prefix suffix extra-desc) in diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index 5c4e5305ecc..e35a7a729bc 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -49,7 +49,7 @@ (setq backtrace-frames (seq-subseq backtrace-frames 0 (1+ this-index)))) (backtrace-print)))) - (eval backtrace-tests--uncompiled-functions)) + (eval backtrace-tests--uncompiled-functions t)) (defun backtrace-tests--backtrace-lines () (if debugger-stack-frame-as-list diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 033764a7f98..be2c0fa02b4 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -529,7 +529,7 @@ collection clause." (should-error ;; Use `eval' so the error is signaled when running the test rather than ;; when macroexpanding it. - (eval '(let ((l (list 1))) (cl-symbol-macrolet ((x 1)) (setq (car l) 0))))) + (eval '(let ((l (list 1))) (cl-symbol-macrolet ((x 1)) (setq (car l) 0))) t)) ;; Make sure `gv-synthetic-place' isn't macro-expanded before `setf' gets to ;; see its `gv-expander'. (should (equal (let ((l '(0))) diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el index 88e689c80b8..bbceb04b49d 100644 --- a/test/lisp/emacs-lisp/let-alist-tests.el +++ b/test/lisp/emacs-lisp/let-alist-tests.el @@ -82,7 +82,7 @@ (ert-deftest let-alist-list-to-sexp () "Check that multiple dots are handled correctly." - (should (= 1 (eval (let-alist--list-to-sexp '(a b c d) ''((d (c (b (a . 1))))))))) + (should (= 1 (eval (let-alist--list-to-sexp '(a b c d) ''((d (c (b (a . 1)))))) t))) (should (equal (let-alist--access-sexp '.foo.bar.baz 'var) '(cdr (assq 'baz (cdr (assq 'bar (cdr (assq 'foo var)))))))) (should (equal (let-alist--access-sexp '..foo.bar.baz 'var) '.foo.bar.baz))) diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 78ecf3ff03d..8301d9906a2 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -235,7 +235,7 @@ (should (or (not mark-active) (mark))))) (ert-deftest core-elisp-tests-3-backquote () - (should (eq 3 (eval ``,,'(+ 1 2))))) + (should (eq 3 (eval ``,,'(+ 1 2) t)))) ;; Test up-list and backward-up-list. (defun lisp-run-up-list-test (fn data start instructions) @@ -324,7 +324,7 @@ start." (declare (indent 1) (debug (def-form body))) (let* ((var-pos nil) (text (with-temp-buffer - (insert (eval contents)) + (insert (eval contents t)) (goto-char (point-min)) (while (re-search-forward elisp-test-point-position-regex nil t) (push (list (intern (match-string-no-properties 1)) diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el index 29094526d7e..4d49e5ae70c 100644 --- a/test/lisp/emacs-lisp/testcover-resources/testcases.el +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el @@ -424,7 +424,7 @@ (defmacro testcover-testcase-nth-case (arg vec) (declare (indent 1) (debug (form (vector &rest form)))) - `(eval (aref ,vec%%% ,arg%%%))%%%) + `(eval (aref ,vec%%% ,arg%%%) t)%%%) (defun testcover-testcase-use-nth-case (choice val) (testcover-testcase-nth-case choice diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index 84b9cea6c12..df5c264baad 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -132,7 +132,7 @@ left alone when opening a URL in an external browser." ;; Macros in BODY are expanded when the test is defined, not when it ;; is run. If a macro (possibly with side effects) is to be tested, ;; it has to be wrapped in `(eval (quote ...))'. - (eval (quote (ido-everywhere))) + (eval (quote (ido-everywhere)) t) (let ((read-file-name-function (lambda (&rest args) (expand-file-name (nth 4 args) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 2c4557ead61..d3d58aad5f2 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -136,7 +136,7 @@ form.") ;; Prevent any dir-locals file interfering with the tests. (enable-dir-local-variables nil)) (hack-local-variables) - (eval (nth 2 test-settings))))) + (eval (nth 2 test-settings) t)))) (ert-deftest files-tests-local-variables () "Test the file-local variables implementation." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 52a03843372..47fa18eb806 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6609,7 +6609,7 @@ Use the \"ls\" command." ;; Use all available language specific snippets. (lambda (x) (and - (stringp (setq x (eval (get-language-info (car x) 'sample-text)))) + (stringp (setq x (eval (get-language-info (car x) 'sample-text) t))) ;; Filter out strings which use unencodable characters. (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) (unencodable-char-position diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index b91f7331a8d..63bae79bb40 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -610,7 +610,7 @@ to (xref-elisp-test-descr-to-target xref)." )) (xref-elisp-deftest find-defs-defgeneric-eval - (elisp--xref-find-definitions (eval '(cl-defgeneric stephe-leake-cl-defgeneric ()))) + (elisp--xref-find-definitions (eval '(cl-defgeneric stephe-leake-cl-defgeneric ()) t)) nil) ;; Define some mode-local overloadable/overridden functions for xref to find @@ -712,7 +712,7 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))))) (xref-elisp-deftest find-defs-defun-eval - (elisp--xref-find-definitions (eval '(defun stephe-leake-defun ()))) + (elisp--xref-find-definitions (eval '(defun stephe-leake-defun ()) t)) nil) (xref-elisp-deftest find-defs-defun-c @@ -797,7 +797,7 @@ to (xref-elisp-test-descr-to-target xref)." "DEFVAR_PER_BUFFER (\"default-directory\""))) (xref-elisp-deftest find-defs-defvar-eval - (elisp--xref-find-definitions (eval '(defvar stephe-leake-defvar nil))) + (elisp--xref-find-definitions (eval '(defvar stephe-leake-defvar nil) t)) nil) (xref-elisp-deftest find-defs-face-el @@ -815,7 +815,7 @@ to (xref-elisp-test-descr-to-target xref)." )) (xref-elisp-deftest find-defs-face-eval - (elisp--xref-find-definitions (eval '(defface stephe-leake-defface nil ""))) + (elisp--xref-find-definitions (eval '(defface stephe-leake-defface nil "") t)) nil) (xref-elisp-deftest find-defs-feature-el @@ -830,7 +830,7 @@ to (xref-elisp-test-descr-to-target xref)." )) (xref-elisp-deftest find-defs-feature-eval - (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature))) + (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature) t)) nil) (ert-deftest elisp--preceding-sexp--char-name () diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index ca0ded1ea3d..e02de952f2f 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -611,12 +611,13 @@ indirectly `mapbacktrace'." (ert-deftest subr-tests--dolist--wrong-number-of-args () "Test that `dolist' doesn't accept wrong types or length of SPEC, cf. Bug#25477." - (should-error (eval '(dolist (a))) - :type 'wrong-number-of-arguments) - (should-error (eval '(dolist (a () 'result 'invalid)) t) - :type 'wrong-number-of-arguments) - (should-error (eval '(dolist "foo") t) - :type 'wrong-type-argument)) + (dolist (lb '(nil t)) + (should-error (eval '(dolist (a)) lb) + :type 'wrong-number-of-arguments) + (should-error (eval '(dolist (a () 'result 'invalid)) lb) + :type 'wrong-number-of-arguments) + (should-error (eval '(dolist "foo") lb) + :type 'wrong-type-argument))) (ert-deftest subr-tests-bug22027 () "Test for https://debbugs.gnu.org/22027 ." diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 4f05d99136b..727c98aa5fa 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -86,23 +86,27 @@ Bug#24912." (ert-deftest eval-tests--if-dot-string () "Check that Emacs rejects (if . \"string\")." - (should-error (eval '(if . "abc")) :type 'wrong-type-argument) + (should-error (eval '(if . "abc") nil) :type 'wrong-type-argument) + (should-error (eval '(if . "abc") t) :type 'wrong-type-argument) (let ((if-tail (list '(setcdr if-tail "abc") t))) - (should-error (eval (cons 'if if-tail)))) + (should-error (eval (cons 'if if-tail) nil) :type 'void-variable) + (should-error (eval (cons 'if if-tail) t) :type 'void-variable)) (let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t))) - (should-error (eval (cons 'if if-tail))))) + (should-error (eval (cons 'if if-tail) nil) :type 'void-variable) + (should-error (eval (cons 'if if-tail) t) :type 'void-variable))) (ert-deftest eval-tests--let-with-circular-defs () "Check that Emacs reports an error for (let VARS ...) when VARS is circular." (let ((vars (list 'v))) (setcdr vars vars) (dolist (let-sym '(let let*)) - (should-error (eval (list let-sym vars)))))) + (should-error (eval (list let-sym vars) nil))))) (ert-deftest eval-tests--mutating-cond () "Check that Emacs doesn't crash on a cond clause that mutates during eval." (let ((clauses (list '((progn (setcdr clauses "ouch") nil))))) - (should-error (eval (cons 'cond clauses))))) + (should-error (eval (cons 'cond clauses) nil)) + (should-error (eval (cons 'cond clauses) t)))) (defun eval-tests--exceed-specbind-limit () (defvar eval-tests--var1) @@ -184,7 +188,8 @@ are found on the stack and therefore not garbage collected." Don't handle destructive splicing in backquote expressions (like in Common Lisp). Instead, make sure substitution in backquote expressions works for identifiers starting with period." - (should (equal (let ((.x 'identity)) (eval `(,.x 'ok))) 'ok))) + (should (equal (let ((.x 'identity)) (eval `(,.x 'ok) nil)) 'ok)) + (should (equal (let ((.x 'identity)) (eval `(,.x 'ok) t)) 'ok))) (ert-deftest eval-tests/backtrace-in-batch-mode () (let ((emacs (expand-file-name invocation-name invocation-directory))) From 3b68662a8226805c397f2a9dbd427a7ce716273b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 19:54:51 +0800 Subject: [PATCH 171/367] Fix xwidgets with XInput 2 builds * src/xwidget.c (Fmake_xwidget): Refrain from synthesizing a focus event here on XI2 builds. (Fxwidget_perform_lispy_event): Try to set embedder on XI2 builds and do nothing otherwise. (synthesize_focus_in_event): Use focus_change.window as opposed to any.window. (x_draw_xwidget_glyph_string): Synthesize focus event here instead on XI2 builds. --- src/xwidget.c | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index b1bf291a168..1ab953d3c82 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -226,8 +226,9 @@ fails. */) gtk_widget_show (xw->widget_osr); gtk_widget_show (xw->widgetwindow_osr); +#ifndef HAVE_XINPUT2 synthesize_focus_in_event (xw->widgetwindow_osr); - +#endif g_signal_connect (G_OBJECT (gtk_widget_get_window (xw->widgetwindow_osr)), "from-embedder", G_CALLBACK (from_embedder), NULL); @@ -326,6 +327,10 @@ selected frame is not an X-Windows frame. */) GtkContainerClass *klass; GtkWidget *widget; GtkWidget *temp = NULL; +#ifdef HAVE_XINPUT2 + GdkWindow *embedder; + GdkWindow *osw; +#endif #endif CHECK_LIVE_XWIDGET (xwidget); @@ -337,6 +342,16 @@ selected frame is not an X-Windows frame. */) f = SELECTED_FRAME (); #ifdef USE_GTK +#ifdef HAVE_XINPUT2 + /* XI2 GDK devices crash if we try this without an embedder set. */ + if (!f) + return Qnil; + + osw = gtk_widget_get_window (xw->widgetwindow_osr); + embedder = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + + gdk_offscreen_window_set_embedder (osw, embedder); +#endif widget = gtk_window_get_focus (GTK_WINDOW (xw->widgetwindow_osr)); if (!widget) @@ -1012,7 +1027,7 @@ synthesize_focus_in_event (GtkWidget *offscreen_window) wnd = gtk_widget_get_window (offscreen_window); focus_event = gdk_event_new (GDK_FOCUS_CHANGE); - focus_event->any.window = wnd; + focus_event->focus_change.window = wnd; focus_event->focus_change.in = TRUE; if (FRAME_WINDOW_P (SELECTED_FRAME ())) @@ -1781,6 +1796,11 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) } #endif +#ifdef HAVE_XINPUT2 + record_osr_embedder (xv); + synthesize_focus_in_event (xww->widget_osr); +#endif + #ifdef USE_GTK unblock_input (); #endif From 7294a2861d274fe61f61d182d7c74041e738fe75 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Nov 2021 20:00:45 +0800 Subject: [PATCH 172/367] Prevent crashes when scrolling in an unknown Window on XI2 * src/xterm.c (handle_one_xevent): Fix XI2 frame lookup to handle foreign windows. --- src/xterm.c | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index a023a5f9c89..18f8a6062f8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9939,7 +9939,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (delta != DBL_MAX) { - f = mouse_or_wdesc_frame (dpyinfo, xev->event); + if (!f) + { + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (!f) + goto XI_OTHER; + } + scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); found_valuator = true; @@ -9952,14 +9959,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, && (fabs (val->emacs_value) < 1)) continue; - if (!f) - { - f = x_any_window_to_frame (dpyinfo, xev->event); - - if (!f) - goto XI_OTHER; - } - bool s = signbit (val->emacs_value); inev.ie.kind = (val->horizontal ? HORIZ_WHEEL_EVENT From 14cd6ec8d269415ad4c342580c53528ab1bb17b2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Nov 2021 13:12:38 +0100 Subject: [PATCH 173/367] Make string-animate smoother * lisp/play/animate.el (animate-total-added-delay): New defcustom. (animate-n-steps): Double the default value. Use :type 'natnum'. (animate-string): Make the delay depend on the above new defcustom divided by the number of steps. --- lisp/play/animate.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/play/animate.el b/lisp/play/animate.el index 7eb1b277179..f3c77b31a5d 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -93,9 +93,17 @@ (unless (eolp) (delete-char 1)) (insert-char char 1)) -(defcustom animate-n-steps 10 +(defcustom animate-n-steps 20 "Number of steps `animate-string' will place a char before its last position." - :type 'integer) + :type 'natnum + :version "29.1") + +(defcustom animate-total-added-delay 0.5 + "Total number of seconds to wait in between steps. +This is added to the total time it takes to run `animate-string' +to ensure that the animation is not too fast to be seen." + :type 'float + :version "29.1") (defvar animation-buffer-name nil "String naming the default buffer for animations. @@ -130,7 +138,7 @@ in the current window." ;; Make sure buffer is displayed starting at the beginning. (set-window-start nil 1) ;; Display it, and wait just a little while. - (sit-for .05) + (sit-for (/ animate-total-added-delay (max animate-n-steps 1))) ;; Now undo the changes we made in the buffer. (setq list-to-undo buffer-undo-list) (while list-to-undo From 560a6c35cb274af6b79f89eddbdbb2fd6c00e2b0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Nov 2021 13:18:17 +0100 Subject: [PATCH 174/367] ; Fix my last commit * lisp/play/animate.el (animate-string): Ensure the delay is always a float. --- lisp/play/animate.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/play/animate.el b/lisp/play/animate.el index f3c77b31a5d..54ee9dc84eb 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -138,7 +138,7 @@ in the current window." ;; Make sure buffer is displayed starting at the beginning. (set-window-start nil 1) ;; Display it, and wait just a little while. - (sit-for (/ animate-total-added-delay (max animate-n-steps 1))) + (sit-for (/ (float animate-total-added-delay) (max animate-n-steps 1))) ;; Now undo the changes we made in the buffer. (setq list-to-undo buffer-undo-list) (while list-to-undo From bfcc59371ba74e53c5ce1ba93bcddf9a9aa64230 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Nov 2021 13:29:33 +0100 Subject: [PATCH 175/367] ; Rearrange normal stage in emba files --- test/infra/gitlab-ci.yml | 2 +- test/infra/test-jobs-generator.sh | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index ebfe9965139..d53133d8acd 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -32,7 +32,7 @@ stages: - generator - trigger # - fast -# - normal + - normal - platform-images - platforms - native-comp-images diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh index 15877dd3e60..67205b383ba 100755 --- a/test/infra/test-jobs-generator.sh +++ b/test/infra/test-jobs-generator.sh @@ -56,9 +56,6 @@ for subdir in $SUBDIRS; do include: - local: '/test/infra/default-gitlab-ci.yml' -stages: - - normal - EOF cat < Date: Sat, 20 Nov 2021 21:30:08 +0800 Subject: [PATCH 176/367] Add support for the Haiku operating system and its window system * .gitignore: Add binaries specific to Haiku. * Makefie.in (HAVE_BE_APP): New variable. (install-arch-dep): Install Emacs and Emacs.pdmp when using Haiku. * configure.ac: Detect and configure for Haiku and various related configurations. (be-app, be-freetype, be-cairo): New options. (HAVE_BE_APP, HAIKU_OBJ, HAIKU_CXX_OBJ) (HAIKU_LIBS, HAIKU_CFLAGS): New variables. (HAIKU, HAVE_TINY_SPEED_T): New define. (emacs_config_features): Add BE_APP. * doc/emacs/Makefile.in (EMACSSOURCES): Add Haiku appendix. * doc/emacs/emacs.texi: Add Haiku appendix to menus and include it. * doc/emacs/haiku.texi: New Haiku appendix. * doc/lispref/display.texi (Defining Faces, Window Systems): Explain meaning of `haiku' as a window system identifier. (haiku-use-system-tooltips): Explain meaning of system tooltips on Haiku. * doc/lispref/frames.texi (Multiple Terminals): Explain meaning of haiku as a display type. (Frame Layout): Clarify section for Haiku frames. (Size Parameters): Explain limitations of fullwidth and fullheight on Haiku. (Management Parameters): Explain limitations of inhibiting double buffering on builds with Cairo, and the inability of frames with no-accept-focus to receive keyboard input on Haiku. (Font and Color Parameters): Explain the different font backends available on Haiku. (Raising and Lowering): Explain that lowering and restacking frames doesn't work on Haiku. (Child Frames): Explain oddities of child frame visibility on Haiku. * doc/lispref/os.texi (System Environment): Explain meaning of haiku. * etc/MACHINES: Add appropriate notices for Haiku. * etc/NEWS: Document changes. * etc/PROBLEMS: Document font spacing bug on Haiku. * lib-src/Makefile.in: Build be-resources binary on Haiku. (CXX, CXXFLAGS, NON_CXX_FLAGS, ALL_CXXFLAGS) (HAVE_BE_APP, HAIKU_LIBS, HAIKU_CFLAGS): New variables. (DONT_INSTALL): Add be-resources binary if on Haiku. (be-resources): New target. * lib-src/be_resources: Add helper binary for setting resources on the Emacs application. * lib-src/emacsclient.c (decode_options): Set alt_display to "be" on Haiku. * lisp/cus-edit.el (custom-button, custom-button-mouse) (custom-button-unraised, custom-button-pressed): Update face definitions for Haiku. * lisp/cus-start.el: Add haiku-debug-on-fatal-error and haiku-use-system-tooltips. * lisp/faces.el (face-valid-attribute-values): Clarify attribute comment for Haiku. (tool-bar): Add appropriate toolbar color for Haiku. * lisp/frame.el (haiku-frame-geometry) (haiku-mouse-absolute-pixel-position) (haiku-set-mouse-absolute-pixel-position) (haiku-frame-edges) (haiku-frame-list-z-order): New function declarations. (frame-geometry, frame-edges) (mouse-absolute-pixel-position) (set-mouse-absolute-pixel-position) (frame-list-z-order): Call appropriate window system functions on Haiku. (display-mouse-p, display-graphic-p) (display-images-p, display-pixel-height) (display-pixel-width, display-mm-height) (display-mm-width, display-backing-store) (display-save-under, display-planes) (display-color-cells, display-visual-class): Update type tests for Haiku. * lisp/international/mule-cmds.el (set-coding-system-map): Also prevent set-terminal-coding-system from appearing in the menu bar on Haiku. * lisp/loadup.el: Load Haiku-specific files when built with Haiku, and don't rename newly built Emacs on Haiku as BFS doesn't support hard links. * lisp/menu-bar.el (menu-bar-open): Add for Haiku. * lisp/mwheel.el (mouse-wheel-down-event): Expect wheel-up on Haiku. (mouse-wheel-up-event): Expect wheel-down on Haiku. (mouse-wheel-left-event): Expect wheel-left on Haiku. (mouse-wheel-right-event): Expect wheel-right on Haiku. * lisp/net/browse-url.el (browse-url--browser-defcustom-type): Add option for WebPositive. (browse-url-webpositive-program): New variable. (browse-url-default-program): Search for WebPositive. (browse-url-webpositive): New function. * lisp/net/eww.el (eww-form-submit, eww-form-file) (eww-form-checkbox, eww-form-select): Define faces appropriately for Haiku. * lisp/term/haiku-win.el: New file. * lisp/tooltip.el (menu-or-popup-active-p): New function declaration. (tooltip-show-help): Don't use tooltips on Haiku when a menu is active. * lisp/version.el (haiku-get-version-string): New function declaration. (emacs-version): Add Haiku version string if appropriate. * src/Makefile.in: Also produce binary named "Emacs" with Haiku resources set. (CXX, HAIKU_OBJ, HAIKU_CXX_OBJ, HAIKU_LIBS) (HAIKU_CFLAGS, HAVE_BE_APP, NON_CXX_FLAGS) (ALL_CXX_FLAGS): New variables. (.SUFFIXES): Add .cc. (.cc.o): New target. (base_obj): Add Haiku C objects. (doc_obj, obj): Split objects that should scanned for documentation into doc_obj. (SOME_MACHINE_OBJECTS): Add appropriate Haiku C objects. (all): Depend on Emacs and Emacs.pdmp on Haiku. (LIBES): Add Haiku libraries. (gl-stamp) ($(etc)/DOC): Scan doc_obj instead of obj (temacs$(EXEEXT): Use C++ linker on Haiku. (ctagsfiles3): New variable. (TAGS): Scan C++ files. * src/alloc.c (garbage_collect): Mark Haiku display. * src/dispextern.h (HAVE_NATIVE_TRANSFORMS): Also enable on Haiku. (struct image): Add fields for Haiku transforms. (RGB_PIXEL_COLOR): Define to unsigned long on Haiku as well. (sit_for): Also check USABLE_SIGPOLL. (init_display_interactive): Set initial window system to Haiku on Haiku builds. * src/emacs.c (main): Define Haiku syms and init haiku clipboard. (shut_down_emacs): Quit BApplication on Haiku and trigger debug on aborts if haiku_debug_on_fatal_error. (Vsystem_type): Update docstring. * src/fileio.c (next-read-file-uses-dialog-p): Enable on Haiku. * src/filelock.c (WTMP_FILE): Only define if BOOT_TIME is also defined. * src/floatfns.c (double_integer_scale): Work around Haiku libroot brain damage. * src/font.c (syms_of_font): Define appropriate font driver symbols for Haiku builds with various options. * src/font.h: Also enable ftcrfont on Haiku builds with Cairo. (font_data_structures_may_be_ill_formed): Also enable on Haiku builds that have Cairo. * src/frame.c (Fframep): Update doc-string for Haiku builds and return haiku if appropriate. (syms_of_frame): New symbol `haiku'. * src/frame.h (struct frame): Add output data for Haiku. (FRAME_HAIKU_P): New macro. (FRAME_WINDOW_P): Test for Haiku frames as well. * src/ftcrfont.c (RED_FROM_ULONG, GREEN_FROM_ULONG) (BLUE_FROM_ULONG): New macros. (ftcrfont_draw): Add haiku specific code for Haiku builds with Cairo. * src/ftfont.c (ftfont_open): Set face. (ftfont_has_char, ftfont_text_extents): Work around crash. (syms_of_ftfont): New symbol `mono'. * src/ftfont.h (struct font_info): Enable Cairo-specific fields for Cairo builds on Haiku. * src/haiku_draw_support.cc: * src/haiku_font_support.cc: * src/haiku_io.c: * src/haiku_select.cc: * src/haiku_support.cc: * src/haiku_support.h: * src/haikufns.c: * src/haikufont.c: * src/haikugui.h: * src/haikuimage.c: * src/haikumenu.c: * src/haikuselect.c: * src/haikuselect.h: * src/haikuterm.c: * src/haikuterm.h: Add new files for Haiku windowing support. * src/haiku.c: Add new files for Haiku operating system support. * src/image.c: Implement image transforms and native XPM support on Haiku. (GET_PIXEL, PUT_PIXEL, NO_PIXMAP) (PIX_MASK_RETAIN, PIX_MASK_DRAW) (RGB_TO_ULONG, RED_FROM_ULONG, GREEN_FROM_ULONG) (BLUE_FROM_ULONG, RED16_FROM_ULONG, GREEN16_FROM_ULONG) (BLUE16_FROM_ULONG): Define to appropriate values on Haiku. (image_create_bitmap_from_data): Add Haiku support. (image_create_bitmap_from_file): Add TODO on Haiku. (free_bitmap_record): Free bitmap on Haiku. (image_size_in_bytes): Implement for Haiku bitmaps. (image_set_transform): Implement on Haiku. (image_create_x_image_and_pixmap_1): Implement on Haiku, 24-bit or 1-bit only. (image_destroy_x_image, image_get_x_image): Use correct img and pixmap values on Haiku. (lookup_rgb_color): Use correct macro on Haiku. (image_to_emacs_colors): Implement on Haiku. (image_disable_image): Disable on Haiku. (image_can_use_native_api): Test for translator presence on Haiku. (native_image_load): Use translator on Haiku. (imagemagick_load_image): Add Haiku-specific quirks. (Fimage_transforms_p): Allow rotate90 on Haiku. (image_types): Enable native XPM support on Haiku. (syms_of_image): Enable XPM images on Haiku. * src/keyboard.c (kbd_buffer_get_event) (handle_async_input, handle_input_available_signal) (handle_user_signal, Fset_input_interrupt_mode) (init_keyboard): Check for USABLE_SIGPOLL along with USABLE_SIGIO. * src/lisp.h (pD): Work around broken Haiku headers. (HAVE_EXT_MENU_BAR): Define on Haiku. (handle_input_available_signal): Enable if we just have SIGPOLL as well. * src/menu.c (have_boxes): Return true on Haiku. (single_menu_item): Enable toolkit menus on Haiku. (find_and_call_menu_selection): Also enable on Haiku. * src/process.c (keyboard_bit_set): Enable with only usable SIGPOLL. (wait_reading_process_output): Test for SIGPOLL as well as SIGIO availability. * src/sound.c (sound_perror, vox_open) (vox_configure, vox_close): Enable for usable SIGPOLL as well. * src/sysdep.c (sys_subshell): Enable for usable SIGPOLL. (reset_sigio): Make conditional on F_SETOWN. (request_sigio, unrequest_sigio) (emacs_sigaction_init): Also handle SIGPOLLs. (init_sys_modes): Disable TCXONC usage on Haiku, as it doesn't have any ttys other than pseudo ttys, which don't support C-s/C-q flow control, and causes compiler warnings. (speeds): Disable high speeds if HAVE_TINY_SPEED_T. * src/termhooks.h (enum output_method): Add output_haiku. (struct terminal): Add Haiku display info. (TERMINAL_FONT_CACHE): Enable for Haiku. * src/terminal.c (Fterminal_live_p): Return `haiku' if appropriate. * src/verbose.mk.in (AM_V_CXX, AM_V_CXXLD): New logging variables. * src/xdisp.c (redisplay_internal) (note_mouse_highlight): Return on Haiku if a popup is activated. (display_menu_bar): Return on Haiku if frame is a Haiku frame. * src/xfaces.c (GCGraphicsExposures): Enable correctly on Haiku. (x_create_gc): Enable dummy GC code on Haiku. * src/xfns.c (x-server-version, x-file-dialog): Add Haiku specifics to doc strings. * src/xterm.c (syms_of_xterm): Add Haiku information to doc string. --- .gitignore | 2 + Makefile.in | 8 + configure.ac | 222 +- doc/emacs/Makefile.in | 1 + doc/emacs/emacs.texi | 7 + doc/emacs/haiku.texi | 136 ++ doc/lispref/display.texi | 8 +- doc/lispref/frames.texi | 44 +- doc/lispref/os.texi | 3 + etc/MACHINES | 28 + etc/NEWS | 21 + etc/PROBLEMS | 16 + lib-src/Makefile.in | 21 + lib-src/be_resources.cc | 144 ++ lib-src/emacsclient.c | 2 + lisp/cus-edit.el | 6 +- lisp/cus-start.el | 8 +- lisp/faces.el | 4 +- lisp/frame.el | 45 +- lisp/international/mule-cmds.el | 2 +- lisp/loadup.el | 6 + lisp/menu-bar.el | 9 +- lisp/mwheel.el | 12 +- lisp/net/browse-url.el | 20 + lisp/net/eww.el | 8 +- lisp/term/haiku-win.el | 134 ++ lisp/tooltip.el | 7 +- lisp/version.el | 4 + src/Makefile.in | 64 +- src/alloc.c | 4 + src/dispextern.h | 20 +- src/dispnew.c | 11 +- src/emacs.c | 28 + src/fileio.c | 2 +- src/filelock.c | 2 +- src/floatfns.c | 15 + src/font.c | 3 + src/font.h | 4 +- src/frame.c | 4 + src/frame.h | 9 + src/ftcrfont.c | 56 +- src/ftfont.c | 4 + src/ftfont.h | 6 +- src/haiku.c | 286 +++ src/haiku_draw_support.cc | 488 +++++ src/haiku_font_support.cc | 596 +++++ src/haiku_io.c | 207 ++ src/haiku_select.cc | 155 ++ src/haiku_support.cc | 2930 +++++++++++++++++++++++++ src/haiku_support.h | 869 ++++++++ src/haikufns.c | 2448 +++++++++++++++++++++ src/haikufont.c | 1072 +++++++++ src/haikugui.h | 106 + src/haikuimage.c | 109 + src/haikumenu.c | 656 ++++++ src/haikuselect.c | 134 ++ src/haikuselect.h | 64 + src/haikuterm.c | 3608 +++++++++++++++++++++++++++++++ src/haikuterm.h | 293 +++ src/image.c | 142 +- src/keyboard.c | 21 +- src/lisp.h | 14 +- src/menu.c | 12 +- src/process.c | 10 +- src/sound.c | 24 +- src/sysdep.c | 34 +- src/termhooks.h | 8 +- src/terminal.c | 2 + src/verbose.mk.in | 4 + src/xdisp.c | 15 + src/xfaces.c | 8 +- src/xfns.c | 5 +- src/xterm.c | 2 +- 73 files changed, 15344 insertions(+), 138 deletions(-) create mode 100644 doc/emacs/haiku.texi create mode 100644 lib-src/be_resources.cc create mode 100644 lisp/term/haiku-win.el create mode 100644 src/haiku.c create mode 100644 src/haiku_draw_support.cc create mode 100644 src/haiku_font_support.cc create mode 100644 src/haiku_io.c create mode 100644 src/haiku_select.cc create mode 100644 src/haiku_support.cc create mode 100644 src/haiku_support.h create mode 100644 src/haikufns.c create mode 100644 src/haikufont.c create mode 100644 src/haikugui.h create mode 100644 src/haikuimage.c create mode 100644 src/haikumenu.c create mode 100644 src/haikuselect.c create mode 100644 src/haikuselect.h create mode 100644 src/haikuterm.c create mode 100644 src/haikuterm.h diff --git a/.gitignore b/.gitignore index ea1662c9b8c..f1abb2ab687 100644 --- a/.gitignore +++ b/.gitignore @@ -182,6 +182,7 @@ ID # Executables. *.exe a.out +lib-src/be-resources lib-src/blessmail lib-src/ctags lib-src/ebrowse @@ -203,6 +204,7 @@ nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist src/bootstrap-emacs src/emacs src/emacs-[0-9]* +src/Emacs src/temacs src/dmpstruct.h src/*.pdmp diff --git a/Makefile.in b/Makefile.in index ccb5d93f2f0..3c092fa63df 100644 --- a/Makefile.in +++ b/Makefile.in @@ -102,6 +102,8 @@ HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ USE_STARTUP_NOTIFICATION = @USE_STARTUP_NOTIFICATION@ +HAVE_BE_APP = @HAVE_BE_APP@ + # ==================== Where To Install Things ==================== # Location to install Emacs.app under GNUstep / macOS. @@ -521,7 +523,13 @@ install-arch-dep: src install-arch-indep install-etcdoc install-$(NTDIR) $(MAKE) -C lib-src install ifeq (${ns_self_contained},no) ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} "$(DESTDIR)${bindir}/$(EMACSFULL)" +ifeq (${HAVE_BE_APP},yes) + ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/Emacs "$(DESTDIR)${prefix}/apps/Emacs" +endif ifeq (${DUMPING},pdumper) +ifeq (${HAVE_BE_APP},yes) + ${INSTALL_DATA} src/Emacs.pdmp "$(DESTDIR)${libexecdir}/emacs/${version}/${configuration}"/Emacs.pdmp +endif ${INSTALL_DATA} src/emacs.pdmp "$(DESTDIR)${libexecdir}/emacs/${version}/${configuration}"/emacs-${EMACS_PDMP} endif -chmod 755 "$(DESTDIR)${bindir}/$(EMACSFULL)" diff --git a/configure.ac b/configure.ac index 82661c975e0..90a487f7ac7 100644 --- a/configure.ac +++ b/configure.ac @@ -511,6 +511,12 @@ otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.]) OPTION_DEFAULT_OFF([xwidgets], [enable use of xwidgets in Emacs buffers (requires gtk3 or macOS Cocoa)]) +OPTION_DEFAULT_OFF([be-app], + [enable use of Haiku's Application Kit as a window system]) + +OPTION_DEFAULT_OFF([be-cairo], + [enable use of cairo under Haiku's Application Kit]) + ## Makefile.in needs the cache file name. AC_SUBST(cache_file) @@ -787,6 +793,10 @@ case "${canonical}" in LDFLAGS="-N2M $LDFLAGS" ;; + *-haiku ) + opsys=haiku + ;; + ## Intel 386 machines where we don't care about the manufacturer. i[3456]86-*-* ) case "${canonical}" in @@ -908,7 +918,9 @@ if test "$ac_test_CFLAGS" != set; then if test $emacs_cv_prog_cc_g3 != yes; then CFLAGS=$emacs_save_CFLAGS fi - if test $opsys = mingw32; then + # Haiku also needs -gdwarf-2 because its GDB is too old + # to understand newer formats. + if test $opsys = mingw32 || test $opsys = haiku; then CFLAGS="$CFLAGS -gdwarf-2" fi fi @@ -1575,6 +1587,8 @@ case "$opsys" in ## Motif needs -lgen. unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; + + haiku) LIBS_SYSTEM="-lnetwork" ;; esac AC_SUBST(LIBS_SYSTEM) @@ -2080,6 +2094,22 @@ if test "${HAVE_NS}" = yes; then fi fi +HAVE_BE_APP=no +if test "${opsys}" = "haiku" && test "${with_be_app}" = "yes"; then + dnl Only GCC is supported. Clang might work, but it's + dnl not reliable, so don't check for it here. + AC_PROG_CXX([gcc g++]) + CXXFLAGS="$CXXFLAGS $emacs_g3_CFLAGS" + AC_LANG_PUSH([C++]) + AC_CHECK_HEADER([app/Application.h], [HAVE_BE_APP=yes], + [AC_MSG_ERROR([The Application Kit headers required for building +with the Application Kit were not found or cannot be compiled. Either fix this, or +re-configure with the option '--without-be-app'.])]) + AC_LANG_POP([C++]) +fi + +AC_SUBST(HAVE_BE_APP) + HAVE_W32=no W32_OBJ= W32_LIBS= @@ -2201,6 +2231,39 @@ if test "${HAVE_W32}" = "yes"; then with_xft=no fi +HAIKU_OBJ= +HAIKU_CXX_OBJ= +HAIKU_LIBS= +HAIKU_CFLAGS= + +if test "$opsys" = "haiku"; then + HAIKU_OBJ="$HAIKU_OBJ haiku.o" +fi + +if test "${HAVE_BE_APP}" = "yes"; then + AC_DEFINE([HAVE_HAIKU], 1, + [Define if Emacs will be built with Haiku windowing support]) +fi + +if test "${HAVE_BE_APP}" = "yes"; then + window_system=haiku + with_xft=no + HAIKU_OBJ="$HAIKU_OBJ haikufns.o haikuterm.o haikumenu.o haikufont.o haikuselect.o haiku_io.o" + HAIKU_CXX_OBJ="haiku_support.o haiku_font_support.o haiku_draw_support.o haiku_select.o" + HAIKU_LIBS="-lbe -lgame -ltranslation -ltracker" # -lgame is needed for set_mouse_position. + + if test "${with_native_image_api}" = yes; then + AC_DEFINE(HAVE_NATIVE_IMAGE_API, 1, [Define to use native OS APIs for images.]) + NATIVE_IMAGE_API="yes (haiku)" + HAIKU_OBJ="$HAIKU_OBJ haikuimage.o" + fi +fi + +AC_SUBST(HAIKU_LIBS) +AC_SUBST(HAIKU_OBJ) +AC_SUBST(HAIKU_CXX_OBJ) +AC_SUBST(HAIKU_CFLAGS) + ## $window_system is now set to the window system we will ## ultimately use. @@ -2240,6 +2303,9 @@ dnl use the toolkit if we have gtk, or X11R5 or newer. w32 ) term_header=w32term.h ;; + haiku ) + term_header=haikuterm.h + ;; esac if test "$window_system" = none && test "X$with_x" != "Xno"; then @@ -2571,7 +2637,8 @@ fi ### Use -lrsvg-2 if available, unless '--with-rsvg=no' is specified. HAVE_RSVG=no -if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${opsys}" = "mingw32"; then +if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" \ + || test "${opsys}" = "mingw32" || test "${HAVE_BE_APP}" = "yes"; then if test "${with_rsvg}" != "no"; then RSVG_REQUIRED=2.14.0 RSVG_MODULE="librsvg-2.0 >= $RSVG_REQUIRED" @@ -2595,7 +2662,8 @@ fi HAVE_WEBP=no if test "${with_webp}" != "no"; then if test "${HAVE_X11}" = "yes" || test "${opsys}" = "mingw32" \ - || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes"; then + || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes" \ + || test "${HAVE_BE_APP}" = "yes"; then WEBP_REQUIRED=0.6.0 WEBP_MODULE="libwebp >= $WEBP_REQUIRED" @@ -2614,7 +2682,8 @@ if test "${with_webp}" != "no"; then fi HAVE_IMAGEMAGICK=no -if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" = "yes"; then +if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" = "yes" || \ + test "${HAVE_BE_APP}" = "yes"; then if test "${with_imagemagick}" != "no"; then if test -n "$BREW"; then # Homebrew doesn't link ImageMagick 6 by default, so make sure @@ -3264,6 +3333,9 @@ if test "${with_toolkit_scroll_bars}" != "no"; then elif test "${HAVE_W32}" = "yes"; then AC_DEFINE(USE_TOOLKIT_SCROLL_BARS) USE_TOOLKIT_SCROLL_BARS=yes + elif test "${HAVE_BE_APP}" = "yes"; then + AC_DEFINE(USE_TOOLKIT_SCROLL_BARS) + USE_TOOLKIT_SCROLL_BARS=yes fi fi @@ -3353,6 +3425,22 @@ if test "${HAVE_X11}" = "yes"; then fi fi fi +if test "${HAVE_BE_APP}" = "yes"; then + if test "${with_be_cairo}" != "no"; then + CAIRO_REQUIRED=1.8.0 + CAIRO_MODULE="cairo >= $CAIRO_REQUIRED" + EMACS_CHECK_MODULES(CAIRO, $CAIRO_MODULE) + if test $HAVE_CAIRO = yes; then + AC_DEFINE(USE_BE_CAIRO, 1, [Define to 1 if using cairo on Haiku.]) + CFLAGS="$CFLAGS $CAIRO_CFLAGS" + LIBS="$LIBS $CAIRO_LIBS" + AC_SUBST(CAIRO_CFLAGS) + AC_SUBST(CAIRO_LIBS) + else + AC_MSG_WARN([cairo requested but not found.]) + fi + fi +fi ### Start of font-backend (under any platform) section. # (nothing here yet -- this is a placeholder) @@ -3502,6 +3590,58 @@ if test "${HAVE_X11}" = "yes" && test "${HAVE_FREETYPE}" = "yes" \ fi fi +### Start of font-backend (under Haiku) selectionn. +if test "${HAVE_BE_APP}" = "yes"; then + if test $HAVE_CAIRO = "yes"; then + EMACS_CHECK_MODULES([FREETYPE], [freetype2 >= 2.5.0]) + test "$HAVE_FREETYPE" = "no" && AC_MSG_ERROR(cairo on Haiku requires libfreetype) + EMACS_CHECK_MODULES([FONTCONFIG], [fontconfig >= 2.2.0]) + test "$HAVE_FONTCONFIG" = "no" && AC_MSG_ERROR(cairo on Haiku requires libfontconfig) + fi + + HAVE_LIBOTF=no + + if test "${HAVE_FREETYPE}" = "yes"; then + AC_DEFINE(HAVE_FREETYPE, 1, + [Define to 1 if using the freetype and fontconfig libraries.]) + OLD_CFLAGS=$CFLAGS + OLD_LIBS=$LIBS + CFLAGS="$CFLAGS $FREETYPE_CFLAGS" + LIBS="$FREETYPE_LIBS $LIBS" + AC_CHECK_FUNCS(FT_Face_GetCharVariantIndex) + CFLAGS=$OLD_CFLAGS + LIBS=$OLD_LIBS + if test "${with_libotf}" != "no"; then + EMACS_CHECK_MODULES([LIBOTF], [libotf]) + if test "$HAVE_LIBOTF" = "yes"; then + AC_DEFINE(HAVE_LIBOTF, 1, [Define to 1 if using libotf.]) + AC_CHECK_LIB(otf, OTF_get_variation_glyphs, + HAVE_OTF_GET_VARIATION_GLYPHS=yes, + HAVE_OTF_GET_VARIATION_GLYPHS=no) + if test "${HAVE_OTF_GET_VARIATION_GLYPHS}" = "yes"; then + AC_DEFINE(HAVE_OTF_GET_VARIATION_GLYPHS, 1, + [Define to 1 if libotf has OTF_get_variation_glyphs.]) + fi + if ! $PKG_CONFIG --atleast-version=0.9.16 libotf; then + AC_DEFINE(HAVE_OTF_KANNADA_BUG, 1, +[Define to 1 if libotf is affected by https://debbugs.gnu.org/28110.]) + fi + fi + fi + dnl FIXME should there be an error if HAVE_FREETYPE != yes? + dnl Does the new font backend require it, or can it work without it? + fi +fi + +if test "${HAVE_BE_APP}" = "yes" && test "${HAVE_FREETYPE}" = "yes"; then + if test "${with_harfbuzz}" != "no"; then + EMACS_CHECK_MODULES([HARFBUZZ], [harfbuzz >= $harfbuzz_required_ver]) + if test "$HAVE_HARFBUZZ" = "yes"; then + AC_DEFINE(HAVE_HARFBUZZ, 1, [Define to 1 if using HarfBuzz.]) + fi + fi +fi + ### End of font-backend section. AC_SUBST(FREETYPE_CFLAGS) @@ -3623,7 +3763,7 @@ AC_SUBST(LIBXPM) HAVE_JPEG=no LIBJPEG= if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \ - || test "${HAVE_NS}" = "yes"; then + || test "${HAVE_NS}" = "yes" || test "${HAVE_BE_APP}" = "yes"; then if test "${with_jpeg}" != "no"; then AC_CACHE_CHECK([for jpeglib 6b or later], [emacs_cv_jpeglib], @@ -3941,7 +4081,7 @@ if test "${with_png}" != no; then if test "$opsys" = mingw32; then AC_CHECK_HEADER([png.h], [HAVE_PNG=yes]) elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \ - || test "${HAVE_NS}" = "yes"; then + || test "${HAVE_NS}" = "yes" || test "${HAVE_BE_APP}" = "yes"; then EMACS_CHECK_MODULES([PNG], [libpng >= 1.0.0]) if test $HAVE_PNG = yes; then LIBPNG=$PNG_LIBS @@ -4016,7 +4156,7 @@ if test "${opsys}" = "mingw32"; then AC_DEFINE(HAVE_TIFF, 1, [Define to 1 if you have the tiff library (-ltiff).]) fi elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \ - || test "${HAVE_NS}" = "yes"; then + || test "${HAVE_NS}" = "yes" || test "${HAVE_BE_APP}" = "yes"; then if test "${with_tiff}" != "no"; then AC_CHECK_HEADER(tiffio.h, [tifflibs="-lz -lm" @@ -4045,7 +4185,8 @@ if test "${opsys}" = "mingw32"; then AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have a gif (or ungif) library.]) fi elif test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \ - || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes"; then + || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes" \ + || test "${HAVE_BE_APP}" = "yes"; then AC_CHECK_HEADER(gif_lib.h, # EGifPutExtensionLast only exists from version libungif-4.1.0b1. # Earlier versions can crash Emacs, but version 5.0 removes EGifPutExtensionLast. @@ -4482,6 +4623,13 @@ case $with_unexec,$canonical in [AC_MSG_ERROR([Non-ELF systems are not supported on this platform.])]);; esac +if test "$with_unexec" = yes && test "$opsys" = "haiku"; then + dnl A serious attempt was actually made to port unexec to Haiku. + dnl Something in libstdc++ seems to prevent it from working. + AC_MSG_ERROR([Haiku is not supported by the legacy unexec dumper. +Please use the portable dumper instead.]) +fi + # Dump loading AC_CHECK_FUNCS([posix_madvise]) @@ -4835,7 +4983,7 @@ CFLAGS="$OLDCFLAGS" LIBS="$OLDLIBS"]) if test "${emacs_cv_links_glib}" = "yes"; then AC_DEFINE(HAVE_GLIB, 1, [Define to 1 if GLib is linked in.]) - if test "$HAVE_NS" = no;then + if test "$HAVE_NS" = no ; then XGSELOBJ=xgselect.o fi fi @@ -5090,7 +5238,7 @@ dnl It would have Emacs fork off a separate process dnl to read the input and send it to the true Emacs process dnl through a pipe. case $opsys in - darwin | gnu-linux | gnu-kfreebsd ) + darwin | gnu-linux | gnu-kfreebsd) AC_DEFINE(INTERRUPT_INPUT, 1, [Define to read input using SIGIO.]) ;; esac @@ -5186,6 +5334,14 @@ case $opsys in AC_DEFINE(PTY_OPEN, [fd = open (pty_name, O_RDWR | O_NONBLOCK)]) AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) ;; + + haiku*) + AC_DEFINE(FIRST_PTY_LETTER, ['s']) + AC_DEFINE(PTY_NAME_SPRINTF, []) + dnl on Haiku pty names aren't distinctive, thus the use of posix_openpt + AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_NONBLOCK)]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) + ;; esac @@ -5407,8 +5563,25 @@ case $opsys in AC_DEFINE(USG, []) AC_DEFINE(USG5_4, []) ;; + + haiku) + AC_DEFINE(HAIKU, [], [Define if the system is Haiku.]) + ;; esac +AC_SYS_POSIX_TERMIOS +if test $ac_cv_sys_posix_termios = yes; then + AC_CHECK_SIZEOF([speed_t], [], [#include ]) + dnl on Haiku, and possibly other platforms, speed_t is defined to + dnl unsigned char, even when speeds greater than 200 baud are + dnl defined. + + if test ${ac_cv_sizeof_speed_t} -lt 2; then + AC_DEFINE([HAVE_TINY_SPEED_T], [1], + [Define to 1 if speed_t has some sort of nonsensically tiny size.]) + fi +fi + AC_CACHE_CHECK([for usable FIONREAD], [emacs_cv_usable_FIONREAD], [case $opsys in aix4-2 | nacl) @@ -5451,6 +5624,22 @@ if test $emacs_cv_usable_FIONREAD = yes; then AC_DEFINE([USABLE_SIGIO], [1], [Define to 1 if SIGIO is usable.]) fi fi + + if test $emacs_broken_SIGIO = no && test $emacs_cv_usable_SIGIO = no; then + AC_CACHE_CHECK([for usable SIGPOLL], [emacs_cv_usable_SIGPOLL], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[#include + #include + ]], + [[int foo = SIGPOLL | F_SETFL;]])], + [emacs_cv_usable_SIGPOLL=yes], + [emacs_cv_usable_SIGPOLL=no])], + [emacs_cv_usable_SIGPOLL=yes], + [emacs_cv_usable_SIGPOLL=no]) + if test $emacs_cv_usable_SIGPOLL = yes; then + AC_DEFINE([USABLE_SIGPOLL], [1], [Define to 1 if SIGPOLL is usable but SIGIO is not.]) + fi + fi fi case $opsys in @@ -5563,6 +5752,17 @@ if test "${HAVE_X_WINDOWS}" = "yes" ; then FONT_OBJ="$FONT_OBJ ftfont.o" fi fi + +if test "${HAVE_BE_APP}" = "yes" ; then + if test "${HAVE_FREETYPE}" = "yes" || \ + test "${HAVE_CAIRO}" = "yes"; then + FONT_OBJ="$FONT_OBJ ftfont.o" + fi + if test "${HAVE_CAIRO}" = "yes"; then + FONT_OBJ="$FONT_OBJ ftcrfont.o" + fi +fi + if test "${HAVE_HARFBUZZ}" = "yes" ; then FONT_OBJ="$FONT_OBJ hbfont.o" fi @@ -5951,7 +6151,7 @@ Configured for '${canonical}'. #### Please respect alphabetical ordering when making additions. optsep= emacs_config_features= -for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ +for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \ SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \ diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in index 69d39efa8b9..dde3ae83c16 100644 --- a/doc/emacs/Makefile.in +++ b/doc/emacs/Makefile.in @@ -140,6 +140,7 @@ EMACSSOURCES= \ ${srcdir}/xresources.texi \ ${srcdir}/anti.texi \ ${srcdir}/macos.texi \ + $(srcdir)/haiku.texi \ ${srcdir}/msdos.texi \ ${srcdir}/gnu.texi \ ${srcdir}/glossary.texi \ diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 83847fb8f12..ce92435ae70 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -221,6 +221,7 @@ Appendices * X Resources:: X resources for customizing Emacs. * Antinews:: Information about Emacs version 27. * Mac OS / GNUstep:: Using Emacs under macOS and GNUstep. +* Haiku:: Using Emacs on Haiku. * Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS. * Manifesto:: What's GNU? Gnu's Not Unix! @@ -1249,6 +1250,11 @@ Emacs and macOS / GNUstep * Mac / GNUstep Events:: How window system events are handled. * GNUstep Support:: Details on status of GNUstep support. +Emacs and Haiku + +* Haiku Basics:: Basic Emacs usage and installation under Haiku. +* Haiku Fonts:: The various options for displaying fonts on Haiku. + Emacs and Microsoft Windows/MS-DOS * Windows Startup:: How to start Emacs on Windows. @@ -1618,6 +1624,7 @@ Lisp programming. @include anti.texi @include macos.texi +@include haiku.texi @c Includes msdos-xtra. @include msdos.texi @include gnu.texi diff --git a/doc/emacs/haiku.texi b/doc/emacs/haiku.texi new file mode 100644 index 00000000000..a2dc6e14d0e --- /dev/null +++ b/doc/emacs/haiku.texi @@ -0,0 +1,136 @@ +@c This is part of the Emacs manual. +@c Copyright (C) 2021 Free Software Foundation, Inc. +@c See file emacs.texi for copying conditions. +@node Haiku +@appendix Emacs and Haiku +@cindex Haiku + + Haiku is a Unix-like operating system that originated as a +re-implementation of the operating system BeOS. + + This section describes the peculiarities of using Emacs built with +the Application Kit, the windowing system native to Haiku. The +oddities described here do not apply to using Emacs on Haiku built +without windowing support, or built with X11. + +@menu +* Haiku Basics:: Basic Emacs usage and installation under Haiku. +* Haiku Fonts:: The various options for displaying fonts on Haiku. +@end menu + +@node Haiku Basics +@section Installation and usage peculiarities under Haiku +@cindex haiku application +@cindex haiku installation + + Emacs installs two separate executables under Haiku; it is up to the +user to decide which one suits him best: A regular executable, with +the lowercase name @code{emacs}, and a binary containing +Haiku-specific application metadata, with the name @code{Emacs}. + +@cindex launching Emacs from the tracker +@cindex tty Emacs in haiku + If you are launching Emacs from the Tracker, or want to make the +Tracker open files using Emacs, you should use the binary named +@code{Emacs}; ff you are going to use Emacs in the terminal, or wish +to launch separate instances of Emacs, or do not care for the +aforementioned system integration features, use the binary named +@code{emacs} instead. + +@cindex modifier keys and system keymap (Haiku) +@cindex haiku keymap + On Haiku, unusual modifier keys such as the Hyper key are +unsupported. By default, the super key corresponds with the option +key defined by the operating system, the meta key with the command +key, the control key with the system control key, and the shift key +with the system shift key. On a standard PC keyboard, Haiku should +map these keys to positions familiar to those using a GNU system, but +this may require some adjustment to your system's configuration to +work. + + It is impossible to type accented characters using the system super +key map. + + You can customize the correspondence between modifier keys known to +the system, and those known to Emacs. The variables that allow for +that are described below. + +@cindex modifier key customization (Haiku) +You can customize which Emacs modifiers the various system modifier +keys correspond to through the following variables: + +@table @code +@vindex haiku-meta-keysym +@item haiku-meta-keysym +The system modifier key that will be treated as the Meta key by Emacs. +It defaults to @code{command}. + +@vindex haiku-control-keysym +@item haiku-control-keysym +The system modifier key that will be treated as the Control key by +Emacs. It defaults to @code{control}. + +@vindex haiku-super-keysym +@item haiku-super-keysym +The system modifier key that will be treated as the Super key by +Emacs. It defaults to @code{option}. + +@vindex haiku-shift-keysym +@item haiku-shift-keysym +The system modifier key that will be treated as the Shift key by +Emacs. It defaults to @code{shift}. +@end table + +The value of each variable can be one of the symbols @code{command}, +@code{control}, @code{option}, @code{shift}, or @code{nil}. +@code{nil} or any other value will cause the default value to be used +instead. + +@cindex tooltips (haiku) +@cindex haiku tooltips +@vindex haiku-use-system-tooltips + On Haiku, Emacs defaults to using the system tooltip mechanism. +This usually leads to more responsive tooltips, but the tooltips will +not be able to display text properties or faces. If you need those +features, customize the variable @code{haiku-use-system-tooltips} to +the nil value, and Emacs will use its own implementation of tooltips. + + Both system tooltips and Emacs's own tooltips cannot display above +the menu bar, so help text in the menu bar will display in the echo +area instead. + +@subsection What to do when Emacs crashes +@cindex crashes, Haiku +@cindex haiku debugger +@vindex haiku-debug-on-fatal-error + If the variable @code{haiku-debug-on-fatal-error} is non-nil, Emacs +will launch the system debugger when a fatal signal is received. It +defaults to @code{t}. If GDB cannot be used on your system, please +attach the report generated by the system debugger when reporting a +bug. + +@table @code +@vindex haiku-use-system-debugger +@item haiku-use-system-debugger +When non-nil, Emacs will ask the system to launch the system debugger +whenever it experiences a fatal error. This behaviour is standard +among Haiku applications. +@end table + +@node Haiku Fonts +@section Font and font backend selection on Haiku +@cindex font backend selection (Haiku) + + Emacs, when built with Haiku windowing support, can be built with +several different font backends. You can specify font backends by +specifying @kbd{-xrm Emacs.fontBackend:BACKEND} on the command line +used to invoke Emacs, where @kbd{BACKEND} is one of the backends +specified below, or on a per-frame basis by changing the +@code{font-backend} frame parameter. (@pxref{Parameter Access,,, +elisp, The Emacs Lisp Reference Manual}). + + Two of these backends, @code{ftcr} and @code{ftcrhb} are identical +to their counterparts on the X Window System. There is also a +Haiku-specific backend named @code{haiku}, that uses the App Server to +draw fonts, but does not at present support display of color font and +emoji. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index c093901ea1d..b948aff0242 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2767,8 +2767,9 @@ apply to. Here are the possible values of @var{characteristic}: @item type The kind of window system the terminal uses---either @code{graphic} (any graphics-capable display), @code{x}, @code{pc} (for the MS-DOS -console), @code{w32} (for MS Windows 9X/NT/2K/XP), or @code{tty} (a -non-graphics-capable display). @xref{Window Systems, window-system}. +console), @code{w32} (for MS Windows 9X/NT/2K/XP), @code{haiku} (for +Haiku), or @code{tty} (a non-graphics-capable display). +@xref{Window Systems, window-system}. @item class What kinds of colors the terminal supports---either @code{color}, @@ -8274,6 +8275,8 @@ Emacs is displaying the frame using the Nextstep interface (used on GNUstep and macOS). @item pc Emacs is displaying the frame using MS-DOS direct screen writes. +@item haiku +Emacs is displaying the frame using the Application Kit on Haiku. @item nil Emacs is displaying the frame on a character-based terminal. @end table @@ -8320,6 +8323,7 @@ area. On text-mode (a.k.a.@: ``TTY'') frames, tooltips are always displayed in the echo area. @end defun +@cindex system tooltips @vindex x-gtk-use-system-tooltips When Emacs is built with GTK+ support, it by default displays tooltips using GTK+ functions, and the appearance of the tooltips is then diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 31ad82b7ada..923ff19997e 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -214,7 +214,8 @@ The terminal and keyboard coding systems used on the terminal. @item The kind of display associated with the terminal. This is the symbol returned by the function @code{terminal-live-p} (i.e., @code{x}, -@code{t}, @code{w32}, @code{ns}, or @code{pc}). @xref{Frames}. +@code{t}, @code{w32}, @code{ns}, @code{pc}, or @code{haiku}). +@xref{Frames}. @item A list of terminal parameters. @xref{Terminal Parameters}. @@ -680,7 +681,7 @@ indicate that position for the various builds: @itemize @w{} @item (1) non-toolkit and terminal frames -@item (2) Lucid, Motif and MS-Windows frames +@item (2) Lucid, Motif, MS-Windows, and Haiku frames @item (3) GTK+ and NS frames @end itemize @@ -1729,7 +1730,9 @@ fit will be clipped by the window manager. @item fullscreen This parameter specifies whether to maximize the frame's width, height or both. Its value can be @code{fullwidth}, @code{fullheight}, -@code{fullboth}, or @code{maximized}. A @dfn{fullwidth} frame is as +@code{fullboth}, or @code{maximized}.@footnote{On Haiku, setting +@code{fullscreen} to @code{fullwidth} or @code{fullheight} has no +effect.} A @dfn{fullwidth} frame is as wide as possible, a @dfn{fullheight} frame is as tall as possible, and a @dfn{fullboth} frame is both as wide and as tall as possible. A @dfn{maximized} frame is like a ``fullboth'' frame, except that it usually @@ -2191,7 +2194,10 @@ either via @code{focus-follows-mouse} (@pxref{Input Focus}) or @code{mouse-autoselect-window} (@pxref{Mouse Window Auto-selection}). This may have the unwanted side-effect that a user cannot scroll a non-selected frame with the mouse. Some window managers may not honor -this parameter. +this parameter. On Haiku, it also has the side-effect that the window +will not be able to receive any keyboard input from the user, not even +if the user switches to the frame using the key combination +@kbd{Alt-@key{TAB}}. @vindex undecorated@r{, a frame parameter} @item undecorated @@ -2352,7 +2358,10 @@ driver for OTF and TTF fonts with text shaping by the Uniscribe engine), and @code{harfbuzz} (font driver for OTF and TTF fonts with HarfBuzz text shaping) (@pxref{Windows Fonts,,, emacs, The GNU Emacs Manual}). The @code{harfbuzz} driver is similarly recommended. On -other systems, there is only one available font backend, so it does +Haiku, there can be several font drivers (@pxref{Haiku Fonts,,, emacs, +The GNU Emacs Manual}). + +On other systems, there is only one available font backend, so it does not make sense to modify this frame parameter. @vindex background-mode@r{, a frame parameter} @@ -3141,8 +3150,10 @@ raises @var{frame} above all other child frames of its parent. @deffn Command lower-frame &optional frame This function lowers frame @var{frame} (default, the selected frame) below all other frames belonging to the same or a higher z-group as -@var{frame}. If @var{frame} is a child frame (@pxref{Child Frames}), -this lowers @var{frame} below all other child frames of its parent. +@var{frame}.@footnote{Lowering frames is not supported on Haiku, due +to limitations imposed by the system.} If @var{frame} is a child +frame (@pxref{Child Frames}), this lowers @var{frame} below all other +child frames of its parent. @end deffn @defun frame-restack frame1 frame2 &optional above @@ -3152,7 +3163,8 @@ that if both frames are visible and their display areas overlap, third argument @var{above} is non-@code{nil}, this function restacks @var{frame1} above @var{frame2}. This means that if both frames are visible and their display areas overlap, @var{frame1} will (partially) -obscure @var{frame2}. +obscure @var{frame2}.@footnote{Restacking frames is not supported on +Haiku, due to limitations imposed by the system.} Technically, this function may be thought of as an atomic action performed in two steps: The first step removes @var{frame1}'s @@ -3247,12 +3259,16 @@ parent frame's window-system window. @cindex reparent frame @cindex nest frame - The @code{parent-frame} parameter can be changed at any time. Setting -it to another frame @dfn{reparents} the child frame. Setting it to -another child frame makes the frame a @dfn{nested} child frame. Setting -it to @code{nil} restores the frame's status as a top-level frame---a -frame whose window-system window is a child of its display's root -window. + The @code{parent-frame} parameter can be changed at any time. +Setting it to another frame @dfn{reparents} the child frame. Setting +it to another child frame makes the frame a @dfn{nested} child frame. +Setting it to @code{nil} restores the frame's status as a top-level +frame---a frame whose window-system window is a child of its display's +root window.@footnote{On Haiku, child frames are only visible when a +parent frame is active, owing to a limitation of the Haiku windowing +system. Owing to the same limitation, child frames are only +guaranteed to appear above their top-level parent; that is to say, the +top-most frame in the hierarchy, which does not have a parent frame.} Since child frames can be arbitrarily nested, a frame can be both a child and a parent frame. Also, the relative roles of child and parent diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 1fbd66458a4..fb0f25fa3d7 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -947,6 +947,9 @@ actually Linux is just the kernel, not the whole system.) @item gnu/kfreebsd A GNU (glibc-based) system with a FreeBSD kernel. +@item haiku +The Haiku operating system, a derivative of the Be Operating System. + @item hpux Hewlett-Packard HPUX operating system. diff --git a/etc/MACHINES b/etc/MACHINES index d8d0b86fb4d..d883f1abd60 100644 --- a/etc/MACHINES +++ b/etc/MACHINES @@ -103,6 +103,34 @@ the list at the end of this file. ./configure CC='gcc -m64' # GCC ./configure CC='cc -m64' # Oracle Developer Studio +** Haiku + + On 32-bit Haiku it is required that the newer GCC 8 be used, instead + of the legacy GCC 2 used by default. This can be achieved by + invoking configure inside a shell launched by the 'setarch' program + invoked as 'setarch x86'. + + When building with packages discovered through pkg-config, such as + libpng, on a GCC 2/GCC 8 hybrid system, simply evaluating 'setarch + x86' is insufficient to ensure that all required libraries are found + at their correct locations. To avoid this problem, set the + environment variable 'PKG_CONFIG_PATH' to the GCC 8 pkg-config + directory at '/system/develop/lib/x86/pkgconfig/' before configuring + Emacs. + + If GCC complains about not being able to resolve symbols such as + "BHandler::LockLooper", you are almost certainly experiencing this + problem. + + Haiku running on non-x86 systems has not been tested. It is + anticipated that Haiku running on big-endian systems will experience + problems when Emacs is built with Haiku windowing support, but there + doesn't seem to be any reliable way to get Haiku running on a + big-endian system at present. + + The earliest release of Haiku that will successfully compile Emacs + is R1/Beta2. For windowing support, R1/Beta3 or later is required. + * Obsolete platforms diff --git a/etc/NEWS b/etc/NEWS index 3cceac55844..bfea4da8b9e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,6 +24,27 @@ applies, and please also update docstrings as needed. * Installation Changes in Emacs 29.1 +** Emacs has been ported to the Haiku operating system. +The configuration process should automatically detect and build for +Haiku. There is also an optional window-system port to Haiku, which +can be enabled by configuring Emacs with the option '--with-be-app', +which will require the Haiku Application Kit development headers and a +C++ compiler to be present on your system. If Emacs is not built with +the option '--with-be-app', the resulting Emacs will only run in +text-mode terminals. + ++++ +*** Cairo drawing support has been enabled for Haiku builds. +To enable Cairo support, ensure that the Cairo and FreeType +development files are present on your system, and configure Emacs with +'--with-be-cairo'. + +--- +*** Double buffering is now enabled on the Haiku operating system. +Unlike X, there is no compile-time option to enable or disable +double-buffering. If you wish to disable double-buffering, change the +frame parameter `inhibit-double-buffering' instead. + ** Emacs now installs the ".pdmp" file using a unique fingerprint in the name. The file is typically installed using a file name akin to "...dir/libexec/emacs/29.1/x86_64-pc-linux-gnu/emacs-.pdmp". diff --git a/etc/PROBLEMS b/etc/PROBLEMS index f506881a4ba..acff3be7da4 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1022,6 +1022,15 @@ modern fonts are used, such as Noto Emoji or Ebrima. The solution is to switch to a configuration that uses HarfBuzz as its shaping engine, where these problems don't exist. +** On Haiku, some proportionally-spaced fonts display with artifacting. + +This is a Haiku bug: https://dev.haiku-os.org/ticket/17229, which can +be remedied by using a different font that does not exhibit this +problem, or by configuring Emacs '--with-be-cairo'. + +So far, Bitstream Charter and Noto Sans have been known to exhibit +this problem, while Noto Sans Display is known to not do so. + * Internationalization problems ** M-{ does not work on a Spanish PC keyboard. @@ -1105,6 +1114,13 @@ In your ~/.Xresources file, then run And restart Emacs. +** On Haiku, BeCJK doesn't work properly with Emacs + +Some popular Haiku input methods such BeCJK are known to behave badly +when interacting with Emacs, in ways such as stealing input focus and +displaying popup windows that don't disappear. If you are affected, +you should use an Emacs input method instead. + * X runtime problems ** X keyboard problems diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index e6cda733679..d062e78366f 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -27,7 +27,9 @@ EMACSOPT = -batch --no-site-file --no-site-lisp # ==================== Things 'configure' will edit ==================== CC=@CC@ +CXX=@CXX@ CFLAGS=@CFLAGS@ +CXXFLAGS=@CXXFLAGS@ CPPFLAGS = @CPPFLAGS@ LDFLAGS = @LDFLAGS@ @@ -130,6 +132,11 @@ MKDIR_P = @MKDIR_P@ # ========================== Lists of Files =========================== +## Haiku build-time support +HAVE_BE_APP=@HAVE_BE_APP@ +HAIKU_LIBS=@HAIKU_LIBS@ +HAIKU_CFLAGS=@HAIKU_CFLAGS@ + # emacsclientw.exe for MinGW, empty otherwise CLIENTW = @CLIENTW@ @@ -143,7 +150,11 @@ UTILITIES = hexl${EXEEXT} \ $(if $(with_mailutils), , movemail${EXEEXT}) \ $(and $(use_gamedir), update-game-score${EXEEXT}) +ifeq ($(HAVE_BE_APP),yes) +DONT_INSTALL= make-docfile${EXEEXT} make-fingerprint${EXEEXT} be-resources +else DONT_INSTALL= make-docfile${EXEEXT} make-fingerprint${EXEEXT} +endif # Like UTILITIES, but they're not system-dependent, and should not be # deleted by the distclean target. @@ -230,6 +241,10 @@ WINDRES = @WINDRES@ ## Some systems define this to request special libraries. LIBS_SYSTEM = @LIBS_SYSTEM@ +# Flags that could be in WARN_CFLAGS, but are invalid for C++. +NON_CXX_CFLAGS = -Wmissing-prototypes -Wnested-externs -Wold-style-definition \ + -Wstrict-prototypes -Wno-override-init + BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) \ -I. -I../src -I../lib \ @@ -238,6 +253,9 @@ BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS} +ALL_CXXFLAGS = $(filter-out ${NON_CXX_CFLAGS},${BASE_CFLAGS}) \ + ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} ${CXXFLAGS} ${HAIKU_CFLAGS} + # Configuration files for .o files to depend on. config_h = ../src/config.h $(srcdir)/../src/conf_post.h @@ -407,6 +425,9 @@ emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) $(LOADLIBES) \ $(LIB_WSOCK32) $(LIB_EACCESS) $(LIBS_ECLIENT) -o $@ +be-resources: ${srcdir}/be_resources.cc ${config_h} + $(AM_V_CXXLD)$(CXX) ${ALL_CXXFLAGS} ${HAIKU_LIBS} $< -o $@ + NTINC = ${srcdir}/../nt/inc NTDEPS = $(NTINC)/ms-w32.h $(NTINC)/sys/stat.h $(NTINC)/inttypes.h \ $(NTINC)/stdint.h $(NTINC)/pwd.h $(NTINC)/sys/time.h $(NTINC)/stdbool.h \ diff --git a/lib-src/be_resources.cc b/lib-src/be_resources.cc new file mode 100644 index 00000000000..e6a14f037b6 --- /dev/null +++ b/lib-src/be_resources.cc @@ -0,0 +1,144 @@ +/* Haiku window system support + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include + +using namespace std; + +static void +be_perror (status_t code, char *arg) +{ + if (code != B_OK) + { + switch (code) + { + case B_BAD_VALUE: + fprintf (stderr, "%s: Bad value\n", arg); + break; + case B_ENTRY_NOT_FOUND: + fprintf (stderr, "%s: Not found\n", arg); + break; + case B_PERMISSION_DENIED: + fprintf (stderr, "%s: Permission denied\n", arg); + break; + case B_NO_MEMORY: + fprintf (stderr, "%s: No memory\n", arg); + break; + case B_LINK_LIMIT: + fprintf (stderr, "%s: Link limit reached\n", arg); + break; + case B_BUSY: + fprintf (stderr, "%s: Busy\n", arg); + break; + case B_NO_MORE_FDS: + fprintf (stderr, "%s: No more file descriptors\n", arg); + break; + case B_FILE_ERROR: + fprintf (stderr, "%s: File error\n", arg); + break; + default: + fprintf (stderr, "%s: Unknown error\n", arg); + } + } + else + { + abort (); + } +} + +int +main (int argc, char **argv) +{ + BApplication app ("application/x-vnd.GNU-emacs-resource-helper"); + BFile file; + BBitmap *icon; + BAppFileInfo info; + status_t code; + struct version_info vinfo; + char *v = strdup (PACKAGE_VERSION); + + if (argc != 3) + { + printf ("be-resources ICON FILE: make FILE appropriate for Emacs.\n"); + return EXIT_FAILURE; + } + + code = file.SetTo (argv[2], B_READ_WRITE); + if (code != B_OK) + { + be_perror (code, argv[2]); + return EXIT_FAILURE; + } + code = info.SetTo (&file); + if (code != B_OK) + { + be_perror (code, argv[2]); + return EXIT_FAILURE; + } + code = info.SetAppFlags (B_EXCLUSIVE_LAUNCH | B_ARGV_ONLY); + if (code != B_OK) + { + be_perror (code, argv[2]); + return EXIT_FAILURE; + } + + icon = BTranslationUtils::GetBitmapFile (argv[1], NULL); + + if (!icon) + { + be_perror (B_ERROR, argv[1]); + return EXIT_FAILURE; + } + + info.SetIcon (icon, B_MINI_ICON); + info.SetIcon (icon, B_LARGE_ICON); + info.SetSignature ("application/x-vnd.GNU-emacs"); + + v = strtok (v, "."); + vinfo.major = atoi (v); + + v = strtok (NULL, "."); + vinfo.middle = atoi (v); + + v = strtok (NULL, "."); + vinfo.minor = v ? atoi (v) : 0; + + vinfo.variety = 0; + vinfo.internal = 0; + + strncpy ((char *) &vinfo.short_info, PACKAGE_VERSION, + sizeof vinfo.short_info - 1); + strncpy ((char *) &vinfo.long_info, PACKAGE_STRING, + sizeof vinfo.long_info - 1); + + info.SetVersionInfo (&vinfo, B_APP_VERSION_KIND); + + return EXIT_SUCCESS; +} diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 0e800dd7e89..c55b29830df 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -603,6 +603,8 @@ decode_options (int argc, char **argv) alt_display = "ns"; #elif defined (HAVE_NTGUI) alt_display = "w32"; +#elif defined (HAVE_HAIKU) + alt_display = "be"; #endif display = egetenv ("DISPLAY"); diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 6c353b0d9ec..b7c53a4dfed 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2176,7 +2176,7 @@ and `face'." ;;; The `custom' Widget. (defface custom-button - '((((type x w32 ns) (class color)) ; Like default mode line + '((((type x w32 ns haiku) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) "Face for custom buffer buttons if `custom-raised-buttons' is non-nil." @@ -2184,7 +2184,7 @@ and `face'." :group 'custom-faces) (defface custom-button-mouse - '((((type x w32 ns) (class color)) + '((((type x w32 ns haiku) (class color)) :box (:line-width 2 :style released-button) :background "grey90" :foreground "black") (t @@ -2209,7 +2209,7 @@ and `face'." (if custom-raised-buttons 'custom-button-mouse 'highlight)) (defface custom-button-pressed - '((((type x w32 ns) (class color)) + '((((type x w32 ns haiku) (class color)) :box (:line-width 2 :style pressed-button) :background "lightgrey" :foreground "black") (t :inverse-video t)) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a46107a6784..68019c038e7 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -829,7 +829,11 @@ since it could result in memory overflow and make Emacs crash." ;; xselect.c (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c - (font-use-system-font font-selection boolean "23.2"))) + (font-use-system-font font-selection boolean "23.2") + ;; haikuterm.c + (haiku-debug-on-fatal-error debug boolean "29.1") + ;; haikufns.c + (haiku-use-system-tooltips tooltip boolean "29.1"))) (setq ;; If we did not specify any standard value expression above, ;; use the current value as the standard value. standard (if (setq prop (memq :standard rest)) @@ -846,6 +850,8 @@ since it could result in memory overflow and make Emacs crash." (eq system-type 'windows-nt)) ((string-match "\\`ns-" (symbol-name symbol)) (featurep 'ns)) + ((string-match "\\`haiku-" (symbol-name symbol)) + (featurep 'haiku)) ((string-match "\\`x-.*gtk" (symbol-name symbol)) (featurep 'gtk)) ((string-match "clipboard-manager" (symbol-name symbol)) diff --git a/lisp/faces.el b/lisp/faces.el index 9ec20c42987..b2498cda88a 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1172,7 +1172,7 @@ an integer value." (:height 'integerp) (:stipple - (and (memq (window-system frame) '(x ns)) ; No stipple on w32 + (and (memq (window-system frame) '(x ns)) ; No stipple on w32 or haiku (mapcar #'list (apply #'nconc (mapcar (lambda (dir) @@ -2822,7 +2822,7 @@ Note: Other faces cannot inherit from the cursor face." '((default :box (:line-width 1 :style released-button) :foreground "black") - (((type x w32 ns) (class color)) + (((type x w32 ns haiku) (class color)) :background "grey75") (((type x) (class mono)) :background "grey")) diff --git a/lisp/frame.el b/lisp/frame.el index 2c73737a541..1319759e74d 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1633,6 +1633,7 @@ live frame and defaults to the selected one." (declare-function x-frame-geometry "xfns.c" (&optional frame)) (declare-function w32-frame-geometry "w32fns.c" (&optional frame)) (declare-function ns-frame-geometry "nsfns.m" (&optional frame)) +(declare-function haiku-frame-geometry "haikufns.c" (&optional frame)) (defun frame-geometry (&optional frame) "Return geometric attributes of FRAME. @@ -1682,6 +1683,8 @@ and width values are in pixels. (w32-frame-geometry frame)) ((eq frame-type 'ns) (ns-frame-geometry frame)) + ((eq frame-type 'haiku) + (haiku-frame-geometry frame)) (t (list '(outer-position 0 . 0) @@ -1806,6 +1809,7 @@ of frames like calls to map a frame or change its visibility." (declare-function x-frame-edges "xfns.c" (&optional frame type)) (declare-function w32-frame-edges "w32fns.c" (&optional frame type)) (declare-function ns-frame-edges "nsfns.m" (&optional frame type)) +(declare-function haiku-frame-edges "haikufns.c" (&optional frame type)) (defun frame-edges (&optional frame type) "Return coordinates of FRAME's edges. @@ -1829,12 +1833,15 @@ FRAME." (w32-frame-edges frame type)) ((eq frame-type 'ns) (ns-frame-edges frame type)) + ((eq frame-type 'haiku) + (haiku-frame-edges frame type)) (t (list 0 0 (frame-width frame) (frame-height frame)))))) (declare-function w32-mouse-absolute-pixel-position "w32fns.c") (declare-function x-mouse-absolute-pixel-position "xfns.c") (declare-function ns-mouse-absolute-pixel-position "nsfns.m") +(declare-function haiku-mouse-absolute-pixel-position "haikufns.c") (defun mouse-absolute-pixel-position () "Return absolute position of mouse cursor in pixels. @@ -1849,12 +1856,15 @@ position (0, 0) of the selected frame's terminal." (w32-mouse-absolute-pixel-position)) ((eq frame-type 'ns) (ns-mouse-absolute-pixel-position)) + ((eq frame-type 'haiku) + (haiku-mouse-absolute-pixel-position)) (t (cons 0 0))))) (declare-function ns-set-mouse-absolute-pixel-position "nsfns.m" (x y)) (declare-function w32-set-mouse-absolute-pixel-position "w32fns.c" (x y)) (declare-function x-set-mouse-absolute-pixel-position "xfns.c" (x y)) +(declare-function haiku-set-mouse-absolute-pixel-position "haikufns.c" (x y)) (defun set-mouse-absolute-pixel-position (x y) "Move mouse pointer to absolute pixel position (X, Y). @@ -1867,7 +1877,9 @@ position (0, 0) of the selected frame's terminal." ((eq frame-type 'x) (x-set-mouse-absolute-pixel-position x y)) ((eq frame-type 'w32) - (w32-set-mouse-absolute-pixel-position x y))))) + (w32-set-mouse-absolute-pixel-position x y)) + ((eq frame-type 'haiku) + (haiku-set-mouse-absolute-pixel-position x y))))) (defun frame-monitor-attributes (&optional frame) "Return the attributes of the physical monitor dominating FRAME. @@ -1960,6 +1972,7 @@ workarea attribute." (declare-function x-frame-list-z-order "xfns.c" (&optional display)) (declare-function w32-frame-list-z-order "w32fns.c" (&optional display)) (declare-function ns-frame-list-z-order "nsfns.m" (&optional display)) +(declare-function haiku-frame-list-z-order "haikufns.c" (&optional display)) (defun frame-list-z-order (&optional display) "Return list of Emacs' frames, in Z (stacking) order. @@ -1979,7 +1992,9 @@ Return nil if DISPLAY contains no Emacs frame." ((eq frame-type 'w32) (w32-frame-list-z-order display)) ((eq frame-type 'ns) - (ns-frame-list-z-order display))))) + (ns-frame-list-z-order display)) + ((eq frame-type 'haiku) + (haiku-frame-list-z-order display))))) (declare-function x-frame-restack "xfns.c" (frame1 frame2 &optional above)) (declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above)) @@ -2060,8 +2075,8 @@ frame's display)." ((eq frame-type 'w32) (with-no-warnings (> w32-num-mouse-buttons 0))) - ((memq frame-type '(x ns)) - t) ;; We assume X and NeXTstep *always* have a pointing device + ((memq frame-type '(x ns haiku)) + t) ;; We assume X, NeXTstep and Haiku *always* have a pointing device (t (or (and (featurep 'xt-mouse) xterm-mouse-mode) @@ -2086,7 +2101,7 @@ frames and several different fonts at once. This is true for displays that use a window system such as X, and false for text-only terminals. DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display)." - (not (null (memq (framep-on-display display) '(x w32 ns))))) + (not (null (memq (framep-on-display display) '(x w32 ns haiku))))) (defun display-images-p (&optional display) "Return non-nil if DISPLAY can display images. @@ -2137,7 +2152,7 @@ DISPLAY should be either a frame or a display name (a string). If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-screens display)) (t 1)))) @@ -2157,7 +2172,7 @@ with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-pixel-height display)) (t (frame-height (if (framep display) display (selected-frame))))))) @@ -2177,7 +2192,7 @@ with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-pixel-width display)) (t (frame-width (if (framep display) display (selected-frame))))))) @@ -2215,7 +2230,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this refers to the height in millimeters for all physical monitors associated with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." - (and (memq (framep-on-display display) '(x w32 ns)) + (and (memq (framep-on-display display) '(x w32 ns haiku)) (or (cddr (assoc (or display (frame-parameter nil 'display)) display-mm-dimensions-alist)) (cddr (assoc t display-mm-dimensions-alist)) @@ -2236,7 +2251,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this refers to the width in millimeters for all physical monitors associated with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." - (and (memq (framep-on-display display) '(x w32 ns)) + (and (memq (framep-on-display display) '(x w32 ns haiku)) (or (cadr (assoc (or display (frame-parameter nil 'display)) display-mm-dimensions-alist)) (cadr (assoc t display-mm-dimensions-alist)) @@ -2254,7 +2269,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-backing-store display)) (t 'not-useful)))) @@ -2267,7 +2282,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-save-under display)) (t 'not-useful)))) @@ -2280,7 +2295,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-planes display)) ((eq frame-type 'pc) 4) @@ -2295,7 +2310,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-color-cells display)) ((eq frame-type 'pc) 16) @@ -2312,7 +2327,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku)) (x-display-visual-class display)) ((and (memq frame-type '(pc t)) (tty-display-color-p display)) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 089decb83c8..b922f192a94 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -88,7 +88,7 @@ (bindings--define-key map [separator-3] menu-bar-separator) (bindings--define-key map [set-terminal-coding-system] '(menu-item "For Terminal" set-terminal-coding-system - :enable (null (memq initial-window-system '(x w32 ns))) + :enable (null (memq initial-window-system '(x w32 ns haiku))) :help "How to encode terminal output")) (bindings--define-key map [set-keyboard-coding-system] '(menu-item "For Keyboard" set-keyboard-coding-system diff --git a/lisp/loadup.el b/lisp/loadup.el index 15a71ef244e..ed1570e778b 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -303,6 +303,11 @@ (load "term/common-win") (load "term/x-win"))) +(if (featurep 'haiku) + (progn + (load "term/common-win") + (load "term/haiku-win"))) + (if (or (eq system-type 'windows-nt) (featurep 'w32)) (progn @@ -558,6 +563,7 @@ lost after dumping"))) (delete-file output))))) ;; Recompute NAME now, so that it isn't set when we dump. (if (not (or (eq system-type 'ms-dos) + (eq system-type 'haiku) ;; BFS doesn't support hard links ;; Don't bother adding another name if we're just ;; building bootstrap-emacs. (member dump-mode '("pbootstrap" "bootstrap")))) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 94e75efeeb0..274f594f69e 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2540,6 +2540,7 @@ See `menu-bar-mode' for more information." (declare-function x-menu-bar-open "term/x-win" (&optional frame)) (declare-function w32-menu-bar-open "term/w32-win" (&optional frame)) +(declare-function haiku-menu-bar-open "haikumenu.c" (&optional frame)) (defun lookup-key-ignore-too-long (map key) "Call `lookup-key' and convert numeric values to nil." @@ -2665,9 +2666,10 @@ first TTY menu-bar menu to be dropped down. Interactively, this is the numeric argument to the command. This function decides which method to use to access the menu depending on FRAME's terminal device. On X displays, it calls -`x-menu-bar-open'; on Windows, `w32-menu-bar-open'; otherwise it -calls either `popup-menu' or `tmm-menubar' depending on whether -`tty-menu-open-use-tmm' is nil or not. +`x-menu-bar-open'; on Windows, `w32-menu-bar-open'; on Haiku, +`haiku-menu-bar-open'; otherwise it calls either `popup-menu' +or `tmm-menubar' depending on whether `tty-menu-open-use-tmm' +is nil or not. If FRAME is nil or not given, use the selected frame." (interactive @@ -2676,6 +2678,7 @@ If FRAME is nil or not given, use the selected frame." (cond ((eq type 'x) (x-menu-bar-open frame)) ((eq type 'w32) (w32-menu-bar-open frame)) + ((eq type 'haiku) (haiku-menu-bar-open frame)) ((and (null tty-menu-open-use-tmm) (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0)))) ;; Make sure the menu bar is up to date. One situation where diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 3d0b8f07cb7..cd84a109993 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -55,7 +55,8 @@ (mouse-wheel-mode 1))) (defcustom mouse-wheel-down-event - (if (or (featurep 'w32-win) (featurep 'ns-win)) + (if (or (featurep 'w32-win) (featurep 'ns-win) + (featurep 'haiku-win)) 'wheel-up 'mouse-4) "Event used for scrolling down." @@ -71,7 +72,8 @@ :set 'mouse-wheel-change-button) (defcustom mouse-wheel-up-event - (if (or (featurep 'w32-win) (featurep 'ns-win)) + (if (or (featurep 'w32-win) (featurep 'ns-win) + (featurep 'haiku-win)) 'wheel-down 'mouse-5) "Event used for scrolling up." @@ -235,7 +237,8 @@ Also see `mouse-wheel-tilt-scroll'." "Function that does the job of scrolling right.") (defvar mouse-wheel-left-event - (if (or (featurep 'w32-win) (featurep 'ns-win)) + (if (or (featurep 'w32-win) (featurep 'ns-win) + (featurep 'haiku-win)) 'wheel-left 'mouse-6) "Event used for scrolling left.") @@ -245,7 +248,8 @@ Also see `mouse-wheel-tilt-scroll'." "Alternative wheel left event to consider.") (defvar mouse-wheel-right-event - (if (or (featurep 'w32-win) (featurep 'ns-win)) + (if (or (featurep 'w32-win) (featurep 'ns-win) + (featurep 'haiku-win)) 'wheel-right 'mouse-7) "Event used for scrolling right.") diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 3af37e412d9..687bf6c8840 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -39,6 +39,7 @@ ;; browse-url-chrome Chrome 47.0.2526.111 ;; browse-url-chromium Chromium 3.0 ;; browse-url-epiphany Epiphany Don't know +;; browse-url-webpositive WebPositive 1.2-alpha (Haiku R1/beta3) ;; browse-url-w3 w3 0 ;; browse-url-text-* Any text browser 0 ;; browse-url-generic arbitrary @@ -156,6 +157,7 @@ (function-item :tag "Google Chrome" :value browse-url-chrome) (function-item :tag "Chromium" :value browse-url-chromium) (function-item :tag "Epiphany" :value browse-url-epiphany) + (function-item :tag "WebPositive" :value browse-url-webpositive) (function-item :tag "Text browser in an xterm window" :value browse-url-text-xterm) (function-item :tag "Text browser in an Emacs window" @@ -366,6 +368,11 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time `browse-url' is loaded." :type '(repeat (string :tag "Argument"))) +(defcustom browse-url-webpositive-program "WebPositive" + "The name by which to invoke WebPositive." + :type 'string + :version "28.1") + ;; GNOME means of invoking either Mozilla or Netscape. (defvar browse-url-gnome-moz-program "gnome-moz-remote") @@ -1050,6 +1057,7 @@ instead of `browse-url-new-window-flag'." ((executable-find browse-url-kde-program) 'browse-url-kde) ;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape) ((executable-find browse-url-chrome-program) 'browse-url-chrome) + ((executable-find browse-url-webpositive-program) 'browse-url-webpositive) ((executable-find browse-url-xterm-program) 'browse-url-text-xterm) ((locate-library "w3") 'browse-url-w3) (t @@ -1376,6 +1384,18 @@ used instead of `browse-url-new-window-flag'." (defvar url-handler-regexp) +;;;###autoload +(defun browse-url-webpositive (url &optional _new-window) + "Ask the WebPositive WWW browser to load URL. +Default to the URL around or before point. +The optional argument NEW-WINDOW is not used." + (interactive (browse-url-interactive-arg "URL: ")) + (setq url (browse-url-encode-url url)) + (let* ((process-environment (browse-url-process-environment))) + (start-process (concat "WebPositive " url) nil "WebPositive" url))) + +(function-put 'browse-url-webpositive 'browse-url-browser-kind 'external) + ;;;###autoload (defun browse-url-emacs (url &optional same-window) "Ask Emacs to load URL into a buffer and show it in another window. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 031a73143e4..e86d21f889c 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -239,7 +239,7 @@ parameter, and should return the (possibly) transformed URL." :version "29.1") (defface eww-form-submit - '((((type x w32 ns) (class color)) ; Like default mode line + '((((type x w32 ns haiku) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "#808080" :foreground "black")) "Face for eww buffer buttons." @@ -247,7 +247,7 @@ parameter, and should return the (possibly) transformed URL." :group 'eww) (defface eww-form-file - '((((type x w32 ns) (class color)) ; Like default mode line + '((((type x w32 ns haiku) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "#808080" :foreground "black")) "Face for eww buffer buttons." @@ -255,7 +255,7 @@ parameter, and should return the (possibly) transformed URL." :group 'eww) (defface eww-form-checkbox - '((((type x w32 ns) (class color)) ; Like default mode line + '((((type x w32 ns haiku) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) "Face for eww buffer buttons." @@ -263,7 +263,7 @@ parameter, and should return the (possibly) transformed URL." :group 'eww) (defface eww-form-select - '((((type x w32 ns) (class color)) ; Like default mode line + '((((type x w32 ns haiku) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) "Face for eww buffer buttons." diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el new file mode 100644 index 00000000000..36af10d2c70 --- /dev/null +++ b/lisp/term/haiku-win.el @@ -0,0 +1,134 @@ +;;; haiku-win.el --- set up windowing on Haiku -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Support for using Haiku's BeOS derived windowing system. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(unless (featurep 'haiku) + (error "%s: Loading haiku-win without having Haiku" + invocation-name)) + +;; Documentation-purposes only: actually loaded in loadup.el. +(require 'frame) +(require 'mouse) +(require 'scroll-bar) +(require 'menu-bar) +(require 'fontset) +(require 'dnd) + +(add-to-list 'display-format-alist '(".*" . haiku-win)) + +;;;; Command line argument handling. + +(defvar x-invocation-args) +(defvar x-command-line-resources) + +(defvar haiku-initialized) + +(declare-function x-open-connection "haikufns.c") +(declare-function x-handle-args "common-win") +(declare-function haiku-selection-data "haikuselect.c") +(declare-function haiku-selection-put "haikuselect.c") +(declare-function haiku-put-resource "haikufns.c") + +(defun haiku--handle-x-command-line-resources (command-line-resources) + "Handle command line X resources specified with the option `-xrm'. +The resources should be a list of strings in COMMAND-LINE-RESOURCES." + (dolist (s command-line-resources) + (let ((components (split-string s ":"))) + (when (car components) + (haiku-put-resource (car components) + (string-trim-left + (mapconcat #'identity (cdr components) ":"))))))) + +(cl-defmethod window-system-initialization (&context (window-system haiku) + &optional display) + "Set up the window system. WINDOW-SYSTEM must be HAIKU. +DISPLAY may be set to the name of a display that will be initialized." + (cl-assert (not haiku-initialized)) + + (create-default-fontset) + (when x-command-line-resources + (haiku--handle-x-command-line-resources + (split-string x-command-line-resources "\n"))) + (x-open-connection (or display "be") x-command-line-resources t) + (setq haiku-initialized t)) + +(cl-defmethod frame-creation-function (params &context (window-system haiku)) + (x-create-frame-with-faces params)) + +(cl-defmethod handle-args-function (args &context (window-system haiku)) + (x-handle-args args)) + +(defun haiku--selection-type-to-mime (type) + "Convert symbolic selection type TYPE to its MIME equivalent. +If TYPE is nil, return \"text/plain\"." + (cond + ((memq type '(TEXT COMPOUND_TEXT STRING UTF8_STRING)) "text/plain") + ((stringp type) type) + (t "text/plain"))) + +(cl-defmethod gui-backend-get-selection (type data-type + &context (window-system haiku)) + (haiku-selection-data type (haiku--selection-type-to-mime data-type))) + +(cl-defmethod gui-backend-set-selection (type value + &context (window-system haiku)) + (haiku-selection-put type "text/plain" value)) + +(cl-defmethod gui-backend-selection-exists-p (selection + &context (window-system haiku)) + (haiku-selection-data selection "text/plain")) + +(cl-defmethod gui-backend-selection-owner-p (_ + &context (window-system haiku)) + t) + +(declare-function haiku-read-file-name "haikufns.c") + +(defun x-file-dialog (prompt dir default_filename mustmatch only_dir_p) + "SKIP: real doc in xfns.c." + (if (eq (framep-on-display (selected-frame)) 'haiku) + (haiku-read-file-name prompt (selected-frame) + (or dir (and default_filename + (file-name-directory default_filename))) + mustmatch only_dir_p + (file-name-nondirectory default_filename)) + (error "x-file-dialog on a tty frame"))) + +(defun haiku-dnd-handle-drag-n-drop-event (event) + "Handle specified drag-n-drop EVENT." + (interactive "e") + (let* ((string (caddr event)) + (window (posn-window (event-start event)))) + (with-selected-window window + (raise-frame) + (dnd-handle-one-url window 'private (concat "file:" string))))) + +(define-key special-event-map [drag-n-drop] + 'haiku-dnd-handle-drag-n-drop-event) + +(provide 'haiku-win) +(provide 'term/haiku-win) + +;;; haiku-win.el ends here diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 23b67ee2cab..6cc482d012a 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -368,10 +368,15 @@ It is also called if Tooltip mode is on, for text-only displays." ((equal-including-properties tooltip-help-message (current-message)) (message nil))))) +(declare-function menu-or-popup-active-p "xmenu.c" ()) + (defun tooltip-show-help (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." - (if (display-graphic-p) + (if (and (display-graphic-p) + (or (not (eq window-system 'haiku)) ;; On Haiku, there isn't a reliable way to show tooltips + ;; above menus. + (not (menu-or-popup-active-p)))) (let ((previous-help tooltip-help-message)) (setq tooltip-help-message msg) (cond ((null msg) diff --git a/lisp/version.el b/lisp/version.el index 3a3093fdd4a..5d0a1ae37dc 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -53,6 +53,8 @@ developing Emacs.") (defvar ns-version-string) (defvar cairo-version-string) +(declare-function haiku-get-version-string "haikufns.c") + (defun emacs-version (&optional here) "Return string describing the version of Emacs that is running. If optional argument HERE is non-nil, insert string at point. @@ -71,6 +73,8 @@ to the system configuration; look at `system-configuration' instead." ((featurep 'x-toolkit) ", X toolkit") ((featurep 'ns) (format ", NS %s" ns-version-string)) + ((featurep 'haiku) + (format ", Haiku %s" (haiku-get-version-string))) (t "")) (if (featurep 'cairo) (format ", cairo version %s" cairo-version-string) diff --git a/src/Makefile.in b/src/Makefile.in index 0aaaf91d392..d276df22475 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -34,6 +34,7 @@ top_builddir = @top_builddir@ abs_top_srcdir=@abs_top_srcdir@ VPATH = $(srcdir) CC = @CC@ +CXX = @CXX@ CFLAGS = @CFLAGS@ CPPFLAGS = @CPPFLAGS@ LDFLAGS = @LDFLAGS@ @@ -346,10 +347,17 @@ BUILD_DETAILS = @BUILD_DETAILS@ UNEXEC_OBJ = @UNEXEC_OBJ@ +HAIKU_OBJ = @HAIKU_OBJ@ +HAIKU_CXX_OBJ = @HAIKU_CXX_OBJ@ +HAIKU_LIBS = @HAIKU_LIBS@ +HAIKU_CFLAGS = @HAIKU_CFLAGS@ + DUMPING=@DUMPING@ CHECK_STRUCTS = @CHECK_STRUCTS@ HAVE_PDUMPER = @HAVE_PDUMPER@ +HAVE_BE_APP = @HAVE_BE_APP@ + ## ARM Macs require that all code have a valid signature. Since pdump ## invalidates the signature, we must re-sign to fix it. DO_CODESIGN=$(patsubst aarch64-apple-darwin%,yes,@configuration@) @@ -367,6 +375,9 @@ endif # Flags that might be in WARN_CFLAGS but are not valid for Objective C. NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd +# Ditto, but for C++. +NON_CXX_CFLAGS = -Wmissing-prototypes -Wnested-externs -Wold-style-definition \ + -Wstrict-prototypes -Wno-override-init # -Demacs makes some files produce the correct version for use in Emacs. # MYCPPFLAGS is for by-hand Emacs-specific overrides, e.g., @@ -382,17 +393,21 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \ $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ - $(WERROR_CFLAGS) + $(WERROR_CFLAGS) $(HAIKU_CFLAGS) ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) ALL_OBJC_CFLAGS = $(EMACS_CFLAGS) \ $(filter-out $(NON_OBJC_CFLAGS),$(WARN_CFLAGS)) $(CFLAGS) \ $(GNU_OBJC_CFLAGS) +ALL_CXX_CFLAGS = $(EMACS_CFLAGS) \ + $(filter-out $(NON_CXX_CFLAGS),$(WARN_CFLAGS)) $(CXXFLAGS) -.SUFFIXES: .m +.SUFFIXES: .m .cc .c.o: $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $(PROFILING_CFLAGS) $< .m.o: $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_OBJC_CFLAGS) $(PROFILING_CFLAGS) $< +.cc.o: + $(AM_V_CXX)$(CXX) -c $(CPPFLAGS) $(ALL_CXX_CFLAGS) $(PROFILING_CFLAGS) $< ## lastfile must follow all files whose initialized data areas should ## be dumped as pure by dump-emacs. @@ -414,8 +429,10 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ thread.o systhread.o \ $(if $(HYBRID_MALLOC),sheap.o) \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ - $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) -obj = $(base_obj) $(NS_OBJC_OBJ) + $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \ + $(HAIKU_OBJ) +doc_obj = $(base_obj) $(NS_OBJC_OBJ) +obj = $(doc_obj) $(HAIKU_CXX_OBJ) ## Object files used on some machine or other. ## These go in the DOC file on all machines in case they are needed. @@ -429,7 +446,8 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \ - xsettings.o xgselect.o termcap.o hbfont.o + xsettings.o xgselect.o termcap.o hbfont.o \ + haikuterm.o haikufns.o haikumenu.o haikufont.o ## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty. GMALLOC_OBJ=@GMALLOC_OBJ@ @@ -455,7 +473,11 @@ FIRSTFILE_OBJ=@FIRSTFILE_OBJ@ ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) # Must be first, before dep inclusion! +ifneq ($(HAVE_BE_APP),yes) all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES) +else +all: Emacs Emacs.pdmp $(OTHER_FILES) +endif ifeq ($(HAVE_NATIVE_COMP):$(NATIVE_DISABLED),yes:) all: ../native-lisp endif @@ -527,7 +549,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ - $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) + $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, @@ -584,6 +606,18 @@ else rm -f $@ && cp -f temacs$(EXEEXT) $@ endif +## On Haiku, also produce a binary named Emacs with the appropriate +## icon set. + +ifeq ($(HAVE_BE_APP),yes) +Emacs: emacs$(EXEEXT) + cp -f emacs$(EXEEXT) $@ + $(AM_V_GEN) $(libsrc)/be-resources \ + $(etc)/images/icons/hicolor/32x32/apps/emacs.png $@ +Emacs.pdmp: $(pdmp) + $(AM_V_GEN) cp -f $(pdmp) $@ +endif + ifeq ($(DUMPING),pdumper) $(pdmp): emacs$(EXEEXT) LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \ @@ -602,11 +636,11 @@ endif ## for the first time, this prevents any variation between configurations ## in the contents of the DOC file. ## -$(etc)/DOC: lisp.mk $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp) +$(etc)/DOC: lisp.mk $(libsrc)/make-docfile$(EXEEXT) $(doc_obj) $(lisp) $(AM_V_GEN)$(MKDIR_P) $(etc) $(AM_V_at)rm -f $(etc)/DOC $(AM_V_at)$(libsrc)/make-docfile -d $(srcdir) \ - $(SOME_MACHINE_OBJECTS) $(obj) > $(etc)/DOC + $(SOME_MACHINE_OBJECTS) $(doc_obj) > $(etc)/DOC $(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \ $(shortlisp) @@ -624,7 +658,7 @@ buildobj.h: Makefile GLOBAL_SOURCES = $(base_obj:.o=.c) $(NS_OBJC_OBJ:.o=.m) gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES) - $(AM_V_GLOBALS)$(libsrc)/make-docfile -d $(srcdir) -g $(obj) > globals.tmp + $(AM_V_GLOBALS)$(libsrc)/make-docfile -d $(srcdir) -g $(doc_obj) > globals.tmp $(AM_V_at)$(top_srcdir)/build-aux/move-if-change globals.tmp globals.h $(AM_V_at)echo timestamp > $@ @@ -649,9 +683,15 @@ endif ## to start if Vinstallation_directory has the wrong value. temacs$(EXEEXT): $(LIBXMENU) $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(EMACSRES) \ $(charsets) $(charscript) ${emoji-zwj} $(MAKE_PDUMPER_FINGERPRINT) - $(AM_V_CCLD)$(CC) -o $@.tmp \ +ifeq ($(HAVE_BE_APP),yes) + $(AM_V_CXXLD)$(CXX) -o $@.tmp \ $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ + $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) -lstdc++ +else + $(AM_V_CCLD)$(CC) -o $@.tmp \ + $(ALL_CFLAGS) $(CXXFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) +endif ifeq ($(HAVE_PDUMPER),yes) $(AM_V_at)$(MAKE_PDUMPER_FINGERPRINT) $@.tmp ifeq ($(DO_CODESIGN),yes) @@ -736,6 +776,7 @@ ${ETAGS}: FORCE # to be built before we can get TAGS. ctagsfiles1 = $(filter-out ${srcdir}/macuvs.h, $(wildcard ${srcdir}/*.[hc])) ctagsfiles2 = $(wildcard ${srcdir}/*.m) +ctagsfiles3 = $(wildcard ${srcdir}/*.cc) ## In out-of-tree builds, TAGS are generated in the build dir, like ## other non-bootstrap build products (see Bug#31744). @@ -750,7 +791,8 @@ TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2) $(ctagsfiles1) \ --regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/\1/' \ --regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"[^"]+",[ ]\([A-Za-z0-9_]+\)/\1/' \ - $(ctagsfiles2) + $(ctagsfiles2) \ + $(ctagsfiles3) ## Arrange to make tags tables for ../lisp and ../lwlib, ## which the above TAGS file for the C files includes by reference. diff --git a/src/alloc.c b/src/alloc.c index aa790d3afae..f8908c91dba 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6149,6 +6149,10 @@ garbage_collect (void) xg_mark_data (); #endif +#ifdef HAVE_HAIKU + mark_haiku_display (); +#endif + #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); #endif diff --git a/src/dispextern.h b/src/dispextern.h index f17f095e0d3..a698f6546b1 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -134,6 +134,13 @@ typedef Emacs_Pixmap Emacs_Pix_Context; #define FACE_COLOR_TO_PIXEL(face_color, frame) face_color #endif +#ifdef HAVE_HAIKU +#include "haikugui.h" +typedef struct haiku_display_info Display_Info; +typedef Emacs_Pixmap Emacs_Pix_Container; +typedef Emacs_Pixmap Emacs_Pix_Context; +#endif + #ifdef HAVE_WINDOW_SYSTEM # include # include "fontset.h" @@ -3011,7 +3018,7 @@ struct redisplay_interface #ifdef HAVE_WINDOW_SYSTEM # if (defined USE_CAIRO || defined HAVE_XRENDER \ - || defined HAVE_NS || defined HAVE_NTGUI) + || defined HAVE_NS || defined HAVE_NTGUI || defined HAVE_HAIKU) # define HAVE_NATIVE_TRANSFORMS # endif @@ -3050,6 +3057,14 @@ struct image #ifdef HAVE_NTGUI XFORM xform; #endif +#ifdef HAVE_HAIKU + /* Non-zero if the image has not yet been transformed for display. */ + int have_be_transforms_p; + + double be_rotate; + double be_scale_x; + double be_scale_y; +#endif /* Colors allocated for this image, if any. Allocated via xmalloc. */ unsigned long *colors; @@ -3489,7 +3504,8 @@ bool valid_image_p (Lisp_Object); void prepare_image_for_display (struct frame *, struct image *); ptrdiff_t lookup_image (struct frame *, Lisp_Object, int); -#if defined HAVE_X_WINDOWS || defined USE_CAIRO || defined HAVE_NS +#if defined HAVE_X_WINDOWS || defined USE_CAIRO || defined HAVE_NS \ + || defined HAVE_HAIKU #define RGB_PIXEL_COLOR unsigned long #endif diff --git a/src/dispnew.c b/src/dispnew.c index 632eec2f031..f3f110a8f27 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6146,7 +6146,7 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) wrong_type_argument (Qnumberp, timeout); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) gobble_input (); #endif @@ -6453,6 +6453,15 @@ init_display_interactive (void) } #endif +#ifdef HAVE_HAIKU + if (!inhibit_window_system && !will_dump_p ()) + { + Vinitial_window_system = Qhaiku; + Vwindow_system_version = make_fixnum (1); + return; + } +#endif + /* If no window system has been specified, try to use the terminal. */ if (! isatty (STDIN_FILENO)) fatal ("standard input is not a tty"); diff --git a/src/emacs.c b/src/emacs.c index 032b27fcf3c..63f2a393085 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -109,6 +109,10 @@ along with GNU Emacs. If not, see . */ #include "getpagesize.h" #include "gnutls.h" +#ifdef HAVE_HAIKU +#include +#endif + #ifdef PROFILING # include extern void moncontrol (int mode); @@ -2207,6 +2211,18 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_fontset (); #endif /* HAVE_NS */ +#ifdef HAVE_HAIKU + syms_of_haikuterm (); + syms_of_haikufns (); + syms_of_haikumenu (); + syms_of_haikufont (); + syms_of_haikuselect (); +#ifdef HAVE_NATIVE_IMAGE_API + syms_of_haikuimage (); +#endif + syms_of_fontset (); +#endif /* HAVE_HAIKU */ + syms_of_gnutls (); #ifdef HAVE_INOTIFY @@ -2261,6 +2277,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #if defined WINDOWSNT || defined HAVE_NTGUI globals_of_w32select (); #endif + +#ifdef HAVE_HAIKU + init_haiku_select (); +#endif } init_charset (); @@ -2728,6 +2748,9 @@ shut_down_emacs (int sig, Lisp_Object stuff) /* Don't update display from now on. */ Vinhibit_redisplay = Qt; +#ifdef HAVE_HAIKU + be_app_quit (); +#endif /* If we are controlling the terminal, reset terminal modes. */ #ifndef DOS_NT pid_t tpgrp = tcgetpgrp (STDIN_FILENO); @@ -2737,6 +2760,10 @@ shut_down_emacs (int sig, Lisp_Object stuff) if (sig && sig != SIGTERM) { static char const fmt[] = "Fatal error %d: %n%s\n"; +#ifdef HAVE_HAIKU + if (haiku_debug_on_fatal_error) + debugger ("Fatal error in Emacs"); +#endif char buf[max ((sizeof fmt - sizeof "%d%n%s\n" + INT_STRLEN_BOUND (int) + 1), min (PIPE_BUF, MAX_ALLOCA))]; @@ -3229,6 +3256,7 @@ Special values: `ms-dos' compiled as an MS-DOS application. `windows-nt' compiled as a native W32 application. `cygwin' compiled using the Cygwin library. + `haiku' compiled for a Haiku system. Anything else (in Emacs 26, the possibilities are: aix, berkeley-unix, hpux, usg-unix-v) indicates some sort of Unix system. */); Vsystem_type = intern_c_string (SYSTEM_TYPE); diff --git a/src/fileio.c b/src/fileio.c index 4015448ecee..859b30564aa 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6190,7 +6190,7 @@ before any other event (mouse or keypress) is handled. */) (void) { #if (defined USE_GTK || defined USE_MOTIF \ - || defined HAVE_NS || defined HAVE_NTGUI) + || defined HAVE_NS || defined HAVE_NTGUI || defined HAVE_HAIKU) if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) && use_dialog_box && use_file_dialog diff --git a/src/filelock.c b/src/filelock.c index cc185d96cdf..c12776246bd 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -65,7 +65,7 @@ along with GNU Emacs. If not, see . */ #define BOOT_TIME_FILE "/var/run/random-seed" #endif -#if !defined WTMP_FILE && !defined WINDOWSNT +#if !defined WTMP_FILE && !defined WINDOWSNT && defined BOOT_TIME #define WTMP_FILE "/var/log/wtmp" #endif diff --git a/src/floatfns.c b/src/floatfns.c index aadae4fd9d6..f52dae47193 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -347,6 +347,21 @@ int double_integer_scale (double d) { int exponent = ilogb (d); +#ifdef HAIKU + /* On Haiku, the values returned by ilogb are nonsensical when + confronted with tiny numbers, inf, or NaN, which breaks the trick + used by code on other platforms, so we have to test for each case + manually, and return the appropriate value. */ + if (exponent == FP_ILOGB0) + { + if (isnan (d)) + return (DBL_MANT_DIG - DBL_MIN_EXP) + 2; + if (isinf (d)) + return (DBL_MANT_DIG - DBL_MIN_EXP) + 1; + + return (DBL_MANT_DIG - DBL_MIN_EXP); + } +#endif return (DBL_MIN_EXP - 1 <= exponent && exponent < INT_MAX ? DBL_MANT_DIG - 1 - exponent : (DBL_MANT_DIG - DBL_MIN_EXP diff --git a/src/font.c b/src/font.c index b503123b96e..d423fd46b70 100644 --- a/src/font.c +++ b/src/font.c @@ -5751,6 +5751,9 @@ match. */); #ifdef HAVE_NTGUI syms_of_w32font (); #endif /* HAVE_NTGUI */ +#ifdef USE_BE_CAIRO + syms_of_ftcrfont (); +#endif #endif /* HAVE_WINDOW_SYSTEM */ } diff --git a/src/font.h b/src/font.h index 6694164e09b..2da5ec45047 100644 --- a/src/font.h +++ b/src/font.h @@ -965,7 +965,7 @@ extern struct font_driver const nsfont_driver; extern void syms_of_nsfont (void); extern void syms_of_macfont (void); #endif /* HAVE_NS */ -#ifdef USE_CAIRO +#if defined (USE_CAIRO) || defined (USE_BE_CAIRO) extern struct font_driver const ftcrfont_driver; #ifdef HAVE_HARFBUZZ extern struct font_driver ftcrhbfont_driver; @@ -999,7 +999,7 @@ extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object); INLINE bool font_data_structures_may_be_ill_formed (void) { -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined USE_BE_CAIRO /* Although this works around Bug#20890, it is probably not the right thing to do. */ return gc_in_progress; diff --git a/src/frame.c b/src/frame.c index 79a7c89e0dd..a21dd0d9275 100644 --- a/src/frame.c +++ b/src/frame.c @@ -226,6 +226,7 @@ Value is: `w32' for an Emacs frame that is a window on MS-Windows display, `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, `pc' for a direct-write MS-DOS frame. + `haiku` for an Emacs frame running in Haiku. See also `frame-live-p'. */) (Lisp_Object object) { @@ -244,6 +245,8 @@ See also `frame-live-p'. */) return Qpc; case output_ns: return Qns; + case output_haiku: + return Qhaiku; default: emacs_abort (); } @@ -6020,6 +6023,7 @@ syms_of_frame (void) DEFSYM (Qw32, "w32"); DEFSYM (Qpc, "pc"); DEFSYM (Qns, "ns"); + DEFSYM (Qhaiku, "haiku"); DEFSYM (Qvisible, "visible"); DEFSYM (Qbuffer_predicate, "buffer-predicate"); DEFSYM (Qbuffer_list, "buffer-list"); diff --git a/src/frame.h b/src/frame.h index 3dd76805dd2..cb2bad71c5d 100644 --- a/src/frame.h +++ b/src/frame.h @@ -585,6 +585,7 @@ struct frame struct x_output *x; /* From xterm.h. */ struct w32_output *w32; /* From w32term.h. */ struct ns_output *ns; /* From nsterm.h. */ + struct haiku_output *haiku; /* From haikuterm.h. */ } output_data; @@ -852,6 +853,11 @@ default_pixels_per_inch_y (void) #else #define FRAME_NS_P(f) ((f)->output_method == output_ns) #endif +#ifndef HAVE_HAIKU +#define FRAME_HAIKU_P(f) false +#else +#define FRAME_HAIKU_P(f) ((f)->output_method == output_haiku) +#endif /* FRAME_WINDOW_P tests whether the frame is a graphical window system frame. */ @@ -864,6 +870,9 @@ default_pixels_per_inch_y (void) #ifdef HAVE_NS #define FRAME_WINDOW_P(f) FRAME_NS_P(f) #endif +#ifdef HAVE_HAIKU +#define FRAME_WINDOW_P(f) FRAME_HAIKU_P (f) +#endif #ifndef FRAME_WINDOW_P #define FRAME_WINDOW_P(f) ((void) (f), false) #endif diff --git a/src/ftcrfont.c b/src/ftcrfont.c index db417b3e77d..5d75f183570 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -22,7 +22,13 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" +#ifdef HAVE_X_WINDOWS #include "xterm.h" +#else /* Otherwise, Haiku */ +#include "haikuterm.h" +#include "haiku_support.h" +#include "termchar.h" +#endif #include "blockinput.h" #include "charset.h" #include "composite.h" @@ -30,6 +36,12 @@ along with GNU Emacs. If not, see . */ #include "ftfont.h" #include "pdumper.h" +#ifdef USE_BE_CAIRO +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) +#endif + #define METRICS_NCOLS_PER_ROW (128) enum metrics_status @@ -513,11 +525,37 @@ ftcrfont_draw (struct glyph_string *s, block_input (); +#ifndef USE_BE_CAIRO cr = x_begin_cr_clip (f, s->gc); +#else + BView_draw_lock (FRAME_HAIKU_VIEW (f)); + EmacsWindow_begin_cr_critical_section (FRAME_HAIKU_WINDOW (f)); + cr = haiku_begin_cr_clip (f, s); + if (!cr) + { + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); + EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + return 0; + } + BView_cr_dump_clipping (FRAME_HAIKU_VIEW (f), cr); +#endif if (with_background) { +#ifndef USE_BE_CAIRO x_set_cr_source_with_gc_background (f, s->gc); + s->background_filled_p = 1; +#else + struct face *face = s->face; + + uint32_t col = s->hl == DRAW_CURSOR ? + FRAME_CURSOR_COLOR (s->f).pixel : face->background; + + cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, + GREEN_FROM_ULONG (col) / 255.0, + BLUE_FROM_ULONG (col) / 255.0); +#endif cairo_rectangle (cr, x, y - FONT_BASE (face->font), s->width, FONT_HEIGHT (face->font)); cairo_fill (cr); @@ -533,13 +571,25 @@ ftcrfont_draw (struct glyph_string *s, glyphs[i].index, NULL)); } - +#ifndef USE_BE_CAIRO x_set_cr_source_with_gc_foreground (f, s->gc); +#else + uint32_t col = s->hl == DRAW_CURSOR ? + FRAME_OUTPUT_DATA (s->f)->cursor_fg : face->foreground; + + cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, + GREEN_FROM_ULONG (col) / 255.0, + BLUE_FROM_ULONG (col) / 255.0); +#endif cairo_set_scaled_font (cr, ftcrfont_info->cr_scaled_font); cairo_show_glyphs (cr, glyphs, len); - +#ifndef USE_BE_CAIRO x_end_cr_clip (f); - +#else + haiku_end_cr_clip (cr); + EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); +#endif unblock_input (); return len; diff --git a/src/ftfont.c b/src/ftfont.c index 03e44ec30ee..cf592759ab6 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -3108,6 +3108,10 @@ syms_of_ftfont (void) Fput (Qfreetype, Qfont_driver_superseded_by, Qfreetypehb); #endif /* HAVE_HARFBUZZ */ +#ifdef HAVE_HAIKU + DEFSYM (Qmono, "mono"); +#endif + /* Fontconfig's generic families and their aliases. */ DEFSYM (Qmonospace, "monospace"); DEFSYM (Qsans_serif, "sans-serif"); diff --git a/src/ftfont.h b/src/ftfont.h index f771dc159b0..0e0bebb6f6c 100644 --- a/src/ftfont.h +++ b/src/ftfont.h @@ -29,6 +29,10 @@ along with GNU Emacs. If not, see . */ # include FT_BDF_H #endif +#ifdef USE_BE_CAIRO +#include +#endif + #ifdef HAVE_HARFBUZZ #include #include @@ -62,7 +66,7 @@ struct font_info hb_font_t *hb_font; #endif /* HAVE_HARFBUZZ */ -#ifdef USE_CAIRO +#if defined (USE_CAIRO) || defined (USE_BE_CAIRO) cairo_scaled_font_t *cr_scaled_font; /* Scale factor from the bitmap strike metrics in 1/64 pixels, used as the hb_position_t value in HarfBuzz, to those in (scaled) diff --git a/src/haiku.c b/src/haiku.c new file mode 100644 index 00000000000..485d86983c2 --- /dev/null +++ b/src/haiku.c @@ -0,0 +1,286 @@ +/* Haiku subroutines that are general to the Haiku operating system. + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include "lisp.h" +#include "process.h" +#include "coding.h" + +#include + +#include +#include + +Lisp_Object +list_system_processes (void) +{ + team_info info; + int32 cookie = 0; + Lisp_Object lval = Qnil; + + while (get_next_team_info (&cookie, &info) == B_OK) + lval = Fcons (make_fixnum (info.team), lval); + + return lval; +} + +Lisp_Object +system_process_attributes (Lisp_Object pid) +{ + CHECK_FIXNUM (pid); + + team_info info; + Lisp_Object lval = Qnil; + thread_info inf; + area_info area; + team_id id = (team_id) XFIXNUM (pid); + struct passwd *g; + size_t mem = 0; + + if (get_team_info (id, &info) != B_OK) + return Qnil; + + bigtime_t everything = 0, vsample = 0; + bigtime_t cpu_eaten = 0, esample = 0; + + lval = Fcons (Fcons (Qeuid, make_fixnum (info.uid)), lval); + lval = Fcons (Fcons (Qegid, make_fixnum (info.gid)), lval); + lval = Fcons (Fcons (Qthcount, make_fixnum (info.thread_count)), lval); + lval = Fcons (Fcons (Qcomm, build_string_from_utf8 (info.args)), lval); + + g = getpwuid (info.uid); + + if (g && g->pw_name) + lval = Fcons (Fcons (Quser, build_string (g->pw_name)), lval); + + /* FIXME: Calculating this makes Emacs show up as using 100% CPU! */ + + for (int32 team_cookie = 0; + get_next_team_info (&team_cookie, &info) == B_OK;) + for (int32 thread_cookie = 0; + get_next_thread_info (info.team, &thread_cookie, &inf) == B_OK;) + { + if (inf.team == id && strncmp (inf.name, "idle thread ", 12)) + cpu_eaten += inf.user_time + inf.kernel_time; + everything += inf.user_time + inf.kernel_time; + } + + sleep (0.05); + + for (int32 team_cookie = 0; + get_next_team_info (&team_cookie, &info) == B_OK;) + for (int32 thread_cookie = 0; + get_next_thread_info (info.team, &thread_cookie, &inf) == B_OK;) + { + if (inf.team == id && strncmp (inf.name, "idle thread ", 12)) + esample += inf.user_time + inf.kernel_time; + vsample += inf.user_time + inf.kernel_time; + } + + cpu_eaten = esample - cpu_eaten; + everything = vsample - everything; + + if (everything) + lval = Fcons (Fcons (Qpcpu, make_float (((double) (cpu_eaten) / + (double) (everything)) * 100)), + lval); + else + lval = Fcons (Fcons (Qpcpu, make_float (0.0)), lval); + + for (ssize_t area_cookie = 0; + get_next_area_info (id, &area_cookie, &area) == B_OK;) + mem += area.ram_size; + + system_info sinfo; + get_system_info (&sinfo); + int64 max = (int64) sinfo.max_pages * B_PAGE_SIZE; + + lval = Fcons (Fcons (Qpmem, make_float (((double) mem / + (double) max) * 100)), + lval); + lval = Fcons (Fcons (Qrss, make_fixnum (mem / 1024)), lval); + + return lval; +} + + +/* Borrowed from w32 implementation. */ + +struct load_sample +{ + time_t sample_time; + bigtime_t idle; + bigtime_t kernel; + bigtime_t user; +}; + +/* We maintain 1-sec samples for the last 16 minutes in a circular buffer. */ +static struct load_sample samples[16*60]; +static int first_idx = -1, last_idx = -1; +static int max_idx = ARRAYELTS (samples); +static unsigned num_of_processors = 0; + +static int +buf_next (int from) +{ + int next_idx = from + 1; + + if (next_idx >= max_idx) + next_idx = 0; + + return next_idx; +} + +static int +buf_prev (int from) +{ + int prev_idx = from - 1; + + if (prev_idx < 0) + prev_idx = max_idx - 1; + + return prev_idx; +} + +static double +getavg (int which) +{ + double retval = -1.0; + double tdiff; + int idx; + double span = (which == 0 ? 1.0 : (which == 1 ? 5.0 : 15.0)) * 60; + time_t now = samples[last_idx].sample_time; + + if (first_idx != last_idx) + { + for (idx = buf_prev (last_idx); ; idx = buf_prev (idx)) + { + tdiff = difftime (now, samples[idx].sample_time); + if (tdiff >= span - 2 * DBL_EPSILON * now) + { + long double sys = + (samples[last_idx].kernel + samples[last_idx].user) - + (samples[idx].kernel + samples[idx].user); + long double idl = samples[last_idx].idle - samples[idx].idle; + + retval = (idl / (sys + idl)) * num_of_processors; + break; + } + if (idx == first_idx) + break; + } + } + + return retval; +} + +static void +sample_sys_load (bigtime_t *idle, bigtime_t *system, bigtime_t *user) +{ + bigtime_t i = 0, s = 0, u = 0; + team_info info; + thread_info inf; + + for (int32 team_cookie = 0; + get_next_team_info (&team_cookie, &info) == B_OK;) + for (int32 thread_cookie = 0; + get_next_thread_info (info.team, &thread_cookie, &inf) == B_OK;) + { + if (!strncmp (inf.name, "idle thread ", 12)) + i += inf.user_time + inf.kernel_time; + else + s += inf.kernel_time, u += inf.user_time; + } + + *idle = i; + *system = s; + *user = u; +} + +int +getloadavg (double loadavg[], int nelem) +{ + int elem; + bigtime_t idle, kernel, user; + time_t now = time (NULL); + + if (num_of_processors <= 0) + { + system_info i; + if (get_system_info (&i) == B_OK) + num_of_processors = i.cpu_count; + } + + /* If system time jumped back for some reason, delete all samples + whose time is later than the current wall-clock time. This + prevents load average figures from becoming frozen for prolonged + periods of time, when system time is reset backwards. */ + if (last_idx >= 0) + { + while (difftime (now, samples[last_idx].sample_time) < -1.0) + { + if (last_idx == first_idx) + { + first_idx = last_idx = -1; + break; + } + last_idx = buf_prev (last_idx); + } + } + + /* Store another sample. We ignore samples that are less than 1 sec + apart. */ + if (last_idx < 0 + || (difftime (now, samples[last_idx].sample_time) + >= 1.0 - 2 * DBL_EPSILON * now)) + { + sample_sys_load (&idle, &kernel, &user); + last_idx = buf_next (last_idx); + samples[last_idx].sample_time = now; + samples[last_idx].idle = idle; + samples[last_idx].kernel = kernel; + samples[last_idx].user = user; + /* If the buffer has more that 15 min worth of samples, discard + the old ones. */ + if (first_idx == -1) + first_idx = last_idx; + while (first_idx != last_idx + && (difftime (now, samples[first_idx].sample_time) + >= 15.0 * 60 + 2 * DBL_EPSILON * now)) + first_idx = buf_next (first_idx); + } + + for (elem = 0; elem < nelem; elem++) + { + double avg = getavg (elem); + + if (avg < 0) + break; + loadavg[elem] = avg; + } + + /* Always return at least one element, otherwise load-average + returns nil, and Lisp programs might decide we cannot measure + system load. For example, jit-lock-stealth-load's defcustom + might decide that feature is "unsupported". */ + if (elem == 0) + loadavg[elem++] = 0.09; /* < display-time-load-average-threshold */ + + return elem; +} diff --git a/src/haiku_draw_support.cc b/src/haiku_draw_support.cc new file mode 100644 index 00000000000..5b1eccfbe6e --- /dev/null +++ b/src/haiku_draw_support.cc @@ -0,0 +1,488 @@ +/* Haiku window system support. Hey, Emacs, this is -*- C++ -*- + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include +#include +#include +#include +#include + +#include + +#include "haiku_support.h" + +#define RGB_TO_UINT32(r, g, b) ((255 << 24) | ((r) << 16) | ((g) << 8) | (b)) +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) + +#define RGB_COLOR_UINT32(r) RGB_TO_UINT32 ((r).red, (r).green, (r).blue) + +static void +rgb32_to_rgb_color (uint32_t rgb, rgb_color *color) +{ + color->red = RED_FROM_ULONG (rgb); + color->green = GREEN_FROM_ULONG (rgb); + color->blue = BLUE_FROM_ULONG (rgb); + color->alpha = 255; +} + +static BView * +get_view (void *vw) +{ + BView *view = (BView *) find_appropriate_view_for_draw (vw); + return view; +} + +void +BView_StartClip (void *view) +{ + BView *vw = get_view (view); + vw->PushState (); +} + +void +BView_EndClip (void *view) +{ + BView *vw = get_view (view); + vw->PopState (); +} + +void +BView_SetHighColor (void *view, uint32_t color) +{ + BView *vw = get_view (view); + rgb_color col; + rgb32_to_rgb_color (color, &col); + + vw->SetHighColor (col); +} + +void +BView_SetLowColor (void *view, uint32_t color) +{ + BView *vw = get_view (view); + rgb_color col; + rgb32_to_rgb_color (color, &col); + + vw->SetLowColor (col); +} + +void +BView_SetPenSize (void *view, int u) +{ + BView *vw = get_view (view); + vw->SetPenSize (u); +} + +void +BView_FillRectangle (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->FillRect (rect); +} + +void +BView_FillRectangleAbs (void *view, int x, int y, int x1, int y1) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x1, y1); + + vw->FillRect (rect); +} + +void +BView_StrokeRectangle (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->StrokeRect (rect); +} + +void +BView_SetViewColor (void *view, uint32_t color) +{ + BView *vw = get_view (view); + rgb_color col; + rgb32_to_rgb_color (color, &col); + +#ifndef USE_BE_CAIRO + vw->SetViewColor (col); +#else + vw->SetViewColor (B_TRANSPARENT_32_BIT); +#endif +} + +void +BView_ClipToRect (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->ClipToRect (rect); +} + +void +BView_ClipToInverseRect (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->ClipToInverseRect (rect); +} + +void +BView_StrokeLine (void *view, int sx, int sy, int tx, int ty) +{ + BView *vw = get_view (view); + BPoint from = BPoint (sx, sy); + BPoint to = BPoint (tx, ty); + + vw->StrokeLine (from, to); +} + +void +BView_SetFont (void *view, void *font) +{ + BView *vw = get_view (view); + + vw->SetFont ((BFont *) font); +} + +void +BView_MovePenTo (void *view, int x, int y) +{ + BView *vw = get_view (view); + BPoint pt = BPoint (x, y); + + vw->MovePenTo (pt); +} + +void +BView_DrawString (void *view, const char *chr, ptrdiff_t len) +{ + BView *vw = get_view (view); + + vw->DrawString (chr, len); +} + +void +BView_DrawChar (void *view, char chr) +{ + BView *vw = get_view (view); + + vw->DrawChar (chr); +} + +void +BView_CopyBits (void *view, int x, int y, int width, int height, + int tox, int toy, int towidth, int toheight) +{ + BView *vw = get_view (view); + + vw->CopyBits (BRect (x, y, x + width - 1, y + height - 1), + BRect (tox, toy, tox + towidth - 1, toy + toheight - 1)); + vw->Sync (); +} + +/* Convert RGB32 color color from RGB color space to its + HSL components pointed to by H, S and L. */ +void +rgb_color_hsl (uint32_t rgb, double *h, double *s, double *l) +{ + rgb_color col; + rgb32_to_rgb_color (rgb, &col); + + double red = col.red / 255.0; + double green = col.green / 255.0; + double blue = col.blue / 255.0; + + double max = std::fmax (std::fmax (red, blue), green); + double min = std::fmin (std::fmin (red, blue), green); + double delta = max - min; + *l = (max + min) / 2.0; + + if (!delta) + { + *h = 0; + *s = 0; + return; + } + + *s = (*l < 0.5) ? delta / (max + min) : + delta / (20 - max - min); + double rc = (max - red) / delta; + double gc = (max - green) / delta; + double bc = (max - blue) / delta; + + if (red == max) + *h = bc - gc; + else if (green == max) + *h = 2.0 + rc + -bc; + else + *h = 4.0 + gc + -rc; + *h = std::fmod (*h / 6, 1.0); +} + +static double +hue_to_rgb (double v1, double v2, double h) +{ + if (h < 1 / 6) + return v1 + (v2 - v1) * h * 6.0; + else if (h < 0.5) + return v2; + else if (h < 2.0 / 3) + return v1 + (v2 - v1) * (2.0 / 3 - h) * 6.0; + return v1; +} + +void +hsl_color_rgb (double h, double s, double l, uint32_t *rgb) +{ + if (!s) + *rgb = RGB_TO_UINT32 (std::lrint (l * 255), + std::lrint (l * 255), + std::lrint (l * 255)); + else + { + double m2 = l <= 0.5 ? l * (1 + s) : l + s - l * s; + double m1 = 2.0 * l - m2; + + *rgb = RGB_TO_UINT32 + (std::lrint (hue_to_rgb (m1, m2, + std::fmod (h + 1 / 3.0, 1)) * 255), + std::lrint (hue_to_rgb (m1, m2, h) * 255), + std::lrint (hue_to_rgb (m1, m2, + std::fmod (h - 1 / 3.0, 1)) * 255)); + } +} + +void +BView_DrawBitmap (void *view, void *bitmap, int x, int y, + int width, int height, int vx, int vy, int vwidth, + int vheight) +{ + BView *vw = get_view (view); + BBitmap *bm = (BBitmap *) bitmap; + + vw->PushState (); + vw->SetDrawingMode (B_OP_OVER); + vw->DrawBitmap (bm, BRect (x, y, x + width - 1, y + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); + vw->PopState (); +} + +void +BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x, + int y, int width, int height) +{ + BView *vw = get_view (view); + BBitmap *bm = (BBitmap *) bitmap; + BBitmap bc (bm->Bounds (), B_RGBA32); + BRect rect (x, y, x + width - 1, y + height - 1); + + if (bc.InitCheck () != B_OK || bc.ImportBits (bm) != B_OK) + return; + + uint32_t *bits = (uint32_t *) bc.Bits (); + size_t stride = bc.BytesPerRow (); + + if (bm->ColorSpace () == B_GRAY1) + { + rgb_color low_color = vw->LowColor (); + for (int y = 0; y <= bc.Bounds ().Height (); ++y) + { + for (int x = 0; x <= bc.Bounds ().Width (); ++x) + { + if (bits[y * (stride / 4) + x] == 0xFF000000) + bits[y * (stride / 4) + x] = RGB_COLOR_UINT32 (low_color); + else + bits[y * (stride / 4) + x] = 0; + } + } + } + + vw->PushState (); + vw->SetDrawingMode (bm->ColorSpace () == B_GRAY1 ? B_OP_OVER : B_OP_ERASE); + vw->DrawBitmap (&bc, rect); + vw->PopState (); +} + +void +BView_DrawMask (void *src, void *view, + int x, int y, int width, int height, + int vx, int vy, int vwidth, int vheight, + uint32_t color) +{ + BBitmap *source = (BBitmap *) src; + BBitmap bm (source->Bounds (), B_RGBA32); + if (bm.InitCheck () != B_OK) + return; + for (int y = 0; y <= bm.Bounds ().Height (); ++y) + { + for (int x = 0; x <= bm.Bounds ().Width (); ++x) + { + int bit = haiku_get_pixel ((void *) source, x, y); + + if (!bit) + haiku_put_pixel ((void *) &bm, x, y, ((uint32_t) 255 << 24) | color); + else + haiku_put_pixel ((void *) &bm, x, y, 0); + } + } + BView *vw = get_view (view); + vw->SetDrawingMode (B_OP_OVER); + vw->DrawBitmap (&bm, BRect (x, y, x + width - 1, y + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); +} + +static BBitmap * +rotate_bitmap_270 (BBitmap *bmp) +{ + BRect r = bmp->Bounds (); + BBitmap *bm = new BBitmap (BRect (r.top, r.left, r.bottom, r.right), + bmp->ColorSpace (), true); + if (bm->InitCheck () != B_OK) + gui_abort ("Failed to init bitmap for rotate"); + int w = bmp->Bounds ().Width () + 1; + int h = bmp->Bounds ().Height () + 1; + + for (int y = 0; y < h; ++y) + for (int x = 0; x < w; ++x) + haiku_put_pixel ((void *) bm, y, w - x - 1, + haiku_get_pixel ((void *) bmp, x, y)); + + return bm; +} + +static BBitmap * +rotate_bitmap_90 (BBitmap *bmp) +{ + BRect r = bmp->Bounds (); + BBitmap *bm = new BBitmap (BRect (r.top, r.left, r.bottom, r.right), + bmp->ColorSpace (), true); + if (bm->InitCheck () != B_OK) + gui_abort ("Failed to init bitmap for rotate"); + int w = bmp->Bounds ().Width () + 1; + int h = bmp->Bounds ().Height () + 1; + + for (int y = 0; y < h; ++y) + for (int x = 0; x < w; ++x) + haiku_put_pixel ((void *) bm, h - y - 1, x, + haiku_get_pixel ((void *) bmp, x, y)); + + return bm; +} + +void * +BBitmap_transform_bitmap (void *bitmap, void *mask, uint32_t m_color, + double rot, int desw, int desh) +{ + BBitmap *bm = (BBitmap *) bitmap; + BBitmap *mk = (BBitmap *) mask; + int copied_p = 0; + + if (rot == 90) + { + copied_p = 1; + bm = rotate_bitmap_90 (bm); + if (mk) + mk = rotate_bitmap_90 (mk); + } + + if (rot == 270) + { + copied_p = 1; + bm = rotate_bitmap_270 (bm); + if (mk) + mk = rotate_bitmap_270 (mk); + } + + BRect r = bm->Bounds (); + if (r.Width () != desw || r.Height () != desh) + { + BRect n = BRect (0, 0, desw - 1, desh - 1); + BView vw (n, NULL, B_FOLLOW_NONE, 0); + BBitmap *dst = new BBitmap (n, bm->ColorSpace (), true); + if (dst->InitCheck () != B_OK) + if (bm->InitCheck () != B_OK) + gui_abort ("Failed to init bitmap for scale"); + dst->AddChild (&vw); + + if (!vw.LockLooper ()) + gui_abort ("Failed to lock offscreen view for scale"); + + if (rot != 90 && rot != 270) + { + BAffineTransform tr; + tr.RotateBy (BPoint (desw / 2, desh / 2), rot * M_PI / 180.0); + vw.SetTransform (tr); + } + + vw.MovePenTo (0, 0); + vw.DrawBitmap (bm, n); + if (mk) + BView_DrawMask ((void *) mk, (void *) &vw, + 0, 0, mk->Bounds ().Width (), + mk->Bounds ().Height (), + 0, 0, desw, desh, m_color); + vw.Sync (); + vw.RemoveSelf (); + + if (copied_p) + delete bm; + if (copied_p && mk) + delete mk; + return dst; + } + + return bm; +} + +void +BView_FillTriangle (void *view, int x1, int y1, + int x2, int y2, int x3, int y3) +{ + BView *vw = get_view (view); + vw->FillTriangle (BPoint (x1, y1), BPoint (x2, y2), + BPoint (x3, y3)); +} + +void +BView_SetHighColorForVisibleBell (void *view, uint32_t color) +{ + BView *vw = (BView *) view; + rgb_color col; + rgb32_to_rgb_color (color, &col); + + vw->SetHighColor (col); +} + +void +BView_FillRectangleForVisibleBell (void *view, int x, int y, int width, int height) +{ + BView *vw = (BView *) view; + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->FillRect (rect); +} diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc new file mode 100644 index 00000000000..9ac0400969b --- /dev/null +++ b/src/haiku_font_support.cc @@ -0,0 +1,596 @@ +/* Haiku window system support. Hey, Emacs, this is -*- C++ -*- + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include +#include +#include + +#include +#include + +#include "haiku_support.h" + +/* Haiku doesn't expose font language data in BFont objects. Thus, we + select a few representative characters for each supported `:lang' + (currently Chinese, Korean and Japanese,) and test for those + instead. */ + +static uint32_t language_code_points[MAX_LANGUAGE][4] = + {{20154, 20754, 22996, 0}, /* Chinese. */ + {51312, 49440, 44544, 0}, /* Korean. */ + {26085, 26412, 12371, 0}, /* Japanese. */}; + +static void +estimate_font_ascii (BFont *font, int *max_width, + int *min_width, int *avg_width) +{ + char ch[2]; + bool tems[1]; + int total = 0; + int count = 0; + int min = 0; + int max = 0; + + std::memset (ch, 0, sizeof ch); + for (ch[0] = 32; ch[0] < 127; ++ch[0]) + { + tems[0] = false; + font->GetHasGlyphs (ch, 1, tems); + if (tems[0]) + { + int w = font->StringWidth (ch); + ++count; + total += w; + + if (!min || min > w) + min = w; + if (max < w) + max = w; + } + } + + *min_width = min; + *max_width = max; + *avg_width = total / count; +} + +void +BFont_close (void *font) +{ + if (font != (void *) be_fixed_font && + font != (void *) be_plain_font && + font != (void *) be_bold_font) + delete (BFont *) font; +} + +void +BFont_dat (void *font, int *px_size, int *min_width, int *max_width, + int *avg_width, int *height, int *space_width, int *ascent, + int *descent, int *underline_position, int *underline_thickness) +{ + BFont *ft = (BFont *) font; + struct font_height fheight; + bool have_space_p; + + char atem[1]; + bool otem[1]; + + ft->GetHeight (&fheight); + atem[0] = ' '; + otem[0] = false; + ft->GetHasGlyphs (atem, 1, otem); + have_space_p = otem[0]; + + estimate_font_ascii (ft, max_width, min_width, avg_width); + *ascent = std::lrint (fheight.ascent); + *descent = std::lrint (fheight.descent); + *height = *ascent + *descent; + + *space_width = have_space_p ? ft->StringWidth (" ") : 0; + + *px_size = std::lrint (ft->Size ()); + *underline_position = 0; + *underline_thickness = 0; +} + +/* Return non-null if FONT contains CHR, a Unicode code-point. */ +int +BFont_have_char_p (void *font, int32_t chr) +{ + BFont *ft = (BFont *) font; + return ft->IncludesBlock (chr, chr); +} + +/* Return non-null if font contains a block from BEG to END. */ +int +BFont_have_char_block (void *font, int32_t beg, int32_t end) +{ + BFont *ft = (BFont *) font; + return ft->IncludesBlock (beg, end); +} + +/* Compute bounds for MB_STR, a character in multibyte encoding, + used with font. The width (in pixels) is returned in ADVANCE, + the left bearing in LB, and the right bearing in RB. */ +void +BFont_char_bounds (void *font, const char *mb_str, int *advance, + int *lb, int *rb) +{ + BFont *ft = (BFont *) font; + edge_info edge_info; + float size, escapement; + size = ft->Size (); + + ft->GetEdges (mb_str, 1, &edge_info); + ft->GetEscapements (mb_str, 1, &escapement); + *advance = std::lrint (escapement * size); + *lb = std::lrint (edge_info.left * size); + *rb = *advance + std::lrint (edge_info.right * size); +} + +/* The same, but for a variable amount of chars. */ +void +BFont_nchar_bounds (void *font, const char *mb_str, int *advance, + int *lb, int *rb, int32_t n) +{ + BFont *ft = (BFont *) font; + edge_info edge_info[n]; + float size; + float escapement[n]; + + size = ft->Size (); + + ft->GetEdges (mb_str, n, edge_info); + ft->GetEscapements (mb_str, n, (float *) escapement); + + for (int32_t i = 0; i < n; ++i) + { + advance[i] = std::lrint (escapement[i] * size); + lb[i] = advance[i] - std::lrint (edge_info[i].left * size); + rb[i] = advance[i] + std::lrint (edge_info[i].right * size); + } +} + +static void +font_style_to_flags (char *st, struct haiku_font_pattern *pattern) +{ + char *style = strdup (st); + char *token; + pattern->weight = -1; + pattern->width = NO_WIDTH; + pattern->slant = NO_SLANT; + int tok = 0; + + while ((token = std::strtok (!tok ? style : NULL, " ")) && tok < 3) + { + if (token && !strcmp (token, "Thin")) + pattern->weight = HAIKU_THIN; + else if (token && !strcmp (token, "UltraLight")) + pattern->weight = HAIKU_ULTRALIGHT; + else if (token && !strcmp (token, "ExtraLight")) + pattern->weight = HAIKU_EXTRALIGHT; + else if (token && !strcmp (token, "Light")) + pattern->weight = HAIKU_LIGHT; + else if (token && !strcmp (token, "SemiLight")) + pattern->weight = HAIKU_SEMI_LIGHT; + else if (token && !strcmp (token, "Regular")) + { + if (pattern->slant == NO_SLANT) + pattern->slant = SLANT_REGULAR; + + if (pattern->width == NO_WIDTH) + pattern->width = NORMAL_WIDTH; + + if (pattern->weight == -1) + pattern->weight = HAIKU_REGULAR; + } + else if (token && !strcmp (token, "SemiBold")) + pattern->weight = HAIKU_SEMI_BOLD; + else if (token && !strcmp (token, "Bold")) + pattern->weight = HAIKU_BOLD; + else if (token && (!strcmp (token, "ExtraBold") || + /* This has actually been seen in the wild. */ + !strcmp (token, "Extrabold"))) + pattern->weight = HAIKU_EXTRA_BOLD; + else if (token && !strcmp (token, "UltraBold")) + pattern->weight = HAIKU_ULTRA_BOLD; + else if (token && !strcmp (token, "Book")) + pattern->weight = HAIKU_BOOK; + else if (token && !strcmp (token, "Heavy")) + pattern->weight = HAIKU_HEAVY; + else if (token && !strcmp (token, "UltraHeavy")) + pattern->weight = HAIKU_ULTRA_HEAVY; + else if (token && !strcmp (token, "Black")) + pattern->weight = HAIKU_BLACK; + else if (token && !strcmp (token, "Medium")) + pattern->weight = HAIKU_MEDIUM; + else if (token && !strcmp (token, "Oblique")) + pattern->slant = SLANT_OBLIQUE; + else if (token && !strcmp (token, "Italic")) + pattern->slant = SLANT_ITALIC; + else if (token && !strcmp (token, "UltraCondensed")) + pattern->width = ULTRA_CONDENSED; + else if (token && !strcmp (token, "ExtraCondensed")) + pattern->width = EXTRA_CONDENSED; + else if (token && !strcmp (token, "Condensed")) + pattern->width = CONDENSED; + else if (token && !strcmp (token, "SemiCondensed")) + pattern->width = SEMI_CONDENSED; + else if (token && !strcmp (token, "SemiExpanded")) + pattern->width = SEMI_EXPANDED; + else if (token && !strcmp (token, "Expanded")) + pattern->width = EXPANDED; + else if (token && !strcmp (token, "ExtraExpanded")) + pattern->width = EXTRA_EXPANDED; + else if (token && !strcmp (token, "UltraExpanded")) + pattern->width = ULTRA_EXPANDED; + else + { + tok = 1000; + break; + } + tok++; + } + + if (pattern->weight != -1) + pattern->specified |= FSPEC_WEIGHT; + if (pattern->slant != NO_SLANT) + pattern->specified |= FSPEC_SLANT; + if (pattern->width != NO_WIDTH) + pattern->specified |= FSPEC_WIDTH; + + if (tok > 3) + { + pattern->specified &= ~FSPEC_SLANT; + pattern->specified &= ~FSPEC_WEIGHT; + pattern->specified &= ~FSPEC_WIDTH; + pattern->specified |= FSPEC_STYLE; + std::strncpy ((char *) &pattern->style, st, + sizeof pattern->style - 1); + } + + free (style); +} + +static bool +font_check_wanted_chars (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont ft; + + if (ft.SetFamilyAndStyle (family, style) != B_OK) + return false; + + for (int i = 0; i < pattern->want_chars_len; ++i) + if (!ft.IncludesBlock (pattern->wanted_chars[i], + pattern->wanted_chars[i])) + return false; + + return true; +} + +static bool +font_check_one_of (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont ft; + + if (ft.SetFamilyAndStyle (family, style) != B_OK) + return false; + + for (int i = 0; i < pattern->need_one_of_len; ++i) + if (ft.IncludesBlock (pattern->need_one_of[i], + pattern->need_one_of[i])) + return true; + + return false; +} + +static bool +font_check_language (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont ft; + + if (ft.SetFamilyAndStyle (family, style) != B_OK) + return false; + + if (pattern->language == MAX_LANGUAGE) + return false; + + for (uint32_t *ch = (uint32_t *) + &language_code_points[pattern->language]; *ch; ch++) + if (!ft.IncludesBlock (*ch, *ch)) + return false; + + return true; +} + +static bool +font_family_style_matches_p (font_family family, char *style, uint32_t flags, + struct haiku_font_pattern *pattern, + int ignore_flags_p = 0) +{ + struct haiku_font_pattern m; + m.specified = 0; + + if (style) + font_style_to_flags (style, &m); + + if ((pattern->specified & FSPEC_FAMILY) && + strcmp ((char *) &pattern->family, family)) + return false; + + if (!ignore_flags_p && (pattern->specified & FSPEC_SPACING) && + !(pattern->mono_spacing_p) != !(flags & B_IS_FIXED)) + return false; + + if (pattern->specified & FSPEC_STYLE) + return style && !strcmp (style, pattern->style); + + if ((pattern->specified & FSPEC_WEIGHT) + && (pattern->weight + != ((m.specified & FSPEC_WEIGHT) ? m.weight : HAIKU_REGULAR))) + return false; + + if ((pattern->specified & FSPEC_SLANT) + && (pattern->slant + != ((m.specified & FSPEC_SLANT) ? m.slant : SLANT_REGULAR))) + return false; + + if ((pattern->specified & FSPEC_WANTED) + && !font_check_wanted_chars (pattern, family, style)) + return false; + + if ((pattern->specified & FSPEC_WIDTH) + && (pattern->width != + ((m.specified & FSPEC_WIDTH) ? m.width : NORMAL_WIDTH))) + return false; + + if ((pattern->specified & FSPEC_NEED_ONE_OF) + && !font_check_one_of (pattern, family, style)) + return false; + + if ((pattern->specified & FSPEC_LANGUAGE) + && !font_check_language (pattern, family, style)) + return false; + + return true; +} + +static void +haiku_font_fill_pattern (struct haiku_font_pattern *pattern, + font_family family, char *style, + uint32_t flags) +{ + if (style) + font_style_to_flags (style, pattern); + + pattern->specified |= FSPEC_FAMILY; + std::strncpy (pattern->family, family, + sizeof pattern->family - 1); + pattern->specified |= FSPEC_SPACING; + pattern->mono_spacing_p = flags & B_IS_FIXED; +} + +/* Delete every element of the font pattern PT. */ +void +haiku_font_pattern_free (struct haiku_font_pattern *pt) +{ + struct haiku_font_pattern *tem = pt; + while (tem) + { + struct haiku_font_pattern *t = tem; + tem = t->next; + delete t; + } +} + +/* Find all fonts matching the font pattern PT. */ +struct haiku_font_pattern * +BFont_find (struct haiku_font_pattern *pt) +{ + struct haiku_font_pattern *r = NULL; + font_family name; + font_style sname; + uint32 flags; + int sty_count; + int fam_count = count_font_families (); + + for (int fi = 0; fi < fam_count; ++fi) + { + if (get_font_family (fi, &name, &flags) == B_OK) + { + sty_count = count_font_styles (name); + if (!sty_count && + font_family_style_matches_p (name, NULL, flags, pt)) + { + struct haiku_font_pattern *p = new struct haiku_font_pattern; + p->specified = 0; + p->oblique_seen_p = 1; + haiku_font_fill_pattern (p, name, NULL, flags); + p->next = r; + if (p->next) + p->next->last = p; + p->last = NULL; + p->next_family = r; + r = p; + } + else if (sty_count) + { + for (int si = 0; si < sty_count; ++si) + { + int oblique_seen_p = 0; + struct haiku_font_pattern *head = r; + struct haiku_font_pattern *p = NULL; + + if (get_font_style (name, si, &sname, &flags) == B_OK) + { + if (font_family_style_matches_p (name, (char *) &sname, flags, pt)) + { + p = new struct haiku_font_pattern; + p->specified = 0; + haiku_font_fill_pattern (p, name, (char *) &sname, flags); + if (p->specified & FSPEC_SLANT && + ((p->slant == SLANT_OBLIQUE) || (p->slant == SLANT_ITALIC))) + oblique_seen_p = 1; + + p->next = r; + if (p->next) + p->next->last = p; + r = p; + p->next_family = head; + } + } + + if (p) + p->last = NULL; + + for (; head; head = head->last) + { + head->oblique_seen_p = oblique_seen_p; + } + } + } + } + } + + /* There's a very good chance that this result will get cached if no + slant is specified. Thus, we look through each font that hasn't + seen an oblique style, and add one. */ + + if (!(pt->specified & FSPEC_SLANT)) + { + /* r->last is invalid from here onwards. */ + for (struct haiku_font_pattern *p = r; p;) + { + if (!p->oblique_seen_p) + { + struct haiku_font_pattern *n = new haiku_font_pattern; + *n = *p; + n->slant = SLANT_OBLIQUE; + p->next = n; + p = p->next_family; + } + else + p = p->next_family; + } + } + + return r; +} + +/* Find and open a font matching the pattern PAT, which must have its + family set. */ +int +BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) +{ + int sty_count; + font_family name; + font_style sname; + uint32 flags = 0; + if (!(pat->specified & FSPEC_FAMILY)) + return 1; + strncpy (name, pat->family, sizeof name - 1); + sty_count = count_font_styles (name); + + if (!sty_count && + font_family_style_matches_p (name, NULL, flags, pat, 1)) + { + BFont *ft = new BFont; + if (ft->SetFamilyAndStyle (name, NULL) != B_OK) + { + delete ft; + return 1; + } + ft->SetSize (size); + ft->SetEncoding (B_UNICODE_UTF8); + ft->SetSpacing (B_BITMAP_SPACING); + *font = (void *) ft; + return 0; + } + else if (sty_count) + { + for (int si = 0; si < sty_count; ++si) + { + if (get_font_style (name, si, &sname, &flags) == B_OK && + font_family_style_matches_p (name, (char *) &sname, flags, pat)) + { + BFont *ft = new BFont; + if (ft->SetFamilyAndStyle (name, sname) != B_OK) + { + delete ft; + return 1; + } + ft->SetSize (size); + ft->SetEncoding (B_UNICODE_UTF8); + ft->SetSpacing (B_BITMAP_SPACING); + *font = (void *) ft; + return 0; + } + } + } + + if (pat->specified & FSPEC_SLANT && pat->slant == SLANT_OBLIQUE) + { + struct haiku_font_pattern copy = *pat; + copy.slant = SLANT_REGULAR; + int code = BFont_open_pattern (©, font, size); + if (code) + return code; + BFont *ft = (BFont *) *font; + /* XXX Font measurements don't respect shear. Haiku bug? + This apparently worked in BeOS. + ft->SetShear (100.0); */ + ft->SetFace (B_ITALIC_FACE); + return 0; + } + + return 1; +} + +/* Query the family of the default fixed font. */ +void +BFont_populate_fixed_family (struct haiku_font_pattern *ptn) +{ + font_family f; + font_style s; + be_fixed_font->GetFamilyAndStyle (&f, &s); + + ptn->specified |= FSPEC_FAMILY; + strncpy (ptn->family, f, sizeof ptn->family - 1); +} + +void +BFont_populate_plain_family (struct haiku_font_pattern *ptn) +{ + font_family f; + font_style s; + be_plain_font->GetFamilyAndStyle (&f, &s); + + ptn->specified |= FSPEC_FAMILY; + strncpy (ptn->family, f, sizeof ptn->family - 1); +} + +int +BFont_string_width (void *font, const char *utf8) +{ + return ((BFont *) font)->StringWidth (utf8); +} diff --git a/src/haiku_io.c b/src/haiku_io.c new file mode 100644 index 00000000000..c152d9b086a --- /dev/null +++ b/src/haiku_io.c @@ -0,0 +1,207 @@ +/* Haiku window system support. + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include +#include +#include +#include + +#include + +#include "haiku_support.h" +#include "lisp.h" +#include "haikuterm.h" +#include "blockinput.h" + +#define PORT_CAP 1200 + +/* The port used to send messages from the application thread to + Emacs. */ +port_id port_application_to_emacs; + +void +haiku_io_init (void) +{ + port_application_to_emacs = create_port (PORT_CAP, "application emacs port"); +} + +static ssize_t +haiku_len (enum haiku_event_type type) +{ + switch (type) + { + case QUIT_REQUESTED: + return sizeof (struct haiku_quit_requested_event); + case FRAME_RESIZED: + return sizeof (struct haiku_resize_event); + case FRAME_EXPOSED: + return sizeof (struct haiku_expose_event); + case KEY_DOWN: + case KEY_UP: + return sizeof (struct haiku_key_event); + case ACTIVATION: + return sizeof (struct haiku_activation_event); + case MOUSE_MOTION: + return sizeof (struct haiku_mouse_motion_event); + case BUTTON_DOWN: + case BUTTON_UP: + return sizeof (struct haiku_button_event); + case ICONIFICATION: + return sizeof (struct haiku_iconification_event); + case MOVE_EVENT: + return sizeof (struct haiku_move_event); + case SCROLL_BAR_VALUE_EVENT: + return sizeof (struct haiku_scroll_bar_value_event); + case SCROLL_BAR_DRAG_EVENT: + return sizeof (struct haiku_scroll_bar_drag_event); + case WHEEL_MOVE_EVENT: + return sizeof (struct haiku_wheel_move_event); + case MENU_BAR_RESIZE: + return sizeof (struct haiku_menu_bar_resize_event); + case MENU_BAR_OPEN: + case MENU_BAR_CLOSE: + return sizeof (struct haiku_menu_bar_state_event); + case MENU_BAR_SELECT_EVENT: + return sizeof (struct haiku_menu_bar_select_event); + case FILE_PANEL_EVENT: + return sizeof (struct haiku_file_panel_event); + case MENU_BAR_HELP_EVENT: + return sizeof (struct haiku_menu_bar_help_event); + case ZOOM_EVENT: + return sizeof (struct haiku_zoom_event); + case REFS_EVENT: + return sizeof (struct haiku_refs_event); + case APP_QUIT_REQUESTED_EVENT: + return sizeof (struct haiku_app_quit_requested_event); + } + + emacs_abort (); +} + +/* Read the size of the next message into len, returning -1 if the + query fails or there is no next message. */ +void +haiku_read_size (ssize_t *len) +{ + port_id from = port_application_to_emacs; + ssize_t size; + + size = port_buffer_size_etc (from, B_TIMEOUT, 0); + + if (size < B_OK) + *len = -1; + else + *len = size; +} + +/* Read the next message into BUF, putting its type into TYPE, + assuming the message is at most LEN long. Return 0 if successful + and -1 if the read fails. */ +int +haiku_read (enum haiku_event_type *type, void *buf, ssize_t len) +{ + int32 typ; + port_id from = port_application_to_emacs; + + if (read_port (from, &typ, buf, len) < B_OK) + return -1; + + *type = (enum haiku_event_type) typ; + eassert (len >= haiku_len (typ)); + return 0; +} + +/* The same as haiku_read, but time out after TIMEOUT microseconds. + Input is blocked when an attempt to read is in progress. */ +int +haiku_read_with_timeout (enum haiku_event_type *type, void *buf, ssize_t len, + time_t timeout) +{ + int32 typ; + port_id from = port_application_to_emacs; + + block_input (); + if (read_port_etc (from, &typ, buf, len, + B_TIMEOUT, (bigtime_t) timeout) < B_OK) + { + unblock_input (); + return -1; + } + unblock_input (); + *type = (enum haiku_event_type) typ; + eassert (len >= haiku_len (typ)); + return 0; +} + +/* Write a message with type TYPE into BUF. */ +int +haiku_write (enum haiku_event_type type, void *buf) +{ + port_id to = port_application_to_emacs; + + if (write_port (to, (int32_t) type, buf, haiku_len (type)) < B_OK) + return -1; + + kill (getpid (), SIGPOLL); + + return 0; +} + +int +haiku_write_without_signal (enum haiku_event_type type, void *buf) +{ + port_id to = port_application_to_emacs; + + if (write_port (to, (int32_t) type, buf, haiku_len (type)) < B_OK) + return -1; + + return 0; +} + +void +haiku_io_init_in_app_thread (void) +{ + sigset_t set; + sigfillset (&set); + + if (pthread_sigmask (SIG_BLOCK, &set, NULL)) + perror ("pthread_sigmask"); +} + +/* Record an unwind protect from C++ code. */ +void +record_c_unwind_protect_from_cxx (void (*fn) (void *), void *r) +{ + record_unwind_protect_ptr (fn, r); +} + +/* SPECPDL_IDX that is safe from C++ code. */ +ptrdiff_t +c_specpdl_idx_from_cxx (void) +{ + return SPECPDL_INDEX (); +} + +/* unbind_to (IDX, Qnil), but safe from C++ code. */ +void +c_unbind_to_nil_from_cxx (ptrdiff_t idx) +{ + unbind_to (idx, Qnil); +} diff --git a/src/haiku_select.cc b/src/haiku_select.cc new file mode 100644 index 00000000000..8d345ca6617 --- /dev/null +++ b/src/haiku_select.cc @@ -0,0 +1,155 @@ +/* Haiku window system selection support. Hey Emacs, this is -*- C++ -*- + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include + +#include +#include + +#include "haikuselect.h" + + +static BClipboard *primary = NULL; +static BClipboard *secondary = NULL; +static BClipboard *system_clipboard = NULL; + +int selection_state_flag; + +static char * +BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) +{ + if (!cb->Lock ()) + return 0; + + BMessage *dat = cb->Data (); + if (!dat) + { + cb->Unlock (); + return 0; + } + + const char *ptr; + ssize_t bt; + dat->FindData (type, B_MIME_TYPE, (const void **) &ptr, &bt); + + if (!ptr) + { + cb->Unlock (); + return NULL; + } + + if (len) + *len = bt; + + cb->Unlock (); + + return strndup (ptr, bt); +} + +static void +BClipboard_set_data (BClipboard *cb, const char *type, const char *dat, + ssize_t len) +{ + if (!cb->Lock ()) + return; + cb->Clear (); + BMessage *mdat = cb->Data (); + if (!mdat) + { + cb->Unlock (); + return; + } + + if (dat) + mdat->AddData (type, B_MIME_TYPE, dat, len); + cb->Commit (); + cb->Unlock (); +} + +char * +BClipboard_find_system_data (const char *type, ssize_t *len) +{ + if (!system_clipboard) + return 0; + + return BClipboard_find_data (system_clipboard, type, len); +} + +char * +BClipboard_find_primary_selection_data (const char *type, ssize_t *len) +{ + if (!primary) + return 0; + + return BClipboard_find_data (primary, type, len); +} + +char * +BClipboard_find_secondary_selection_data (const char *type, ssize_t *len) +{ + if (!secondary) + return 0; + + return BClipboard_find_data (secondary, type, len); +} + +void +BClipboard_set_system_data (const char *type, const char *data, + ssize_t len) +{ + if (!system_clipboard) + return; + + BClipboard_set_data (system_clipboard, type, data, len); +} + +void +BClipboard_set_primary_selection_data (const char *type, const char *data, + ssize_t len) +{ + if (!primary) + return; + + BClipboard_set_data (primary, type, data, len); +} + +void +BClipboard_set_secondary_selection_data (const char *type, const char *data, + ssize_t len) +{ + if (!secondary) + return; + + BClipboard_set_data (secondary, type, data, len); +} + +void +BClipboard_free_data (void *ptr) +{ + std::free (ptr); +} + +void +init_haiku_select (void) +{ + system_clipboard = new BClipboard ("system"); + primary = new BClipboard ("primary"); + secondary = new BClipboard ("secondary"); +} diff --git a/src/haiku_support.cc b/src/haiku_support.cc new file mode 100644 index 00000000000..99d4ee79140 --- /dev/null +++ b/src/haiku_support.cc @@ -0,0 +1,2930 @@ +/* Haiku window system support. Hey, Emacs, this is -*- C++ -*- + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include + +#include +#include + +#include +#include +#include +#include +#include +#include + +#include +#include +#include + +#include +#include +#include + +#include +#include +#include + +#include + +#include +#include +#include +#include +#include +#include + +#include + +#ifdef USE_BE_CAIRO +#include +#endif + +#include "haiku_support.h" + +#define SCROLL_BAR_UPDATE 3000 + +static color_space dpy_color_space = B_NO_COLOR_SPACE; +static key_map *key_map = NULL; +static char *key_chars = NULL; +static BLocker key_map_lock; + +extern "C" +{ + extern _Noreturn void emacs_abort (void); + /* Also defined in haikuterm.h. */ + extern void be_app_quit (void); +} + +static thread_id app_thread; + +_Noreturn void +gui_abort (const char *msg) +{ + fprintf (stderr, "Abort in GUI code: %s\n", msg); + fprintf (stderr, "Under Haiku, Emacs cannot recover from errors in GUI code\n"); + fprintf (stderr, "App Server disconnects usually manifest as bitmap " + "initialization failures or lock failures."); + emacs_abort (); +} + +#ifdef USE_BE_CAIRO +static cairo_format_t +cairo_format_from_color_space (color_space space) +{ + switch (space) + { + case B_RGBA32: + return CAIRO_FORMAT_ARGB32; + case B_RGB32: + return CAIRO_FORMAT_RGB24; + case B_RGB16: + return CAIRO_FORMAT_RGB16_565; + case B_GRAY8: + return CAIRO_FORMAT_A8; + case B_GRAY1: + return CAIRO_FORMAT_A1; + default: + gui_abort ("Unsupported color space"); + } +} +#endif + +static void +map_key (char *chars, int32 offset, uint32_t *c) +{ + int size = chars[offset++]; + switch (size) + { + case 0: + break; + + case 1: + *c = chars[offset]; + break; + + default: + { + char str[5]; + int i = (size <= 4) ? size : 4; + strncpy (str, &(chars[offset]), i); + str[i] = '0'; + *c = BUnicodeChar::FromUTF8 ((char *) &str); + break; + } + } +} + +static void +map_shift (uint32_t kc, uint32_t *ch) +{ + if (!key_map_lock.Lock ()) + gui_abort ("Failed to lock keymap"); + if (!key_map) + get_key_map (&key_map, &key_chars); + if (!key_map) + return; + if (kc >= 128) + return; + + int32_t m = key_map->shift_map[kc]; + map_key (key_chars, m, ch); + key_map_lock.Unlock (); +} + +static void +map_normal (uint32_t kc, uint32_t *ch) +{ + if (!key_map_lock.Lock ()) + gui_abort ("Failed to lock keymap"); + if (!key_map) + get_key_map (&key_map, &key_chars); + if (!key_map) + return; + if (kc >= 128) + return; + + int32_t m = key_map->normal_map[kc]; + map_key (key_chars, m, ch); + key_map_lock.Unlock (); +} + +class Emacs : public BApplication +{ +public: + Emacs () : BApplication ("application/x-vnd.GNU-emacs") + { + } + + void + AboutRequested (void) + { + BAlert *about = new BAlert (PACKAGE_NAME, + PACKAGE_STRING + "\nThe extensible, self-documenting, real-time display editor.", + "Close"); + about->Go (); + } + + bool + QuitRequested (void) + { + struct haiku_app_quit_requested_event rq; + haiku_write (APP_QUIT_REQUESTED_EVENT, &rq); + return 0; + } + + void + RefsReceived (BMessage *msg) + { + struct haiku_refs_event rq; + entry_ref ref; + BEntry entry; + BPath path; + int32 cookie = 0; + int32 x, y; + void *window; + + if ((msg->FindPointer ("window", 0, &window) != B_OK) + || (msg->FindInt32 ("x", 0, &x) != B_OK) + || (msg->FindInt32 ("y", 0, &y) != B_OK)) + return; + + rq.window = window; + rq.x = x; + rq.y = y; + + while (msg->FindRef ("refs", cookie++, &ref) == B_OK) + { + if (entry.SetTo (&ref, 0) == B_OK + && entry.GetPath (&path) == B_OK) + { + rq.ref = strdup (path.Path ()); + haiku_write (REFS_EVENT, &rq); + } + } + } +}; + +class EmacsWindow : public BDirectWindow +{ +public: + struct child_frame + { + struct child_frame *next; + int xoff, yoff; + EmacsWindow *window; + } *subset_windows = NULL; + + EmacsWindow *parent = NULL; + BRect pre_fullscreen_rect; + BRect pre_zoom_rect; + int x_before_zoom = INT_MIN; + int y_before_zoom = INT_MIN; + int fullscreen_p = 0; + int zoomed_p = 0; + int shown_flag = 0; + +#ifdef USE_BE_CAIRO + BLocker surface_lock; + cairo_surface_t *cr_surface = NULL; +#endif + + EmacsWindow () : BDirectWindow (BRect (0, 0, 0, 0), "", B_TITLED_WINDOW_LOOK, + B_NORMAL_WINDOW_FEEL, B_NO_SERVER_SIDE_WINDOW_MODIFIERS) + { + + } + + ~EmacsWindow () + { + struct child_frame *next; + for (struct child_frame *f = subset_windows; f; f = next) + { + f->window->Unparent (); + next = f->next; + delete f; + } + + if (this->parent) + UnparentAndUnlink (); + +#ifdef USE_BE_CAIRO + if (!surface_lock.Lock ()) + gui_abort ("Failed to lock cairo surface"); + if (cr_surface) + { + cairo_surface_destroy (cr_surface); + cr_surface = NULL; + } + surface_lock.Unlock (); +#endif + } + + void + UpwardsSubset (EmacsWindow *w) + { + for (; w; w = w->parent) + AddToSubset (w); + } + + void + UpwardsSubsetChildren (EmacsWindow *w) + { + UpwardsSubset (w); + for (struct child_frame *f = subset_windows; f; + f = f->next) + f->window->UpwardsSubsetChildren (w); + } + + void + UpwardsUnSubset (EmacsWindow *w) + { + for (; w; w = w->parent) + RemoveFromSubset (w); + } + + void + UpwardsUnSubsetChildren (EmacsWindow *w) + { + UpwardsUnSubset (w); + for (struct child_frame *f = subset_windows; f; + f = f->next) + f->window->UpwardsUnSubsetChildren (w); + } + + void + Unparent (void) + { + this->SetFeel (B_NORMAL_WINDOW_FEEL); + UpwardsUnSubsetChildren (parent); + this->RemoveFromSubset (this); + this->parent = NULL; + if (fullscreen_p) + { + fullscreen_p = 0; + MakeFullscreen (1); + } + } + + void + UnparentAndUnlink (void) + { + this->parent->UnlinkChild (this); + this->Unparent (); + } + + void + UnlinkChild (EmacsWindow *window) + { + struct child_frame *last = NULL; + struct child_frame *tem = subset_windows; + + for (; tem; last = tem, tem = tem->next) + { + if (tem->window == window) + { + if (last) + last->next = tem->next; + if (tem == subset_windows) + subset_windows = NULL; + delete tem; + return; + } + } + + gui_abort ("Failed to unlink child frame"); + } + + void + ParentTo (EmacsWindow *window) + { + if (this->parent) + UnparentAndUnlink (); + + this->parent = window; + this->SetFeel (B_FLOATING_SUBSET_WINDOW_FEEL); + this->AddToSubset (this); + if (!IsHidden () && this->parent) + UpwardsSubsetChildren (parent); + if (fullscreen_p) + { + fullscreen_p = 0; + MakeFullscreen (1); + } + this->Sync (); + window->LinkChild (this); + } + + void + LinkChild (EmacsWindow *window) + { + struct child_frame *f = new struct child_frame; + + for (struct child_frame *f = subset_windows; f; + f = f->next) + { + if (window == f->window) + gui_abort ("Trying to link a child frame that is already present"); + } + + f->window = window; + f->next = subset_windows; + f->xoff = -1; + f->yoff = -1; + + subset_windows = f; + } + + void + DoMove (struct child_frame *f) + { + BRect frame = this->Frame (); + f->window->MoveTo (frame.left + f->xoff, + frame.top + f->yoff); + this->Sync (); + } + + void + DoUpdateWorkspace (struct child_frame *f) + { + f->window->SetWorkspaces (this->Workspaces ()); + } + + void + MoveChild (EmacsWindow *window, int xoff, int yoff, + int weak_p) + { + for (struct child_frame *f = subset_windows; f; + f = f->next) + { + if (window == f->window) + { + f->xoff = xoff; + f->yoff = yoff; + if (!weak_p) + DoMove (f); + return; + } + } + + gui_abort ("Trying to move a child frame that doesn't exist"); + } + + void + WindowActivated (bool activated) + { + struct haiku_activation_event rq; + rq.window = this; + rq.activated_p = activated; + + haiku_write (ACTIVATION, &rq); + } + + void + DirectConnected (direct_buffer_info *info) + { +#ifdef USE_BE_CAIRO + if (!surface_lock.Lock ()) + gui_abort ("Failed to lock window direct cr surface"); + if (cr_surface) + { + cairo_surface_destroy (cr_surface); + cr_surface = NULL; + } + + if (info->buffer_state != B_DIRECT_STOP) + { + int left, top, right, bottom; + left = info->clip_bounds.left; + top = info->clip_bounds.top; + right = info->clip_bounds.right; + bottom = info->clip_bounds.bottom; + + unsigned char *bits = (unsigned char *) info->bits; + if ((info->bits_per_pixel % 8) == 0) + { + bits += info->bytes_per_row * top; + bits += (left * info->bits_per_pixel / 8); + cr_surface = cairo_image_surface_create_for_data + (bits, + cairo_format_from_color_space (info->pixel_format), + right - left + 1, + bottom - top + 1, + info->bytes_per_row); + } + } + surface_lock.Unlock (); +#endif + } + + void + MessageReceived (BMessage *msg) + { + int32 old_what = 0; + + if (msg->WasDropped ()) + { + entry_ref ref; + BPoint whereto; + + if (msg->FindRef ("refs", &ref) == B_OK) + { + msg->what = B_REFS_RECEIVED; + msg->AddPointer ("window", this); + if (msg->FindPoint ("_drop_point_", &whereto) == B_OK) + { + this->ConvertFromScreen (&whereto); + msg->AddInt32 ("x", whereto.x); + msg->AddInt32 ("y", whereto.y); + } + be_app->PostMessage (msg); + msg->SendReply (B_OK); + } + } + else if (msg->GetPointer ("menuptr")) + { + struct haiku_menu_bar_select_event rq; + rq.window = this; + rq.ptr = (void *) msg->GetPointer ("menuptr"); + haiku_write (MENU_BAR_SELECT_EVENT, &rq); + } + else if (msg->what == 'FPSE' + || ((msg->FindInt32 ("old_what", &old_what) == B_OK + && old_what == 'FPSE'))) + { + struct haiku_file_panel_event rq; + BEntry entry; + BPath path; + entry_ref ref; + + rq.ptr = NULL; + + if (msg->FindRef ("refs", &ref) == B_OK && + entry.SetTo (&ref, 0) == B_OK && + entry.GetPath (&path) == B_OK) + { + const char *str_path = path.Path (); + if (str_path) + rq.ptr = strdup (str_path); + } + + if (msg->FindRef ("directory", &ref), + entry.SetTo (&ref, 0) == B_OK && + entry.GetPath (&path) == B_OK) + { + const char *name = msg->GetString ("name"); + const char *str_path = path.Path (); + + if (name) + { + char str_buf[std::strlen (str_path) + + std::strlen (name) + 2]; + snprintf ((char *) &str_buf, + std::strlen (str_path) + + std::strlen (name) + 2, "%s/%s", + str_path, name); + rq.ptr = strdup (str_buf); + } + } + + haiku_write (FILE_PANEL_EVENT, &rq); + } + else + BDirectWindow::MessageReceived (msg); + } + + void + DispatchMessage (BMessage *msg, BHandler *handler) + { + if (msg->what == B_KEY_DOWN || msg->what == B_KEY_UP) + { + struct haiku_key_event rq; + rq.window = this; + + int32_t code = msg->GetInt32 ("raw_char", 0); + + rq.modifiers = 0; + uint32_t mods = modifiers (); + + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + rq.mb_char = code; + rq.kc = msg->GetInt32 ("key", -1); + rq.unraw_mb_char = + BUnicodeChar::FromUTF8 (msg->GetString ("bytes")); + + if ((mods & B_SHIFT_KEY) && rq.kc >= 0) + map_shift (rq.kc, &rq.unraw_mb_char); + else if (rq.kc >= 0) + map_normal (rq.kc, &rq.unraw_mb_char); + + haiku_write (msg->what == B_KEY_DOWN ? KEY_DOWN : KEY_UP, &rq); + } + else if (msg->what == B_MOUSE_WHEEL_CHANGED) + { + struct haiku_wheel_move_event rq; + rq.window = this; + rq.modifiers = 0; + + uint32_t mods = modifiers (); + + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + float dx, dy; + if (msg->FindFloat ("be:wheel_delta_x", &dx) == B_OK && + msg->FindFloat ("be:wheel_delta_y", &dy) == B_OK) + { + rq.delta_x = dx * 10; + rq.delta_y = dy * 10; + + haiku_write (WHEEL_MOVE_EVENT, &rq); + }; + } + else + BDirectWindow::DispatchMessage (msg, handler); + } + + void + MenusBeginning () + { + struct haiku_menu_bar_state_event rq; + rq.window = this; + + haiku_write (MENU_BAR_OPEN, &rq); + } + + void + MenusEnded () + { + struct haiku_menu_bar_state_event rq; + rq.window = this; + + haiku_write (MENU_BAR_CLOSE, &rq); + } + + void + FrameResized (float newWidth, float newHeight) + { + struct haiku_resize_event rq; + rq.window = this; + rq.px_heightf = newHeight; + rq.px_widthf = newWidth; + + haiku_write (FRAME_RESIZED, &rq); + BDirectWindow::FrameResized (newWidth, newHeight); + } + + void + FrameMoved (BPoint newPosition) + { + struct haiku_move_event rq; + rq.window = this; + rq.x = std::lrint (newPosition.x); + rq.y = std::lrint (newPosition.y); + + haiku_write (MOVE_EVENT, &rq); + + for (struct child_frame *f = subset_windows; + f; f = f->next) + DoMove (f); + BDirectWindow::FrameMoved (newPosition); + } + + void + WorkspacesChanged (uint32_t old, uint32_t n) + { + for (struct child_frame *f = subset_windows; + f; f = f->next) + DoUpdateWorkspace (f); + } + + void + EmacsMoveTo (int x, int y) + { + if (!this->parent) + this->MoveTo (x, y); + else + this->parent->MoveChild (this, x, y, 0); + } + + bool + QuitRequested () + { + struct haiku_quit_requested_event rq; + rq.window = this; + haiku_write (QUIT_REQUESTED, &rq); + return false; + } + + void + Minimize (bool minimized_p) + { + BDirectWindow::Minimize (minimized_p); + struct haiku_iconification_event rq; + rq.window = this; + rq.iconified_p = !parent && minimized_p; + + haiku_write (ICONIFICATION, &rq); + } + + void + EmacsHide (void) + { + if (this->IsHidden ()) + return; + Hide (); + if (this->parent) + UpwardsUnSubsetChildren (this->parent); + } + + void + EmacsShow (void) + { + if (!this->IsHidden ()) + return; + if (this->parent) + shown_flag = 1; + Show (); + if (this->parent) + UpwardsSubsetChildren (this->parent); + } + + void + Zoom (BPoint o, float w, float h) + { + struct haiku_zoom_event rq; + rq.window = this; + + rq.x = o.x; + rq.y = o.y; + + rq.width = w; + rq.height = h; + + if (fullscreen_p) + MakeFullscreen (0); + + if (o.x != x_before_zoom || + o.y != y_before_zoom) + { + x_before_zoom = Frame ().left; + y_before_zoom = Frame ().top; + pre_zoom_rect = Frame (); + zoomed_p = 1; + haiku_write (ZOOM_EVENT, &rq); + } + else + { + zoomed_p = 0; + x_before_zoom = y_before_zoom = INT_MIN; + } + + BDirectWindow::Zoom (o, w, h); + } + + void + UnZoom (void) + { + if (!zoomed_p) + return; + zoomed_p = 0; + + EmacsMoveTo (pre_zoom_rect.left, pre_zoom_rect.top); + ResizeTo (pre_zoom_rect.Width (), + pre_zoom_rect.Height ()); + } + + void + GetParentWidthHeight (int *width, int *height) + { + if (parent) + { + *width = parent->Frame ().Width (); + *height = parent->Frame ().Height (); + } + else + { + BScreen s (this); + *width = s.Frame ().Width (); + *height = s.Frame ().Height (); + } + } + + void + OffsetChildRect (BRect *r, EmacsWindow *c) + { + for (struct child_frame *f; f; f = f->next) + if (f->window == c) + { + r->top -= f->yoff; + r->bottom -= f->yoff; + r->left -= f->xoff; + r->right -= f->xoff; + return; + } + + gui_abort ("Trying to calculate offsets for a child frame that doesn't exist"); + } + + void + MakeFullscreen (int make_fullscreen_p) + { + BScreen screen (this); + + if (!screen.IsValid ()) + gui_abort ("Trying to make a window fullscreen without a screen"); + + if (make_fullscreen_p == fullscreen_p) + return; + + fullscreen_p = make_fullscreen_p; + uint32 flags = Flags (); + if (fullscreen_p) + { + if (zoomed_p) + UnZoom (); + + flags |= B_NOT_MOVABLE | B_NOT_ZOOMABLE; + pre_fullscreen_rect = Frame (); + if (parent) + parent->OffsetChildRect (&pre_fullscreen_rect, this); + + int w, h; + EmacsMoveTo (0, 0); + GetParentWidthHeight (&w, &h); + ResizeTo (w, h); + } + else + { + flags &= ~(B_NOT_MOVABLE | B_NOT_ZOOMABLE); + EmacsMoveTo (pre_fullscreen_rect.left, + pre_fullscreen_rect.top); + ResizeTo (pre_fullscreen_rect.Width (), + pre_fullscreen_rect.Height ()); + } + SetFlags (flags); + } +}; + +class EmacsMenuBar : public BMenuBar +{ +public: + EmacsMenuBar () : BMenuBar (BRect (0, 0, 0, 0), NULL) + { + } + + void + FrameResized (float newWidth, float newHeight) + { + struct haiku_menu_bar_resize_event rq; + rq.window = this->Window (); + rq.height = std::lrint (newHeight); + rq.width = std::lrint (newWidth); + + haiku_write (MENU_BAR_RESIZE, &rq); + BMenuBar::FrameResized (newWidth, newHeight); + } +}; + +class EmacsView : public BView +{ +public: + uint32_t visible_bell_color = 0; + uint32_t previous_buttons = 0; + int looper_locked_count = 0; + BRegion sb_region; + + BView *offscreen_draw_view = NULL; + BBitmap *offscreen_draw_bitmap_1 = NULL; + BBitmap *copy_bitmap = NULL; + +#ifdef USE_BE_CAIRO + cairo_surface_t *cr_surface = NULL; + BLocker cr_surface_lock; +#endif + + BPoint tt_absl_pos; + + color_space cspace; + + EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", B_FOLLOW_NONE, B_WILL_DRAW) + { + + } + + ~EmacsView () + { + TearDownDoubleBuffering (); + } + + void + AttachedToWindow (void) + { + cspace = B_RGBA32; + } + +#ifdef USE_BE_CAIRO + void + DetachCairoSurface (void) + { + if (!cr_surface_lock.Lock ()) + gui_abort ("Could not lock cr surface during detachment"); + if (!cr_surface) + gui_abort ("Trying to detach window cr surface when none exists"); + cairo_surface_destroy (cr_surface); + cr_surface = NULL; + cr_surface_lock.Unlock (); + } + + void + AttachCairoSurface (void) + { + if (!cr_surface_lock.Lock ()) + gui_abort ("Could not lock cr surface during attachment"); + if (cr_surface) + gui_abort ("Trying to attach cr surface when one already exists"); + cr_surface = cairo_image_surface_create_for_data + ((unsigned char *) offscreen_draw_bitmap_1->Bits (), + CAIRO_FORMAT_ARGB32, offscreen_draw_bitmap_1->Bounds ().Width (), + offscreen_draw_bitmap_1->Bounds ().Height (), + offscreen_draw_bitmap_1->BytesPerRow ()); + if (!cr_surface) + gui_abort ("Cr surface allocation failed for double-buffered view"); + cr_surface_lock.Unlock (); + } +#endif + + void + TearDownDoubleBuffering (void) + { + if (offscreen_draw_view) + { + if (Window ()) + ClearViewBitmap (); + if (copy_bitmap) + { + delete copy_bitmap; + copy_bitmap = NULL; + } + if (!looper_locked_count) + if (!offscreen_draw_view->LockLooper ()) + gui_abort ("Failed to lock offscreen draw view"); +#ifdef USE_BE_CAIRO + if (cr_surface) + DetachCairoSurface (); +#endif + offscreen_draw_view->RemoveSelf (); + delete offscreen_draw_view; + offscreen_draw_view = NULL; + delete offscreen_draw_bitmap_1; + offscreen_draw_bitmap_1 = NULL; + } + } + + void + AfterResize (float newWidth, float newHeight) + { + if (offscreen_draw_view) + { + if (!LockLooper ()) + gui_abort ("Failed to lock looper after resize"); + + if (!offscreen_draw_view->LockLooper ()) + gui_abort ("Failed to lock offscreen draw view after resize"); +#ifdef USE_BE_CAIRO + DetachCairoSurface (); +#endif + offscreen_draw_view->RemoveSelf (); + delete offscreen_draw_bitmap_1; + offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 1); + if (offscreen_draw_bitmap_1->InitCheck () != B_OK) + gui_abort ("Offscreen draw bitmap initialization failed"); + + offscreen_draw_view->MoveTo (Frame ().left, Frame ().top); + offscreen_draw_view->ResizeTo (Frame ().Width (), Frame ().Height ()); + offscreen_draw_bitmap_1->AddChild (offscreen_draw_view); +#ifdef USE_BE_CAIRO + AttachCairoSurface (); +#endif + + if (looper_locked_count) + { + offscreen_draw_bitmap_1->Lock (); + } + + UnlockLooper (); + } + } + + void + Pulse (void) + { + visible_bell_color = 0; + SetFlags (Flags () & ~B_PULSE_NEEDED); + Window ()->SetPulseRate (0); + Invalidate (); + } + + void + Draw (BRect expose_bounds) + { + struct haiku_expose_event rq; + EmacsWindow *w = (EmacsWindow *) Window (); + + if (visible_bell_color > 0) + { + PushState (); + BView_SetHighColorForVisibleBell (this, visible_bell_color); + FillRect (Frame ()); + PopState (); + return; + } + + if (w->shown_flag) + { + PushState (); + SetDrawingMode (B_OP_ERASE); + FillRect (Frame ()); + PopState (); + return; + } + + if (!offscreen_draw_view) + { + if (sb_region.Contains (std::lrint (expose_bounds.left), + std::lrint (expose_bounds.top)) && + sb_region.Contains (std::lrint (expose_bounds.right), + std::lrint (expose_bounds.top)) && + sb_region.Contains (std::lrint (expose_bounds.left), + std::lrint (expose_bounds.bottom)) && + sb_region.Contains (std::lrint (expose_bounds.right), + std::lrint (expose_bounds.bottom))) + return; + + rq.x = std::floor (expose_bounds.left); + rq.y = std::floor (expose_bounds.top); + rq.width = std::ceil (expose_bounds.right - expose_bounds.left + 1); + rq.height = std::ceil (expose_bounds.bottom - expose_bounds.top + 1); + if (!rq.width) + rq.width = 1; + if (!rq.height) + rq.height = 1; + rq.window = this->Window (); + + haiku_write (FRAME_EXPOSED, &rq); + } + } + + void + DoVisibleBell (uint32_t color) + { + if (!LockLooper ()) + gui_abort ("Failed to lock looper during visible bell"); + visible_bell_color = color | (255 << 24); + SetFlags (Flags () | B_PULSE_NEEDED); + Window ()->SetPulseRate (100 * 1000); + Invalidate (); + UnlockLooper (); + } + + void + FlipBuffers (void) + { + if (!LockLooper ()) + gui_abort ("Failed to lock looper during buffer flip"); + if (!offscreen_draw_view) + gui_abort ("Failed to lock offscreen view during buffer flip"); + + offscreen_draw_view->Flush (); + offscreen_draw_view->Sync (); + + EmacsWindow *w = (EmacsWindow *) Window (); + w->shown_flag = 0; + + if (copy_bitmap && + copy_bitmap->Bounds () != offscreen_draw_bitmap_1->Bounds ()) + { + delete copy_bitmap; + copy_bitmap = NULL; + } + if (!copy_bitmap) + copy_bitmap = new BBitmap (offscreen_draw_bitmap_1); + else + copy_bitmap->ImportBits (offscreen_draw_bitmap_1); + + if (copy_bitmap->InitCheck () != B_OK) + gui_abort ("Failed to init copy bitmap during buffer flip"); + + SetViewBitmap (copy_bitmap, + Frame (), Frame (), B_FOLLOW_NONE, 0); + + Invalidate (); + UnlockLooper (); + return; + } + + void + SetUpDoubleBuffering (void) + { + if (!LockLooper ()) + gui_abort ("Failed to lock self setting up double buffering"); + if (offscreen_draw_view) + gui_abort ("Failed to lock offscreen view setting up double buffering"); + + offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 1); + if (offscreen_draw_bitmap_1->InitCheck () != B_OK) + gui_abort ("Failed to init offscreen bitmap"); +#ifdef USE_BE_CAIRO + AttachCairoSurface (); +#endif + offscreen_draw_view = new BView (Frame (), NULL, B_FOLLOW_NONE, B_WILL_DRAW); + offscreen_draw_bitmap_1->AddChild (offscreen_draw_view); + + if (looper_locked_count) + { + if (!offscreen_draw_bitmap_1->Lock ()) + gui_abort ("Failed to lock bitmap after double buffering was set up."); + } + + UnlockLooper (); + Invalidate (); + } + + void + MouseMoved (BPoint point, uint32 transit, const BMessage *msg) + { + struct haiku_mouse_motion_event rq; + + rq.just_exited_p = transit == B_EXITED_VIEW; + rq.x = point.x; + rq.y = point.y; + rq.be_code = transit; + rq.window = this->Window (); + + if (ToolTip ()) + ToolTip ()->SetMouseRelativeLocation (BPoint (-(point.x - tt_absl_pos.x), + -(point.y - tt_absl_pos.y))); + + haiku_write (MOUSE_MOTION, &rq); + } + + void + MouseDown (BPoint point) + { + struct haiku_button_event rq; + uint32 buttons; + + this->GetMouse (&point, &buttons, false); + + rq.window = this->Window (); + rq.btn_no = 0; + + if (!(previous_buttons & B_PRIMARY_MOUSE_BUTTON) && + (buttons & B_PRIMARY_MOUSE_BUTTON)) + rq.btn_no = 0; + else if (!(previous_buttons & B_SECONDARY_MOUSE_BUTTON) && + (buttons & B_SECONDARY_MOUSE_BUTTON)) + rq.btn_no = 2; + else if (!(previous_buttons & B_TERTIARY_MOUSE_BUTTON) && + (buttons & B_TERTIARY_MOUSE_BUTTON)) + rq.btn_no = 1; + previous_buttons = buttons; + + rq.x = point.x; + rq.y = point.y; + + uint32_t mods = modifiers (); + + rq.modifiers = 0; + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + SetMouseEventMask (B_POINTER_EVENTS, B_LOCK_WINDOW_FOCUS); + + haiku_write (BUTTON_DOWN, &rq); + } + + void + MouseUp (BPoint point) + { + struct haiku_button_event rq; + uint32 buttons; + + this->GetMouse (&point, &buttons, false); + + rq.window = this->Window (); + rq.btn_no = 0; + + if ((previous_buttons & B_PRIMARY_MOUSE_BUTTON) + && !(buttons & B_PRIMARY_MOUSE_BUTTON)) + rq.btn_no = 0; + else if ((previous_buttons & B_SECONDARY_MOUSE_BUTTON) + && !(buttons & B_SECONDARY_MOUSE_BUTTON)) + rq.btn_no = 2; + else if ((previous_buttons & B_TERTIARY_MOUSE_BUTTON) + && !(buttons & B_TERTIARY_MOUSE_BUTTON)) + rq.btn_no = 1; + previous_buttons = buttons; + + rq.x = point.x; + rq.y = point.y; + + uint32_t mods = modifiers (); + + rq.modifiers = 0; + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + if (!buttons) + SetMouseEventMask (0, 0); + + haiku_write (BUTTON_UP, &rq); + } +}; + +class EmacsScrollBar : public BScrollBar +{ +public: + void *scroll_bar; + + EmacsScrollBar (int x, int y, int x1, int y1, bool horizontal_p) : + BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ? + B_HORIZONTAL : B_VERTICAL) + { + BView *vw = (BView *) this; + vw->SetResizingMode (B_FOLLOW_NONE); + } + + void + MessageReceived (BMessage *msg) + { + if (msg->what == SCROLL_BAR_UPDATE) + { + this->SetRange (0, msg->GetInt32 ("emacs:range", 0)); + this->SetValue (msg->GetInt32 ("emacs:units", 0)); + } + + BScrollBar::MessageReceived (msg); + } + + void + ValueChanged (float new_value) + { + struct haiku_scroll_bar_value_event rq; + rq.scroll_bar = scroll_bar; + rq.position = new_value; + + haiku_write (SCROLL_BAR_VALUE_EVENT, &rq); + } + + void + MouseDown (BPoint pt) + { + struct haiku_scroll_bar_drag_event rq; + rq.dragging_p = 1; + rq.scroll_bar = scroll_bar; + + haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + BScrollBar::MouseDown (pt); + } + + void + MouseUp (BPoint pt) + { + struct haiku_scroll_bar_drag_event rq; + rq.dragging_p = 0; + rq.scroll_bar = scroll_bar; + + haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + BScrollBar::MouseUp (pt); + } +}; + +class EmacsTitleMenuItem : public BMenuItem +{ +public: + EmacsTitleMenuItem (const char *str) : BMenuItem (str, NULL) + { + SetEnabled (0); + } + + void + DrawContent (void) + { + BMenu *menu = Menu (); + + menu->PushState (); + menu->SetFont (be_bold_font); + BView_SetHighColorForVisibleBell (menu, 0); + BMenuItem::DrawContent (); + menu->PopState (); + } +}; + +class EmacsMenuItem : public BMenuItem +{ +public: + int menu_bar_id = -1; + void *wind_ptr = NULL; + char *key = NULL; + char *help = NULL; + + EmacsMenuItem (const char *ky, + const char *str, + const char *help, + BMessage *message = NULL) : BMenuItem (str, message) + { + if (ky) + { + key = strdup (ky); + if (!key) + gui_abort ("strdup failed"); + } + + if (help) + { + this->help = strdup (help); + if (!this->help) + gui_abort ("strdup failed"); + } + } + + ~EmacsMenuItem () + { + if (key) + free (key); + if (help) + free (help); + } + + void + DrawContent (void) + { + BMenu *menu = Menu (); + + BMenuItem::DrawContent (); + + if (key) + { + BRect r = menu->Frame (); + int w = menu->StringWidth (key); + menu->MovePenTo (BPoint (r.Width () - w - 4, + menu->PenLocation ().y)); + menu->DrawString (key); + } + } + + void + GetContentSize (float *w, float *h) + { + BMenuItem::GetContentSize (w, h); + if (Menu () && key) + *w += 4 + Menu ()->StringWidth (key); + } + + void + Highlight (bool highlight_p) + { + struct haiku_menu_bar_help_event rq; + + if (menu_bar_id >= 0) + { + rq.window = wind_ptr; + rq.mb_idx = highlight_p ? menu_bar_id : -1; + + haiku_write (MENU_BAR_HELP_EVENT, &rq); + } + else if (help) + { + Menu ()->SetToolTip (highlight_p ? help : NULL); + } + + BMenuItem::Highlight (highlight_p); + } +}; + +class EmacsPopUpMenu : public BPopUpMenu +{ +public: + EmacsPopUpMenu (const char *name) : BPopUpMenu (name, 0) + { + + } + + void + FrameResized (float w, float h) + { + Invalidate (); + BPopUpMenu::FrameResized (w, h); + } +}; + +static int32 +start_running_application (void *data) +{ + haiku_io_init_in_app_thread (); + + if (!((Emacs *) data)->Lock ()) + gui_abort ("Failed to lock application"); + + ((Emacs *) data)->Run (); + ((Emacs *) data)->Unlock (); + return 0; +} + +/* Take BITMAP, a reference to a BBitmap, and return a pointer to its + data. */ +void * +BBitmap_data (void *bitmap) +{ + return ((BBitmap *) bitmap)->Bits (); +} + +/* Convert bitmap if required, placing the new bitmap in NEW_BITMAP, + and return non-null if bitmap was successfully converted. Bitmaps + should be freed with `BBitmap_free'. */ +int +BBitmap_convert (void *_bitmap, void **new_bitmap) +{ + BBitmap *bitmap = (BBitmap *) _bitmap; + if (bitmap->ColorSpace () == B_RGBA32) + return -1; + BRect bounds = bitmap->Bounds (); + BBitmap *bmp = new (std::nothrow) BBitmap (bounds, B_RGBA32); + if (!bmp || bmp->InitCheck () != B_OK) + { + if (bmp) + delete bmp; + return 0; + } + if (bmp->ImportBits (bitmap) != B_OK) + { + delete bmp; + return 0; + } + *(BBitmap **) new_bitmap = bmp; + return 1; +} + +void +BBitmap_free (void *bitmap) +{ + delete (BBitmap *) bitmap; +} + +/* Create new bitmap in RGB32 format, or in GRAY1 if MONO_P is + non-zero. */ +void * +BBitmap_new (int width, int height, int mono_p) +{ + BBitmap *bn = new (std::nothrow) BBitmap (BRect (0, 0, width - 1, height - 1), + mono_p ? B_GRAY1 : B_RGB32); + + return bn->InitCheck () == B_OK ? (void *) bn : (void *) (delete bn, NULL); +} + +void +BBitmap_dimensions (void *bitmap, int *left, int *top, + int *right, int *bottom, + int32_t *bytes_per_row, int *mono_p) +{ + BRect rect = ((BBitmap *) bitmap)->Bounds (); + *left = rect.left; + *top = rect.top; + *right = rect.right; + *bottom = rect.bottom; + + *bytes_per_row = ((BBitmap *) bitmap)->BytesPerRow (); + *mono_p = (((BBitmap *) bitmap)->ColorSpace () == B_GRAY1); +} + +/* Set up an application and return it. If starting the application + thread fails, abort Emacs. */ +void * +BApplication_setup (void) +{ + if (be_app) + return be_app; + thread_id id; + Emacs *app; + + app = new Emacs; + app->Unlock (); + if ((id = spawn_thread (start_running_application, "Emacs app thread", + B_DEFAULT_MEDIA_PRIORITY, app)) < 0) + gui_abort ("spawn_thread failed"); + + resume_thread (id); + + app_thread = id; + return app; +} + +/* Set up and return a window with its view put in VIEW. */ +void * +BWindow_new (void *_view) +{ + BWindow *window = new (std::nothrow) EmacsWindow; + BView **v = (BView **) _view; + if (!window) + { + *v = NULL; + return window; + } + + BView *vw = new (std::nothrow) EmacsView; + if (!vw) + { + *v = NULL; + window->Lock (); + window->Quit (); + return NULL; + } + window->AddChild (vw); + *v = vw; + return window; +} + +void +BWindow_quit (void *window) +{ + ((BWindow *) window)->Lock (); + ((BWindow *) window)->Quit (); +} + +/* Set WINDOW's offset to X, Y. */ +void +BWindow_set_offset (void *window, int x, int y) +{ + BWindow *wn = (BWindow *) window; + EmacsWindow *w = dynamic_cast (wn); + if (w) + { + if (!w->LockLooper ()) + gui_abort ("Failed to lock window looper setting offset"); + w->EmacsMoveTo (x, y); + w->UnlockLooper (); + } + else + wn->MoveTo (x, y); +} + +/* Iconify WINDOW. */ +void +BWindow_iconify (void *window) +{ + if (((BWindow *) window)->IsHidden ()) + BWindow_set_visible (window, true); + ((BWindow *) window)->Minimize (true); +} + +/* Show or hide WINDOW. */ +void +BWindow_set_visible (void *window, int visible_p) +{ + EmacsWindow *win = (EmacsWindow *) window; + if (visible_p) + { + if (win->IsMinimized ()) + win->Minimize (false); + win->EmacsShow (); + } + else if (!win->IsHidden ()) + { + if (win->IsMinimized ()) + win->Minimize (false); + win->EmacsHide (); + } + win->Sync (); +} + +/* Change the title of WINDOW to the multibyte string TITLE. */ +void +BWindow_retitle (void *window, const char *title) +{ + ((BWindow *) window)->SetTitle (title); +} + +/* Resize WINDOW to WIDTH by HEIGHT. */ +void +BWindow_resize (void *window, int width, int height) +{ + ((BWindow *) window)->ResizeTo (width, height); +} + +/* Activate WINDOW, making it the subject of keyboard focus and + bringing it to the front of the screen. */ +void +BWindow_activate (void *window) +{ + ((BWindow *) window)->Activate (); +} + +/* Return the pixel dimensions of the main screen in WIDTH and + HEIGHT. */ +void +BScreen_px_dim (int *width, int *height) +{ + BScreen screen; + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + BRect frame = screen.Frame (); + + *width = frame.right - frame.left; + *height = frame.bottom - frame.top; +} + +/* Resize VIEW to WIDTH, HEIGHT. */ +void +BView_resize_to (void *view, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view for resize"); + vw->ResizeTo (width, height); + vw->AfterResize (width, height); + vw->UnlockLooper (); +} + +void * +BCursor_create_default (void) +{ + return new BCursor (B_CURSOR_ID_SYSTEM_DEFAULT); +} + +void * +BCursor_create_modeline (void) +{ + return new BCursor (B_CURSOR_ID_CONTEXT_MENU); +} + +void * +BCursor_from_id (enum haiku_cursor cursor) +{ + return new BCursor ((enum BCursorID) cursor); +} + +void * +BCursor_create_i_beam (void) +{ + return new BCursor (B_CURSOR_ID_I_BEAM); +} + +void * +BCursor_create_progress_cursor (void) +{ + return new BCursor (B_CURSOR_ID_PROGRESS); +} + +void * +BCursor_create_grab (void) +{ + return new BCursor (B_CURSOR_ID_GRAB); +} + +void +BCursor_delete (void *cursor) +{ + delete (BCursor *) cursor; +} + +void +BView_set_view_cursor (void *view, void *cursor) +{ + if (!((BView *) view)->LockLooper ()) + gui_abort ("Failed to lock view setting cursor"); + ((BView *) view)->SetViewCursor ((BCursor *) cursor); + ((BView *) view)->UnlockLooper (); +} + +void +BWindow_Flush (void *window) +{ + ((BWindow *) window)->Flush (); +} + +/* Map the keycode KC, storing the result in CODE and 1 in + NON_ASCII_P if it should be used. */ +void +BMapKey (uint32_t kc, int *non_ascii_p, unsigned *code) +{ + if (*code == 10 && kc != 0x42) + { + *code = XK_Return; + *non_ascii_p = 1; + return; + } + + switch (kc) + { + default: + *non_ascii_p = 0; + if (kc < 0xe && kc > 0x1) + { + *code = XK_F1 + kc - 2; + *non_ascii_p = 1; + } + return; + case 0x1e: + *code = XK_BackSpace; + break; + case 0x61: + *code = XK_Left; + break; + case 0x63: + *code = XK_Right; + break; + case 0x57: + *code = XK_Up; + break; + case 0x62: + *code = XK_Down; + break; + case 0x64: + *code = XK_Insert; + break; + case 0x65: + *code = XK_Delete; + break; + case 0x37: + *code = XK_Home; + break; + case 0x58: + *code = XK_End; + break; + case 0x39: + *code = XK_Page_Up; + break; + case 0x5a: + *code = XK_Page_Down; + break; + case 0x1: + *code = XK_Escape; + break; + case 0x68: + *code = XK_Menu; + break; + } + *non_ascii_p = 1; +} + +/* Make a scrollbar, attach it to VIEW's window, and return it. */ +void * +BScrollBar_make_for_view (void *view, int horizontal_p, + int x, int y, int x1, int y1, + void *scroll_bar_ptr) +{ + EmacsScrollBar *sb = new EmacsScrollBar (x, y, x1, y1, horizontal_p); + sb->scroll_bar = scroll_bar_ptr; + + BView *vw = (BView *) view; + BView *sv = (BView *) sb; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock scrollbar owner"); + vw->AddChild ((BView *) sb); + sv->WindowActivated (vw->Window ()->IsActive ()); + vw->UnlockLooper (); + return sb; +} + +void +BScrollBar_delete (void *sb) +{ + BView *view = (BView *) sb; + BView *pr = view->Parent (); + + if (!pr->LockLooper ()) + gui_abort ("Failed to lock scrollbar parent"); + pr->RemoveChild (view); + pr->UnlockLooper (); + + delete (EmacsScrollBar *) sb; +} + +void +BView_move_frame (void *view, int x, int y, int x1, int y1) +{ + BView *vw = (BView *) view; + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view moving frame"); + vw->MoveTo (x, y); + vw->ResizeTo (x1 - x, y1 - y); + vw->Flush (); + vw->Sync (); + vw->UnlockLooper (); +} + +void +BView_scroll_bar_update (void *sb, int portion, int whole, int position) +{ + BScrollBar *bar = (BScrollBar *) sb; + BMessage msg = BMessage (SCROLL_BAR_UPDATE); + BMessenger mr = BMessenger (bar); + msg.AddInt32 ("emacs:range", whole); + msg.AddInt32 ("emacs:units", position); + + mr.SendMessage (&msg); +} + +/* Return the default scrollbar size. */ +int +BScrollBar_default_size (int horizontal_p) +{ + return horizontal_p ? B_H_SCROLL_BAR_HEIGHT : B_V_SCROLL_BAR_WIDTH; +} + +/* Invalidate VIEW, causing it to be drawn again. */ +void +BView_invalidate (void *view) +{ + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Couldn't lock view while invalidating it"); + vw->Invalidate (); + vw->UnlockLooper (); +} + +/* Lock VIEW in preparation for drawing operations. This should be + called before any attempt to draw onto VIEW or to lock it for Cairo + drawing. `BView_draw_unlock' should be called afterwards. */ +void +BView_draw_lock (void *view) +{ + EmacsView *vw = (EmacsView *) view; + if (vw->looper_locked_count) + { + vw->looper_locked_count++; + return; + } + BView *v = (BView *) find_appropriate_view_for_draw (vw); + if (v != vw) + { + if (!vw->offscreen_draw_bitmap_1->Lock ()) + gui_abort ("Failed to lock offscreen bitmap while acquiring draw lock"); + } + else if (!v->LockLooper ()) + gui_abort ("Failed to lock draw view while acquiring draw lock"); + + if (v != vw && !vw->LockLooper ()) + gui_abort ("Failed to lock view while acquiring draw lock"); + vw->looper_locked_count++; +} + +void +BView_draw_unlock (void *view) +{ + EmacsView *vw = (EmacsView *) view; + if (--vw->looper_locked_count) + return; + + BView *v = (BView *) find_appropriate_view_for_draw (view); + if (v == vw) + vw->UnlockLooper (); + else + { + vw->offscreen_draw_bitmap_1->Unlock (); + vw->UnlockLooper (); + } +} + +void +BWindow_center_on_screen (void *window) +{ + BWindow *w = (BWindow *) window; + w->CenterOnScreen (); +} + +/* Tell VIEW it has been clicked at X by Y. */ +void +BView_mouse_down (void *view, int x, int y) +{ + BView *vw = (BView *) view; + if (vw->LockLooper ()) + { + vw->MouseDown (BPoint (x, y)); + vw->UnlockLooper (); + } +} + +/* Tell VIEW the mouse has been released at X by Y. */ +void +BView_mouse_up (void *view, int x, int y) +{ + BView *vw = (BView *) view; + if (vw->LockLooper ()) + { + vw->MouseUp (BPoint (x, y)); + vw->UnlockLooper (); + } +} + +/* Tell VIEW that the mouse has moved to Y by Y. */ +void +BView_mouse_moved (void *view, int x, int y, uint32_t transit) +{ + BView *vw = (BView *) view; + if (vw->LockLooper ()) + { + vw->MouseMoved (BPoint (x, y), transit, NULL); + vw->UnlockLooper (); + } +} + +/* Import BITS into BITMAP using the B_GRAY1 colorspace. */ +void +BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h) +{ + BBitmap *bmp = (BBitmap *) bitmap; + unsigned char *data = (unsigned char *) bmp->Bits (); + unsigned short *bts = (unsigned short *) bits; + + for (int i = 0; i < (h * (wd / 8)); i++) + { + *((unsigned short *) data) = bts[i]; + data += bmp->BytesPerRow (); + } +} + +/* Make a scrollbar at X, Y known to the view VIEW. */ +void +BView_publish_scroll_bar (void *view, int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + if (vw->LockLooper ()) + { + vw->sb_region.Include (BRect (x, y, x - 1 + width, + y - 1 + height)); + vw->UnlockLooper (); + } +} + +void +BView_forget_scroll_bar (void *view, int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + if (vw->LockLooper ()) + { + vw->sb_region.Exclude (BRect (x, y, x - 1 + width, + y - 1 + height)); + vw->UnlockLooper (); + } +} + +void +BView_get_mouse (void *view, int *x, int *y) +{ + BPoint l; + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view in BView_get_mouse"); + vw->GetMouse (&l, NULL, 1); + vw->UnlockLooper (); + + *x = std::lrint (l.x); + *y = std::lrint (l.y); +} + +/* Perform an in-place conversion of X and Y from VIEW's coordinate + system to its screen's coordinate system. */ +void +BView_convert_to_screen (void *view, int *x, int *y) +{ + BPoint l = BPoint (*x, *y); + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view in convert_to_screen"); + vw->ConvertToScreen (&l); + vw->UnlockLooper (); + + *x = std::lrint (l.x); + *y = std::lrint (l.y); +} + +void +BView_convert_from_screen (void *view, int *x, int *y) +{ + BPoint l = BPoint (*x, *y); + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view in convert_from_screen"); + vw->ConvertFromScreen (&l); + vw->UnlockLooper (); + + *x = std::lrint (l.x); + *y = std::lrint (l.y); +} + +/* Decorate or undecorate WINDOW depending on DECORATE_P. */ +void +BWindow_change_decoration (void *window, int decorate_p) +{ + BWindow *w = (BWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while changing its decorations"); + if (decorate_p) + w->SetLook (B_TITLED_WINDOW_LOOK); + else + w->SetLook (B_NO_BORDER_WINDOW_LOOK); + w->UnlockLooper (); +} + +/* Decorate WINDOW appropriately for use as a tooltip. */ +void +BWindow_set_tooltip_decoration (void *window) +{ + BWindow *w = (BWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while setting ttip decoration"); + w->SetLook (B_BORDERED_WINDOW_LOOK); + w->SetFeel (B_FLOATING_APP_WINDOW_FEEL); + w->UnlockLooper (); +} + +/* Set B_AVOID_FOCUS on WINDOW if AVOID_FOCUS_P is non-nil, or clear + it otherwise. */ +void +BWindow_set_avoid_focus (void *window, int avoid_focus_p) +{ + BWindow *w = (BWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while setting avoid focus"); + + if (!avoid_focus_p) + w->SetFlags (w->Flags () & ~B_AVOID_FOCUS); + else + w->SetFlags (w->Flags () | B_AVOID_FOCUS); + w->Sync (); + w->UnlockLooper (); +} + +void +BView_emacs_delete (void *view) +{ + EmacsView *vw = (EmacsView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view while deleting it"); + vw->RemoveSelf (); + delete vw; +} + +/* Return the current workspace. */ +uint32_t +haiku_current_workspace (void) +{ + return current_workspace (); +} + +/* Return a bitmask consisting of workspaces WINDOW is on. */ +uint32_t +BWindow_workspaces (void *window) +{ + return ((BWindow *) window)->Workspaces (); +} + +/* Create a popup menu. */ +void * +BPopUpMenu_new (const char *name) +{ + BPopUpMenu *menu = new EmacsPopUpMenu (name); + menu->SetRadioMode (0); + return menu; +} + +/* Add a title item to MENU. These items cannot be highlighted or + triggered, and their labels will display as bold text. */ +void +BMenu_add_title (void *menu, const char *text) +{ + EmacsTitleMenuItem *it = new EmacsTitleMenuItem (text); + BMenu *mn = (BMenu *) menu; + mn->AddItem (it); +} + +/* Add an item to the menu MENU. */ +void +BMenu_add_item (void *menu, const char *label, void *ptr, bool enabled_p, + bool marked_p, bool mbar_p, void *mbw_ptr, const char *key, + const char *help) +{ + BMenu *m = (BMenu *) menu; + BMessage *msg; + if (ptr) + msg = new BMessage (); + EmacsMenuItem *it = new EmacsMenuItem (key, label, help, ptr ? msg : NULL); + it->SetTarget (m->Window ()); + it->SetEnabled (enabled_p); + it->SetMarked (marked_p); + if (mbar_p) + { + it->menu_bar_id = (intptr_t) ptr; + it->wind_ptr = mbw_ptr; + } + if (ptr) + msg->AddPointer ("menuptr", ptr); + m->AddItem (it); +} + +/* Add a separator to the menu MENU. */ +void +BMenu_add_separator (void *menu) +{ + BMenu *m = (BMenu *) menu; + + m->AddSeparatorItem (); +} + +/* Create a submenu and attach it to MENU. */ +void * +BMenu_new_submenu (void *menu, const char *label, bool enabled_p) +{ + BMenu *m = (BMenu *) menu; + BMenu *mn = new BMenu (label, B_ITEMS_IN_COLUMN); + mn->SetRadioMode (0); + BMenuItem *i = new BMenuItem (mn); + i->SetEnabled (enabled_p); + m->AddItem (i); + return mn; +} + +/* Create a submenu that notifies Emacs upon opening. */ +void * +BMenu_new_menu_bar_submenu (void *menu, const char *label) +{ + BMenu *m = (BMenu *) menu; + BMenu *mn = new BMenu (label, B_ITEMS_IN_COLUMN); + mn->SetRadioMode (0); + BMenuItem *i = new BMenuItem (mn); + i->SetEnabled (1); + m->AddItem (i); + return mn; +} + +/* Run MENU, waiting for it to close, and return a pointer to the + data of the selected item (if one exists), or NULL. X, Y should + be in the screen coordinate system. */ +void * +BMenu_run (void *menu, int x, int y) +{ + BPopUpMenu *mn = (BPopUpMenu *) menu; + mn->SetRadioMode (0); + BMenuItem *it = mn->Go (BPoint (x, y)); + if (it) + { + BMessage *mg = it->Message (); + if (mg) + return (void *) mg->GetPointer ("menuptr"); + else + return NULL; + } + return NULL; +} + +/* Delete the entire menu hierarchy of MENU, and then delete MENU + itself. */ +void +BPopUpMenu_delete (void *menu) +{ + delete (BPopUpMenu *) menu; +} + +/* Create a menubar, attach it to VIEW, and return it. */ +void * +BMenuBar_new (void *view) +{ + BView *vw = (BView *) view; + EmacsMenuBar *bar = new EmacsMenuBar (); + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock menu bar parent"); + vw->AddChild ((BView *) bar); + vw->UnlockLooper (); + + return bar; +} + +/* Delete MENUBAR along with all subitems. */ +void +BMenuBar_delete (void *menubar) +{ + BView *vw = (BView *) menubar; + BView *p = vw->Parent (); + if (!p->LockLooper ()) + gui_abort ("Failed to lock menu bar parent while removing menubar"); + vw->RemoveSelf (); + p->UnlockLooper (); + delete vw; +} + +/* Delete all items from MENU. */ +void +BMenu_delete_all (void *menu) +{ + BMenu *mn = (BMenu *) menu; + mn->RemoveItems (0, mn->CountItems (), true); +} + +/* Delete COUNT items from MENU starting from START. */ +void +BMenu_delete_from (void *menu, int start, int count) +{ + BMenu *mn = (BMenu *) menu; + mn->RemoveItems (start, count, true); +} + +/* Count items in menu MENU. */ +int +BMenu_count_items (void *menu) +{ + return ((BMenu *) menu)->CountItems (); +} + +/* Find the item in MENU at IDX. */ +void * +BMenu_item_at (void *menu, int idx) +{ + return ((BMenu *) menu)->ItemAt (idx); +} + +/* Set ITEM's label to LABEL. */ +void +BMenu_item_set_label (void *item, const char *label) +{ + ((BMenuItem *) item)->SetLabel (label); +} + +/* Get ITEM's menu. */ +void * +BMenu_item_get_menu (void *item) +{ + return ((BMenuItem *) item)->Submenu (); +} + +/* Emit a beep noise. */ +void +haiku_ring_bell (void) +{ + beep (); +} + +/* Create a BAlert with TEXT. */ +void * +BAlert_new (const char *text, enum haiku_alert_type type) +{ + return new BAlert (NULL, text, NULL, NULL, NULL, B_WIDTH_AS_USUAL, + (enum alert_type) type); +} + +/* Add a button to ALERT and return the button. */ +void * +BAlert_add_button (void *alert, const char *text) +{ + BAlert *al = (BAlert *) alert; + al->AddButton (text); + return al->ButtonAt (al->CountButtons () - 1); +} + +/* Run ALERT, returning the number of the button that was selected, + or -1 if no button was selected before the alert was closed. */ +int32_t +BAlert_go (void *alert) +{ + return ((BAlert *) alert)->Go (); +} + +/* Enable or disable BUTTON depending on ENABLED_P. */ +void +BButton_set_enabled (void *button, int enabled_p) +{ + ((BButton *) button)->SetEnabled (enabled_p); +} + +/* Set VIEW's tooltip to TOOLTIP. */ +void +BView_set_tooltip (void *view, const char *tooltip) +{ + ((BView *) view)->SetToolTip (tooltip); +} + +/* Set VIEW's tooltip to a sticky tooltip at X by Y. */ +void +BView_set_and_show_sticky_tooltip (void *view, const char *tooltip, + int x, int y) +{ + BToolTip *tip; + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view while showing sticky tooltip"); + vw->SetToolTip (tooltip); + tip = vw->ToolTip (); + BPoint pt; + EmacsView *ev = dynamic_cast (vw); + if (ev) + ev->tt_absl_pos = BPoint (x, y); + + vw->GetMouse (&pt, NULL, 1); + pt.x -= x; + pt.y -= y; + + pt.x = -pt.x; + pt.y = -pt.y; + + tip->SetMouseRelativeLocation (pt); + tip->SetSticky (1); + vw->ShowToolTip (tip); + vw->UnlockLooper (); +} + +/* Delete ALERT. */ +void +BAlert_delete (void *alert) +{ + delete (BAlert *) alert; +} + +/* Place the resolution of the monitor in DPI in RSSX and RSSY. */ +void +BScreen_res (double *rrsx, double *rrsy) +{ + BScreen s (B_MAIN_SCREEN_ID); + if (!s.IsValid ()) + gui_abort ("Invalid screen for resolution checks"); + monitor_info i; + + if (s.GetMonitorInfo (&i) == B_OK) + { + *rrsx = (double) i.width / (double) 2.54; + *rrsy = (double) i.height / (double) 2.54; + } + else + { + *rrsx = 72.27; + *rrsy = 72.27; + } +} + +/* Add WINDOW to OTHER_WINDOW's subset and parent it to + OTHER_WINDOW. */ +void +EmacsWindow_parent_to (void *window, void *other_window) +{ + EmacsWindow *w = (EmacsWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while parenting"); + w->ParentTo ((EmacsWindow *) other_window); + w->UnlockLooper (); +} + +void +EmacsWindow_unparent (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while unparenting"); + w->UnparentAndUnlink (); + w->UnlockLooper (); +} + +/* Place text describing the current version of Haiku in VERSION, + which should be a buffer LEN bytes wide. */ +void +be_get_version_string (char *version, int len) +{ + std::strncpy (version, "Unknown Haiku release", len - 1); + BPath path; + if (find_directory (B_BEOS_LIB_DIRECTORY, &path) == B_OK) + { + path.Append ("libbe.so"); + + BAppFileInfo appFileInfo; + version_info versionInfo; + BFile file; + if (file.SetTo (path.Path (), B_READ_ONLY) == B_OK + && appFileInfo.SetTo (&file) == B_OK + && appFileInfo.GetVersionInfo (&versionInfo, + B_APP_VERSION_KIND) == B_OK + && versionInfo.short_info[0] != '\0') + std::strncpy (version, versionInfo.short_info, len - 1); + } +} + +/* Return the amount of color planes in the current display. */ +int +be_get_display_planes (void) +{ + color_space space = dpy_color_space; + if (space == B_NO_COLOR_SPACE) + { + BScreen screen; /* This is actually a very slow operation. */ + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + space = dpy_color_space = screen.ColorSpace (); + } + + if (space == B_RGB32 || space == B_RGB24) + return 24; + if (space == B_RGB16) + return 16; + if (space == B_RGB15) + return 15; + if (space == B_CMAP8) + return 8; + + gui_abort ("Bad colorspace for screen"); + /* https://www.haiku-os.org/docs/api/classBScreen.html + says a valid screen can't be anything else. */ + return -1; +} + +/* Return the amount of colors the display can handle. */ +int +be_get_display_color_cells (void) +{ + color_space space = dpy_color_space; + if (space == B_NO_COLOR_SPACE) + { + BScreen screen; + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + space = dpy_color_space = screen.ColorSpace (); + } + + if (space == B_RGB32 || space == B_RGB24) + return 1677216; + if (space == B_RGB16) + return 65536; + if (space == B_RGB15) + return 32768; + if (space == B_CMAP8) + return 256; + + gui_abort ("Bad colorspace for screen"); + return -1; +} + +/* Warp the pointer to X by Y. */ +void +be_warp_pointer (int x, int y) +{ + /* We're not supposed to use the following function without a + BWindowScreen object, but in Haiku nothing actually prevents us + from doing so. */ + + set_mouse_position (x, y); +} + +/* Update the position of CHILD in WINDOW without actually moving + it. */ +void +EmacsWindow_move_weak_child (void *window, void *child, int xoff, int yoff) +{ + EmacsWindow *w = (EmacsWindow *) window; + EmacsWindow *c = (EmacsWindow *) child; + + if (!w->LockLooper ()) + gui_abort ("Couldn't lock window for weak move"); + w->MoveChild (c, xoff, yoff, 1); + w->UnlockLooper (); +} + +/* Find an appropriate view to draw onto. If VW is double-buffered, + this will be the view used for double buffering instead of VW + itself. */ +void * +find_appropriate_view_for_draw (void *vw) +{ + BView *v = (BView *) vw; + EmacsView *ev = dynamic_cast(v); + if (!ev) + return v; + + return ev->offscreen_draw_view ? ev->offscreen_draw_view : vw; +} + +/* Set up double buffering for VW. */ +void +EmacsView_set_up_double_buffering (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view while setting up double buffering"); + if (view->offscreen_draw_view) + { + view->UnlockLooper (); + return; + } + view->SetUpDoubleBuffering (); + view->UnlockLooper (); +} + +/* Flip and invalidate the view VW. */ +void +EmacsView_flip_and_blit (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->offscreen_draw_view) + return; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view in flip_and_blit"); + view->FlipBuffers (); + view->UnlockLooper (); +} + +/* Disable double buffering for VW. */ +void +EmacsView_disable_double_buffering (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view tearing down double buffering"); + view->TearDownDoubleBuffering (); + view->UnlockLooper (); +} + +/* Return non-0 if VW is double-buffered. */ +int +EmacsView_double_buffered_p (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view testing double buffering status"); + int db_p = !!view->offscreen_draw_view; + view->UnlockLooper (); + return db_p; +} + +struct popup_file_dialog_data +{ + BMessage *msg; + BFilePanel *panel; + BEntry *entry; +}; + +static void +unwind_popup_file_dialog (void *ptr) +{ + struct popup_file_dialog_data *data = + (struct popup_file_dialog_data *) ptr; + BFilePanel *panel = data->panel; + delete panel; + delete data->entry; + delete data->msg; +} + +static void +be_popup_file_dialog_safe_set_target (BFilePanel *dialog, BWindow *window) +{ + dialog->SetTarget (BMessenger (window)); +} + +/* Popup a file dialog. */ +char * +be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int dir_only_p, + void *window, const char *save_text, const char *prompt, + void (*block_input_function) (void), + void (*unblock_input_function) (void)) +{ + ptrdiff_t idx = c_specpdl_idx_from_cxx (); + /* setjmp/longjmp is UB with automatic objects. */ + block_input_function (); + BWindow *w = (BWindow *) window; + uint32_t mode = dir_only_p ? B_DIRECTORY_NODE : B_FILE_NODE | B_DIRECTORY_NODE; + BEntry *path = new BEntry; + BMessage *msg = new BMessage ('FPSE'); + BFilePanel *panel = new BFilePanel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, + NULL, NULL, mode); + unblock_input_function (); + + struct popup_file_dialog_data dat; + dat.entry = path; + dat.msg = msg; + dat.panel = panel; + + record_c_unwind_protect_from_cxx (unwind_popup_file_dialog, &dat); + if (default_dir) + { + if (path->SetTo (default_dir, 0) != B_OK) + default_dir = NULL; + } + + panel->SetMessage (msg); + if (default_dir) + panel->SetPanelDirectory (path); + if (save_text) + panel->SetSaveText (save_text); + panel->SetHideWhenDone (0); + panel->Window ()->SetTitle (prompt); + be_popup_file_dialog_safe_set_target (panel, w); + + panel->Show (); + panel->Window ()->Show (); + + void *buf = alloca (200); + while (1) + { + enum haiku_event_type type; + char *ptr = NULL; + + if (!haiku_read_with_timeout (&type, buf, 200, 100000)) + { + if (type != FILE_PANEL_EVENT) + haiku_write (type, buf); + else if (!ptr) + ptr = (char *) ((struct haiku_file_panel_event *) buf)->ptr; + } + + ssize_t b_s; + haiku_read_size (&b_s); + if (!b_s || b_s == -1 || ptr || panel->Window ()->IsHidden ()) + { + c_unbind_to_nil_from_cxx (idx); + return ptr; + } + } +} + +void +be_app_quit (void) +{ + if (be_app) + { + status_t e; + while (!be_app->Lock ()); + be_app->Quit (); + wait_for_thread (app_thread, &e); + } +} + +/* Temporarily fill VIEW with COLOR. */ +void +EmacsView_do_visible_bell (void *view, uint32_t color) +{ + EmacsView *vw = (EmacsView *) view; + vw->DoVisibleBell (color); +} + +/* Zoom WINDOW. */ +void +BWindow_zoom (void *window) +{ + BWindow *w = (BWindow *) window; + w->Zoom (); +} + +/* Make WINDOW fullscreen if FULLSCREEN_P. */ +void +EmacsWindow_make_fullscreen (void *window, int fullscreen_p) +{ + EmacsWindow *w = (EmacsWindow *) window; + w->MakeFullscreen (fullscreen_p); +} + +/* Unzoom (maximize) WINDOW. */ +void +EmacsWindow_unzoom (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + w->UnZoom (); +} + +/* Move the pointer into MBAR and start tracking. */ +void +BMenuBar_start_tracking (void *mbar) +{ + EmacsMenuBar *mb = (EmacsMenuBar *) mbar; + if (!mb->LockLooper ()) + gui_abort ("Couldn't lock menubar"); + BRect frame = mb->Frame (); + BPoint pt = frame.LeftTop (); + BPoint l = pt; + mb->Parent ()->ConvertToScreen (&pt); + set_mouse_position (pt.x, pt.y); + mb->MouseDown (l); + mb->UnlockLooper (); +} + +#ifdef HAVE_NATIVE_IMAGE_API +int +be_can_translate_type_to_bitmap_p (const char *mime) +{ + BTranslatorRoster *r = BTranslatorRoster::Default (); + translator_id *ids; + int32 id_len; + + if (r->GetAllTranslators (&ids, &id_len) != B_OK) + return 0; + + int found_in = 0; + int found_out = 0; + + for (int i = 0; i < id_len; ++i) + { + found_in = 0; + found_out = 0; + const translation_format *i_fmts; + const translation_format *o_fmts; + + int32 i_count, o_count; + + if (r->GetInputFormats (ids[i], &i_fmts, &i_count) != B_OK) + continue; + + if (r->GetOutputFormats (ids[i], &o_fmts, &o_count) != B_OK) + continue; + + for (int x = 0; x < i_count; ++x) + { + if (!strcmp (i_fmts[x].MIME, mime)) + { + found_in = 1; + break; + } + } + + for (int x = 0; x < i_count; ++x) + { + if (!strcmp (o_fmts[x].MIME, "image/x-be-bitmap") || + !strcmp (o_fmts[x].MIME, "image/x-vnd.Be-bitmap")) + { + found_out = 1; + break; + } + } + + if (found_in && found_out) + break; + } + + delete [] ids; + + return found_in && found_out; +} + +void * +be_translate_bitmap_from_file_name (const char *filename) +{ + BBitmap *bm = BTranslationUtils::GetBitmap (filename); + return bm; +} + +void * +be_translate_bitmap_from_memory (const void *buf, size_t bytes) +{ + BMemoryIO io (buf, bytes); + BBitmap *bm = BTranslationUtils::GetBitmap (&io); + return bm; +} +#endif + +/* Return the size of BITMAP's data, in bytes. */ +size_t +BBitmap_bytes_length (void *bitmap) +{ + BBitmap *bm = (BBitmap *) bitmap; + return bm->BitsLength (); +} + +/* Show VIEW's tooltip. */ +void +BView_show_tooltip (void *view) +{ + BView *vw = (BView *) view; + if (vw->LockLooper ()) + { + vw->ShowToolTip (vw->ToolTip ()); + vw->UnlockLooper (); + } +} + + +#ifdef USE_BE_CAIRO +/* Return VIEW's cairo surface. */ +cairo_surface_t * +EmacsView_cairo_surface (void *view) +{ + EmacsView *vw = (EmacsView *) view; + EmacsWindow *wn = (EmacsWindow *) vw->Window (); + return vw->cr_surface ? vw->cr_surface : wn->cr_surface; +} + +/* Transfer each clip rectangle in VIEW to the cairo context + CTX. */ +void +BView_cr_dump_clipping (void *view, cairo_t *ctx) +{ + BView *vw = (BView *) find_appropriate_view_for_draw (view); + BRegion cr; + vw->GetClippingRegion (&cr); + + for (int i = 0; i < cr.CountRects (); ++i) + { + BRect r = cr.RectAt (i); + cairo_rectangle (ctx, r.left, r.top, r.Width () + 1, + r.Height () + 1); + } + + cairo_clip (ctx); +} + +/* Lock WINDOW in preparation for drawing using Cairo. */ +void +EmacsWindow_begin_cr_critical_section (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + if (!w->surface_lock.Lock ()) + gui_abort ("Couldn't lock cairo surface"); + + BView *vw = (BView *) w->FindView ("Emacs"); + EmacsView *ev = dynamic_cast (vw); + if (ev && !ev->cr_surface_lock.Lock ()) + gui_abort ("Couldn't lock view cairo surface"); +} + +/* Unlock WINDOW in preparation for drawing using Cairo. */ +void +EmacsWindow_end_cr_critical_section (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + w->surface_lock.Unlock (); + BView *vw = (BView *) w->FindView ("Emacs"); + EmacsView *ev = dynamic_cast (vw); + if (ev) + ev->cr_surface_lock.Unlock (); +} +#endif + +/* Get the width of STR in the plain font. */ +int +be_string_width_with_plain_font (const char *str) +{ + return be_plain_font->StringWidth (str); +} + +/* Get the ascent + descent of the plain font. */ +int +be_plain_font_height (void) +{ + struct font_height fheight; + be_plain_font->GetHeight (&fheight); + + return fheight.ascent + fheight.descent; +} + +/* Return the number of physical displays connected. */ +int +be_get_display_screens (void) +{ + int count = 1; + BScreen scr; + + if (!scr.IsValid ()) + gui_abort ("Main screen vanished!"); + while (scr.SetToNext () == B_OK && scr.IsValid ()) + ++count; + + return count; +} + +/* Set the minimum width the user can resize WINDOW to. */ +void +BWindow_set_min_size (void *window, int width, int height) +{ + BWindow *w = (BWindow *) window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window looper setting min size"); + w->SetSizeLimits (width, -1, height, -1); + w->UnlockLooper (); +} + +/* Set the alignment of WINDOW's dimensions. */ +void +BWindow_set_size_alignment (void *window, int align_width, int align_height) +{ + BWindow *w = (BWindow *) window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window looper setting alignment"); +#if 0 /* Haiku does not currently implement SetWindowAlignment. */ + if (w->SetWindowAlignment (B_PIXEL_ALIGNMENT, -1, -1, align_width, + align_width, -1, -1, align_height, + align_height) != B_NO_ERROR) + gui_abort ("Invalid pixel alignment"); +#endif + w->UnlockLooper (); +} diff --git a/src/haiku_support.h b/src/haiku_support.h new file mode 100644 index 00000000000..9f5f3c77e3d --- /dev/null +++ b/src/haiku_support.h @@ -0,0 +1,869 @@ +/* Haiku window system support. Hey Emacs, this is -*- C++ -*- + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef _HAIKU_SUPPORT_H +#define _HAIKU_SUPPORT_H + +#include + +#ifdef HAVE_FREETYPE +#include +#include +#include FT_FREETYPE_H +#include FT_SIZES_H +#endif + +#ifdef USE_BE_CAIRO +#include +#endif + +enum haiku_cursor + { + CURSOR_ID_NO_CURSOR = 12, + CURSOR_ID_RESIZE_NORTH = 15, + CURSOR_ID_RESIZE_EAST = 16, + CURSOR_ID_RESIZE_SOUTH = 17, + CURSOR_ID_RESIZE_WEST = 18, + CURSOR_ID_RESIZE_NORTH_EAST = 19, + CURSOR_ID_RESIZE_NORTH_WEST = 20, + CURSOR_ID_RESIZE_SOUTH_EAST = 21, + CURSOR_ID_RESIZE_SOUTH_WEST = 22, + CURSOR_ID_RESIZE_NORTH_SOUTH = 23, + CURSOR_ID_RESIZE_EAST_WEST = 24, + CURSOR_ID_RESIZE_NORTH_EAST_SOUTH_WEST = 25, + CURSOR_ID_RESIZE_NORTH_WEST_SOUTH_EAST = 26 + }; + +enum haiku_alert_type + { + HAIKU_EMPTY_ALERT = 0, + HAIKU_INFO_ALERT, + HAIKU_IDEA_ALERT, + HAIKU_WARNING_ALERT, + HAIKU_STOP_ALERT + }; + +enum haiku_event_type + { + QUIT_REQUESTED, + FRAME_RESIZED, + FRAME_EXPOSED, + KEY_DOWN, + KEY_UP, + ACTIVATION, + MOUSE_MOTION, + BUTTON_DOWN, + BUTTON_UP, + ICONIFICATION, + MOVE_EVENT, + SCROLL_BAR_VALUE_EVENT, + SCROLL_BAR_DRAG_EVENT, + WHEEL_MOVE_EVENT, + MENU_BAR_RESIZE, + MENU_BAR_OPEN, + MENU_BAR_SELECT_EVENT, + MENU_BAR_CLOSE, + FILE_PANEL_EVENT, + MENU_BAR_HELP_EVENT, + ZOOM_EVENT, + REFS_EVENT, + APP_QUIT_REQUESTED_EVENT + }; + +struct haiku_quit_requested_event +{ + void *window; +}; + +struct haiku_resize_event +{ + void *window; + float px_heightf; + float px_widthf; +}; + +struct haiku_expose_event +{ + void *window; + int x; + int y; + int width; + int height; +}; + +struct haiku_refs_event +{ + void *window; + int x, y; + /* Free this with free! */ + char *ref; +}; + +struct haiku_app_quit_requested_event +{ + char dummy; +}; + +#define HAIKU_MODIFIER_ALT (1) +#define HAIKU_MODIFIER_CTRL (1 << 1) +#define HAIKU_MODIFIER_SHIFT (1 << 2) +#define HAIKU_MODIFIER_SUPER (1 << 3) + +struct haiku_key_event +{ + void *window; + int modifiers; + uint32_t mb_char; + uint32_t unraw_mb_char; + short kc; +}; + +struct haiku_activation_event +{ + void *window; + int activated_p; +}; + +struct haiku_mouse_motion_event +{ + void *window; + bool just_exited_p; + int x; + int y; + uint32_t be_code; +}; + +struct haiku_button_event +{ + void *window; + int btn_no; + int modifiers; + int x; + int y; +}; + +struct haiku_iconification_event +{ + void *window; + int iconified_p; +}; + +struct haiku_move_event +{ + void *window; + int x; + int y; +}; + +struct haiku_wheel_move_event +{ + void *window; + int modifiers; + float delta_x; + float delta_y; +}; + +struct haiku_menu_bar_select_event +{ + void *window; + void *ptr; +}; + +struct haiku_file_panel_event +{ + void *ptr; +}; + +struct haiku_menu_bar_help_event +{ + void *window; + int mb_idx; +}; + +struct haiku_zoom_event +{ + void *window; + int x; + int y; + int width; + int height; +}; + +#define FSPEC_FAMILY 1 +#define FSPEC_STYLE (1 << 1) +#define FSPEC_SLANT (1 << 2) +#define FSPEC_WEIGHT (1 << 3) +#define FSPEC_SPACING (1 << 4) +#define FSPEC_WANTED (1 << 5) +#define FSPEC_NEED_ONE_OF (1 << 6) +#define FSPEC_WIDTH (1 << 7) +#define FSPEC_LANGUAGE (1 << 8) + +typedef char haiku_font_family_or_style[64]; + +enum haiku_font_slant + { + NO_SLANT = -1, + SLANT_OBLIQUE, + SLANT_REGULAR, + SLANT_ITALIC + }; + +enum haiku_font_width + { + NO_WIDTH = -1, + ULTRA_CONDENSED, + EXTRA_CONDENSED, + CONDENSED, + SEMI_CONDENSED, + NORMAL_WIDTH, + SEMI_EXPANDED, + EXPANDED, + EXTRA_EXPANDED, + ULTRA_EXPANDED + }; + +enum haiku_font_language + { + LANGUAGE_CN, + LANGUAGE_KO, + LANGUAGE_JP, + MAX_LANGUAGE /* This isn't a language. */ + }; + +struct haiku_font_pattern +{ + int specified; + struct haiku_font_pattern *next; + /* The next two fields are only temporarily used during the font + discovery process! Do not rely on them being correct outside + BFont_find. */ + struct haiku_font_pattern *last; + struct haiku_font_pattern *next_family; + haiku_font_family_or_style family; + haiku_font_family_or_style style; + int weight; + int mono_spacing_p; + int want_chars_len; + int need_one_of_len; + enum haiku_font_slant slant; + enum haiku_font_width width; + enum haiku_font_language language; + uint32_t *wanted_chars; + uint32_t *need_one_of; + + int oblique_seen_p; +}; + +struct haiku_scroll_bar_value_event +{ + void *scroll_bar; + int position; +}; + +struct haiku_scroll_bar_drag_event +{ + void *scroll_bar; + int dragging_p; +}; + +struct haiku_menu_bar_resize_event +{ + void *window; + int width; + int height; +}; + +struct haiku_menu_bar_state_event +{ + void *window; +}; + +#define HAIKU_THIN 0 +#define HAIKU_ULTRALIGHT 20 +#define HAIKU_EXTRALIGHT 40 +#define HAIKU_LIGHT 50 +#define HAIKU_SEMI_LIGHT 75 +#define HAIKU_REGULAR 100 +#define HAIKU_SEMI_BOLD 180 +#define HAIKU_BOLD 200 +#define HAIKU_EXTRA_BOLD 205 +#define HAIKU_ULTRA_BOLD 210 +#define HAIKU_BOOK 400 +#define HAIKU_HEAVY 800 +#define HAIKU_ULTRA_HEAVY 900 +#define HAIKU_BLACK 1000 +#define HAIKU_MEDIUM 2000 + +#ifdef __cplusplus +extern "C" +{ +#endif +#include +#include + +#ifdef __cplusplus + typedef void *haiku; + + extern void + haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel); + + extern unsigned long + haiku_get_pixel (haiku bitmap, int x, int y); +#endif + + extern port_id port_application_to_emacs; + + extern void haiku_io_init (void); + extern void haiku_io_init_in_app_thread (void); + + extern void + haiku_read_size (ssize_t *len); + + extern int + haiku_read (enum haiku_event_type *type, void *buf, ssize_t len); + + extern int + haiku_read_with_timeout (enum haiku_event_type *type, void *buf, ssize_t len, + time_t timeout); + + extern int + haiku_write (enum haiku_event_type type, void *buf); + + extern int + haiku_write_without_signal (enum haiku_event_type type, void *buf); + + extern void + rgb_color_hsl (uint32_t rgb, double *h, double *s, double *l); + + extern void + hsl_color_rgb (double h, double s, double l, uint32_t *rgb); + + extern void * + BBitmap_new (int width, int height, int mono_p); + + extern void * + BBitmap_data (void *bitmap); + + extern int + BBitmap_convert (void *bitmap, void **new_bitmap); + + extern void + BBitmap_free (void *bitmap); + + extern void + BBitmap_dimensions (void *bitmap, int *left, int *top, + int *right, int *bottom, int32_t *bytes_per_row, + int *mono_p); + + extern void * + BApplication_setup (void); + + extern void * + BWindow_new (void *view); + + extern void + BWindow_quit (void *window); + + extern void + BWindow_set_offset (void *window, int x, int y); + + extern void + BWindow_iconify (void *window); + + extern void + BWindow_set_visible (void *window, int visible_p); + + extern void + BFont_close (void *font); + + extern void + BFont_dat (void *font, int *px_size, int *min_width, int *max_width, + int *avg_width, int *height, int *space_width, int *ascent, + int *descent, int *underline_position, int *underline_thickness); + + extern int + BFont_have_char_p (void *font, int32_t chr); + + extern int + BFont_have_char_block (void *font, int32_t beg, int32_t end); + + extern void + BFont_char_bounds (void *font, const char *mb_str, int *advance, + int *lb, int *rb); + + extern void + BFont_nchar_bounds (void *font, const char *mb_str, int *advance, + int *lb, int *rb, int32_t n); + + extern void + BWindow_retitle (void *window, const char *title); + + extern void + BWindow_resize (void *window, int width, int height); + + extern void + BWindow_activate (void *window); + + extern void + BView_StartClip (void *view); + + extern void + BView_EndClip (void *view); + + extern void + BView_SetHighColor (void *view, uint32_t color); + + extern void + BView_SetHighColorForVisibleBell (void *view, uint32_t color); + + extern void + BView_FillRectangleForVisibleBell (void *view, int x, int y, int width, + int height); + + extern void + BView_SetLowColor (void *view, uint32_t color); + + extern void + BView_SetPenSize (void *view, int u); + + extern void + BView_SetFont (void *view, void *font); + + extern void + BView_MovePenTo (void *view, int x, int y); + + extern void + BView_DrawString (void *view, const char *chr, ptrdiff_t len); + + extern void + BView_DrawChar (void *view, char chr); + + extern void + BView_FillRectangle (void *view, int x, int y, int width, int height); + + extern void + BView_FillRectangleAbs (void *view, int x, int y, int x1, int y1); + + extern void + BView_FillTriangle (void *view, int x1, int y1, + int x2, int y2, int x3, int y3); + + extern void + BView_StrokeRectangle (void *view, int x, int y, int width, int height); + + extern void + BView_SetViewColor (void *view, uint32_t color); + + extern void + BView_ClipToRect (void *view, int x, int y, int width, int height); + + extern void + BView_ClipToInverseRect (void *view, int x, int y, int width, int height); + + extern void + BView_StrokeLine (void *view, int sx, int sy, int tx, int ty); + + extern void + BView_CopyBits (void *view, int x, int y, int width, int height, + int tox, int toy, int towidth, int toheight); + + extern void + BView_DrawBitmap (void *view, void *bitmap, int x, int y, + int width, int height, int vx, int vy, int vwidth, + int vheight); + + extern void + BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x, + int y, int width, int height); + + extern void + BView_DrawMask (void *src, void *view, + int x, int y, int width, int height, + int vx, int vy, int vwidth, int vheight, + uint32_t color); + + extern void * + BBitmap_transform_bitmap (void *bitmap, void *mask, uint32_t m_color, + double rot, int desw, int desh); + + extern void + BScreen_px_dim (int *width, int *height); + + extern void + BView_resize_to (void *view, int width, int height); + + /* Functions for creating and freeing cursors. */ + extern void * + BCursor_create_default (void); + + extern void * + BCursor_from_id (enum haiku_cursor cursor); + + extern void * + BCursor_create_modeline (void); + + extern void * + BCursor_create_i_beam (void); + + extern void * + BCursor_create_progress_cursor (void); + + extern void * + BCursor_create_grab (void); + + extern void + BCursor_delete (void *cursor); + + extern void + BView_set_view_cursor (void *view, void *cursor); + + extern void + BWindow_Flush (void *window); + + extern void + BMapKey (uint32_t kc, int *non_ascii_p, unsigned *code); + + extern void * + BScrollBar_make_for_view (void *view, int horizontal_p, + int x, int y, int x1, int y1, + void *scroll_bar_ptr); + + extern void + BScrollBar_delete (void *sb); + + extern void + BView_move_frame (void *view, int x, int y, int x1, int y1); + + extern void + BView_scroll_bar_update (void *sb, int portion, int whole, int position); + + extern int + BScrollBar_default_size (int horizontal_p); + + extern void + BView_invalidate (void *view); + + extern void + BView_draw_lock (void *view); + + extern void + BView_draw_unlock (void *view); + + extern void + BWindow_center_on_screen (void *window); + + extern void + BView_mouse_moved (void *view, int x, int y, uint32_t transit); + + extern void + BView_mouse_down (void *view, int x, int y); + + extern void + BView_mouse_up (void *view, int x, int y); + + extern void + BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h); + + extern void + haiku_font_pattern_free (struct haiku_font_pattern *pt); + + extern struct haiku_font_pattern * + BFont_find (struct haiku_font_pattern *pt); + + extern int + BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size); + + extern void + BFont_populate_fixed_family (struct haiku_font_pattern *ptn); + + extern void + BFont_populate_plain_family (struct haiku_font_pattern *ptn); + + extern void + BView_publish_scroll_bar (void *view, int x, int y, int width, int height); + + extern void + BView_forget_scroll_bar (void *view, int x, int y, int width, int height); + + extern void + BView_get_mouse (void *view, int *x, int *y); + + extern void + BView_convert_to_screen (void *view, int *x, int *y); + + extern void + BView_convert_from_screen (void *view, int *x, int *y); + + extern void + BWindow_change_decoration (void *window, int decorate_p); + + extern void + BWindow_set_tooltip_decoration (void *window); + + extern void + BWindow_set_avoid_focus (void *window, int avoid_focus_p); + + extern void + BView_emacs_delete (void *view); + + extern uint32_t + haiku_current_workspace (void); + + extern uint32_t + BWindow_workspaces (void *window); + + extern void * + BPopUpMenu_new (const char *name); + + extern void + BMenu_add_item (void *menu, const char *label, void *ptr, bool enabled_p, + bool marked_p, bool mbar_p, void *mbw_ptr, const char *key, + const char *help); + + extern void + BMenu_add_separator (void *menu); + + extern void * + BMenu_new_submenu (void *menu, const char *label, bool enabled_p); + + extern void * + BMenu_new_menu_bar_submenu (void *menu, const char *label); + + extern int + BMenu_count_items (void *menu); + + extern void * + BMenu_item_at (void *menu, int idx); + + extern void * + BMenu_run (void *menu, int x, int y); + + extern void + BPopUpMenu_delete (void *menu); + + extern void * + BMenuBar_new (void *view); + + extern void + BMenu_delete_all (void *menu); + + extern void + BMenuBar_delete (void *menubar); + + extern void + BMenu_item_set_label (void *item, const char *label); + + extern void * + BMenu_item_get_menu (void *item); + + extern void + BMenu_delete_from (void *menu, int start, int count); + + extern void + haiku_ring_bell (void); + + extern void * + BAlert_new (const char *text, enum haiku_alert_type type); + + extern void * + BAlert_add_button (void *alert, const char *text); + + extern int32_t + BAlert_go (void *alert); + + extern void + BButton_set_enabled (void *button, int enabled_p); + + extern void + BView_set_tooltip (void *view, const char *tooltip); + + extern void + BAlert_delete (void *alert); + + extern void + BScreen_res (double *rrsx, double *rrsy); + + extern void + EmacsWindow_parent_to (void *window, void *other_window); + + extern void + EmacsWindow_unparent (void *window); + + extern int + BFont_string_width (void *font, const char *utf8); + + extern void + be_get_version_string (char *version, int len); + + extern int + be_get_display_planes (void); + + extern int + be_get_display_color_cells (void); + + extern void + be_warp_pointer (int x, int y); + + extern void + EmacsWindow_move_weak_child (void *window, void *child, int xoff, int yoff); + + extern void + EmacsView_set_up_double_buffering (void *vw); + + extern void + EmacsView_disable_double_buffering (void *vw); + + extern void + EmacsView_flip_and_blit (void *vw); + + extern int + EmacsView_double_buffered_p (void *vw); + + extern char * + be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, + int dir_only_p, void *window, const char *save_text, + const char *prompt, + void (*block_input_function) (void), + void (*unblock_input_function) (void)); + + extern void + record_c_unwind_protect_from_cxx (void (*) (void *), void *); + + extern ptrdiff_t + c_specpdl_idx_from_cxx (void); + + extern void + c_unbind_to_nil_from_cxx (ptrdiff_t idx); + + extern void + EmacsView_do_visible_bell (void *view, uint32_t color); + + extern void + BWindow_zoom (void *window); + + extern void + EmacsWindow_make_fullscreen (void *window, int fullscreen_p); + + extern void + EmacsWindow_unzoom (void *window); + +#ifdef HAVE_NATIVE_IMAGE_API + extern int + be_can_translate_type_to_bitmap_p (const char *mime); + + extern void * + be_translate_bitmap_from_file_name (const char *filename); + + extern void * + be_translate_bitmap_from_memory (const void *buf, size_t bytes); +#endif + + extern void + BMenuBar_start_tracking (void *mbar); + + extern size_t + BBitmap_bytes_length (void *bitmap); + + extern void + BView_show_tooltip (void *view); + +#ifdef USE_BE_CAIRO + extern cairo_surface_t * + EmacsView_cairo_surface (void *view); + + extern void + BView_cr_dump_clipping (void *view, cairo_t *ctx); + + extern void + EmacsWindow_begin_cr_critical_section (void *window); + + extern void + EmacsWindow_end_cr_critical_section (void *window); +#endif + + extern void + BView_set_and_show_sticky_tooltip (void *view, const char *tooltip, + int x, int y); + + extern void + BMenu_add_title (void *menu, const char *text); + + extern int + be_plain_font_height (void); + + extern int + be_string_width_with_plain_font (const char *str); + + extern int + be_get_display_screens (void); + + extern void + BWindow_set_min_size (void *window, int width, int height); + + extern void + BWindow_set_size_alignment (void *window, int align_width, int align_height); + +#ifdef __cplusplus + extern void * + find_appropriate_view_for_draw (void *vw); +} + +extern _Noreturn void +gui_abort (const char *msg); +#endif /* _cplusplus */ + +/* Borrowed from X.Org keysymdef.h */ +#define XK_BackSpace 0xff08 /* Back space, back char */ +#define XK_Tab 0xff09 +#define XK_Linefeed 0xff0a /* Linefeed, LF */ +#define XK_Clear 0xff0b +#define XK_Return 0xff0d /* Return, enter */ +#define XK_Pause 0xff13 /* Pause, hold */ +#define XK_Scroll_Lock 0xff14 +#define XK_Sys_Req 0xff15 +#define XK_Escape 0xff1b +#define XK_Delete 0xffff /* Delete, rubout */ +#define XK_Home 0xff50 +#define XK_Left 0xff51 /* Move left, left arrow */ +#define XK_Up 0xff52 /* Move up, up arrow */ +#define XK_Right 0xff53 /* Move right, right arrow */ +#define XK_Down 0xff54 /* Move down, down arrow */ +#define XK_Prior 0xff55 /* Prior, previous */ +#define XK_Page_Up 0xff55 +#define XK_Next 0xff56 /* Next */ +#define XK_Page_Down 0xff56 +#define XK_End 0xff57 /* EOL */ +#define XK_Begin 0xff58 /* BOL */ +#define XK_Select 0xff60 /* Select, mark */ +#define XK_Print 0xff61 +#define XK_Execute 0xff62 /* Execute, run, do */ +#define XK_Insert 0xff63 /* Insert, insert here */ +#define XK_Undo 0xff65 +#define XK_Redo 0xff66 /* Redo, again */ +#define XK_Menu 0xff67 +#define XK_Find 0xff68 /* Find, search */ +#define XK_Cancel 0xff69 /* Cancel, stop, abort, exit */ +#define XK_Help 0xff6a /* Help */ +#define XK_Break 0xff6b +#define XK_Mode_switch 0xff7e /* Character set switch */ +#define XK_script_switch 0xff7e /* Alias for mode_switch */ +#define XK_Num_Lock 0xff7f +#define XK_F1 0xffbe + +#endif /* _HAIKU_SUPPORT_H_ */ diff --git a/src/haikufns.c b/src/haikufns.c new file mode 100644 index 00000000000..868fc71f979 --- /dev/null +++ b/src/haikufns.c @@ -0,0 +1,2448 @@ +/* Haiku window system support + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include + +#include "lisp.h" +#include "frame.h" +#include "blockinput.h" +#include "termchar.h" +#include "font.h" +#include "keyboard.h" +#include "buffer.h" +#include "dispextern.h" + +#include "haikugui.h" +#include "haikuterm.h" +#include "haiku_support.h" +#include "termhooks.h" + +#include + +#include + +#define RGB_TO_ULONG(r, g, b) \ + (((r) << 16) | ((g) << 8) | (b)); +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) + +/* The frame of the currently visible tooltip. */ +static Lisp_Object tip_frame; + +/* The window-system window corresponding to the frame of the + currently visible tooltip. */ +static Window tip_window; + +/* A timer that hides or deletes the currently visible tooltip when it + fires. */ +static Lisp_Object tip_timer; + +/* STRING argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_string; + +/* Normalized FRAME argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_frame; + +/* PARMS argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_parms; + +static void +haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval); +static void +haiku_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name); + +static ptrdiff_t image_cache_refcount; + +static Lisp_Object +get_geometry_from_preferences (struct haiku_display_info *dpyinfo, + Lisp_Object parms) +{ + struct { + const char *val; + const char *cls; + Lisp_Object tem; + } r[] = { + { "width", "Width", Qwidth }, + { "height", "Height", Qheight }, + { "left", "Left", Qleft }, + { "top", "Top", Qtop }, + }; + + int i; + for (i = 0; i < ARRAYELTS (r); ++i) + { + if (NILP (Fassq (r[i].tem, parms))) + { + Lisp_Object value + = gui_display_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls, + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (r[i].tem, value), parms); + } + } + + return parms; +} + +void +haiku_change_tool_bar_height (struct frame *f, int height) +{ + int unit = FRAME_LINE_HEIGHT (f); + int old_height = FRAME_TOOL_BAR_HEIGHT (f); + int lines = (height + unit - 1) / unit; + Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + + /* Make sure we redisplay all windows in this frame. */ + fset_redisplay (f); + + FRAME_TOOL_BAR_HEIGHT (f) = height; + FRAME_TOOL_BAR_LINES (f) = lines; + store_frame_param (f, Qtool_bar_lines, make_fixnum (lines)); + + if (FRAME_HAIKU_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0) + { + clear_frame (f); + clear_current_matrices (f); + } + + if ((height < old_height) && WINDOWP (f->tool_bar_window)) + clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); + + if (!f->tool_bar_resized) + { + /* As long as tool_bar_resized is false, effectively try to change + F's native height. */ + if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth)) + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 1, false, Qtool_bar_lines); + else + adjust_frame_size (f, -1, -1, 4, false, Qtool_bar_lines); + + f->tool_bar_resized = f->tool_bar_redisplayed; + } + else + /* Any other change may leave the native size of F alone. */ + adjust_frame_size (f, -1, -1, 3, false, Qtool_bar_lines); + + /* adjust_frame_size might not have done anything, garbage frame + here. */ + adjust_frame_glyphs (f); + SET_FRAME_GARBAGED (f); + + if (FRAME_HAIKU_WINDOW (f)) + haiku_clear_under_internal_border (f); +} + +void +haiku_change_tab_bar_height (struct frame *f, int height) +{ + int unit = FRAME_LINE_HEIGHT (f); + int old_height = FRAME_TAB_BAR_HEIGHT (f); + int lines = (height + unit - 1) / unit; + Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + + /* Make sure we redisplay all windows in this frame. */ + fset_redisplay (f); + + /* Recalculate tab bar and frame text sizes. */ + FRAME_TAB_BAR_HEIGHT (f) = height; + FRAME_TAB_BAR_LINES (f) = lines; + store_frame_param (f, Qtab_bar_lines, make_fixnum (lines)); + + if (FRAME_HAIKU_WINDOW (f) && FRAME_TAB_BAR_HEIGHT (f) == 0) + { + clear_frame (f); + clear_current_matrices (f); + } + + if ((height < old_height) && WINDOWP (f->tab_bar_window)) + clear_glyph_matrix (XWINDOW (f->tab_bar_window)->current_matrix); + + if (!f->tab_bar_resized) + { + /* As long as tab_bar_resized is false, effectively try to change + F's native height. */ + if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth)) + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 1, false, Qtab_bar_lines); + else + adjust_frame_size (f, -1, -1, 4, false, Qtab_bar_lines); + + f->tab_bar_resized = f->tab_bar_redisplayed; + } + else + /* Any other change may leave the native size of F alone. */ + adjust_frame_size (f, -1, -1, 3, false, Qtab_bar_lines); + + /* adjust_frame_size might not have done anything, garbage frame + here. */ + adjust_frame_glyphs (f); + SET_FRAME_GARBAGED (f); + if (FRAME_HAIKU_WINDOW (f)) + haiku_clear_under_internal_border (f); +} + +static void +haiku_set_no_focus_on_map (struct frame *f, Lisp_Object value, + Lisp_Object oldval) +{ + if (!EQ (value, oldval)) + FRAME_NO_FOCUS_ON_MAP (f) = !NILP (value); +} + +static void +haiku_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + int nlines; + + /* Treat tool bars like menu bars. */ + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + /* Use VALUE only if an int >= 0. */ + if (RANGED_FIXNUMP (0, value, INT_MAX)) + nlines = XFIXNAT (value); + else + nlines = 0; + + haiku_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + +static void +haiku_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + int olines = FRAME_TAB_BAR_LINES (f); + int nlines; + + /* Treat tab bars like menu bars. */ + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + /* Use VALUE only if an int >= 0. */ + if (RANGED_FIXNUMP (0, value, INT_MAX)) + nlines = XFIXNAT (value); + else + nlines = 0; + + if (nlines != olines && (olines == 0 || nlines == 0)) + haiku_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + + +int +haiku_get_color (const char *name, Emacs_Color *color) +{ + unsigned short r16, g16, b16; + Lisp_Object tem; + + if (parse_color_spec (name, &r16, &g16, &b16)) + { + color->pixel = RGB_TO_ULONG (r16 / 256, g16 / 256, b16 / 256); + color->red = r16; + color->green = g16; + color->blue = b16; + return 0; + } + else + { + block_input (); + eassert (x_display_list && !NILP (x_display_list->color_map)); + tem = x_display_list->color_map; + for (; CONSP (tem); tem = XCDR (tem)) + { + Lisp_Object col = XCAR (tem); + if (CONSP (col) && !xstrcasecmp (SSDATA (XCAR (col)), name)) + { + int32_t clr = XFIXNUM (XCDR (col)); + color->pixel = clr; + color->red = RED_FROM_ULONG (clr) * 257; + color->green = GREEN_FROM_ULONG (clr) * 257; + color->blue = BLUE_FROM_ULONG (clr) * 257; + unblock_input (); + return 0; + } + } + + unblock_input (); + } + + return 1; +} + +static struct haiku_display_info * +haiku_display_info_for_name (Lisp_Object name) +{ + CHECK_STRING (name); + + if (!NILP (Fstring_equal (name, build_string ("be")))) + { + if (!x_display_list) + return x_display_list; + + error ("Be windowing not initialized"); + } + + error ("Be displays can only be named \"be\""); +} + +static struct haiku_display_info * +check_haiku_display_info (Lisp_Object object) +{ + struct haiku_display_info *dpyinfo = NULL; + + if (NILP (object)) + { + struct frame *sf = XFRAME (selected_frame); + + if (FRAME_HAIKU_P (sf) && FRAME_LIVE_P (sf)) + dpyinfo = FRAME_DISPLAY_INFO (sf); + else if (x_display_list) + dpyinfo = x_display_list; + else + error ("Be windowing not present"); + } + else if (TERMINALP (object)) + { + struct terminal *t = decode_live_terminal (object); + + if (t->type != output_haiku) + error ("Terminal %d is not a Be display", t->id); + + dpyinfo = t->display_info.haiku; + } + else if (STRINGP (object)) + dpyinfo = haiku_display_info_for_name (object); + else + { + struct frame *f = decode_window_system_frame (object); + dpyinfo = FRAME_DISPLAY_INFO (f); + } + + return dpyinfo; +} + +static void +haiku_set_title_bar_text (struct frame *f, Lisp_Object text) +{ + if (FRAME_HAIKU_WINDOW (f)) + { + block_input (); + BWindow_retitle (FRAME_HAIKU_WINDOW (f), SSDATA (ENCODE_UTF_8 (text))); + unblock_input (); + } +} + +static void +haiku_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) +{ + /* Don't change the title if it's already NAME. */ + if (EQ (name, f->title)) + return; + + update_mode_lines = 26; + + fset_title (f, name); + + if (NILP (name)) + name = f->name; + + haiku_set_title_bar_text (f, name); +} + +static void +haiku_set_child_frame_border_width (struct frame *f, + Lisp_Object arg, Lisp_Object oldval) +{ + int border; + + if (NILP (arg)) + border = -1; + else if (RANGED_FIXNUMP (0, arg, INT_MAX)) + border = XFIXNAT (arg); + else + signal_error ("Invalid child frame border width", arg); + + if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f)) + { + f->child_frame_border_width = border; + + if (FRAME_HAIKU_WINDOW (f)) + adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width); + + SET_FRAME_GARBAGED (f); + } +} + +static void +haiku_set_parent_frame (struct frame *f, + Lisp_Object new_value, Lisp_Object old_value) +{ + struct frame *p = NULL; + block_input (); + if (!NILP (new_value) + && (!FRAMEP (new_value) + || !FRAME_LIVE_P (p = XFRAME (new_value)) + || !FRAME_HAIKU_P (p))) + { + store_frame_param (f, Qparent_frame, old_value); + unblock_input (); + error ("Invalid specification of `parent-frame'"); + } + + if (EQ (new_value, old_value)) + { + unblock_input (); + return; + } + + if (!NILP (old_value)) + EmacsWindow_unparent (FRAME_HAIKU_WINDOW (f)); + if (!NILP (new_value)) + { + EmacsWindow_parent_to (FRAME_HAIKU_WINDOW (f), + FRAME_HAIKU_WINDOW (p)); + BWindow_set_offset (FRAME_HAIKU_WINDOW (f), + f->left_pos, f->top_pos); + } + fset_parent_frame (f, new_value); + unblock_input (); +} + +static void +haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + haiku_set_name (f, arg, 1); +} + +static void +haiku_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +{ + block_input (); + if (!EQ (new_value, old_value)) + FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); + + if (FRAME_HAIKU_WINDOW (f)) + { + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), + FRAME_NO_ACCEPT_FOCUS (f)); + } + unblock_input (); +} + +static void +unwind_create_frame (Lisp_Object frame) +{ + struct frame *f = XFRAME (frame); + + /* If frame is already dead, nothing to do. This can happen if the + display is disconnected after the frame has become official, but + before x_create_frame removes the unwind protect. */ + if (!FRAME_LIVE_P (f)) + return; + + /* If frame is ``official'', nothing to do. */ + if (NILP (Fmemq (frame, Vframe_list))) + { +#if defined GLYPH_DEBUG && defined ENABLE_CHECKING + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); +#endif + + /* If the frame's image cache refcount is still the same as our + private shadow variable, it means we are unwinding a frame + for which we didn't yet call init_frame_faces, where the + refcount is incremented. Therefore, we increment it here, so + that free_frame_faces, called in free_frame_resources later, + will not mistakenly decrement the counter that was not + incremented yet to account for this new frame. */ + if (FRAME_IMAGE_CACHE (f) != NULL + && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount) + FRAME_IMAGE_CACHE (f)->refcount++; + + haiku_free_frame_resources (f); + free_glyphs (f); + +#if defined GLYPH_DEBUG && defined ENABLE_CHECKING + /* Check that reference counts are indeed correct. */ + if (dpyinfo->terminal->image_cache) + eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount); +#endif + } +} + +static void +unwind_create_tip_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); + tip_window = NULL; + tip_frame = Qnil; +} + +static void +haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct haiku_output *output = FRAME_OUTPUT_DATA (f); + unsigned long old_fg; + + Emacs_Color color; + + if (haiku_get_color (SSDATA (arg), &color)) + { + store_frame_param (f, Qforeground_color, oldval); + unblock_input (); + error ("Bad color"); + } + + old_fg = FRAME_FOREGROUND_PIXEL (f); + FRAME_FOREGROUND_PIXEL (f) = color.pixel; + + if (FRAME_HAIKU_WINDOW (f)) + { + + block_input (); + if (output->cursor_color.pixel == old_fg) + { + output->cursor_color.pixel = old_fg; + output->cursor_color.red = RED_FROM_ULONG (old_fg); + output->cursor_color.green = GREEN_FROM_ULONG (old_fg); + output->cursor_color.blue = BLUE_FROM_ULONG (old_fg); + } + + unblock_input (); + + update_face_from_frame_parameter (f, Qforeground_color, arg); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + +static void +unwind_popup (void) +{ + if (!popup_activated_p) + emacs_abort (); + --popup_activated_p; +} + +static Lisp_Object +haiku_create_frame (Lisp_Object parms, int ttip_p) +{ + struct frame *f; + Lisp_Object frame, tem; + Lisp_Object name; + bool minibuffer_only = false; + bool face_change_before = face_change; + long window_prompting = 0; + ptrdiff_t count = SPECPDL_INDEX (); + Lisp_Object display; + struct haiku_display_info *dpyinfo = NULL; + struct kboard *kb; + + parms = Fcopy_alist (parms); + + Vx_resource_name = Vinvocation_name; + + display = gui_display_get_arg (dpyinfo, parms, Qterminal, 0, 0, + RES_TYPE_STRING); + if (EQ (display, Qunbound)) + display = Qnil; + dpyinfo = check_haiku_display_info (display); + kb = dpyinfo->terminal->kboard; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + name = gui_display_get_arg (dpyinfo, parms, Qname, 0, 0, + RES_TYPE_STRING); + if (!STRINGP (name) + && ! EQ (name, Qunbound) + && ! NILP (name)) + error ("Invalid frame name--not a string or nil"); + + if (STRINGP (name)) + Vx_resource_name = name; + + block_input (); + + /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ + /* No need to protect DISPLAY because that's not used after passing + it to make_frame_without_minibuffer. */ + frame = Qnil; + tem = gui_display_get_arg (dpyinfo, parms, Qminibuffer, + "minibuffer", "Minibuffer", + RES_TYPE_SYMBOL); + if (ttip_p) + f = make_frame (0); + else if (EQ (tem, Qnone) || NILP (tem)) + f = make_frame_without_minibuffer (Qnil, kb, display); + else if (EQ (tem, Qonly)) + { + f = make_minibuffer_frame (); + minibuffer_only = 1; + } + else if (WINDOWP (tem)) + f = make_frame_without_minibuffer (tem, kb, display); + else + f = make_frame (1); + XSETFRAME (frame, f); + + f->terminal = dpyinfo->terminal; + + f->output_method = output_haiku; + f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + + f->output_data.haiku->pending_zoom_x = INT_MIN; + f->output_data.haiku->pending_zoom_y = INT_MIN; + f->output_data.haiku->pending_zoom_width = INT_MIN; + f->output_data.haiku->pending_zoom_height = INT_MIN; + + if (ttip_p) + f->wants_modeline = false; + + fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, Qicon_name, + "iconName", "Title", + RES_TYPE_STRING)); + if (! STRINGP (f->icon_name) || ttip_p) + fset_icon_name (f, Qnil); + + FRAME_DISPLAY_INFO (f) = dpyinfo; + + /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */ + if (!ttip_p) + record_unwind_protect (unwind_create_frame, frame); + else + record_unwind_protect (unwind_create_tip_frame, frame); + + FRAME_OUTPUT_DATA (f)->parent_desc = NULL; + FRAME_OUTPUT_DATA (f)->explicit_parent = 0; + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name)) + { + fset_name (f, Vinvocation_name); + f->explicit_name = 0; + } + else + { + fset_name (f, name); + f->explicit_name = 1; + specbind (Qx_resource_name, name); + } + +#ifdef USE_BE_CAIRO + register_font_driver (&ftcrfont_driver, f); +#ifdef HAVE_HARFBUZZ + register_font_driver (&ftcrhbfont_driver, f); +#endif +#endif + register_font_driver (&haikufont_driver, f); + + f->tooltip = ttip_p; + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + FRAME_RIF (f)->default_font_parameter (f, parms); + + unblock_input (); + + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderwidth", "BorderWidth", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (ttip_p ? 1 : 2), + "internalBorderWidth", "InternalBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, + "childFrameBorderWidth", "childFrameBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qvertical_scroll_bars, !ttip_p ? Qt : Qnil, + "verticalScrollBars", "VerticalScrollBars", + RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil, + "horizontalScrollBars", "HorizontalScrollBars", + RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qline_spacing, Qnil, + "lineSpacing", "LineSpacing", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qleft_fringe, Qnil, + "leftFringe", "LeftFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_fringe, Qnil, + "rightFringe", "RightFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qno_special_glyphs, ttip_p ? Qnil : Qt, + NULL, NULL, RES_TYPE_BOOLEAN); + + init_frame_faces (f); + + /* Read comment about this code in corresponding place in xfns.c. */ + tem = gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, + RES_TYPE_NUMBER); + if (FIXNUMP (tem)) + store_frame_param (f, Qmin_width, tem); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, + RES_TYPE_NUMBER); + if (FIXNUMP (tem)) + store_frame_param (f, Qmin_height, tem); + adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), + FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, + Qx_create_frame_1); + + if (!ttip_p) + { + gui_default_parameter (f, parms, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qno_focus_on_map, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qno_accept_focus, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* The resources controlling the menu-bar, tool-bar, and tab-bar are + processed specially at startup, and reflected in the mode + variables; ignore them here. */ + gui_default_parameter (f, parms, Qmenu_bar_lines, + NILP (Vmenu_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtab_bar_lines, + NILP (Vtab_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtool_bar_lines, + NILP (Vtool_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate", + "BufferPredicate", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qtitle, Qnil, "title", "Title", + RES_TYPE_STRING); + } + + parms = get_geometry_from_preferences (dpyinfo, parms); + window_prompting = gui_figure_window_size (f, parms, false, true); + + if (ttip_p) + { + /* No fringes on tip frame. */ + f->fringe_cols = 0; + f->left_fringe_width = 0; + f->right_fringe_width = 0; + /* No dividers on tip frame. */ + f->right_divider_width = 0; + f->bottom_divider_width = 0; + } + + tem = gui_display_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, + RES_TYPE_BOOLEAN); + f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !NILP (tem)); + + /* Add `tooltip' frame parameter's default value. */ + if (NILP (Fframe_parameter (frame, Qtooltip)) && ttip_p) + Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil)); + +#define ASSIGN_CURSOR(cursor, be_cursor) \ + (FRAME_OUTPUT_DATA (f)->cursor = be_cursor) + + ASSIGN_CURSOR (text_cursor, BCursor_create_i_beam ()); + ASSIGN_CURSOR (nontext_cursor, BCursor_create_default ()); + ASSIGN_CURSOR (modeline_cursor, BCursor_create_modeline ()); + ASSIGN_CURSOR (hand_cursor, BCursor_create_grab ()); + ASSIGN_CURSOR (hourglass_cursor, BCursor_create_progress_cursor ()); + ASSIGN_CURSOR (horizontal_drag_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_EAST_WEST)); + ASSIGN_CURSOR (vertical_drag_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH_SOUTH)); + ASSIGN_CURSOR (left_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_WEST)); + ASSIGN_CURSOR (top_left_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH_WEST)); + ASSIGN_CURSOR (top_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH)); + ASSIGN_CURSOR (top_right_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH_EAST)); + ASSIGN_CURSOR (right_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_EAST)); + ASSIGN_CURSOR (bottom_right_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_SOUTH_EAST)); + ASSIGN_CURSOR (bottom_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_SOUTH)); + ASSIGN_CURSOR (bottom_left_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_SOUTH_WEST)); + ASSIGN_CURSOR (no_cursor, + BCursor_from_id (CURSOR_ID_NO_CURSOR)); + + ASSIGN_CURSOR (current_cursor, FRAME_OUTPUT_DATA (f)->text_cursor); +#undef ASSIGN_CURSOR + + + if (ttip_p) + f->no_split = true; + f->terminal->reference_count++; + + FRAME_OUTPUT_DATA (f)->window = BWindow_new (&FRAME_OUTPUT_DATA (f)->view); + if (!FRAME_OUTPUT_DATA (f)->window) + xsignal1 (Qerror, build_unibyte_string ("Could not create window")); + + if (!minibuffer_only && !ttip_p && FRAME_EXTERNAL_MENU_BAR (f)) + initialize_frame_menubar (f); + + FRAME_OUTPUT_DATA (f)->window_desc = FRAME_OUTPUT_DATA (f)->window; + + Vframe_list = Fcons (frame, Vframe_list); + + Lisp_Object parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, + RES_TYPE_SYMBOL); + + if (EQ (parent_frame, Qunbound) + || NILP (parent_frame) + || !FRAMEP (parent_frame) + || !FRAME_LIVE_P (XFRAME (parent_frame))) + parent_frame = Qnil; + + fset_parent_frame (f, parent_frame); + store_frame_param (f, Qparent_frame, parent_frame); + + if (!NILP (parent_frame)) + haiku_set_parent_frame (f, parent_frame, Qnil); + + gui_default_parameter (f, parms, Qundecorated, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + + gui_default_parameter (f, parms, Qicon_type, Qnil, + "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL); + if (ttip_p) + { + gui_default_parameter (f, parms, Qundecorated, Qt, NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qno_accept_focus, Qt, NULL, NULL, + RES_TYPE_BOOLEAN); + } + else + { + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qscroll_bar_width, Qnil, + "scrollBarWidth", "ScrollBarWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qscroll_bar_height, Qnil, + "scrollBarHeight", "ScrollBarHeight", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qfullscreen, Qnil, + "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); + } + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + if (ttip_p) + { + Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); + + call2 (Qface_set_after_frame_default, frame, Qnil); + + if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) + { + AUTO_FRAME_ARG (arg, Qbackground_color, bg); + Fmodify_frame_parameters (frame, arg); + } + } + + if (ttip_p) + face_change = face_change_before; + + f->can_set_window_size = true; + + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, ttip_p ? Qtip_frame : Qx_create_frame_2); + + if (!FRAME_OUTPUT_DATA (f)->explicit_parent && !ttip_p) + { + Lisp_Object visibility; + + visibility = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, + RES_TYPE_SYMBOL); + if (EQ (visibility, Qunbound)) + visibility = Qt; + if (EQ (visibility, Qicon)) + haiku_iconify_frame (f); + else if (!NILP (visibility)) + haiku_visualize_frame (f); + else /* Qnil */ + { + f->was_invisible = true; + } + } + + if (!ttip_p) + { + if (FRAME_HAS_MINIBUF_P (f) + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + kset_default_minibuffer_frame (kb, frame); + } + + for (tem = parms; CONSP (tem); tem = XCDR (tem)) + if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) + fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); + + if (window_prompting & (USPosition | PPosition)) + haiku_set_offset (f, f->left_pos, f->top_pos, 1); + else + BWindow_center_on_screen (FRAME_HAIKU_WINDOW (f)); + + /* Make sure windows on this frame appear in calls to next-window + and similar functions. */ + Vwindow_list = Qnil; + + if (ttip_p) + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qtip_frame); + + return unbind_to (count, frame); +} + +static void +compute_tip_xy (struct frame *f, + Lisp_Object parms, Lisp_Object dx, Lisp_Object dy, + int width, int height, int *root_x, int *root_y) +{ + Lisp_Object left, top, right, bottom; + int min_x = 0, min_y = 0, max_x = 0, max_y = 0; + + /* User-specified position? */ + left = Fcdr (Fassq (Qleft, parms)); + top = Fcdr (Fassq (Qtop, parms)); + right = Fcdr (Fassq (Qright, parms)); + bottom = Fcdr (Fassq (Qbottom, parms)); + + /* Move the tooltip window where the mouse pointer is. Resize and + show it. */ + if ((!FIXNUMP (left) && !FIXNUMP (right)) + || (!FIXNUMP (top) && !FIXNUMP (bottom))) + { + int x, y; + + /* Default min and max values. */ + min_x = 0; + min_y = 0; + BScreen_px_dim (&max_x, &max_y); + + block_input (); + BView_get_mouse (FRAME_HAIKU_VIEW (f), &x, &y); + BView_convert_to_screen (FRAME_HAIKU_VIEW (f), &x, &y); + *root_x = x; + *root_y = y; + unblock_input (); + } + + if (FIXNUMP (top)) + *root_y = XFIXNUM (top); + else if (FIXNUMP (bottom)) + *root_y = XFIXNUM (bottom) - height; + else if (*root_y + XFIXNUM (dy) <= min_y) + *root_y = min_y; /* Can happen for negative dy */ + else if (*root_y + XFIXNUM (dy) + height <= max_y) + /* It fits below the pointer */ + *root_y += XFIXNUM (dy); + else if (height + XFIXNUM (dy) + min_y <= *root_y) + /* It fits above the pointer. */ + *root_y -= height + XFIXNUM (dy); + else + /* Put it on the top. */ + *root_y = min_y; + + if (FIXNUMP (left)) + *root_x = XFIXNUM (left); + else if (FIXNUMP (right)) + *root_x = XFIXNUM (right) - width; + else if (*root_x + XFIXNUM (dx) <= min_x) + *root_x = 0; /* Can happen for negative dx */ + else if (*root_x + XFIXNUM (dx) + width <= max_x) + /* It fits to the right of the pointer. */ + *root_x += XFIXNUM (dx); + else if (width + XFIXNUM (dx) + min_x <= *root_x) + /* It fits to the left of the pointer. */ + *root_x -= width + XFIXNUM (dx); + else + /* Put it left justified on the screen -- it ought to fit that way. */ + *root_x = min_x; +} + +static Lisp_Object +haiku_hide_tip (bool delete) +{ + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + Lisp_Object it, frame; + FOR_EACH_FRAME (it, frame) + if (FRAME_WINDOW_P (XFRAME (frame)) && + FRAME_HAIKU_VIEW (XFRAME (frame))) + BView_set_tooltip (FRAME_HAIKU_VIEW (XFRAME (frame)), NULL); + + if (NILP (tip_frame) + || (!delete && !NILP (tip_frame) + && !FRAME_VISIBLE_P (XFRAME (tip_frame)))) + return Qnil; + else + { + ptrdiff_t count; + Lisp_Object was_open = Qnil; + + count = SPECPDL_INDEX (); + specbind (Qinhibit_redisplay, Qt); + specbind (Qinhibit_quit, Qt); + + if (!NILP (tip_frame)) + { + if (FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (delete) + { + delete_frame (tip_frame, Qnil); + tip_frame = Qnil; + } + else + haiku_unvisualize_frame (XFRAME (tip_frame)); + + was_open = Qt; + } + else + tip_frame = Qnil; + } + else + tip_frame = Qnil; + + return unbind_to (count, was_open); + } +} + +static void +haiku_set_undecorated (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (EQ (new_value, old_value)) + return; + + block_input (); + FRAME_UNDECORATED (f) = !NILP (new_value); + BWindow_change_decoration (FRAME_HAIKU_WINDOW (f), NILP (new_value)); + unblock_input (); +} + +static void +haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + int nlines; + if (TYPE_RANGED_FIXNUMP (int, value)) + nlines = XFIXNUM (value); + else + nlines = 0; + + fset_redisplay (f); + + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + + if (nlines) + { + FRAME_EXTERNAL_MENU_BAR (f) = 1; + if (FRAME_HAIKU_P (f) && !FRAME_HAIKU_MENU_BAR (f)) + XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1; + } + else + { + if (FRAME_EXTERNAL_MENU_BAR (f)) + free_frame_menubar (f); + FRAME_EXTERNAL_MENU_BAR (f) = 0; + if (FRAME_HAIKU_P (f)) + FRAME_HAIKU_MENU_BAR (f) = 0; + } + + adjust_frame_glyphs (f); +} + +/* Return geometric attributes of FRAME. According to the value of + ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner + edges of FRAME, the root window edges of frame (Qroot_edges). Any + other value means to return the geometry as returned by + Fx_frame_geometry. */ +static Lisp_Object +frame_geometry (Lisp_Object frame, Lisp_Object attribute) +{ + struct frame *f = decode_live_frame (frame); + check_window_system (f); + + if (EQ (attribute, Qouter_edges)) + return list4i (f->left_pos, f->top_pos, + f->left_pos, f->top_pos); + else if (EQ (attribute, Qnative_edges)) + return list4i (f->left_pos, f->top_pos, + f->left_pos + FRAME_PIXEL_WIDTH (f), + f->top_pos + FRAME_PIXEL_HEIGHT (f)); + else if (EQ (attribute, Qinner_edges)) + return list4i (f->left_pos + FRAME_INTERNAL_BORDER_WIDTH (f), + f->top_pos + FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_MENU_BAR_HEIGHT (f) + FRAME_TOOL_BAR_HEIGHT (f), + f->left_pos - FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_PIXEL_WIDTH (f), + f->top_pos + FRAME_PIXEL_HEIGHT (f) - + FRAME_INTERNAL_BORDER_WIDTH (f)); + + else + return + list (Fcons (Qouter_position, + Fcons (make_fixnum (f->left_pos), + make_fixnum (f->top_pos))), + Fcons (Qouter_size, + Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f)), + make_fixnum (FRAME_PIXEL_HEIGHT (f)))), + Fcons (Qexternal_border_size, + Fcons (make_fixnum (0), make_fixnum (0))), + Fcons (Qtitle_bar_size, + Fcons (make_fixnum (0), make_fixnum (0))), + Fcons (Qmenu_bar_external, Qnil), + Fcons (Qmenu_bar_size, Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) - + (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)), + make_fixnum (FRAME_MENU_BAR_HEIGHT (f)))), + Fcons (Qtool_bar_external, Qnil), + Fcons (Qtool_bar_position, Qtop), + Fcons (Qtool_bar_size, Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) - + (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)), + make_fixnum (FRAME_TOOL_BAR_HEIGHT (f)))), + Fcons (Qinternal_border_width, make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)))); +} + +void +haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + CHECK_STRING (arg); + + block_input (); + Emacs_Color color; + + if (haiku_get_color (SSDATA (arg), &color)) + { + store_frame_param (f, Qbackground_color, oldval); + unblock_input (); + error ("Bad color"); + } + + FRAME_OUTPUT_DATA (f)->cursor_fg = color.pixel; + FRAME_BACKGROUND_PIXEL (f) = color.pixel; + + if (FRAME_HAIKU_VIEW (f)) + { + struct face *defface; + + BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_SetViewColor (FRAME_HAIKU_VIEW (f), color.pixel); + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); + + defface = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID); + if (defface) + { + defface->background = color.pixel; + update_face_from_frame_parameter (f, Qbackground_color, arg); + clear_frame (f); + } + } + + if (FRAME_VISIBLE_P (f)) + SET_FRAME_GARBAGED (f); + unblock_input (); +} + +void +haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + CHECK_STRING (arg); + + block_input (); + Emacs_Color color; + + if (haiku_get_color (SSDATA (arg), &color)) + { + store_frame_param (f, Qcursor_color, oldval); + unblock_input (); + error ("Bad color"); + } + + FRAME_CURSOR_COLOR (f) = color; + if (FRAME_VISIBLE_P (f)) + { + gui_update_cursor (f, 0); + gui_update_cursor (f, 1); + } + update_face_from_frame_parameter (f, Qcursor_color, arg); + unblock_input (); +} + +void +haiku_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + set_frame_cursor_types (f, arg); +} + +unsigned long +haiku_get_pixel (haiku bitmap, int x, int y) +{ + unsigned char *data; + int32_t bytes_per_row; + int mono_p; + int left; + int right; + int top; + int bottom; + + data = BBitmap_data (bitmap); + BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, + &bytes_per_row, &mono_p); + + if (x < left || x > right || y < top || y > bottom) + emacs_abort (); + + if (!mono_p) + return ((uint32_t *) (data + (bytes_per_row * y)))[x]; + + int byte = y * bytes_per_row + x / 8; + return data[byte] & (1 << (x % 8)); +} + +void +haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel) +{ + unsigned char *data; + int32_t bytes_per_row; + int mono_p; + int left; + int right; + int top; + int bottom; + + data = BBitmap_data (bitmap); + BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, + &bytes_per_row, &mono_p); + + if (x < left || x > right || y < top || y > bottom) + emacs_abort (); + + if (mono_p) + { + ptrdiff_t off = y * bytes_per_row; + ptrdiff_t bit = x % 8; + ptrdiff_t xoff = x / 8; + + unsigned char *byte = data + off + xoff; + if (!pixel) + *byte &= ~(1 << bit); + else + *byte |= 1 << bit; + } + else + ((uint32_t *) (data + (bytes_per_row * y)))[x] = pixel; +} + +void +haiku_free_frame_resources (struct frame *f) +{ + haiku window, drawable, mbar; + Mouse_HLInfo *hlinfo; + struct haiku_display_info *dpyinfo; + Lisp_Object bar; + struct scroll_bar *b; + + block_input (); + check_window_system (f); + + hlinfo = MOUSE_HL_INFO (f); + window = FRAME_HAIKU_WINDOW (f); + drawable = FRAME_HAIKU_VIEW (f); + mbar = FRAME_HAIKU_MENU_BAR (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + + free_frame_faces (f); + + /* Free scroll bars */ + for (bar = FRAME_SCROLL_BARS (f); !NILP (bar); bar = b->next) + { + b = XSCROLL_BAR (bar); + haiku_scroll_bar_remove (b); + } + + if (f == dpyinfo->highlight_frame) + dpyinfo->highlight_frame = 0; + if (f == dpyinfo->focused_frame) + dpyinfo->focused_frame = 0; + if (f == dpyinfo->last_mouse_motion_frame) + dpyinfo->last_mouse_motion_frame = NULL; + if (f == dpyinfo->last_mouse_frame) + dpyinfo->last_mouse_frame = NULL; + if (f == dpyinfo->focus_event_frame) + dpyinfo->focus_event_frame = NULL; + + if (f == hlinfo->mouse_face_mouse_frame) + reset_mouse_highlight (hlinfo); + + if (mbar) + { + BMenuBar_delete (mbar); + if (f->output_data.haiku->menu_bar_open_p) + { + --popup_activated_p; + f->output_data.haiku->menu_bar_open_p = 0; + } + } + + if (drawable) + BView_emacs_delete (drawable); + + if (window) + BWindow_quit (window); + + /* Free cursors */ + + BCursor_delete (f->output_data.haiku->text_cursor); + BCursor_delete (f->output_data.haiku->nontext_cursor); + BCursor_delete (f->output_data.haiku->modeline_cursor); + BCursor_delete (f->output_data.haiku->hand_cursor); + BCursor_delete (f->output_data.haiku->hourglass_cursor); + BCursor_delete (f->output_data.haiku->horizontal_drag_cursor); + BCursor_delete (f->output_data.haiku->vertical_drag_cursor); + BCursor_delete (f->output_data.haiku->left_edge_cursor); + BCursor_delete (f->output_data.haiku->top_left_corner_cursor); + BCursor_delete (f->output_data.haiku->top_edge_cursor); + BCursor_delete (f->output_data.haiku->top_right_corner_cursor); + BCursor_delete (f->output_data.haiku->right_edge_cursor); + BCursor_delete (f->output_data.haiku->bottom_right_corner_cursor); + BCursor_delete (f->output_data.haiku->bottom_edge_cursor); + BCursor_delete (f->output_data.haiku->bottom_left_corner_cursor); + BCursor_delete (f->output_data.haiku->no_cursor); + + xfree (FRAME_OUTPUT_DATA (f)); + FRAME_OUTPUT_DATA (f) = NULL; + + unblock_input (); +} + +void +haiku_iconify_frame (struct frame *frame) +{ + if (FRAME_ICONIFIED_P (frame)) + return; + + block_input (); + + SET_FRAME_VISIBLE (frame, false); + SET_FRAME_ICONIFIED (frame, true); + + BWindow_iconify (FRAME_HAIKU_WINDOW (frame)); + + unblock_input (); +} + +void +haiku_visualize_frame (struct frame *f) +{ + block_input (); + + if (!FRAME_VISIBLE_P (f)) + { + if (FRAME_NO_FOCUS_ON_MAP (f)) + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), 1); + BWindow_set_visible (FRAME_HAIKU_WINDOW (f), 1); + if (FRAME_NO_FOCUS_ON_MAP (f) && + !FRAME_NO_ACCEPT_FOCUS (f)) + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), 0); + + haiku_set_offset (f, f->left_pos, f->top_pos, 0); + + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, 0); + } + + unblock_input (); +} + +void +haiku_unvisualize_frame (struct frame *f) +{ + block_input (); + + BWindow_set_visible (FRAME_HAIKU_WINDOW (f), 0); + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, 0); + + unblock_input (); +} + +void +haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + int old_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int new_width = check_int_nonnegative (arg); + + if (new_width == old_width) + return; + f->internal_border_width = new_width; + + if (FRAME_HAIKU_WINDOW (f)) + { + adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width); + haiku_clear_under_internal_border (f); + } + + SET_FRAME_GARBAGED (f); +} + +void +haiku_set_frame_visible_invisible (struct frame *f, bool visible_p) +{ + if (visible_p) + haiku_visualize_frame (f); + else + haiku_unvisualize_frame (f); +} + +void +frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) +{ + block_input (); + + BView_convert_to_screen (FRAME_HAIKU_VIEW (f), &pix_x, &pix_y); + be_warp_pointer (pix_x, pix_y); + + unblock_input (); +} + +void +haiku_query_color (uint32_t col, Emacs_Color *color_def) +{ + color_def->red = RED_FROM_ULONG (col) * 257; + color_def->green = GREEN_FROM_ULONG (col) * 257; + color_def->blue = BLUE_FROM_ULONG (col) * 257; + + color_def->pixel = col; +} + +Display_Info * +check_x_display_info (Lisp_Object object) +{ + return check_haiku_display_info (object); +} + +/* Rename frame F to NAME. If NAME is nil, set F's name to "GNU + Emacs". If EXPLICIT_P is non-zero, that indicates Lisp code is + setting the name, not redisplay; in that case, set F's name to NAME + and set F->explicit_name; if NAME is nil, clear F->explicit_name. + + If EXPLICIT_P is zero, it means redisplay is setting the name; the + name provided will be ignored if explicit_name is set. */ +void +haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p) +{ + if (explicit_p) + { + if (f->explicit_name && NILP (name)) + update_mode_lines = 24; + + f->explicit_name = !NILP (name); + } + else if (f->explicit_name) + return; + + if (NILP (name)) + name = build_unibyte_string ("GNU Emacs"); + + if (!NILP (Fstring_equal (name, f->name))) + return; + + fset_name (f, name); + + if (!NILP (f->title)) + name = f->title; + + haiku_set_title_bar_text (f, name); +} + +static void +haiku_set_inhibit_double_buffering (struct frame *f, + Lisp_Object new_value, + Lisp_Object old_value) +{ + block_input (); + if (FRAME_HAIKU_WINDOW (f)) + { + if (NILP (new_value)) + { + EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); + if (!NILP (old_value)) + { + SET_FRAME_GARBAGED (f); + expose_frame (f, 0, 0, 0, 0); + } + } + else + EmacsView_disable_double_buffering (FRAME_HAIKU_VIEW (f)); + } + unblock_input (); +} + + + +DEFUN ("haiku-set-mouse-absolute-pixel-position", + Fhaiku_set_mouse_absolute_pixel_position, + Shaiku_set_mouse_absolute_pixel_position, 2, 2, 0, + doc: /* Move mouse pointer to a pixel position at (X, Y). The +coordinates X and Y are interpreted to start from the top-left +corner of the screen. */) + (Lisp_Object x, Lisp_Object y) +{ + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); + + if (!x_display_list) + error ("Window system not initialized"); + + block_input (); + be_warp_pointer (xval, yval); + unblock_input (); + return Qnil; +} + +DEFUN ("haiku-mouse-absolute-pixel-position", Fhaiku_mouse_absolute_pixel_position, + Shaiku_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the coordinates of +the mouse cursor position in pixels relative to a position (0, 0) of the +selected frame's display. */) + (void) +{ + if (!x_display_list) + return Qnil; + + struct frame *f = SELECTED_FRAME (); + + if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f) + || !FRAME_HAIKU_VIEW (f)) + return Qnil; + + block_input (); + void *view = FRAME_HAIKU_VIEW (f); + + int x, y; + BView_get_mouse (view, &x, &y); + BView_convert_to_screen (view, &x, &y); + unblock_input (); + + return Fcons (make_fixnum (x), make_fixnum (y)); +} + +DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + return Qt; +} + +DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + CHECK_STRING (color); + decode_window_system_frame (frame); + + return haiku_get_color (SSDATA (color), &col) ? Qnil : Qt; +} + +DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + CHECK_STRING (color); + decode_window_system_frame (frame); + + block_input (); + if (haiku_get_color (SSDATA (color), &col)) + { + unblock_input (); + return Qnil; + } + unblock_input (); + return list3i (lrint (col.red), lrint (col.green), lrint (col.blue)); +} + +DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + return Qnil; +} + +DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, + 1, 3, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) +{ + struct haiku_display_info *dpy_info; + CHECK_STRING (display); + + if (NILP (Fstring_equal (display, build_string ("be")))) + !NILP (must_succeed) ? fatal ("Bad display") : error ("Bad display"); + dpy_info = haiku_term_init (); + + if (!dpy_info) + !NILP (must_succeed) ? fatal ("Display not responding") : + error ("Display not responding"); + + return Qnil; +} + +DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) + +{ + check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + return make_fixnum (width); +} + +DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) + +{ + check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + return make_fixnum (width); +} + +DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + + return make_fixnum (height / (dpyinfo->resy / 25.4)); +} + + +DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + + return make_fixnum (height / (dpyinfo->resy / 25.4)); +} + +DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, + 1, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object parms) +{ + return haiku_create_frame (parms, 0); +} + +DEFUN ("x-display-visual-class", Fx_display_visual_class, + Sx_display_visual_class, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + int planes = be_get_display_planes (); + + if (planes == 8) + return intern ("static-color"); + else if (planes == 16 || planes == 15) + return intern ("pseudo-color"); + + return intern ("direct-color"); +} + +DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, + Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) +{ + struct frame *tip_f; + struct window *w; + int root_x, root_y; + struct buffer *old_buffer; + struct text_pos pos; + int width, height; + int old_windows_or_buffers_changed = windows_or_buffers_changed; + ptrdiff_t count = SPECPDL_INDEX (); + ptrdiff_t count_1; + Lisp_Object window, size, tip_buf; + + AUTO_STRING (tip, " *tip*"); + + specbind (Qinhibit_redisplay, Qt); + + CHECK_STRING (string); + + if (NILP (frame)) + frame = selected_frame; + decode_window_system_frame (frame); + + if (NILP (timeout)) + timeout = make_fixnum (5); + else + CHECK_FIXNAT (timeout); + + if (NILP (dx)) + dx = make_fixnum (5); + else + CHECK_FIXNUM (dx); + + if (NILP (dy)) + dy = make_fixnum (-10); + else + CHECK_FIXNUM (dy); + + if (haiku_use_system_tooltips) + { + int root_x, root_y; + CHECK_STRING (string); + if (STRING_MULTIBYTE (string)) + string = ENCODE_UTF_8 (string); + + if (NILP (frame)) + frame = selected_frame; + + struct frame *f = decode_window_system_frame (frame); + block_input (); + + char *str = xstrdup (SSDATA (string)); + int height = be_plain_font_height (); + int width; + char *tok = strtok (str, "\n"); + width = be_string_width_with_plain_font (tok); + + while ((tok = strtok (NULL, "\n"))) + { + height = be_plain_font_height (); + int w = be_string_width_with_plain_font (tok); + if (w > width) + w = width; + } + free (str); + + height += 16; /* Default margin. */ + width += 16; /* Ditto. Unfortunately there isn't a more + reliable way to get it. */ + compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y); + BView_convert_from_screen (FRAME_HAIKU_VIEW (f), &root_x, &root_y); + BView_set_and_show_sticky_tooltip (FRAME_HAIKU_VIEW (f), SSDATA (string), + root_x, root_y); + unblock_input (); + goto start_timer; + } + + if (!NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (FRAME_VISIBLE_P (XFRAME (tip_frame)) + && EQ (frame, tip_last_frame) + && !NILP (Fequal_including_properties (string, tip_last_string)) + && !NILP (Fequal (parms, tip_last_parms))) + { + /* Only DX and DY have changed. */ + tip_f = XFRAME (tip_frame); + if (!NILP (tip_timer)) + { + Lisp_Object timer = tip_timer; + + tip_timer = Qnil; + call1 (Qcancel_timer, timer); + } + + block_input (); + compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y); + haiku_set_offset (tip_f, root_x, root_y, 1); + haiku_visualize_frame (tip_f); + unblock_input (); + + goto start_timer; + } + else if (tooltip_reuse_hidden_frame && EQ (frame, tip_last_frame)) + { + bool delete = false; + Lisp_Object tail, elt, parm, last; + + /* Check if every parameter in PARMS has the same value in + tip_last_parms. This may destruct tip_last_parms + which, however, will be recreated below. */ + for (tail = parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + /* The left, top, right and bottom parameters are handled + by compute_tip_xy so they can be ignored here. */ + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) + && !EQ (parm, Qright) && !EQ (parm, Qbottom)) + { + last = Fassq (parm, tip_last_parms); + if (NILP (Fequal (Fcdr (elt), Fcdr (last)))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + + /* Now check if there's a parameter left in tip_last_parms with a + non-nil value. */ + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) + && !EQ (parm, Qbottom) && !NILP (Fcdr (elt))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + } + + haiku_hide_tip (delete); + } + else + haiku_hide_tip (true); + } + else + haiku_hide_tip (true); + + tip_last_frame = frame; + tip_last_string = string; + tip_last_parms = parms; + + /* Block input until the tip has been fully drawn, to avoid crashes + when drawing tips in menus. */ + block_input (); + + if (NILP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame))) + { + /* Add default values to frame parameters. */ + if (NILP (Fassq (Qname, parms))) + parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); + if (NILP (Fassq (Qinternal_border_width, parms))) + parms = Fcons (Fcons (Qinternal_border_width, make_fixnum (3)), parms); + if (NILP (Fassq (Qborder_width, parms))) + parms = Fcons (Fcons (Qborder_width, make_fixnum (1)), parms); + if (NILP (Fassq (Qborder_color, parms))) + parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), + parms); + if (NILP (Fassq (Qbackground_color, parms))) + parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")), + parms); + + /* Create a frame for the tooltip and record it in the global + variable tip_frame. */ + + if (NILP (tip_frame = haiku_create_frame (parms, 1))) + { + /* Creating the tip frame failed. */ + unblock_input (); + return unbind_to (count, Qnil); + } + } + + tip_f = XFRAME (tip_frame); + window = FRAME_ROOT_WINDOW (tip_f); + tip_buf = Fget_buffer_create (tip, Qnil); + /* We will mark the tip window a "pseudo-window" below, and such + windows cannot have display margins. */ + bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + bset_right_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + set_window_buffer (window, tip_buf, false, false); + w = XWINDOW (window); + w->pseudo_window_p = true; + /* Try to avoid that `other-window' select us (Bug#47207). */ + Fset_window_parameter (window, Qno_other_window, Qt); + + /* Set up the frame's root window. Note: The following code does not + try to size the window or its frame correctly. Its only purpose is + to make the subsequent text size calculations work. The right + sizes should get installed when the toolkit gets back to us. */ + w->left_col = 0; + w->top_line = 0; + w->pixel_left = 0; + w->pixel_top = 0; + + if (CONSP (Vx_max_tooltip_size) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + { + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); + } + else + { + w->total_cols = 80; + w->total_lines = 40; + } + + w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (tip_f); + w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (tip_f); + FRAME_TOTAL_COLS (tip_f) = WINDOW_TOTAL_COLS (w); + adjust_frame_glyphs (tip_f); + + /* Insert STRING into the root window's buffer and fit the frame to + the buffer. */ + count_1 = SPECPDL_INDEX (); + old_buffer = current_buffer; + set_buffer_internal_1 (XBUFFER (w->contents)); + bset_truncate_lines (current_buffer, Qnil); + specbind (Qinhibit_read_only, Qt); + specbind (Qinhibit_modification_hooks, Qt); + specbind (Qinhibit_point_motion_hooks, Qt); + Ferase_buffer (); + Finsert (1, &string); + clear_glyph_matrix (w->desired_matrix); + clear_glyph_matrix (w->current_matrix); + SET_TEXT_POS (pos, BEGV, BEGV_BYTE); + try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); + /* Calculate size of tooltip window. */ + size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, + make_fixnum (w->pixel_height), Qnil); + /* Add the frame's internal border to calculated size. */ + width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + /* Calculate position of tooltip frame. */ + compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y); + BWindow_resize (FRAME_HAIKU_WINDOW (tip_f), width, height); + haiku_set_offset (tip_f, root_x, root_y, 1); + BWindow_set_tooltip_decoration (FRAME_HAIKU_WINDOW (tip_f)); + BView_set_view_cursor (FRAME_HAIKU_VIEW (tip_f), + FRAME_OUTPUT_DATA (XFRAME (frame))->current_cursor); + SET_FRAME_VISIBLE (tip_f, 1); + BWindow_set_visible (FRAME_HAIKU_WINDOW (tip_f), 1); + + w->must_be_updated_p = true; + flush_frame (tip_f); + update_single_window (w); + set_buffer_internal_1 (old_buffer); + unbind_to (count_1, Qnil); + unblock_input (); + windows_or_buffers_changed = old_windows_or_buffers_changed; + + start_timer: + /* Let the tip disappear after timeout seconds. */ + tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, + intern ("x-hide-tip")); + + return unbind_to (count, Qnil); +} + +DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, + doc: /* SKIP: real doc in xfns.c. */) + (void) +{ + return haiku_hide_tip (!tooltip_reuse_hidden_frame); +} + +DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection, 1, 1, 0, + doc: /* SKIP: real doc in xfns.c. */ + attributes: noreturn) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + error ("Cannot close Haiku displays"); +} + +DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, + doc: /* SKIP: real doc in xfns.c. */) + (void) +{ + if (!x_display_list) + return Qnil; + + return list1 (XCAR (x_display_list->name_list_element)); +} + +DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return build_string ("Haiku, Inc."); +} + +DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return list3i (5, 1, 1); +} + +DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return make_fixnum (be_get_display_screens ()); +} + +DEFUN ("haiku-get-version-string", Fhaiku_get_version_string, + Shaiku_get_version_string, 0, 0, 0, + doc: /* Return a string describing the current Haiku version. */) + (void) +{ + char buf[1024]; + + be_get_version_string ((char *) &buf, sizeof buf); + return build_string (buf); +} + +DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return make_fixnum (be_get_display_color_cells ()); +} + +DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return make_fixnum (be_get_display_planes ()); +} + +DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object frame) +{ + struct frame *f = decode_live_frame (frame); + check_window_system (f); + + return EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ? Qt : Qnil; +} + +DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + if (FRAMEP (terminal)) + { + CHECK_LIVE_FRAME (terminal); + struct frame *f = decode_window_system_frame (terminal); + + if (FRAME_HAIKU_VIEW (f) && + EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + return FRAME_PARENT_FRAME (f) ? Qwhen_mapped : Qalways; + else + return Qnot_useful; + } + else + { + check_haiku_display_info (terminal); + return Qnot_useful; + } +} + +DEFUN ("haiku-frame-geometry", Fhaiku_frame_geometry, Shaiku_frame_geometry, 0, 1, 0, + doc: /* Return geometric attributes of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is an association list of the attributes listed below. All height +and width values are in pixels. + +`outer-position' is a cons of the outer left and top edges of FRAME + relative to the origin - the position (0, 0) - of FRAME's display. + +`outer-size' is a cons of the outer width and height of FRAME. The + outer size includes the title bar and the external borders as well as + any menu and/or tool bar of frame. + +`external-border-size' is a cons of the horizontal and vertical width of + FRAME's external borders as supplied by the window manager. + +`title-bar-size' is a cons of the width and height of the title bar of + FRAME as supplied by the window manager. If both of them are zero, + FRAME has no title bar. If only the width is zero, Emacs was not + able to retrieve the width information. + +`menu-bar-external', if non-nil, means the menu bar is external (never + included in the inner edges of FRAME). + +`menu-bar-size' is a cons of the width and height of the menu bar of + FRAME. + +`tool-bar-external', if non-nil, means the tool bar is external (never + included in the inner edges of FRAME). + +`tool-bar-position' tells on which side the tool bar on FRAME is and can + be one of `left', `top', `right' or `bottom'. If this is nil, FRAME + has no tool bar. + +`tool-bar-size' is a cons of the width and height of the tool bar of + FRAME. + +`internal-border-width' is the width of the internal border of + FRAME. */) + (Lisp_Object frame) +{ + return frame_geometry (frame, Qnil); +} + +DEFUN ("haiku-frame-edges", Fhaiku_frame_edges, Shaiku_frame_edges, 0, 2, 0, + doc: /* Return edge coordinates of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are +in pixels relative to the origin - the position (0, 0) - of FRAME's +display. + +If optional argument TYPE is the symbol `outer-edges', return the outer +edges of FRAME. The outer edges comprise the decorations of the window +manager (like the title bar or external borders) as well as any external +menu or tool bar of FRAME. If optional argument TYPE is the symbol +`native-edges' or nil, return the native edges of FRAME. The native +edges exclude the decorations of the window manager and any external +menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return +the inner edges of FRAME. These edges exclude title bar, any borders, +menu bar or tool bar of FRAME. */) + (Lisp_Object frame, Lisp_Object type) +{ + return frame_geometry (frame, ((EQ (type, Qouter_edges) + || EQ (type, Qinner_edges)) + ? type + : Qnative_edges)); +} + +DEFUN ("haiku-read-file-name", Fhaiku_read_file_name, Shaiku_read_file_name, 1, 6, 0, + doc: /* Use a graphical panel to read a file name, using prompt PROMPT. +Optional arg FRAME specifies a frame on which to display the file panel. +If it is nil, the current frame is used instead. +The frame being used will be brought to the front of +the display after the file panel is closed. +Optional arg DIR, if non-nil, supplies a default directory. +Optional arg MUSTMATCH, if non-nil, means the returned file or +directory must exist. +Optional arg DIR_ONLY_P, if non-nil, means choose only directories. +Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry field. */) + (Lisp_Object prompt, Lisp_Object frame, + Lisp_Object dir, Lisp_Object mustmatch, + Lisp_Object dir_only_p, Lisp_Object save_text) +{ + ptrdiff_t idx; + if (!x_display_list) + error ("Be windowing not initialized"); + + if (!NILP (dir)) + CHECK_STRING (dir); + + if (!NILP (save_text)) + CHECK_STRING (save_text); + + if (NILP (frame)) + frame = selected_frame; + + CHECK_STRING (prompt); + + CHECK_LIVE_FRAME (frame); + check_window_system (XFRAME (frame)); + + idx = SPECPDL_INDEX (); + record_unwind_protect_void (unwind_popup); + + struct frame *f = XFRAME (frame); + + FRAME_DISPLAY_INFO (f)->focus_event_frame = f; + + ++popup_activated_p; + char *fn = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), + !NILP (dir) ? SSDATA (ENCODE_UTF_8 (dir)) : NULL, + !NILP (mustmatch), !NILP (dir_only_p), + FRAME_HAIKU_WINDOW (f), + !NILP (save_text) ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL, + SSDATA (ENCODE_UTF_8 (prompt)), + block_input, unblock_input); + + unbind_to (idx, Qnil); + + block_input (); + BWindow_activate (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + + if (!fn) + return Qnil; + + Lisp_Object p = build_string_from_utf8 (fn); + free (fn); + return p; +} + +DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource, + 2, 2, 0, doc: /* Place STRING by the key RESOURCE in the resource database. +It can later be retrieved with `x-get-resource'. */) + (Lisp_Object resource, Lisp_Object string) +{ + CHECK_STRING (resource); + if (!NILP (string)) + CHECK_STRING (string); + + put_xrm_resource (resource, string); + return Qnil; +} + +DEFUN ("haiku-frame-list-z-order", Fhaiku_frame_list_z_order, + Shaiku_frame_list_z_order, 0, 1, 0, + doc: /* Return list of Emacs' frames, in Z (stacking) order. +If TERMINAL is non-nil and specifies a live frame, return the child +frames of that frame in Z (stacking) order. + +As it is impossible to reliably determine the frame stacking order on +Haiku, the selected frame is always the first element of the returned +list, while the rest are not guaranteed to be in any particular order. + +Frames are listed from topmost (first) to bottommost (last). */) + (Lisp_Object terminal) +{ + Lisp_Object frames = Qnil; + Lisp_Object head, tail; + Lisp_Object sel = Qnil; + + FOR_EACH_FRAME (head, tail) + { + struct frame *f = XFRAME (tail); + if (!FRAME_HAIKU_P (f) || + (FRAMEP (terminal) && + FRAME_LIVE_P (XFRAME (terminal)) && + !EQ (terminal, get_frame_param (f, Qparent_frame)))) + continue; + + if (EQ (tail, selected_frame)) + sel = tail; + else + frames = Fcons (tail, frames); + } + + if (NILP (sel)) + return frames; + return Fcons (sel, frames); +} + +DEFUN ("x-display-save-under", Fx_display_save_under, + Sx_display_save_under, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + if (FRAMEP (terminal)) + { + struct frame *f = decode_window_system_frame (terminal); + return FRAME_HAIKU_VIEW (f) && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ? + Qt : Qnil; + } + + return Qnil; +} + +frame_parm_handler haiku_frame_parm_handlers[] = + { + gui_set_autoraise, + gui_set_autolower, + haiku_set_background_color, + NULL, /* x_set_border_color */ + gui_set_border_width, + haiku_set_cursor_color, + haiku_set_cursor_type, + gui_set_font, + haiku_set_foreground_color, + NULL, /* set icon name */ + NULL, /* set icon type */ + haiku_set_child_frame_border_width, + haiku_set_internal_border_width, + gui_set_right_divider_width, + gui_set_bottom_divider_width, + haiku_set_menu_bar_lines, + NULL, /* set mouse color */ + haiku_explicitly_set_name, + gui_set_scroll_bar_width, + gui_set_scroll_bar_height, + haiku_set_title, + gui_set_unsplittable, + gui_set_vertical_scroll_bars, + gui_set_horizontal_scroll_bars, + gui_set_visibility, + haiku_set_tab_bar_lines, + haiku_set_tool_bar_lines, + NULL, /* set scroll bar fg */ + NULL, /* set scroll bar bkg */ + gui_set_screen_gamma, + gui_set_line_spacing, + gui_set_left_fringe, + gui_set_right_fringe, + NULL, /* x wait for wm */ + gui_set_fullscreen, + gui_set_font_backend, + gui_set_alpha, + NULL, /* set sticky */ + NULL, /* set tool bar pos */ + haiku_set_inhibit_double_buffering, + haiku_set_undecorated, + haiku_set_parent_frame, + NULL, /* set skip taskbar */ + haiku_set_no_focus_on_map, + haiku_set_no_accept_focus, + NULL, /* set z group */ + NULL, /* set override redir */ + gui_set_no_special_glyphs + }; + +void +syms_of_haikufns (void) +{ + DEFSYM (Qfont_parameter, "font-parameter"); + DEFSYM (Qcancel_timer, "cancel-timer"); + DEFSYM (Qassq_delete_all, "assq-delete-all"); + + DEFSYM (Qalways, "always"); + DEFSYM (Qnot_useful, "not-useful"); + DEFSYM (Qwhen_mapped, "when-mapped"); + + defsubr (&Sx_hide_tip); + defsubr (&Sxw_display_color_p); + defsubr (&Sx_display_grayscale_p); + defsubr (&Sx_open_connection); + defsubr (&Sx_create_frame); + defsubr (&Sx_display_pixel_width); + defsubr (&Sx_display_pixel_height); + defsubr (&Sxw_color_values); + defsubr (&Sxw_color_defined_p); + defsubr (&Sx_display_visual_class); + defsubr (&Sx_show_tip); + defsubr (&Sx_display_mm_height); + defsubr (&Sx_display_mm_width); + defsubr (&Sx_close_connection); + defsubr (&Sx_display_list); + defsubr (&Sx_server_vendor); + defsubr (&Sx_server_version); + defsubr (&Sx_display_screens); + defsubr (&Shaiku_get_version_string); + defsubr (&Sx_display_color_cells); + defsubr (&Sx_display_planes); + defsubr (&Shaiku_set_mouse_absolute_pixel_position); + defsubr (&Shaiku_mouse_absolute_pixel_position); + defsubr (&Shaiku_frame_geometry); + defsubr (&Shaiku_frame_edges); + defsubr (&Sx_double_buffered_p); + defsubr (&Sx_display_backing_store); + defsubr (&Shaiku_read_file_name); + defsubr (&Shaiku_put_resource); + defsubr (&Shaiku_frame_list_z_order); + defsubr (&Sx_display_save_under); + + tip_timer = Qnil; + staticpro (&tip_timer); + tip_frame = Qnil; + staticpro (&tip_frame); + tip_last_frame = Qnil; + staticpro (&tip_last_frame); + tip_last_string = Qnil; + staticpro (&tip_last_string); + tip_last_parms = Qnil; + staticpro (&tip_last_parms); + + DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, + doc: /* SKIP: real doc in xfns.c. */); + Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); + + DEFVAR_BOOL ("haiku-use-system-tooltips", haiku_use_system_tooltips, + doc: /* When non-nil, Emacs will display tooltips using the App Kit. +This can avoid a great deal of consing that does not play +well with the Haiku memory allocator, but comes with the +disadvantage of not being able to use special display properties +within tooltips. */); + haiku_use_system_tooltips = 1; + +#ifdef USE_BE_CAIRO + DEFVAR_LISP ("cairo-version-string", Vcairo_version_string, + doc: /* Version info for cairo. */); + { + char cairo_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)]; + int len = sprintf (cairo_version, "%d.%d.%d", + CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, + CAIRO_VERSION_MICRO); + Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + } +#endif + + return; +} diff --git a/src/haikufont.c b/src/haikufont.c new file mode 100644 index 00000000000..811fa62a848 --- /dev/null +++ b/src/haikufont.c @@ -0,0 +1,1072 @@ +/* Font support for Haiku windowing + +Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include "lisp.h" +#include "dispextern.h" +#include "composite.h" +#include "blockinput.h" +#include "charset.h" +#include "frame.h" +#include "window.h" +#include "fontset.h" +#include "haikuterm.h" +#include "character.h" +#include "font.h" +#include "termchar.h" +#include "pdumper.h" +#include "haiku_support.h" + +#include +#include + +static Lisp_Object font_cache; + +#define METRICS_NCOLS_PER_ROW (128) + +enum metrics_status + { + METRICS_INVALID = -1, /* metrics entry is invalid */ + }; + +#define METRICS_STATUS(metrics) ((metrics)->ascent + (metrics)->descent) +#define METRICS_SET_STATUS(metrics, status) \ + ((metrics)->ascent = 0, (metrics)->descent = (status)) + +static struct +{ + /* registry name */ + const char *name; + /* characters to distinguish the charset from the others */ + int uniquifier[6]; + /* additional constraint by language */ + const char *lang; +} em_charset_table[] = + { { "iso8859-1", { 0x00A0, 0x00A1, 0x00B4, 0x00BC, 0x00D0 } }, + { "iso8859-2", { 0x00A0, 0x010E }}, + { "iso8859-3", { 0x00A0, 0x0108 }}, + { "iso8859-4", { 0x00A0, 0x00AF, 0x0128, 0x0156, 0x02C7 }}, + { "iso8859-5", { 0x00A0, 0x0401 }}, + { "iso8859-6", { 0x00A0, 0x060C }}, + { "iso8859-7", { 0x00A0, 0x0384 }}, + { "iso8859-8", { 0x00A0, 0x05D0 }}, + { "iso8859-9", { 0x00A0, 0x00A1, 0x00BC, 0x011E }}, + { "iso8859-10", { 0x00A0, 0x00D0, 0x0128, 0x2015 }}, + { "iso8859-11", { 0x00A0, 0x0E01 }}, + { "iso8859-13", { 0x00A0, 0x201C }}, + { "iso8859-14", { 0x00A0, 0x0174 }}, + { "iso8859-15", { 0x00A0, 0x00A1, 0x00D0, 0x0152 }}, + { "iso8859-16", { 0x00A0, 0x0218}}, + { "gb2312.1980-0", { 0x4E13 }, "zh-cn"}, + { "big5-0", { 0x9C21 }, "zh-tw" }, + { "jisx0208.1983-0", { 0x4E55 }, "ja"}, + { "ksc5601.1985-0", { 0xAC00 }, "ko"}, + { "cns11643.1992-1", { 0xFE32 }, "zh-tw"}, + { "cns11643.1992-2", { 0x4E33, 0x7934 }}, + { "cns11643.1992-3", { 0x201A9 }}, + { "cns11643.1992-4", { 0x20057 }}, + { "cns11643.1992-5", { 0x20000 }}, + { "cns11643.1992-6", { 0x20003 }}, + { "cns11643.1992-7", { 0x20055 }}, + { "gbk-0", { 0x4E06 }, "zh-cn"}, + { "jisx0212.1990-0", { 0x4E44 }}, + { "jisx0213.2000-1", { 0xFA10 }, "ja"}, + { "jisx0213.2000-2", { 0xFA49 }}, + { "jisx0213.2004-1", { 0x20B9F }}, + { "viscii1.1-1", { 0x1EA0, 0x1EAE, 0x1ED2 }, "vi"}, + { "tis620.2529-1", { 0x0E01 }, "th"}, + { "microsoft-cp1251", { 0x0401, 0x0490 }, "ru"}, + { "koi8-r", { 0x0401, 0x2219 }, "ru"}, + { "mulelao-1", { 0x0E81 }, "lo"}, + { "unicode-sip", { 0x20000 }}, + { "mulearabic-0", { 0x628 }}, + { "mulearabic-1", { 0x628 }}, + { "mulearabic-2", { 0x628 }}, + { NULL } + }; + +static void +haikufont_apply_registry (struct haiku_font_pattern *pattern, + Lisp_Object registry) +{ + char *str = SSDATA (SYMBOL_NAME (registry)); + USE_SAFE_ALLOCA; + char *re = SAFE_ALLOCA (SBYTES (SYMBOL_NAME (registry)) * 2 + 1); + int i, j; + + for (i = j = 0; i < SBYTES (SYMBOL_NAME (registry)); i++, j++) + { + if (str[i] == '.') + re[j++] = '\\'; + else if (str[i] == '*') + re[j++] = '.'; + re[j] = str[i]; + if (re[j] == '?') + re[j] = '.'; + } + re[j] = '\0'; + AUTO_STRING_WITH_LEN (regexp, re, j); + for (i = 0; em_charset_table[i].name; i++) + if (fast_c_string_match_ignore_case + (regexp, em_charset_table[i].name, + strlen (em_charset_table[i].name)) >= 0) + break; + SAFE_FREE (); + if (!em_charset_table[i].name) + return; + int *uniquifier = em_charset_table[i].uniquifier; + int l; + + for (l = 0; uniquifier[l]; ++l); + + uint32_t *a = xmalloc (l * sizeof *a); + for (l = 0; uniquifier[l]; ++l) + a[l] = uniquifier[l]; + + if (pattern->specified & FSPEC_WANTED) + { + int old_l = l; + l += pattern->want_chars_len; + a = xrealloc (a, l * sizeof *a); + memcpy (&a[old_l], pattern->wanted_chars, (l - old_l) * sizeof *a); + xfree (pattern->wanted_chars); + } + pattern->specified |= FSPEC_WANTED; + pattern->want_chars_len = l; + pattern->wanted_chars = a; + + if (em_charset_table[i].lang) + { + if (!strncmp (em_charset_table[i].lang, "zh", 2)) + { + pattern->specified |= FSPEC_LANGUAGE; + pattern->language = LANGUAGE_CN; + } + else if (!strncmp (em_charset_table[i].lang, "ko", 2)) + { + pattern->specified |= FSPEC_LANGUAGE; + pattern->language = LANGUAGE_KO; + } + else if (!strncmp (em_charset_table[i].lang, "ja", 2)) + { + pattern->specified |= FSPEC_LANGUAGE; + pattern->language = LANGUAGE_JP; + } + } + + return; +} + +static Lisp_Object +haikufont_get_fallback_entity (void) +{ + Lisp_Object ent = font_make_entity (); + ASET (ent, FONT_TYPE_INDEX, Qhaiku); + ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku); + ASET (ent, FONT_FAMILY_INDEX, Qnil); + ASET (ent, FONT_ADSTYLE_INDEX, Qnil); + ASET (ent, FONT_REGISTRY_INDEX, Qutf_8); + ASET (ent, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0)); + ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, Qnil); + FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, Qnil); + FONT_SET_STYLE (ent, FONT_SLANT_INDEX, Qnil); + + return ent; +} + +static Lisp_Object +haikufont_get_cache (struct frame *frame) +{ + return font_cache; +} + +static Lisp_Object +haikufont_weight_to_lisp (int weight) +{ + switch (weight) + { + case HAIKU_THIN: + return Qthin; + case HAIKU_ULTRALIGHT: + return Qultra_light; + case HAIKU_EXTRALIGHT: + return Qextra_light; + case HAIKU_LIGHT: + return Qlight; + case HAIKU_SEMI_LIGHT: + return Qsemi_light; + case HAIKU_REGULAR: + return Qnormal; + case HAIKU_SEMI_BOLD: + return Qsemi_bold; + case HAIKU_BOLD: + return Qbold; + case HAIKU_EXTRA_BOLD: + return Qextra_bold; + case HAIKU_ULTRA_BOLD: + return Qultra_bold; + case HAIKU_BOOK: + return Qbook; + case HAIKU_HEAVY: + return Qheavy; + case HAIKU_ULTRA_HEAVY: + return Qultra_heavy; + case HAIKU_BLACK: + return Qblack; + case HAIKU_MEDIUM: + return Qmedium; + } + emacs_abort (); +} + +static int +haikufont_lisp_to_weight (Lisp_Object weight) +{ + if (EQ (weight, Qthin)) + return HAIKU_THIN; + if (EQ (weight, Qultra_light)) + return HAIKU_ULTRALIGHT; + if (EQ (weight, Qextra_light)) + return HAIKU_EXTRALIGHT; + if (EQ (weight, Qlight)) + return HAIKU_LIGHT; + if (EQ (weight, Qsemi_light)) + return HAIKU_SEMI_LIGHT; + if (EQ (weight, Qnormal)) + return HAIKU_REGULAR; + if (EQ (weight, Qsemi_bold)) + return HAIKU_SEMI_BOLD; + if (EQ (weight, Qbold)) + return HAIKU_BOLD; + if (EQ (weight, Qextra_bold)) + return HAIKU_EXTRA_BOLD; + if (EQ (weight, Qultra_bold)) + return HAIKU_ULTRA_BOLD; + if (EQ (weight, Qbook)) + return HAIKU_BOOK; + if (EQ (weight, Qheavy)) + return HAIKU_HEAVY; + if (EQ (weight, Qultra_heavy)) + return HAIKU_ULTRA_HEAVY; + if (EQ (weight, Qblack)) + return HAIKU_BLACK; + if (EQ (weight, Qmedium)) + return HAIKU_MEDIUM; + + emacs_abort (); +} + +static Lisp_Object +haikufont_slant_to_lisp (enum haiku_font_slant slant) +{ + switch (slant) + { + case NO_SLANT: + emacs_abort (); + case SLANT_ITALIC: + return Qitalic; + case SLANT_REGULAR: + return Qnormal; + case SLANT_OBLIQUE: + return Qoblique; + } + emacs_abort (); +} + +static enum haiku_font_slant +haikufont_lisp_to_slant (Lisp_Object slant) +{ + if (EQ (slant, Qitalic) || + EQ (slant, Qreverse_italic)) + return SLANT_ITALIC; + if (EQ (slant, Qoblique) || + EQ (slant, Qreverse_oblique)) + return SLANT_OBLIQUE; + if (EQ (slant, Qnormal)) + return SLANT_REGULAR; + emacs_abort (); +} + +static Lisp_Object +haikufont_width_to_lisp (enum haiku_font_width width) +{ + switch (width) + { + case NO_WIDTH: + emacs_abort (); + case ULTRA_CONDENSED: + return Qultra_condensed; + case EXTRA_CONDENSED: + return Qextra_condensed; + case CONDENSED: + return Qcondensed; + case SEMI_CONDENSED: + return Qsemi_condensed; + case NORMAL_WIDTH: + return Qnormal; + case SEMI_EXPANDED: + return Qsemi_expanded; + case EXPANDED: + return Qexpanded; + case EXTRA_EXPANDED: + return Qextra_expanded; + case ULTRA_EXPANDED: + return Qultra_expanded; + } + + emacs_abort (); +} + +static enum haiku_font_width +haikufont_lisp_to_width (Lisp_Object lisp) +{ + if (EQ (lisp, Qultra_condensed)) + return ULTRA_CONDENSED; + if (EQ (lisp, Qextra_condensed)) + return EXTRA_CONDENSED; + if (EQ (lisp, Qcondensed)) + return CONDENSED; + if (EQ (lisp, Qsemi_condensed)) + return SEMI_CONDENSED; + if (EQ (lisp, Qnormal)) + return NORMAL_WIDTH; + if (EQ (lisp, Qexpanded)) + return EXPANDED; + if (EQ (lisp, Qextra_expanded)) + return EXTRA_EXPANDED; + if (EQ (lisp, Qultra_expanded)) + return ULTRA_EXPANDED; + emacs_abort (); +} + +static int +haikufont_maybe_handle_special_family (Lisp_Object family, + struct haiku_font_pattern *ptn) +{ + CHECK_SYMBOL (family); + + if (EQ (family, Qmonospace) || EQ (family, Qfixed) || + EQ (family, Qdefault)) + { + BFont_populate_fixed_family (ptn); + return 1; + } + else if (EQ (family, intern ("Sans Serif"))) + { + BFont_populate_plain_family (ptn); + return 1; + } + return 0; +} + +static Lisp_Object +haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) +{ + Lisp_Object ent = font_make_entity (); + ASET (ent, FONT_TYPE_INDEX, Qhaiku); + ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku); + ASET (ent, FONT_FAMILY_INDEX, Qdefault); + ASET (ent, FONT_ADSTYLE_INDEX, Qnil); + ASET (ent, FONT_REGISTRY_INDEX, Qutf_8); + ASET (ent, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0)); + ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, Qnormal); + FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, Qnormal); + FONT_SET_STYLE (ent, FONT_SLANT_INDEX, Qnormal); + + if (ptn->specified & FSPEC_FAMILY) + ASET (ent, FONT_FAMILY_INDEX, intern (ptn->family)); + else + ASET (ent, FONT_FAMILY_INDEX, Qdefault); + + if (ptn->specified & FSPEC_STYLE) + ASET (ent, FONT_ADSTYLE_INDEX, intern (ptn->style)); + else + { + if (ptn->specified & FSPEC_WEIGHT) + FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, + haikufont_weight_to_lisp (ptn->weight)); + if (ptn->specified & FSPEC_SLANT) + FONT_SET_STYLE (ent, FONT_SLANT_INDEX, + haikufont_slant_to_lisp (ptn->slant)); + if (ptn->specified & FSPEC_WIDTH) + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, + haikufont_width_to_lisp (ptn->width)); + } + + if (ptn->specified & FSPEC_SPACING) + ASET (ent, FONT_SPACING_INDEX, + make_fixnum (ptn->mono_spacing_p ? + FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); + return ent; +} + +static void +haikufont_spec_or_entity_to_pattern (Lisp_Object ent, + int list_p, + struct haiku_font_pattern *ptn) +{ + Lisp_Object tem; + ptn->specified = 0; + + tem = AREF (ent, FONT_ADSTYLE_INDEX); + if (!NILP (tem)) + { + ptn->specified |= FSPEC_STYLE; + strncpy ((char *) &ptn->style, + SSDATA (SYMBOL_NAME (tem)), + sizeof ptn->style - 1); + } + + tem = FONT_SLANT_SYMBOLIC (ent); + if (!NILP (tem)) + { + ptn->specified |= FSPEC_SLANT; + ptn->slant = haikufont_lisp_to_slant (tem); + } + + tem = FONT_WEIGHT_SYMBOLIC (ent); + if (!NILP (tem)) + { + ptn->specified |= FSPEC_WEIGHT; + ptn->weight = haikufont_lisp_to_weight (tem); + } + + tem = FONT_WIDTH_SYMBOLIC (ent); + if (!NILP (tem)) + { + ptn->specified |= FSPEC_WIDTH; + ptn->width = haikufont_lisp_to_width (tem); + } + + tem = AREF (ent, FONT_SPACING_INDEX); + if (FIXNUMP (tem)) + { + ptn->specified |= FSPEC_SPACING; + ptn->mono_spacing_p = XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL; + } + + tem = AREF (ent, FONT_FAMILY_INDEX); + if (!NILP (tem) && + (list_p && !haikufont_maybe_handle_special_family (tem, ptn))) + { + ptn->specified |= FSPEC_FAMILY; + strncpy ((char *) &ptn->family, + SSDATA (SYMBOL_NAME (tem)), + sizeof ptn->family - 1); + } + + tem = assq_no_quit (QCscript, AREF (ent, FONT_EXTRA_INDEX)); + if (!NILP (tem)) + { + tem = assq_no_quit (XCDR (tem), Vscript_representative_chars); + + if (CONSP (tem) && VECTORP (XCDR (tem))) + { + tem = XCDR (tem); + + int count = 0; + + for (int j = 0; j < ASIZE (tem); ++j) + if (TYPE_RANGED_FIXNUMP (uint32_t, AREF (tem, j))) + ++count; + + if (count) + { + ptn->specified |= FSPEC_NEED_ONE_OF; + ptn->need_one_of_len = count; + ptn->need_one_of = xmalloc (count * sizeof *ptn->need_one_of); + count = 0; + for (int j = 0; j < ASIZE (tem); ++j) + if (TYPE_RANGED_FIXNUMP (uint32_t, AREF (tem, j))) + { + ptn->need_one_of[j] = XFIXNAT (AREF (tem, j)); + ++count; + } + } + } + else if (CONSP (tem) && CONSP (XCDR (tem))) + { + int count = 0; + + for (Lisp_Object it = XCDR (tem); CONSP (it); it = XCDR (it)) + if (TYPE_RANGED_FIXNUMP (uint32_t, XCAR (it))) + ++count; + + if (count) + { + ptn->specified |= FSPEC_WANTED; + ptn->want_chars_len = count; + ptn->wanted_chars = xmalloc (count * sizeof *ptn->wanted_chars); + count = 0; + + for (tem = XCDR (tem); CONSP (tem); tem = XCDR (tem)) + if (TYPE_RANGED_FIXNUMP (uint32_t, XCAR (tem))) + { + ptn->wanted_chars[count] = XFIXNAT (XCAR (tem)); + ++count; + } + } + } + } + + tem = assq_no_quit (QClang, AREF (ent, FONT_EXTRA_INDEX)); + if (CONSP (tem)) + { + tem = XCDR (tem); + if (EQ (tem, Qzh)) + { + ptn->specified |= FSPEC_LANGUAGE; + ptn->language = LANGUAGE_CN; + } + else if (EQ (tem, Qko)) + { + ptn->specified |= FSPEC_LANGUAGE; + ptn->language = LANGUAGE_KO; + } + else if (EQ (tem, Qjp)) + { + ptn->specified |= FSPEC_LANGUAGE; + ptn->language = LANGUAGE_JP; + } + } + + tem = AREF (ent, FONT_REGISTRY_INDEX); + if (SYMBOLP (tem)) + haikufont_apply_registry (ptn, tem); +} + +static void +haikufont_done_with_query_pattern (struct haiku_font_pattern *ptn) +{ + if (ptn->specified & FSPEC_WANTED) + xfree (ptn->wanted_chars); + + if (ptn->specified & FSPEC_NEED_ONE_OF) + xfree (ptn->need_one_of); +} + +static Lisp_Object +haikufont_match (struct frame *f, Lisp_Object font_spec) +{ + block_input (); + Lisp_Object tem = Qnil; + struct haiku_font_pattern ptn; + haikufont_spec_or_entity_to_pattern (font_spec, 0, &ptn); + ptn.specified &= ~FSPEC_FAMILY; + struct haiku_font_pattern *found = BFont_find (&ptn); + haikufont_done_with_query_pattern (&ptn); + if (found) + { + tem = haikufont_pattern_to_entity (found); + haiku_font_pattern_free (found); + } + unblock_input (); + return !NILP (tem) ? tem : haikufont_get_fallback_entity (); +} + +static Lisp_Object +haikufont_list (struct frame *f, Lisp_Object font_spec) +{ + block_input (); + Lisp_Object lst = Qnil; + + /* Returning irrelevant results on receiving an OTF form will cause + fontset.c to loop over and over, making displaying some + characters very slow. */ + Lisp_Object tem = assq_no_quit (QCotf, AREF (font_spec, FONT_EXTRA_INDEX)); + if (CONSP (tem) && !NILP (XCDR (tem))) + { + unblock_input (); + return Qnil; + } + + struct haiku_font_pattern ptn; + haikufont_spec_or_entity_to_pattern (font_spec, 1, &ptn); + struct haiku_font_pattern *found = BFont_find (&ptn); + haikufont_done_with_query_pattern (&ptn); + if (found) + { + for (struct haiku_font_pattern *pt = found; + pt; pt = pt->next) + lst = Fcons (haikufont_pattern_to_entity (pt), lst); + haiku_font_pattern_free (found); + } + unblock_input (); + return lst; +} + +static void +haiku_bulk_encode (struct haikufont_info *font_info, int block) +{ + unsigned short *unichars = xmalloc (0x101 * sizeof (*unichars)); + unsigned int i, idx; + + block_input (); + + font_info->glyphs[block] = unichars; + if (!unichars) + emacs_abort (); + + for (idx = block << 8, i = 0; i < 0x100; idx++, i++) + unichars[i] = idx; + unichars[0x100] = 0; + + + /* If the font contains the entire block, just store it. */ + if (!BFont_have_char_block (font_info->be_font, + unichars[0], unichars[0xff])) + { + for (int i = 0; i < 0x100; ++i) + if (!BFont_have_char_p (font_info->be_font, unichars[i])) + unichars[i] = 0xFFFF; + } + + unblock_input (); +} + +static unsigned int +haikufont_encode_char (struct font *font, int c) +{ + struct haikufont_info *font_info = (struct haikufont_info *) font; + unsigned char high = (c & 0xff00) >> 8, low = c & 0x00ff; + unsigned short g; + + if (c > 0xFFFF) + return FONT_INVALID_CODE; + + if (!font_info->glyphs[high]) + haiku_bulk_encode (font_info, high); + g = font_info->glyphs[high][low]; + return g == 0xFFFF ? FONT_INVALID_CODE : g; +} + +static Lisp_Object +haikufont_open (struct frame *f, Lisp_Object font_entity, int x) +{ + struct haikufont_info *font_info; + struct haiku_font_pattern ptn; + struct font *font; + void *be_font; + Lisp_Object font_object; + Lisp_Object tem; + + block_input (); + if (x <= 0) + { + /* Get pixel size from frame instead. */ + tem = get_frame_param (f, Qfontsize); + x = NILP (tem) ? 0 : XFIXNAT (tem); + } + + haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); + + if (BFont_open_pattern (&ptn, &be_font, x)) + { + haikufont_done_with_query_pattern (&ptn); + unblock_input (); + return Qnil; + } + + haikufont_done_with_query_pattern (&ptn); + + font_object = font_make_object (VECSIZE (struct haikufont_info), + font_entity, x); + + ASET (font_object, FONT_TYPE_INDEX, Qhaiku); + font_info = (struct haikufont_info *) XFONT_OBJECT (font_object); + font = (struct font *) font_info; + + if (!font) + { + unblock_input (); + return Qnil; + } + + font_info->be_font = be_font; + font_info->glyphs = xzalloc (0x100 * sizeof *font_info->glyphs); + + font->pixel_size = 0; + font->driver = &haikufont_driver; + font->encoding_charset = -1; + font->repertory_charset = -1; + font->default_ascent = 0; + font->vertical_centering = 0; + font->baseline_offset = 0; + font->relative_compose = 0; + + font_info->metrics = NULL; + font_info->metrics_nrows = 0; + + int px_size, min_width, max_width, + avg_width, height, space_width, ascent, + descent, underline_pos, underline_thickness; + + BFont_dat (be_font, &px_size, &min_width, + &max_width, &avg_width, &height, + &space_width, &ascent, &descent, + &underline_pos, &underline_thickness); + + font->pixel_size = px_size; + font->min_width = min_width; + font->max_width = max_width; + font->average_width = avg_width; + font->height = height; + font->space_width = space_width; + font->ascent = ascent; + font->descent = descent; + font->default_ascent = ascent; + font->underline_position = underline_pos; + font->underline_thickness = underline_thickness; + + font->vertical_centering = 0; + font->baseline_offset = 0; + font->relative_compose = 0; + + font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil); + + unblock_input (); + return font_object; +} + +static void +haikufont_close (struct font *font) +{ + if (font_data_structures_may_be_ill_formed ()) + return; + struct haikufont_info *info = (struct haikufont_info *) font; + + block_input (); + if (info && info->be_font) + BFont_close (info->be_font); + + for (int i = 0; i < info->metrics_nrows; i++) + if (info->metrics[i]) + xfree (info->metrics[i]); + if (info->metrics) + xfree (info->metrics); + for (int i = 0; i < 0x100; ++i) + if (info->glyphs[i]) + xfree (info->glyphs[i]); + xfree (info->glyphs); + unblock_input (); +} + +static void +haikufont_prepare_face (struct frame *f, struct face *face) +{ + +} + +static void +haikufont_glyph_extents (struct font *font, unsigned code, + struct font_metrics *metrics) +{ + struct haikufont_info *info = (struct haikufont_info *) font; + + struct font_metrics *cache; + int row, col; + + row = code / METRICS_NCOLS_PER_ROW; + col = code % METRICS_NCOLS_PER_ROW; + if (row >= info->metrics_nrows) + { + info->metrics = + xrealloc (info->metrics, + sizeof (struct font_metrics *) * (row + 1)); + memset (info->metrics + info->metrics_nrows, 0, + (sizeof (struct font_metrics *) + * (row + 1 - info->metrics_nrows))); + info->metrics_nrows = row + 1; + } + + if (info->metrics[row] == NULL) + { + struct font_metrics *new; + int i; + + new = xmalloc (sizeof (struct font_metrics) * METRICS_NCOLS_PER_ROW); + for (i = 0; i < METRICS_NCOLS_PER_ROW; i++) + METRICS_SET_STATUS (new + i, METRICS_INVALID); + info->metrics[row] = new; + } + cache = info->metrics[row] + col; + + if (METRICS_STATUS (cache) == METRICS_INVALID) + { + unsigned char utf8[MAX_MULTIBYTE_LENGTH]; + memset (utf8, 0, MAX_MULTIBYTE_LENGTH); + CHAR_STRING (code, utf8); + int advance, lb, rb; + BFont_char_bounds (info->be_font, (const char *) utf8, &advance, &lb, &rb); + + cache->lbearing = lb; + cache->rbearing = rb; + cache->width = advance; + cache->ascent = font->ascent; + cache->descent = font->descent; + } + + if (metrics) + *metrics = *cache; +} + +static void +haikufont_text_extents (struct font *font, const unsigned int *code, + int nglyphs, struct font_metrics *metrics) +{ + int totalwidth = 0; + memset (metrics, 0, sizeof (struct font_metrics)); + + block_input (); + for (int i = 0; i < nglyphs; i++) + { + struct font_metrics m; + haikufont_glyph_extents (font, code[i], &m); + if (metrics) + { + if (totalwidth + m.lbearing < metrics->lbearing) + metrics->lbearing = totalwidth + m.lbearing; + if (totalwidth + m.rbearing > metrics->rbearing) + metrics->rbearing = totalwidth + m.rbearing; + if (m.ascent > metrics->ascent) + metrics->ascent = m.ascent; + if (m.descent > metrics->descent) + metrics->descent = m.descent; + } + totalwidth += m.width; + } + + unblock_input (); + + if (metrics) + metrics->width = totalwidth; +} + +static Lisp_Object +haikufont_shape (Lisp_Object lgstring, Lisp_Object direction) +{ + struct haikufont_info *font = + (struct haikufont_info *) CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring)); + int *advance, *lb, *rb; + ptrdiff_t glyph_len, len, i, b_len; + Lisp_Object tem; + char *b; + uint32_t *mb_buf; + + glyph_len = LGSTRING_GLYPH_LEN (lgstring); + for (i = 0; i < glyph_len; ++i) + { + tem = LGSTRING_GLYPH (lgstring, i); + + if (NILP (tem)) + break; + } + + len = i; + + if (INT_MAX / 2 < len) + memory_full (SIZE_MAX); + + block_input (); + + b_len = 0; + b = xmalloc (b_len); + mb_buf = alloca (len * sizeof *mb_buf); + + for (i = b_len; i < len; ++i) + { + uint32_t c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i)); + mb_buf[i] = c; + unsigned char mb[MAX_MULTIBYTE_LENGTH]; + int slen = CHAR_STRING (c, mb); + + b = xrealloc (b, b_len = (b_len + slen)); + if (len == 1) + b[b_len - slen] = mb[0]; + else + memcpy (b + b_len - slen, mb, slen); + } + + advance = alloca (len * sizeof *advance); + lb = alloca (len * sizeof *lb); + rb = alloca (len * sizeof *rb); + + eassert (font->be_font); + BFont_nchar_bounds (font->be_font, b, advance, lb, rb, len); + xfree (b); + + for (i = 0; i < len; ++i) + { + tem = LGSTRING_GLYPH (lgstring, i); + if (NILP (tem)) + { + tem = LGLYPH_NEW (); + LGSTRING_SET_GLYPH (lgstring, i, tem); + } + + LGLYPH_SET_FROM (tem, i); + LGLYPH_SET_TO (tem, i); + LGLYPH_SET_CHAR (tem, mb_buf[i]); + LGLYPH_SET_CODE (tem, mb_buf[i]); + + LGLYPH_SET_WIDTH (tem, advance[i]); + LGLYPH_SET_LBEARING (tem, lb[i]); + LGLYPH_SET_RBEARING (tem, rb[i]); + LGLYPH_SET_ASCENT (tem, font->font.ascent); + LGLYPH_SET_DESCENT (tem, font->font.descent); + } + + unblock_input (); + + return make_fixnum (len); +} + +static int +haikufont_draw (struct glyph_string *s, int from, int to, + int x, int y, bool with_background) +{ + struct frame *f = s->f; + struct face *face = s->face; + struct font_info *info = (struct font_info *) s->font; + unsigned char mb[MAX_MULTIBYTE_LENGTH]; + void *view = FRAME_HAIKU_VIEW (f); + + block_input (); + prepare_face_for_display (s->f, face); + + BView_draw_lock (view); + BView_StartClip (view); + if (with_background) + { + int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); + + /* Font's global height and ascent values might be + preposterously large for some fonts. We fix here the case + when those fonts are used for display of glyphless + characters, because drawing background with font dimensions + in those cases makes the display illegible. There's only one + more call to the draw method with with_background set to + true, and that's in x_draw_glyph_string_foreground, when + drawing the cursor, where we have no such heuristics + available. FIXME. */ + if (s->first_glyph->type == GLYPHLESS_GLYPH + && (s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE + || s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM)) + height = ascent = + s->first_glyph->slice.glyphless.lower_yoff + - s->first_glyph->slice.glyphless.upper_yoff; + + BView_SetHighColor (view, s->hl == DRAW_CURSOR ? + FRAME_CURSOR_COLOR (s->f).pixel : face->background); + + BView_FillRectangle (view, x, y - ascent, s->width, height); + s->background_filled_p = 1; + } + + if (s->left_overhang && s->clip_head && !s->for_overlaps) + { + /* XXX: Why is this neccessary? */ + BView_ClipToRect (view, s->clip_head->x, 0, + FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); + } + + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else + BView_SetHighColor (view, face->foreground); + + BView_MovePenTo (view, x, y); + BView_SetFont (view, ((struct haikufont_info *) info)->be_font); + + if (from == to) + { + int len = CHAR_STRING (s->char2b[from], mb); + BView_DrawString (view, (char *) mb, len); + } + else + { + ptrdiff_t b_len = 0; + char *b = xmalloc (b_len); + + for (int idx = from; idx < to; ++idx) + { + int len = CHAR_STRING (s->char2b[idx], mb); + b = xrealloc (b, b_len = (b_len + len)); + if (len == 1) + b[b_len - len] = mb[0]; + else + memcpy (b + b_len - len, mb, len); + } + + BView_DrawString (view, b, b_len); + xfree (b); + } + BView_EndClip (view); + BView_draw_unlock (view); + unblock_input (); + return 1; +} + +struct font_driver const haikufont_driver = + { + .type = LISPSYM_INITIALLY (Qhaiku), + .case_sensitive = true, + .get_cache = haikufont_get_cache, + .list = haikufont_list, + .match = haikufont_match, + .draw = haikufont_draw, + .open_font = haikufont_open, + .close_font = haikufont_close, + .prepare_face = haikufont_prepare_face, + .encode_char = haikufont_encode_char, + .text_extents = haikufont_text_extents, + .shape = haikufont_shape + }; + +void +syms_of_haikufont (void) +{ + DEFSYM (Qfontsize, "fontsize"); + DEFSYM (Qfixed, "fixed"); + DEFSYM (Qplain, "plain"); + DEFSYM (Qultra_light, "ultra-light"); + DEFSYM (Qthin, "thin"); + DEFSYM (Qreverse_italic, "reverse-italic"); + DEFSYM (Qreverse_oblique, "reverse-oblique"); + DEFSYM (Qmonospace, "monospace"); + DEFSYM (Qultra_condensed, "ultra-condensed"); + DEFSYM (Qextra_condensed, "extra-condensed"); + DEFSYM (Qcondensed, "condensed"); + DEFSYM (Qsemi_condensed, "semi-condensed"); + DEFSYM (Qsemi_expanded, "semi-expanded"); + DEFSYM (Qexpanded, "expanded"); + DEFSYM (Qextra_expanded, "extra-expanded"); + DEFSYM (Qultra_expanded, "ultra-expanded"); + DEFSYM (Qzh, "zh"); + DEFSYM (Qko, "ko"); + DEFSYM (Qjp, "jp"); + + font_cache = list (Qnil); + staticpro (&font_cache); +} diff --git a/src/haikugui.h b/src/haikugui.h new file mode 100644 index 00000000000..cfc693fb552 --- /dev/null +++ b/src/haikugui.h @@ -0,0 +1,106 @@ +/* Haiku window system support + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef _HAIKU_GUI_H_ +#define _HAIKU_GUI_H_ + +#ifdef _cplusplus +extern "C" +{ +#endif + +typedef struct haiku_char_struct +{ + int rbearing; + int lbearing; + int width; + int ascent; + int descent; +} XCharStruct; + +struct haiku_rect +{ + int x, y; + int width, height; +}; + +typedef void *haiku; + +typedef haiku Emacs_Pixmap; +typedef haiku Emacs_Window; +typedef haiku Emacs_Cursor; +typedef haiku Drawable; + +#define NativeRectangle struct haiku_rect +#define CONVERT_TO_EMACS_RECT(xr, nr) \ + ((xr).x = (nr).x, \ + (xr).y = (nr).y, \ + (xr).width = (nr).width, \ + (xr).height = (nr).height) + +#define CONVERT_FROM_EMACS_RECT(xr, nr) \ + ((nr).x = (xr).x, \ + (nr).y = (xr).y, \ + (nr).width = (xr).width, \ + (nr).height = (xr).height) + +#define STORE_NATIVE_RECT(nr, px, py, pwidth, pheight) \ + ((nr).x = (px), \ + (nr).y = (py), \ + (nr).width = (pwidth), \ + (nr).height = (pheight)) + +#define ForgetGravity 0 +#define NorthWestGravity 1 +#define NorthGravity 2 +#define NorthEastGravity 3 +#define WestGravity 4 +#define CenterGravity 5 +#define EastGravity 6 +#define SouthWestGravity 7 +#define SouthGravity 8 +#define SouthEastGravity 9 +#define StaticGravity 10 + +#define NoValue 0x0000 +#define XValue 0x0001 +#define YValue 0x0002 +#define WidthValue 0x0004 +#define HeightValue 0x0008 +#define AllValues 0x000F +#define XNegative 0x0010 +#define YNegative 0x0020 + +#define USPosition (1L << 0) /* user specified x, y */ +#define USSize (1L << 1) /* user specified width, height */ +#define PPosition (1L << 2) /* program specified position */ +#define PSize (1L << 3) /* program specified size */ +#define PMinSize (1L << 4) /* program specified minimum size */ +#define PMaxSize (1L << 5) /* program specified maximum size */ +#define PResizeInc (1L << 6) /* program specified resize increments */ +#define PAspect (1L << 7) /* program specified min, max aspect ratios */ +#define PBaseSize (1L << 8) /* program specified base for incrementing */ +#define PWinGravity (1L << 9) /* program specified window gravity */ + +typedef haiku Window; +typedef int Display; + +#ifdef _cplusplus +}; +#endif +#endif /* _HAIKU_GUI_H_ */ diff --git a/src/haikuimage.c b/src/haikuimage.c new file mode 100644 index 00000000000..138e5b84e6a --- /dev/null +++ b/src/haikuimage.c @@ -0,0 +1,109 @@ +/* Haiku window system support. + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include "lisp.h" +#include "dispextern.h" +#include "haikuterm.h" +#include "coding.h" + +#include "haiku_support.h" + +bool +haiku_can_use_native_image_api (Lisp_Object type) +{ + const char *mime_type = NULL; + + if (EQ (type, Qnative_image)) + return 1; + +#ifdef HAVE_RSVG + if (EQ (type, Qsvg)) + return 0; +#endif + + if (EQ (type, Qjpeg)) + mime_type = "image/jpeg"; + else if (EQ (type, Qpng)) + mime_type = "image/png"; + else if (EQ (type, Qgif)) + mime_type = "image/gif"; + else if (EQ (type, Qtiff)) + mime_type = "image/tiff"; + else if (EQ (type, Qbmp)) + mime_type = "image/bmp"; + else if (EQ (type, Qsvg)) + mime_type = "image/svg"; + else if (EQ (type, Qpbm)) + mime_type = "image/pbm"; + + if (!mime_type) + return 0; + + return be_can_translate_type_to_bitmap_p (mime_type); +} + +extern int +haiku_load_image (struct frame *f, struct image *img, + Lisp_Object spec_file, Lisp_Object spec_data) +{ + eassert (valid_image_p (img->spec)); + + void *pixmap = NULL; + + if (STRINGP (spec_file)) + { + pixmap = be_translate_bitmap_from_file_name + (SSDATA (ENCODE_UTF_8 (spec_file))); + } + else if (STRINGP (spec_data)) + { + pixmap = be_translate_bitmap_from_memory + (SSDATA (spec_data), SBYTES (spec_data)); + } + + void *conv = NULL; + + if (!pixmap || !BBitmap_convert (pixmap, &conv)) + { + add_to_log ("Unable to load image %s", img->spec); + return 0; + } + + if (conv) + { + BBitmap_free (pixmap); + pixmap = conv; + } + + int left, top, right, bottom, stride, mono_p; + BBitmap_dimensions (pixmap, &left, &top, &right, &bottom, &stride, &mono_p); + + img->width = (1 + right - left); + img->height = (1 + bottom - top); + img->pixmap = pixmap; + + return 1; +} + +void +syms_of_haikuimage (void) +{ + DEFSYM (Qbmp, "bmp"); +} diff --git a/src/haikumenu.c b/src/haikumenu.c new file mode 100644 index 00000000000..698da9d639c --- /dev/null +++ b/src/haikumenu.c @@ -0,0 +1,656 @@ +/* Haiku window system support + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include "lisp.h" +#include "frame.h" +#include "keyboard.h" +#include "menu.h" +#include "buffer.h" +#include "blockinput.h" + +#include "haikuterm.h" +#include "haiku_support.h" + +static Lisp_Object *volatile menu_item_selection; + +int popup_activated_p = 0; + +struct submenu_stack_cell +{ + void *parent_menu; + void *pane; +}; + +static void +digest_menu_items (void *first_menu, int start, int menu_items_used, + int mbar_p) +{ + void **menus, **panes; + ssize_t menu_len = (menu_items_used + 1 - start) * sizeof *menus; + ssize_t pane_len = (menu_items_used + 1 - start) * sizeof *panes; + + menus = alloca (menu_len); + panes = alloca (pane_len); + + int i = start, menu_depth = 0; + + memset (menus, 0, menu_len); + memset (panes, 0, pane_len); + + void *menu = first_menu; + + menus[0] = first_menu; + + void *window = NULL; + if (FRAMEP (Vmenu_updating_frame) && + FRAME_LIVE_P (XFRAME (Vmenu_updating_frame)) && + FRAME_HAIKU_P (XFRAME (Vmenu_updating_frame))) + window = FRAME_HAIKU_WINDOW (XFRAME (Vmenu_updating_frame)); + + while (i < menu_items_used) + { + if (NILP (AREF (menu_items, i))) + { + menus[++menu_depth] = menu; + i++; + } + else if (EQ (AREF (menu_items, i), Qlambda)) + { + panes[menu_depth] = NULL; + menu = panes[--menu_depth] ? panes[menu_depth] : menus[menu_depth]; + i++; + } + else if (EQ (AREF (menu_items, i), Qquote)) + i += 1; + else if (EQ (AREF (menu_items, i), Qt)) + { + Lisp_Object pane_name, prefix; + const char *pane_string; + + if (menu_items_n_panes == 1) + { + i += MENU_ITEMS_PANE_LENGTH; + continue; + } + + pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + + if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) + { + pane_name = ENCODE_UTF_8 (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } + + pane_string = (NILP (pane_name) + ? "" : SSDATA (pane_name)); + if (!NILP (prefix)) + pane_string++; + + if (strcmp (pane_string, "")) + { + panes[menu_depth] = + menu = BMenu_new_submenu (menus[menu_depth], pane_string, 1); + } + + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + Lisp_Object item_name, enable, descrip, def, selected, help; + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION); + selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); + help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); + + if (STRINGP (item_name) && STRING_MULTIBYTE (item_name)) + { + item_name = ENCODE_UTF_8 (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } + + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_UTF_8 (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } + + if (STRINGP (help) && STRING_MULTIBYTE (help)) + { + help = ENCODE_UTF_8 (help); + ASET (menu_items, i + MENU_ITEMS_ITEM_HELP, help); + } + + if (i + MENU_ITEMS_ITEM_LENGTH < menu_items_used && + NILP (AREF (menu_items, i + MENU_ITEMS_ITEM_LENGTH))) + menu = BMenu_new_submenu (menu, SSDATA (item_name), !NILP (enable)); + else if (NILP (def) && menu_separator_name_p (SSDATA (item_name))) + BMenu_add_separator (menu); + else if (!mbar_p) + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? aref_addr (menu_items, i) : NULL, + !NILP (enable), !NILP (selected), 0, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + STRINGP (help) ? SSDATA (help) : NULL); + else + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? (void *) (intptr_t) i : NULL, + !NILP (enable), !NILP (selected), 1, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + STRINGP (help) ? SSDATA (help) : NULL); + + i += MENU_ITEMS_ITEM_LENGTH; + } + } +} + +static Lisp_Object +haiku_dialog_show (struct frame *f, Lisp_Object title, + Lisp_Object header, const char **error_name) +{ + int i, nb_buttons = 0; + + *error_name = NULL; + + if (menu_items_n_panes > 1) + { + *error_name = "Multiple panes in dialog box"; + return Qnil; + } + + Lisp_Object pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); + i = MENU_ITEMS_PANE_LENGTH; + + if (STRING_MULTIBYTE (pane_name)) + pane_name = ENCODE_UTF_8 (pane_name); + + block_input (); + void *alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT : + HAIKU_IDEA_ALERT); + + Lisp_Object vals[10]; + + while (i < menu_items_used) + { + Lisp_Object item_name, enable, descrip, value; + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + value = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); + + if (NILP (item_name)) + { + BAlert_delete (alert); + *error_name = "Submenu in dialog items"; + unblock_input (); + return Qnil; + } + + if (EQ (item_name, Qquote)) + { + i++; + } + + if (nb_buttons >= 9) + { + BAlert_delete (alert); + *error_name = "Too many dialog items"; + unblock_input (); + return Qnil; + } + + if (STRING_MULTIBYTE (item_name)) + item_name = ENCODE_UTF_8 (item_name); + if (!NILP (descrip) && STRING_MULTIBYTE (descrip)) + descrip = ENCODE_UTF_8 (descrip); + + void *button = BAlert_add_button (alert, SSDATA (item_name)); + + BButton_set_enabled (button, !NILP (enable)); + if (!NILP (descrip)) + BView_set_tooltip (button, SSDATA (descrip)); + + vals[nb_buttons] = value; + ++nb_buttons; + i += MENU_ITEMS_ITEM_LENGTH; + } + + int32_t val = BAlert_go (alert); + unblock_input (); + + if (val < 0) + quit (); + else + return vals[val]; + + return Qnil; +} + +Lisp_Object +haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) +{ + Lisp_Object title; + const char *error_name = NULL; + Lisp_Object selection; + ptrdiff_t specpdl_count = SPECPDL_INDEX (); + + check_window_system (f); + + /* Decode the dialog items from what was specified. */ + title = Fcar (contents); + CHECK_STRING (title); + record_unwind_protect_void (unuse_menu_items); + + if (NILP (Fcar (Fcdr (contents)))) + /* No buttons specified, add an "Ok" button so users can pop down + the dialog. Also, the lesstif/motif version crashes if there are + no buttons. */ + contents = list2 (title, Fcons (build_string ("Ok"), Qt)); + + list_of_panes (list1 (contents)); + + /* Display them in a dialog box. */ + block_input (); + selection = haiku_dialog_show (f, title, header, &error_name); + unblock_input (); + + unbind_to (specpdl_count, Qnil); + discard_menu_items (); + + if (error_name) + error ("%s", error_name); + return selection; +} + +Lisp_Object +haiku_menu_show (struct frame *f, int x, int y, int menuflags, + Lisp_Object title, const char **error_name) +{ + int i = 0, submenu_depth = 0; + void *view = FRAME_HAIKU_VIEW (f); + void *menu; + + Lisp_Object *subprefix_stack = + alloca (menu_items_used * sizeof (Lisp_Object)); + + eassert (FRAME_HAIKU_P (f)); + + *error_name = NULL; + + if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) + { + *error_name = "Empty menu"; + return Qnil; + } + + block_input (); + if (STRINGP (title) && STRING_MULTIBYTE (title)) + title = ENCODE_UTF_8 (title); + + menu = BPopUpMenu_new (STRINGP (title) ? SSDATA (title) : NULL); + if (STRINGP (title)) + { + BMenu_add_title (menu, SSDATA (title)); + BMenu_add_separator (menu); + } + digest_menu_items (menu, 0, menu_items_used, 0); + BView_convert_to_screen (view, &x, &y); + unblock_input (); + + menu_item_selection = BMenu_run (menu, x, y); + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (menu_item_selection) + { + Lisp_Object prefix, entry; + + prefix = entry = Qnil; + i = 0; + while (i < menu_items_used) + { + if (NILP (AREF (menu_items, i))) + { + subprefix_stack[submenu_depth++] = prefix; + prefix = entry; + i++; + } + else if (EQ (AREF (menu_items, i), Qlambda)) + { + prefix = subprefix_stack[--submenu_depth]; + i++; + } + else if (EQ (AREF (menu_items, i), Qt)) + { + prefix + = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + i += MENU_ITEMS_PANE_LENGTH; + } + /* Ignore a nil in the item list. + It's meaningful only for dialog boxes. */ + else if (EQ (AREF (menu_items, i), Qquote)) + i += 1; + else + { + entry + = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); + if (menu_item_selection == aref_addr (menu_items, i)) + { + if (menuflags & MENU_KEYMAPS) + { + int j; + + entry = list1 (entry); + if (!NILP (prefix)) + entry = Fcons (prefix, entry); + for (j = submenu_depth - 1; j >= 0; j--) + if (!NILP (subprefix_stack[j])) + entry = Fcons (subprefix_stack[j], entry); + } + BPopUpMenu_delete (menu); + return entry; + } + i += MENU_ITEMS_ITEM_LENGTH; + } + } + } + else if (!(menuflags & MENU_FOR_CLICK)) + { + BPopUpMenu_delete (menu); + quit (); + } + BPopUpMenu_delete (menu); + return Qnil; +} + +void +free_frame_menubar (struct frame *f) +{ + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + FRAME_EXTERNAL_MENU_BAR (f) = 0; + + block_input (); + void *mbar = FRAME_HAIKU_MENU_BAR (f); + if (mbar) + BMenuBar_delete (mbar); + if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + --popup_activated_p; + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0; + unblock_input (); + + adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines); +} + +void +initialize_frame_menubar (struct frame *f) +{ + /* This function is called before the first chance to redisplay + the frame. It has to be, so the frame will have the right size. */ + fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); + set_frame_menubar (f, true); +} + +void +set_frame_menubar (struct frame *f, bool deep_p) +{ + void *mbar = FRAME_HAIKU_MENU_BAR (f); + void *view = FRAME_HAIKU_VIEW (f); + + int first_time_p = 0; + + if (!mbar) + { + mbar = FRAME_HAIKU_MENU_BAR (f) = BMenuBar_new (view); + first_time_p = 1; + } + + Lisp_Object items; + struct buffer *prev = current_buffer; + Lisp_Object buffer; + ptrdiff_t specpdl_count = SPECPDL_INDEX (); + int previous_menu_items_used = f->menu_bar_items_used; + Lisp_Object *previous_items + = alloca (previous_menu_items_used * sizeof *previous_items); + + XSETFRAME (Vmenu_updating_frame, f); + + if (!deep_p) + { + FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 0; + items = FRAME_MENU_BAR_ITEMS (f); + Lisp_Object string; + + block_input (); + int count = BMenu_count_items (mbar); + + int i; + for (i = 0; i < ASIZE (items); i += 4) + { + string = AREF (items, i + 1); + + if (!STRINGP (string)) + break; + + if (STRING_MULTIBYTE (string)) + string = ENCODE_UTF_8 (string); + + if (i / 4 < count) + { + void *it = BMenu_item_at (mbar, i / 4); + BMenu_item_set_label (it, SSDATA (string)); + } + else + BMenu_new_menu_bar_submenu (mbar, SSDATA (string)); + } + + if (i / 4 < count) + BMenu_delete_from (mbar, i / 4, count - i / 4 + 1); + unblock_input (); + + f->menu_bar_items_used = 0; + } + else + { + /* If we are making a new widget, its contents are empty, + do always reinitialize them. */ + if (first_time_p) + previous_menu_items_used = 0; + buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->contents; + specbind (Qinhibit_quit, Qt); + /* Don't let the debugger step into this code + because it is not reentrant. */ + specbind (Qdebug_on_next_call, Qnil); + + record_unwind_save_match_data (); + if (NILP (Voverriding_local_map_menu_flag)) + { + specbind (Qoverriding_terminal_local_map, Qnil); + specbind (Qoverriding_local_map, Qnil); + } + + set_buffer_internal_1 (XBUFFER (buffer)); + + /* Run the Lucid hook. */ + safe_run_hooks (Qactivate_menubar_hook); + + /* If it has changed current-menubar from previous value, + really recompute the menubar from the value. */ + if (! NILP (Vlucid_menu_bar_dirty_flag)) + call0 (Qrecompute_lucid_menubar); + safe_run_hooks (Qmenu_bar_update_hook); + fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); + + items = FRAME_MENU_BAR_ITEMS (f); + + /* Save the frame's previous menu bar contents data. */ + if (previous_menu_items_used) + memcpy (previous_items, xvector_contents (f->menu_bar_vector), + previous_menu_items_used * word_size); + + /* Fill in menu_items with the current menu bar contents. + This can evaluate Lisp code. */ + save_menu_items (); + menu_items = f->menu_bar_vector; + menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; + init_menu_items (); + int i; + int count = BMenu_count_items (mbar); + int subitems = ASIZE (items) / 4; + + int *submenu_start, *submenu_end, *submenu_n_panes; + Lisp_Object *submenu_names; + + submenu_start = alloca ((subitems + 1) * sizeof *submenu_start); + submenu_end = alloca (subitems * sizeof *submenu_end); + submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes); + submenu_names = alloca (subitems * sizeof (Lisp_Object)); + + for (i = 0; i < subitems; ++i) + { + Lisp_Object key, string, maps; + + key = AREF (items, i * 4); + string = AREF (items, i * 4 + 1); + maps = AREF (items, i * 4 + 2); + + if (NILP (string)) + break; + + if (STRINGP (string) && STRING_MULTIBYTE (string)) + string = ENCODE_UTF_8 (string); + + submenu_start[i] = menu_items_used; + menu_items_n_panes = 0; + parse_single_submenu (key, string, maps); + submenu_n_panes[i] = menu_items_n_panes; + submenu_end[i] = menu_items_used; + submenu_names[i] = string; + } + finish_menu_items (); + submenu_start[i] = -1; + + block_input (); + for (i = 0; submenu_start[i] >= 0; ++i) + { + void *mn = NULL; + if (i < count) + mn = BMenu_item_get_menu (BMenu_item_at (mbar, i)); + if (mn) + BMenu_delete_all (mn); + else + mn = BMenu_new_menu_bar_submenu (mbar, SSDATA (submenu_names[i])); + + menu_items_n_panes = submenu_n_panes[i]; + digest_menu_items (mn, submenu_start[i], submenu_end[i], 1); + } + unblock_input (); + + set_buffer_internal_1 (prev); + + FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 1; + fset_menu_bar_vector (f, menu_items); + f->menu_bar_items_used = menu_items_used; + } + unbind_to (specpdl_count, Qnil); +} + +void +run_menu_bar_help_event (struct frame *f, int mb_idx) +{ + Lisp_Object frame; + Lisp_Object vec; + Lisp_Object help; + + block_input (); + if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) + { + unblock_input (); + return; + } + + XSETFRAME (frame, f); + + if (mb_idx < 0) + { + kbd_buffer_store_help_event (frame, Qnil); + unblock_input (); + return; + } + + vec = f->menu_bar_vector; + if (mb_idx >= ASIZE (vec)) + emacs_abort (); + + help = AREF (vec, mb_idx + MENU_ITEMS_ITEM_HELP); + if (STRINGP (help) || NILP (help)) + kbd_buffer_store_help_event (frame, help); + unblock_input (); +} + +DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, + 0, 0, 0, doc: /* SKIP: real doc in xmenu.c. */) + (void) +{ + return popup_activated_p ? Qt : Qnil; +} + +DEFUN ("haiku-menu-bar-open", Fhaiku_menu_bar_open, Shaiku_menu_bar_open, 0, 1, "i", + doc: /* Show the menu bar in FRAME. + +Move the mouse pointer onto the first element of FRAME's menu bar, and +cause it to be opened. If FRAME is nil or not given, use the selected +frame. If FRAME has no menu bar, a pop-up is displayed at the position +of the last non-menu event instead. */) + (Lisp_Object frame) +{ + struct frame *f = decode_window_system_frame (frame); + + if (FRAME_EXTERNAL_MENU_BAR (f)) + { + if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) + set_frame_menubar (f, 1); + } + else + { + return call2 (Qpopup_menu, call0 (Qmouse_menu_bar_map), + last_nonmenu_event); + } + + block_input (); + BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); + unblock_input (); + + return Qnil; +} + +void +syms_of_haikumenu (void) +{ + DEFSYM (Qdebug_on_next_call, "debug-on-next-call"); + DEFSYM (Qpopup_menu, "popup-menu"); + DEFSYM (Qmouse_menu_bar_map, "mouse-menu-bar-map"); + + defsubr (&Smenu_or_popup_active_p); + defsubr (&Shaiku_menu_bar_open); + return; +} diff --git a/src/haikuselect.c b/src/haikuselect.c new file mode 100644 index 00000000000..3f0441e0779 --- /dev/null +++ b/src/haikuselect.c @@ -0,0 +1,134 @@ +/* Haiku window system selection support. + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include "lisp.h" +#include "blockinput.h" +#include "coding.h" +#include "haikuselect.h" +#include "haikuterm.h" + +DEFUN ("haiku-selection-data", Fhaiku_selection_data, Shaiku_selection_data, + 2, 2, 0, + doc: /* Retrieve content typed as NAME from the clipboard +CLIPBOARD. CLIPBOARD is the symbol `PRIMARY', `SECONDARY' or +`CLIPBOARD'. NAME is a MIME type denoting the type of the data to +fetch. */) + (Lisp_Object clipboard, Lisp_Object name) +{ + CHECK_SYMBOL (clipboard); + CHECK_STRING (name); + char *dat; + ssize_t len; + + block_input (); + if (EQ (clipboard, QPRIMARY)) + dat = BClipboard_find_primary_selection_data (SSDATA (name), &len); + else if (EQ (clipboard, QSECONDARY)) + dat = BClipboard_find_secondary_selection_data (SSDATA (name), &len); + else if (EQ (clipboard, QCLIPBOARD)) + dat = BClipboard_find_system_data (SSDATA (name), &len); + else + { + unblock_input (); + signal_error ("Bad clipboard", clipboard); + } + unblock_input (); + + if (!dat) + return Qnil; + + Lisp_Object str = make_unibyte_string (dat, len); + Lisp_Object lispy_type = Qnil; + + if (!strcmp (SSDATA (name), "text/utf-8") || + !strcmp (SSDATA (name), "text/plain")) + { + if (string_ascii_p (str)) + lispy_type = QSTRING; + else + lispy_type = QUTF8_STRING; + } + + if (!NILP (lispy_type)) + Fput_text_property (make_fixnum (0), make_fixnum (len), + Qforeign_selection, lispy_type, str); + + block_input (); + BClipboard_free_data (dat); + unblock_input (); + + return str; +} + +DEFUN ("haiku-selection-put", Fhaiku_selection_put, Shaiku_selection_put, + 3, 3, 0, + doc: /* Add or remove content from the clipboard CLIPBOARD. +CLIPBOARD is the symbol `PRIMARY', `SECONDARY' or `CLIPBOARD'. NAME +is a MIME type denoting the type of the data to add. DATA is the +string that will be placed in the clipboard, or nil if the content is +to be removed. If NAME is the string `text/utf-8' or the string +`text/plain', encode it as UTF-8 before storing it into the +clipboard. */) + (Lisp_Object clipboard, Lisp_Object name, Lisp_Object data) +{ + CHECK_SYMBOL (clipboard); + CHECK_STRING (name); + if (!NILP (data)) + CHECK_STRING (data); + + block_input (); + /* It seems that Haiku applications counter-intuitively expect + UTF-8 data in both text/utf-8 and text/plain. */ + if (!NILP (data) && STRING_MULTIBYTE (data) && + (!strcmp (SSDATA (name), "text/utf-8") || + !strcmp (SSDATA (name), "text/plain"))) + data = ENCODE_UTF_8 (data); + + char *dat = !NILP (data) ? SSDATA (data) : NULL; + ptrdiff_t len = !NILP (data) ? SBYTES (data) : 0; + + if (EQ (clipboard, QPRIMARY)) + BClipboard_set_primary_selection_data (SSDATA (name), dat, len); + else if (EQ (clipboard, QSECONDARY)) + BClipboard_set_secondary_selection_data (SSDATA (name), dat, len); + else if (EQ (clipboard, QCLIPBOARD)) + BClipboard_set_system_data (SSDATA (name), dat, len); + else + { + unblock_input (); + signal_error ("Bad clipboard", clipboard); + } + unblock_input (); + + return Qnil; +} + +void +syms_of_haikuselect (void) +{ + DEFSYM (QSECONDARY, "SECONDARY"); + DEFSYM (QCLIPBOARD, "CLIPBOARD"); + DEFSYM (QSTRING, "STRING"); + DEFSYM (QUTF8_STRING, "UTF8_STRING"); + DEFSYM (Qforeign_selection, "foreign-selection"); + + defsubr (&Shaiku_selection_data); + defsubr (&Shaiku_selection_put); +} diff --git a/src/haikuselect.h b/src/haikuselect.h new file mode 100644 index 00000000000..542d550d64e --- /dev/null +++ b/src/haikuselect.h @@ -0,0 +1,64 @@ +/* Haiku window system selection support. Hey Emacs, this is -*- C++ -*- + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef _HAIKU_SELECT_H_ +#define _HAIKU_SELECT_H_ + +#ifdef __cplusplus +#include +#endif + +#ifdef __cplusplus +#include +extern "C" +{ + extern void init_haiku_select (void); +#endif + + /* Whether or not the selection was recently changed. */ + extern int selection_state_flag; + + /* Find a string with the MIME type TYPE in the system clipboard. */ + extern char * + BClipboard_find_system_data (const char *type, ssize_t *len); + + /* Ditto, but for the primary selection and not clipboard. */ + extern char * + BClipboard_find_primary_selection_data (const char *type, ssize_t *len); + + /* Ditto, this time for the secondary selection. */ + extern char * + BClipboard_find_secondary_selection_data (const char *type, ssize_t *len); + + extern void + BClipboard_set_system_data (const char *type, const char *data, ssize_t len); + + extern void + BClipboard_set_primary_selection_data (const char *type, const char *data, + ssize_t len); + + extern void + BClipboard_set_secondary_selection_data (const char *type, const char *data, + ssize_t len); + + /* Free the returned data. */ + extern void BClipboard_free_data (void *ptr); +#ifdef __cplusplus +}; +#endif +#endif /* _HAIKU_SELECT_H_ */ diff --git a/src/haikuterm.c b/src/haikuterm.c new file mode 100644 index 00000000000..05fbd1021b8 --- /dev/null +++ b/src/haikuterm.c @@ -0,0 +1,3608 @@ +/* Haiku window system support + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include "dispextern.h" +#include "frame.h" +#include "lisp.h" +#include "haikugui.h" +#include "keyboard.h" +#include "haikuterm.h" +#include "blockinput.h" +#include "termchar.h" +#include "termhooks.h" +#include "menu.h" +#include "buffer.h" +#include "haiku_support.h" +#include "thread.h" +#include "window.h" + +#include +#include + +#ifdef USE_BE_CAIRO +#include +#endif + +struct haiku_display_info *x_display_list = NULL; +extern frame_parm_handler haiku_frame_parm_handlers[]; + +static void **fringe_bmps; +static int fringe_bitmap_fillptr = 0; + +static Lisp_Object rdb; + +struct unhandled_event +{ + struct unhandled_event *next; + enum haiku_event_type type; + uint8_t buffer[200]; +}; + +char * +get_keysym_name (int keysym) +{ + static char value[16]; + sprintf (value, "%d", keysym); + return value; +} + +static struct frame * +haiku_window_to_frame (void *window) +{ + Lisp_Object tail, tem; + struct frame *f; + + FOR_EACH_FRAME (tail, tem) + { + f = XFRAME (tem); + if (!FRAME_HAIKU_P (f)) + continue; + + eassert (FRAME_DISPLAY_INFO (f) == x_display_list); + + if (FRAME_HAIKU_WINDOW (f) == window) + return f; + } + + return 0; +} + +static void +haiku_coords_from_parent (struct frame *f, int *x, int *y) +{ + struct frame *p = FRAME_PARENT_FRAME (f); + eassert (p); + + for (struct frame *parent = p; parent; + parent = FRAME_PARENT_FRAME (parent)) + { + *x -= parent->left_pos; + *y -= parent->top_pos; + } +} + +static void +haiku_delete_terminal (struct terminal *terminal) +{ + emacs_abort (); +} + +static const char * +get_string_resource (void *ignored, const char *name, const char *class) +{ + if (!name) + return NULL; + + Lisp_Object lval = assoc_no_quit (build_string (name), rdb); + + if (!NILP (lval)) + return SSDATA (XCDR (lval)); + + return NULL; +} + +static void +haiku_update_size_hints (struct frame *f) +{ + int base_width, base_height; + eassert (FRAME_HAIKU_P (f) && FRAME_HAIKU_WINDOW (f)); + + base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); + base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); + + block_input (); + BWindow_set_size_alignment (FRAME_HAIKU_WINDOW (f), + frame_resize_pixelwise ? 1 : FRAME_COLUMN_WIDTH (f), + frame_resize_pixelwise ? 1 : FRAME_LINE_HEIGHT (f)); + BWindow_set_min_size (FRAME_HAIKU_WINDOW (f), base_width, + base_height + + FRAME_TOOL_BAR_HEIGHT (f) + + FRAME_MENU_BAR_HEIGHT (f)); + unblock_input (); +} + +static void +haiku_clip_to_string (struct glyph_string *s) +{ + struct haiku_rect r[2]; + int n = get_glyph_string_clip_rects (s, (struct haiku_rect *) &r, 2); + + if (n) + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[0].x, r[0].y, + r[0].width, r[0].height); + if (n > 1) + { + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[1].x, r[1].y, + r[1].width, r[1].height); + } + + s->num_clips = n; +} + +static void +haiku_clip_to_string_exactly (struct glyph_string *s, struct glyph_string *dst) +{ + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), s->x, s->y, + s->width, s->height); + dst->num_clips = 1; +} + +static void +haiku_flip_buffers (struct frame *f) +{ + void *view = FRAME_OUTPUT_DATA (f)->view; + block_input (); + + BView_draw_lock (view); + FRAME_DIRTY_P (f) = 0; + EmacsView_flip_and_blit (view); + BView_draw_unlock (view); + + unblock_input (); +} + +static void +haiku_frame_up_to_date (struct frame *f) +{ + block_input (); + FRAME_MOUSE_UPDATE (f); + if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ()) + haiku_flip_buffers (f); + unblock_input (); +} + +static void +haiku_buffer_flipping_unblocked_hook (struct frame *f) +{ + if (FRAME_DIRTY_P (f)) + haiku_flip_buffers (f); +} + +static void +haiku_clear_frame_area (struct frame *f, int x, int y, + int width, int height) +{ + void *vw = FRAME_HAIKU_VIEW (f); + block_input (); + BView_draw_lock (vw); + BView_StartClip (vw); + BView_ClipToRect (vw, x, y, width, height); + BView_SetHighColor (vw, FRAME_BACKGROUND_PIXEL (f)); + BView_FillRectangle (vw, x, y, width, height); + BView_EndClip (vw); + BView_draw_unlock (vw); + unblock_input (); +} + +static void +haiku_clear_frame (struct frame *f) +{ + void *view = FRAME_HAIKU_VIEW (f); + block_input (); + BView_draw_lock (view); + BView_StartClip (view); + BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_SetHighColor (view, FRAME_BACKGROUND_PIXEL (f)); + BView_FillRectangle (view, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_EndClip (view); + BView_draw_unlock (view); + unblock_input (); +} + +/* Give frame F the font FONT-OBJECT as its default font. The return + value is FONT-OBJECT. FONTSET is an ID of the fontset for the + frame. If it is negative, generate a new fontset from + FONT-OBJECT. */ + +static Lisp_Object +haiku_new_font (struct frame *f, Lisp_Object font_object, int fontset) +{ + struct font *font = XFONT_OBJECT (font_object); + if (fontset < 0) + fontset = fontset_from_font (font_object); + + FRAME_FONTSET (f) = fontset; + if (FRAME_FONT (f) == font) + return font_object; + + FRAME_FONT (f) = font; + FRAME_BASELINE_OFFSET (f) = font->baseline_offset; + FRAME_COLUMN_WIDTH (f) = font->average_width; + + int ascent, descent; + get_font_ascent_descent (font, &ascent, &descent); + FRAME_LINE_HEIGHT (f) = ascent + descent; + FRAME_TAB_BAR_HEIGHT (f) = FRAME_TAB_BAR_LINES (f) * FRAME_LINE_HEIGHT (f); + + int unit = FRAME_COLUMN_WIDTH (f); + if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0) + FRAME_CONFIG_SCROLL_BAR_COLS (f) + = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit; + else + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + unit - 1) / unit; + + if (FRAME_HAIKU_WINDOW (f)) + { + adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), + FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), + 3, false, Qfont); + + haiku_clear_under_internal_border (f); + } + return font_object; +} + +static int +haiku_valid_modifier_p (Lisp_Object sym) +{ + return EQ (sym, Qcommand) || EQ (sym, Qshift) + || EQ (sym, Qcontrol) || EQ (sym, Qoption); +} + +#define MODIFIER_OR(obj, def) (haiku_valid_modifier_p (obj) ? obj : def) + +static void +haiku_add_modifier (int modifier, int toput, Lisp_Object qtem, int *modifiers) +{ + if ((modifier & HAIKU_MODIFIER_ALT && EQ (qtem, Qcommand)) + || (modifier & HAIKU_MODIFIER_SHIFT && EQ (qtem, Qshift)) + || (modifier & HAIKU_MODIFIER_CTRL && EQ (qtem, Qcontrol)) + || (modifier & HAIKU_MODIFIER_SUPER && EQ (qtem, Qoption))) + *modifiers |= toput; +} + +static int +haiku_modifiers_to_emacs (int haiku_key) +{ + int modifiers = 0; + haiku_add_modifier (haiku_key, shift_modifier, + MODIFIER_OR (Vhaiku_shift_keysym, Qshift), &modifiers); + haiku_add_modifier (haiku_key, super_modifier, + MODIFIER_OR (Vhaiku_super_keysym, Qoption), &modifiers); + haiku_add_modifier (haiku_key, meta_modifier, + MODIFIER_OR (Vhaiku_meta_keysym, Qcommand), &modifiers); + haiku_add_modifier (haiku_key, ctrl_modifier, + MODIFIER_OR (Vhaiku_control_keysym, Qcontrol), &modifiers); + return modifiers; +} + +#undef MODIFIER_OR + +static void +haiku_rehighlight (void) +{ + eassert (x_display_list && !x_display_list->next); + + block_input (); + + struct frame *old_hl = x_display_list->highlight_frame; + + if (x_display_list->focused_frame) + { + x_display_list->highlight_frame + = ((FRAMEP (FRAME_FOCUS_FRAME (x_display_list->focused_frame))) + ? XFRAME (FRAME_FOCUS_FRAME (x_display_list->focused_frame)) + : x_display_list->focused_frame); + if (!FRAME_LIVE_P (x_display_list->highlight_frame)) + { + fset_focus_frame (x_display_list->focused_frame, Qnil); + x_display_list->highlight_frame = x_display_list->focused_frame; + } + } + else + x_display_list->highlight_frame = 0; + + if (old_hl) + gui_update_cursor (old_hl, true); + + if (x_display_list->highlight_frame) + gui_update_cursor (x_display_list->highlight_frame, true); + unblock_input (); +} + +static void +haiku_frame_raise_lower (struct frame *f, bool raise_p) +{ + if (raise_p) + { + block_input (); + BWindow_activate (FRAME_HAIKU_WINDOW (f)); + flush_frame (f); + unblock_input (); + } +} + +/* Unfortunately, NOACTIVATE is not implementable on Haiku. */ +static void +haiku_focus_frame (struct frame *frame, bool noactivate) +{ + if (x_display_list->focused_frame != frame) + haiku_frame_raise_lower (frame, 1); +} + +static void +haiku_new_focus_frame (struct frame *frame) +{ + eassert (x_display_list && !x_display_list->next); + + block_input (); + if (frame != x_display_list->focused_frame) + { + if (x_display_list->focused_frame && + x_display_list->focused_frame->auto_lower) + haiku_frame_raise_lower (x_display_list->focused_frame, 0); + + x_display_list->focused_frame = frame; + + if (frame && frame->auto_raise) + haiku_frame_raise_lower (frame, 1); + } + unblock_input (); + + haiku_rehighlight (); +} + +static void +haiku_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + haiku_set_name (f, arg, 0); +} + +static void +haiku_query_frame_background_color (struct frame *f, Emacs_Color *bgcolor) +{ + haiku_query_color (FRAME_BACKGROUND_PIXEL (f), bgcolor); +} + +static bool +haiku_defined_color (struct frame *f, + const char *name, + Emacs_Color *color, + bool alloc, + bool make_index) +{ + return !haiku_get_color (name, color); +} + +/* Adapted from xterm `x_draw_box_rect'. */ +static void +haiku_draw_box_rect (struct glyph_string *s, + int left_x, int top_y, int right_x, int bottom_y, int hwidth, + int vwidth, bool left_p, bool right_p, struct haiku_rect *clip_rect) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + struct face *face = s->face; + + BView_StartClip (view); + BView_SetHighColor (view, face->box_color); + if (clip_rect) + BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width, + clip_rect->height); + BView_FillRectangle (view, left_x, top_y, right_x - left_x + 1, hwidth); + if (left_p) + BView_FillRectangle (view, left_x, top_y, vwidth, bottom_y - top_y + 1); + + BView_FillRectangle (view, left_x, bottom_y - hwidth + 1, + right_x - left_x + 1, hwidth); + if (right_p) + BView_FillRectangle (view, right_x - vwidth + 1, + top_y, vwidth, bottom_y - top_y + 1); + BView_EndClip (view); +} + +static void +haiku_calculate_relief_colors (struct glyph_string *s, + uint32_t *rgbout_w, uint32_t *rgbout_b, + uint32_t *rgbout_c) +{ + struct face *face = s->face; + + prepare_face_for_display (s->f, s->face); + + uint32_t rgbin = face->use_box_color_for_shadows_p + ? face->box_color : face->background; + + if (s->hl == DRAW_CURSOR) + rgbin = FRAME_CURSOR_COLOR (s->f).pixel; + + double h, cs, l; + rgb_color_hsl (rgbin, &h, &cs, &l); + + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), rgbout_b); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), rgbout_w); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.8), rgbout_c); +} + +static void +haiku_draw_relief_rect (struct glyph_string *s, + int left_x, int top_y, int right_x, int bottom_y, + int hwidth, int vwidth, bool raised_p, bool top_p, bool bot_p, + bool left_p, bool right_p, + struct haiku_rect *clip_rect, bool fancy_p) +{ + uint32_t color_white; + uint32_t color_black; + uint32_t color_corner; + + haiku_calculate_relief_colors (s, &color_white, &color_black, + &color_corner); + + void *view = FRAME_HAIKU_VIEW (s->f); + BView_StartClip (view); + + BView_SetHighColor (view, raised_p ? color_white : color_black); + if (clip_rect) + BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width, + clip_rect->height); + if (top_p) + BView_FillRectangle (view, left_x, top_y, right_x - left_x + 1, hwidth); + if (left_p) + BView_FillRectangle (view, left_x, top_y, vwidth, bottom_y - top_y + 1); + BView_SetHighColor (view, !raised_p ? color_white : color_black); + + if (bot_p) + BView_FillRectangle (view, left_x, bottom_y - hwidth + 1, + right_x - left_x + 1, hwidth); + if (right_p) + BView_FillRectangle (view, right_x - vwidth + 1, top_y, + vwidth, bottom_y - top_y + 1); + + /* Draw the triangle for the bottom-left corner. */ + if (bot_p && left_p) + { + BView_SetHighColor (view, raised_p ? color_white : color_black); + BView_FillTriangle (view, left_x, bottom_y - hwidth, left_x + vwidth, + bottom_y - hwidth, left_x, bottom_y); + } + + /* Now draw the triangle for the top-right corner. */ + if (top_p && right_p) + { + BView_SetHighColor (view, raised_p ? color_white : color_black); + BView_FillTriangle (view, right_x - vwidth, top_y, + right_x, top_y, + right_x - vwidth, top_y + hwidth); + } + + /* If (h/v)width is > 1, we draw the outer-most line on each side in the + black relief color. */ + + BView_SetHighColor (view, color_black); + + if (hwidth > 1 && top_p) + BView_StrokeLine (view, left_x, top_y, right_x, top_y); + if (hwidth > 1 && bot_p) + BView_StrokeLine (view, left_x, bottom_y, right_x, bottom_y); + if (vwidth > 1 && left_p) + BView_StrokeLine (view, left_x, top_y, left_x, bottom_y); + if (vwidth > 1 && right_p) + BView_StrokeLine (view, right_x, top_y, right_x, bottom_y); + + BView_SetHighColor (view, color_corner); + + /* Omit corner pixels. */ + if (hwidth > 1 || vwidth > 1) + { + if (left_p && top_p) + BView_FillRectangle (view, left_x, top_y, 1, 1); + if (left_p && bot_p) + BView_FillRectangle (view, left_x, bottom_y, 1, 1); + if (right_p && top_p) + BView_FillRectangle (view, right_x, top_y, 1, 1); + if (right_p && bot_p) + BView_FillRectangle (view, right_x, bottom_y, 1, 1); + } + + BView_EndClip (view); +} + +static void +haiku_draw_string_box (struct glyph_string *s, int clip_p) +{ + int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x; + bool raised_p, left_p, right_p; + struct glyph *last_glyph; + struct haiku_rect clip_rect; + + struct face *face = s->face; + + last_x = ((s->row->full_width_p && !s->w->pseudo_window_p) + ? WINDOW_RIGHT_EDGE_X (s->w) + : window_box_right (s->w, s->area)); + + /* The glyph that may have a right box line. For static + compositions and images, the right-box flag is on the first glyph + of the glyph string; for other types it's on the last glyph. */ + if (s->cmp || s->img) + last_glyph = s->first_glyph; + else if (s->first_glyph->type == COMPOSITE_GLYPH + && s->first_glyph->u.cmp.automatic) + { + /* For automatic compositions, we need to look up the last glyph + in the composition. */ + struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area]; + struct glyph *g = s->first_glyph; + for (last_glyph = g++; + g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id + && g->slice.cmp.to < s->cmp_to; + last_glyph = g++) + ; + } + else + last_glyph = s->first_glyph + s->nchars - 1; + + vwidth = eabs (face->box_vertical_line_width); + hwidth = eabs (face->box_horizontal_line_width); + raised_p = face->box == FACE_RAISED_BOX; + left_x = s->x; + right_x = (s->row->full_width_p && s->extends_to_end_of_line_p + ? last_x - 1 + : min (last_x, s->x + s->background_width) - 1); + + top_y = s->y; + bottom_y = top_y + s->height - 1; + + left_p = (s->first_glyph->left_box_line_p + || (s->hl == DRAW_MOUSE_FACE + && (s->prev == NULL + || s->prev->hl != s->hl))); + right_p = (last_glyph->right_box_line_p + || (s->hl == DRAW_MOUSE_FACE + && (s->next == NULL + || s->next->hl != s->hl))); + + get_glyph_string_clip_rect (s, &clip_rect); + + if (face->box == FACE_SIMPLE_BOX) + haiku_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, left_p, right_p, &clip_rect); + else + haiku_draw_relief_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, raised_p, true, true, left_p, right_p, + &clip_rect, 1); + + if (clip_p) + { + void *view = FRAME_HAIKU_VIEW (s->f); + BView_ClipToInverseRect (view, left_x, top_y, right_x - left_x + 1, hwidth); + if (left_p) + BView_ClipToInverseRect (view, left_x, top_y, vwidth, bottom_y - top_y + 1); + BView_ClipToInverseRect (view, left_x, bottom_y - hwidth + 1, + right_x - left_x + 1, hwidth); + if (right_p) + BView_ClipToInverseRect (view, right_x - vwidth + 1, + top_y, vwidth, bottom_y - top_y + 1); + } +} + +static void +haiku_draw_plain_background (struct glyph_string *s, struct face *face, + int box_line_hwidth, int box_line_vwidth) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + BView_StartClip (view); + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + else + BView_SetHighColor (view, face->background_defaulted_p ? + FRAME_BACKGROUND_PIXEL (s->f) : + face->background); + + BView_FillRectangle (view, s->x, + s->y + box_line_hwidth, + s->background_width, + s->height - 2 * box_line_hwidth); + BView_EndClip (view); +} + +static void +haiku_draw_stipple_background (struct glyph_string *s, struct face *face, + int box_line_hwidth, int box_line_vwidth) +{ +} + +static void +haiku_maybe_draw_background (struct glyph_string *s, int force_p) +{ + if ((s->first_glyph->type != IMAGE_GLYPH) && !s->background_filled_p) + { + struct face *face = s->face; + int box_line_width = max (face->box_horizontal_line_width, 0); + int box_vline_width = max (face->box_vertical_line_width, 0); + + if (FONT_HEIGHT (s->font) < s->height - 2 * box_vline_width + || FONT_TOO_HIGH (s->font) + || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) + { + if (!face->stipple) + haiku_draw_plain_background (s, face, box_line_width, + box_vline_width); + else + haiku_draw_stipple_background (s, face, box_line_width, + box_vline_width); + s->background_filled_p = 1; + } + } +} + +static void +haiku_mouse_face_colors (struct glyph_string *s, uint32_t *fg, + uint32_t *bg) +{ + int face_id; + struct face *face; + + /* What face has to be used last for the mouse face? */ + face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; + face = FACE_FROM_ID_OR_NULL (s->f, face_id); + if (face == NULL) + face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + + if (s->first_glyph->type == CHAR_GLYPH) + face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); + else + face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); + + face = FACE_FROM_ID (s->f, face_id); + prepare_face_for_display (s->f, s->face); + + if (fg) + *fg = face->foreground; + if (bg) + *bg = face->background; +} + +static void +haiku_draw_underwave (struct glyph_string *s, int width, int x) +{ + int wave_height = 3, wave_length = 2; + int y, dx, dy, odd, xmax; + dx = wave_length; + dy = wave_height - 1; + y = s->ybase - wave_height + 3; + + float ax, ay, bx, by; + xmax = x + width; + + void *view = FRAME_HAIKU_VIEW (s->f); + + BView_StartClip (view); + BView_ClipToRect (view, x, y, width, wave_height); + ax = x - ((int) (x) % dx) + (float) 0.5; + bx = ax + dx; + odd = (int) (ax / dx) % 2; + ay = by = y + 0.5; + + if (odd) + ay += dy; + else + by += dy; + + while (ax <= xmax) + { + BView_StrokeLine (view, ax, ay, bx, by); + ax = bx, ay = by; + bx += dx, by = y + 0.5 + odd * dy; + odd = !odd; + } + BView_EndClip (view); +} + +static void +haiku_draw_text_decoration (struct glyph_string *s, struct face *face, + uint8_t dcol, int width, int x) +{ + if (s->for_overlaps) + return; + + void *view = FRAME_HAIKU_VIEW (s->f); + BView_draw_lock (view); + BView_StartClip (view); + + if (face->underline) + { + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else if (!face->underline_defaulted_p) + BView_SetHighColor (view, face->underline_color); + else + BView_SetHighColor (view, dcol); + + if (face->underline == FACE_UNDER_WAVE) + haiku_draw_underwave (s, width, x); + else if (face->underline == FACE_UNDER_LINE) + { + unsigned long thickness, position; + int y; + + if (s->prev && s->prev && s->prev->hl == DRAW_MOUSE_FACE) + { + struct face *prev_face = s->prev->face; + + if (prev_face && prev_face->underline == FACE_UNDER_LINE) + { + /* We use the same underline style as the previous one. */ + thickness = s->prev->underline_thickness; + position = s->prev->underline_position; + } + else + goto calculate_underline_metrics; + } + else + { + calculate_underline_metrics:; + struct font *font = font_for_underline_metrics (s); + unsigned long minimum_offset; + bool underline_at_descent_line; + bool use_underline_position_properties; + Lisp_Object val = (WINDOW_BUFFER_LOCAL_VALUE + (Qunderline_minimum_offset, s->w)); + + if (FIXNUMP (val)) + minimum_offset = max (0, XFIXNUM (val)); + else + minimum_offset = 1; + + val = (WINDOW_BUFFER_LOCAL_VALUE + (Qx_underline_at_descent_line, s->w)); + underline_at_descent_line + = !(NILP (val) || EQ (val, Qunbound)); + + val = (WINDOW_BUFFER_LOCAL_VALUE + (Qx_use_underline_position_properties, s->w)); + use_underline_position_properties + = !(NILP (val) || EQ (val, Qunbound)); + + /* Get the underline thickness. Default is 1 pixel. */ + if (font && font->underline_thickness > 0) + thickness = font->underline_thickness; + else + thickness = 1; + if (underline_at_descent_line) + position = (s->height - thickness) - (s->ybase - s->y); + else + { + /* Get the underline position. This is the + recommended vertical offset in pixels from + the baseline to the top of the underline. + This is a signed value according to the + specs, and its default is + + ROUND ((maximum descent) / 2), with + ROUND(x) = floor (x + 0.5) */ + + if (use_underline_position_properties + && font && font->underline_position >= 0) + position = font->underline_position; + else if (font) + position = (font->descent + 1) / 2; + else + position = minimum_offset; + } + position = max (position, minimum_offset); + } + /* Check the sanity of thickness and position. We should + avoid drawing underline out of the current line area. */ + if (s->y + s->height <= s->ybase + position) + position = (s->height - 1) - (s->ybase - s->y); + if (s->y + s->height < s->ybase + position + thickness) + thickness = (s->y + s->height) - (s->ybase + position); + s->underline_thickness = thickness; + s->underline_position = position; + y = s->ybase + position; + + BView_FillRectangle (view, s->x, y, s->width, thickness); + } + } + + if (face->overline_p) + { + unsigned long dy = 0, h = 1; + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else if (!face->overline_color_defaulted_p) + BView_SetHighColor (view, face->overline_color); + else + BView_SetHighColor (view, dcol); + + BView_FillRectangle (view, s->x, s->y + dy, s->width, h); + } + + if (face->strike_through_p) + { + /* Y-coordinate and height of the glyph string's first + glyph. We cannot use s->y and s->height because those + could be larger if there are taller display elements + (e.g., characters displayed with a larger font) in the + same glyph row. */ + int glyph_y = s->ybase - s->first_glyph->ascent; + int glyph_height = s->first_glyph->ascent + s->first_glyph->descent; + /* Strike-through width and offset from the glyph string's + top edge. */ + unsigned long h = 1; + unsigned long dy = (glyph_height - h) / 2; + + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else if (!face->strike_through_color_defaulted_p) + BView_SetHighColor (view, face->strike_through_color); + else + BView_SetHighColor (view, dcol); + + BView_FillRectangle (view, s->x, glyph_y + dy, s->width, h); + } + + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_draw_glyph_string_foreground (struct glyph_string *s) +{ + struct face *face = s->face; + + int i, x; + if (face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (face->box_vertical_line_width, 0); + else + x = s->x; + + void *view = FRAME_HAIKU_VIEW (s->f); + + if (s->font_not_found_p) + { + BView_StartClip (view); + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else + BView_SetHighColor (view, face->foreground); + for (i = 0; i < s->nchars; ++i) + { + struct glyph *g = s->first_glyph + i; + BView_StrokeRectangle (view, x, s->y, g->pixel_width, + s->height); + x += g->pixel_width; + } + BView_EndClip (view); + } + else + { + struct font *ft = s->font; + int off = ft->baseline_offset; + int y; + + if (ft->vertical_centering) + off = VCENTER_BASELINE_OFFSET (ft, s->f) - off; + y = s->ybase - off; + if (s->for_overlaps || (s->background_filled_p && s->hl != DRAW_CURSOR)) + ft->driver->draw (s, 0, s->nchars, x, y, false); + else + ft->driver->draw (s, 0, s->nchars, x, y, true); + + if (face->overstrike) + ft->driver->draw (s, 0, s->nchars, x + 1, y, false); + } +} + +static void +haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +{ + struct glyph *glyph = s->first_glyph; + unsigned char2b[8]; + int x, i, j; + struct face *face = s->face; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (face && face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (face->box_vertical_line_width, 0); + else + x = s->x; + + s->char2b = char2b; + + for (i = 0; i < s->nchars; i++, glyph++) + { +#ifdef GCC_LINT + enum { PACIFY_GCC_BUG_81401 = 1 }; +#else + enum { PACIFY_GCC_BUG_81401 = 0 }; +#endif + char buf[7 + PACIFY_GCC_BUG_81401]; + char *str = NULL; + int len = glyph->u.glyphless.len; + + if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (len > 0 + && CHAR_TABLE_P (Vglyphless_char_display) + && (CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) + >= 1)) + { + Lisp_Object acronym + = (! glyph->u.glyphless.for_no_font + ? CHAR_TABLE_REF (Vglyphless_char_display, + glyph->u.glyphless.ch) + : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (STRINGP (acronym)) + str = SSDATA (acronym); + } + } + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) + { + unsigned int ch = glyph->u.glyphless.ch; + eassume (ch <= MAX_CHAR); + sprintf (buf, "%0*X", ch < 0x10000 ? 4 : 6, ch); + str = buf; + } + + if (str) + { + int upper_len = (len + 1) / 2; + + /* It is assured that all LEN characters in STR is ASCII. */ + for (j = 0; j < len; j++) + char2b[j] = s->font->driver->encode_char (s->font, str[j]) & 0xFFFF; + + s->font->driver->draw (s, 0, upper_len, + x + glyph->slice.glyphless.upper_xoff, + s->ybase + glyph->slice.glyphless.upper_yoff, + false); + s->font->driver->draw (s, upper_len, len, + x + glyph->slice.glyphless.lower_xoff, + s->ybase + glyph->slice.glyphless.lower_yoff, + false); + } + BView_StartClip (FRAME_HAIKU_VIEW (s->f)); + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) + BView_FillRectangle (FRAME_HAIKU_VIEW (s->f), + x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1); + BView_EndClip (FRAME_HAIKU_VIEW (s->f)); + x += glyph->pixel_width; + } +} + +static void +haiku_draw_stretch_glyph_string (struct glyph_string *s) +{ + eassert (s->first_glyph->type == STRETCH_GLYPH); + + struct face *face = s->face; + + if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p) + { + int width, background_width = s->background_width; + int x = s->x; + + if (!s->row->reversed_p) + { + int left_x = window_box_left_offset (s->w, TEXT_AREA); + + if (x < left_x) + { + background_width -= left_x - x; + x = left_x; + } + } + else + { + /* In R2L rows, draw the cursor on the right edge of the + stretch glyph. */ + int right_x = window_box_right (s->w, TEXT_AREA); + if (x + background_width > right_x) + background_width -= x - right_x; + x += background_width; + } + + width = min (FRAME_COLUMN_WIDTH (s->f), background_width); + if (s->row->reversed_p) + x -= width; + + void *view = FRAME_HAIKU_VIEW (s->f); + BView_StartClip (view); + BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + BView_FillRectangle (view, x, s->y, width, s->height); + BView_EndClip (view); + + if (width < background_width) + { + if (!s->row->reversed_p) + x += width; + else + x = s->x; + + int y = s->y; + int w = background_width - width, h = s->height; + + if (!face->stipple) + { + uint32_t bkg; + if (s->hl == DRAW_MOUSE_FACE || (s->hl == DRAW_CURSOR + && s->row->mouse_face_p + && cursor_in_mouse_face_p (s->w))) + haiku_mouse_face_colors (s, NULL, &bkg); + else + bkg = face->background; + + BView_StartClip (view); + BView_SetHighColor (view, bkg); + BView_FillRectangle (view, x, y, w, h); + BView_EndClip (view); + } + } + } + else if (!s->background_filled_p) + { + int background_width = s->background_width; + int x = s->x, text_left_x = window_box_left (s->w, TEXT_AREA); + + /* Don't draw into left fringe or scrollbar area except for + header line and mode line. */ + if (s->area == TEXT_AREA + && x < text_left_x && !s->row->mode_line_p) + { + background_width -= text_left_x - x; + x = text_left_x; + } + + if (background_width > 0) + { + void *view = FRAME_HAIKU_VIEW (s->f); + BView_StartClip (view); + uint32_t bkg; + if (s->hl == DRAW_MOUSE_FACE) + haiku_mouse_face_colors (s, NULL, &bkg); + else if (s->hl == DRAW_CURSOR) + bkg = FRAME_CURSOR_COLOR (s->f).pixel; + else + bkg = s->face->background; + + BView_SetHighColor (view, bkg); + BView_FillRectangle (view, x, s->y, background_width, s->height); + BView_EndClip (view); + } + } + s->background_filled_p = 1; +} + +static void +haiku_start_clip (struct glyph_string *s) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + BView_draw_lock (view); + BView_StartClip (view); +} + +static void +haiku_end_clip (struct glyph_string *s) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_clip_to_row (struct window *w, struct glyph_row *row, + enum glyph_row_area area) +{ + struct frame *f = WINDOW_XFRAME (w); + int window_x, window_y, window_width; + int x, y, width, height; + + window_box (w, area, &window_x, &window_y, &window_width, 0); + + x = window_x; + y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, row->y)); + y = max (y, window_y); + width = window_width; + height = row->visible_height; + + BView_ClipToRect (FRAME_HAIKU_VIEW (f), x, y, width, height); +} + +static void +haiku_update_begin (struct frame *f) +{ +} + +static void +haiku_update_end (struct frame *f) +{ + MOUSE_HL_INFO (f)->mouse_face_defer = false; + flush_frame (f); +} + +static void +haiku_draw_composite_glyph_string_foreground (struct glyph_string *s) +{ + int i, j, x; + struct font *font = s->font; + void *view = FRAME_HAIKU_VIEW (s->f); + struct face *face = s->face; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (face && face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (face->box_vertical_line_width, 0); + else + x = s->x; + + /* S is a glyph string for a composition. S->cmp_from is the index + of the first character drawn for glyphs of this composition. + S->cmp_from == 0 means we are drawing the very first character of + this composition. */ + + /* Draw a rectangle for the composition if the font for the very + first character of the composition could not be loaded. */ + + if (s->font_not_found_p && !s->cmp_from) + { + BView_StartClip (view); + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else + BView_SetHighColor (view, s->face->foreground); + BView_StrokeRectangle (view, s->x, s->y, s->width - 1, s->height - 1); + BView_EndClip (view); + } + else if (!s->first_glyph->u.cmp.automatic) + { + int y = s->ybase; + + for (i = 0, j = s->cmp_from; i < s->nchars; i++, j++) + /* TAB in a composition means display glyphs with padding + space on the left or right. */ + if (COMPOSITION_GLYPH (s->cmp, j) != '\t') + { + int xx = x + s->cmp->offsets[j * 2]; + int yy = y - s->cmp->offsets[j * 2 + 1]; + + font->driver->draw (s, j, j + 1, xx, yy, false); + if (face->overstrike) + font->driver->draw (s, j, j + 1, xx + 1, yy, false); + } + } + else + { + Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); + Lisp_Object glyph; + int y = s->ybase; + int width = 0; + + for (i = j = s->cmp_from; i < s->cmp_to; i++) + { + glyph = LGSTRING_GLYPH (gstring, i); + if (NILP (LGLYPH_ADJUSTMENT (glyph))) + width += LGLYPH_WIDTH (glyph); + else + { + int xoff, yoff, wadjust; + + if (j < i) + { + font->driver->draw (s, j, i, x, y, false); + if (s->face->overstrike) + font->driver->draw (s, j, i, x + 1, y, false); + x += width; + } + xoff = LGLYPH_XOFF (glyph); + yoff = LGLYPH_YOFF (glyph); + wadjust = LGLYPH_WADJUST (glyph); + font->driver->draw (s, i, i + 1, x + xoff, y + yoff, false); + if (face->overstrike) + font->driver->draw (s, i, i + 1, x + xoff + 1, y + yoff, + false); + x += wadjust; + j = i + 1; + width = 0; + } + } + if (j < i) + { + font->driver->draw (s, j, i, x, y, false); + if (face->overstrike) + font->driver->draw (s, j, i, x + 1, y, false); + } + } +} + +static void +haiku_draw_image_relief (struct glyph_string *s) +{ + int x1, y1, thick; + bool raised_p, top_p, bot_p, left_p, right_p; + int extra_x, extra_y; + struct haiku_rect r; + int x = s->x; + int y = s->ybase - image_ascent (s->img, s->face, &s->slice); + + struct face *face = s->face; + + /* If first glyph of S has a left box line, start drawing it to the + right of that line. */ + if (face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p + && s->slice.x == 0) + x += max (face->box_vertical_line_width, 0); + + /* If there is a margin around the image, adjust x- and y-position + by that margin. */ + if (s->slice.x == 0) + x += s->img->hmargin; + if (s->slice.y == 0) + y += s->img->vmargin; + + if (s->hl == DRAW_IMAGE_SUNKEN + || s->hl == DRAW_IMAGE_RAISED) + { + if (s->face->id == TAB_BAR_FACE_ID) + thick = (tab_bar_button_relief < 0 + ? DEFAULT_TAB_BAR_BUTTON_RELIEF + : min (tab_bar_button_relief, 1000000)); + else + thick = (tool_bar_button_relief < 0 + ? DEFAULT_TOOL_BAR_BUTTON_RELIEF + : min (tool_bar_button_relief, 1000000)); + raised_p = s->hl == DRAW_IMAGE_RAISED; + } + else + { + thick = eabs (s->img->relief); + raised_p = s->img->relief > 0; + } + + x1 = x + s->slice.width - 1; + y1 = y + s->slice.height - 1; + + extra_x = extra_y = 0; + + if (s->face->id == TAB_BAR_FACE_ID) + { + if (CONSP (Vtab_bar_button_margin) + && FIXNUMP (XCAR (Vtab_bar_button_margin)) + && FIXNUMP (XCDR (Vtab_bar_button_margin))) + { + extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)) - thick; + extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)) - thick; + } + else if (FIXNUMP (Vtab_bar_button_margin)) + extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin) - thick; + } + + if (s->face->id == TOOL_BAR_FACE_ID) + { + if (CONSP (Vtool_bar_button_margin) + && FIXNUMP (XCAR (Vtool_bar_button_margin)) + && FIXNUMP (XCDR (Vtool_bar_button_margin))) + { + extra_x = XFIXNUM (XCAR (Vtool_bar_button_margin)); + extra_y = XFIXNUM (XCDR (Vtool_bar_button_margin)); + } + else if (FIXNUMP (Vtool_bar_button_margin)) + extra_x = extra_y = XFIXNUM (Vtool_bar_button_margin); + } + + top_p = bot_p = left_p = right_p = 0; + + if (s->slice.x == 0) + x -= thick + extra_x, left_p = 1; + if (s->slice.y == 0) + y -= thick + extra_y, top_p = 1; + if (s->slice.x + s->slice.width == s->img->width) + x1 += thick + extra_x, right_p = 1; + if (s->slice.y + s->slice.height == s->img->height) + y1 += thick + extra_y, bot_p = 1; + + get_glyph_string_clip_rect (s, &r); + haiku_draw_relief_rect (s, x, y, x1, y1, thick, thick, raised_p, + top_p, bot_p, left_p, right_p, &r, 0); +} + +static void +haiku_draw_image_glyph_string (struct glyph_string *s) +{ + struct face *face = s->face; + + int box_line_hwidth = max (face->box_vertical_line_width, 0); + int box_line_vwidth = max (face->box_horizontal_line_width, 0); + + int x, y; + int height, width; + + height = s->height; + if (s->slice.y == 0) + height -= box_line_vwidth; + if (s->slice.y + s->slice.height >= s->img->height) + height -= box_line_vwidth; + + width = s->background_width; + x = s->x; + if (s->first_glyph->left_box_line_p + && s->slice.x == 0) + { + x += box_line_hwidth; + width -= box_line_hwidth; + } + + y = s->y; + if (s->slice.y == 0) + y += box_line_vwidth; + + void *view = FRAME_HAIKU_VIEW (s->f); + void *bitmap = s->img->pixmap; + + s->stippled_p = face->stipple != 0; + + BView_draw_lock (view); + BView_StartClip (view); + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, x, y, width, height); + BView_EndClip (view); + BView_draw_unlock (view); + + if (bitmap) + { + struct haiku_rect nr; + Emacs_Rectangle cr, ir, r; + + get_glyph_string_clip_rect (s, &nr); + CONVERT_TO_EMACS_RECT (cr, nr); + x = s->x; + y = s->ybase - image_ascent (s->img, face, &s->slice); + + if (s->slice.x == 0) + x += s->img->hmargin; + if (s->slice.y == 0) + y += s->img->vmargin; + + if (face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p + && s->slice.x == 0) + x += max (face->box_vertical_line_width, 0); + + ir.x = x; + ir.y = y; + ir.width = s->slice.width; + ir.height = s->slice.height; + r = ir; + + void *mask = s->img->mask; + + if (gui_intersect_rectangles (&cr, &ir, &r)) + { + BView_draw_lock (view); + BView_StartClip (view); + + haiku_clip_to_string (s); + if (s->img->have_be_transforms_p) + { + bitmap = BBitmap_transform_bitmap (bitmap, + s->img->mask, + face->background, + s->img->be_rotate, + s->img->width, + s->img->height); + mask = NULL; + } + + BView_DrawBitmap (view, bitmap, + s->slice.x + r.x - x, + s->slice.y + r.y - y, + r.width, r.height, + r.x, r.y, r.width, r.height); + if (mask) + { + BView_DrawMask (mask, view, + s->slice.x + r.x - x, + s->slice.y + r.y - y, + r.width, r.height, + r.x, r.y, r.width, r.height, + face->background); + } + + if (s->img->have_be_transforms_p) + BBitmap_free (bitmap); + BView_EndClip (view); + BView_draw_unlock (view); + } + + if (s->hl == DRAW_CURSOR) + { + BView_draw_lock (view); + BView_StartClip (view); + BView_SetPenSize (view, 1); + BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + BView_StrokeRectangle (view, r.x, r.y, r.width, r.height); + BView_EndClip (view); + BView_draw_unlock (view); + } + } + + if (s->img->relief + || s->hl == DRAW_IMAGE_RAISED + || s->hl == DRAW_IMAGE_SUNKEN) + haiku_draw_image_relief (s); +} + +static void +haiku_draw_glyph_string (struct glyph_string *s) +{ + block_input (); + prepare_face_for_display (s->f, s->face); + + struct face *face = s->face; + if (face != s->face) + prepare_face_for_display (s->f, face); + + if (s->next && s->right_overhang && !s->for_overlaps) + { + int width; + struct glyph_string *next; + + for (width = 0, next = s->next; + next && width < s->right_overhang; + width += next->width, next = next->next) + if (next->first_glyph->type != IMAGE_GLYPH) + { + prepare_face_for_display (s->f, s->next->face); + haiku_start_clip (s->next); + haiku_clip_to_string (s->next); + if (next->first_glyph->type != STRETCH_GLYPH) + haiku_maybe_draw_background (s->next, 1); + else + haiku_draw_stretch_glyph_string (s->next); + next->num_clips = 0; + haiku_end_clip (s); + } + } + + haiku_start_clip (s); + + int box_filled_p = 0; + + if (!s->for_overlaps && face->box != FACE_NO_BOX + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) + { + haiku_clip_to_string (s); + haiku_maybe_draw_background (s, 1); + box_filled_p = 1; + haiku_draw_string_box (s, 0); + } + else if (!s->clip_head && !s->clip_tail && + ((s->prev && s->left_overhang && s->prev->hl != s->hl) || + (s->next && s->right_overhang && s->next->hl != s->hl))) + haiku_clip_to_string_exactly (s, s); + else + haiku_clip_to_string (s); + + if (s->for_overlaps) + s->background_filled_p = 1; + + switch (s->first_glyph->type) + { + case COMPOSITE_GLYPH: + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + haiku_maybe_draw_background (s, 1); + haiku_draw_composite_glyph_string_foreground (s); + break; + case CHAR_GLYPH: + if (s->for_overlaps) + s->background_filled_p = 1; + else + haiku_maybe_draw_background (s, 0); + haiku_draw_glyph_string_foreground (s); + break; + case STRETCH_GLYPH: + haiku_draw_stretch_glyph_string (s); + break; + case IMAGE_GLYPH: + haiku_draw_image_glyph_string (s); + break; + case GLYPHLESS_GLYPH: + if (s->for_overlaps) + s->background_filled_p = 1; + else + haiku_maybe_draw_background (s, 1); + haiku_draw_glyphless_glyph_string_foreground (s); + break; + } + + if (!box_filled_p && face->box != FACE_NO_BOX) + haiku_draw_string_box (s, 1); + + if (!s->for_overlaps) + { + uint32_t dcol; + dcol = face->foreground; + + haiku_draw_text_decoration (s, face, dcol, s->width, s->x); + + if (s->prev) + { + struct glyph_string *prev; + + for (prev = s->prev; prev; prev = prev->prev) + if (prev->hl != s->hl + && prev->x + prev->width + prev->right_overhang > s->x) + { + /* As prev was drawn while clipped to its own area, we + must draw the right_overhang part using s->hl now. */ + enum draw_glyphs_face save = prev->hl; + struct face *save_face = prev->face; + + prev->hl = s->hl; + prev->face = s->face; + haiku_start_clip (s); + haiku_clip_to_string_exactly (s, prev); + if (prev->first_glyph->type == CHAR_GLYPH) + haiku_draw_glyph_string_foreground (prev); + else + haiku_draw_composite_glyph_string_foreground (prev); + haiku_end_clip (s); + prev->hl = save; + prev->face = save_face; + prev->num_clips = 0; + } + } + + if (s->next) + { + struct glyph_string *next; + + for (next = s->next; next; next = next->next) + if (next->hl != s->hl + && next->x - next->left_overhang < s->x + s->width) + { + /* As next will be drawn while clipped to its own area, + we must draw the left_overhang part using s->hl now. */ + enum draw_glyphs_face save = next->hl; + struct face *save_face = next->face; + + next->hl = s->hl; + next->face = s->face; + haiku_start_clip (s); + haiku_clip_to_string_exactly (s, next); + if (next->first_glyph->type == CHAR_GLYPH) + haiku_draw_glyph_string_foreground (next); + else + haiku_draw_composite_glyph_string_foreground (next); + haiku_end_clip (s); + + next->background_filled_p = 0; + next->hl = save; + next->face = save_face; + next->clip_head = next; + next->num_clips = 0; + } + } + } + s->num_clips = 0; + haiku_end_clip (s); + unblock_input (); +} + +static void +haiku_after_update_window_line (struct window *w, + struct glyph_row *desired_row) +{ + eassert (w); + struct frame *f; + int width, height; + + if (!desired_row->mode_line_p && !w->pseudo_window_p) + desired_row->redraw_fringe_bitmaps_p = true; + + if (windows_or_buffers_changed + && desired_row->full_width_p + && (f = XFRAME (w->frame), + width = FRAME_INTERNAL_BORDER_WIDTH (f), + width != 0) + && (height = desired_row->visible_height, + height > 0)) + { + int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); + int face_id = + !NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) + : INTERNAL_BORDER_FACE_ID; + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + + block_input (); + if (face) + { + void *view = FRAME_HAIKU_VIEW (f); + BView_draw_lock (view); + BView_StartClip (view); + BView_SetHighColor (view, face->background_defaulted_p ? + FRAME_BACKGROUND_PIXEL (f) : face->background); + BView_FillRectangle (view, 0, y, width, height); + BView_FillRectangle (view, FRAME_PIXEL_WIDTH (f) - width, + y, width, height); + BView_EndClip (view); + BView_draw_unlock (view); + } + else + { + haiku_clear_frame_area (f, 0, y, width, height); + haiku_clear_frame_area (f, FRAME_PIXEL_WIDTH (f) - width, + y, width, height); + } + unblock_input (); + } +} + +static void +haiku_set_window_size (struct frame *f, bool change_gravity, + int width, int height) +{ + haiku_update_size_hints (f); + + if (FRAME_HAIKU_WINDOW (f)) + { + block_input (); + BWindow_resize (FRAME_HAIKU_WINDOW (f), width, height); + unblock_input (); + } +} + +static void +haiku_draw_window_cursor (struct window *w, + struct glyph_row *glyph_row, + int x, int y, + enum text_cursor_kinds cursor_type, + int cursor_width, bool on_p, bool active_p) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + + struct glyph *phys_cursor_glyph; + struct glyph *cursor_glyph; + + void *view = FRAME_HAIKU_VIEW (f); + + int fx, fy, h, cursor_height; + + if (!on_p) + return; + + if (cursor_type == NO_CURSOR) + { + w->phys_cursor_width = 0; + return; + } + + w->phys_cursor_on_p = true; + w->phys_cursor_type = cursor_type; + + phys_cursor_glyph = get_phys_cursor_glyph (w); + + if (!phys_cursor_glyph) + { + if (glyph_row->exact_window_width_line_p + && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]) + { + glyph_row->cursor_in_fringe_p = 1; + draw_fringe_bitmap (w, glyph_row, 0); + } + return; + } + + get_phys_cursor_geometry (w, glyph_row, phys_cursor_glyph, &fx, &fy, &h); + + if (cursor_type == BAR_CURSOR) + { + if (cursor_width < 1) + cursor_width = max (FRAME_CURSOR_WIDTH (f), 1); + if (cursor_width < w->phys_cursor_width) + w->phys_cursor_width = cursor_width; + } + else if (cursor_type == HBAR_CURSOR) + { + cursor_height = (cursor_width < 1) ? lrint (0.25 * h) : cursor_width; + if (cursor_height > glyph_row->height) + cursor_height = glyph_row->height; + if (h > cursor_height) + fy += h - cursor_height; + h = cursor_height; + } + + BView_draw_lock (view); + BView_StartClip (view); + BView_SetHighColor (view, FRAME_CURSOR_COLOR (f).pixel); + haiku_clip_to_row (w, glyph_row, TEXT_AREA); + + switch (cursor_type) + { + default: + case DEFAULT_CURSOR: + case NO_CURSOR: + break; + case HBAR_CURSOR: + BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + break; + case BAR_CURSOR: + cursor_glyph = get_phys_cursor_glyph (w); + if (cursor_glyph->resolved_level & 1) + BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, + fy, w->phys_cursor_width, h); + else + BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + break; + case HOLLOW_BOX_CURSOR: + if (phys_cursor_glyph->type != IMAGE_GLYPH) + { + BView_SetPenSize (view, 1); + BView_StrokeRectangle (view, fx, fy, w->phys_cursor_width, h); + } + else + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + break; + case FILLED_BOX_CURSOR: + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + } + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_show_hourglass (struct frame *f) +{ + if (FRAME_OUTPUT_DATA (f)->hourglass_p) + return; + + block_input (); + FRAME_OUTPUT_DATA (f)->hourglass_p = 1; + + if (FRAME_HAIKU_VIEW (f)) + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->hourglass_cursor); + unblock_input (); +} + +static void +haiku_hide_hourglass (struct frame *f) +{ + if (!FRAME_OUTPUT_DATA (f)->hourglass_p) + return; + + block_input (); + FRAME_OUTPUT_DATA (f)->hourglass_p = 0; + + if (FRAME_HAIKU_VIEW (f)) + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->current_cursor); + unblock_input (); +} + +static void +haiku_compute_glyph_string_overhangs (struct glyph_string *s) +{ + if (s->cmp == NULL + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) + { + struct font_metrics metrics; + + if (s->first_glyph->type == CHAR_GLYPH) + { + struct font *font = s->font; + font->driver->text_extents (font, s->char2b, s->nchars, &metrics); + } + else + { + Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); + + composition_gstring_width (gstring, s->cmp_from, s->cmp_to, &metrics); + } + s->right_overhang = (metrics.rbearing > metrics.width + ? metrics.rbearing - metrics.width : 0); + s->left_overhang = metrics.lbearing < 0 ? - metrics.lbearing : 0; + } + else if (s->cmp) + { + s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width; + s->left_overhang = - s->cmp->lbearing; + } +} + +static void +haiku_draw_vertical_window_border (struct window *w, + int x, int y_0, int y_1) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face; + + face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); + void *view = FRAME_HAIKU_VIEW (f); + BView_draw_lock (view); + BView_StartClip (view); + if (face) + BView_SetHighColor (view, face->foreground); + BView_StrokeLine (view, x, y_0, x, y_1); + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_set_scroll_bar_default_width (struct frame *f) +{ + int unit = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = BScrollBar_default_size (0) + 1; + FRAME_CONFIG_SCROLL_BAR_COLS (f) = + (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit; +} + +static void +haiku_set_scroll_bar_default_height (struct frame *f) +{ + int height = FRAME_LINE_HEIGHT (f); + FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = BScrollBar_default_size (1) + 1; + FRAME_CONFIG_SCROLL_BAR_LINES (f) = + (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + height - 1) / height; +} + +static void +haiku_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID); + struct face *face_first + = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID); + struct face *face_last + = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID); + unsigned long color = face ? face->foreground : FRAME_FOREGROUND_PIXEL (f); + unsigned long color_first = (face_first + ? face_first->foreground + : FRAME_FOREGROUND_PIXEL (f)); + unsigned long color_last = (face_last + ? face_last->foreground + : FRAME_FOREGROUND_PIXEL (f)); + void *view = FRAME_HAIKU_VIEW (f); + + BView_draw_lock (view); + BView_StartClip (view); + + if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) + /* A vertical divider, at least three pixels wide: Draw first and + last pixels differently. */ + { + BView_SetHighColor (view, color_first); + BView_StrokeLine (view, x0, y0, x0, y1 - 1); + BView_SetHighColor (view, color); + BView_FillRectangle (view, x0 + 1, y0, x1 - x0 - 2, y1 - y0); + BView_SetHighColor (view, color_last); + BView_StrokeLine (view, x1 - 1, y0, x1 - 1, y1 - 1); + } + else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) + /* A horizontal divider, at least three pixels high: Draw first and + last pixels differently. */ + { + BView_SetHighColor (view, color_first); + BView_StrokeLine (f, x0, y0, x1 - 1, y0); + BView_SetHighColor (view, color); + BView_FillRectangle (view, x0, y0 + 1, x1 - x0, y1 - y0 - 2); + BView_SetHighColor (view, color_last); + BView_StrokeLine (view, x0, y1, x1 - 1, y1); + } + else + { + BView_SetHighColor (view, color); + BView_FillRectangleAbs (view, x0, y0, x1, y1); + } + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_condemn_scroll_bars (struct frame *frame) +{ + if (!NILP (FRAME_SCROLL_BARS (frame))) + { + if (!NILP (FRAME_CONDEMNED_SCROLL_BARS (frame))) + { + /* Prepend scrollbars to already condemned ones. */ + Lisp_Object last = FRAME_SCROLL_BARS (frame); + + while (!NILP (XSCROLL_BAR (last)->next)) + last = XSCROLL_BAR (last)->next; + + XSCROLL_BAR (last)->next = FRAME_CONDEMNED_SCROLL_BARS (frame); + XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = last; + } + + fset_condemned_scroll_bars (frame, FRAME_SCROLL_BARS (frame)); + fset_scroll_bars (frame, Qnil); + } +} + +static void +haiku_redeem_scroll_bar (struct window *w) +{ + struct scroll_bar *bar; + Lisp_Object barobj; + struct frame *f; + + if (!NILP (w->vertical_scroll_bar) && WINDOW_HAS_VERTICAL_SCROLL_BAR (w)) + { + bar = XSCROLL_BAR (w->vertical_scroll_bar); + /* Unlink it from the condemned list. */ + f = XFRAME (WINDOW_FRAME (w)); + if (NILP (bar->prev)) + { + /* If the prev pointer is nil, it must be the first in one of + the lists. */ + if (EQ (FRAME_SCROLL_BARS (f), w->vertical_scroll_bar)) + /* It's not condemned. Everything's fine. */ + goto horizontal; + else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), + w->vertical_scroll_bar)) + fset_condemned_scroll_bars (f, bar->next); + else + /* If its prev pointer is nil, it must be at the front of + one or the other! */ + emacs_abort (); + } + else + XSCROLL_BAR (bar->prev)->next = bar->next; + + if (! NILP (bar->next)) + XSCROLL_BAR (bar->next)->prev = bar->prev; + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + if (! NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + } + horizontal: + if (!NILP (w->horizontal_scroll_bar) && WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w)) + { + bar = XSCROLL_BAR (w->horizontal_scroll_bar); + /* Unlink it from the condemned list. */ + f = XFRAME (WINDOW_FRAME (w)); + if (NILP (bar->prev)) + { + /* If the prev pointer is nil, it must be the first in one of + the lists. */ + if (EQ (FRAME_SCROLL_BARS (f), w->horizontal_scroll_bar)) + /* It's not condemned. Everything's fine. */ + return; + else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), + w->horizontal_scroll_bar)) + fset_condemned_scroll_bars (f, bar->next); + else + /* If its prev pointer is nil, it must be at the front of + one or the other! */ + emacs_abort (); + } + else + XSCROLL_BAR (bar->prev)->next = bar->next; + + if (! NILP (bar->next)) + XSCROLL_BAR (bar->next)->prev = bar->prev; + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + if (! NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + } +} + +static void +haiku_judge_scroll_bars (struct frame *f) +{ + Lisp_Object bar, next; + + bar = FRAME_CONDEMNED_SCROLL_BARS (f); + + /* Clear out the condemned list now so we won't try to process any + more events on the hapless scroll bars. */ + fset_condemned_scroll_bars (f, Qnil); + + for (; ! NILP (bar); bar = next) + { + struct scroll_bar *b = XSCROLL_BAR (bar); + + haiku_scroll_bar_remove (b); + + next = b->next; + b->next = b->prev = Qnil; + } + + /* Now there should be no references to the condemned scroll bars, + and they should get garbage-collected. */ +} + +static struct scroll_bar * +haiku_scroll_bar_create (struct window *w, int left, int top, + int width, int height, bool horizontal_p) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + Lisp_Object barobj; + + void *sb = NULL; + void *vw = FRAME_HAIKU_VIEW (f); + + block_input (); + struct scroll_bar *bar + = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER); + + XSETWINDOW (bar->window, w); + bar->top = top; + bar->left = left; + bar->width = width; + bar->height = height; + bar->position = 0; + bar->total = 0; + bar->dragging = 0; + bar->update = -1; + bar->horizontal = horizontal_p; + + sb = BScrollBar_make_for_view (vw, horizontal_p, + left, top, left + width - 1, + top + height - 1, bar); + + BView_publish_scroll_bar (vw, left, top, width, height); + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + bar->scroll_bar = sb; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + + if (!NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + + unblock_input (); + return bar; +} + +static void +haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int position) +{ + eassert (WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w)); + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_x, window_width; + + /* Get window dimensions. */ + window_box (w, ANY_AREA, &window_x, 0, &window_width, 0); + left = window_x; + width = window_width; + top = WINDOW_SCROLL_BAR_AREA_Y (w); + height = WINDOW_CONFIG_SCROLL_BAR_HEIGHT (w); + + block_input (); + + if (NILP (w->horizontal_scroll_bar)) + { + bar = haiku_scroll_bar_create (w, left, top, width, height, true); + BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); + bar->update = position; + bar->position = position; + bar->total = whole; + } + else + { + bar = XSCROLL_BAR (w->horizontal_scroll_bar); + + if (bar->left != left || bar->top != top || + bar->width != width || bar->height != height) + { + void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); + BView_forget_scroll_bar (view, bar->left, bar->top, + bar->width, bar->height); + BView_move_frame (bar->scroll_bar, left, top, + left + width - 1, top + height - 1); + BView_publish_scroll_bar (view, left, top, width, height); + bar->left = left; + bar->top = top; + bar->width = width; + bar->height = height; + } + + if (!bar->dragging) + { + BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); + BView_invalidate (bar->scroll_bar); + } + } + bar->position = position; + bar->total = whole; + XSETVECTOR (barobj, bar); + wset_horizontal_scroll_bar (w, barobj); + unblock_input (); +} + +static void +haiku_set_vertical_scroll_bar (struct window *w, + int portion, int whole, int position) +{ + eassert (WINDOW_HAS_VERTICAL_SCROLL_BAR (w)); + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_y, window_height; + + /* Get window dimensions. */ + window_box (w, ANY_AREA, 0, &window_y, 0, &window_height); + top = window_y; + height = window_height; + + /* Compute the left edge and the width of the scroll bar area. */ + left = WINDOW_SCROLL_BAR_AREA_X (w); + width = WINDOW_SCROLL_BAR_AREA_WIDTH (w); + block_input (); + + if (NILP (w->vertical_scroll_bar)) + { + bar = haiku_scroll_bar_create (w, left, top, width, height, false); + BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); + bar->position = position; + bar->total = whole; + } + else + { + bar = XSCROLL_BAR (w->vertical_scroll_bar); + + if (bar->left != left || bar->top != top || + bar->width != width || bar->height != height) + { + void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); + BView_forget_scroll_bar (view, bar->left, bar->top, + bar->width, bar->height); + BView_move_frame (bar->scroll_bar, left, top, + left + width - 1, top + height - 1); + flush_frame (WINDOW_XFRAME (w)); + BView_publish_scroll_bar (view, left, top, width, height); + bar->left = left; + bar->top = top; + bar->width = width; + bar->height = height; + } + + if (!bar->dragging) + { + BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); + bar->update = position; + BView_invalidate (bar->scroll_bar); + } + } + + bar->position = position; + bar->total = whole; + + XSETVECTOR (barobj, bar); + wset_vertical_scroll_bar (w, barobj); + unblock_input (); +} + +static void +haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, + struct draw_fringe_bitmap_params *p) +{ + void *view = FRAME_HAIKU_VIEW (XFRAME (WINDOW_FRAME (w))); + struct face *face = p->face; + + BView_draw_lock (view); + BView_StartClip (view); + + haiku_clip_to_row (w, row, ANY_AREA); + if (p->bx >= 0 && !p->overlay_p) + { + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, p->bx, p->by, p->nx, p->ny); + } + + if (p->which && p->which < fringe_bitmap_fillptr) + { + void *bitmap = fringe_bmps[p->which]; + + uint32_t col; + + if (!p->cursor_p) + col = face->foreground; + else if (p->overlay_p) + col = face->background; + else + col = FRAME_CURSOR_COLOR (XFRAME (WINDOW_FRAME (w))).pixel; + + if (!p->overlay_p) + { + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, p->x, p->y, p->wd, p->h); + } + + BView_SetLowColor (view, col); + BView_DrawBitmapWithEraseOp (view, bitmap, p->x, p->y, p->wd, p->h); + } + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_define_fringe_bitmap (int which, unsigned short *bits, + int h, int wd) +{ + if (which >= fringe_bitmap_fillptr) + { + int i = fringe_bitmap_fillptr; + fringe_bitmap_fillptr = which + 20; + fringe_bmps = !i ? xmalloc (fringe_bitmap_fillptr * sizeof (void *)) : + xrealloc (fringe_bmps, fringe_bitmap_fillptr * sizeof (void *)); + + while (i < fringe_bitmap_fillptr) + fringe_bmps[i++] = NULL; + } + + fringe_bmps[which] = BBitmap_new (wd, h, 1); + BBitmap_import_mono_bits (fringe_bmps[which], bits, wd, h); +} + +static void +haiku_destroy_fringe_bitmap (int which) +{ + if (which >= fringe_bitmap_fillptr) + return; + + if (fringe_bmps[which]) + BBitmap_free (fringe_bmps[which]); + fringe_bmps[which] = NULL; +} + +static void +haiku_scroll_run (struct window *w, struct run *run) +{ + struct frame *f = XFRAME (w->frame); + void *view = FRAME_HAIKU_VIEW (f); + int x, y, width, height, from_y, to_y, bottom_y; + window_box (w, ANY_AREA, &x, &y, &width, &height); + + from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y); + to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y); + bottom_y = y + height; + + if (to_y < from_y) + { + /* Scrolling up. Make sure we don't copy part of the mode + line at the bottom. */ + if (from_y + run->height > bottom_y) + height = bottom_y - from_y; + else + height = run->height; + } + else + { + /* Scrolling down. Make sure we don't copy over the mode line. + at the bottom. */ + if (to_y + run->height > bottom_y) + height = bottom_y - to_y; + else + height = run->height; + } + + if (!height) + return; + + block_input (); + gui_clear_cursor (w); + BView_draw_lock (view); +#ifdef USE_BE_CAIRO + if (EmacsView_double_buffered_p (view)) + { +#endif + BView_StartClip (view); + BView_CopyBits (view, x, from_y, width, height, + x, to_y, width, height); + BView_EndClip (view); +#ifdef USE_BE_CAIRO + } + else + { + EmacsWindow_begin_cr_critical_section (FRAME_HAIKU_WINDOW (f)); + cairo_surface_t *surface = FRAME_CR_SURFACE (f); + cairo_surface_t *s + = cairo_surface_create_similar (surface, + cairo_surface_get_content (surface), + width, height); + cairo_t *cr = cairo_create (s); + if (surface) + { + cairo_set_source_surface (cr, surface, -x, -from_y); + cairo_paint (cr); + cairo_destroy (cr); + + cr = haiku_begin_cr_clip (f, NULL); + cairo_save (cr); + cairo_set_source_surface (cr, s, x, to_y); + cairo_set_operator (cr, CAIRO_OPERATOR_SOURCE); + cairo_rectangle (cr, x, to_y, width, height); + cairo_fill (cr); + cairo_restore (cr); + cairo_surface_destroy (s); + haiku_end_cr_clip (cr); + } + EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); + } +#endif + BView_draw_unlock (view); + + unblock_input (); +} + +static void +haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, + enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, + Time *timestamp) +{ + block_input (); + if (!fp) + return; + Lisp_Object frame, tail; + struct frame *f1 = NULL; + FOR_EACH_FRAME (tail, frame) + XFRAME (frame)->mouse_moved = false; + + if (gui_mouse_grabbed (x_display_list) && !EQ (track_mouse, Qdropping)) + f1 = x_display_list->last_mouse_frame; + + if (!f1 || FRAME_TOOLTIP_P (f1)) + f1 = ((EQ (track_mouse, Qdropping) && gui_mouse_grabbed (x_display_list)) + ? x_display_list->last_mouse_frame + : NULL); + + if (!f1 && insist > 0) + f1 = SELECTED_FRAME (); + + if (!f1 || (!FRAME_HAIKU_P (f1) && (insist > 0))) + FOR_EACH_FRAME (tail, frame) + if (FRAME_HAIKU_P (XFRAME (frame)) && + !FRAME_TOOLTIP_P (XFRAME (frame))) + f1 = XFRAME (frame); + + if (FRAME_TOOLTIP_P (f1)) + f1 = NULL; + + if (f1 && FRAME_HAIKU_P (f1)) + { + int sx, sy; + void *view = FRAME_HAIKU_VIEW (f1); + if (view) + { + BView_get_mouse (view, &sx, &sy); + + remember_mouse_glyph (f1, sx, sy, &x_display_list->last_mouse_glyph); + x_display_list->last_mouse_glyph_frame = f1; + + *bar_window = Qnil; + *part = scroll_bar_above_handle; + *fp = f1; + XSETINT (*x, sx); + XSETINT (*y, sy); + } + } + + unblock_input (); +} + +static void +haiku_flush (struct frame *f) +{ + if (FRAME_VISIBLE_P (f)) + BWindow_Flush (FRAME_HAIKU_WINDOW (f)); +} + +static void +haiku_define_frame_cursor (struct frame *f, Emacs_Cursor cursor) +{ + if (f->tooltip) + return; + block_input (); + if (!f->pointer_invisible && FRAME_HAIKU_VIEW (f) + && !FRAME_OUTPUT_DATA (f)->hourglass_p) + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), cursor); + unblock_input (); + FRAME_OUTPUT_DATA (f)->current_cursor = cursor; +} + +static void +haiku_update_window_end (struct window *w, bool cursor_on_p, + bool mouse_face_overwritten_p) +{ + +} + +static void +haiku_default_font_parameter (struct frame *f, Lisp_Object parms) +{ + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + Lisp_Object font_param = gui_display_get_arg (dpyinfo, parms, Qfont, NULL, NULL, + RES_TYPE_STRING); + Lisp_Object font = Qnil; + if (EQ (font_param, Qunbound)) + font_param = Qnil; + + if (NILP (font_param)) + { + /* System font should take precedence over X resources. We suggest this + regardless of font-use-system-font because .emacs may not have been + read yet. */ + struct haiku_font_pattern ptn; + ptn.specified = 0; + + if (f->tooltip) + BFont_populate_plain_family (&ptn); + else + BFont_populate_fixed_family (&ptn); + + if (ptn.specified & FSPEC_FAMILY) + font = font_open_by_name (f, build_unibyte_string (ptn.family)); + } + + if (NILP (font)) + font = !NILP (font_param) ? font_param + : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font", + RES_TYPE_STRING); + + if (! FONTP (font) && ! STRINGP (font)) + { + const char **names = (const char *[]) { "monospace-12", + "Noto Sans Mono-12", + "Source Code Pro-12", + NULL }; + int i; + + for (i = 0; names[i]; i++) + { + font + = font_open_by_name (f, build_unibyte_string (names[i])); + if (!NILP (font)) + break; + } + if (NILP (font)) + error ("No suitable font was found"); + } + else if (!NILP (font_param)) + { + /* Remember the explicit font parameter, so we can re-apply it + after we've applied the `default' face settings. */ + AUTO_FRAME_ARG (arg, Qfont_parameter, font_param); + gui_set_frame_parameters (f, arg); + } + + gui_default_parameter (f, parms, Qfont, font, "font", "Font", + RES_TYPE_STRING); +} + +static struct redisplay_interface haiku_redisplay_interface = + { + haiku_frame_parm_handlers, + gui_produce_glyphs, + gui_write_glyphs, + gui_insert_glyphs, + gui_clear_end_of_line, + haiku_scroll_run, + haiku_after_update_window_line, + NULL, + haiku_update_window_end, + haiku_flush, + gui_clear_window_mouse_face, + gui_get_glyph_overhangs, + gui_fix_overlapping_area, + haiku_draw_fringe_bitmap, + haiku_define_fringe_bitmap, + haiku_destroy_fringe_bitmap, + haiku_compute_glyph_string_overhangs, + haiku_draw_glyph_string, + haiku_define_frame_cursor, + haiku_clear_frame_area, + haiku_clear_under_internal_border, + haiku_draw_window_cursor, + haiku_draw_vertical_window_border, + haiku_draw_window_divider, + 0, /* shift glyphs for insert */ + haiku_show_hourglass, + haiku_hide_hourglass, + haiku_default_font_parameter, + }; + +static void +haiku_make_fullscreen_consistent (struct frame *f) +{ + Lisp_Object lval = get_frame_param (f, Qfullscreen); + + if (!EQ (lval, Qmaximized) && FRAME_OUTPUT_DATA (f)->zoomed_p) + lval = Qmaximized; + else if (EQ (lval, Qmaximized) && !FRAME_OUTPUT_DATA (f)->zoomed_p) + lval = Qnil; + + store_frame_param (f, Qfullscreen, lval); +} + +static int +haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) +{ + block_input (); + int message_count = 0; + static void *buf = NULL; + ssize_t b_size; + struct unhandled_event *unhandled_events = NULL; + + if (!buf) + buf = xmalloc (200); + haiku_read_size (&b_size); + while (b_size >= 0) + { + enum haiku_event_type type; + struct input_event inev, inev2; + + if (b_size > 200) + emacs_abort (); + + EVENT_INIT (inev); + EVENT_INIT (inev2); + inev.kind = NO_EVENT; + inev2.kind = NO_EVENT; + inev.arg = Qnil; + inev2.arg = Qnil; + + haiku_read (&type, buf, b_size); + + switch (type) + { + case QUIT_REQUESTED: + { + struct haiku_quit_requested_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + inev.kind = DELETE_WINDOW_EVENT; + XSETFRAME (inev.frame_or_window, f); + break; + } + case FRAME_RESIZED: + { + struct haiku_resize_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + int width = (int) b->px_widthf; + int height = (int) b->px_heightf; + + BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_resize_to (FRAME_HAIKU_VIEW (f), width, height); + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); + if (width != FRAME_PIXEL_WIDTH (f) + || height != FRAME_PIXEL_HEIGHT (f) + || (f->new_size_p + && ((f->new_width >= 0 && width != f->new_width) + || (f->new_height >= 0 && height != f->new_height)))) + { + change_frame_size (f, width, height, false, true, false); + SET_FRAME_GARBAGED (f); + cancel_mouse_face (f); + haiku_clear_under_internal_border (f); + } + + if (FRAME_OUTPUT_DATA (f)->pending_zoom_width != width || + FRAME_OUTPUT_DATA (f)->pending_zoom_height != height) + { + FRAME_OUTPUT_DATA (f)->zoomed_p = 0; + haiku_make_fullscreen_consistent (f); + } + else + { + FRAME_OUTPUT_DATA (f)->zoomed_p = 1; + FRAME_OUTPUT_DATA (f)->pending_zoom_width = INT_MIN; + FRAME_OUTPUT_DATA (f)->pending_zoom_height = INT_MIN; + } + break; + } + case FRAME_EXPOSED: + { + struct haiku_expose_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + expose_frame (f, b->x, b->y, b->width, b->height); + + haiku_clear_under_internal_border (f); + break; + } + case KEY_DOWN: + { + struct haiku_key_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + int non_ascii_p; + if (!f) + continue; + + inev.code = b->unraw_mb_char; + + BMapKey (b->kc, &non_ascii_p, &inev.code); + + if (non_ascii_p) + inev.kind = NON_ASCII_KEYSTROKE_EVENT; + else + inev.kind = inev.code > 127 ? MULTIBYTE_CHAR_KEYSTROKE_EVENT : + ASCII_KEYSTROKE_EVENT; + + inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + XSETFRAME (inev.frame_or_window, f); + break; + } + case ACTIVATION: + { + struct haiku_activation_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if ((x_display_list->focus_event_frame != f && b->activated_p) || + (x_display_list->focus_event_frame == f && !b->activated_p)) + { + haiku_new_focus_frame (b->activated_p ? f : NULL); + if (b->activated_p) + x_display_list->focus_event_frame = f; + else + x_display_list->focus_event_frame = NULL; + inev.kind = b->activated_p ? FOCUS_IN_EVENT : FOCUS_OUT_EVENT; + XSETFRAME (inev.frame_or_window, f); + } + + break; + } + case MOUSE_MOTION: + { + struct haiku_mouse_motion_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + Lisp_Object frame; + XSETFRAME (frame, f); + + if (b->just_exited_p) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + if (f == hlinfo->mouse_face_mouse_frame) + { + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; + } + + haiku_new_focus_frame (x_display_list->focused_frame); + help_echo_string = Qnil; + gen_help_event (Qnil, frame, Qnil, Qnil, 0); + } + else + { + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + struct haiku_rect r = dpyinfo->last_mouse_glyph; + + dpyinfo->last_mouse_motion_x = b->x; + dpyinfo->last_mouse_motion_y = b->y; + dpyinfo->last_mouse_motion_frame = f; + + previous_help_echo_string = help_echo_string; + help_echo_string = Qnil; + + if (f != dpyinfo->last_mouse_glyph_frame || + b->x < r.x || b->x >= r.x + r.width - 1 || b->y < r.y || + b->y >= r.y + r.height - 1) + { + f->mouse_moved = true; + dpyinfo->last_mouse_scroll_bar = NULL; + note_mouse_highlight (f, b->x, b->y); + remember_mouse_glyph (f, b->x, b->y, + &FRAME_DISPLAY_INFO (f)->last_mouse_glyph); + dpyinfo->last_mouse_glyph_frame = f; + gen_help_event (help_echo_string, frame, help_echo_window, + help_echo_object, help_echo_pos); + } + + if (MOUSE_HL_INFO (f)->mouse_face_hidden) + { + MOUSE_HL_INFO (f)->mouse_face_hidden = 0; + clear_mouse_face (MOUSE_HL_INFO (f)); + } + + if (!NILP (Vmouse_autoselect_window)) + { + static Lisp_Object last_mouse_window; + Lisp_Object window = window_from_coordinates (f, b->x, b->y, 0, 0, 0); + + if (WINDOWP (window) + && !EQ (window, last_mouse_window) + && !EQ (window, selected_window) + && (!NILP (focus_follows_mouse) + || (EQ (XWINDOW (window)->frame, + XWINDOW (selected_window)->frame)))) + { + inev.kind = SELECT_WINDOW_EVENT; + inev.frame_or_window = window; + } + + last_mouse_window = window; + } + } + break; + } + case BUTTON_UP: + case BUTTON_DOWN: + { + struct haiku_button_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + Lisp_Object tab_bar_arg = Qnil; + int tab_bar_p = 0, tool_bar_p = 0; + + if (!f) + continue; + + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + + inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + + x_display_list->last_mouse_glyph_frame = 0; + + /* Is this in the tab-bar? */ + if (WINDOWP (f->tab_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tab_bar_window))) + { + Lisp_Object window; + int x = b->x; + int y = b->y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tab_bar_p = EQ (window, f->tab_bar_window); + + if (tab_bar_p) + tab_bar_arg = handle_tab_bar_click + (f, x, y, type == BUTTON_DOWN, inev.modifiers); + } + + if (WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) + { + Lisp_Object window; + int x = b->x; + int y = b->y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tool_bar_p = EQ (window, f->tool_bar_window); + + if (tool_bar_p) + handle_tool_bar_click + (f, x, y, type == BUTTON_DOWN, inev.modifiers); + } + + if (type == BUTTON_UP) + { + inev.modifiers |= up_modifier; + dpyinfo->grabbed &= ~(1 << b->btn_no); + } + else + { + inev.modifiers |= down_modifier; + dpyinfo->last_mouse_frame = f; + dpyinfo->grabbed |= (1 << b->btn_no); + if (f && !tab_bar_p) + f->last_tab_bar_item = -1; + if (f && !tool_bar_p) + f->last_tool_bar_item = -1; + } + + if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p) + inev.kind = MOUSE_CLICK_EVENT; + inev.arg = tab_bar_arg; + inev.code = b->btn_no; + + inev.modifiers |= type == BUTTON_UP ? + up_modifier : down_modifier; + + XSETINT (inev.x, b->x); + XSETINT (inev.y, b->y); + + XSETFRAME (inev.frame_or_window, f); + break; + } + case ICONIFICATION: + { + struct haiku_iconification_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if (!b->iconified_p) + { + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, 0); + inev.kind = DEICONIFY_EVENT; + + + /* Haiku doesn't expose frames on deiconification, but + if we are double-buffered, the previous screen + contents should have been preserved. */ + if (!EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + { + SET_FRAME_GARBAGED (f); + expose_frame (f, 0, 0, 0, 0); + } + } + else + { + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, 1); + inev.kind = ICONIFY_EVENT; + } + + XSETFRAME (inev.frame_or_window, f); + break; + } + case MOVE_EVENT: + { + struct haiku_move_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if (FRAME_OUTPUT_DATA (f)->pending_zoom_x != b->x || + FRAME_OUTPUT_DATA (f)->pending_zoom_y != b->y) + FRAME_OUTPUT_DATA (f)->zoomed_p = 0; + else + { + FRAME_OUTPUT_DATA (f)->zoomed_p = 1; + FRAME_OUTPUT_DATA (f)->pending_zoom_x = INT_MIN; + FRAME_OUTPUT_DATA (f)->pending_zoom_y = INT_MIN; + } + + if (FRAME_PARENT_FRAME (f)) + haiku_coords_from_parent (f, &b->x, &b->y); + + if (b->x != f->left_pos || b->y != f->top_pos) + { + inev.kind = MOVE_FRAME_EVENT; + + XSETINT (inev.x, b->x); + XSETINT (inev.y, b->y); + + f->left_pos = b->x; + f->top_pos = b->y; + + struct frame *p; + + if ((p = FRAME_PARENT_FRAME (f))) + { + void *window = FRAME_HAIKU_WINDOW (p); + EmacsWindow_move_weak_child (window, b->window, b->x, b->y); + } + + XSETFRAME (inev.frame_or_window, f); + } + + haiku_make_fullscreen_consistent (f); + break; + } + case SCROLL_BAR_VALUE_EVENT: + { + struct haiku_scroll_bar_value_event *b = buf; + struct scroll_bar *bar = b->scroll_bar; + + struct window *w = XWINDOW (bar->window); + + if (bar->update != -1) + { + bar->update = -1; + break; + } + + if (bar->position != b->position) + { + inev.kind = bar->horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : + SCROLL_BAR_CLICK_EVENT; + inev.part = bar->horizontal ? + scroll_bar_horizontal_handle : scroll_bar_handle; + + XSETINT (inev.x, b->position); + XSETINT (inev.y, bar->total); + XSETWINDOW (inev.frame_or_window, w); + } + break; + } + case SCROLL_BAR_DRAG_EVENT: + { + struct haiku_scroll_bar_drag_event *b = buf; + struct scroll_bar *bar = b->scroll_bar; + + bar->dragging = b->dragging_p; + if (!b->dragging_p && bar->horizontal) + set_horizontal_scroll_bar (XWINDOW (bar->window)); + else if (!b->dragging_p) + set_vertical_scroll_bar (XWINDOW (bar->window)); + break; + } + case WHEEL_MOVE_EVENT: + { + struct haiku_wheel_move_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + int x, y; + static float px = 0.0f, py = 0.0f; + + if (!f) + continue; + BView_get_mouse (FRAME_HAIKU_VIEW (f), &x, &y); + + inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + + inev2.modifiers = inev.modifiers; + + if (signbit (px) != signbit (b->delta_x)) + px = 0; + + if (signbit (py) != signbit (b->delta_y)) + py = 0; + + px += b->delta_x; + py += b->delta_y; + + if (fabsf (py) >= FRAME_LINE_HEIGHT (f)) + { + inev.kind = WHEEL_EVENT; + inev.code = 0; + + XSETINT (inev.x, x); + XSETINT (inev.y, y); + XSETINT (inev.arg, lrint (fabsf (py) / FRAME_LINE_HEIGHT (f))); + XSETFRAME (inev.frame_or_window, f); + + inev.modifiers |= signbit (py) ? up_modifier : down_modifier; + py = 0.0f; + } + + if (fabsf (px) >= FRAME_COLUMN_WIDTH (f)) + { + inev2.kind = HORIZ_WHEEL_EVENT; + inev2.code = 0; + + XSETINT (inev2.x, x); + XSETINT (inev2.y, y); + XSETINT (inev2.arg, lrint (fabsf (px) / FRAME_COLUMN_WIDTH (f))); + XSETFRAME (inev2.frame_or_window, f); + + inev2.modifiers |= signbit (px) ? up_modifier : down_modifier; + px = 0.0f; + } + + break; + } + + case MENU_BAR_RESIZE: + { + struct haiku_menu_bar_resize_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + int old_height = FRAME_MENU_BAR_HEIGHT (f); + + FRAME_MENU_BAR_HEIGHT (f) = b->height + 1; + FRAME_MENU_BAR_LINES (f) = + (b->height + FRAME_LINE_HEIGHT (f)) / FRAME_LINE_HEIGHT (f); + + if (old_height != b->height) + { + adjust_frame_size (f, -1, -1, 3, true, Qmenu_bar_lines); + haiku_clear_under_internal_border (f); + } + break; + } + case MENU_BAR_OPEN: + case MENU_BAR_CLOSE: + { + struct haiku_menu_bar_state_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + if (type == MENU_BAR_OPEN) + { + if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) + { + BView_draw_lock (FRAME_HAIKU_VIEW (f)); + /* This shouldn't be here, but nsmenu does it, so + it should probably be safe. */ + int was_waiting_for_input_p = waiting_for_input; + if (waiting_for_input) + waiting_for_input = 0; + set_frame_menubar (f, 1); + waiting_for_input = was_waiting_for_input_p; + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); + } + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + } + else + { + if (!popup_activated_p) + emacs_abort (); + if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + { + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0; + popup_activated_p -= 1; + } + } + break; + } + case MENU_BAR_SELECT_EVENT: + { + struct haiku_menu_bar_select_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + if (FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) + find_and_call_menu_selection (f, f->menu_bar_items_used, + f->menu_bar_vector, b->ptr); + break; + } + case FILE_PANEL_EVENT: + { + if (!popup_activated_p) + continue; + + struct unhandled_event *ev = xmalloc (sizeof *ev); + ev->next = unhandled_events; + ev->type = type; + memcpy (&ev->buffer, buf, 200); + + unhandled_events = ev; + break; + } + case MENU_BAR_HELP_EVENT: + { + struct haiku_menu_bar_help_event *b = buf; + + if (!popup_activated_p) + continue; + + struct frame *f = haiku_window_to_frame (b->window); + if (!f || !FRAME_EXTERNAL_MENU_BAR (f) || + !FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + continue; + + run_menu_bar_help_event (f, b->mb_idx); + + break; + } + case ZOOM_EVENT: + { + struct haiku_zoom_event *b = buf; + + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + FRAME_OUTPUT_DATA (f)->pending_zoom_height = b->height; + FRAME_OUTPUT_DATA (f)->pending_zoom_width = b->width; + FRAME_OUTPUT_DATA (f)->pending_zoom_x = b->x; + FRAME_OUTPUT_DATA (f)->pending_zoom_y = b->y; + + FRAME_OUTPUT_DATA (f)->zoomed_p = 1; + haiku_make_fullscreen_consistent (f); + break; + } + case REFS_EVENT: + { + struct haiku_refs_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + inev.kind = DRAG_N_DROP_EVENT; + inev.arg = build_string_from_utf8 (b->ref); + + XSETINT (inev.x, b->x); + XSETINT (inev.y, b->y); + XSETFRAME (inev.frame_or_window, f); + + /* There should be no problem with calling free here. + free on Haiku is thread-safe. */ + free (b->ref); + break; + } + case APP_QUIT_REQUESTED_EVENT: + case KEY_UP: + default: + break; + } + + haiku_read_size (&b_size); + + if (inev.kind != NO_EVENT) + { + kbd_buffer_store_event_hold (&inev, hold_quit); + ++message_count; + } + + if (inev2.kind != NO_EVENT) + { + kbd_buffer_store_event_hold (&inev2, hold_quit); + ++message_count; + } + } + + for (struct unhandled_event *ev = unhandled_events; ev;) + { + haiku_write_without_signal (ev->type, &ev->buffer); + struct unhandled_event *old = ev; + ev = old->next; + xfree (old); + } + + unblock_input (); + return message_count; +} + +static void +haiku_frame_rehighlight (struct frame *frame) +{ + haiku_rehighlight (); +} + +static void +haiku_delete_window (struct frame *f) +{ + check_window_system (f); + haiku_free_frame_resources (f); +} + +static void +haiku_free_pixmap (struct frame *f, Emacs_Pixmap pixmap) +{ + BBitmap_free (pixmap); +} + +static void +haiku_beep (struct frame *f) +{ + if (visible_bell) + { + void *view = FRAME_HAIKU_VIEW (f); + if (view) + { + block_input (); + BView_draw_lock (view); + if (!EmacsView_double_buffered_p (view)) + { + BView_SetHighColorForVisibleBell (view, FRAME_FOREGROUND_PIXEL (f)); + BView_FillRectangleForVisibleBell (view, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + SET_FRAME_GARBAGED (f); + expose_frame (f, 0, 0, 0, 0); + } + else + { + EmacsView_do_visible_bell (view, FRAME_FOREGROUND_PIXEL (f)); + haiku_flip_buffers (f); + } + BView_draw_unlock (view); + unblock_input (); + } + } + else + haiku_ring_bell (); +} + +static void +haiku_toggle_invisible_pointer (struct frame *f, bool invisible_p) +{ + void *view = FRAME_HAIKU_VIEW (f); + + if (view) + { + block_input (); + BView_set_view_cursor (view, invisible_p ? + FRAME_OUTPUT_DATA (f)->no_cursor : + FRAME_OUTPUT_DATA (f)->current_cursor); + f->pointer_invisible = invisible_p; + unblock_input (); + } +} + +static void +haiku_fullscreen (struct frame *f) +{ + if (f->want_fullscreen == FULLSCREEN_MAXIMIZED) + { + EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 0); + BWindow_zoom (FRAME_HAIKU_WINDOW (f)); + } + else if (f->want_fullscreen == FULLSCREEN_BOTH) + EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 1); + else if (f->want_fullscreen == FULLSCREEN_NONE) + { + EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 0); + EmacsWindow_unzoom (FRAME_HAIKU_WINDOW (f)); + } + + f->want_fullscreen = FULLSCREEN_NONE; + + haiku_update_size_hints (f); +} + +static struct terminal * +haiku_create_terminal (struct haiku_display_info *dpyinfo) +{ + struct terminal *terminal; + + terminal = create_terminal (output_haiku, &haiku_redisplay_interface); + + terminal->display_info.haiku = dpyinfo; + dpyinfo->terminal = terminal; + terminal->kboard = allocate_kboard (Qhaiku); + + terminal->iconify_frame_hook = haiku_iconify_frame; + terminal->focus_frame_hook = haiku_focus_frame; + terminal->ring_bell_hook = haiku_beep; + terminal->popup_dialog_hook = haiku_popup_dialog; + terminal->frame_visible_invisible_hook = haiku_set_frame_visible_invisible; + terminal->set_frame_offset_hook = haiku_set_offset; + terminal->delete_terminal_hook = haiku_delete_terminal; + terminal->get_string_resource_hook = get_string_resource; + terminal->set_new_font_hook = haiku_new_font; + terminal->defined_color_hook = haiku_defined_color; + terminal->set_window_size_hook = haiku_set_window_size; + terminal->read_socket_hook = haiku_read_socket; + terminal->implicit_set_name_hook = haiku_implicitly_set_name; + terminal->mouse_position_hook = haiku_mouse_position; + terminal->delete_frame_hook = haiku_delete_window; + terminal->frame_up_to_date_hook = haiku_frame_up_to_date; + terminal->buffer_flipping_unblocked_hook = haiku_buffer_flipping_unblocked_hook; + terminal->clear_frame_hook = haiku_clear_frame; + terminal->change_tab_bar_height_hook = haiku_change_tab_bar_height; + terminal->change_tool_bar_height_hook = haiku_change_tool_bar_height; + terminal->set_vertical_scroll_bar_hook = haiku_set_vertical_scroll_bar; + terminal->set_horizontal_scroll_bar_hook = haiku_set_horizontal_scroll_bar; + terminal->set_scroll_bar_default_height_hook = haiku_set_scroll_bar_default_height; + terminal->set_scroll_bar_default_width_hook = haiku_set_scroll_bar_default_width; + terminal->judge_scroll_bars_hook = haiku_judge_scroll_bars; + terminal->condemn_scroll_bars_hook = haiku_condemn_scroll_bars; + terminal->redeem_scroll_bar_hook = haiku_redeem_scroll_bar; + terminal->update_begin_hook = haiku_update_begin; + terminal->update_end_hook = haiku_update_end; + terminal->frame_rehighlight_hook = haiku_frame_rehighlight; + terminal->query_frame_background_color = haiku_query_frame_background_color; + terminal->free_pixmap = haiku_free_pixmap; + terminal->frame_raise_lower_hook = haiku_frame_raise_lower; + terminal->menu_show_hook = haiku_menu_show; + terminal->toggle_invisible_pointer_hook = haiku_toggle_invisible_pointer; + terminal->fullscreen_hook = haiku_fullscreen; + + return terminal; +} + +struct haiku_display_info * +haiku_term_init (void) +{ + struct haiku_display_info *dpyinfo; + struct terminal *terminal; + + Lisp_Object color_file, color_map; + + block_input (); + Fset_input_interrupt_mode (Qnil); + + baud_rate = 19200; + + dpyinfo = xzalloc (sizeof *dpyinfo); + + haiku_io_init (); + + if (port_application_to_emacs < B_OK) + emacs_abort (); + + color_file = Fexpand_file_name (build_string ("rgb.txt"), + Fsymbol_value (intern ("data-directory"))); + + color_map = Fx_load_color_file (color_file); + if (NILP (color_map)) + fatal ("Could not read %s.\n", SDATA (color_file)); + + dpyinfo->color_map = color_map; + + dpyinfo->display = BApplication_setup (); + + BScreen_res (&dpyinfo->resx, &dpyinfo->resy); + + dpyinfo->next = x_display_list; + dpyinfo->n_planes = be_get_display_planes (); + x_display_list = dpyinfo; + + terminal = haiku_create_terminal (dpyinfo); + if (current_kboard == initial_kboard) + current_kboard = terminal->kboard; + + terminal->kboard->reference_count++; + /* Never delete haiku displays -- there can only ever be one, + anyhow. */ + terminal->reference_count++; + terminal->name = xstrdup ("be"); + + dpyinfo->name_list_element = Fcons (build_string ("be"), Qnil); + dpyinfo->smallest_font_height = 1; + dpyinfo->smallest_char_width = 1; + + gui_init_fringe (terminal->rif); + unblock_input (); + + return dpyinfo; +} + +void +put_xrm_resource (Lisp_Object name, Lisp_Object val) +{ + eassert (STRINGP (name)); + eassert (STRINGP (val) || NILP (val)); + + Lisp_Object lval = assoc_no_quit (name, rdb); + if (!NILP (lval)) + Fsetcdr (lval, val); + else + rdb = Fcons (Fcons (name, val), rdb); +} + +void +haiku_clear_under_internal_border (struct frame *f) +{ + if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0) + { + int border = FRAME_INTERNAL_BORDER_WIDTH (f); + int width = FRAME_PIXEL_WIDTH (f); + int height = FRAME_PIXEL_HEIGHT (f); + int margin = FRAME_TOP_MARGIN_HEIGHT (f); + int face_id = + (FRAME_PARENT_FRAME (f) + ? (!NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID) + : CHILD_FRAME_BORDER_FACE_ID) + : (!NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) + : INTERNAL_BORDER_FACE_ID)); + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + void *view = FRAME_HAIKU_VIEW (f); + block_input (); + BView_draw_lock (view); + BView_StartClip (view); + BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + + if (face) + BView_SetHighColor (view, face->background); + else + BView_SetHighColor (view, FRAME_BACKGROUND_PIXEL (f)); + + BView_FillRectangle (view, 0, margin, width, border); + BView_FillRectangle (view, 0, 0, border, height); + BView_FillRectangle (view, 0, margin, width, border); + BView_FillRectangle (view, width - border, 0, border, height); + BView_FillRectangle (view, 0, height - border, width, border); + BView_EndClip (view); + BView_draw_unlock (view); + unblock_input (); + } +} + +void +mark_haiku_display (void) +{ + if (x_display_list) + mark_object (x_display_list->color_map); +} + +void +haiku_scroll_bar_remove (struct scroll_bar *bar) +{ + block_input (); + void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (XWINDOW (bar->window))); + BView_forget_scroll_bar (view, bar->left, bar->top, bar->width, bar->height); + BScrollBar_delete (bar->scroll_bar); + expose_frame (WINDOW_XFRAME (XWINDOW (bar->window)), + bar->left, bar->top, bar->width, bar->height); + + if (bar->horizontal) + wset_horizontal_scroll_bar (XWINDOW (bar->window), Qnil); + else + wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil); + + unblock_input (); +}; + +void +haiku_set_offset (struct frame *frame, int x, int y, + int change_gravity) +{ + if (change_gravity > 0) + { + frame->top_pos = y; + frame->left_pos = x; + frame->size_hint_flags &= ~ (XNegative | YNegative); + if (x < 0) + frame->size_hint_flags |= XNegative; + if (y < 0) + frame->size_hint_flags |= YNegative; + frame->win_gravity = NorthWestGravity; + } + + haiku_update_size_hints (frame); + + block_input (); + if (change_gravity) + BWindow_set_offset (FRAME_HAIKU_WINDOW (frame), x, y); + unblock_input (); +} + +#ifdef USE_BE_CAIRO +cairo_t * +haiku_begin_cr_clip (struct frame *f, struct glyph_string *s) +{ + cairo_surface_t *surface = FRAME_CR_SURFACE (f); + if (!surface) + return NULL; + + cairo_t *context = cairo_create (surface); + return context; +} + +void +haiku_end_cr_clip (cairo_t *cr) +{ + cairo_destroy (cr); +} +#endif + +void +syms_of_haikuterm (void) +{ + DEFVAR_BOOL ("haiku-initialized", haiku_initialized, + doc: /* Non-nil if the Haiku terminal backend has been initialized. */); + + DEFVAR_BOOL ("x-use-underline-position-properties", + x_use_underline_position_properties, + doc: /* SKIP: real doc in xterm.c. */); + x_use_underline_position_properties = 1; + + DEFVAR_BOOL ("x-underline-at-descent-line", + x_underline_at_descent_line, + doc: /* SKIP: real doc in xterm.c. */); + x_underline_at_descent_line = 0; + + DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, + doc: /* SKIP: real doc in xterm.c. */); + Vx_toolkit_scroll_bars = Qt; + + DEFVAR_BOOL ("haiku-debug-on-fatal-error", haiku_debug_on_fatal_error, + doc: /* If non-nil, Emacs will launch the system debugger upon a fatal error. */); + haiku_debug_on_fatal_error = 1; + + DEFSYM (Qshift, "shift"); + DEFSYM (Qcontrol, "control"); + DEFSYM (Qoption, "option"); + DEFSYM (Qcommand, "command"); + + DEFVAR_LISP ("haiku-meta-keysym", Vhaiku_meta_keysym, + doc: /* Which key Emacs uses as the meta modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `command'. + +Setting it to any other value is equivalent to `command'. */); + Vhaiku_meta_keysym = Qnil; + + DEFVAR_LISP ("haiku-control-keysym", Vhaiku_control_keysym, + doc: /* Which key Emacs uses as the control modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `control'. + +Setting it to any other value is equivalent to `control'. */); + Vhaiku_control_keysym = Qnil; + + DEFVAR_LISP ("haiku-super-keysym", Vhaiku_super_keysym, + doc: /* Which key Emacs uses as the super modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `option'. + +Setting it to any other value is equivalent to `option'. */); + Vhaiku_super_keysym = Qnil; + + DEFVAR_LISP ("haiku-shift-keysym", Vhaiku_shift_keysym, + doc: /* Which key Emacs uses as the shift modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `shift'. + +Setting it to any other value is equivalent to `shift'. */); + Vhaiku_shift_keysym = Qnil; + + + DEFSYM (Qx_use_underline_position_properties, + "x-use-underline-position-properties"); + + DEFSYM (Qx_underline_at_descent_line, "x-underline-at-descent-line"); + + rdb = Qnil; + staticpro (&rdb); + + Fprovide (Qhaiku, Qnil); +#ifdef HAVE_BE_FREETYPE + Fprovide (Qfreetype, Qnil); +#endif +#ifdef USE_BE_CAIRO + Fprovide (intern_c_string ("cairo"), Qnil); +#endif +} diff --git a/src/haikuterm.h b/src/haikuterm.h new file mode 100644 index 00000000000..af55f68c679 --- /dev/null +++ b/src/haikuterm.h @@ -0,0 +1,293 @@ +/* Haiku window system support + Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef _HAIKU_TERM_H_ +#define _HAIKU_TERM_H_ + +#include + +#ifdef USE_BE_CAIRO +#include +#endif + +#include "haikugui.h" +#include "frame.h" +#include "character.h" +#include "dispextern.h" +#include "font.h" + +#define C_FRAME struct frame * +#define C_FONT struct font * +#define C_TERMINAL struct terminal * + +#define HAVE_CHAR_CACHE_MAX 65535 + +extern int popup_activated_p; + +extern void be_app_quit (void); + +struct haikufont_info +{ + struct font font; + haiku be_font; + struct font_metrics **metrics; + short metrics_nrows; + + unsigned short **glyphs; +}; + +struct haiku_bitmap_record +{ + haiku img; + char *file; + int refcount; + int height, width, depth; +}; + +struct haiku_display_info +{ + /* Chain of all haiku_display_info structures. */ + struct haiku_display_info *next; + C_TERMINAL terminal; + + Lisp_Object name_list_element; + Lisp_Object color_map; + + int n_fonts; + + int smallest_char_width; + int smallest_font_height; + + struct frame *focused_frame; + struct frame *focus_event_frame; + struct frame *last_mouse_glyph_frame; + + struct haiku_bitmap_record *bitmaps; + ptrdiff_t bitmaps_size; + ptrdiff_t bitmaps_last; + + int grabbed; + int n_planes; + int color_p; + + Window root_window; + Lisp_Object rdb; + + Emacs_Cursor vertical_scroll_bar_cursor; + Emacs_Cursor horizontal_scroll_bar_cursor; + + Mouse_HLInfo mouse_highlight; + + C_FRAME highlight_frame; + C_FRAME last_mouse_frame; + C_FRAME last_mouse_motion_frame; + + int last_mouse_motion_x; + int last_mouse_motion_y; + + struct haiku_rect last_mouse_glyph; + + void *last_mouse_scroll_bar; + + haiku display; + + double resx, resy; +}; + +struct haiku_output +{ + Emacs_Cursor text_cursor; + Emacs_Cursor nontext_cursor; + Emacs_Cursor modeline_cursor; + Emacs_Cursor hand_cursor; + Emacs_Cursor hourglass_cursor; + Emacs_Cursor horizontal_drag_cursor; + Emacs_Cursor vertical_drag_cursor; + Emacs_Cursor left_edge_cursor; + Emacs_Cursor top_left_corner_cursor; + Emacs_Cursor top_edge_cursor; + Emacs_Cursor top_right_corner_cursor; + Emacs_Cursor right_edge_cursor; + Emacs_Cursor bottom_right_corner_cursor; + Emacs_Cursor bottom_edge_cursor; + Emacs_Cursor bottom_left_corner_cursor; + Emacs_Cursor no_cursor; + + Emacs_Cursor current_cursor; + + struct haiku_display_info *display_info; + + int baseline_offset; + int fontset; + + Emacs_Color cursor_color; + + Window window_desc, parent_desc; + char explicit_parent; + + int titlebar_height; + int toolbar_height; + + haiku window; + haiku view; + haiku menubar; + + int menu_up_to_date_p; + int zoomed_p; + + int pending_zoom_x; + int pending_zoom_y; + int pending_zoom_width; + int pending_zoom_height; + + int menu_bar_open_p; + + C_FONT font; + + int hourglass_p; + uint32_t cursor_fg; + bool dirty_p; + + /* The pending position we're waiting for. */ + int pending_top, pending_left; +}; + +struct x_output +{ + /* Unused, makes term.c happy. */ +}; + +extern struct haiku_display_info *x_display_list; +extern struct font_driver const haikufont_driver; + +struct scroll_bar +{ + /* These fields are shared by all vectors. */ + union vectorlike_header header; + + /* The window we're a scroll bar for. */ + Lisp_Object window; + + /* The next and previous in the chain of scroll bars in this frame. */ + Lisp_Object next, prev; + + /* Fields after 'prev' are not traced by the GC. */ + + /* The position and size of the scroll bar in pixels, relative to the + frame. */ + int top, left, width, height; + + /* The actual scrollbar. */ + void *scroll_bar; + + /* Non-nil if the scroll bar handle is currently being dragged by + the user. */ + int dragging; + + /* The update position if we are waiting for a scrollbar update, or + -1. */ + int update; + + /* The last known position of this scrollbar. */ + int position; + + /* The total number of units inside this scrollbar. */ + int total; + + /* True if the scroll bar is horizontal. */ + bool horizontal; +}; + +#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) + +#define FRAME_DIRTY_P(f) (FRAME_OUTPUT_DATA (f)->dirty_p) +#define MAKE_FRAME_DIRTY(f) (FRAME_DIRTY_P (f) = 1) +#define FRAME_OUTPUT_DATA(f) ((f)->output_data.haiku) +#define FRAME_HAIKU_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) +#define FRAME_HAIKU_VIEW(f) ((MAKE_FRAME_DIRTY (f)), FRAME_OUTPUT_DATA (f)->view) +#define FRAME_HAIKU_MENU_BAR(f) (FRAME_OUTPUT_DATA (f)->menubar) +#define FRAME_DISPLAY_INFO(f) (FRAME_OUTPUT_DATA (f)->display_info) +#define FRAME_FONT(f) (FRAME_OUTPUT_DATA (f)->font) +#define FRAME_FONTSET(f) (FRAME_OUTPUT_DATA (f)->fontset) +#define FRAME_NATIVE_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) +#define FRAME_BASELINE_OFFSET(f) (FRAME_OUTPUT_DATA (f)->baseline_offset) +#define FRAME_CURSOR_COLOR(f) (FRAME_OUTPUT_DATA (f)->cursor_color) + +#ifdef USE_BE_CAIRO +#define FRAME_CR_SURFACE(f) \ + (FRAME_HAIKU_VIEW (f) ? EmacsView_cairo_surface (FRAME_HAIKU_VIEW (f)) : 0); +#endif + +extern void syms_of_haikuterm (void); +extern void syms_of_haikufns (void); +extern void syms_of_haikumenu (void); +extern void syms_of_haikufont (void); +extern void syms_of_haikuselect (void); +extern void init_haiku_select (void); + +extern void haiku_iconify_frame (struct frame *); +extern void haiku_visualize_frame (struct frame *); +extern void haiku_unvisualize_frame (struct frame *); +extern void haiku_set_offset (struct frame *, int, int, int); +extern void haiku_set_frame_visible_invisible (struct frame *, bool); +extern void haiku_free_frame_resources (struct frame *f); +extern void haiku_scroll_bar_remove (struct scroll_bar *bar); +extern void haiku_clear_under_internal_border (struct frame *f); +extern void haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p); + +extern struct haiku_display_info *haiku_term_init (void); + +extern void mark_haiku_display (void); + +extern int haiku_get_color (const char *name, Emacs_Color *color); +extern void haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval); +extern void haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval); +extern void haiku_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval); +extern void haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval); +extern void haiku_change_tab_bar_height (struct frame *f, int height); +extern void haiku_change_tool_bar_height (struct frame *f, int height); + +extern void haiku_query_color (uint32_t col, Emacs_Color *color); + +extern unsigned long haiku_get_pixel (haiku bitmap, int x, int y); +extern void haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel); + +extern Lisp_Object haiku_menu_show (struct frame *f, int x, int y, int menu_flags, + Lisp_Object title, const char **error_name); +extern Lisp_Object haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents); + +extern void initialize_frame_menubar (struct frame *f); + +extern void run_menu_bar_help_event (struct frame *f, int mb_idx); +extern void put_xrm_resource (Lisp_Object name, Lisp_Object val); + +#ifdef HAVE_NATIVE_IMAGE_API +extern bool haiku_can_use_native_image_api (Lisp_Object type); +extern int haiku_load_image (struct frame *f, struct image *img, + Lisp_Object spec_file, Lisp_Object spec_data); +extern void syms_of_haikuimage (void); +#endif + +#ifdef USE_BE_CAIRO +extern cairo_t * +haiku_begin_cr_clip (struct frame *f, struct glyph_string *s); + +extern void +haiku_end_cr_clip (cairo_t *cr); +#endif +#endif /* _HAIKU_TERM_H_ */ diff --git a/src/image.c b/src/image.c index 6769e491202..734ccdac311 100644 --- a/src/image.c +++ b/src/image.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include /* Include this before including to work around bugs with @@ -135,6 +136,27 @@ typedef struct ns_bitmap_record Bitmap_Record; # define COLOR_TABLE_SUPPORT 1 #endif +#ifdef HAVE_HAIKU +#include "haiku_support.h" +typedef struct haiku_bitmap_record Bitmap_Record; + +#define GET_PIXEL(ximg, x, y) haiku_get_pixel (ximg, x, y) +#define PUT_PIXEL haiku_put_pixel +#define NO_PIXMAP 0 + +#define PIX_MASK_RETAIN 0 +#define PIX_MASK_DRAW 1 + +#define RGB_TO_ULONG(r, g, b) (((r) << 16) | ((g) << 8) | (b)) +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) +#define RED16_FROM_ULONG(color) (RED_FROM_ULONG (color) * 0x101) +#define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG (color) * 0x101) +#define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG (color) * 0x101) + +#endif + static void image_disable_image (struct frame *, struct image *); static void image_edge_detection (struct frame *, struct image *, Lisp_Object, Lisp_Object); @@ -430,6 +452,11 @@ image_create_bitmap_from_data (struct frame *f, char *bits, return -1; #endif +#ifdef HAVE_HAIKU + void *bitmap = BBitmap_new (width, height, 1); + BBitmap_import_mono_bits (bitmap, bits, width, height); +#endif + id = image_allocate_bitmap_record (f); #ifdef HAVE_NS @@ -437,6 +464,11 @@ image_create_bitmap_from_data (struct frame *f, char *bits, dpyinfo->bitmaps[id - 1].depth = 1; #endif +#ifdef HAVE_HAIKU + dpyinfo->bitmaps[id - 1].img = bitmap; + dpyinfo->bitmaps[id - 1].depth = 1; +#endif + dpyinfo->bitmaps[id - 1].file = NULL; dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; @@ -465,7 +497,7 @@ image_create_bitmap_from_data (struct frame *f, char *bits, ptrdiff_t image_create_bitmap_from_file (struct frame *f, Lisp_Object file) { -#ifdef HAVE_NTGUI +#if defined (HAVE_NTGUI) || defined (HAVE_HAIKU) return -1; /* W32_TODO : bitmap support */ #else Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); @@ -561,6 +593,10 @@ free_bitmap_record (Display_Info *dpyinfo, Bitmap_Record *bm) ns_release_object (bm->img); #endif +#ifdef HAVE_HAIKU + BBitmap_free (bm->img); +#endif + if (bm->file) { xfree (bm->file); @@ -1834,6 +1870,11 @@ image_size_in_bytes (struct image *img) if (img->mask) size += w32_image_size (img->mask); +#elif defined HAVE_HAIKU + if (img->pixmap) + size += BBitmap_bytes_length (img->pixmap); + if (img->mask) + size += BBitmap_bytes_length (img->mask); #endif return size; @@ -2173,6 +2214,7 @@ compute_image_size (size_t width, size_t height, single step, but the maths for each element is much more complex and performing the steps separately makes for more readable code. */ +#ifndef HAVE_HAIKU typedef double matrix3x3[3][3]; static void @@ -2187,6 +2229,7 @@ matrix3x3_mult (matrix3x3 a, matrix3x3 b, matrix3x3 result) result[i][j] = sum; } } +#endif /* not HAVE_HAIKU */ static void compute_image_rotation (struct image *img, double *rotation) @@ -2244,6 +2287,7 @@ image_set_transform (struct frame *f, struct image *img) double rotation = 0.0; compute_image_rotation (img, &rotation); +#ifndef HAVE_HAIKU # if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS /* We want scale up operations to use a nearest neighbor filter to show real pixels instead of munging them, but scale down @@ -2414,6 +2458,34 @@ image_set_transform (struct frame *f, struct image *img) img->xform.eDx = matrix[2][0]; img->xform.eDy = matrix[2][1]; # endif +#else + if (rotation != 0 && + rotation != 90 && + rotation != 180 && + rotation != 270 && + rotation != 360) + { + image_error ("No native support for rotation by %g degrees", + make_float (rotation)); + return; + } + + rotation = fmod (rotation, 360.0); + + if (rotation == 90 || rotation == 270) + { + int w = width; + width = height; + height = w; + } + + img->have_be_transforms_p = rotation != 0 || (img->width != width) || (img->height != height); + img->be_rotate = rotation; + img->be_scale_x = 1.0 / (img->width / (double) width); + img->be_scale_y = 1.0 / (img->height / (double) height); + img->width = width; + img->height = height; +#endif /* not HAVE_HAIKU */ } #endif /* HAVE_IMAGEMAGICK || HAVE_NATIVE_TRANSFORMS */ @@ -2820,6 +2892,30 @@ image_create_x_image_and_pixmap_1 (struct frame *f, int width, int height, int d return 1; #endif /* HAVE_X_WINDOWS */ +#ifdef HAVE_HAIKU + if (depth == 0) + depth = 24; + + if (depth != 24 && depth != 1) + { + *pimg = NULL; + image_error ("Invalid image bit depth specified"); + return 0; + } + + *pixmap = BBitmap_new (width, height, depth == 1); + + if (*pixmap == NO_PIXMAP) + { + *pimg = NULL; + image_error ("Unable to create pixmap", Qnil, Qnil); + return 0; + } + + *pimg = *pixmap; + return 1; +#endif + #ifdef HAVE_NTGUI BITMAPINFOHEADER *header; @@ -2960,7 +3056,7 @@ static void gui_put_x_image (struct frame *f, Emacs_Pix_Container pimg, Emacs_Pixmap pixmap, int width, int height) { -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined HAVE_HAIKU eassert (pimg == pixmap); #elif defined HAVE_X_WINDOWS GC gc; @@ -3087,7 +3183,7 @@ image_unget_x_image_or_dc (struct image *img, bool mask_p, static Emacs_Pix_Container image_get_x_image (struct frame *f, struct image *img, bool mask_p) { -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined (HAVE_HAIKU) return !mask_p ? img->pixmap : img->mask; #elif defined HAVE_X_WINDOWS XImage *ximg_in_img = !mask_p ? img->ximg : img->mask_img; @@ -4036,7 +4132,7 @@ xbm_load (struct frame *f, struct image *img) #endif /* not HAVE_NTGUI */ #endif /* HAVE_XPM */ -#if defined HAVE_XPM || defined USE_CAIRO || defined HAVE_NS +#if defined HAVE_XPM || defined USE_CAIRO || defined HAVE_NS || defined HAVE_HAIKU /* Indices of image specification fields in xpm_format, below. */ @@ -4056,7 +4152,7 @@ enum xpm_keyword_index XPM_LAST }; -#if defined HAVE_XPM || defined HAVE_NS +#if defined HAVE_XPM || defined HAVE_NS || defined HAVE_HAIKU /* Vector of image_keyword structures describing the format of valid XPM image specifications. */ @@ -4074,7 +4170,7 @@ static const struct image_keyword xpm_format[XPM_LAST] = {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#endif /* HAVE_XPM || HAVE_NS */ +#endif /* HAVE_XPM || HAVE_NS || HAVE_HAIKU */ #if defined HAVE_X_WINDOWS && !defined USE_CAIRO @@ -4298,7 +4394,7 @@ init_xpm_functions (void) #endif /* WINDOWSNT */ -#if defined HAVE_XPM || defined HAVE_NS +#if defined HAVE_XPM || defined HAVE_NS || defined HAVE_HAIKU /* Value is true if COLOR_SYMBOLS is a valid color symbols list for XPM images. Such a list must consist of conses whose car and cdr are strings. */ @@ -4334,9 +4430,9 @@ xpm_image_p (Lisp_Object object) && (! fmt[XPM_COLOR_SYMBOLS].count || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))); } -#endif /* HAVE_XPM || HAVE_NS */ +#endif /* HAVE_XPM || HAVE_NS || HAVE_HAIKU */ -#endif /* HAVE_XPM || USE_CAIRO || HAVE_NS */ +#endif /* HAVE_XPM || USE_CAIRO || HAVE_NS || HAVE_HAIKU */ #if defined HAVE_XPM && defined HAVE_X_WINDOWS && !defined USE_GTK ptrdiff_t @@ -4705,9 +4801,10 @@ xpm_load (struct frame *f, struct image *img) #endif /* HAVE_XPM && !USE_CAIRO */ #if (defined USE_CAIRO && defined HAVE_XPM) \ - || (defined HAVE_NS && !defined HAVE_XPM) + || (defined HAVE_NS && !defined HAVE_XPM) \ + || (defined HAVE_HAIKU && !defined HAVE_XPM) -/* XPM support functions for NS where libxpm is not available, and for +/* XPM support functions for NS and Haiku where libxpm is not available, and for Cairo. Only XPM version 3 (without any extensions) is supported. */ static void xpm_put_color_table_v (Lisp_Object, const char *, @@ -5444,7 +5541,7 @@ lookup_rgb_color (struct frame *f, int r, int g, int b) { #ifdef HAVE_NTGUI return PALETTERGB (r >> 8, g >> 8, b >> 8); -#elif defined USE_CAIRO || defined HAVE_NS +#elif defined USE_CAIRO || defined HAVE_NS || defined HAVE_HAIKU return RGB_TO_ULONG (r >> 8, g >> 8, b >> 8); #else xsignal1 (Qfile_error, @@ -5517,7 +5614,7 @@ image_to_emacs_colors (struct frame *f, struct image *img, bool rgb_p) p = colors; for (y = 0; y < img->height; ++y) { -#if !defined USE_CAIRO && !defined HAVE_NS +#if !defined USE_CAIRO && !defined HAVE_NS && !defined HAVE_HAIKU Emacs_Color *row = p; for (x = 0; x < img->width; ++x, ++p) p->pixel = GET_PIXEL (ximg, x, y); @@ -5525,7 +5622,7 @@ image_to_emacs_colors (struct frame *f, struct image *img, bool rgb_p) { FRAME_TERMINAL (f)->query_colors (f, row, img->width); } -#else /* USE_CAIRO || HAVE_NS */ +#else /* USE_CAIRO || HAVE_NS || HAVE_HAIKU */ for (x = 0; x < img->width; ++x, ++p) { p->pixel = GET_PIXEL (ximg, x, y); @@ -5839,6 +5936,7 @@ image_disable_image (struct frame *f, struct image *img) { #ifndef HAVE_NTGUI #ifndef HAVE_NS /* TODO: NS support, however this not needed for toolbars */ +#ifndef HAVE_HAIKU #ifndef USE_CAIRO #define CrossForeground(f) BLACK_PIX_DEFAULT (f) @@ -5856,6 +5954,7 @@ image_disable_image (struct frame *f, struct image *img) if (img->mask) image_pixmap_draw_cross (f, img->mask, 0, 0, img->width, img->height, MaskForeground (f)); +#endif /* !HAVE_HAIKU */ #endif /* !HAVE_NS */ #else HDC hdc, bmpdc; @@ -6413,6 +6512,8 @@ image_can_use_native_api (Lisp_Object type) return w32_can_use_native_image_api (type); # elif defined HAVE_NS return ns_can_use_native_image_api (type); +# elif defined HAVE_HAIKU + return haiku_can_use_native_image_api (type); # else return false; # endif @@ -6486,6 +6587,9 @@ native_image_load (struct frame *f, struct image *img) # elif defined HAVE_NS return ns_load_image (f, img, image_file, image_spec_value (img->spec, QCdata, NULL)); +# elif defined HAVE_HAIKU + return haiku_load_image (f, img, image_file, + image_spec_value (img->spec, QCdata, NULL)); # else return 0; # endif @@ -9635,7 +9739,8 @@ imagemagick_load_image (struct frame *f, struct image *img, init_color_table (); -#if defined (HAVE_MAGICKEXPORTIMAGEPIXELS) && ! defined (HAVE_NS) +#if defined (HAVE_MAGICKEXPORTIMAGEPIXELS) && \ + ! defined (HAVE_NS) && ! defined (HAVE_HAIKU) if (imagemagick_render_type != 0) { /* Magicexportimage is normally faster than pixelpushing. This @@ -10925,7 +11030,8 @@ The list of capabilities can include one or more of the following: if (FRAME_WINDOW_P (f)) { #ifdef HAVE_NATIVE_TRANSFORMS -# if defined HAVE_IMAGEMAGICK || defined (USE_CAIRO) || defined (HAVE_NS) +# if defined HAVE_IMAGEMAGICK || defined (USE_CAIRO) || defined (HAVE_NS) \ + || defined (HAVE_HAIKU) return list2 (Qscale, Qrotate90); # elif defined (HAVE_X_WINDOWS) && defined (HAVE_XRENDER) int event_basep, error_basep; @@ -11015,7 +11121,7 @@ static struct image_type const image_types[] = { SYMBOL_INDEX (Qjpeg), jpeg_image_p, jpeg_load, image_clear_image, IMAGE_TYPE_INIT (init_jpeg_functions) }, #endif -#if defined HAVE_XPM || defined HAVE_NS +#if defined HAVE_XPM || defined HAVE_NS || defined HAVE_HAIKU { SYMBOL_INDEX (Qxpm), xpm_image_p, xpm_load, image_clear_image, IMAGE_TYPE_INIT (init_xpm_functions) }, #endif @@ -11163,7 +11269,7 @@ non-numeric, there is no explicit limit on the size of images. */); DEFSYM (Qxbm, "xbm"); add_image_type (Qxbm); -#if defined (HAVE_XPM) || defined (HAVE_NS) +#if defined (HAVE_XPM) || defined (HAVE_NS) || defined (HAVE_HAIKU) DEFSYM (Qxpm, "xpm"); add_image_type (Qxpm); #endif diff --git a/src/keyboard.c b/src/keyboard.c index 0c48790ce8d..3722ba14cc5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3865,7 +3865,7 @@ kbd_buffer_get_event (KBOARD **kbp, /* One way or another, wait until input is available; then, if interrupt handlers have not read it, read it now. */ -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) gobble_input (); #endif if (kbd_fetch_ptr != kbd_store_ptr) @@ -6156,7 +6156,6 @@ make_lispy_event (struct input_event *event) case CONFIG_CHANGED_EVENT: return list3 (Qconfig_changed_event, event->arg, event->frame_or_window); - /* The 'kind' field of the event is something we don't recognize. */ default: emacs_abort (); @@ -7247,7 +7246,7 @@ totally_unblock_input (void) unblock_input_to (0); } -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) void handle_input_available_signal (int sig) @@ -7263,7 +7262,7 @@ deliver_input_available_signal (int sig) { deliver_process_signal (sig, handle_input_available_signal); } -#endif /* USABLE_SIGIO */ +#endif /* defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) */ /* User signal events. */ @@ -7333,7 +7332,7 @@ handle_user_signal (int sig) } p->npending++; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) if (interrupt_input) handle_input_available_signal (sig); else @@ -11103,7 +11102,7 @@ See also `current-input-mode'. */) (Lisp_Object interrupt) { bool new_interrupt_input; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) #ifdef HAVE_X_WINDOWS if (x_display_list != NULL) { @@ -11114,9 +11113,9 @@ See also `current-input-mode'. */) else #endif /* HAVE_X_WINDOWS */ new_interrupt_input = !NILP (interrupt); -#else /* not USABLE_SIGIO */ +#else /* not USABLE_SIGIO || USABLE_SIGPOLL */ new_interrupt_input = false; -#endif /* not USABLE_SIGIO */ +#endif /* not USABLE_SIGIO || USABLE_SIGPOLL */ if (new_interrupt_input != interrupt_input) { @@ -11545,12 +11544,16 @@ init_keyboard (void) sigaction (SIGQUIT, &action, 0); #endif /* not DOS_NT */ } -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) if (!noninteractive) { struct sigaction action; emacs_sigaction_init (&action, deliver_input_available_signal); +#ifdef USABLE_SIGIO sigaction (SIGIO, &action, 0); +#else + sigaction (SIGPOLL, &action, 0); +#endif } #endif diff --git a/src/lisp.h b/src/lisp.h index 31656bb3b1c..19caba40014 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -138,7 +138,12 @@ verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); buffers and strings. Emacs never allocates objects larger than PTRDIFF_MAX bytes, as they cause problems with pointer subtraction. In C99, pD can always be "t"; configure it here for the sake of - pre-C99 libraries such as glibc 2.0 and Solaris 8. */ + pre-C99 libraries such as glibc 2.0 and Solaris 8. + + On Haiku, the size of ptrdiff_t is inconsistent with the value of + PTRDIFF_MAX. In that case, "t" should be sufficient. */ + +#ifndef HAIKU #if PTRDIFF_MAX == INT_MAX # define pD "" #elif PTRDIFF_MAX == LONG_MAX @@ -148,6 +153,9 @@ verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); #else # define pD "t" #endif +#else +# define pD "t" +#endif /* Convenience macro for rarely-used functions that do not return. */ #define AVOID _Noreturn ATTRIBUTE_COLD void @@ -3330,7 +3338,7 @@ struct frame; /* Define if the windowing system provides a menu bar. */ #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \ - || defined (HAVE_NS) || defined (USE_GTK) + || defined (HAVE_NS) || defined (USE_GTK) || defined (HAVE_HAIKU) #define HAVE_EXT_MENU_BAR true #endif @@ -4429,7 +4437,7 @@ extern Lisp_Object menu_bar_items (Lisp_Object); extern Lisp_Object tab_bar_items (Lisp_Object, int *); extern Lisp_Object tool_bar_items (Lisp_Object, int *); extern void discard_mouse_events (void); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) void handle_input_available_signal (int); #endif extern Lisp_Object pending_funcalls; diff --git a/src/menu.c b/src/menu.c index 1aafa78c3ce..ab01e1bfad2 100644 --- a/src/menu.c +++ b/src/menu.c @@ -50,7 +50,8 @@ extern AppendMenuW_Proc unicode_append_menu; static bool have_boxes (void) { -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined(HAVE_NS) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined (HAVE_NS) \ + || defined (HAVE_HAIKU) if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))) return 1; #endif @@ -422,7 +423,8 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk AREF (item_properties, ITEM_PROPERTY_SELECTED), AREF (item_properties, ITEM_PROPERTY_HELP)); -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \ + || defined (HAVE_NTGUI) || defined (HAVE_HAIKU) /* Display a submenu using the toolkit. */ if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)) && ! (NILP (map) || NILP (enabled))) @@ -872,6 +874,10 @@ update_submenu_strings (widget_value *first_wv) } } +#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */ +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \ + || defined (HAVE_NTGUI) || defined (HAVE_HAIKU) + /* Find the menu selection and store it in the keyboard buffer. F is the frame the menu is on. MENU_BAR_ITEMS_USED is the length of VECTOR. @@ -959,7 +965,7 @@ find_and_call_menu_selection (struct frame *f, int menu_bar_items_used, SAFE_FREE (); } -#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */ +#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI || HAVE_HAIKU */ #ifdef HAVE_NS /* As above, but return the menu selection instead of storing in kb buffer. diff --git a/src/process.c b/src/process.c index a00426795b8..241ffe9a8dd 100644 --- a/src/process.c +++ b/src/process.c @@ -259,7 +259,7 @@ static bool process_output_skip; static void start_process_unwind (Lisp_Object); static void create_process (Lisp_Object, char **, Lisp_Object); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) static bool keyboard_bit_set (fd_set *); #endif static void deactivate_process (Lisp_Object); @@ -5730,7 +5730,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) /* If we think we have keyboard input waiting, but didn't get SIGIO, go read it. This can happen with X on BSD after logging out. In that case, there really is no input and no SIGIO, @@ -5738,7 +5738,11 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (read_kbd && interrupt_input && keyboard_bit_set (&Available) && ! noninteractive) +#ifdef USABLE_SIGIO handle_input_available_signal (SIGIO); +#else + handle_input_available_signal (SIGPOLL); +#endif #endif /* If checking input just got us a size-change event from X, @@ -7732,7 +7736,7 @@ delete_gpm_wait_descriptor (int desc) # endif -# ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) /* Return true if *MASK has a bit set that corresponds to one of the keyboard input descriptors. */ diff --git a/src/sound.c b/src/sound.c index 9041076bdc0..d42bc8550d3 100644 --- a/src/sound.c +++ b/src/sound.c @@ -299,11 +299,15 @@ sound_perror (const char *msg) int saved_errno = errno; turn_on_atimers (1); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) { sigset_t unblocked; sigemptyset (&unblocked); +#ifdef USABLE_SIGIO sigaddset (&unblocked, SIGIO); +#else + sigaddset (&unblocked, SIGPOLL); +#endif pthread_sigmask (SIG_UNBLOCK, &unblocked, 0); } #endif @@ -698,7 +702,7 @@ static void vox_configure (struct sound_device *sd) { int val; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t oldset, blocked; #endif @@ -708,9 +712,13 @@ vox_configure (struct sound_device *sd) interrupted by a signal. Block the ones we know to cause troubles. */ turn_on_atimers (0); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigemptyset (&blocked); +#ifdef USABLE_SIGIO sigaddset (&blocked, SIGIO); +#else + sigaddset (&blocked, SIGPOLL); +#endif pthread_sigmask (SIG_BLOCK, &blocked, &oldset); #endif @@ -744,7 +752,7 @@ vox_configure (struct sound_device *sd) } turn_on_atimers (1); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) pthread_sigmask (SIG_SETMASK, &oldset, 0); #endif } @@ -760,10 +768,14 @@ vox_close (struct sound_device *sd) /* On GNU/Linux, it seems that the device driver doesn't like to be interrupted by a signal. Block the ones we know to cause troubles. */ -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t blocked, oldset; sigemptyset (&blocked); +#ifdef USABLE_SIGIO sigaddset (&blocked, SIGIO); +#else + sigaddset (&blocked, SIGPOLL); +#endif pthread_sigmask (SIG_BLOCK, &blocked, &oldset); #endif turn_on_atimers (0); @@ -772,7 +784,7 @@ vox_close (struct sound_device *sd) ioctl (sd->fd, SNDCTL_DSP_SYNC, NULL); turn_on_atimers (1); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) pthread_sigmask (SIG_SETMASK, &oldset, 0); #endif diff --git a/src/sysdep.c b/src/sysdep.c index 8eaee224987..5e13dd097ec 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -678,6 +678,9 @@ sys_subshell (void) #ifdef USABLE_SIGIO saved_handlers[3].code = SIGIO; saved_handlers[4].code = 0; +#elif defined (USABLE_SIGPOLL) + saved_handlers[3].code = SIGPOLL; + saved_handlers[4].code = 0; #else saved_handlers[3].code = 0; #endif @@ -788,6 +791,7 @@ init_sigio (int fd) } #ifndef DOS_NT +#ifdef F_SETOWN static void reset_sigio (int fd) { @@ -795,12 +799,13 @@ reset_sigio (int fd) fcntl (fd, F_SETFL, old_fcntl_flags[fd]); #endif } +#endif /* F_SETOWN */ #endif void request_sigio (void) { -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t unblocked; if (noninteractive) @@ -810,7 +815,11 @@ request_sigio (void) # ifdef SIGWINCH sigaddset (&unblocked, SIGWINCH); # endif +# ifdef USABLE_SIGIO sigaddset (&unblocked, SIGIO); +# else + sigaddset (&unblocked, SIGPOLL); +# endif pthread_sigmask (SIG_UNBLOCK, &unblocked, 0); interrupts_deferred = 0; @@ -820,7 +829,7 @@ request_sigio (void) void unrequest_sigio (void) { -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t blocked; if (noninteractive) @@ -830,7 +839,11 @@ unrequest_sigio (void) # ifdef SIGWINCH sigaddset (&blocked, SIGWINCH); # endif +# ifdef USABLE_SIGIO sigaddset (&blocked, SIGIO); +# else + sigaddset (&blocked, SIGPOLL); +# endif pthread_sigmask (SIG_BLOCK, &blocked, 0); interrupts_deferred = 1; #endif @@ -1256,9 +1269,12 @@ init_sys_modes (struct tty_display_info *tty_out) /* This code added to insure that, if flow-control is not to be used, we have an unlocked terminal at the start. */ +#ifndef HAIKU /* On Haiku, TCXONC is a no-op and causes spurious + compiler warnings. */ #ifdef TCXONC if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TCXONC, 1); #endif +#endif /* HAIKU */ #ifdef TIOCSTART if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TIOCSTART, 0); #endif @@ -1674,6 +1690,8 @@ emacs_sigaction_init (struct sigaction *action, signal_handler_t handler) sigaddset (&action->sa_mask, SIGQUIT); #ifdef USABLE_SIGIO sigaddset (&action->sa_mask, SIGIO); +#elif defined (USABLE_SIGPOLL) + sigaddset (&action->sa_mask, SIGPOLL); #endif } @@ -2772,6 +2790,7 @@ static const struct speed_struct speeds[] = #ifdef B150 { 150, B150 }, #endif +#ifndef HAVE_TINY_SPEED_T #ifdef B200 { 200, B200 }, #endif @@ -2859,6 +2878,7 @@ static const struct speed_struct speeds[] = #ifdef B4000000 { 4000000, B4000000 }, #endif +#endif /* HAVE_TINY_SPEED_T */ }; /* Convert a numerical speed (e.g., 9600) to a Bnnn constant (e.g., @@ -3120,8 +3140,9 @@ list_system_processes (void) } /* The WINDOWSNT implementation is in w32.c. - The MSDOS implementation is in dosfns.c. */ -#elif !defined (WINDOWSNT) && !defined (MSDOS) + The MSDOS implementation is in dosfns.c. + The Haiku implementation is in haiku.c. */ +#elif !defined (WINDOWSNT) && !defined (MSDOS) && !defined (HAIKU) Lisp_Object list_system_processes (void) @@ -4200,8 +4221,9 @@ system_process_attributes (Lisp_Object pid) } /* The WINDOWSNT implementation is in w32.c. - The MSDOS implementation is in dosfns.c. */ -#elif !defined (WINDOWSNT) && !defined (MSDOS) + The MSDOS implementation is in dosfns.c. + The HAIKU implementation is in haiku.c. */ +#elif !defined (WINDOWSNT) && !defined (MSDOS) && !defined (HAIKU) Lisp_Object system_process_attributes (Lisp_Object pid) diff --git a/src/termhooks.h b/src/termhooks.h index b274be9e3cd..1cf9863f3a1 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -60,7 +60,8 @@ enum output_method output_x_window, output_msdos_raw, output_w32, - output_ns + output_ns, + output_haiku }; /* Input queue declarations and hooks. */ @@ -266,7 +267,6 @@ enum event_kind /* File or directory was changed. */ , FILE_NOTIFY_EVENT #endif - }; /* Bit width of an enum event_kind tag at the start of structs and unions. */ @@ -447,6 +447,7 @@ struct terminal struct x_display_info *x; /* xterm.h */ struct w32_display_info *w32; /* w32term.h */ struct ns_display_info *ns; /* nsterm.h */ + struct haiku_display_info *haiku; /* haikuterm.h */ } display_info; @@ -835,6 +836,9 @@ extern struct terminal *terminal_list; #elif defined (HAVE_NS) #define TERMINAL_FONT_CACHE(t) \ (t->type == output_ns ? t->display_info.ns->name_list_element : Qnil) +#elif defined (HAVE_HAIKU) +#define TERMINAL_FONT_CACHE(t) \ + (t->type == output_haiku ? t->display_info.haiku->name_list_element : Qnil) #endif extern struct terminal *decode_live_terminal (Lisp_Object); diff --git a/src/terminal.c b/src/terminal.c index b83adc596bb..b5f244ee318 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -445,6 +445,8 @@ possible return values. */) return Qpc; case output_ns: return Qns; + case output_haiku: + return Qhaiku; default: emacs_abort (); } diff --git a/src/verbose.mk.in b/src/verbose.mk.in index a5ff931ed09..9252971acc3 100644 --- a/src/verbose.mk.in +++ b/src/verbose.mk.in @@ -23,7 +23,9 @@ ifeq (${V},1) AM_V_AR = AM_V_at = AM_V_CC = +AM_V_CXX = AM_V_CCLD = +AM_V_CXXLD = AM_V_ELC = AM_V_ELN = AM_V_GEN = @@ -34,7 +36,9 @@ else AM_V_AR = @echo " AR " $@; AM_V_at = @ AM_V_CC = @echo " CC " $@; +AM_V_CXX = @echo " CXX " $@; AM_V_CCLD = @echo " CCLD " $@; +AM_V_CXXLD = @echo " CXXLD " $@; ifeq ($(HAVE_NATIVE_COMP),yes) ifeq ($(NATIVE_DISABLED),1) AM_V_ELC = @echo " ELC " $@; diff --git a/src/xdisp.c b/src/xdisp.c index 6c70ce60bb5..8d34b7c4c30 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -15657,6 +15657,11 @@ redisplay_internal (void) } #endif +#if defined (HAVE_HAIKU) + if (popup_activated_p) + return; +#endif + /* I don't think this happens but let's be paranoid. */ if (redisplaying_p) return; @@ -25247,6 +25252,11 @@ display_menu_bar (struct window *w) return; #endif /* HAVE_NS */ +#ifdef HAVE_HAIKU + if (FRAME_HAIKU_P (f)) + return; +#endif /* HAVE_HAIKU */ + #if defined (USE_X_TOOLKIT) || defined (USE_GTK) eassert (!FRAME_WINDOW_P (f)); init_iterator (&it, w, -1, -1, f->desired_matrix->rows, MENU_FACE_ID); @@ -33698,6 +33708,11 @@ note_mouse_highlight (struct frame *f, int x, int y) return; #endif +#if defined (HAVE_HAIKU) + if (popup_activated_p) + return; +#endif + if (!f->glyphs_initialized_p || f->pointer_invisible) return; diff --git a/src/xfaces.c b/src/xfaces.c index d0d73eb8286..fec6b2654b1 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -246,6 +246,10 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_NS #define GCGraphicsExposures 0 #endif /* HAVE_NS */ + +#ifdef HAVE_HAIKU +#define GCGraphicsExposures 0 +#endif /* HAVE_HAIKU */ #endif /* HAVE_WINDOW_SYSTEM */ #include "buffer.h" @@ -555,8 +559,8 @@ x_free_gc (struct frame *f, Emacs_GC *gc) #endif /* HAVE_NTGUI */ -#ifdef HAVE_NS -/* NS emulation of GCs */ +#if defined (HAVE_NS) || defined (HAVE_HAIKU) +/* NS and Haiku emulation of GCs */ static Emacs_GC * x_create_gc (struct frame *f, diff --git a/src/xfns.c b/src/xfns.c index 0ea43d13306..a142f5518cc 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4461,7 +4461,8 @@ For GNU and Unix system, the first 2 numbers are the version of the X Protocol used on TERMINAL and the 3rd number is the distributor-specific release number. For MS Windows, the 3 numbers report the OS major and minor version and build number. For Nextstep, the first 2 numbers are -hard-coded and the 3rd represents the OS version. +hard-coded and the 3rd represents the OS version. For Haiku, all 3 +numbers are hard-coded. See also the function `x-server-vendor'. @@ -7419,7 +7420,7 @@ Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if specified. If MUSTMATCH is non-nil, the returned file or directory must exist. -This function is defined only on NS, MS Windows, and X Windows with the +This function is defined only on NS, Haiku, MS Windows, and X Windows with the Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. Otherwise, if ONLY-DIR-P is non-nil, the user can select only directories. On MS Windows 7 and later, the file selection dialog "remembers" the last diff --git a/src/xterm.c b/src/xterm.c index 18f8a6062f8..9e5aed996ae 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14959,7 +14959,7 @@ selected window or cursor position is preserved. */); A value of nil means Emacs doesn't use toolkit scroll bars. With the X Window system, the value is a symbol describing the X toolkit. Possible values are: gtk, motif, xaw, or xaw3d. -With MS Windows or Nextstep, the value is t. */); +With MS Windows, Haiku windowing or Nextstep, the value is t. */); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_MOTIF Vx_toolkit_scroll_bars = intern_c_string ("motif"); From 7e437af41319330ddade02d9784cf78c8e6674d8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Nov 2021 18:17:59 +0200 Subject: [PATCH 177/367] Fix temacs invocation from outside of the 'src' directory * src/emacs.c (main) [HAVE_NATIVE_COMP]: Recompute the value of native-comp-eln-load-path if about to load loadup in uninitialized Emacs. (Bug#51999) --- src/emacs.c | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/emacs.c b/src/emacs.c index 866e43fda94..41c92a46155 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2284,6 +2284,17 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem /* Unless next switch is -nl, load "loadup.el" first thing. */ if (! no_loadup) Vtop_level = list2 (Qload, build_string ("loadup.el")); + +#ifdef HAVE_NATIVE_COMP + /* If we are going to load stuff in a non-initialized Emacs, + update the value of native-comp-eln-load-path, so that the + *.eln files will be found if they are there. */ + if (!NILP (Vtop_level) && !temacs) + Vnative_comp_eln_load_path = + Fcons (Fexpand_file_name (XCAR (Vnative_comp_eln_load_path), + Vinvocation_directory), + Qnil); +#endif } /* Set up for profiling. This is known to work on FreeBSD, From e3d5337970585d1e47a4942048edf8261ad5b781 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Nov 2021 20:08:06 +0200 Subject: [PATCH 178/367] Fix mouse handling with several TTY frames on MS-Windows * src/w32inevt.c (do_mouse_event): Reset the 'mouse_moved' flag of the selected frame. Without that, this flag might remain set on a TTY frame that is not displayed. --- src/w32inevt.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/w32inevt.c b/src/w32inevt.c index 9a69b32bcb0..894bc3ab089 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -470,6 +470,9 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, DWORD but_change, mask, flags = event->dwEventFlags; int i; + /* Mouse didn't move unless MOUSE_MOVED says it did. */ + SELECTED_FRAME ()->mouse_moved = 0; + switch (flags) { case MOUSE_MOVED: From 0dd3883defc04ea02d2f77d79debf4e18157500d Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 20 Nov 2021 13:12:18 -0500 Subject: [PATCH 179/367] Update to Org 9.5-72-gc5d6656 --- lisp/org/org-goto.el | 67 ++++++++++++++++++++-------------------- lisp/org/org-version.el | 2 +- lisp/org/ox-icalendar.el | 6 ++++ 3 files changed, 40 insertions(+), 35 deletions(-) diff --git a/lisp/org/org-goto.el b/lisp/org/org-goto.el index 0a3470f5451..352bf9f2e52 100644 --- a/lisp/org/org-goto.el +++ b/lisp/org/org-goto.el @@ -203,40 +203,39 @@ When nil, you can use these keybindings to navigate the buffer: "Let the user select a location in current buffer. This function uses a recursive edit. It returns the selected position or nil." - (org-no-popups - (let ((isearch-mode-map org-goto-local-auto-isearch-map) - (isearch-hide-immediately nil) - (isearch-search-fun-function - (lambda () #'org-goto--local-search-headings)) - (help (or help org-goto-help))) - (save-excursion - (save-window-excursion - (delete-other-windows) - (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (pop-to-buffer-same-window - (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*" t) - (error (make-indirect-buffer (current-buffer) "*org-goto*" t)))) - (let (temp-buffer-show-function temp-buffer-show-hook) - (with-output-to-temp-buffer "*Org Help*" - (princ (format help (if org-goto-auto-isearch - " Just type for auto-isearch." - " n/p/f/b/u to navigate, q to quit."))))) - (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) - (org-overview) - (setq buffer-read-only t) - (if (and (boundp 'org-goto-start-pos) - (integer-or-marker-p org-goto-start-pos)) - (progn (goto-char org-goto-start-pos) - (when (org-invisible-p) - (org-show-set-visibility 'lineage))) - (goto-char (point-min))) - (let (org-special-ctrl-a/e) (org-beginning-of-line)) - (message "Select location and press RET") - (use-local-map org-goto-map) - (recursive-edit))) - (kill-buffer "*org-goto*") - (cons org-goto-selected-point org-goto-exit-command)))) + (let ((isearch-mode-map org-goto-local-auto-isearch-map) + (isearch-hide-immediately nil) + (isearch-search-fun-function + (lambda () #'org-goto--local-search-headings)) + (help (or help org-goto-help))) + (save-excursion + (save-window-excursion + (delete-other-windows) + (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) + (pop-to-buffer-same-window + (condition-case nil + (make-indirect-buffer (current-buffer) "*org-goto*" t) + (error (make-indirect-buffer (current-buffer) "*org-goto*" t)))) + (let (temp-buffer-show-function temp-buffer-show-hook) + (with-output-to-temp-buffer "*Org Help*" + (princ (format help (if org-goto-auto-isearch + " Just type for auto-isearch." + " n/p/f/b/u to navigate, q to quit."))))) + (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) + (org-overview) + (setq buffer-read-only t) + (if (and (boundp 'org-goto-start-pos) + (integer-or-marker-p org-goto-start-pos)) + (progn (goto-char org-goto-start-pos) + (when (org-invisible-p) + (org-show-set-visibility 'lineage))) + (goto-char (point-min))) + (let (org-special-ctrl-a/e) (org-beginning-of-line)) + (message "Select location and press RET") + (use-local-map org-goto-map) + (recursive-edit))) + (kill-buffer "*org-goto*") + (cons org-goto-selected-point org-goto-exit-command))) ;;;###autoload (defun org-goto (&optional alternative-interface) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 6427f30072e..77b1cf4e5ff 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5-68-g77e2ec")) + (let ((org-git-version "release_9.5-72-gc5d6656")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index 9170059156d..081a28317f6 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -280,6 +280,7 @@ re-read the iCalendar file.") (footnote-definition . ignore) (footnote-reference . ignore) (headline . org-icalendar-entry) + (inner-template . org-icalendar-inner-template) (inlinetask . ignore) (planning . ignore) (section . ignore) @@ -805,6 +806,11 @@ END:VALARM\n" ;;;; Template +(defun org-icalendar-inner-template (contents _) + "Return document body string after iCalendar conversion. +CONTENTS is the transcoded contents string." + contents) + (defun org-icalendar-template (contents info) "Return complete document string after iCalendar conversion. CONTENTS is the transcoded contents string. INFO is a plist used From 33e994415d7e8b5779dabbac53bcefdb7d8d0ea8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Nov 2021 20:05:52 +0100 Subject: [PATCH 180/367] Revert last change on emba files --- test/infra/gitlab-ci.yml | 2 +- test/infra/test-jobs-generator.sh | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index d53133d8acd..ebfe9965139 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -32,7 +32,7 @@ stages: - generator - trigger # - fast - - normal +# - normal - platform-images - platforms - native-comp-images diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh index 67205b383ba..0636d8c8c22 100755 --- a/test/infra/test-jobs-generator.sh +++ b/test/infra/test-jobs-generator.sh @@ -60,7 +60,7 @@ EOF cat < Date: Sat, 20 Nov 2021 21:50:20 +0100 Subject: [PATCH 181/367] * test/infra/test-jobs-generator.sh: Generate also stages entry. --- test/infra/test-jobs-generator.sh | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh index 0636d8c8c22..c40570cbc30 100755 --- a/test/infra/test-jobs-generator.sh +++ b/test/infra/test-jobs-generator.sh @@ -56,6 +56,9 @@ for subdir in $SUBDIRS; do include: - local: '/test/infra/default-gitlab-ci.yml' +stages: + - test + EOF cat < Date: Sun, 21 Nov 2021 09:22:31 +0800 Subject: [PATCH 182/367] Add XInput 2 input method support * src/xterm.c (handle_one_xevent): Let input methods filter events first before trying to handle an XI2 key press event. --- src/xterm.c | 145 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 102 insertions(+), 43 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 9e5aed996ae..6a35b11d054 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10350,6 +10350,104 @@ handle_one_xevent (struct x_display_info *dpyinfo, = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), state); inev.ie.timestamp = xev->time; +#ifdef HAVE_X_I18N + XKeyPressedEvent xkey; + + memset (&xkey, 0, sizeof xkey); + + xkey.type = KeyPress; + xkey.serial = 0; + xkey.send_event = xev->send_event; + xkey.display = xev->display; + xkey.window = xev->event; + xkey.root = xev->root; + xkey.subwindow = xev->child; + xkey.time = xev->time; + xkey.state = state; + xkey.keycode = keycode; + xkey.same_screen = True; + + if (x_filter_event (dpyinfo, (XEvent *) &xkey)) + goto xi_done_keysym; + + if (FRAME_XIC (f)) + { + Status status_return; + nbytes = XmbLookupString (FRAME_XIC (f), + &xkey, (char *) copy_bufptr, + copy_bufsiz, &keysym, + &status_return); + + if (status_return == XBufferOverflow) + { + copy_bufsiz = nbytes + 1; + copy_bufptr = alloca (copy_bufsiz); + nbytes = XmbLookupString (FRAME_XIC (f), + &xkey, (char *) copy_bufptr, + copy_bufsiz, &keysym, + &status_return); + } + + if (status_return == XLookupNone) + goto xi_done_keysym; + else if (status_return == XLookupChars) + { + keysym = NoSymbol; + state = 0; + } + else if (status_return != XLookupKeySym + && status_return != XLookupBoth) + emacs_abort (); + } + else + { +#endif +#ifdef HAVE_XKB + int overflow = 0; + KeySym sym = keysym; + + if (dpyinfo->xkb_desc) + { + if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz, &overflow))) + goto XI_OTHER; + } + else +#else + { + block_input (); + char *str = XKeysymToString (keysym); + if (!str) + { + unblock_input (); + goto XI_OTHER; + } + nbytes = strlen (str) + 1; + copy_bufptr = alloca (nbytes); + strcpy (copy_bufptr, str); + unblock_input (); + } +#endif +#ifdef HAVE_XKB + if (overflow) + { + overflow = 0; + copy_bufptr = alloca (copy_bufsiz + overflow); + keysym = sym; + if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz + overflow, &overflow))) + goto XI_OTHER; + + if (overflow) + goto XI_OTHER; + } +#endif +#ifdef HAVE_X_I18N + } +#endif + /* First deal with keysyms which have defined translations to characters. */ if (keysym >= 32 && keysym < 128) @@ -10466,49 +10564,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto xi_done_keysym; } -#ifdef HAVE_XKB - int overflow = 0; - KeySym sym = keysym; - - if (dpyinfo->xkb_desc) - { - if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, - state & ~mods_rtrn, copy_bufptr, - copy_bufsiz, &overflow))) - goto XI_OTHER; - } - else -#else - { - block_input (); - char *str = XKeysymToString (keysym); - if (!str) - { - unblock_input (); - goto XI_OTHER; - } - nbytes = strlen (str) + 1; - copy_bufptr = alloca (nbytes); - strcpy (copy_bufptr, str); - unblock_input (); - } -#endif -#ifdef HAVE_XKB - if (overflow) - { - overflow = 0; - copy_bufptr = alloca (copy_bufsiz + overflow); - keysym = sym; - if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, - state & ~mods_rtrn, copy_bufptr, - copy_bufsiz + overflow, &overflow))) - goto XI_OTHER; - - if (overflow) - goto XI_OTHER; - } -#endif - for (i = 0, nchars = 0; i < nbytes; i++) { if (ASCII_CHAR_P (copy_bufptr[i])) @@ -10574,6 +10629,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; } xi_done_keysym: +#ifdef HAVE_X_I18N + if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) + xic_set_statusarea (f); +#endif if (must_free_data) XFreeEventData (dpyinfo->display, &event->xcookie); goto done_keysym; From f16bb8693f0122cea447edc243885428a4b8d370 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 09:32:46 +0800 Subject: [PATCH 183/367] Select device notification events correctly * src/xfns.c (setup_xi_event_mask): Select PropertyEvent, HierarchyChanged and DeviceChanged for all devices. --- src/xfns.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/xfns.c b/src/xfns.c index a142f5518cc..5eff9f5b0f8 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2938,6 +2938,13 @@ setup_xi_event_mask (struct frame *f) XISetMask (m, XI_Leave); XISetMask (m, XI_FocusIn); XISetMask (m, XI_FocusOut); + XISelectEvents (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + &mask, 1); + + memset (m, 0, l); + mask.deviceid = XIAllDevices; + XISetMask (m, XI_PropertyEvent); XISetMask (m, XI_HierarchyChanged); XISetMask (m, XI_DeviceChanged); From 39f3604e229ff349742dab0d6a5c7b4500530c07 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 11:04:29 +0800 Subject: [PATCH 184/367] Allow handling smooth scroll events in xwidgets * src/xterm.c (handle_one_xevent): Pass through XI2 motion events to xwidgets. * src/xterm.c (xwidget_button): Don't handle legacy scroll events on XInput 2. (xwidget_motion_notify, xwidget_scroll): New functions. --- src/xterm.c | 32 ++++++++++++++ src/xwidget.c | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/xwidget.h | 6 +++ 3 files changed, 151 insertions(+) diff --git a/src/xterm.c b/src/xterm.c index 6a35b11d054..b78cfa70531 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9927,6 +9927,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_display_set_last_user_time (dpyinfo, xi_event->time); +#ifdef HAVE_XWIDGETS + struct xwidget_view *xv = xwidget_view_from_window (xev->event); + double xv_total_x = 0.0; + double xv_total_y = 0.0; +#endif + for (int i = 0; i < states->mask_len * 8; i++) { if (XIMaskIsSet (states->mask, i)) @@ -9939,6 +9945,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (delta != DBL_MAX) { +#ifdef HAVE_XWIDGETS + if (xv) + { + if (val->horizontal) + xv_total_x += delta; + else + xv_total_y += -delta; + + found_valuator = true; + continue; + } +#endif if (!f) { f = x_any_window_to_frame (dpyinfo, xev->event); @@ -9999,6 +10017,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = NO_EVENT; } +#ifdef HAVE_XWIDGETS + if (xv) + { + if (found_valuator) + xwidget_scroll (xv, xev->event_x, xev->event_y, + xv_total_x, xv_total_y, xev->mods.effective, + xev->time); + else + xwidget_motion_notify (xv, xev->event_x, xev->event_y, + xev->mods.effective, xev->time); + + goto XI_OTHER; + } +#endif if (found_valuator) goto XI_OTHER; diff --git a/src/xwidget.c b/src/xwidget.c index 1ab953d3c82..35e359458bc 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -40,10 +40,15 @@ along with GNU Emacs. If not, see . */ #include #include #include +#ifdef HAVE_XINPUT2 +#include +#endif #elif defined NS_IMPL_COCOA #include "nsxwidget.h" #endif +#include + static Lisp_Object id_to_xwidget_map; static Lisp_Object internal_xwidget_view_list; static Lisp_Object internal_xwidget_list; @@ -912,7 +917,12 @@ xwidget_button (struct xwidget_view *view, if (button < 4 || button > 8) xwidget_button_1 (view, down_p, x, y, button, modifier_state, time); +#ifndef HAVE_XINPUT2 else +#else + else if (!FRAME_DISPLAY_INFO (view->frame)->supports_xi2 + || FRAME_DISPLAY_INFO (view->frame)->xi2_version < 1) +#endif { GdkEvent *xg_event = gdk_event_new (GDK_SCROLL); struct xwidget *model = XXWIDGET (view->model); @@ -955,6 +965,93 @@ xwidget_button (struct xwidget_view *view, } } +#ifdef HAVE_XINPUT2 +void +xwidget_motion_notify (struct xwidget_view *view, + double x, double y, uint state, Time time) +{ + GdkEvent *xg_event; + GtkWidget *target; + struct xwidget *model = XXWIDGET (view->model); + int target_x, target_y; + + if (NILP (model->buffer)) + return; + + record_osr_embedder (view); + + target = find_widget_at_pos (model->widgetwindow_osr, + lrint (x), lrint (y), + &target_x, &target_y); + + if (!target) + { + target_x = lrint (x); + target_y = lrint (y); + target = model->widget_osr; + } + + xg_event = gdk_event_new (GDK_MOTION_NOTIFY); + xg_event->any.window = gtk_widget_get_window (target); + xg_event->motion.x = target_x; + xg_event->motion.y = target_y; + xg_event->motion.x_root = lrint (x); + xg_event->motion.y_root = lrint (y); + xg_event->motion.time = time; + xg_event->motion.state = state; + xg_event->motion.device = find_suitable_pointer (view->frame); + + g_object_ref (xg_event->any.window); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +} + +void +xwidget_scroll (struct xwidget_view *view, double x, double y, + double dx, double dy, uint state, Time time) +{ + GdkEvent *xg_event; + GtkWidget *target; + struct xwidget *model = XXWIDGET (view->model); + int target_x, target_y; + + if (NILP (model->buffer)) + return; + + record_osr_embedder (view); + + target = find_widget_at_pos (model->widgetwindow_osr, + lrint (x), lrint (y), + &target_x, &target_y); + + if (!target) + { + target_x = lrint (x); + target_y = lrint (y); + target = model->widget_osr; + } + + xg_event = gdk_event_new (GDK_SCROLL); + xg_event->any.window = gtk_widget_get_window (target); + xg_event->scroll.direction = GDK_SCROLL_SMOOTH; + xg_event->scroll.x = target_x; + xg_event->scroll.y = target_y; + xg_event->scroll.x_root = lrint (x); + xg_event->scroll.y_root = lrint (y); + xg_event->scroll.time = time; + xg_event->scroll.state = state; + xg_event->scroll.delta_x = dx; + xg_event->scroll.delta_y = dy; + xg_event->scroll.device = find_suitable_pointer (view->frame); + + g_object_ref (xg_event->any.window); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +} +#endif + void xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) { @@ -1705,6 +1802,22 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) clip_bottom - clip_top, 0, CopyFromParent, CopyFromParent, CopyFromParent, CWEventMask, &a); +#ifdef HAVE_XINPUT2 + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + if (FRAME_DISPLAY_INFO (s->f)->supports_xi2) + { + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + mask.deviceid = XIAllMasterDevices; + + XISetMask (m, XI_Motion); + XISelectEvents (xv->dpy, xv->wdesc, &mask, 1); + } +#endif XLowerWindow (xv->dpy, xv->wdesc); XDefineCursor (xv->dpy, xv->wdesc, xv->cursor); xv->cr_surface = cairo_xlib_surface_create (xv->dpy, diff --git a/src/xwidget.h b/src/xwidget.h index 78fe865dd84..f2d497c0920 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -195,6 +195,12 @@ extern void xwidget_button (struct xwidget_view *, bool, int, int, int, int, Time); extern void xwidget_motion_or_crossing (struct xwidget_view *, const XEvent *); +#ifdef HAVE_XINPUT2 +extern void xwidget_motion_notify (struct xwidget_view *, double, + double, uint, Time); +extern void xwidget_scroll (struct xwidget_view *, double, double, + double, double, uint, Time); +#endif #endif #else INLINE_HEADER_BEGIN From b6570602cca3fffd8adcd05dadb1d64d2b1442bd Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 11:14:14 +0800 Subject: [PATCH 185/367] Attach download-started signals to correct WebKit context * src/xwidget.c (Fmake_xwidget): Use correct context. --- src/xwidget.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index 35e359458bc..b0ff142bc73 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -197,6 +197,10 @@ fails. */) xw->widget_osr = webkit_web_view_new_with_context (ctx); g_object_unref (ctx); + g_signal_connect (G_OBJECT (ctx), + "download-started", + G_CALLBACK (webkit_download_cb), xw); + webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), "about:blank"); /* webkitgtk uses GSubprocess which sets sigaction causing @@ -252,10 +256,6 @@ fails. */) "load-changed", G_CALLBACK (webkit_view_load_changed_cb), xw); - g_signal_connect (G_OBJECT (webkit_context), - "download-started", - G_CALLBACK (webkit_download_cb), xw); - g_signal_connect (G_OBJECT (xw->widget_osr), "decide-policy", G_CALLBACK From 677859b7af143e3bb2f8f15bb47ff7b7773dc955 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 03:40:36 +0000 Subject: [PATCH 186/367] Add pixel delta support for wheel events on Haiku * src/haiku_support.cc (EmacsWindow.MessageReceived): Stop adjusting scroll deltas. * src/haikuterm.c (haiku_read_socket): Handle pixel deltas correctly. --- src/haiku_support.cc | 4 ++-- src/haikuterm.c | 32 ++++++++++++++------------------ 2 files changed, 16 insertions(+), 20 deletions(-) diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 99d4ee79140..5f9fe7e234f 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -631,8 +631,8 @@ class EmacsWindow : public BDirectWindow if (msg->FindFloat ("be:wheel_delta_x", &dx) == B_OK && msg->FindFloat ("be:wheel_delta_y", &dy) == B_OK) { - rq.delta_x = dx * 10; - rq.delta_y = dy * 10; + rq.delta_x = dx; + rq.delta_y = dy; haiku_write (WHEEL_MOVE_EVENT, &rq); }; diff --git a/src/haikuterm.c b/src/haikuterm.c index 05fbd1021b8..6b3c5dbe483 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3005,34 +3005,26 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (signbit (py) != signbit (b->delta_y)) py = 0; - px += b->delta_x; - py += b->delta_y; + px += b->delta_x * pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); + py += b->delta_y * pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); - if (fabsf (py) >= FRAME_LINE_HEIGHT (f)) + if (fabsf (py) >= FRAME_LINE_HEIGHT (f) + || fabsf (px) >= FRAME_COLUMN_WIDTH (f) + || !x_coalesce_scroll_events) { - inev.kind = WHEEL_EVENT; + inev.kind = (fabsf (px) > fabs (py) + ? HORIZ_WHEEL_EVENT + : WHEEL_EVENT); inev.code = 0; XSETINT (inev.x, x); XSETINT (inev.y, y); - XSETINT (inev.arg, lrint (fabsf (py) / FRAME_LINE_HEIGHT (f))); + inev.arg = list3 (Qnil, make_float (px), + make_float (py)); XSETFRAME (inev.frame_or_window, f); inev.modifiers |= signbit (py) ? up_modifier : down_modifier; py = 0.0f; - } - - if (fabsf (px) >= FRAME_COLUMN_WIDTH (f)) - { - inev2.kind = HORIZ_WHEEL_EVENT; - inev2.code = 0; - - XSETINT (inev2.x, x); - XSETINT (inev2.y, y); - XSETINT (inev2.arg, lrint (fabsf (px) / FRAME_COLUMN_WIDTH (f))); - XSETFRAME (inev2.frame_or_window, f); - - inev2.modifiers |= signbit (px) ? up_modifier : down_modifier; px = 0.0f; } @@ -3548,6 +3540,10 @@ syms_of_haikuterm (void) doc: /* SKIP: real doc in xterm.c. */); Vx_toolkit_scroll_bars = Qt; + DEFVAR_BOOL ("x-coalesce-scroll-events", x_coalesce_scroll_events, + doc: /* SKIP: real doc in xterm.c. */); + x_coalesce_scroll_events = true; + DEFVAR_BOOL ("haiku-debug-on-fatal-error", haiku_debug_on_fatal_error, doc: /* If non-nil, Emacs will launch the system debugger upon a fatal error. */); haiku_debug_on_fatal_error = 1; From a81fbf83672d275ae693b7cb7c00cb52155f4d7b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 03:48:27 +0000 Subject: [PATCH 187/367] Fix compiler warnings * src/haikuterm.c (haiku_read_socket): Fix compiler warnings intoduced by last change. --- src/haikuterm.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/haikuterm.c b/src/haikuterm.c index 6b3c5dbe483..6304d9bcd3c 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3005,14 +3005,16 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (signbit (py) != signbit (b->delta_y)) py = 0; - px += b->delta_x * pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); - py += b->delta_y * pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); + px += (b->delta_x + * powf (FRAME_PIXEL_HEIGHT (f), 2.0f / 3.0f)); + py += (b->delta_y + * powf (FRAME_PIXEL_HEIGHT (f), 2.0f / 3.0f)); if (fabsf (py) >= FRAME_LINE_HEIGHT (f) || fabsf (px) >= FRAME_COLUMN_WIDTH (f) || !x_coalesce_scroll_events) { - inev.kind = (fabsf (px) > fabs (py) + inev.kind = (fabsf (px) > fabsf (py) ? HORIZ_WHEEL_EVENT : WHEEL_EVENT); inev.code = 0; From 890fd7760c5f709feb5a0533ebe89a6fec5709a8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 13:32:03 +0800 Subject: [PATCH 188/367] Add a user command to stop page loading in xwidget-webkit * lisp/xwidget.el: Add `xwidget-webkit-stop' to menu. (xwidget-webkit-stop): New command. (xwidget-webkit-tool-bar-map): New tool bar item. --- lisp/xwidget.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 5b465dad3d5..160da67cb21 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -59,6 +59,7 @@ (declare-function xwidget-webkit-estimated-load-progress "xwidget.c" (xwidget)) (declare-function xwidget-webkit-set-cookie-storage-file "xwidget.c" (xwidget file)) (declare-function xwidget-live-p "xwidget.c" (xwidget)) +(declare-function xwidget-webkit-stop-loading "xwidget.c" (xwidget)) (defgroup xwidget nil "Displaying native widgets in Emacs buffers." @@ -256,11 +257,17 @@ for the actual events that will be sent." :help "Save the browser's selection in the kill ring"] ["Incremental Search" xwidget-webkit-isearch-mode :active (not xwidget-webkit-isearch-mode) - :help "Perform incremental search inside the WebKit widget"])) + :help "Perform incremental search inside the WebKit widget"] + ["Stop Loading" xwidget-webkit-stop + :active xwidget-webkit--loading-p])) (defvar xwidget-webkit-tool-bar-map (let ((map (make-sparse-keymap))) (prog1 map + (tool-bar-local-item-from-menu 'xwidget-webkit-stop + "cancel" + map + xwidget-webkit-mode-map) (tool-bar-local-item-from-menu 'xwidget-webkit-back "left-arrow" map @@ -561,6 +568,10 @@ The latter might be nil." (let ((size (xwidget-size-request xw))) (xwidget-resize xw (car size) (cadr size)))) +(defun xwidget-webkit-stop () + "Stop trying to load the current page." + (interactive) + (xwidget-webkit-stop-loading (xwidget-webkit-current-session))) (defvar xwidget-webkit-activeelement-js" function findactiveelement(doc){ From f0507192826070ca0070c0c5ce4ac80c8b32313d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 05:37:50 +0000 Subject: [PATCH 189/367] Improve Haiku documentation * doc/emacs/haiku.texi: Remove duplicate text and extraneous pxref. --- doc/emacs/haiku.texi | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/doc/emacs/haiku.texi b/doc/emacs/haiku.texi index a2dc6e14d0e..551599dfa80 100644 --- a/doc/emacs/haiku.texi +++ b/doc/emacs/haiku.texi @@ -56,9 +56,6 @@ the system, and those known to Emacs. The variables that allow for that are described below. @cindex modifier key customization (Haiku) -You can customize which Emacs modifiers the various system modifier -keys correspond to through the following variables: - @table @code @vindex haiku-meta-keysym @item haiku-meta-keysym @@ -126,8 +123,7 @@ several different font backends. You can specify font backends by specifying @kbd{-xrm Emacs.fontBackend:BACKEND} on the command line used to invoke Emacs, where @kbd{BACKEND} is one of the backends specified below, or on a per-frame basis by changing the -@code{font-backend} frame parameter. (@pxref{Parameter Access,,, -elisp, The Emacs Lisp Reference Manual}). +@code{font-backend} frame parameter. Two of these backends, @code{ftcr} and @code{ftcrhb} are identical to their counterparts on the X Window System. There is also a From f2730520ce3159704801e7cd459e2971c191c5a3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 21 Nov 2021 09:52:43 +0200 Subject: [PATCH 190/367] Improve the fix for bug#51864 * src/xfaces.c (face_at_buffer_position): Call FACE_FROM_ID_OR_NULL just once. (face_at_string_position): Make sure we have a usable base face. --- src/xfaces.c | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/xfaces.c b/src/xfaces.c index fec6b2654b1..174a1ca47c9 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4841,7 +4841,7 @@ lookup_named_face (struct window *w, struct frame *f, /* Return the display face-id of the basic face whose canonical face-id is FACE_ID. The return value will usually simply be FACE_ID, unless that - basic face has bee remapped via Vface_remapping_alist. This function is + basic face has been remapped via Vface_remapping_alist. This function is conservative: if something goes wrong, it will simply return FACE_ID rather than signal an error. Window W, if non-NULL, is used to filter face specifications for remapping. */ @@ -6372,20 +6372,16 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, int face_id; if (base_face_id >= 0) - { - face_id = base_face_id; - /* Make sure the base face ID is usable: if someone freed the - cached faces since we've looked up the base face, we need - to look it up again. */ - if (!FACE_FROM_ID_OR_NULL (f, face_id)) - face_id = lookup_basic_face (w, f, DEFAULT_FACE_ID); - } + face_id = base_face_id; else if (NILP (Vface_remapping_alist)) face_id = DEFAULT_FACE_ID; else face_id = lookup_basic_face (w, f, DEFAULT_FACE_ID); default_face = FACE_FROM_ID_OR_NULL (f, face_id); + /* Make sure the default face ID is usable: if someone freed the + cached faces since we've looked up these faces, we need to look + them up again. */ if (!default_face) default_face = FACE_FROM_ID (f, lookup_basic_face (w, f, DEFAULT_FACE_ID)); @@ -6573,7 +6569,9 @@ face_at_string_position (struct window *w, Lisp_Object string, else *endptr = -1; - base_face = FACE_FROM_ID (f, base_face_id); + base_face = FACE_FROM_ID_OR_NULL (f, base_face_id); + if (!base_face) + base_face = FACE_FROM_ID (f, lookup_basic_face (w, f, DEFAULT_FACE_ID)); /* Optimize the default case that there is no face property. */ if (NILP (prop) From 2a4a32eddbee7bd8759cf5f64be5d948a68b2caa Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 08:05:13 +0000 Subject: [PATCH 191/367] Fix documentation string of x_coalesce_scroll_events * src/xterm.c (x_coalesce_scroll_events): Update doc string to reflect that this option is now supported under Haiku. --- src/xterm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xterm.c b/src/xterm.c index b78cfa70531..ee8e03f80b9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15155,6 +15155,6 @@ always uses gtk_window_move and ignores the value of this variable. */); doc: /* Non-nil means send a wheel event only for scrolling at least one screen line. Otherwise, a wheel event will be sent every time the mouse wheel is moved. This option is only effective when Emacs is built with XInput -2. */); +2 or with Haiku windowing support. */); x_coalesce_scroll_events = true; } From 867c57029c4d71b9378d34dfbdd975dca8a104f4 Mon Sep 17 00:00:00 2001 From: dickmao Date: Sun, 21 Nov 2021 09:18:57 +0100 Subject: [PATCH 192/367] Fix icalendar time zone parsing * lisp/calendar/icalendar.el (icalendar--decode-isodatetime): Parse time zones more correctly. * test/lisp/calendar/icalendar-tests.el (icalendar-tests--decode-isodatetime): Fix tests so that they work in other time zones than Europe/Berlin (bug#51959). --- lisp/calendar/icalendar.el | 14 +++++------ test/lisp/calendar/icalendar-tests.el | 34 +++++++++++++++------------ 2 files changed, 26 insertions(+), 22 deletions(-) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 2d31101e50e..7a483d40627 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -644,13 +644,13 @@ FIXME: multiple comma-separated values should be allowed!" ;; seconds present (setq second (read (substring isodatetimestring 13 15)))) ;; FIXME: Support subseconds. - (when (and (> (length isodatetimestring) 15) - ;; UTC specifier present - (char-equal ?Z (aref isodatetimestring 15))) - (setq source-zone t - ;; decode to local time unless result-zone is explicitly given, - ;; i.e. do not decode to UTC, i.e. do not (setq result-zone t) - )) + (when (> (length isodatetimestring) 15) + (cl-case (aref isodatetimestring 15) + (?Z + (setq source-zone t)) + ((?- ?+) + (setq source-zone + (concat "UTC" (substring isodatetimestring 15)))))) ;; shift if necessary (if day-shift (let ((mdy (calendar-gregorian-from-absolute diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 10b684aacbe..1551922028c 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -1635,26 +1635,30 @@ SUMMARY:NNN Wwwwwwww Wwwww - Aaaaaa Pppppppp rrrrrr ddd oo Nnnnnnnn 30 (ert-deftest icalendar-tests--decode-isodatetime () "Test `icalendar--decode-isodatetime'." - (should (equal (icalendar-test--format "20040917T050910-0200") - "2004-09-17T03:09:10+0000")) - (should (equal (icalendar-test--format "20040917T050910") + (should (equal (icalendar-test--format "20040917T050910-02:00") "2004-09-17T03:09:10+0000")) + (let ((orig (icalendar-test--format "20040917T050910"))) + (unwind-protect + (progn + (set-time-zone-rule "UTC-02:00") + (should (equal (icalendar-test--format "20040917T050910") + "2004-09-17T03:09:10+0000")) + (should (equal (icalendar-test--format "20040917T0509") + "2004-09-17T03:09:00+0000")) + (should (equal (icalendar-test--format "20040917") + "2004-09-16T22:00:00+0000")) + (should (equal (icalendar-test--format "20040917T050910" 1) + "2004-09-18T03:09:10+0000")) + (should (equal (icalendar-test--format "20040917T050910" 30) + "2004-10-17T03:09:10+0000"))) + (set-time-zone-rule 'wall) ;; (set-time-zone-rule nil) is broken + (should (equal orig (icalendar-test--format "20040917T050910"))))) (should (equal (icalendar-test--format "20040917T050910Z") "2004-09-17T05:09:10+0000")) - (should (equal (icalendar-test--format "20040917T0509") - "2004-09-17T03:09:00+0000")) - (should (equal (icalendar-test--format "20040917") - "2004-09-16T22:00:00+0000")) - (should (equal (icalendar-test--format "20040917T050910" 1) - "2004-09-18T03:09:10+0000")) - (should (equal (icalendar-test--format "20040917T050910" 30) - "2004-10-17T03:09:10+0000")) - (should (equal (icalendar-test--format "20040917T050910" -1) - "2004-09-16T03:09:10+0000")) - + (should (equal (icalendar-test--format "20040917T050910" -1 0) + "2004-09-16T05:09:10+0000")) (should (equal (icalendar-test--format "20040917T050910" nil -3600) "2004-09-17T06:09:10+0000"))) - (provide 'icalendar-tests) ;;; icalendar-tests.el ends here From 1f08f2258beb16d20851f2d4cb85b94840b45ed4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Nov 2021 10:10:07 +0100 Subject: [PATCH 193/367] Revert "* admin/gitmerge.el (gitmerge-mode-map): Convert to defvar-keymap." This reverts commit 4c467e4aff12e65fa4fa62d7f4bdcbf4a2bcd92c. --- admin/gitmerge.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 5aae6b40a0c..67fca87c119 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -96,13 +96,16 @@ If nil, the function `gitmerge-default-branch' guesses.") (defvar gitmerge-log-regexp "^\\([A-Z ]\\)\\s-*\\([0-9a-f]+\\) \\(.+?\\): \\(.*\\)$") -(defvar-keymap gitmerge-mode-map - :doc "Keymap for gitmerge major mode." - "l" #'gitmerge-show-log - "d" #'gitmerge-show-diff - "f" #'gitmerge-show-files - "s" #'gitmerge-toggle-skip - "m" #'gitmerge-start-merge) +(defvar gitmerge-mode-map + (let ((map (make-keymap))) + (define-key map [(l)] 'gitmerge-show-log) + (define-key map [(d)] 'gitmerge-show-diff) + (define-key map [(f)] 'gitmerge-show-files) + (define-key map [(s)] 'gitmerge-toggle-skip) + (define-key map [(m)] 'gitmerge-start-merge) + map) + "Keymap for gitmerge major mode.") + (defvar gitmerge-mode-font-lock-keywords `((,gitmerge-log-regexp From f094120360b4cfbb104496c0b3e21b26f88547a6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 17:38:41 +0800 Subject: [PATCH 194/367] Implement `pick_embedded_child' for offscreen xwidgets * src/xwidget.c (pick_embedded_child): New function. (Fmake_xwidget): Connect `pick-embedded-child' signal to offscreen window. --- src/xwidget.c | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/src/xwidget.c b/src/xwidget.c index b0ff142bc73..d88270dbe97 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -64,6 +64,7 @@ static gboolean webkit_script_dialog_cb (WebKitWebView *, WebKitScriptDialog *, static void record_osr_embedder (struct xwidget_view *); static void from_embedder (GdkWindow *, double, double, gpointer, gpointer, gpointer); static void to_embedder (GdkWindow *, double, double, gpointer, gpointer, gpointer); +static GdkWindow *pick_embedded_child (GdkWindow *, double, double, gpointer); #endif static struct xwidget * @@ -243,6 +244,8 @@ fails. */) "from-embedder", G_CALLBACK (from_embedder), NULL); g_signal_connect (G_OBJECT (gtk_widget_get_window (xw->widgetwindow_osr)), "to-embedder", G_CALLBACK (to_embedder), NULL); + g_signal_connect (G_OBJECT (gtk_widget_get_window (xw->widgetwindow_osr)), + "pick-embedded-child", G_CALLBACK (pick_embedded_child), NULL); /* Store some xwidget data in the gtk widgets for convenient retrieval in the event handlers. */ @@ -510,6 +513,32 @@ xwidget_from_id (uint32_t id) } #ifdef USE_GTK +static GdkWindow * +pick_embedded_child (GdkWindow *window, double x, double y, + gpointer user_data) +{ + GtkWidget *widget; + GtkWidget *child; + GdkEvent event; + int xout, yout; + + event.any.window = window; + event.any.type = GDK_NOTHING; + + widget = gtk_get_event_widget (&event); + + if (!widget) + return NULL; + + child = find_widget_at_pos (widget, lrint (x), lrint (y), + &xout, &yout); + + if (!child) + return NULL; + + return gtk_widget_get_window (child); +} + static void record_osr_embedder (struct xwidget_view *view) { From 539ee617d42220e53218c4fc11f8901c79789a8c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 21 Nov 2021 11:04:35 +0100 Subject: [PATCH 195/367] Fill the Emacs version on the splash page * lisp/startup.el (fancy-startup-tail): (normal-mouse-startup-screen): (normal-no-mouse-startup-screen): Fill the Emacs version data, since it's usually longer than a single line, anyway. --- lisp/startup.el | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index d4fa59925f1..e1106419f10 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1838,11 +1838,14 @@ a face or button specification." :face 'variable-pitch "To quit a partially entered command, type " :face 'default "Control-g" :face 'variable-pitch ".\n") - (fancy-splash-insert :face '(variable-pitch font-lock-builtin-face) - "\nThis is " - (emacs-version) - "\n" - :face '(variable-pitch (:height 0.8)) + (save-restriction + (narrow-to-region (point) (point)) + (fancy-splash-insert :face '(variable-pitch font-lock-builtin-face) + "\nThis is " + (emacs-version) + "\n") + (fill-region (point-min) (point-max))) + (fancy-splash-insert :face '(variable-pitch (:height 0.8)) emacs-copyright "\n") (when auto-save-list-file-prefix @@ -2121,8 +2124,11 @@ To quit a partially entered command, type Control-g.\n") 'follow-link t) (insert "\tChange initialization settings including this screen\n") - (insert "\n" (emacs-version) - "\n" emacs-copyright)) + (save-restriction + (narrow-to-region (point) (point)) + (insert "\n" (emacs-version) "\n") + (fill-region (point-min) (point-max))) + (insert emacs-copyright)) (defun normal-no-mouse-startup-screen () "Show a splash screen suitable for displays without mouse support." @@ -2202,7 +2208,11 @@ If you have no Meta key, you may instead type ESC followed by the character.)")) (startup--get-buffer-create-scratch))) 'follow-link t) (insert "\n") - (insert "\n" (emacs-version) "\n" emacs-copyright "\n") + (save-restriction + (narrow-to-region (point) (point)) + (insert "\n" (emacs-version) "\n") + (fill-region (point-min) (point-max))) + (insert emacs-copyright "\n") (insert (substitute-command-keys " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) From e22c37aa8763b4e8ab5919d87fb14bc9ed175724 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 12:43:53 +0000 Subject: [PATCH 196/367] Fix horizontal wheel events on Haiku * src/haikuterm.c (haiku_read_socket): Fix modifier calculation for horizontal wheel events. --- src/haikuterm.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/haikuterm.c b/src/haikuterm.c index 6304d9bcd3c..67c202d97a2 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3025,7 +3025,10 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) make_float (py)); XSETFRAME (inev.frame_or_window, f); - inev.modifiers |= signbit (py) ? up_modifier : down_modifier; + inev.modifiers |= (signbit (inev.kind == HORIZ_WHEEL_EVENT + ? px : py) + ? up_modifier + : down_modifier); py = 0.0f; px = 0.0f; } From f1ee5c67027b22884835edc0910bbabe4aa62d6c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 21:07:58 +0800 Subject: [PATCH 197/367] Report time in XInput 2 button events * src/xterm.c (handle_one_xevent): Report time in XI button events. --- src/xterm.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/xterm.c b/src/xterm.c index ee8e03f80b9..f5459afd4ff 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10145,6 +10145,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, | xev->mods.effective | xev->mods.latched | xev->mods.locked; + bv.time = xev->time; memset (&compose_status, 0, sizeof (compose_status)); dpyinfo->last_mouse_glyph_frame = NULL; From 6d90444ba0f5202553cf8c245b809c09fce1a317 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Nov 2021 13:14:06 +0000 Subject: [PATCH 198/367] Fix double and triple click in Haiku. * src/haikuterm.c (haiku_read_socket): Record timestamp in events. --- src/haikuterm.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/haikuterm.c b/src/haikuterm.c index 67c202d97a2..61920dbecef 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3185,12 +3185,16 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (inev.kind != NO_EVENT) { + if (inev.kind != HELP_EVENT) + inev.timestamp = time (NULL); kbd_buffer_store_event_hold (&inev, hold_quit); ++message_count; } if (inev2.kind != NO_EVENT) { + if (inev.kind != HELP_EVENT) + inev.timestamp = time (NULL); kbd_buffer_store_event_hold (&inev2, hold_quit); ++message_count; } From 75d294cd4abb4d4062a1bfcd914229d0f9e142dd Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 21 Nov 2021 14:39:29 +0100 Subject: [PATCH 199/367] Reorganize emba control files Using dynamic job generation in GitLab does not work sufficiently. So we generate the jobs in the Emacs sources. * configure.ac (SUBDIR_MAKEFILES): Add test/infra/Makefile. * test/Makefile.in (subdirs, generate-test-jobs): New targets. * test/infra/Makefile.in: * test/infra/test-jobs.yml: New files. * test/infra/default-gitlab-ci.yml: * test/infra/test-jobs-generator.sh: Remove. * test/infra/gitlab-ci.yml: Insert contents of default-gitlab-ci.yml. (stages): Remove generator and trigger. Add normal. (test-jobs-generator, test-jobs-pipeline): Remove jobs. (top): Include test-jobs.yml. --- configure.ac | 7 + test/Makefile.in | 8 +- test/infra/Makefile.in | 86 +++++++ test/infra/default-gitlab-ci.yml | 216 ------------------ test/infra/gitlab-ci.yml | 208 +++++++++++++++-- test/infra/test-jobs-generator.sh | 75 ------- test/infra/test-jobs.yml | 362 ++++++++++++++++++++++++++++++ 7 files changed, 650 insertions(+), 312 deletions(-) create mode 100644 test/infra/Makefile.in delete mode 100644 test/infra/default-gitlab-ci.yml delete mode 100755 test/infra/test-jobs-generator.sh create mode 100644 test/infra/test-jobs.yml diff --git a/configure.ac b/configure.ac index 90a487f7ac7..9cf192d4ba9 100644 --- a/configure.ac +++ b/configure.ac @@ -6309,6 +6309,13 @@ if test -f "$srcdir/$opt_makefile.in"; then dnl ", [], [opt_makefile='$opt_makefile']" and it should work. AC_CONFIG_FILES([test/Makefile]) fi +opt_makefile=test/infra/Makefile +if test -f "$srcdir/$opt_makefile.in"; then + SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile" + dnl Again, it's best not to use a variable. Though you can add + dnl ", [], [opt_makefile='$opt_makefile']" and it should work. + AC_CONFIG_FILES([test/infra/Makefile]) +fi dnl The admin/ directory used to be excluded from tarfiles. diff --git a/test/Makefile.in b/test/Makefile.in index 39d7b1d4e48..51696d7faaf 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -371,7 +371,13 @@ check-declare: $(emacs) -l check-declare \ --eval '(check-declare-directory "$(srcdir)")' -.PHONY: subdir-targets +.PHONY: subdirs subdir-targets generate-test-jobs + +subdirs: + @echo $(SUBDIRS) subdir-targets: @echo $(SUBDIR_TARGETS) + +generate-test-jobs: + @$(MAKE) -C infra generate-test-jobs SUBDIRS="$(SUBDIRS)" diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in new file mode 100644 index 00000000000..e91aea404d4 --- /dev/null +++ b/test/infra/Makefile.in @@ -0,0 +1,86 @@ +### test/infra/Makefile. Generated from Makefile.in by configure. + +# Copyright (C) 2021 Free Software Foundation, Inc. + +# This file is part of GNU Emacs. + +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +### Commentary: + +## Generate the test-jobs.yml file for emba. + +### Code: + +SHELL = @SHELL@ + +top_builddir = @top_builddir@ + +-include ${top_builddir}/src/verbose.mk + +## Get the tests for only a specific directory. +SUBDIRS ?= $(shell make -s -C .. subdirs) +SUBDIR_TARGETS = +FILE = test-jobs.yml + +define subdir_template + $(eval target = check-$(subst /,-,$(1))) + SUBDIR_TARGETS += $(target) + + $(eval + ifeq ($(findstring src, $(1)), src) + define changes + @echo " - $(1)/*.{h,c}" >>$(FILE) + @echo " - test/$(1)/*.el" >>$(FILE) + endef + else ifeq ($(findstring misc, $(1)), misc) + define changes + @echo " - admin/*.el" >>$(FILE) + @echo " - test/$(1)/*.el" >>$(FILE) + endef + else + define changes + @echo " - $(1)/*.el" >>$(FILE) + @echo " - test/$(1)/*.el" >>$(FILE) + endef + endif) + + .PHONY: $(target) + + $(target): + @echo "test-$(subst /,-,$(1))-inotify:" >>$(FILE) + @echo " stage: normal" >>$(FILE) + @echo " extends: [.job-template, .test-template]" >>$(FILE) + @echo " rules:" >>$(FILE) + @echo " - changes:" >>$(FILE) + $(changes) + @echo " variables:" >>$(FILE) + @echo " target: emacs-inotify" >>$(FILE) + @echo " make_params: \"-C test $(target)\"" >>$(FILE) + @echo >>$(FILE) +endef + +$(foreach subdir, $(SUBDIRS), $(eval $(call subdir_template,$(subdir)))) + +all: generate-test-jobs + +.PHONY: generate-test-jobs $(FILE) + +generate-test-jobs: clean $(FILE) $(SUBDIR_TARGETS) + +$(FILE): + $(AM_V_GEN) + +clean: + @rm -f $(FILE) diff --git a/test/infra/default-gitlab-ci.yml b/test/infra/default-gitlab-ci.yml deleted file mode 100644 index f6fadee27f3..00000000000 --- a/test/infra/default-gitlab-ci.yml +++ /dev/null @@ -1,216 +0,0 @@ -# Copyright (C) 2017-2021 Free Software Foundation, Inc. -# -# This file is part of GNU Emacs. -# -# GNU Emacs is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# GNU Emacs is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GNU Emacs. If not, see . - -# GNU Emacs support for the GitLab protocol for CI. - -# The presence of this file does not imply any FSF/GNU endorsement of -# any particular service that uses that protocol. Also, it is intended for -# evaluation purposes, thus possibly temporary. - -# Maintainer: Ted Zlatanov -# URL: https://emba.gnu.org/emacs/emacs - -# Never run merge request pipelines, they usually duplicate push pipelines -# see https://docs.gitlab.com/ee/ci/yaml/README.html#common-if-clauses-for-rules - -# Rules: always run tags and branches named master*, emacs*, feature*, fix* -# Test that it triggers by pushing a tag: `git tag mytag; git push origin mytag` -# Test that it triggers by pushing to: feature/emba, feature1, master, master-2, fix/emba, emacs-299, fix-2 -# Test that it doesn't trigger by pushing to: scratch-2, scratch/emba, oldbranch, dev -workflow: - rules: - - if: '$CI_PIPELINE_SOURCE == "merge_request_event"' - when: never - - if: '$CI_COMMIT_TAG' - when: always - - if: '$CI_COMMIT_BRANCH !~ /^(master|emacs|feature|fix)/' - when: never - - when: always - -variables: - GIT_STRATEGY: fetch - EMACS_EMBA_CI: 1 - # Three hours, see below. - EMACS_TEST_TIMEOUT: 10800 - EMACS_TEST_VERBOSE: 1 - # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled - # DOCKER_HOST: tcp://docker:2376 - # DOCKER_TLS_CERTDIR: "/certs" - # Put the configuration for each run in a separate directory to - # avoid conflicts. - DOCKER_CONFIG: "/.docker-config-${CI_COMMIT_SHA}" - DOCKER_BUILDKIT: 1 - # We don't use ${CI_COMMIT_SHA} to be able to do one bootstrap - # across multiple builds. - BUILD_TAG: ${CI_COMMIT_REF_SLUG} - # Disable if you don't need it, it can be a security risk. - CI_DEBUG_TRACE: "true" - -default: - image: docker:19.03.12 - timeout: 3 hours - before_script: - - docker info - - echo "docker registry is ${CI_REGISTRY}" - - docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY} - -.job-template: - variables: - test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA} - rules: - - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - aclocal.m4 - - autogen.sh - - configure.ac - - lib/*.{h,c} - - lisp/**.el - - src/*.{h,c} - - test/infra/* - - test/lib-src/*.el - - test/lisp/**.el - - test/misc/*.el - - test/src/*.el - - changes: - # gfilemonitor, kqueue - - src/gfilenotify.c - - src/kqueue.c - # MS Windows - - "**w32*" - # GNUstep - - lisp/term/ns-win.el - - src/ns*.{h,m} - - src/macfont.{h,m} - when: never - # These will be cached across builds. - cache: - key: ${CI_COMMIT_SHA} - paths: [] - policy: pull-push - # These will be saved for followup builds. - artifacts: - expire_in: 24 hrs - paths: [] - # Using the variables for each job. - script: - - docker pull ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} - # TODO: with make -j4 several of the tests were failing, for - # example shadowfile-tests, but passed without it. - - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' - after_script: - # - docker ps -a - # - printenv - # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) - - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} - # - ls -alR ${test_name} - -.build-template: - needs: [] - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - when: always - - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - aclocal.m4 - - autogen.sh - - configure.ac - - lib/*.{h,c} - - lisp/emacs-lisp/*.el - - src/*.{h,c} - - test/infra/* - - changes: - # gfilemonitor, kqueue - - src/gfilenotify.c - - src/kqueue.c - # MS Windows - - "**w32*" - # GNUstep - - lisp/term/ns-win.el - - src/ns*.{h,m} - - src/macfont.{h,m} - when: never - script: - - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba . - - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} - -.test-template: - # Do not run fast and normal test jobs when scheduled. - rules: - - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' - when: never - - when: always - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/**/*.log - - ${test_name}/**/core - - ${test_name}/core - when: always - -.gnustep-template: - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - - if: '$CI_PIPELINE_SOURCE == "schedule"' - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - configure.ac - - src/ns*.{h,m} - - src/macfont.{h,m} - - lisp/term/ns-win.el - - nextstep/** - - test/infra/* - -.filenotify-gio-template: - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - - if: '$CI_PIPELINE_SOURCE == "schedule"' - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - lisp/autorevert.el - - lisp/filenotify.el - - lisp/net/tramp-sh.el - - src/gfilenotify.c - - test/infra/* - - test/lisp/autorevert-tests.el - - test/lisp/filenotify-tests.el - -.native-comp-template: - rules: - - if: '$CI_PIPELINE_SOURCE == "web"' - - if: '$CI_PIPELINE_SOURCE == "schedule"' - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - lisp/emacs-lisp/comp.el - - lisp/emacs-lisp/comp-cstr.el - - src/comp.{h,m} - - test/infra/* - - test/src/comp-resources/*.el - - test/src/comp-tests.el - timeout: 8 hours - -# Local Variables: -# add-log-current-defun-header-regexp: "^\\([-_.[:alnum:]]+\\)[ \t]*:" -# End: diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index ebfe9965139..a0e2c283cde 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -24,15 +24,197 @@ # Maintainer: Ted Zlatanov # URL: https://emba.gnu.org/emacs/emacs -# Include defaults. -include: '/test/infra/default-gitlab-ci.yml' +# Never run merge request pipelines, they usually duplicate push pipelines +# see https://docs.gitlab.com/ee/ci/yaml/README.html#common-if-clauses-for-rules + +# Rules: always run tags and branches named master*, emacs*, feature*, fix* +# Test that it triggers by pushing a tag: `git tag mytag; git push origin mytag` +# Test that it triggers by pushing to: feature/emba, feature1, master, master-2, fix/emba, emacs-299, fix-2 +# Test that it doesn't trigger by pushing to: scratch-2, scratch/emba, oldbranch, dev +workflow: + rules: + - if: '$CI_PIPELINE_SOURCE == "merge_request_event"' + when: never + - if: '$CI_COMMIT_TAG' + when: always + - if: '$CI_COMMIT_BRANCH !~ /^(master|emacs|feature|fix)/' + when: never + - when: always + +variables: + GIT_STRATEGY: fetch + EMACS_EMBA_CI: 1 + # Three hours, see below. + EMACS_TEST_TIMEOUT: 10800 + EMACS_TEST_VERBOSE: 1 + # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled + # DOCKER_HOST: tcp://docker:2376 + # DOCKER_TLS_CERTDIR: "/certs" + # Put the configuration for each run in a separate directory to + # avoid conflicts. + DOCKER_CONFIG: "/.docker-config-${CI_COMMIT_SHA}" + DOCKER_BUILDKIT: 1 + # We don't use ${CI_COMMIT_SHA} to be able to do one bootstrap + # across multiple builds. + BUILD_TAG: ${CI_COMMIT_REF_SLUG} + # Disable if you don't need it, it can be a security risk. + # CI_DEBUG_TRACE: "true" + +default: + image: docker:19.03.12 + timeout: 3 hours + before_script: + - docker info + - echo "docker registry is ${CI_REGISTRY}" + - docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY} + +.job-template: + variables: + test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA} + rules: + - changes: + - "**Makefile.in" + - .gitlab-ci.yml + - aclocal.m4 + - autogen.sh + - configure.ac + - lib/*.{h,c} + - lisp/**.el + - src/*.{h,c} + - test/infra/* + - test/lib-src/*.el + - test/lisp/**.el + - test/misc/*.el + - test/src/*.el + - changes: + # gfilemonitor, kqueue + - src/gfilenotify.c + - src/kqueue.c + # MS Windows + - "**w32*" + # GNUstep + - lisp/term/ns-win.el + - src/ns*.{h,m} + - src/macfont.{h,m} + when: never + # These will be cached across builds. + cache: + key: ${CI_COMMIT_SHA} + paths: [] + policy: pull-push + # These will be saved for followup builds. + artifacts: + expire_in: 24 hrs + paths: [] + # Using the variables for each job. + script: + - docker pull ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} + # TODO: with make -j4 several of the tests were failing, for + # example shadowfile-tests, but passed without it. + - 'export PWD=$(pwd)' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' + after_script: + # - docker ps -a + # - printenv + # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) + - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} + - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} + # - ls -alR ${test_name} + +.build-template: + needs: [] + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + when: always + - changes: + - "**Makefile.in" + - .gitlab-ci.yml + - aclocal.m4 + - autogen.sh + - configure.ac + - lib/*.{h,c} + - lisp/emacs-lisp/*.el + - src/*.{h,c} + - test/infra/* + - changes: + # gfilemonitor, kqueue + - src/gfilenotify.c + - src/kqueue.c + # MS Windows + - "**w32*" + # GNUstep + - lisp/term/ns-win.el + - src/ns*.{h,m} + - src/macfont.{h,m} + when: never + script: + - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba . + - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} + +.test-template: + # Do not run fast and normal test jobs when scheduled. + rules: + - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' + when: never + - when: always + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - ${test_name}/**/*.log + - ${test_name}/**/core + - ${test_name}/core + when: always + +.gnustep-template: + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' + changes: + - "**Makefile.in" + - .gitlab-ci.yml + - configure.ac + - src/ns*.{h,m} + - src/macfont.{h,m} + - lisp/term/ns-win.el + - nextstep/** + - test/infra/* + +.filenotify-gio-template: + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' + changes: + - "**Makefile.in" + - .gitlab-ci.yml + - lisp/autorevert.el + - lisp/filenotify.el + - lisp/net/tramp-sh.el + - src/gfilenotify.c + - test/infra/* + - test/lisp/autorevert-tests.el + - test/lisp/filenotify-tests.el + +.native-comp-template: + rules: + - if: '$CI_PIPELINE_SOURCE == "web"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' + changes: + - "**Makefile.in" + - .gitlab-ci.yml + - lisp/emacs-lisp/comp.el + - lisp/emacs-lisp/comp-cstr.el + - src/comp.{h,m} + - test/infra/* + - test/src/comp-resources/*.el + - test/src/comp-tests.el + timeout: 8 hours stages: - build-images - - generator - - trigger # - fast -# - normal + - normal - platform-images - platforms - native-comp-images @@ -52,21 +234,7 @@ build-image-inotify: # target: emacs-inotify # make_params: "-C test check" -test-jobs-generator: - stage: generator - script: - - test/infra/test-jobs-generator.sh > test-jobs.yml - artifacts: - paths: - - test-jobs.yml - -test-jobs-pipeline: - stage: trigger - trigger: - include: - - artifact: test-jobs.yml - job: test-jobs-generator - strategy: depend +include: '/test/infra/test-jobs.yml' # test-lisp-inotify: # stage: normal diff --git a/test/infra/test-jobs-generator.sh b/test/infra/test-jobs-generator.sh deleted file mode 100755 index c40570cbc30..00000000000 --- a/test/infra/test-jobs-generator.sh +++ /dev/null @@ -1,75 +0,0 @@ -#!/bin/sh - -# Copyright (C) 2021 Free Software Foundation, Inc. -# -# This file is part of GNU Emacs. -# -# GNU Emacs is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# GNU Emacs is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GNU Emacs. If not, see . - -# GNU Emacs support for the gitlab-ci.yml template generation. - -# The presence of this file does not imply any FSF/GNU endorsement of -# any particular service that uses that protocol. Also, it is intended for -# evaluation purposes, thus possibly temporary. - -# Maintainer: Michael Albinus -# URL: https://emba.gnu.org/emacs/emacs - -cd test -SUBDIRS=\ -$(find lib-src lisp misc src -type d \ - ! \( -path "*resources*" -o -path "*auto-save-list" \) -print | sort -) - -for subdir in $SUBDIRS; do - target=check-$(echo $subdir | tr '/' '-') - - case $target in - check*-src) - changes=" - - $subdir/*.{h,c} - - test/$subdir/*.el" - ;; - check-misc) - changes=" - - admin/*.el - - test/$subdir/*.el" - ;; - *) - changes=" - - $subdir/*.el - - test/$subdir/*.el" - ;; - esac - - cat < Date: Sun, 21 Nov 2021 14:44:41 +0100 Subject: [PATCH 200/367] Use variable-pitch-mode in 'C-h C-h' * lisp/faces.el (help-key-binding): Inherit 'fixed-pitch'. * lisp/help-macro.el (make-help-screen): Use 'variable-pitch-mode'. This was discussed in https://lists.gnu.org/r/emacs-devel/2021-11/msg01378.html --- lisp/faces.el | 14 +++++++++----- lisp/help-macro.el | 1 + 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp/faces.el b/lisp/faces.el index b2498cda88a..a07f8c652e4 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2883,13 +2883,17 @@ Note: Other faces cannot inherit from the cursor face." ;; making the characters wider, which then would cause unpleasant ;; horizontal shifts of the cursor during C-n/C-p movement ;; through a line with this face. - :box (:line-width (-1 . -1) :color "grey80")) + :box (:line-width (-1 . -1) :color "grey80") + :inherit fixed-pitch) (((class color) (min-colors 88) (background dark)) :background "grey19" :foreground "LightBlue" - :box (:line-width (-1 . -1) :color "grey35")) - (((class color grayscale) (background light)) :background "grey90") - (((class color grayscale) (background dark)) :background "grey25") - (t :background "grey90")) + :box (:line-width (-1 . -1) :color "grey35") + :inherit fixed-pitch) + (((class color grayscale) (background light)) :background "grey90" + :inherit fixed-pitch) + (((class color grayscale) (background dark)) :background "grey25" + :inherit fixed-pitch) + (t :background "grey90" :inherit fixed-pitch)) "Face for keybindings in *Help* buffers. This face is added by `substitute-command-keys', which see. diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 1fa9d82afd8..588efee66b1 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -140,6 +140,7 @@ and then returns." (insert (substitute-command-keys help-screen))) (let ((minor-mode-map-alist new-minor-mode-map-alist)) (help-mode) + (variable-pitch-mode) (setq new-minor-mode-map-alist minor-mode-map-alist)) (goto-char (point-min)) (while (or (memq char (append help-event-list From 2716146e6cb0926162378de45ee7448d8c88aa64 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 21 Nov 2021 16:57:12 +0200 Subject: [PATCH 201/367] Minor cleanup in w32inevt.c * src/w32inevt.c (w32_console_mouse_position, mouse_moved_to) (do_mouse_event): Use 'get_frame' to obtain the frame pointer. --- src/w32inevt.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/w32inevt.c b/src/w32inevt.c index 894bc3ab089..4cc01d31c94 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -420,7 +420,7 @@ w32_console_mouse_position (struct frame **f, *f = get_frame (); *bar_window = Qnil; *part = scroll_bar_above_handle; - SELECTED_FRAME ()->mouse_moved = 0; + (*f)->mouse_moved = 0; XSETINT (*x, movement_pos.X); XSETINT (*y, movement_pos.Y); @@ -436,7 +436,8 @@ mouse_moved_to (int x, int y) /* If we're in the same place, ignore it. */ if (x != movement_pos.X || y != movement_pos.Y) { - SELECTED_FRAME ()->mouse_moved = 1; + struct frame *f = get_frame (); + f->mouse_moved = 1; movement_pos.X = x; movement_pos.Y = y; movement_time = GetTickCount (); @@ -471,13 +472,13 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, int i; /* Mouse didn't move unless MOUSE_MOVED says it did. */ - SELECTED_FRAME ()->mouse_moved = 0; + struct frame *f = get_frame (); + f->mouse_moved = 0; switch (flags) { case MOUSE_MOVED: { - struct frame *f = get_frame (); Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int mx = event->dwMousePosition.X, my = event->dwMousePosition.Y; @@ -536,7 +537,6 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, case MOUSE_WHEELED: case MOUSE_HWHEELED: { - struct frame *f = get_frame (); /* Mouse positions in console wheel events are reported to ReadConsoleInput relative to the display's top-left corner(!), not relative to the origin of the console screen @@ -588,8 +588,8 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, int x = event->dwMousePosition.X; int y = event->dwMousePosition.Y; - struct frame *f = get_frame (); - emacs_ev->arg = tty_handle_tab_bar_click (f, x, y, (button_state & mask) != 0, + emacs_ev->arg = tty_handle_tab_bar_click (f, x, y, + (button_state & mask) != 0, emacs_ev); emacs_ev->modifiers |= ((button_state & mask) From 7c52c86a84466665fa661bf4ff9cb7a1d9501324 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Sun, 21 Nov 2021 16:00:11 +0100 Subject: [PATCH 202/367] ; Fix a few haiku typos * lisp/net/browse-url.el (browse-url-webpositive-program): Correct :version tag. * src/frame.c (Fframep): Fix quoting of "haiku". --- lisp/net/browse-url.el | 2 +- src/frame.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index f85f5f61495..19afb813317 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -371,7 +371,7 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time (defcustom browse-url-webpositive-program "WebPositive" "The name by which to invoke WebPositive." :type 'string - :version "28.1") + :version "29.1") ;; GNOME means of invoking either Mozilla or Netscape. (defvar browse-url-gnome-moz-program "gnome-moz-remote") diff --git a/src/frame.c b/src/frame.c index a21dd0d9275..33e9606e41d 100644 --- a/src/frame.c +++ b/src/frame.c @@ -226,7 +226,7 @@ Value is: `w32' for an Emacs frame that is a window on MS-Windows display, `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, `pc' for a direct-write MS-DOS frame. - `haiku` for an Emacs frame running in Haiku. + `haiku' for an Emacs frame running in Haiku. See also `frame-live-p'. */) (Lisp_Object object) { From 85f193b6133387b0901ea89d7ff9f665a5f33d26 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Sun, 21 Nov 2021 16:20:20 +0100 Subject: [PATCH 203/367] Add :version tags to new mwheel defcustoms * lisp/mwheel.el (mouse-wheel-down-alternate-event): (mouse-wheel-up-alternate-event): Add :version tag. --- lisp/mwheel.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index cd84a109993..5d18cf84c2b 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -69,6 +69,7 @@ "Alternative wheel down event to consider." :group 'mouse :type 'symbol + :version "29.1" :set 'mouse-wheel-change-button) (defcustom mouse-wheel-up-event @@ -86,6 +87,7 @@ "Alternative wheel up event to consider." :group 'mouse :type 'symbol + :version "29.1" :set 'mouse-wheel-change-button) (defcustom mouse-wheel-click-event 'mouse-2 From b7db7eb2c7b8ac1bddf4afa9ccf9b30ebeb0224e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 21 Nov 2021 19:07:10 +0200 Subject: [PATCH 204/367] Fix positioning of pop-up menus when there are window-margins * src/menu.c (x_popup_menu_1): Calculate X and Y correctly for clicks in the text area. (Bug#51782) --- src/menu.c | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/menu.c b/src/menu.c index ab01e1bfad2..96d1c5208a9 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1113,7 +1113,7 @@ into menu items. */) Lisp_Object x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) { - Lisp_Object keymap, tem, tem2; + Lisp_Object keymap, tem, tem2 = Qnil; int xpos = 0, ypos = 0; Lisp_Object title; const char *error_name = NULL; @@ -1252,8 +1252,21 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) CHECK_LIVE_WINDOW (window); f = XFRAME (WINDOW_FRAME (win)); - xpos = WINDOW_LEFT_EDGE_X (win); - ypos = WINDOW_TOP_EDGE_Y (win); + if (FIXNUMP (tem2)) + { + /* Clicks in the text area, where TEM2 is a buffer + position, are relative to the top-left edge of the text + area, see keyboard.c:make_lispy_position. */ + xpos = window_box_left (win, TEXT_AREA); + ypos = (WINDOW_TOP_EDGE_Y (win) + + WINDOW_TAB_LINE_HEIGHT (win) + + WINDOW_HEADER_LINE_HEIGHT (win)); + } + else + { + xpos = WINDOW_LEFT_EDGE_X (win); + ypos = WINDOW_TOP_EDGE_Y (win); + } } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, From 08ccce2257d81ae4e8a579c374f6a8e886992385 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 16 Nov 2021 00:05:11 +0100 Subject: [PATCH 205/367] Improve error parsing for GCC -fanalyzer output * compile.el (compilation-error-regexp-alist-alist): Adjust gnu rule * compile-tests.el (compile-tests--test-regexps-data): Add testcase --- lisp/progmodes/compile.el | 5 ++++- test/lisp/progmodes/compile-tests.el | 1 + 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 14da5880203..c0e16ce3515 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -351,7 +351,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; from Ruby, but it is unclear whether it is actually ;; used since the gcc-include rule above seems to cover ;; it. - (regexp "[ \t]+\\(?:in \\|from\\)"))) + (regexp "[ \t]+\\(?:in \\|from\\)") + ;; Skip indentation generated by tools like GCC's + ;; -fanalyzer. + (: (+ space) "|"))) ;; File name group. (group-n 1 diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 2a3bb3dafae..c714b9ecfe5 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -230,6 +230,7 @@ (gnu "foo.c:8:23:information: message" 1 23 8 "foo.c") (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 45) (8 . nil) "foo.c") (gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c") + (gnu " |foo.c:8: message" 1 nil 8 "foo.c") ;; The next one is not in the GNU standards AFAICS. ;; Here we seem to interpret it as LINE1-LINE2.COL2. (gnu "foo.c:8-45.3: message" 1 (nil . 3) (8 . 45) "foo.c") From 1bc4fd6f52eaba61a452152642a0ed85d07702c4 Mon Sep 17 00:00:00 2001 From: Omar Polo Date: Mon, 15 Nov 2021 17:33:51 +0000 Subject: [PATCH 206/367] Move the sasl section after the bitlbee text --- doc/misc/rcirc.texi | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index a4ca54a8b01..696983dc771 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -609,12 +609,6 @@ Use this symbol if you need to identify yourself in the Bitlbee channel as follows: @code{identify secret}. The necessary arguments are the nickname you want to use this for, and the password to use. -@item sasl -@cindex sasl authentication -Use this symbol if you want to use @acronym{SASL} authentication. The -necessary arguments are the nickname you want to use this for, and the -password to use. - @cindex gateway to other IM services @cindex instant messaging, other services @cindex Jabber @@ -633,6 +627,12 @@ the other instant messaging services, and Bitlbee will log you in. All @code{rcirc} needs to know, is the login to your Bitlbee account. Don't confuse the Bitlbee account with all the other accounts. +@item sasl +@cindex sasl authentication +Use this symbol if you want to use @acronym{SASL} authentication. The +necessary arguments are the nickname you want to use this for, and the +password to use. + @end table @end table From b79cb838a477ee5a5c3660e81264991ff833a82f Mon Sep 17 00:00:00 2001 From: Omar Polo Date: Mon, 15 Nov 2021 17:40:58 +0000 Subject: [PATCH 207/367] implement certfp authentication to rcirc * lisp/net/rcirc.el (rcirc-connect): Use the provided client certs * doc/misc/rcirc.texi (Configuration): Document the change --- doc/misc/rcirc.texi | 7 +++++++ lisp/net/rcirc.el | 26 ++++++++++++++++++++++---- 2 files changed, 29 insertions(+), 4 deletions(-) diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index 696983dc771..58ca045e786 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -633,6 +633,13 @@ Use this symbol if you want to use @acronym{SASL} authentication. The necessary arguments are the nickname you want to use this for, and the password to use. +@item certfp +@cindex certfp authentication +Use this symbol if you want to use CertFP authentication. The +necessary arguments are the path to the client certificate key and +password. The CertFP authentication requires a @acronym{TLS} +connection. + @end table @end table diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 5c92c60eda2..6030db9daeb 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -262,6 +262,7 @@ The ARGUMENTS for each METHOD symbol are: `bitlbee': NICK PASSWORD `quakenet': ACCOUNT PASSWORD `sasl': NICK PASSWORD + `certfp': KEY CERT Examples: ((\"Libera.Chat\" nickserv \"bob\" \"p455w0rd\") @@ -291,7 +292,11 @@ Examples: (list :tag "SASL" (const sasl) (string :tag "Nick") - (string :tag "Password"))))) + (string :tag "Password")) + (list :tag "CertFP" + (const certfp) + (string :tag "Key") + (string :tag "Certificate"))))) (defcustom rcirc-auto-authenticate-flag t "Non-nil means automatically send authentication string to server. @@ -547,6 +552,9 @@ If ARG is non-nil, instead prompt for connection parameters." (password (plist-get (cdr c) :password)) (encryption (plist-get (cdr c) :encryption)) (server-alias (plist-get (cdr c) :server-alias)) + (client-cert (when (eq (rcirc-get-server-method (car c)) + 'certfp) + (rcirc-get-server-cert (car c)))) contact) (when-let (((not password)) (auth (auth-source-search :host server @@ -563,7 +571,7 @@ If ARG is non-nil, instead prompt for connection parameters." (condition-case nil (let ((process (rcirc-connect server port nick user-name full-name channels password encryption - server-alias))) + client-cert server-alias))) (when rcirc-display-server-buffer (pop-to-buffer-same-window (process-buffer process)))) (quit (message "Quit connecting to %s" @@ -662,13 +670,22 @@ See `rcirc-connect' for more details on these variables.") (when (string-match server-i server) (throw 'pass (car args))))))) +(defun rcirc-get-server-cert (server) + "Return a list of key and certificate for SERVER." + (catch 'cert + (dolist (i rcirc-authinfo) + (let ((server-i (car i)) + (args (cddr i))) + (when (string-match server-i server) + (throw 'cert args)))))) + ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption - server-alias) + certfp server-alias) "Connect to SERVER. The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD, -ENCRYPTION, SERVER-ALIAS are interpreted as in +ENCRYPTION, CERTFP, SERVER-ALIAS are interpreted as in `rcirc-server-alist'. STARTUP-CHANNELS is a list of channels that are joined after authentication." (save-excursion @@ -695,6 +712,7 @@ that are joined after authentication." (setq process (open-network-stream (or server-alias server) nil server port-number :type (or encryption 'plain) + :client-certificate certfp :nowait t)) (set-process-coding-system process 'raw-text 'raw-text) (with-current-buffer (get-buffer-create (rcirc-generate-new-buffer-name process nil)) From 74386abc0ff14affe2a9564c681d9e53cfe418e2 Mon Sep 17 00:00:00 2001 From: Omar Polo Date: Mon, 15 Nov 2021 21:49:23 +0000 Subject: [PATCH 208/367] ; Simplify rcirc authentication querying functions --- lisp/net/rcirc.el | 21 +++------------------ 1 file changed, 3 insertions(+), 18 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 6030db9daeb..b4e9031e0d4 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -654,30 +654,15 @@ See `rcirc-connect' for more details on these variables.") (defun rcirc-get-server-method (server) "Return authentication method for SERVER." - (catch 'method - (dolist (i rcirc-authinfo) - (let ((server-i (car i)) - (method (cadr i))) - (when (string-match server-i server) - (throw 'method method)))))) + (cadr (assoc server rcirc-authinfo #'string-match))) (defun rcirc-get-server-password (server) "Return password for SERVER." - (catch 'pass - (dolist (i rcirc-authinfo) - (let ((server-i (car i)) - (args (cdddr i))) - (when (string-match server-i server) - (throw 'pass (car args))))))) + (cadddr (assoc server rcirc-authinfo #'string-match))) (defun rcirc-get-server-cert (server) "Return a list of key and certificate for SERVER." - (catch 'cert - (dolist (i rcirc-authinfo) - (let ((server-i (car i)) - (args (cddr i))) - (when (string-match server-i server) - (throw 'cert args)))))) + (cddr (assoc server rcirc-authinfo #'string-match))) ;;;###autoload (defun rcirc-connect (server &optional port nick user-name From 73754bc54c0d9d390ae76ab0ccf18f63db16bc1f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Nov 2021 21:05:47 +0100 Subject: [PATCH 209/367] Adapt isearch help screen for variable-pitch-mode * lisp/isearch.el (isearch-help-for-help-internal): Adapt for 'variable-pitch-mode', now that 'make-help-screen' uses that. --- lisp/isearch.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/isearch.el b/lisp/isearch.el index dea96624774..9dc8525417a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -488,9 +488,9 @@ and doesn't remove full-buffer highlighting after a search." "You have typed %THIS-KEY%, the help character. Type a Help option: \(Type \\\\[help-quit] to exit the Help command.) -\\[isearch-describe-bindings] Display all Isearch key bindings. -\\[isearch-describe-key] KEYS Display full documentation of Isearch key sequence. -\\[isearch-describe-mode] Display documentation of Isearch mode. + \\[isearch-describe-bindings] Display all Isearch key bindings. + \\[isearch-describe-key] Display full documentation of Isearch key sequence. + \\[isearch-describe-mode] Display documentation of Isearch mode. You can't type here other help keys available in the global help map, but outside of this help window when you type them in Isearch mode, From bb2a989e002c954e67e3112d7bdb2f2891d387bd Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 00:24:26 +0000 Subject: [PATCH 210/367] Remove variable that no longer exists from manual * doc/emacs/haiku.texi: Remove nonexistent variable. --- doc/emacs/haiku.texi | 8 -------- 1 file changed, 8 deletions(-) diff --git a/doc/emacs/haiku.texi b/doc/emacs/haiku.texi index 551599dfa80..a41804b2336 100644 --- a/doc/emacs/haiku.texi +++ b/doc/emacs/haiku.texi @@ -106,14 +106,6 @@ defaults to @code{t}. If GDB cannot be used on your system, please attach the report generated by the system debugger when reporting a bug. -@table @code -@vindex haiku-use-system-debugger -@item haiku-use-system-debugger -When non-nil, Emacs will ask the system to launch the system debugger -whenever it experiences a fatal error. This behaviour is standard -among Haiku applications. -@end table - @node Haiku Fonts @section Font and font backend selection on Haiku @cindex font backend selection (Haiku) From a4ac6090986262f5a01c858a35bdcfb1787ded45 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 09:34:39 +0800 Subject: [PATCH 211/367] Use only effective modifiers for XI2 key press events * src/xterm.c (handle_one_xevent): Use only effective modifiers in XI_KeyPress events. --- src/xterm.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index f5459afd4ff..7c2276f2e6c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10292,10 +10292,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } case XI_KeyPress: { - int state = xev->mods.base - | xev->mods.effective - | xev->mods.latched - | xev->mods.locked; + int state = xev->mods.effective; Lisp_Object c; #ifdef HAVE_XKB unsigned int mods_rtrn; From 4eb228bfac3cd384bc8b21cd0c46fc89b339b0ed Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 09:40:47 +0800 Subject: [PATCH 212/367] Also filter XI_KeyRelease events * src/xterm.c (handle_one_xevent): Also filter XI_KeyRelease events through the X input method. --- src/xterm.c | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/xterm.c b/src/xterm.c index 7c2276f2e6c..9d052c412b4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10649,6 +10649,25 @@ handle_one_xevent (struct x_display_info *dpyinfo, } case XI_KeyRelease: x_display_set_last_user_time (dpyinfo, xev->time); +#ifdef HAVE_X_I18N + XKeyPressedEvent xkey; + + memset (&xkey, 0, sizeof xkey); + + xkey.type = KeyRelease; + xkey.serial = 0; + xkey.send_event = xev->send_event; + xkey.display = xev->display; + xkey.window = xev->event; + xkey.root = xev->root; + xkey.subwindow = xev->child; + xkey.time = xev->time; + xkey.state = xev->mods.effective; + xkey.keycode = xev->detail; + xkey.same_screen = True; + + x_filter_event (dpyinfo, (XEvent *) &xkey); +#endif goto XI_OTHER; case XI_PropertyEvent: case XI_HierarchyChanged: From 536e7bf03b2ef8451fdd6b8d62db08f2bc7ebec9 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 21 Nov 2021 18:29:24 -0800 Subject: [PATCH 213/367] Fix recent compile-tests addition * test/lisp/progmodes/compile-tests.el (compile-test-error-regexps): Bump number of expected errors. ; Surely running the tests before committing would have flagged this? --- test/lisp/progmodes/compile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index c714b9ecfe5..c87a4453cbd 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -492,7 +492,7 @@ The test data is in `compile-tests--test-regexps-data'." (compilation-num-warnings-found 0) (compilation-num-infos-found 0)) (mapc #'compile--test-error-line compile-tests--test-regexps-data) - (should (eq compilation-num-errors-found 96)) + (should (eq compilation-num-errors-found 97)) (should (eq compilation-num-warnings-found 35)) (should (eq compilation-num-infos-found 28))))) From 9324efac480df3cd78af112da2b12a0d2bd18e02 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 10:42:46 +0800 Subject: [PATCH 214/367] Make `xwidget-display-event' a special event as well * doc/lispref/commands.texi (Xwidget Events): Document that `xwidget-display-event' is a special event, and that it should be handled through callbacks. * etc/NEWS: Update NEWS entry. * lisp/xwidget.el (xwidget-webkit-new-session) (xwidget-webkit-import-widget): Attach display callback. (xwidget-webkit-display-event): Call display callback instead. (xwidget-webkit-display-callback): New function. * src/keyboard.c (make_lispy_event): Store source information for XWIDGET_DISPLAY_EVENT correctly. * src/xwidget.c (store_xwidget_display_event): Store source of the display request. (webkit_ready_to_show): Store source if available. (webkit_create_cb_1): Store source if available. (kill_xwidget): Remove dead widget from internal_xwidget_list. --- doc/lispref/commands.texi | 10 ++++++++-- etc/NEWS | 4 ++-- lisp/xwidget.el | 17 ++++++++++++++--- src/keyboard.c | 2 +- src/xwidget.c | 34 +++++++++++++++++++++++++--------- 5 files changed, 50 insertions(+), 17 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 5fd7b55a60b..c12a97cc7df 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1950,9 +1950,15 @@ internally by @code{xwidget-webkit-execute-script}. @end table @cindex @code{xwidget-display-event} event -@item (xwidget-display-event @var{xwidget}) +@item (xwidget-display-event @var{xwidget} @var{source}) This event is sent whenever an xwidget requests that another xwidget -be displayed. @var{xwidget} is the xwidget that should be displayed. +be displayed. @var{xwidget} is the xwidget that should be displayed, +and @var{source} is the xwidget that asked to display @var{xwidget}. + +It is also a special event which should be handled through callbacks. +You can add such a callback by setting the @code{display-callback} of +@var{source}'s property list, which should be a function that accepts +@var{xwidget} and @var{source} as arguments. @var{xwidget}'s buffer will be set to a temporary buffer. When displaying the widget, care should be taken to replace the buffer with diff --git a/etc/NEWS b/etc/NEWS index bfea4da8b9e..6fa5de0116d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -927,8 +927,8 @@ commits to the load. +++ *** New event type 'xwidget-display-event'. These events are sent whenever an xwidget requests that Emacs display -another xwidget. The only argument to this event is the xwidget that -should be displayed. +another xwidget. The only arguments to this event are the xwidget +that should be displayed, and the xwidget that asked to display it. +++ *** New function 'xwidget-webkit-set-cookie-storage-file'. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 160da67cb21..cf4396fec2d 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -818,6 +818,7 @@ For example, use this to display an anchor." (xwidget-webkit-set-cookie-storage-file xw (expand-file-name xwidget-webkit-cookie-file))) (xwidget-put xw 'callback callback) + (xwidget-put xw 'display-callback #'xwidget-webkit-display-callback) (xwidget-webkit-mode) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) @@ -840,16 +841,26 @@ Return the buffer." (put-text-property (point-min) (point-max) 'display (list 'xwidget :xwidget xwidget))) (xwidget-put xwidget 'callback callback) + (xwidget-put xwidget 'display-callback + #'xwidget-webkit-display-callback) (set-xwidget-buffer xwidget buffer) (xwidget-webkit-mode)) buffer)) (defun xwidget-webkit-display-event (event) - "Import the xwidget inside EVENT and display it." + "Trigger display callback for EVENT." (interactive "e") - (display-buffer (xwidget-webkit-import-widget (nth 1 event)))) + (let ((xwidget (cadr event)) + (source (caddr event))) + (when (xwidget-get source 'display-callback) + (funcall (xwidget-get source 'display-callback) + xwidget source)))) -(global-set-key [xwidget-display-event] 'xwidget-webkit-display-event) +(defun xwidget-webkit-display-callback (xwidget _source) + "Import XWIDGET and display it." + (display-buffer (xwidget-webkit-import-widget xwidget))) + +(define-key special-event-map [xwidget-display-event] 'xwidget-webkit-display-event) (defun xwidget-webkit-goto-url (url) "Goto URL with xwidget webkit." diff --git a/src/keyboard.c b/src/keyboard.c index 982854c41e1..c98175aea0d 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -6141,7 +6141,7 @@ make_lispy_event (struct input_event *event) return Fcons (Qxwidget_event, event->arg); case XWIDGET_DISPLAY_EVENT: - return list2 (Qxwidget_display_event, event->arg); + return Fcons (Qxwidget_display_event, event->arg); #endif #ifdef USE_FILE_NOTIFY diff --git a/src/xwidget.c b/src/xwidget.c index d88270dbe97..5da2aa1743b 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -1316,16 +1316,18 @@ store_xwidget_js_callback_event (struct xwidget *xw, #ifdef USE_GTK static void -store_xwidget_display_event (struct xwidget *xw) +store_xwidget_display_event (struct xwidget *xw, + struct xwidget *src) { struct input_event evt; - Lisp_Object val; + Lisp_Object val, src_val; XSETXWIDGET (val, xw); + XSETXWIDGET (src_val, src); EVENT_INIT (evt); evt.kind = XWIDGET_DISPLAY_EVENT; evt.frame_or_window = Qnil; - evt.arg = val; + evt.arg = list2 (val, src_val); kbd_buffer_store_event (&evt); } @@ -1335,6 +1337,9 @@ webkit_ready_to_show (WebKitWebView *new_view, { Lisp_Object tem; struct xwidget *xw; + struct xwidget *src; + + src = find_xwidget_for_offscreen_window (GDK_WINDOW (user_data)); for (tem = internal_xwidget_list; CONSP (tem); tem = XCDR (tem)) { @@ -1344,14 +1349,21 @@ webkit_ready_to_show (WebKitWebView *new_view, if (EQ (xw->type, Qwebkit) && WEBKIT_WEB_VIEW (xw->widget_osr) == new_view) - store_xwidget_display_event (xw); + { + /* The source widget was destroyed before we had a + chance to display the new widget. */ + if (!src) + kill_xwidget (xw); + else + store_xwidget_display_event (xw, src); + } } } } static GtkWidget * webkit_create_cb_1 (WebKitWebView *webview, - struct xwidget_view *xv) + struct xwidget *xv) { Lisp_Object related; Lisp_Object xwidget; @@ -1369,7 +1381,8 @@ webkit_create_cb_1 (WebKitWebView *webview, widget = XXWIDGET (xwidget)->widget_osr; g_signal_connect (G_OBJECT (widget), "ready-to-show", - G_CALLBACK (webkit_ready_to_show), NULL); + G_CALLBACK (webkit_ready_to_show), + gtk_widget_get_window (xv->widgetwindow_osr)); return widget; } @@ -1591,7 +1604,7 @@ webkit_decide_policy_cb (WebKitWebView *webView, newview = WEBKIT_WEB_VIEW (XXWIDGET (new_xwidget)->widget_osr); webkit_web_view_load_request (newview, request); - store_xwidget_display_event (XXWIDGET (new_xwidget)); + store_xwidget_display_event (XXWIDGET (new_xwidget), xw); return TRUE; } case WEBKIT_POLICY_DECISION_TYPE_NAVIGATION_ACTION: @@ -3106,6 +3119,11 @@ kill_frame_xwidget_views (struct frame *f) static void kill_xwidget (struct xwidget *xw) { + Lisp_Object val; + XSETXWIDGET (val, xw); + + internal_xwidget_list = Fdelq (val, internal_xwidget_list); + Vxwidget_list = Fcopy_sequence (internal_xwidget_list); #ifdef USE_GTK xw->buffer = Qnil; @@ -3145,8 +3163,6 @@ kill_buffer_xwidgets (Lisp_Object buffer) for (tail = Fget_buffer_xwidgets (buffer); CONSP (tail); tail = XCDR (tail)) { xwidget = XCAR (tail); - internal_xwidget_list = Fdelq (xwidget, internal_xwidget_list); - Vxwidget_list = Fcopy_sequence (internal_xwidget_list); { CHECK_LIVE_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); From 5fcff0d2cbe33faef8bbb753a5f02fb26b1d7e5c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 13:24:59 +0800 Subject: [PATCH 215/367] Use more precise test for emulated wheel events in XI2 * src/xterm.c (handle_one_xevent): Ignore button events that have XIPointerEmulated set. --- src/xterm.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 9d052c412b4..4e7ecd840ef 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10128,11 +10128,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, bool tool_bar_p = false; struct xi_device_t *device; +#ifdef XIPointerEmulated /* Ignore emulated scroll events when XI2 native scroll events are present. */ - if (dpyinfo->xi2_version >= 1 && xev->detail >= 4 - && xev->detail <= 8) + if (dpyinfo->xi2_version >= 1 + && xev->detail >= 4 + && xev->detail <= 8 + && xev->flags & XIPointerEmulated) goto XI_OTHER; +#endif device = xi_device_from_id (dpyinfo, xev->deviceid); From 1aef1a6673bc29784effe10d2e01e62b49c0112c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 22 Nov 2021 06:44:10 +0100 Subject: [PATCH 216/367] Add new format for literal key sequences to substitute-command-keys * lisp/help.el (substitute-command-keys): Add new format "\\`f'" for literal key sequences. (Bug#50804) * doc/lispref/help.texi (Keys in Documentation): Document the above new substitution. * test/lisp/help-tests.el (help-tests-substitute-command-keys/literal-key-sequence): (help-tests-substitute-command-keys/literal-key-sequence-errors): New tests. (help-tests-substitute-key-bindings/face-help-key-binding): Extend test. --- doc/lispref/help.texi | 7 +++++++ etc/NEWS | 9 +++++++++ lisp/help.el | 20 ++++++++++++++++++++ test/lisp/help-tests.el | 19 +++++++++++++++++++ 4 files changed, 55 insertions(+) diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index a788852de75..1a9eb30fde1 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -333,6 +333,13 @@ stands for no text itself. It is used only for a side effect: it specifies @var{mapvar}'s value as the keymap for any following @samp{\[@var{command}]} sequences in this documentation string. +@item \`@var{KEYSEQ}' +stands for a key sequence @var{KEYSEQ}, which will use the same face +as a command substitution. This should be used only when a key +sequence has no corresponding command, for example when it is read +directly with @code{read-key-sequence}. It must be a valid key +sequence according to @code{key-valid-p}. + @item ` (grave accent) stands for a left quote. This generates a left single quotation mark, an apostrophe, or a grave diff --git a/etc/NEWS b/etc/NEWS index 6fa5de0116d..b3693c82b4d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -716,6 +716,15 @@ syntax. This is like 'kbd', but only returns vectors instead of a mix of vectors and strings. ++++ +** New substitution in docstrings and 'substitute-command-keys'. Use +Use "\\`KEYSEQ'" to insert a literal key sequence "KEYSEQ" +(e.g. "C-k") in a docstring or when calling 'substitute-command-keys', +which will use the same face as a command substitution. This should +be used only when a key sequence has no corresponding command, for +example when it is read directly with 'read-key-sequence'. It must be +a valid key sequence according to 'key-valid-p'. + +++ ** New function 'file-name-split'. This returns a list of all the components of a file name. diff --git a/lisp/help.el b/lisp/help.el index bc3d4773dad..9122d96271d 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1078,6 +1078,9 @@ Each substring of the form \\\\=[COMMAND] is replaced by either a keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND is not on any keys. Keybindings will use the face `help-key-binding'. +Each substring of the form \\\\=`KEYBINDING' will be replaced by +KEYBINDING and use the `help-key-binding' face. + Each substring of the form \\\\={MAPVAR} is replaced by a summary of the value of MAPVAR as a keymap. This summary is similar to the one produced by ‘describe-bindings’. The summary ends in two newlines @@ -1130,6 +1133,23 @@ Otherwise, return a new string." (delete-char 2) (ignore-errors (forward-char 1))) + ((and (= (following-char) ?`) + (save-excursion + (prog1 (search-forward "'" nil t) + (setq end-point (- (point) 2))))) + (goto-char orig-point) + (delete-char 2) + (goto-char (1- end-point)) + (delete-char 1) + ;; (backward-char 1) + (let ((k (buffer-substring-no-properties orig-point (point)))) + (cond ((= (length k) 0) + (error "Empty key sequence in substitution")) + ((not (key-valid-p k)) + (error "Invalid key sequence in substitution: `%s'" k)))) + (add-text-properties orig-point (point) + '( face help-key-binding + font-lock-face help-key-binding))) ;; 1C. \[foo] is replaced with the keybinding. ((and (= (following-char) ?\[) (save-excursion diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 982750f479e..281d97ee929 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -88,6 +88,25 @@ (test "\\[emacs-version]\\[next-line]" "M-x emacs-versionC-n") (test-re "\\[emacs-version]`foo'" "M-x emacs-version[`'‘]foo['’]"))) +(ert-deftest help-tests-substitute-command-keys/literal-key-sequence () + "Literal replacement." + (with-substitute-command-keys-test + (test "\\`C-m'" "C-m") + (test "\\`C-m'\\`C-j'" "C-mC-j") + (test "foo\\`C-m'bar\\`C-j'baz" "fooC-mbarC-jbaz"))) + +(ert-deftest help-tests-substitute-command-keys/literal-key-sequence-errors () + (should-error (substitute-command-keys "\\`'")) + (should-error (substitute-command-keys "\\`c-c'")) + (should-error (substitute-command-keys "\\`'"))) + +(ert-deftest help-tests-substitute-key-bindings/face-help-key-binding () + (should (eq (get-text-property 0 'face (substitute-command-keys "\\[next-line]")) + 'help-key-binding)) + (should (eq (get-text-property 0 'face (substitute-command-keys "\\`f'")) + 'help-key-binding))) + + (ert-deftest help-tests-substitute-command-keys/keymaps () (with-substitute-command-keys-test (test-re "\\{minibuffer-local-must-match-map}" From 8aea4721d9fadfaaabfea7843df71b62e3fb94a7 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 14:06:18 +0800 Subject: [PATCH 217/367] Move XI2 event filtering to a more appropriate location * src/xterm.c (handle_one_xevent): Filter all key press events even if no frame is found. --- src/xterm.c | 55 +++++++++++++++++++++++++++++------------------------ 1 file changed, 30 insertions(+), 25 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 4e7ecd840ef..197776ce316 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10312,6 +10312,36 @@ handle_one_xevent (struct x_display_info *dpyinfo, ptrdiff_t i; int nchars, len; +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + /* Dispatch XI_KeyPress events when in menu. */ + if (popup_activated ()) + goto XI_OTHER; +#endif + +#ifdef HAVE_X_I18N + XKeyPressedEvent xkey; + + memset (&xkey, 0, sizeof xkey); + + xkey.type = KeyPress; + xkey.serial = 0; + xkey.send_event = xev->send_event; + xkey.display = xev->display; + xkey.window = xev->event; + xkey.root = xev->root; + xkey.subwindow = xev->child; + xkey.time = xev->time; + xkey.state = xev->mods.effective; + xkey.keycode = xev->detail; + xkey.same_screen = True; + + if (x_filter_event (dpyinfo, (XEvent *) &xkey)) + { + *finish = X_EVENT_DROP; + goto XI_OTHER; + } +#endif + #ifdef HAVE_XKB if (dpyinfo->xkb_desc) { @@ -10341,12 +10371,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_display_set_last_user_time (dpyinfo, xev->time); ignore_next_mouse_click_timeout = 0; -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) - /* Dispatch XI_KeyPress events when in menu. */ - if (popup_activated ()) - goto XI_OTHER; -#endif - f = x_any_window_to_frame (dpyinfo, xev->event); /* If mouse-highlight is an integer, input clears out @@ -10385,25 +10409,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.timestamp = xev->time; #ifdef HAVE_X_I18N - XKeyPressedEvent xkey; - - memset (&xkey, 0, sizeof xkey); - - xkey.type = KeyPress; - xkey.serial = 0; - xkey.send_event = xev->send_event; - xkey.display = xev->display; - xkey.window = xev->event; - xkey.root = xev->root; - xkey.subwindow = xev->child; - xkey.time = xev->time; - xkey.state = state; - xkey.keycode = keycode; - xkey.same_screen = True; - - if (x_filter_event (dpyinfo, (XEvent *) &xkey)) - goto xi_done_keysym; - if (FRAME_XIC (f)) { Status status_return; From 9d8a2832e857fa82d401709ee4b56682ccb5b7d4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 06:33:22 +0000 Subject: [PATCH 218/367] Don't set button event modifiers twice on Haiku * src/haikuterm.c (haiku_read_socket): Simplify. --- src/haikuterm.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/haikuterm.c b/src/haikuterm.c index 61920dbecef..bc956f066a9 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2858,9 +2858,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) inev.arg = tab_bar_arg; inev.code = b->btn_no; - inev.modifiers |= type == BUTTON_UP ? - up_modifier : down_modifier; - XSETINT (inev.x, b->x); XSETINT (inev.y, b->y); From c7699b97022f5bdc3848d474485e0da5f2673595 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 07:10:57 +0000 Subject: [PATCH 219/367] Fix mouse movement event generation on Haiku * src/haikuterm.c (haiku_mouse_position): Set timestamp. (haiku_read_socket): Set last_mouse_movement_time. * src/haikuterm.h (struct haiku_display_info): Add field `last_mouse_movement_time'. --- src/haikuterm.c | 30 +++++++++++++++++++++++------- src/haikuterm.h | 3 +++ 2 files changed, 26 insertions(+), 7 deletions(-) diff --git a/src/haikuterm.c b/src/haikuterm.c index bc956f066a9..5364ebf823a 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2386,9 +2386,10 @@ haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, Time *timestamp) { - block_input (); if (!fp) return; + + block_input (); Lisp_Object frame, tail; struct frame *f1 = NULL; FOR_EACH_FRAME (tail, frame) @@ -2428,6 +2429,7 @@ haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, *bar_window = Qnil; *part = scroll_bar_above_handle; *fp = f1; + *timestamp = x_display_list->last_mouse_movement_time; XSETINT (*x, sx); XSETINT (*y, sy); } @@ -2578,6 +2580,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) static void *buf = NULL; ssize_t b_size; struct unhandled_event *unhandled_events = NULL; + int button_or_motion_p; if (!buf) buf = xmalloc (200); @@ -2597,6 +2600,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) inev.arg = Qnil; inev2.arg = Qnil; + button_or_motion_p = 0; + haiku_read (&type, buf, b_size); switch (type) @@ -2721,6 +2726,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) Lisp_Object frame; XSETFRAME (frame, f); + x_display_list->last_mouse_movement_time = time (NULL); + button_or_motion_p = 1; + if (b->just_exited_p) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); @@ -2748,9 +2756,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) previous_help_echo_string = help_echo_string; help_echo_string = Qnil; - if (f != dpyinfo->last_mouse_glyph_frame || - b->x < r.x || b->x >= r.x + r.width - 1 || b->y < r.y || - b->y >= r.y + r.height - 1) + if (f != dpyinfo->last_mouse_glyph_frame + || b->x < r.x || b->x >= r.x + r.width + || b->y < r.y || b->y >= r.y + r.height) { f->mouse_moved = true; dpyinfo->last_mouse_scroll_bar = NULL; @@ -2805,6 +2813,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); x_display_list->last_mouse_glyph_frame = 0; + x_display_list->last_mouse_movement_time = time (NULL); + button_or_motion_p = 1; /* Is this in the tab-bar? */ if (WINDOWP (f->tab_bar_window) @@ -2858,6 +2868,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) inev.arg = tab_bar_arg; inev.code = b->btn_no; + f->mouse_moved = false; + XSETINT (inev.x, b->x); XSETINT (inev.y, b->y); @@ -3183,15 +3195,19 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (inev.kind != NO_EVENT) { if (inev.kind != HELP_EVENT) - inev.timestamp = time (NULL); + inev.timestamp = (button_or_motion_p + ? x_display_list->last_mouse_movement_time + : time (NULL)); kbd_buffer_store_event_hold (&inev, hold_quit); ++message_count; } if (inev2.kind != NO_EVENT) { - if (inev.kind != HELP_EVENT) - inev.timestamp = time (NULL); + if (inev2.kind != HELP_EVENT) + inev2.timestamp = (button_or_motion_p + ? x_display_list->last_mouse_movement_time + : time (NULL)); kbd_buffer_store_event_hold (&inev2, hold_quit); ++message_count; } diff --git a/src/haikuterm.h b/src/haikuterm.h index af55f68c679..7ed7485ef53 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -30,6 +30,7 @@ along with GNU Emacs. If not, see . */ #include "character.h" #include "dispextern.h" #include "font.h" +#include "systime.h" #define C_FRAME struct frame * #define C_FONT struct font * @@ -107,6 +108,8 @@ struct haiku_display_info haiku display; double resx, resy; + + Time last_mouse_movement_time; }; struct haiku_output From 61c254cafc9caa3b52553fa0e7cca8a5086c5cea Mon Sep 17 00:00:00 2001 From: martin rudalics Date: Mon, 22 Nov 2021 12:02:35 +0100 Subject: [PATCH 220/367] Add new function buffer-text-pixel-size * doc/lispref/display.texi (Size of Displayed Text): Document it. * lisp/emacs-lisp/subr-x.el (string-pixel-width): Use buffer-text-pixel-size (bug#51995). * src/xdisp.c (window_text_pixel_size): Factor out from Fwindow_text_pixel_size. (Fbuffer_text_pixel_size): New function. --- doc/lispref/display.texi | 15 +++ etc/NEWS | 5 + lisp/emacs-lisp/subr-x.el | 3 +- src/xdisp.c | 199 +++++++++++++++++++++++++------------- 4 files changed, 152 insertions(+), 70 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index b948aff0242..23418831290 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2140,6 +2140,21 @@ height of all of these lines, if present, in the return value. whole and does not care about the size of individual lines. The following function does. +@defun buffer-text-pixel-size &optional buffer-or-name window from to x-limit y-limit +This is much like @code{window-text-pixel-size}, but can be used when +the buffer isn't shown in a window. (@code{window-text-pixel-size} is +faster when it is, so this function shouldn't be used in that case.) + +@var{buffer-or-name} must specify a live buffer or the name of a live +buffer and defaults to the current buffer. @var{window} must be a +live window and defaults to the selected one. The return value is a +cons of the maximum pixel-width of any text line and the pixel-height +of all the text lines of the buffer specified by @var{buffer-or-name}. + +The optional arguments @var{x-limit} and @var{y-limit} have the same +meaning as with @code{window-text-pixel-size}. +@end defun + @defun window-lines-pixel-dimensions &optional window first last body inverse left This function calculates the pixel dimensions of each line displayed in the specified @var{window}. It does so by walking @var{window}'s diff --git a/etc/NEWS b/etc/NEWS index b3693c82b4d..626b67d03a8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -75,6 +75,11 @@ time. * Changes in Emacs 29.1 ++++ +** New function 'buffer-text-pixel-size'. +This is similar to 'window-text-pixel-size', but can be used when the +buffer isn't displayed. + +++ ** New X resource: "borderThickness". This controls the thickness of the external borders of the menu bars diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index f336799040f..b2dae564c2b 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -446,8 +446,7 @@ is inserted before adjusting the number of empty lines." "Return the width of STRING in pixels." (with-temp-buffer (insert string) - (car (window-text-pixel-size - (current-buffer) (point-min) (point))))) + (car (buffer-text-pixel-size nil nil t)))) ;;;###autoload (defun string-glyph-split (string) diff --git a/src/xdisp.c b/src/xdisp.c index 8d34b7c4c30..d9650211427 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10626,77 +10626,21 @@ in_display_vector_p (struct it *it) && it->dpvec + it->current.dpvec_index != it->dpend); } -DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 6, 0, - doc: /* Return the size of the text of WINDOW's buffer in pixels. -WINDOW can be any live window and defaults to the selected one. The -return value is a cons of the maximum pixel-width of any text line -and the pixel-height of all the text lines in the accessible portion -of buffer text. -WINDOW can also be a buffer, in which case the selected window is used, -and the function behaves as if that window was displaying this buffer. - -This function exists to allow Lisp programs to adjust the dimensions -of WINDOW to the buffer text it needs to display. - -The optional argument FROM, if non-nil, specifies the first text -position to consider, and defaults to the minimum accessible position -of the buffer. If FROM is t, it stands for the minimum accessible -position that starts a non-empty line. TO, if non-nil, specifies the -last text position and defaults to the maximum accessible position of -the buffer. If TO is t, it stands for the maximum accessible position -that ends a non-empty line. - -The optional argument X-LIMIT, if non-nil, specifies the maximum X -coordinate beyond which the text should be ignored. It is therefore -also the maximum width that the function can return. X-LIMIT nil or -omitted means to use the pixel-width of WINDOW's body. This default -means text of truncated lines wider than the window will be ignored; -specify a large value for X-LIMIT if lines are truncated and you need -to account for the truncated text. Use nil for X-LIMIT if you want to -know how high WINDOW should become in order to fit all of its buffer's -text with the width of WINDOW unaltered. Use the maximum width WINDOW -may assume if you intend to change WINDOW's width. Since calculating -the width of long lines can take some time, it's always a good idea to -make this argument as small as possible; in particular, if the buffer -contains long lines that shall be truncated anyway. - -The optional argument Y-LIMIT, if non-nil, specifies the maximum Y -coordinate beyond which the text is to be ignored; it is therefore -also the maximum height that the function can return (excluding the -height of the mode- or header-line, if any). Y-LIMIT nil or omitted -means consider all of the accessible portion of buffer text up to the -position specified by TO. Since calculating the text height of a -large buffer can take some time, it makes sense to specify this -argument if the size of the buffer is large or unknown. - -Optional argument MODE-LINES nil or omitted means do not include the -height of the mode-, tab- or header-line of WINDOW in the return value. -If it is the symbol `mode-line', 'tab-line' or `header-line', include -only the height of that line, if present, in the return value. If t, -include the height of any of these, if present, in the return value. */) - (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, - Lisp_Object y_limit, Lisp_Object mode_lines) +/* This is like Fwindow_text_pixel_size but assumes that WINDOW's buffer + is the current buffer. Fbuffer_text_pixel_size calls it after it has + set WINDOW's buffer to the buffer specified by its BUFFER_OR_NAME + argument. */ +static Lisp_Object +window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, + Lisp_Object y_limit, Lisp_Object mode_lines) { - struct window *w = BUFFERP (window) ? XWINDOW (selected_window) - : decode_live_window (window); - Lisp_Object buffer = BUFFERP (window) ? window : w->contents; - struct buffer *b; + struct window *w = decode_live_window (window); struct it it; - struct buffer *old_b = NULL; ptrdiff_t start, end, bpos; struct text_pos startp; void *itdata = NULL; int c, max_x = 0, max_y = 0, x = 0, y = 0; - CHECK_BUFFER (buffer); - b = XBUFFER (buffer); - - if (b != current_buffer) - { - old_b = current_buffer; - set_buffer_internal (b); - } - if (NILP (from)) { start = BEGV; @@ -10755,8 +10699,10 @@ include the height of any of these, if present, in the return value. */) else end = clip_to_bounds (start, fix_position (to), ZV); - if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) + if (RANGED_FIXNUMP (0, x_limit, INT_MAX)) max_x = XFIXNUM (x_limit); + else if (!NILP (x_limit)) + max_x = INT_MAX; if (NILP (y_limit)) max_y = INT_MAX; @@ -10889,12 +10835,128 @@ include the height of any of these, if present, in the return value. */) bidi_unshelve_cache (itdata, false); - if (old_b) - set_buffer_internal (old_b); - return Fcons (make_fixnum (x - start_x), make_fixnum (y)); } +DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 6, 0, + doc: /* Return the size of the text of WINDOW's buffer in pixels. +WINDOW must be a live window and defaults to the selected one. The +return value is a cons of the maximum pixel-width of any text line +and the pixel-height of all the text lines in the accessible portion +of buffer text. + +This function exists to allow Lisp programs to adjust the dimensions +of WINDOW to the buffer text it needs to display. + +The optional argument FROM, if non-nil, specifies the first text +position to consider, and defaults to the minimum accessible position +of the buffer. If FROM is t, it stands for the minimum accessible +position that starts a non-empty line. TO, if non-nil, specifies the +last text position and defaults to the maximum accessible position of +the buffer. If TO is t, it stands for the maximum accessible position +that ends a non-empty line. + +The optional argument X-LIMIT, if non-nil, specifies the maximum X +coordinate beyond which the text should be ignored. It is therefore +also the maximum width that the function can return. X-LIMIT nil or +omitted means to use the pixel-width of WINDOW's body. This default +means text of truncated lines wider than the window will be ignored; +specify a non-nil value for X-LIMIT if lines are truncated and you need +to account for the truncated text. + +Use nil for X-LIMIT if you want to know how high WINDOW should become in +order to fit all of its buffer's text with the width of WINDOW +unaltered. Use the maximum width WINDOW may assume if you intend to +change WINDOW's width. Use t for the maximum possible value. Since +calculating the width of long lines can take some time, it's always a +good idea to make this argument as small as possible; in particular, if +the buffer contains long lines that shall be truncated anyway. + +The optional argument Y-LIMIT, if non-nil, specifies the maximum Y +coordinate beyond which the text is to be ignored; it is therefore +also the maximum height that the function can return (excluding the +height of the mode- or header-line, if any). Y-LIMIT nil or omitted +means consider all of the accessible portion of buffer text up to the +position specified by TO. Since calculating the text height of a +large buffer can take some time, it makes sense to specify this +argument if the size of the buffer is large or unknown. + +Optional argument MODE-LINES nil or omitted means do not include the +height of the mode-, tab- or header-line of WINDOW in the return value. +If it is the symbol `mode-line', 'tab-line' or `header-line', include +only the height of that line, if present, in the return value. If t, +include the height of any of these, if present, in the return value. */) + (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, + Lisp_Object y_limit, Lisp_Object mode_lines) +{ + struct window *w = decode_live_window (window); + struct buffer *b = XBUFFER (w->contents); + struct buffer *old_b = NULL; + Lisp_Object value; + + if (b != current_buffer) + { + old_b = current_buffer; + set_buffer_internal_1 (b); + } + + value = window_text_pixel_size (window, from, to, x_limit, y_limit, mode_lines); + + if (old_b) + set_buffer_internal_1 (old_b); + + return value; +} + +DEFUN ("buffer-text-pixel-size", Fbuffer_text_pixel_size, Sbuffer_text_pixel_size, 0, 4, 0, + doc: /* Return size of whole text of BUFFER-OR-NAME in WINDOW. +BUFFER-OR-NAME must specify a live buffer or the name of a live buffer +and defaults to the current buffer. WINDOW must be a live window and +defaults to the selected one. The return value is a cons of the maximum +pixel-width of any text line and the pixel-height of all the text lines +of the buffer specified by BUFFER-OR-NAME. + +The optional arguments X-LIMIT and Y-LIMIT have the same meaning as with +`window-text-pixel-size'. + +Do not use this function if the buffer specified by BUFFER-OR-NAME is +already displayed in WINDOW. `window-text-pixel-size' is cheaper in +that case because it does not have to temporarily show that buffer in +WINDOW. */) + (Lisp_Object buffer_or_name, Lisp_Object window, Lisp_Object x_limit, + Lisp_Object y_limit) +{ + struct window *w = decode_live_window (window); + struct buffer *b = (NILP (buffer_or_name) + ? current_buffer + : XBUFFER (Fget_buffer (buffer_or_name))); + Lisp_Object buffer, value; + ptrdiff_t count = SPECPDL_INDEX (); + + XSETBUFFER (buffer, b); + + /* The unwind form of with_echo_area_buffer is what we need here to + make WINDOW temporarily show our buffer. */ + record_unwind_protect (unwind_with_echo_area_buffer, + with_echo_area_buffer_unwind_data (w)); + + set_buffer_internal_1 (b); + + if (!EQ (buffer, w->contents)) + { + wset_buffer (w, buffer); + set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); + set_marker_both (w->old_pointm, buffer, BEG, BEG_BYTE); + } + + value = window_text_pixel_size (window, Qnil, Qnil, x_limit, y_limit, Qnil); + + unbind_to (count, Qnil); + + return value; +} + + DEFUN ("display--line-is-continued-p", Fdisplay__line_is_continued_p, Sdisplay__line_is_continued_p, 0, 0, 0, doc: /* Return non-nil if the current screen line is continued on display. */) @@ -35040,6 +35102,7 @@ be let-bound around code that needs to disable messages temporarily. */); defsubr (&Sinvisible_p); defsubr (&Scurrent_bidi_paragraph_direction); defsubr (&Swindow_text_pixel_size); + defsubr (&Sbuffer_text_pixel_size); defsubr (&Smove_point_visually); defsubr (&Sbidi_find_overridden_directionality); defsubr (&Sdisplay__line_is_continued_p); From e91f71676c19127dd90efabfc0da36483aa53a82 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 22 Nov 2021 08:08:11 +0100 Subject: [PATCH 221/367] Avoid false positives about wide docstrings for key sequences * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): Ignore literal key sequence substitutions. * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el: New file. * test/lisp/emacs-lisp/bytecomp-tests.el ("warn-wide-docstring-ignore-substitutions.el"): New test. --- lisp/emacs-lisp/bytecomp.el | 7 ++++++- .../warn-wide-docstring-ignore-substitutions.el | 17 +++++++++++++++++ test/lisp/emacs-lisp/bytecomp-tests.el | 4 ++++ 3 files changed, 27 insertions(+), 1 deletion(-) create mode 100644 test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3338c383171..bd74c79d717 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1674,7 +1674,12 @@ URLs." (replace-regexp-in-string (rx "\\" (or (seq "[" (* (not "]")) "]"))) (make-string byte-compile--wide-docstring-substitution-len ?x) - docstring)))) + ;; For literal key sequence substitutions (e.g. "\\`C-h'"), just + ;; remove the markup as `substitute-command-keys' would. + (replace-regexp-in-string + (rx "\\" (seq "`" (group (* (not "]"))) "'")) + "\\1" + docstring))))) (defcustom byte-compile-docstring-max-column 80 "Recommended maximum width of doc string lines. diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el new file mode 100644 index 00000000000..37cfe463bfe --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el @@ -0,0 +1,17 @@ +;;; -*- lexical-binding: t -*- +(defalias 'foo #'ignore + "None of this should be considered too wide. + +; this should be treated as 60 characters - no warning +\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window] + +; 64 * 'x' does not warn +\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x' + +; keymaps are just ignored +\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map} + +bar baz foo bar baz foo bar baz foo bar baz foo bar baz foo bar +") diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index dbc0aa3db42..816f14a18d5 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -955,6 +955,10 @@ byte-compiled. Run with dynamic binding." "warn-wide-docstring-ignore-override.el" "defvar .foo-bar. docstring wider than .* characters" 'reverse) +(bytecomp--define-warning-file-test + "warn-wide-docstring-ignore-substitutions.el" + "defvar .foo-bar. docstring wider than .* characters" 'reverse) + (bytecomp--define-warning-file-test "warn-wide-docstring-ignore.el" "defvar .foo-bar. docstring wider than .* characters" 'reverse) From 4a3ba8528bc8b8f083251cbebe46e5978e9ec816 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 22 Nov 2021 11:45:44 +0100 Subject: [PATCH 222/367] Use substitute-command-keys for literal key sequences * lisp/abbrev.el (expand-region-abbrevs): * lisp/calc/calc-graph.el (calc-graph-show-dumb): * lisp/calc/calc-help.el (calc-help-for-help): * lisp/calc/calc-mode.el (calc-auto-why): * lisp/calc/calc.el (calc-do): * lisp/calculator.el (calculator-mode): * lisp/dired-aux.el (dired-create-files) (dired-do-create-files-regexp, dired-create-files-non-directory): * lisp/dired-x.el (dired-virtual): * lisp/dired.el (dired-mark-region, dired-unmark-all-files): * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): * lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode): * lisp/epa-ks.el (epa-ks--display-keys): * lisp/erc/erc.el (erc-toggle-debug-irc-protocol): * lisp/files.el (save-some-buffers): * lisp/gnus/gnus-dired.el (gnus-dired-find-file-mailcap) (gnus-dired-print): * lisp/gnus/gnus-group.el (gnus-keep-same-level): * lisp/gnus/gnus-score.el (gnus-score-find-trace): * lisp/gnus/gnus.el (to-list): * lisp/gnus/message.el (message--send-mail-maybe-partially): * lisp/mail/supercite.el (sc-set-variable): * lisp/minibuffer.el (minibuffer-inactive-mode): * lisp/progmodes/etags.el (select-tags-table): * lisp/progmodes/idlw-shell.el (idlwave-shell-mode) (idlwave-shell-char-mode-loop): * lisp/replace.el (query-replace-help): * lisp/simple.el (set-variable): * lisp/subr.el (read-char-from-minibuffer): * lisp/textmodes/ispell.el (ispell-help, ispell-message): * lisp/textmodes/reftex-global.el (reftex-find-duplicate-labels): * lisp/textmodes/reftex-vars.el (reftex-toc-include-file-boundaries) (reftex-toc-include-labels, reftex-toc-include-index-entries) (reftex-toc-include-context, reftex-toc-follow-mode) (reftex-index-include-context, reftex-index-follow-mode) (reftex-enable-partial-scans) (reftex-auto-update-selection-buffers) (reftex-highlight-selection): * lisp/time.el (display-time-update): * lisp/vc/ediff-help.el (ediff-help-for-quick-help): * lisp/vc/ediff-init.el (ediff-keep-variants): * lisp/vc/ediff-ptch.el (ediff-fixup-patch-map) (ediff-patch-file-internal): * lisp/windmove.el (windmove-delete-default-keybindings): Use 'substitute-command-keys' for literal key sequences. * lisp/userlock.el (userlock--fontify-key): Remove function. (ask-user-about-lock, ask-user-about-lock-help) (ask-user-about-supersession-threat) (ask-user-about-supersession-help): Use 'substitute-command-keys' for literal key sequences. * lisp/ibuffer.el (ibuffer-unmark-all): Use 'substitute-command-keys' for command. --- lisp/abbrev.el | 2 +- lisp/calc/calc-graph.el | 3 +- lisp/calc/calc-help.el | 28 ++++++------ lisp/calc/calc-misc.el | 42 +++++++++--------- lisp/calc/calc-mode.el | 9 ++-- lisp/calc/calc.el | 3 +- lisp/calculator.el | 42 +++++++++--------- lisp/dired-aux.el | 33 +++++++------- lisp/dired-x.el | 2 +- lisp/dired.el | 12 ++--- lisp/emacs-lisp/map-ynp.el | 12 ++--- lisp/emacs-lisp/re-builder.el | 3 +- lisp/epa-ks.el | 3 +- lisp/erc/erc.el | 3 +- lisp/files.el | 12 ++--- lisp/gnus/gnus-dired.el | 10 +++-- lisp/gnus/gnus-group.el | 2 +- lisp/gnus/gnus-score.el | 15 ++++--- lisp/gnus/gnus.el | 4 +- lisp/gnus/message.el | 14 +++--- lisp/ibuffer.el | 4 +- lisp/mail/supercite.el | 2 +- lisp/minibuffer.el | 2 +- lisp/progmodes/etags.el | 3 +- lisp/progmodes/idlw-shell.el | 7 +-- lisp/replace.el | 26 +++++------ lisp/simple.el | 2 +- lisp/subr.el | 2 +- lisp/textmodes/ispell.el | 78 +++++++++++++++++---------------- lisp/textmodes/reftex-global.el | 6 ++- lisp/textmodes/reftex-vars.el | 23 +++++----- lisp/time.el | 2 +- lisp/userlock.el | 62 +++++++++----------------- lisp/vc/ediff-help.el | 4 +- lisp/vc/ediff-init.el | 4 +- lisp/vc/ediff-ptch.el | 15 ++++--- lisp/windmove.el | 2 +- 37 files changed, 255 insertions(+), 243 deletions(-) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index d3daf637cc6..386aff16270 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -403,7 +403,7 @@ argument." (defun expand-region-abbrevs (start end &optional noquery) "For abbrev occurrence in the region, offer to expand it. -The user is asked to type `y' or `n' for each occurrence. +The user is asked to type \\`y' or \\`n' for each occurrence. A prefix argument means don't query; expand all abbrevs." (interactive "r\nP") (save-excursion diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 7891e35c40f..b6ee124a72f 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -969,7 +969,8 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit))) (use-local-map calc-dumb-map) (setq truncate-lines t) - (message "Type `q' or `C-c C-c' to return to Calc") + (message (substitute-command-keys + "Type \\`q' or \\`C-c C-c' to return to Calc")) (recursive-edit) (bury-buffer "*Gnuplot Trail*"))) diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 8481d0b5e9d..2633d64fe42 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -50,25 +50,25 @@ (beep)))) (defun calc-help-for-help (arg) - "You have typed `h', the Calc help character. Type a Help option: + "You have typed \\`h', the Calc help character. Type a Help option: -B calc-describe-bindings. Display a table of all key bindings. -H calc-full-help. Display all `?' key messages at once. +\\`B' calc-describe-bindings. Display a table of all key bindings. +\\`H' calc-full-help. Display all \\`?' key messages at once. -I calc-info. Read the Calc manual using the Info system. -T calc-tutorial. Read the Calc tutorial using the Info system. -S calc-info-summary. Read the Calc summary using the Info system. +\\`I' calc-info. Read the Calc manual using the Info system. +\\`T' calc-tutorial. Read the Calc tutorial using the Info system. +\\`S' calc-info-summary. Read the Calc summary using the Info system. -C calc-describe-key-briefly. Look up the command name for a given key. -K calc-describe-key. Look up a key's documentation in the manual. -F calc-describe-function. Look up a function's documentation in the manual. -V calc-describe-variable. Look up a variable's documentation in the manual. +\\`C' calc-describe-key-briefly. Look up the command name for a given key. +\\`K' calc-describe-key. Look up a key's documentation in the manual. +\\`F' calc-describe-function. Look up a function's documentation in the manual. +\\`V' calc-describe-variable. Look up a variable's documentation in the manual. -N calc-view-news. Display Calc history of changes. +\\`N' calc-view-news. Display Calc history of changes. -C-c Describe conditions for copying Calc. -C-d Describe how you can get a new copy of Calc or report a bug. -C-w Describe how there is no warranty for Calc." +\\`C-c' Describe conditions for copying Calc. +\\`C-d' Describe how you can get a new copy of Calc or report a bug. +\\`C-w' Describe how there is no warranty for Calc." (interactive "P") (if calc-dispatch-help (let (key) diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index c8394e8c2fa..1c4438e7f7a 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -216,26 +216,28 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C)." (defun calc-help () (interactive) (let ((msgs - '("Press `h' for complete help; press `?' repeatedly for a summary" - "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit" - "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option" - "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB" - "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi" - "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args" - "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)" - "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)" - "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)" - "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)" - "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)" - "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)" - "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)" - "Prefix keys: Algebra, Binary/business, Convert, Display" - "Prefix keys: Functions, Graphics, Help, J (select)" - "Prefix keys: Kombinatorics/statistics, Modes, Store/recall" - "Prefix keys: Trail/time, Units/statistics, Vector/matrix" - "Prefix keys: Z (user), SHIFT + Z (define)" - "Prefix keys: prefix + ? gives further help for that prefix" - " Calc by Dave Gillespie, daveg@synaptics.com"))) + ;; FIXME: Change these to `substitute-command-keys' syntax. + (mapcar #'substitute-command-keys + '("Press \\`h' for complete help; press \\`?' repeatedly for a summary" + "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit" + "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option" + "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB" + "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi" + "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args" + "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)" + "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)" + "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)" + "Other keys: \\`SPC'/\\`RET' (enter/dup), LFD (over); < > (scroll horiz)" + "Other keys: \\`DEL' (drop), \\`M-DEL' (drop-above); { } (scroll vert)" + "Other keys: \\`TAB' (swap/roll-dn), \\`M-TAB' (roll-up)" + "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)" + "Prefix keys: Algebra, Binary/business, Convert, Display" + "Prefix keys: Functions, Graphics, Help, J (select)" + "Prefix keys: Kombinatorics/statistics, Modes, Store/recall" + "Prefix keys: Trail/time, Units/statistics, Vector/matrix" + "Prefix keys: Z (user), SHIFT + Z (define)" + "Prefix keys: prefix + ? gives further help for that prefix" + " Calc by Dave Gillespie, daveg@synaptics.com")))) (if calc-full-help-flag msgs (if (or calc-inverse-flag calc-hyperbolic-flag) diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index 68c8b90ac3b..211b8e661fd 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -109,11 +109,14 @@ (setq n (and (not (eq calc-auto-why t)) (if calc-auto-why t 1)))) (calc-change-mode 'calc-auto-why n nil) (cond ((null n) - (message "User must press `w' to explain unsimplified results")) + (message (substitute-command-keys + "User must press \\`w' to explain unsimplified results"))) ((eq n t) - (message "Automatically doing `w' to explain unsimplified results")) + (message (substitute-command-keys + "Automatically doing \\`w' to explain unsimplified results"))) (t - (message "Automatically doing `w' only for unusual messages"))))) + (message (substitute-command-keys + "Automatically doing \\`w' only for unusual messages")))))) (defun calc-group-digits (n) (interactive "P") diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index bd4ec4ff2f0..9774ddff402 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1621,7 +1621,8 @@ See calc-keypad for details." (stringp (nth 1 err)) (string-match "max-specpdl-size\\|max-lisp-eval-depth" (nth 1 err))) - (error "Computation got stuck or ran too long. Type `M' to increase the limit") + (error (substitute-command-keys + "Computation got stuck or ran too long. Type \\`M' to increase the limit")) (setq calc-aborted-prefix nil) (signal (car err) (cdr err))))) (when calc-aborted-prefix diff --git a/lisp/calculator.el b/lisp/calculator.el index 6bcea2d885e..0c255c0cf9d 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -593,15 +593,15 @@ except when using a non-decimal radix mode for input (in this case `e' will be the hexadecimal digit). Here are the editing keys: -* `RET' `=' evaluate the current expression -* `C-insert' copy the whole current expression to the `kill-ring' -* `C-return' evaluate, save result the `kill-ring' and exit -* `insert' paste a number if the one was copied (normally) -* `delete' `C-d' clear last argument or whole expression (hit twice) -* `backspace' delete a digit or a previous expression element -* `h' `?' pop-up a quick reference help -* `ESC' `q' exit (`ESC' can be used if `calculator-bind-escape' is - non-nil, otherwise use three consecutive `ESC's) +* \\`RET' \\`=' evaluate the current expression +* \\`C-' copy the whole current expression to the `kill-ring' +* \\`C-' evaluate, save result the `kill-ring' and exit +* \\`' paste a number if the one was copied (normally) +* \\`' \\`C-d' clear last argument or whole expression (hit twice) +* \\`' delete a digit or a previous expression element +* \\`h' \\`?' pop-up a quick reference help +* \\`ESC' \\`q' exit (\\`ESC' can be used if `calculator-bind-escape' is + non-nil, otherwise use three consecutive \\`ESC's) These operators are pre-defined: * `+' `-' `*' `/' the common binary operators @@ -623,10 +623,10 @@ argument. hex/oct/bin modes can be set for input and for display separately. Another toggle-able mode is for using degrees instead of radians for trigonometric functions. -The keys to switch modes are (both `H' and `X' are for hex): -* `D' switch to all-decimal mode, or toggle degrees/radians -* `B' `O' `H' `X' binary/octal/hexadecimal modes for input & display -* `i' `o' followed by one of `D' `B' `O' `H' `X' (case +The keys to switch modes are (both \\`H' and \\`X' are for hex): +* \\`D' switch to all-decimal mode, or toggle degrees/radians +* \\`B' \\`O' \\`H' \\`X' binary/octal/hexadecimal modes for input & display +* \\`i' \\`o' followed by one of \\`D' \\`B' \\`O' \\`H' \\`X' (case insensitive) sets only the input or display radix mode The prompt indicates the current modes: * \"==\": decimal mode (using radians); @@ -649,17 +649,17 @@ collected data. It is possible to navigate in this list, and if the value shown is the current one on the list, an indication is displayed as \"[N]\" if this is the last number and there are N numbers, or \"[M/N]\" if the M-th value is shown. -* `SPC' evaluate the current value as usual, but also adds +* \\`SPC' evaluate the current value as usual, but also adds the result to the list of saved values -* `l' `v' computes total / average of saved values -* `up' `C-p' browse to the previous value in the list -* `down' `C-n' browse to the next value in the list -* `delete' `C-d' remove current value from the list (if it is on it) -* `C-delete' `C-c' delete the whole list +* \\`l' \\`v' computes total / average of saved values +* \\`' \\`C-p' browse to the previous value in the list +* \\`' \\`C-n' browse to the next value in the list +* \\`' \\`C-d' remove current value from the list (if it is on it) +* \\`C-' \\`C-c' delete the whole list Registers are variable-like place-holders for values: -* `s' followed by a character attach the current value to that character -* `g' followed by a character fetches the attached value +* \\`s' followed by a character attach the current value to that character +* \\`g' followed by a character fetches the attached value There are many variables that can be used to customize the calculator. Some interesting customization variables are: diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 92409db33ea..588551a6417 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1989,11 +1989,12 @@ or with the current marker character if MARKER-CHAR is t." (let* ((overwrite (file-exists-p to)) (dired-overwrite-confirmed ; for dired-handle-overwrite (and overwrite - (let ((help-form (format-message "\ -Type SPC or `y' to overwrite file `%s', -DEL or `n' to skip to next, -ESC or `q' to not overwrite any of the remaining files, -`!' to overwrite all remaining files with no more questions." to))) + (let ((help-form (format-message + (substitute-command-keys "\ +Type \\`SPC' or \\`y' to overwrite file `%s', +\\`DEL' or \\`n' to skip to next, +\\`ESC' or \\`q' to not overwrite any of the remaining files, +\\`!' to overwrite all remaining files with no more questions.") to))) (dired-query 'overwrite-query "Overwrite `%s'?" to)))) ;; must determine if FROM is marked before file-creator @@ -2486,11 +2487,12 @@ Also see `dired-do-revert-buffer'." ;; Optional arg MARKER-CHAR as in dired-create-files. (let* ((fn-list (dired-get-marked-files nil arg)) (operation-prompt (concat operation " `%s' to `%s'?")) - (rename-regexp-help-form (format-message "\ -Type SPC or `y' to %s one match, DEL or `n' to skip to next, -`!' to %s all remaining matches with no more questions." - (downcase operation) - (downcase operation))) + (rename-regexp-help-form (format-message + (substitute-command-keys "\ +Type \\`SPC' or \\`y' to %s one match, \\`DEL' or \\`n' to skip to next, +\\`!' to %s all remaining matches with no more questions.") + (downcase operation) + (downcase operation))) (regexp-name-constructor ;; Function to construct new filename using REGEXP and NEWNAME: (if whole-name ; easy (but rare) case @@ -2611,11 +2613,12 @@ See function `dired-do-rename-regexp' for more info." (let ((to (concat (file-name-directory from) (funcall basename-constructor (file-name-nondirectory from))))) - (and (let ((help-form (format-message "\ -Type SPC or `y' to %s one file, DEL or `n' to skip to next, -`!' to %s all remaining matches with no more questions." - (downcase operation) - (downcase operation)))) + (and (let ((help-form (format-message + (substitute-command-keys "\ +Type \\`SPC' or \\`y' to %s one file, \\`DEL' or \\`n' to skip to next, +\\`!' to %s all remaining matches with no more questions.") + (downcase operation) + (downcase operation)))) (dired-query 'rename-non-directory-query (concat operation " `%s' to `%s'") (dired-make-relative from) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index fc626aa76b5..de21dcf7a60 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -596,7 +596,7 @@ If you have saved a Dired buffer in a file you can use \\[dired-virtual] to resume it in a later session. Type \\\\[revert-buffer] \ -in the Virtual Dired buffer and answer `y' to convert +in the Virtual Dired buffer and answer \\`y' to convert the virtual to a real Dired buffer again. You don't have to do this, though: you can relist single subdirs using \\[dired-do-redisplay]." diff --git a/lisp/dired.el b/lisp/dired.el index a0fa9178911..9280c080a4c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -345,11 +345,11 @@ When `file', the region marking is based on the file name. This means don't mark the file if the end of the region is before the file name displayed on the Dired line, so the file name is visually outside the region. This behavior is consistent with -marking files without the region using the key `m' that advances +marking files without the region using the key \\`m' that advances point to the next line after marking the file. Thus the number of keys used to mark files is the same as the number of keys -used to select the region, e.g. `M-2 m' marks 2 files, and -`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files. +used to select the region, for example \\`M-2 m' marks 2 files, and +\\`C-SPC M-2 n m' marks 2 files, and \\`M-2 S- m' marks 2 files. When `line', the region marking is based on Dired lines, so include the file into marking if the end of the region @@ -4102,9 +4102,9 @@ Type \\[help-command] at that time for help." (inhibit-read-only t) case-fold-search dired-unmark-all-files-query (string (format "\n%c" mark)) - (help-form "\ -Type SPC or `y' to unmark one file, DEL or `n' to skip to next, -`!' to unmark all remaining files with no more questions.")) + (help-form (substitute-command-keys "\ +Type \\`SPC' or \\`y' to unmark one file, \\`DEL' or \\`n' to skip to next, +\\`!' to unmark all remaining files with no more questions."))) (goto-char (point-min)) (while (if (eq mark ?\r) (re-search-forward dired-re-mark nil t) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index b95f11eab64..2f2f96ca0da 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -215,12 +215,12 @@ The function's value is the number of actions taken." (action (or (nth 2 help) "act on"))) (concat (format-message - "\ -Type SPC or `y' to %s the current %s; -DEL or `n' to skip the current %s; -RET or `q' to skip the current and all remaining %s; -C-g to quit (cancel the whole command); -! to %s all remaining %s;\n" + (substitute-command-keys "\ +Type \\`SPC' or \\`y' to %s the current %s; +\\`DEL' or \\`n' to skip the current %s; +\\`RET' or \\`q' to skip the current and all remaining %s; +\\`C-g' to quit (cancel the whole command); +\\`!' to %s all remaining %s;\n") action object object objects action objects) (mapconcat (lambda (elt) (format "%s to %s;\n" diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index aec438ed994..5516b2a81f4 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -448,7 +448,8 @@ provided in the Commentary section of this library." (setq reb-subexp-mode t) (reb-update-modestring) (use-local-map reb-subexp-mode-map) - (message "`0'-`9' to display subexpressions `q' to quit subexp mode")) + (message (substitute-command-keys + "\\`0'-\\`9' to display subexpressions \\`q' to quit subexp mode"))) (defun reb-show-subexp (subexp &optional pause) "Visually show limit of subexpression SUBEXP of recent search. diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index 35caa1a93c5..5dd6ad34d74 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -210,7 +210,8 @@ KEYS is a list of `epa-ks-key' structures, as parsed by (with-current-buffer buf (setq tabulated-list-entries entries) (tabulated-list-print t t)) - (message "Press `f' to mark a key, `x' to fetch all marked keys.")))) + (message (substitute-command-keys + "Press \\`f' to mark a key, \\`x' to fetch all marked keys."))))) (defun epa-ks--restart-search () (when epa-ks-last-query diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index c5a4fbe5a09..df6c3c09d90 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2405,7 +2405,8 @@ If ARG is non-nil, show the *erc-protocol* buffer." (concat "This buffer displays all IRC protocol " "traffic exchanged with servers.")) (erc-make-notice "Kill it to disable logging.") - (erc-make-notice "Press `t' to toggle.")))) + (erc-make-notice (substitute-command-keys + "Press \\`t' to toggle."))))) (insert (string-join msg "\r\n"))) (use-local-map (make-sparse-keymap)) (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) diff --git a/lisp/files.el b/lisp/files.el index 1979f1bbe3d..f72723ab7dd 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5806,13 +5806,13 @@ of the directory that was default during command invocation." (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. -You can answer `y' or SPC to save, `n' or DEL not to save, `C-r' +You can answer \\`y' or \\`SPC' to save, \\`n' or \\`DEL' not to save, \\`C-r' to look at the buffer in question with `view-buffer' before -deciding, `d' to view the differences using -`diff-buffer-with-file', `!' to save the buffer and all remaining -buffers without any further querying, `.' to save only the -current buffer and skip the remaining ones and `q' or RET to exit -the function without saving any more buffers. `C-h' displays a +deciding, \\`d' to view the differences using +`diff-buffer-with-file', \\`!' to save the buffer and all remaining +buffers without any further querying, \\`.' to save only the +current buffer and skip the remaining ones and \\`q' or \\`RET' to exit +the function without saving any more buffers. \\`C-h' displays a help message describing these options. This command first saves any buffers where `buffer-save-without-query' is diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 1d16e007007..00769a5da6e 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -204,7 +204,8 @@ If ARG is non-nil, open it in a new buffer." (find-file file-name))) (if (file-symlink-p file-name) (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update Dired buffer")))) + (error (substitute-command-keys + "File no longer exists; type \\`g' to update Dired buffer"))))) (defun gnus-dired-print (&optional file-name print-to) "In dired, print FILE-NAME according to the mailcap file. @@ -244,9 +245,10 @@ of the file to save in." (error "MIME print only implemented via Gnus"))) (ps-despool print-to)))) ((file-symlink-p file-name) - (error "File is a symlink to a nonexistent target")) - (t - (error "File no longer exists; type `g' to update Dired buffer")))) + (error "File is a symlink to a nonexistent target")) + (t + (error (substitute-command-keys + "File no longer exists; type \\`g' to update Dired buffer"))))) (provide 'gnus-dired) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index f0b0ca58796..2ec001faee7 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -62,7 +62,7 @@ (defcustom gnus-keep-same-level nil "Non-nil means that the newsgroup after this one will be on the same level. -When you type, for instance, `n' after reading the last article in the +When you type, for instance, \\`n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group buffer. diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 2ca25802957..d031047804a 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -2562,16 +2562,17 @@ score in `gnus-newsgroup-scored' by SCORE." (or (caddr s) gnus-score-interactive-default-score)) trace)))) - (insert - "\n\nQuick help: + (insert + (substitute-command-keys + "\n\nQuick help: -Type `e' to edit score file corresponding to the score rule on current line, -`f' to format (pretty print) the score file and edit it, -`t' toggle to truncate long lines in this buffer, -`q' to quit, `k' to kill score trace buffer. +Type \\`e' to edit score file corresponding to the score rule on current line, +\\`f' to format (pretty print) the score file and edit it, +\\`t' toggle to truncate long lines in this buffer, +\\`q' to quit, \\`k' to kill score trace buffer. The first sexp on each line is the score rule, followed by the file name of -the score file and its full name, including the directory.") +the score file and its full name, including the directory.")) (goto-char (point-min)) (gnus-configure-windows 'score-trace))) (set-buffer gnus-summary-buffer) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 4519d65aa84..56934dfa15d 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1467,11 +1467,11 @@ address was listed in gnus-group-split Addresses (see below).") :variable-group gnus-group-parameter :parameter-type '(gnus-email-address :tag "To List") :parameter-document "\ -This address will be used when doing a `a' in the group. +This address will be used when doing a \\`a' in the group. It is totally ignored when doing a followup--except that if it is present in a news group, you'll get mail group semantics when doing -`f'. +\\`f'. The gnus-group-split mail splitting mechanism will behave as if this address was listed in gnus-group-split Addresses (see below).") diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 4a0ea59586c..562bc64f6fb 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4763,23 +4763,25 @@ Valid types are `send', `return', `exit', `kill' and `postpone'." t "\ The message size, " - (/ (buffer-size) 1000) "KB, is too large. + (/ (buffer-size) 1000) + (substitute-command-keys "KB, is too large. Some mail gateways (MTA's) bounce large messages. To avoid the -problem, answer `y', and the message will be split into several -smaller pieces, the size of each is about " +problem, answer \\`y', and the message will be split into several +smaller pieces, the size of each is about ") (/ message-send-mail-partially-limit 1000) - "KB except the last + (substitute-command-keys + "KB except the last one. However, some mail readers (MUA's) can't read split messages, i.e., -mails in message/partially format. Answer `n', and the message +mails in message/partially format. Answer \\`n', and the message will be sent in one piece. The size limit is controlled by `message-send-mail-partially-limit'. If you always want Gnus to send messages in one piece, set `message-send-mail-partially-limit' to nil. -"))) +")))) (progn (message "Sending via mail...") (if message-send-mail-real-function diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 233127b0112..b461197abe9 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1257,7 +1257,9 @@ Otherwise, toggle lock status." "Unmark all buffers with mark MARK." (interactive "cRemove marks (RET means all):") (if (= (ibuffer-count-marked-lines t) 0) - (message "No buffers marked; use `m' to mark a buffer") + (message (substitute-command-keys + "No buffers marked; use \\\ +\\[ibuffer-mark-forward] to mark a buffer")) (let ((fn (lambda (_buf mk) (unless (eq mk ?\s) (ibuffer-set-mark-1 ?\s)) t))) diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index f393ac773f5..b3080ac416b 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -1767,7 +1767,7 @@ is determined non-interactively. The value is queried for in the minibuffer exactly the same way that `set-variable' does it. You can see the current value of the variable when the minibuffer is -querying you by typing `C-h'. Note that the format is changed +querying you by typing \\`C-h'. Note that the format is changed slightly from that used by `set-variable' -- the current value is printed just after the variable's name instead of at the bottom of the help window." diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0fea057d1cb..c2a6b01fc8e 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2734,7 +2734,7 @@ not active.") This is only used when the minibuffer area has no active minibuffer. Note that the minibuffer may change to this mode more often than -you might expect. For instance, typing `M-x' may change the +you might expect. For instance, typing \\`M-x' may change the buffer to this mode, then to a different mode, and then back again to this mode upon exit. Code running from `minibuffer-inactive-mode-hook' has to be prepared to run diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index d833612cd90..d7dbaa06505 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1992,7 +1992,8 @@ see the doc of that variable if you want to add names to the list." (setq set-list (delete (car set-list) set-list))) (goto-char (point-min)) (insert-before-markers - "Type `t' to select a tags table or set of tags tables:\n\n") + (substitute-command-keys + "Type \\`t' to select a tags table or set of tags tables:\n\n")) (if desired-point (goto-char desired-point)) (set-window-start (selected-window) 1 t)) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 5a31ad35087..ded3a9c463c 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -817,7 +817,7 @@ IDL has currently stepped.") Command history, searching of previous commands, command line editing are available via the comint-mode key bindings, by default - mostly on the key `C-c'. Command history is also available with + mostly on the key \\`C-c'. Command history is also available with the arrow keys UP and DOWN. 2. Completion @@ -1327,7 +1327,7 @@ See also the variable `idlwave-shell-input-mode-spells'." Characters are sent one by one, without newlines. The loop is blocking and intercepts all input events to Emacs. You can use this command to interact with the IDL command GET_KBRD. -The loop can be aborted by typing `C-g'. The loop also exits automatically +The loop can be aborted by typing \\[keyboard-quit]. The loop also exits automatically when the IDL prompt gets displayed again after the current IDL command." (interactive) @@ -1342,7 +1342,8 @@ when the IDL prompt gets displayed again after the current IDL command." (funcall errf "No IDL program seems to be waiting for input")) ;; OK, start the loop - (message "Character mode on: Sending single chars (`C-g' to exit)") + (message (substitute-command-keys + "Character mode on: Sending single chars (\\[keyboard-quit] to exit)")) (message (catch 'exit (while t diff --git a/lisp/replace.el b/lisp/replace.el index 5287be2c524..0e81b15a097 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2402,20 +2402,20 @@ To be added to `context-menu-functions'." ;; It would be nice to use \\[...], but there is no reasonable way ;; to make that display both SPC and Y. (defconst query-replace-help - "Type Space or `y' to replace one match, Delete or `n' to skip to next, -RET or `q' to exit, Period to replace one match and exit, -Comma to replace but not move point immediately, -C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), -C-w to delete match and recursive edit, -C-l to clear the screen, redisplay, and offer same replacement again, -! to replace all remaining matches in this buffer with no more questions, -^ to move point back to previous match, -u to undo previous replacement, -U to undo all replacements, -E to edit the replacement string. -In multi-buffer replacements type `Y' to replace all remaining + "Type \\`SPC' or \\`y' to replace one match, Delete or \\`n' to skip to next, +\\`RET' or \\`q' to exit, Period to replace one match and exit, +\\`,' to replace but not move point immediately, +\\`C-r' to enter recursive edit (\\[exit-recursive-edit] to get out again), +\\`C-w' to delete match and recursive edit, +\\`C-l' to clear the screen, redisplay, and offer same replacement again, +\\`!' to replace all remaining matches in this buffer with no more questions, +\\`^' to move point back to previous match, +\\`u' to undo previous replacement, +\\`U' to undo all replacements, +\\`E' to edit the replacement string. +In multi-buffer replacements type \\`Y' to replace all remaining matches in all remaining buffers with no more questions, -`N' to skip to the next buffer without replacing remaining matches +\\`N' to skip to the next buffer without replacing remaining matches in the current buffer." "Help message while in `query-replace'.") diff --git a/lisp/simple.el b/lisp/simple.el index 58283e7b7fd..84928caa310 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8912,7 +8912,7 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally. When called interactively, the user is prompted for VARIABLE and then VALUE. The current value of VARIABLE will be put in the -minibuffer history so that it can be accessed with `M-n', which +minibuffer history so that it can be accessed with \\`M-n', which makes it easier to edit it." (interactive (let* ((default-var (variable-at-point)) diff --git a/lisp/subr.el b/lisp/subr.el index 7ba764880ef..867db47a47e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3120,7 +3120,7 @@ Optional argument CHARS, if non-nil, should be a list of characters; the function will ignore any input that is not one of CHARS. Optional argument HISTORY, if non-nil, should be a symbol that specifies the history list variable to use for navigating in input -history using `M-p' and `M-n', with `RET' to select a character from +history using \\`M-p' and \\`M-n', with \\`RET' to select a character from history. If you bind the variable `help-form' to a non-nil value while calling this function, then pressing `help-char' diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 0a3a49d868a..4087f7e5f29 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -2398,24 +2398,24 @@ Global `ispell-quit' set to start location to continue spell session." Selections are: -DIGIT: Replace the word with a digit offered in the *Choices* buffer. -SPC: Accept word this time. -`i': Accept word and insert into private dictionary. -`a': Accept word for this session. -`A': Accept word and place in `buffer-local dictionary'. -`r': Replace word with typed-in value. Rechecked. -`R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. -`?': Show these commands. -`x': Exit spelling buffer. Move cursor to original point. -`X': Exit spelling buffer. Leaves cursor at the current point, and permits +\\`0'..\\`9' Replace the word with a digit offered in the *Choices* buffer. +\\`SPC' Accept word this time. +\\`i' Accept word and insert into private dictionary. +\\`a' Accept word for this session. +\\`A' Accept word and place in `buffer-local dictionary'. +\\`r' Replace word with typed-in value. Rechecked. +\\`R' Replace word with typed-in value. Query-replaced in buffer. Rechecked. +\\`?' Show these commands. +\\`x' Exit spelling buffer. Move cursor to original point. +\\`X' Exit spelling buffer. Leaves cursor at the current point, and permits the aborted check to be completed later. -`q': Quit spelling session (Kills ispell process). -`l': Look up typed-in replacement in alternate dictionary. Wildcards okay. -`u': Like `i', but the word is lower-cased first. -`m': Place typed-in value in personal dictionary, then recheck current word. -`C-l': Redraw screen. -`C-r': Recursive edit. -`C-z': Suspend Emacs or iconify frame." +\\`q' Quit spelling session (Kills ispell process). +\\`l' Look up typed-in replacement in alternate dictionary. Wildcards okay. +\\`u' Like \\`i', but the word is lower-cased first. +\\`m' Place typed-in value in personal dictionary, then recheck current word. +\\`C-l' Redraw screen. +\\`C-r' Recursive edit. +\\`C-z' Suspend Emacs or iconify frame." (if (equal ispell-help-in-bufferp 'electric) (progn @@ -2428,26 +2428,28 @@ SPC: Accept word this time. ;;(if (< (window-height) 15) ;; (enlarge-window ;; (- 15 (ispell-adjusted-window-height)))) - (princ "Selections are: + (princ + (substitute-command-keys + "Selections are: -DIGIT: Replace the word with a digit offered in the *Choices* buffer. -SPC: Accept word this time. -`i': Accept word and insert into private dictionary. -`a': Accept word for this session. -`A': Accept word and place in `buffer-local dictionary'. -`r': Replace word with typed-in value. Rechecked. -`R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. -`?': Show these commands. -`x': Exit spelling buffer. Move cursor to original point. -`X': Exit spelling buffer. Leaves cursor at the current point, and permits - the aborted check to be completed later. -`q': Quit spelling session (Kills ispell process). -`l': Look up typed-in replacement in alternate dictionary. Wildcards okay. -`u': Like `i', but the word is lower-cased first. -`m': Place typed-in value in personal dictionary, then recheck current word. -`C-l': Redraw screen. -`C-r': Recursive edit. -`C-z': Suspend Emacs or iconify frame.") +\\`0'..\\`9' Replace the word with a digit offered in the *Choices* buffer. +\\`SPC' Accept word this time. +\\`i' Accept word and insert into private dictionary. +\\`a' Accept word for this session. +\\`A' Accept word and place in `buffer-local dictionary'. +\\`r' Replace word with typed-in value. Rechecked. +\\`R' Replace word with typed-in value. Query-replaced in buffer. Rechecked. +\\`?' Show these commands. +\\`x' Exit spelling buffer. Move cursor to original point. +\\`X' Exit spelling buffer. Leaves cursor at the current point, and permits + the aborted check to be completed later. +\\`q' Quit spelling session (Kills ispell process). +\\`l' Look up typed-in replacement in alternate dictionary. Wildcards okay. +\\`u' Like \\`i', but the word is lower-cased first. +\\`m' Place typed-in value in personal dictionary, then recheck current word. +\\`C-l' Redraw screen. +\\`C-r' Recursive edit. +\\`C-z' Suspend Emacs or iconify frame.")) nil))) @@ -3883,8 +3885,8 @@ Don't check spelling of message headers except the Subject field. Don't check included messages. To abort spell checking of a message region and send the message anyway, -use the `x' command. (Any subsequent regions will be checked.) -The `X' command aborts sending the message so that you can edit the buffer. +use the \\`x' command. (Any subsequent regions will be checked.) +The \\`X' command aborts sending the message so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your init file: diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index b90c21339cc..f787f5f3e56 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -148,8 +148,10 @@ No active TAGS table is required." (erase-buffer) (insert " MULTIPLE LABELS IN CURRENT DOCUMENT:\n") (insert - " Move point to label and type `r' to run a query-replace on the label\n" - " and its references. Type `q' to exit this buffer.\n\n") + (substitute-command-keys + " Move point to label and type \\`r' to run a query-replace on the label\n") + (substitute-command-keys + " and its references. Type \\`q' to exit this buffer.\n\n")) (insert " LABEL FILE\n") (insert " -------------------------------------------------------------\n") (use-local-map (make-sparse-keymap)) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index d57a7678553..eedc067b868 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -392,19 +392,19 @@ that the *toc* window fills half the frame." (defcustom reftex-toc-include-file-boundaries nil "Non-nil means, include file boundaries in *toc* buffer. -This flag can be toggled from within the *toc* buffer with the `F' key." +This flag can be toggled from within the *toc* buffer with the \\`F' key." :group 'reftex-table-of-contents-browser :type 'boolean) (defcustom reftex-toc-include-labels nil "Non-nil means, include labels in *toc* buffer. -This flag can be toggled from within the *toc* buffer with the `l' key." +This flag can be toggled from within the *toc* buffer with the \\`l' key." :group 'reftex-table-of-contents-browser :type 'boolean) (defcustom reftex-toc-include-index-entries nil "Non-nil means, include index entries in *toc* buffer. -This flag can be toggled from within the *toc* buffer with the `i' key." +This flag can be toggled from within the *toc* buffer with the \\`i' key." :group 'reftex-table-of-contents-browser :type 'boolean) @@ -422,14 +422,14 @@ changed." (defcustom reftex-toc-include-context nil "Non-nil means, include context with labels in the *toc* buffer. Context will only be shown when labels are visible as well. -This flag can be toggled from within the *toc* buffer with the `c' key." +This flag can be toggled from within the *toc* buffer with the \\`c' key." :group 'reftex-table-of-contents-browser :type 'boolean) (defcustom reftex-toc-follow-mode nil "Non-nil means, point in *toc* buffer will cause other window to follow. The other window will show the corresponding part of the document. -This flag can be toggled from within the *toc* buffer with the `f' key." +This flag can be toggled from within the *toc* buffer with the \\`f' key." :group 'reftex-table-of-contents-browser :type 'boolean) @@ -1627,14 +1627,14 @@ to that section." (defcustom reftex-index-include-context nil "Non-nil means, display the index definition context in the index buffer. -This flag may also be toggled from the index buffer with the `c' key." +This flag may also be toggled from the index buffer with the \\`c' key." :group 'reftex-index-support :type 'boolean) (defcustom reftex-index-follow-mode nil "Non-nil means, point in *Index* buffer will cause other window to follow. The other window will show the corresponding part of the document. -This flag can be toggled from within the *Index* buffer with the `f' key." +This flag can be toggled from within the *Index* buffer with the \\`f' key." :group 'reftex-table-of-contents-browser :type 'boolean) @@ -1863,10 +1863,11 @@ of the regular expressions in this list, that file is not parsed by RefTeX." (defcustom reftex-enable-partial-scans nil "Non-nil means, re-parse only 1 file when asked to re-parse. Re-parsing is normally requested with a \\[universal-argument] prefix to many RefTeX commands, -or with the `r' key in menus. When this option is t in a multifile document, +or with the \\`r' key in menus. When this option is t in a multifile document, we will only parse the current buffer, or the file associated with the label or section heading near point in a menu. Requesting re-parsing of an entire -multifile document then requires a \\[universal-argument] \\[universal-argument] prefix or the capital `R' key +multifile document then requires a \\[universal-argument] \ +\\[universal-argument] prefix or the capital \\`R' key in menus." :group 'reftex-optimizations-for-large-documents :type 'boolean) @@ -1912,7 +1913,7 @@ when new labels in its category are added. See the variable When a new label is defined with `reftex-label', all selection buffers associated with that label category are emptied, in order to force an update upon next use. When nil, the buffers are left alone and have to be -updated by hand, with the `g' key from the label selection process. +updated by hand, with the \\`g' key from the label selection process. The value of this variable will only have any effect when `reftex-use-multiple-selection-buffers' is non-nil." :group 'reftex-optimizations-for-large-documents @@ -1964,7 +1965,7 @@ instead or as well. The variable may have one of these values: both Both cursor and mouse trigger highlighting. Changing this variable requires rebuilding the selection and *toc* buffers -to become effective (keys `g' or `r')." +to become effective (keys \\`g' or \\`r')." :group 'reftex-fontification-configurations :type '(choice (const :tag "Never" nil) diff --git a/lisp/time.el b/lisp/time.el index 8496adec228..4f302caa674 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -343,7 +343,7 @@ Switches from the 1 to 5 to 15 minute load average, and then back to 1." "Update the `display-time' info for the mode line. However, don't redisplay right now. -This is used for things like Rmail `g' that want to force an +This is used for things like Rmail \\`g' that want to force an update which can wait for the next redisplay." (let* ((now (current-time)) (time (current-time-string now)) diff --git a/lisp/userlock.el b/lisp/userlock.el index 348ccc6f8ec..9a2d45a8468 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -39,10 +39,6 @@ (define-error 'file-locked "File is locked" 'file-error) -(defun userlock--fontify-key (key) - "Add the `help-key-binding' face to string KEY." - (propertize key 'face 'help-key-binding)) - ;;;###autoload (defun ask-user-about-lock (file opponent) "Ask user what to do when he wants to edit FILE but it is locked by OPPONENT. @@ -68,12 +64,9 @@ in any way you like." (match-string 0 opponent))) opponent)) (while (null answer) - (message "%s locked by %s: (%s, %s, %s, %s)? " - short-file short-opponent - (userlock--fontify-key "s") - (userlock--fontify-key "q") - (userlock--fontify-key "p") - (userlock--fontify-key "?")) + (message (substitute-command-keys + "%s locked by %s: (\\`s', \\`q', \\`p', \\`?'? ") + short-file short-opponent) (if noninteractive (error "Cannot resolve lock conflict in batch mode")) (let ((tem (let ((inhibit-quit t) (cursor-in-echo-area t)) @@ -88,12 +81,9 @@ in any way you like." (?? . help)))) (cond ((null answer) (beep) - (message "Please type %s, %s, or %s; or %s for help" - (userlock--fontify-key "q") - (userlock--fontify-key "s") - (userlock--fontify-key "p") - ;; FIXME: Why do we use "?" here and "C-h" below? - (userlock--fontify-key "?")) + ;; FIXME: Why do we use "?" here and "C-h" below? + (message (substitute-command-keys + "Please type \\`q', \\`s', or \\`p'; or \\`?' for help")) (sit-for 3)) ((eq (cdr answer) 'help) (ask-user-about-lock-help) @@ -106,17 +96,14 @@ in any way you like." (with-output-to-temp-buffer "*Help*" (with-current-buffer standard-output (insert - (format + (substitute-command-keys "It has been detected that you want to modify a file that someone else has already started modifying in Emacs. -You can <%s>teal the file; the other user becomes the +You can <\\`s'>teal the file; the other user becomes the intruder if (s)he ever unmodifies the file and then changes it again. -You can <%s>roceed; you edit at your own (and the other user's) risk. -You can <%s>uit; don't modify this file." - (userlock--fontify-key "s") - (userlock--fontify-key "p") - (userlock--fontify-key "q"))) +You can <\\`p'>roceed; you edit at your own (and the other user's) risk. +You can <\\`q'>uit; don't modify this file.")) (help-mode)))) (define-error 'file-supersession nil 'file-error) @@ -169,14 +156,11 @@ The buffer in question is current when this function is called." (discard-input) (save-window-excursion (let ((prompt - (format "%s changed on disk; \ -really edit the buffer? (%s, %s, %s or %s) " - (file-name-nondirectory filename) - (userlock--fontify-key "y") - (userlock--fontify-key "n") - (userlock--fontify-key "r") - ;; FIXME: Why do we use "C-h" here and "?" above? - (userlock--fontify-key "C-h"))) + ;; FIXME: Why do we use "C-h" here and "?" above? + (format (substitute-command-keys + "%s changed on disk; \ +really edit the buffer? (\\`y', \\`n', \\`r' or \\`C-h') ") + (file-name-nondirectory filename))) (choices '(?y ?n ?r ?? ?\C-h)) answer) (when noninteractive @@ -205,22 +189,18 @@ really edit the buffer? (%s, %s, %s or %s) " (with-output-to-temp-buffer "*Help*" (with-current-buffer standard-output (insert - (format + (substitute-command-keys "You want to modify a buffer whose disk file has changed since you last read it in or saved it with this buffer. -If you say %s to go ahead and modify this buffer, +If you say \\`y' to go ahead and modify this buffer, you risk ruining the work of whoever rewrote the file. -If you say %s to revert, the contents of the buffer are refreshed +If you say \\`r' to revert, the contents of the buffer are refreshed from the file on disk. -If you say %s, the change you started to make will be aborted. +If you say \\`n', the change you started to make will be aborted. -Usually, you should type %s to get the latest version of the -file, then make the change again." - (userlock--fontify-key "y") - (userlock--fontify-key "r") - (userlock--fontify-key "n") - (userlock--fontify-key "r"))) +Usually, you should type \\`r' to get the latest version of the +file, then make the change again.")) (help-mode)))) ;;;###autoload diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el index 0450cd7f23b..48e1f15f05c 100644 --- a/lisp/vc/ediff-help.el +++ b/lisp/vc/ediff-help.el @@ -227,7 +227,9 @@ the value of this variable and the variables `ediff-help-message-*' in ((string= cmd "s") (re-search-forward "^['`‘]s['’]")) ((string= cmd "+") (re-search-forward "^['`‘]\\+['’]")) ((string= cmd "=") (re-search-forward "^['`‘]=['’]")) - (t (user-error "Undocumented command! Type `G' in Ediff Control Panel to drop a note to the Ediff maintainer"))) + (t (user-error (substitute-command-keys + "Undocumented command! Type \\`G' in Ediff Control \ +Panel to drop a note to the Ediff maintainer")))) ) ; let case-fold-search )) diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index eaccb7a98c7..4b352bd34fc 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -615,8 +615,8 @@ Actually, Ediff restores the scope of visibility that existed at startup.") (defcustom ediff-keep-variants t "Nil means prompt to remove unmodified buffers A/B/C at session end. -Supplying a prefix argument to the quit command `q' temporarily reverses the -meaning of this variable." +Supplying a prefix argument to the quit command \\`q' temporarily +reverses the meaning of this variable." :type 'boolean :group 'ediff) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 7622cf4c196..a03c6a5ed7e 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -415,7 +415,9 @@ other files, enter `/dev/null'. (with-output-to-temp-buffer ediff-msg-buffer (ediff-with-current-buffer standard-output (fundamental-mode)) - (princ (format-message " + (with-current-buffer standard-output + (insert (format-message + (substitute-command-keys " Ediff has inferred that %s %s @@ -423,10 +425,10 @@ are two possible targets for applying the patch. Both files seem to be plausible alternatives. Please advise: - Type `y' to use %s as the target; - Type `n' to use %s as the target. -" - file1 file2 file1 file2))) + Type \\`y' to use %s as the target; + Type \\`n' to use %s as the target. +") + file1 file2 file1 file2)))) (setcar session-file-object (if (y-or-n-p (format "Use %s ? " file1)) (progn @@ -823,7 +825,8 @@ you can still examine the changes via M-x ediff-files" ediff-patch-diagnostics patch-diagnostics)) (bury-buffer patch-diagnostics) - (message "Type `P', if you need to see patch diagnostics") + (message (substitute-command-keys + "Type \\`P', if you need to see patch diagnostics")) ctl-buf)) (defun ediff-multi-patch-internal (patch-buf &optional startup-hooks) diff --git a/lisp/windmove.el b/lisp/windmove.el index 658e59af198..8904f5cbf70 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -700,7 +700,7 @@ where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or a single modifier. If PREFIX is `none', no prefix is used. If MODIFIERS is `none', the keybindings are directly bound to the arrow keys. -Default value of PREFIX is `C-x' and MODIFIERS is `shift'." +Default value of PREFIX is \\`C-x' and MODIFIERS is `shift'." (interactive) (unless prefix (setq prefix '(?\C-x))) (when (eq prefix 'none) (setq prefix nil)) From d1a2e78b8cab54c0d6d0f3c208b24f59545ffbb3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 22 Nov 2021 11:55:24 +0100 Subject: [PATCH 223/367] ; Very minor simplification in bytecomp.el * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): Very minor simplification of 'rx' form. --- lisp/emacs-lisp/bytecomp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index bd74c79d717..e1c7ab4904a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1672,7 +1672,7 @@ URLs." ;; known at compile time. So instead, we assume that these ;; substitutions are of some length N. (replace-regexp-in-string - (rx "\\" (or (seq "[" (* (not "]")) "]"))) + (rx "\\" (seq "[" (* (not "]")) "]")) (make-string byte-compile--wide-docstring-substitution-len ?x) ;; For literal key sequence substitutions (e.g. "\\`C-h'"), just ;; remove the markup as `substitute-command-keys' would. From 3db3d5a3981dad1ac42a5729c285b9adaba10f05 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Nov 2021 11:13:03 +0000 Subject: [PATCH 224/367] Fix compiler warning in image.c * src/image.c (webp_load): Initialize `mask_img' to NULL. --- src/image.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/image.c b/src/image.c index 734ccdac311..f2597f529d1 100644 --- a/src/image.c +++ b/src/image.c @@ -9059,7 +9059,7 @@ webp_load (struct frame *f, struct image *img) } /* Create the x image and pixmap. */ - Emacs_Pix_Container ximg, mask_img; + Emacs_Pix_Container ximg, mask_img = NULL; if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, false)) goto webp_error2; From 487ddf466a58c5f558e44b4ab3b5912219445d89 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 22 Nov 2021 12:12:25 +0100 Subject: [PATCH 225/367] ; Fix typo * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): Fix typo. --- lisp/emacs-lisp/bytecomp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e1c7ab4904a..5dc03eac92b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1677,7 +1677,7 @@ URLs." ;; For literal key sequence substitutions (e.g. "\\`C-h'"), just ;; remove the markup as `substitute-command-keys' would. (replace-regexp-in-string - (rx "\\" (seq "`" (group (* (not "]"))) "'")) + (rx "\\" (seq "`" (group (* (not "'"))) "'")) "\\1" docstring))))) From 698e044a253e9d0e4ec2c74b0b9648f139f2192b Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Mon, 22 Nov 2021 14:20:45 +0100 Subject: [PATCH 226/367] ; * etc/NEWS: Fix some typos and improve some entries. --- etc/NEWS | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 626b67d03a8..47b5578dee1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -105,8 +105,6 @@ the previous definition to be discarded, which was probably not intended when this occurs in batch mode. To remedy the error, rename tests so that they all have unique names. -** Emacs now supports Unicode Standard version 14.0. - ** Emoji +++ @@ -436,7 +434,7 @@ This works like 'image-transform-fit-to-window'. *** New user option 'image-auto-resize-max-scale-percent'. The new 'fit-window' option will never scale an image more than this -much (in percent). It is nil by default. +much (in percent). It is nil by default, which means no limit. ** Image-Dired @@ -549,7 +547,7 @@ WebKit widget. +++ *** New minor mode 'xwidget-webkit-isearch-mode'. -This mode acts similarly to incremental search, and allows to search +This mode acts similarly to incremental search, and allows searching the contents of a WebKit widget. In xwidget-webkit mode, it is bound to 'C-s' and 'C-r'. @@ -722,7 +720,7 @@ This is like 'kbd', but only returns vectors instead of a mix of vectors and strings. +++ -** New substitution in docstrings and 'substitute-command-keys'. Use +** New substitution in docstrings and 'substitute-command-keys'. Use "\\`KEYSEQ'" to insert a literal key sequence "KEYSEQ" (e.g. "C-k") in a docstring or when calling 'substitute-command-keys', which will use the same face as a command substitution. This should From a5fbc21bc6c695623f8ae8c2df635e9d6220c483 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 22 Nov 2021 17:05:40 +0200 Subject: [PATCH 227/367] Improve recently installed documentation * doc/lispref/display.texi (Size of Displayed Text): Move to description of 'buffer-text-pixel-size' to preserve previous text; mention the importance of WINDOW. --- doc/lispref/display.texi | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 23418831290..6b1c52b4859 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2140,21 +2140,6 @@ height of all of these lines, if present, in the return value. whole and does not care about the size of individual lines. The following function does. -@defun buffer-text-pixel-size &optional buffer-or-name window from to x-limit y-limit -This is much like @code{window-text-pixel-size}, but can be used when -the buffer isn't shown in a window. (@code{window-text-pixel-size} is -faster when it is, so this function shouldn't be used in that case.) - -@var{buffer-or-name} must specify a live buffer or the name of a live -buffer and defaults to the current buffer. @var{window} must be a -live window and defaults to the selected one. The return value is a -cons of the maximum pixel-width of any text line and the pixel-height -of all the text lines of the buffer specified by @var{buffer-or-name}. - -The optional arguments @var{x-limit} and @var{y-limit} have the same -meaning as with @code{window-text-pixel-size}. -@end defun - @defun window-lines-pixel-dimensions &optional window first last body inverse left This function calculates the pixel dimensions of each line displayed in the specified @var{window}. It does so by walking @var{window}'s @@ -2216,6 +2201,23 @@ though when this function is run from an idle timer with a delay of zero seconds. @end defun +@defun buffer-text-pixel-size &optional buffer-or-name window from to x-limit y-limit +This is much like @code{window-text-pixel-size}, but can be used when +the buffer isn't shown in a window. (@code{window-text-pixel-size} is +faster when it is, so this function shouldn't be used in that case.) + +@var{buffer-or-name} must specify a live buffer or the name of a live +buffer and defaults to the current buffer. @var{window} must be a +live window and defaults to the selected one; the function will +compute the text dimensions as if @var{buffer} is displayed in +@var{window}. The return value is a cons of the maximum pixel-width +of any text line and the pixel-height of all the text lines of the +buffer specified by @var{buffer-or-name}. + +The optional arguments @var{x-limit} and @var{y-limit} have the same +meaning as with @code{window-text-pixel-size}. +@end defun + @defun string-pixel-width string This is a convenience function that uses @code{window-text-pixel-size} to compute the width of @var{string} (in pixels). From a59e35d79fae989d1047b23ddabc6f2c5bbe0097 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 22 Nov 2021 16:11:45 +0100 Subject: [PATCH 228/367] ; Further minor simplification of rx form in bytecomp.el MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): Simplify even more. Thanks to Mattias Engdegård . --- lisp/emacs-lisp/bytecomp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5dc03eac92b..566a3fdf99c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1672,12 +1672,12 @@ URLs." ;; known at compile time. So instead, we assume that these ;; substitutions are of some length N. (replace-regexp-in-string - (rx "\\" (seq "[" (* (not "]")) "]")) + (rx "\\[" (* (not "]")) "]") (make-string byte-compile--wide-docstring-substitution-len ?x) ;; For literal key sequence substitutions (e.g. "\\`C-h'"), just ;; remove the markup as `substitute-command-keys' would. (replace-regexp-in-string - (rx "\\" (seq "`" (group (* (not "'"))) "'")) + (rx "\\`" (group (* (not "'"))) "'") "\\1" docstring))))) From 55f84a12ec1451788cbabad983f19e065be1d43e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 22 Nov 2021 16:27:55 +0100 Subject: [PATCH 229/367] ; Improve recent NEWS entry * etc/NEWS: Improve recently added entry on substitution of literal key sequences. Thanks to Eli Zaretskii . --- etc/NEWS | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 47b5578dee1..09f17d6553b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -721,8 +721,8 @@ vectors and strings. +++ ** New substitution in docstrings and 'substitute-command-keys'. -Use "\\`KEYSEQ'" to insert a literal key sequence "KEYSEQ" -(e.g. "C-k") in a docstring or when calling 'substitute-command-keys', +Use \\`KEYSEQ' to insert a literal key sequence "KEYSEQ" (for example +\\`C-k') in a docstring or when calling 'substitute-command-keys', which will use the same face as a command substitution. This should be used only when a key sequence has no corresponding command, for example when it is read directly with 'read-key-sequence'. It must be From 196196c739b0ea5db0d9ad5e753f9e38fba11593 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Nov 2021 16:33:16 +0100 Subject: [PATCH 230/367] Adapt emba jobs * admin/notes/emba (Emacs jobset): Precise. * test/infra/Makefile.in (tn): New variable. (subdir_template): Use it. Handle eieio-tests, faceup-tests and so-long-tests. Rearrange .PHONY entry. Add needs and artifacts to emba job. * test/infra/gitlab-ci.yml (test-filenotify-gio): Move up. * test/infra/test-jobs.yml: Regenerate. --- admin/notes/emba | 8 +- test/infra/Makefile.in | 57 ++++--- test/infra/gitlab-ci.yml | 26 +-- test/infra/test-jobs.yml | 338 +++++++++++++++++++++++++++++++++++++-- 4 files changed, 375 insertions(+), 54 deletions(-) diff --git a/admin/notes/emba b/admin/notes/emba index 4e500bc92cf..a30e570fd47 100644 --- a/admin/notes/emba +++ b/admin/notes/emba @@ -28,7 +28,8 @@ The messages contain a URL to the log file of the failed job, like * Emacs jobset The Emacs jobset is defined in the Emacs source tree, file -'.gitlab-ci.yml'. It could be adapted for every Emacs branch, see +'.gitlab-ci.yml'. All related files are located in directory +'test/infra'. They could be adapted for every Emacs branch, see . A jobset on Gitlab is called pipeline. Emacs pipelines run through @@ -37,6 +38,11 @@ the stages 'build-images', 'platform-images' and 'native-comp-images' configuration parameters) as well as 'normal', 'slow', 'platforms' and 'native-comp' (run respective test jobs based on the produced images). +The jobs for stage 'normal' are contained in the file +'test/infra/test-jobs.yml'. This file is generated by calling 'make +-C test generate-test-jobs' in the Emacs source tree, and the +resulting file shall be pushed to the Emacs git repository afterwards. + Every job runs in a Debian docker container. It uses the local clone of the Emacs git repository to perform a bootstrap and test of Emacs. This could happen for several jobs with changed configuration, compile diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index e91aea404d4..36c27024afb 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -1,4 +1,4 @@ -### test/infra/Makefile. Generated from Makefile.in by configure. +### @configure_input@ # Copyright (C) 2021 Free Software Foundation, Inc. @@ -33,6 +33,7 @@ top_builddir = @top_builddir@ SUBDIRS ?= $(shell make -s -C .. subdirs) SUBDIR_TARGETS = FILE = test-jobs.yml +tn = $$$${test_name} define subdir_template $(eval target = check-$(subst /,-,$(1))) @@ -41,41 +42,59 @@ define subdir_template $(eval ifeq ($(findstring src, $(1)), src) define changes - @echo " - $(1)/*.{h,c}" >>$(FILE) - @echo " - test/$(1)/*.el" >>$(FILE) + @echo ' - $(1)/*.{h,c}' >>$(FILE) + endef + else ifeq ($(findstring eieio, $(1)), eieio) + define changes + @echo ' - lisp/emacs-lisp/eieio*.el' >>$(FILE) + endef + else ifeq ($(findstring faceup, $(1)), faceup) + define changes + @echo ' - lisp/emacs-lisp/faceup*.el' >>$(FILE) + endef + else ifeq ($(findstring so-long, $(1)), so-long) + define changes + @echo ' - lisp/so-long*.el' >>$(FILE) endef else ifeq ($(findstring misc, $(1)), misc) define changes - @echo " - admin/*.el" >>$(FILE) - @echo " - test/$(1)/*.el" >>$(FILE) + @echo ' - admin/*.el' >>$(FILE) endef else define changes - @echo " - $(1)/*.el" >>$(FILE) - @echo " - test/$(1)/*.el" >>$(FILE) + @echo ' - $(1)/*.el' >>$(FILE) endef endif) - .PHONY: $(target) - $(target): - @echo "test-$(subst /,-,$(1))-inotify:" >>$(FILE) - @echo " stage: normal" >>$(FILE) - @echo " extends: [.job-template, .test-template]" >>$(FILE) - @echo " rules:" >>$(FILE) - @echo " - changes:" >>$(FILE) - $(changes) - @echo " variables:" >>$(FILE) - @echo " target: emacs-inotify" >>$(FILE) - @echo " make_params: \"-C test $(target)\"" >>$(FILE) @echo >>$(FILE) + @echo 'test-$(subst /,-,$(1))-inotify:' >>$(FILE) + @echo ' stage: normal' >>$(FILE) + @echo ' needs: [build-image-inotify]' >>$(FILE) + @echo ' extends: [.job-template, .test-template]' >>$(FILE) + @echo ' rules:' >>$(FILE) + @echo ' - changes:' >>$(FILE) + $(changes) + @echo ' - test/$(1)/*.el' >>$(FILE) + @echo ' - test/$(1)/*resources/**' >>$(FILE) + @echo ' artifacts:' >>$(FILE) + @echo ' name: $(tn)' >>$(FILE) + @echo ' public: true' >>$(FILE) + @echo ' expire_in: 1 week' >>$(FILE) + @echo ' paths:' >>$(FILE) + @echo ' - test/$(1)/*.log' >>$(FILE) + @echo ' - **core' >>$(FILE) + @echo ' when: always' >>$(FILE) + @echo ' variables:' >>$(FILE) + @echo ' target: emacs-inotify' >>$(FILE) + @echo ' make_params: "-C test $(target)"' >>$(FILE) endef $(foreach subdir, $(SUBDIRS), $(eval $(call subdir_template,$(subdir)))) all: generate-test-jobs -.PHONY: generate-test-jobs $(FILE) +.PHONY: generate-test-jobs $(FILE) $(SUBDIR_TARGETS) generate-test-jobs: clean $(FILE) $(SUBDIR_TARGETS) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index a0e2c283cde..47a8b519648 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -236,32 +236,12 @@ build-image-inotify: include: '/test/infra/test-jobs.yml' -# test-lisp-inotify: -# stage: normal -# extends: [.job-template, .test-template] -# variables: -# target: emacs-inotify -# make_params: "-C test check-lisp" - -# test-lisp-net-inotify: -# stage: normal -# extends: [.job-template, .test-template] -# variables: -# target: emacs-inotify -# make_params: "-C test check-lisp-net" - build-image-filenotify-gio: stage: platform-images extends: [.job-template, .build-template, .filenotify-gio-template] variables: target: emacs-filenotify-gio -build-image-gnustep: - stage: platform-images - extends: [.job-template, .build-template, .gnustep-template] - variables: - target: emacs-gnustep - test-filenotify-gio: # This tests file monitor libraries gfilemonitor and gio. stage: platforms @@ -271,6 +251,12 @@ test-filenotify-gio: target: emacs-filenotify-gio make_params: "-k -C test autorevert-tests.log filenotify-tests.log" +build-image-gnustep: + stage: platform-images + extends: [.job-template, .build-template, .gnustep-template] + variables: + target: emacs-gnustep + test-gnustep: # This tests the GNUstep build process. stage: platforms diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 9fb15081bd4..92eac04f594 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -1,362 +1,672 @@ + test-lib-src-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lib-src/*.{h,c} - test/lib-src/*.el + - test/lib-src/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lib-src/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lib-src" test-lisp-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/*.el - test/lisp/*.el + - test/lisp/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp" test-lisp-calc-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/calc/*.el - test/lisp/calc/*.el + - test/lisp/calc/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/calc/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-calc" test-lisp-calendar-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/calendar/*.el - test/lisp/calendar/*.el + - test/lisp/calendar/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/calendar/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-calendar" test-lisp-cedet-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/cedet/*.el - test/lisp/cedet/*.el + - test/lisp/cedet/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/cedet/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet" test-lisp-cedet-semantic-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/cedet/semantic/*.el - test/lisp/cedet/semantic/*.el + - test/lisp/cedet/semantic/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/cedet/semantic/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet-semantic" test-lisp-cedet-semantic-bovine-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/cedet/semantic/bovine/*.el - test/lisp/cedet/semantic/bovine/*.el + - test/lisp/cedet/semantic/bovine/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/cedet/semantic/bovine/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet-semantic-bovine" test-lisp-cedet-srecode-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/cedet/srecode/*.el - test/lisp/cedet/srecode/*.el + - test/lisp/cedet/srecode/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/cedet/srecode/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet-srecode" test-lisp-emacs-lisp-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/emacs-lisp/*.el - test/lisp/emacs-lisp/*.el + - test/lisp/emacs-lisp/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/emacs-lisp/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emacs-lisp" test-lisp-emacs-lisp-eieio-tests-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - - lisp/emacs-lisp/eieio-tests/*.el + - lisp/emacs-lisp/eieio*.el - test/lisp/emacs-lisp/eieio-tests/*.el + - test/lisp/emacs-lisp/eieio-tests/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/emacs-lisp/eieio-tests/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emacs-lisp-eieio-tests" test-lisp-emacs-lisp-faceup-tests-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - - lisp/emacs-lisp/faceup-tests/*.el + - lisp/emacs-lisp/faceup*.el - test/lisp/emacs-lisp/faceup-tests/*.el + - test/lisp/emacs-lisp/faceup-tests/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/emacs-lisp/faceup-tests/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emacs-lisp-faceup-tests" test-lisp-emulation-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/emulation/*.el - test/lisp/emulation/*.el + - test/lisp/emulation/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/emulation/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emulation" test-lisp-erc-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/erc/*.el - test/lisp/erc/*.el + - test/lisp/erc/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/erc/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-erc" test-lisp-eshell-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/eshell/*.el - test/lisp/eshell/*.el + - test/lisp/eshell/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/eshell/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-eshell" test-lisp-gnus-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/gnus/*.el - test/lisp/gnus/*.el + - test/lisp/gnus/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/gnus/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-gnus" test-lisp-image-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/image/*.el - test/lisp/image/*.el + - test/lisp/image/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/image/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-image" test-lisp-international-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/international/*.el - test/lisp/international/*.el + - test/lisp/international/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/international/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-international" -test-lisp-legacy-inotify: - stage: normal - extends: [.job-template, .test-template] - rules: - - changes: - - lisp/legacy/*.el - - test/lisp/legacy/*.el - variables: - target: emacs-inotify - make_params: "-C test check-lisp-legacy" - test-lisp-mail-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/mail/*.el - test/lisp/mail/*.el + - test/lisp/mail/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/mail/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-mail" test-lisp-mh-e-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/mh-e/*.el - test/lisp/mh-e/*.el + - test/lisp/mh-e/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/mh-e/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-mh-e" test-lisp-net-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/net/*.el - test/lisp/net/*.el + - test/lisp/net/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/net/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-net" test-lisp-nxml-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/nxml/*.el - test/lisp/nxml/*.el + - test/lisp/nxml/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/nxml/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-nxml" test-lisp-obsolete-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/obsolete/*.el - test/lisp/obsolete/*.el + - test/lisp/obsolete/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/obsolete/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-obsolete" test-lisp-org-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/org/*.el - test/lisp/org/*.el + - test/lisp/org/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/org/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-org" test-lisp-play-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/play/*.el - test/lisp/play/*.el + - test/lisp/play/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/play/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-play" test-lisp-progmodes-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/progmodes/*.el - test/lisp/progmodes/*.el + - test/lisp/progmodes/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/progmodes/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-progmodes" test-lisp-so-long-tests-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - - lisp/so-long-tests/*.el + - lisp/so-long*.el - test/lisp/so-long-tests/*.el + - test/lisp/so-long-tests/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/so-long-tests/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-so-long-tests" test-lisp-term-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/term/*.el - test/lisp/term/*.el + - test/lisp/term/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/term/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-term" test-lisp-textmodes-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/textmodes/*.el - test/lisp/textmodes/*.el + - test/lisp/textmodes/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/textmodes/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-textmodes" test-lisp-url-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/url/*.el - test/lisp/url/*.el + - test/lisp/url/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/url/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-url" test-lisp-vc-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - lisp/vc/*.el - test/lisp/vc/*.el + - test/lisp/vc/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/lisp/vc/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-lisp-vc" test-misc-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - admin/*.el - test/misc/*.el + - test/misc/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/misc/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-misc" test-src-inotify: stage: normal + needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: - src/*.{h,c} - test/src/*.el + - test/src/*resources/** + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - test/src/*.log + - **core + when: always variables: target: emacs-inotify make_params: "-C test check-src" From d737bfe911fc46f520fece46dfc930561272ab8d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Nov 2021 16:47:23 +0100 Subject: [PATCH 231/367] ; Fix error in artifacts paths of emba jobs --- test/infra/Makefile.in | 5 +- test/infra/test-jobs.yml | 160 +++++++++++++++++++++++---------------- 2 files changed, 99 insertions(+), 66 deletions(-) diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index 36c27024afb..a6fa81570ae 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -82,8 +82,9 @@ define subdir_template @echo ' public: true' >>$(FILE) @echo ' expire_in: 1 week' >>$(FILE) @echo ' paths:' >>$(FILE) - @echo ' - test/$(1)/*.log' >>$(FILE) - @echo ' - **core' >>$(FILE) + @echo ' - $(tn)/test/$(1)/*.log' >>$(FILE) + @echo ' - $(tn)/**/core' >>$(FILE) + @echo ' - $(tn)/core' >>$(FILE) @echo ' when: always' >>$(FILE) @echo ' variables:' >>$(FILE) @echo ' target: emacs-inotify' >>$(FILE) diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 92eac04f594..059ab4f0e05 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -13,8 +13,9 @@ test-lib-src-inotify: public: true expire_in: 1 week paths: - - test/lib-src/*.log - - **core + - ${test_name}/test/lib-src/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -34,8 +35,9 @@ test-lisp-inotify: public: true expire_in: 1 week paths: - - test/lisp/*.log - - **core + - ${test_name}/test/lisp/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -55,8 +57,9 @@ test-lisp-calc-inotify: public: true expire_in: 1 week paths: - - test/lisp/calc/*.log - - **core + - ${test_name}/test/lisp/calc/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -76,8 +79,9 @@ test-lisp-calendar-inotify: public: true expire_in: 1 week paths: - - test/lisp/calendar/*.log - - **core + - ${test_name}/test/lisp/calendar/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -97,8 +101,9 @@ test-lisp-cedet-inotify: public: true expire_in: 1 week paths: - - test/lisp/cedet/*.log - - **core + - ${test_name}/test/lisp/cedet/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -118,8 +123,9 @@ test-lisp-cedet-semantic-inotify: public: true expire_in: 1 week paths: - - test/lisp/cedet/semantic/*.log - - **core + - ${test_name}/test/lisp/cedet/semantic/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -139,8 +145,9 @@ test-lisp-cedet-semantic-bovine-inotify: public: true expire_in: 1 week paths: - - test/lisp/cedet/semantic/bovine/*.log - - **core + - ${test_name}/test/lisp/cedet/semantic/bovine/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -160,8 +167,9 @@ test-lisp-cedet-srecode-inotify: public: true expire_in: 1 week paths: - - test/lisp/cedet/srecode/*.log - - **core + - ${test_name}/test/lisp/cedet/srecode/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -181,8 +189,9 @@ test-lisp-emacs-lisp-inotify: public: true expire_in: 1 week paths: - - test/lisp/emacs-lisp/*.log - - **core + - ${test_name}/test/lisp/emacs-lisp/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -202,8 +211,9 @@ test-lisp-emacs-lisp-eieio-tests-inotify: public: true expire_in: 1 week paths: - - test/lisp/emacs-lisp/eieio-tests/*.log - - **core + - ${test_name}/test/lisp/emacs-lisp/eieio-tests/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -223,8 +233,9 @@ test-lisp-emacs-lisp-faceup-tests-inotify: public: true expire_in: 1 week paths: - - test/lisp/emacs-lisp/faceup-tests/*.log - - **core + - ${test_name}/test/lisp/emacs-lisp/faceup-tests/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -244,8 +255,9 @@ test-lisp-emulation-inotify: public: true expire_in: 1 week paths: - - test/lisp/emulation/*.log - - **core + - ${test_name}/test/lisp/emulation/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -265,8 +277,9 @@ test-lisp-erc-inotify: public: true expire_in: 1 week paths: - - test/lisp/erc/*.log - - **core + - ${test_name}/test/lisp/erc/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -286,8 +299,9 @@ test-lisp-eshell-inotify: public: true expire_in: 1 week paths: - - test/lisp/eshell/*.log - - **core + - ${test_name}/test/lisp/eshell/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -307,8 +321,9 @@ test-lisp-gnus-inotify: public: true expire_in: 1 week paths: - - test/lisp/gnus/*.log - - **core + - ${test_name}/test/lisp/gnus/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -328,8 +343,9 @@ test-lisp-image-inotify: public: true expire_in: 1 week paths: - - test/lisp/image/*.log - - **core + - ${test_name}/test/lisp/image/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -349,8 +365,9 @@ test-lisp-international-inotify: public: true expire_in: 1 week paths: - - test/lisp/international/*.log - - **core + - ${test_name}/test/lisp/international/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -370,8 +387,9 @@ test-lisp-mail-inotify: public: true expire_in: 1 week paths: - - test/lisp/mail/*.log - - **core + - ${test_name}/test/lisp/mail/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -391,8 +409,9 @@ test-lisp-mh-e-inotify: public: true expire_in: 1 week paths: - - test/lisp/mh-e/*.log - - **core + - ${test_name}/test/lisp/mh-e/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -412,8 +431,9 @@ test-lisp-net-inotify: public: true expire_in: 1 week paths: - - test/lisp/net/*.log - - **core + - ${test_name}/test/lisp/net/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -433,8 +453,9 @@ test-lisp-nxml-inotify: public: true expire_in: 1 week paths: - - test/lisp/nxml/*.log - - **core + - ${test_name}/test/lisp/nxml/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -454,8 +475,9 @@ test-lisp-obsolete-inotify: public: true expire_in: 1 week paths: - - test/lisp/obsolete/*.log - - **core + - ${test_name}/test/lisp/obsolete/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -475,8 +497,9 @@ test-lisp-org-inotify: public: true expire_in: 1 week paths: - - test/lisp/org/*.log - - **core + - ${test_name}/test/lisp/org/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -496,8 +519,9 @@ test-lisp-play-inotify: public: true expire_in: 1 week paths: - - test/lisp/play/*.log - - **core + - ${test_name}/test/lisp/play/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -517,8 +541,9 @@ test-lisp-progmodes-inotify: public: true expire_in: 1 week paths: - - test/lisp/progmodes/*.log - - **core + - ${test_name}/test/lisp/progmodes/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -538,8 +563,9 @@ test-lisp-so-long-tests-inotify: public: true expire_in: 1 week paths: - - test/lisp/so-long-tests/*.log - - **core + - ${test_name}/test/lisp/so-long-tests/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -559,8 +585,9 @@ test-lisp-term-inotify: public: true expire_in: 1 week paths: - - test/lisp/term/*.log - - **core + - ${test_name}/test/lisp/term/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -580,8 +607,9 @@ test-lisp-textmodes-inotify: public: true expire_in: 1 week paths: - - test/lisp/textmodes/*.log - - **core + - ${test_name}/test/lisp/textmodes/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -601,8 +629,9 @@ test-lisp-url-inotify: public: true expire_in: 1 week paths: - - test/lisp/url/*.log - - **core + - ${test_name}/test/lisp/url/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -622,8 +651,9 @@ test-lisp-vc-inotify: public: true expire_in: 1 week paths: - - test/lisp/vc/*.log - - **core + - ${test_name}/test/lisp/vc/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -643,8 +673,9 @@ test-misc-inotify: public: true expire_in: 1 week paths: - - test/misc/*.log - - **core + - ${test_name}/test/misc/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify @@ -664,8 +695,9 @@ test-src-inotify: public: true expire_in: 1 week paths: - - test/src/*.log - - **core + - ${test_name}/test/src/*.log + - ${test_name}/**/core + - ${test_name}/core when: always variables: target: emacs-inotify From 712898210fdc4d7d5efc1636c68f9eac1632c9f8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 22 Nov 2021 19:39:28 +0200 Subject: [PATCH 232/367] * lisp/proced.el (proced-sort-header): Fix event positions (bug#1779). The logic was copied from 'tabulated-list-col-sort'. --- lisp/proced.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/proced.el b/lisp/proced.el index fec2a29c847..3b754c24c5f 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1330,11 +1330,12 @@ It is converted to the corresponding attribute key. This command updates the variable `proced-sort'. Prefix ARG controls sort order, see `proced-sort-interactive'." (interactive (list last-input-event (or last-prefix-arg 'no-arg))) - (let ((start (event-start event)) - col key) + (let* ((start (event-start event)) + (obj (posn-object start)) + col key) (save-selected-window (select-window (posn-window start)) - (setq col (+ (1- (car (posn-actual-col-row start))) + (setq col (+ (if obj (cdr obj) (posn-point start)) (window-hscroll))) (when (and (<= 0 col) (< col (length proced-header-line))) (setq key (get-text-property col 'proced-key proced-header-line)) From 6de588ad244172466bd1948d27f770a624ff9965 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 22 Nov 2021 19:57:59 +0200 Subject: [PATCH 233/367] * lisp/tab-bar.el (tab-bar-history-old-minibuffer-depth): Remove variable. (tab-bar--history-pre-change, tab-bar--history-change): Use minibuffer-depth instead of this variable (bug#51370). --- lisp/tab-bar.el | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 4bb6391cd91..d331f29194d 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1818,16 +1818,11 @@ Interactively, prompt for GROUP-NAME." (defvar tab-bar-history-done-command nil "Command handled by `window-configuration-change-hook'.") -(defvar tab-bar-history-old-minibuffer-depth 0 - "Minibuffer depth before the current command.") - (defun tab-bar--history-pre-change () ;; Reset before the command could set it (setq tab-bar-history-omit nil) (setq tab-bar-history-pre-command this-command) - (setq tab-bar-history-old-minibuffer-depth (minibuffer-depth)) - ;; Store window-configuration before possibly entering the minibuffer. - (when (zerop tab-bar-history-old-minibuffer-depth) + (when (zerop (minibuffer-depth)) (setq tab-bar-history-old `((wc . ,(current-window-configuration)) (wc-point . ,(point-marker)))))) @@ -1837,15 +1832,13 @@ Interactively, prompt for GROUP-NAME." ;; Don't register changes performed by the same command ;; repeated in sequence, such as incremental window resizing. (not (eq tab-bar-history-done-command tab-bar-history-pre-command)) - ;; Store window-configuration before possibly entering - ;; the minibuffer. - (zerop tab-bar-history-old-minibuffer-depth)) + (zerop (minibuffer-depth))) (puthash (selected-frame) (seq-take (cons tab-bar-history-old (gethash (selected-frame) tab-bar-history-back)) tab-bar-history-limit) - tab-bar-history-back)) - (setq tab-bar-history-old nil) + tab-bar-history-back) + (setq tab-bar-history-old nil)) (setq tab-bar-history-done-command tab-bar-history-pre-command)) (defun tab-bar-history-back () From d791cd556d622accb935e4dd230023c485d1e07a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 22 Nov 2021 20:00:48 +0200 Subject: [PATCH 234/367] Fix '(space :relative-width N)' display spec w/non-ASCII chars * src/xdisp.c (produce_stretch_glyph): Use the correct face for non-ASCII characters. Support :relative-width display spec on Lisp strings, not just on buffer text. --- src/xdisp.c | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 0316408d927..b3647f71e4c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29810,7 +29810,7 @@ append_stretch_glyph (struct it *it, Lisp_Object object, #endif /* HAVE_WINDOW_SYSTEM */ /* Produce a stretch glyph for iterator IT. IT->object is the value - of the glyph property displayed. The value must be a list + of the display property. The value must be a list of the form `(space KEYWORD VALUE ...)' with the following KEYWORD/VALUE pairs being recognized: @@ -29820,7 +29820,7 @@ append_stretch_glyph (struct it *it, Lisp_Object object, 2. `:relative-width FACTOR' specifies that the width of the stretch should be computed from the width of the first character having the - `glyph' property, and should be FACTOR times that width. + `display' property, and should be FACTOR times that width. 3. `:align-to HPOS' specifies that the space should be wide enough to reach HPOS, a value in canonical character units. @@ -29832,7 +29832,7 @@ append_stretch_glyph (struct it *it, Lisp_Object object, 5. `:relative-height FACTOR' specifies that the height of the stretch should be FACTOR times the height of the characters having - the glyph property. + the display property. Either none or exactly one of 4 or 5 must be present. @@ -29853,10 +29853,11 @@ produce_stretch_glyph (struct it *it) #ifdef HAVE_WINDOW_SYSTEM int ascent = 0; bool zero_height_ok_p = false; + struct face *face; if (FRAME_WINDOW_P (it->f)) { - struct face *face = FACE_FROM_ID (it->f, it->face_id); + face = FACE_FROM_ID (it->f, it->face_id); font = face->font ? face->font : FRAME_FONT (it->f); prepare_face_for_display (it->f, face); } @@ -29877,14 +29878,27 @@ produce_stretch_glyph (struct it *it) else if (prop = Fplist_get (plist, QCrelative_width), NUMVAL (prop) > 0) { /* Relative width `:relative-width FACTOR' specified and valid. - Compute the width of the characters having the `glyph' + Compute the width of the characters having this `display' property. */ struct it it2; - unsigned char *p = BYTE_POS_ADDR (IT_BYTEPOS (*it)); + Lisp_Object object = it->stack[it->sp - 1].string; + unsigned char *p = (STRINGP (object) + ? SDATA (object) + IT_STRING_BYTEPOS (*it) + : BYTE_POS_ADDR (IT_BYTEPOS (*it))); + bool multibyte_p = + STRINGP (object) ? STRING_MULTIBYTE (object) : it->multibyte_p; it2 = *it; - if (it->multibyte_p) - it2.c = it2.char_to_display = string_char_and_length (p, &it2.len); + if (multibyte_p) + { + it2.c = it2.char_to_display = string_char_and_length (p, &it2.len); +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (it->f) && ! ASCII_CHAR_P (it2.c)) + it2.face_id = FACE_FOR_CHAR (it->f, face, it2.c, + IT_CHARPOS (*it), + STRINGP (object)? object : Qnil); +#endif + } else { it2.c = it2.char_to_display = *p, it2.len = 1; From d096e12f447c1c67fe6fb6baa44212781d27ef53 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 22 Nov 2021 19:07:32 +0100 Subject: [PATCH 235/367] Simplify `gnu` compilation-mode regexp * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Remove the pattern ostensibly added for Ruby, because at closer inspection it could never have matched anything. This lessens the performance impact of the pattern added for GCC's -fanalyzer, now slightly tweaked. --- lisp/progmodes/compile.el | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index c0e16ce3515..2d4070c389c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -346,15 +346,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE ;; which is used for non-interactive programs other than ;; compilers (e.g. the "jade:" entry in compilation.txt). - (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") - ;; FIXME: This pattern was added for handling messages - ;; from Ruby, but it is unclear whether it is actually - ;; used since the gcc-include rule above seems to cover - ;; it. - (regexp "[ \t]+\\(?:in \\|from\\)") + (? (| (: alpha (+ (in ?. ?- alnum)) ":" (? " ")) ;; Skip indentation generated by tools like GCC's ;; -fanalyzer. - (: (+ space) "|"))) + (: (+ (in " \t")) "|"))) ;; File name group. (group-n 1 From eef6626b55e59d4a76e8666108cc68a578fac793 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 22 Nov 2021 20:15:28 +0200 Subject: [PATCH 236/367] * lisp/tab-bar.el: 'C-x t RET' creates a new tab for non-existent tab name. * lisp/tab-bar.el (tab-bar-switch-to-tab): Create a new tab and rename it to NAME when can't find the tab with the given NAME (bug#51935). --- etc/NEWS | 5 +++++ lisp/tab-bar.el | 10 ++++++++-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 09f17d6553b..0bf3d9368b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -181,6 +181,11 @@ For example, a 'display-buffer-alist' entry of will make the body of the chosen window 40 columns wide. For the height use 'window-height' in combination with 'body-lines'. +** Tab Bars and Tab Lines + +--- +*** 'C-x t RET' creates a new tab when the provided tab name doesn't exist. + ** Better detection of text suspiciously reordered on display. The function 'bidi-find-overridden-directionality' has been extended to detect reordering effects produced by embeddings and isolates diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index d331f29194d..656cb878e3e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1196,7 +1196,9 @@ Interactively, ARG is the prefix numeric argument and defaults to 1." Default values are tab names sorted by recency, so you can use \ \\\\[next-history-element] to get the name of the most recently visited tab, the second -most recent, and so on." +most recent, and so on. +When the tab with that NAME doesn't exist, create a new tab +and rename it to NAME." (interactive (let* ((recent-tabs (mapcar (lambda (tab) (alist-get 'name tab)) @@ -1204,7 +1206,11 @@ most recent, and so on." (list (completing-read (format-prompt "Switch to tab by name" (car recent-tabs)) recent-tabs nil nil nil nil recent-tabs)))) - (tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0)))) + (let ((tab-index (tab-bar--tab-index-by-name name))) + (if tab-index + (tab-bar-select-tab (1+ tab-index)) + (tab-bar-new-tab) + (tab-bar-rename-tab name)))) (defalias 'tab-bar-select-tab-by-name 'tab-bar-switch-to-tab) From c3ac8285d42eeb88d7abf9670229884f1bbccaae Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Nov 2021 19:40:56 +0100 Subject: [PATCH 237/367] ; Remove "needs" from emba jobs --- test/infra/Makefile.in | 1 - test/infra/test-jobs.yml | 32 -------------------------------- 2 files changed, 33 deletions(-) diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index a6fa81570ae..c091d2a7ba2 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -70,7 +70,6 @@ define subdir_template @echo >>$(FILE) @echo 'test-$(subst /,-,$(1))-inotify:' >>$(FILE) @echo ' stage: normal' >>$(FILE) - @echo ' needs: [build-image-inotify]' >>$(FILE) @echo ' extends: [.job-template, .test-template]' >>$(FILE) @echo ' rules:' >>$(FILE) @echo ' - changes:' >>$(FILE) diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 059ab4f0e05..79494035530 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -1,7 +1,6 @@ test-lib-src-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -23,7 +22,6 @@ test-lib-src-inotify: test-lisp-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -45,7 +43,6 @@ test-lisp-inotify: test-lisp-calc-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -67,7 +64,6 @@ test-lisp-calc-inotify: test-lisp-calendar-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -89,7 +85,6 @@ test-lisp-calendar-inotify: test-lisp-cedet-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -111,7 +106,6 @@ test-lisp-cedet-inotify: test-lisp-cedet-semantic-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -133,7 +127,6 @@ test-lisp-cedet-semantic-inotify: test-lisp-cedet-semantic-bovine-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -155,7 +148,6 @@ test-lisp-cedet-semantic-bovine-inotify: test-lisp-cedet-srecode-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -177,7 +169,6 @@ test-lisp-cedet-srecode-inotify: test-lisp-emacs-lisp-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -199,7 +190,6 @@ test-lisp-emacs-lisp-inotify: test-lisp-emacs-lisp-eieio-tests-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -221,7 +211,6 @@ test-lisp-emacs-lisp-eieio-tests-inotify: test-lisp-emacs-lisp-faceup-tests-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -243,7 +232,6 @@ test-lisp-emacs-lisp-faceup-tests-inotify: test-lisp-emulation-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -265,7 +253,6 @@ test-lisp-emulation-inotify: test-lisp-erc-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -287,7 +274,6 @@ test-lisp-erc-inotify: test-lisp-eshell-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -309,7 +295,6 @@ test-lisp-eshell-inotify: test-lisp-gnus-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -331,7 +316,6 @@ test-lisp-gnus-inotify: test-lisp-image-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -353,7 +337,6 @@ test-lisp-image-inotify: test-lisp-international-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -375,7 +358,6 @@ test-lisp-international-inotify: test-lisp-mail-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -397,7 +379,6 @@ test-lisp-mail-inotify: test-lisp-mh-e-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -419,7 +400,6 @@ test-lisp-mh-e-inotify: test-lisp-net-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -441,7 +421,6 @@ test-lisp-net-inotify: test-lisp-nxml-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -463,7 +442,6 @@ test-lisp-nxml-inotify: test-lisp-obsolete-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -485,7 +463,6 @@ test-lisp-obsolete-inotify: test-lisp-org-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -507,7 +484,6 @@ test-lisp-org-inotify: test-lisp-play-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -529,7 +505,6 @@ test-lisp-play-inotify: test-lisp-progmodes-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -551,7 +526,6 @@ test-lisp-progmodes-inotify: test-lisp-so-long-tests-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -573,7 +547,6 @@ test-lisp-so-long-tests-inotify: test-lisp-term-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -595,7 +568,6 @@ test-lisp-term-inotify: test-lisp-textmodes-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -617,7 +589,6 @@ test-lisp-textmodes-inotify: test-lisp-url-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -639,7 +610,6 @@ test-lisp-url-inotify: test-lisp-vc-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -661,7 +631,6 @@ test-lisp-vc-inotify: test-misc-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: @@ -683,7 +652,6 @@ test-misc-inotify: test-src-inotify: stage: normal - needs: [build-image-inotify] extends: [.job-template, .test-template] rules: - changes: From 0601afcf7c6c3498df010cef1511c38f254cbbf8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 22 Nov 2021 14:06:14 -0500 Subject: [PATCH 238/367] src/indent.c, src/xdisp.c: Questions about with_echo_area_buffer_unwind_data --- src/indent.c | 1 + src/xdisp.c | 1 + 2 files changed, 2 insertions(+) diff --git a/src/indent.c b/src/indent.c index de6b4895616..914dabf1e72 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2051,6 +2051,7 @@ window_column_x (struct window *w, Lisp_Object window, /* Restore window's buffer and point. */ +/* FIXME: Merge with `with_echo_area_buffer_unwind_data`? */ static void restore_window_buffer (Lisp_Object list) { diff --git a/src/xdisp.c b/src/xdisp.c index d9650211427..259d057adb1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10937,6 +10937,7 @@ WINDOW. */) /* The unwind form of with_echo_area_buffer is what we need here to make WINDOW temporarily show our buffer. */ + /* FIXME: Can we move this into the `if (!EQ (buffer, w->contents))`? */ record_unwind_protect (unwind_with_echo_area_buffer, with_echo_area_buffer_unwind_data (w)); From 44923722f42c2974c140e385c4c765f60944efe7 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 22 Nov 2021 21:05:15 +0200 Subject: [PATCH 239/367] * lisp/textmodes/flyspell.el: Pop up the menu under cursor from keyboard. * lisp/textmodes/flyspell.el (flyspell-emacs-popup): Use popup-menu-normalize-position with point when no mouse is involved, instead of the incorrect use of mouse-position (bug#52025). --- lisp/textmodes/flyspell.el | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 258e5fde674..2a9cae29f79 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -2270,17 +2270,8 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." ;;*---------------------------------------------------------------------*/ (defun flyspell-emacs-popup (event poss word) "The Emacs popup menu." - (if (and (not event) - (display-mouse-p)) - (let* ((mouse-pos (mouse-position)) - (mouse-pos (if (nth 1 mouse-pos) - mouse-pos - (set-mouse-position (car mouse-pos) - (/ (frame-width) 2) 2) - (mouse-position)))) - (setq event (list (list (car (cdr mouse-pos)) - (1+ (cdr (cdr mouse-pos)))) - (car mouse-pos))))) + (unless event + (setq event (popup-menu-normalize-position (point)))) (let* ((corrects (flyspell-sort (car (cdr (cdr poss))) word)) (cor-menu (if (consp corrects) (mapcar (lambda (correct) From 9ceb3070e34ad8a54184fd0deda477bf5ff77000 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 22 Nov 2021 14:23:26 -0500 Subject: [PATCH 240/367] * lisp/subr.el (event-start, event-end): Handle `(menu-bar)` events * lisp/net/browse-url.el (browse-url-interactive-arg): Simplify accordingly --- lisp/net/browse-url.el | 3 +-- lisp/subr.el | 20 ++++++++++---------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 19afb813317..011e43c447b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -737,8 +737,7 @@ position clicked before acting. This function returns a list (URL NEW-WINDOW-FLAG) for use in `interactive'." (let ((event (elt (this-command-keys) 0))) - (when (mouse-event-p event) - (mouse-set-point event))) + (mouse-set-point event)) (list (read-string prompt (or (and transient-mark-mode mark-active ;; rfc2396 Appendix E. (replace-regexp-in-string diff --git a/lisp/subr.el b/lisp/subr.el index 867db47a47e..06ea503da6a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1553,22 +1553,22 @@ nil or (STRING . POSITION)'. `posn-timestamp': The time the event occurred, in milliseconds. For more information, see Info node `(elisp)Click Events'." - (if (consp event) (nth 1 event) - ;; Use `window-point' for the case when the current buffer - ;; is temporarily switched to some other buffer (bug#50256) - (or (posn-at-point (window-point)) - (list (selected-window) (window-point) '(0 . 0) 0)))) + (or (and (consp event) (nth 1 event)) + ;; Use `window-point' for the case when the current buffer + ;; is temporarily switched to some other buffer (bug#50256) + (posn-at-point (window-point)) + (list (selected-window) (window-point) '(0 . 0) 0))) (defun event-end (event) "Return the ending position of EVENT. EVENT should be a click, drag, or key press event. See `event-start' for a description of the value returned." - (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event) - ;; Use `window-point' for the case when the current buffer - ;; is temporarily switched to some other buffer (bug#50256) - (or (posn-at-point (window-point)) - (list (selected-window) (window-point) '(0 . 0) 0)))) + (or (and (consp event) (nth (if (consp (nth 2 event)) 2 1) event)) + ;; Use `window-point' for the case when the current buffer + ;; is temporarily switched to some other buffer (bug#50256) + (posn-at-point (window-point)) + (list (selected-window) (window-point) '(0 . 0) 0))) (defsubst event-click-count (event) "Return the multi-click count of EVENT, a click or drag event. From 919cb31cf7f2aec2d8134783b0a5bb93a621fcaf Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 23 Nov 2021 09:01:33 +0800 Subject: [PATCH 241/367] Fix XI2 keysym translation * src/xterm.c (handle_one_xevent): Handle XI_KeyPress events that can't be translated into strings. --- src/xterm.c | 55 +++++++++++++++++++---------------------------------- 1 file changed, 20 insertions(+), 35 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 197776ce316..11e7e602c09 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10324,7 +10324,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, memset (&xkey, 0, sizeof xkey); xkey.type = KeyPress; - xkey.serial = 0; + xkey.serial = xev->serial; xkey.send_event = xev->send_event; xkey.display = xev->display; xkey.window = xev->event; @@ -10439,53 +10439,38 @@ handle_one_xevent (struct x_display_info *dpyinfo, emacs_abort (); } else - { #endif + { #ifdef HAVE_XKB int overflow = 0; KeySym sym = keysym; if (dpyinfo->xkb_desc) { - if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, - state & ~mods_rtrn, copy_bufptr, - copy_bufsiz, &overflow))) - goto XI_OTHER; + nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz, &overflow); + if (overflow) + { + copy_bufptr = alloca ((copy_bufsiz += overflow) + * sizeof *copy_bufptr); + overflow = 0; + nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz, &overflow); + + if (overflow) + nbytes = 0; + } } else -#else - { - block_input (); - char *str = XKeysymToString (keysym); - if (!str) - { - unblock_input (); - goto XI_OTHER; - } - nbytes = strlen (str) + 1; - copy_bufptr = alloca (nbytes); - strcpy (copy_bufptr, str); - unblock_input (); - } #endif -#ifdef HAVE_XKB - if (overflow) { - overflow = 0; - copy_bufptr = alloca (copy_bufsiz + overflow); - keysym = sym; - if (!(nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, - state & ~mods_rtrn, copy_bufptr, - copy_bufsiz + overflow, &overflow))) - goto XI_OTHER; - - if (overflow) - goto XI_OTHER; + nbytes = XLookupString (&xkey, copy_bufptr, + copy_bufsiz, &keysym, + &compose_status); } -#endif -#ifdef HAVE_X_I18N } -#endif /* First deal with keysyms which have defined translations to characters. */ From da3db6a15d1fa20e862ee7b95aeed84ab86dbb05 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 23 Nov 2021 01:20:15 +0000 Subject: [PATCH 242/367] Fix delay between tool bar clicks and visual feedback * src/haikuterm.c (haiku_read_socket): Redisplay after tool bar click. --- src/haikuterm.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/haikuterm.c b/src/haikuterm.c index 5364ebf823a..da8c92d6217 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2843,8 +2843,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) tool_bar_p = EQ (window, f->tool_bar_window); if (tool_bar_p) - handle_tool_bar_click - (f, x, y, type == BUTTON_DOWN, inev.modifiers); + { + handle_tool_bar_click + (f, x, y, type == BUTTON_DOWN, inev.modifiers); + redisplay (); + } } if (type == BUTTON_UP) From 2955d46c00430b38310d0fae968adea91e2bbc3d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 23 Nov 2021 11:08:45 +0800 Subject: [PATCH 243/367] Only reset scroll valuators on real enter events * src/xterm.c (handle_one_xevent): Test event detail and mode before resetting scroll valuators. --- src/xterm.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 11e7e602c09..bbfd3b0e82b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9870,7 +9870,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_display_set_last_user_time (dpyinfo, xi_event->time); x_detect_focus_change (dpyinfo, any, event, &inev.ie); - xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid); + + if (enter->detail != XINotifyInferior + && enter->mode != XINotifyPassiveUngrab + && enter->mode != XINotifyUngrab && any) + xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid); + f = any; if (f && x_mouse_click_focus_ignore_position) @@ -9895,7 +9900,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_display_set_last_user_time (dpyinfo, xi_event->time); x_detect_focus_change (dpyinfo, any, event, &inev.ie); - xi_reset_scroll_valuators_for_device_id (dpyinfo, leave->deviceid); f = x_top_window_to_frame (dpyinfo, leave->event); if (f) From 5c4136f56465c6b2c65fb3577603879cdbbe7f97 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 23 Nov 2021 17:57:09 +0800 Subject: [PATCH 244/367] Fix compilation with XInput 2 but without XKB * src/xterm.c (handle_one_xevent): Remove extraneous conditional. --- src/xterm.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index bbfd3b0e82b..dfbbff23024 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10310,9 +10310,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, char copy_buffer[81]; char *copy_bufptr = copy_buffer; unsigned char *copy_ubufptr; -#ifdef HAVE_XKB int copy_bufsiz = sizeof (copy_buffer); -#endif ptrdiff_t i; int nchars, len; From 84d9d47660be203ba04f807a5a9de27151df7273 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 23 Nov 2021 11:39:21 +0100 Subject: [PATCH 245/367] Prefer locate-user-emacs-file in gitmerge.el * admin/gitmerge.el (gitmerge-status-file): Prefer 'locate-user-emacs-file' to fiddling with 'user-emacs-directory'. --- admin/gitmerge.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 67fca87c119..658ceb77f49 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -68,8 +68,7 @@ bump Emacs version\\|Auto-commit")) (defvar gitmerge-minimum-missing 10 "Minimum number of missing commits to consider merging in batch mode.") -(defvar gitmerge-status-file (expand-file-name "gitmerge-status" - user-emacs-directory) +(defvar gitmerge-status-file (locate-user-emacs-file "gitmerge-status") "File where missing commits will be saved between sessions.") (defvar gitmerge-ignore-branches-regexp From b4fb381d8d7e866676650a7283ac6d873838c49f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 23 Nov 2021 14:37:53 +0200 Subject: [PATCH 246/367] ; * src/xdisp.c (produce_stretch_glyph): Avoid compilation warning. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index b3647f71e4c..34add807986 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29853,7 +29853,7 @@ produce_stretch_glyph (struct it *it) #ifdef HAVE_WINDOW_SYSTEM int ascent = 0; bool zero_height_ok_p = false; - struct face *face; + struct face *face = NULL; /* shut up GCC's -Wmaybe-uninitialized */ if (FRAME_WINDOW_P (it->f)) { From bdb489ad5dd81c8aef8ada8940f6981034dfaf82 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 23 Nov 2021 14:44:45 +0200 Subject: [PATCH 247/367] ; * etc/DEBUG: Adjust instructions for libgccjit reproducer. --- etc/DEBUG | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/etc/DEBUG b/etc/DEBUG index 555370588fe..ced6a92d711 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -591,9 +591,10 @@ If you cannot figure out the cause for the problem using the above, native-compile the problematic file after setting the variable 'comp-libgccjit-reproducer' to a non-nil value. That should produce a file named ELNFILENAME_libgccjit_repro.c, where ELNFILENAME is the -name of the problematic .eln file, in the same directory where the -.eln file is produced. Then attach that reproducer C file to your bug -report. +name of the problematic .eln file in the same directory where the .eln +file is produced, or a file repro.c under your ~/.emacs.d/eln-cache +(which one depends on how the native-compilation is invoked). Then +attach that reproducer C file to your bug report. ** Following longjmp call. From 38fdeaef4654d4d4fac8c73f48058d94f158e711 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 23 Nov 2021 16:25:48 +0200 Subject: [PATCH 248/367] ; * etc/DEBUG: Fix last change. --- etc/DEBUG | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/etc/DEBUG b/etc/DEBUG index ced6a92d711..a05aeef1606 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -591,10 +591,13 @@ If you cannot figure out the cause for the problem using the above, native-compile the problematic file after setting the variable 'comp-libgccjit-reproducer' to a non-nil value. That should produce a file named ELNFILENAME_libgccjit_repro.c, where ELNFILENAME is the -name of the problematic .eln file in the same directory where the .eln -file is produced, or a file repro.c under your ~/.emacs.d/eln-cache -(which one depends on how the native-compilation is invoked). Then -attach that reproducer C file to your bug report. +name of the problematic .eln file, either in the same directory where +the .eln file is produced, or under your ~/.emacs.d/eln-cache (which +one depends on how the native-compilation is invoked). It is also +possible that the reproducer file's name will be something like +subr--trampoline-XXXXXXX_FUNCTION_libgccjit_repro.c, where XXXXXXX is +a long string of hex digits and FUNCTION is some function from the +compiled .el file. Attach that reproducer C file to your bug report. ** Following longjmp call. From 756b8a5f1bd28aeadc804fd2f93ce7e823a1d4a2 Mon Sep 17 00:00:00 2001 From: Takesi Ayanokoji Date: Tue, 23 Nov 2021 23:30:23 +0900 Subject: [PATCH 249/367] Fix typos in documentation * doc/lispref/anti.texi: * doc/misc/efaq.texi: Fix typos. Copyright-paperwork-exempt: yes --- doc/lispref/anti.texi | 2 +- doc/misc/efaq.texi | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi index 118df05c791..45cbff61e0b 100644 --- a/doc/lispref/anti.texi +++ b/doc/lispref/anti.texi @@ -135,7 +135,7 @@ the programmers should be trusted to know what they are doing. @item We deleted several features of the @code{pcase} macro, in accordance -with our general plane to remove @code{pcase} from Emacs: +with our general plan to remove @code{pcase} from Emacs: @itemize @minus @item diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 18342e65b0a..cdb6f9b5848 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1086,7 +1086,7 @@ Emacs Lisp form at point. @cindex pasting text on text terminals @cindex bracketed paste mode @item -On text terminals that support the ``bracketed paste mode'' EMacs now +On text terminals that support the ``bracketed paste mode'' Emacs now uses that mode by default. This mode allows Emacs to distinguish between pasted text and text typed by the user. @@ -2542,12 +2542,12 @@ load @code{dired-x} by adding the following to your @file{.emacs} file: (require 'dired-x)) @end lisp -With @code{dired-x} loaded, @kbd{M-o} toggles omitting in each dired buffer. +With @code{dired-x} loaded, @kbd{C-x M-o} toggles omitting in each dired buffer. You can make omitting the default for new dired buffers by putting the following in your @file{.emacs}: @lisp -(add-hook 'dired-mode-hook 'dired-omit-toggle) +(add-hook 'dired-mode-hook 'dired-omit-mode) @end lisp If you're tired of seeing backup files whenever you do an @samp{ls} at From 88637c341510e92bb6213418628e2ce84332450a Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 23 Nov 2021 16:25:41 +0100 Subject: [PATCH 250/367] Adapt artifacts paths in emba testjobs * test/infra/Makefile.in (subdir_template): Adapt artifacts paths. * test/infra/test-jobs.yml: Regenerate. --- test/infra/Makefile.in | 4 +- test/infra/test-jobs.yml | 128 ++++++++++----------------------------- 2 files changed, 33 insertions(+), 99 deletions(-) diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index c091d2a7ba2..c6b9b39e8c3 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -81,9 +81,7 @@ define subdir_template @echo ' public: true' >>$(FILE) @echo ' expire_in: 1 week' >>$(FILE) @echo ' paths:' >>$(FILE) - @echo ' - $(tn)/test/$(1)/*.log' >>$(FILE) - @echo ' - $(tn)/**/core' >>$(FILE) - @echo ' - $(tn)/core' >>$(FILE) + @echo ' - $(tn)/$(1)/*.log' >>$(FILE) @echo ' when: always' >>$(FILE) @echo ' variables:' >>$(FILE) @echo ' target: emacs-inotify' >>$(FILE) diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 79494035530..413dfeba33a 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -12,9 +12,7 @@ test-lib-src-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lib-src/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lib-src/*.log when: always variables: target: emacs-inotify @@ -33,9 +31,7 @@ test-lisp-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/*.log when: always variables: target: emacs-inotify @@ -54,9 +50,7 @@ test-lisp-calc-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/calc/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/calc/*.log when: always variables: target: emacs-inotify @@ -75,9 +69,7 @@ test-lisp-calendar-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/calendar/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/calendar/*.log when: always variables: target: emacs-inotify @@ -96,9 +88,7 @@ test-lisp-cedet-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/cedet/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/cedet/*.log when: always variables: target: emacs-inotify @@ -117,9 +107,7 @@ test-lisp-cedet-semantic-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/cedet/semantic/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/cedet/semantic/*.log when: always variables: target: emacs-inotify @@ -138,9 +126,7 @@ test-lisp-cedet-semantic-bovine-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/cedet/semantic/bovine/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/cedet/semantic/bovine/*.log when: always variables: target: emacs-inotify @@ -159,9 +145,7 @@ test-lisp-cedet-srecode-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/cedet/srecode/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/cedet/srecode/*.log when: always variables: target: emacs-inotify @@ -180,9 +164,7 @@ test-lisp-emacs-lisp-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/emacs-lisp/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/emacs-lisp/*.log when: always variables: target: emacs-inotify @@ -201,9 +183,7 @@ test-lisp-emacs-lisp-eieio-tests-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/emacs-lisp/eieio-tests/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/emacs-lisp/eieio-tests/*.log when: always variables: target: emacs-inotify @@ -222,9 +202,7 @@ test-lisp-emacs-lisp-faceup-tests-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/emacs-lisp/faceup-tests/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/emacs-lisp/faceup-tests/*.log when: always variables: target: emacs-inotify @@ -243,9 +221,7 @@ test-lisp-emulation-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/emulation/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/emulation/*.log when: always variables: target: emacs-inotify @@ -264,9 +240,7 @@ test-lisp-erc-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/erc/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/erc/*.log when: always variables: target: emacs-inotify @@ -285,9 +259,7 @@ test-lisp-eshell-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/eshell/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/eshell/*.log when: always variables: target: emacs-inotify @@ -306,9 +278,7 @@ test-lisp-gnus-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/gnus/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/gnus/*.log when: always variables: target: emacs-inotify @@ -327,9 +297,7 @@ test-lisp-image-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/image/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/image/*.log when: always variables: target: emacs-inotify @@ -348,9 +316,7 @@ test-lisp-international-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/international/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/international/*.log when: always variables: target: emacs-inotify @@ -369,9 +335,7 @@ test-lisp-mail-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/mail/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/mail/*.log when: always variables: target: emacs-inotify @@ -390,9 +354,7 @@ test-lisp-mh-e-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/mh-e/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/mh-e/*.log when: always variables: target: emacs-inotify @@ -411,9 +373,7 @@ test-lisp-net-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/net/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/net/*.log when: always variables: target: emacs-inotify @@ -432,9 +392,7 @@ test-lisp-nxml-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/nxml/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/nxml/*.log when: always variables: target: emacs-inotify @@ -453,9 +411,7 @@ test-lisp-obsolete-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/obsolete/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/obsolete/*.log when: always variables: target: emacs-inotify @@ -474,9 +430,7 @@ test-lisp-org-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/org/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/org/*.log when: always variables: target: emacs-inotify @@ -495,9 +449,7 @@ test-lisp-play-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/play/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/play/*.log when: always variables: target: emacs-inotify @@ -516,9 +468,7 @@ test-lisp-progmodes-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/progmodes/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/progmodes/*.log when: always variables: target: emacs-inotify @@ -537,9 +487,7 @@ test-lisp-so-long-tests-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/so-long-tests/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/so-long-tests/*.log when: always variables: target: emacs-inotify @@ -558,9 +506,7 @@ test-lisp-term-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/term/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/term/*.log when: always variables: target: emacs-inotify @@ -579,9 +525,7 @@ test-lisp-textmodes-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/textmodes/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/textmodes/*.log when: always variables: target: emacs-inotify @@ -600,9 +544,7 @@ test-lisp-url-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/url/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/url/*.log when: always variables: target: emacs-inotify @@ -621,9 +563,7 @@ test-lisp-vc-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/lisp/vc/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/lisp/vc/*.log when: always variables: target: emacs-inotify @@ -642,9 +582,7 @@ test-misc-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/misc/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/misc/*.log when: always variables: target: emacs-inotify @@ -663,9 +601,7 @@ test-src-inotify: public: true expire_in: 1 week paths: - - ${test_name}/test/src/*.log - - ${test_name}/**/core - - ${test_name}/core + - ${test_name}/src/*.log when: always variables: target: emacs-inotify From f90176b1ca8440adcbcfa61ce0da35d967b9cd6f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 09:09:45 +0800 Subject: [PATCH 251/367] Use only effective modifiers when handling XI2 button events * src/xterm.c (handle_one_xevent): Use mods.effective when constructing button events. --- src/xterm.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index dfbbff23024..7e0d58745e2 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10149,10 +10149,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, bv.x = lrint (xev->event_x); bv.y = lrint (xev->event_y); bv.window = xev->event; - bv.state = xev->mods.base - | xev->mods.effective - | xev->mods.latched - | xev->mods.locked; + bv.state = xev->mods.effective; bv.time = xev->time; memset (&compose_status, 0, sizeof (compose_status)); From dc0ed8818bebaf8a6003bb9626d28ea9be070890 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 01:46:33 +0000 Subject: [PATCH 252/367] Remove extraneous code left over from the ftbe font driver * src/haikuterm.c (syms_of_haikuterm): Remove dead code. --- src/haikuterm.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/haikuterm.c b/src/haikuterm.c index da8c92d6217..be2b6c2491f 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3620,9 +3620,6 @@ Setting it to any other value is equivalent to `shift'. */); staticpro (&rdb); Fprovide (Qhaiku, Qnil); -#ifdef HAVE_BE_FREETYPE - Fprovide (Qfreetype, Qnil); -#endif #ifdef USE_BE_CAIRO Fprovide (intern_c_string ("cairo"), Qnil); #endif From c484b749f204522b3e9df643cb371b9f5511f4d2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 09:49:39 +0800 Subject: [PATCH 253/367] Fix mouse-wheel-text-scale * lisp/mwheel.el (mouse-wheel-text-scale): Test for alternative events correctly. --- lisp/mwheel.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 5d18cf84c2b..6a853a35216 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -415,8 +415,8 @@ value of ARG, and the command uses it in subsequent scrolls." (cond ((memq button (list mouse-wheel-down-event mouse-wheel-down-alternate-event)) (text-scale-increase 1)) - ((eq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((memq button (list mouse-wheel-up-event + mouse-wheel-up-alternate-event)) (text-scale-decrease 1))) (select-window selected-window)))) From d63fc69b192a608f98c15d6014430f28138fd82e Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Wed, 24 Nov 2021 07:58:11 +0100 Subject: [PATCH 254/367] Pass options from make to configure through a variable. * GNUmakefile (configure): Use the variable. * INSTALL.REPO: Document the variable (bug#51965). --- GNUmakefile | 5 +++++ INSTALL.REPO | 23 +++++++++++++++++++---- Makefile.in | 13 +++++++++++-- 3 files changed, 35 insertions(+), 6 deletions(-) diff --git a/GNUmakefile b/GNUmakefile index 5155487de28..76fd77ba1b0 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -104,8 +104,13 @@ configure: Makefile: configure @echo >&2 'There seems to be no Makefile in this directory.' +ifeq ($(configure),default) @echo >&2 'Running ./configure ...' ./configure +else + @echo >&2 'Running ./configure '$(configure)'...' + ./configure $(configure) +endif @echo >&2 'Makefile built.' # 'make bootstrap' in a fresh checkout needn't run 'configure' twice. diff --git a/INSTALL.REPO b/INSTALL.REPO index da56d7611b2..182c2e95341 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -8,9 +8,15 @@ directory on your local machine: To build the repository code, simply run 'make' in the 'emacs' directory. This should work if your files are freshly checked out -from the repository, and if you have the proper tools installed. If -it doesn't work, or if you have special build requirements, the -following information may be helpful. +from the repository, and if you have the proper tools installed; the +default configuration options will be used. Other configuration +options can be specified by setting a 'configure' variable, for +example: + + $ make configure="--prefix=/opt/emacs CFLAGS='-O0 -g3'" + +If the above doesn't work, or if you have special build requirements, +the following information may be helpful. Building Emacs from the source-code repository requires some tools that are not needed when building from a release. You will need: @@ -58,7 +64,16 @@ To update loaddefs.el (and similar files), do: If either of the above partial procedures fails, try 'make bootstrap'. If CPU time is not an issue, 'make bootstrap' is a more thorough way -to rebuild, avoiding spurious problems. +to rebuild, avoiding spurious problems. 'make bootstrap' rebuilds +Emacs with the same configuration options as the previous build; it +can also be used to rebuild Emacs with other configuration options by +setting a 'configure' variable, for example: + + $ make bootstrap configure="CFLAGS='-O0 -g3'" + +To rebuild Emacs with the default configuration options, you can use: + + $ make bootstrap configure=default Occasionally, there are changes that 'make bootstrap' won't be able to handle. The most thorough cleaning can be achieved by 'git clean -fdx' diff --git a/Makefile.in b/Makefile.in index 3c092fa63df..4b40d8741d4 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1145,14 +1145,23 @@ check-info: info .PHONY: bootstrap -# Bootstrapping does the following: +# Without a 'configure' variable, bootstrapping does the following: # * Remove files to start from a bootstrap-clean slate. # * Run autogen.sh. # * Rebuild Makefile, to update the build procedure itself. # * Do the actual build. -bootstrap: bootstrap-clean +# With a 'configure' variable, bootstrapping does the following: +# * Remove files to start from an extraclean slate. +# * Do the actual build, during which the 'configure' variable is +# used (see the Makefile goal in GNUmakefile). +bootstrap: +ifndef configure + $(MAKE) bootstrap-clean cd $(srcdir) && ./autogen.sh autoconf $(MAKE) MAKEFILE_NAME=force-Makefile force-Makefile +else + $(MAKE) extraclean +endif $(MAKE) all .PHONY: ChangeLog change-history change-history-commit change-history-nocommit From 3a2eee6f7439866ac51d0d4c7b43f7f9f6f88fe2 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 08:27:22 +0100 Subject: [PATCH 255/367] Fix string-glyph-split infloop MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/emacs-lisp/subr-x.el (string-glyph-split): Fix infloop when applied to (string-glyph-split "✈️🌍") (bug#52067). --- lisp/emacs-lisp/subr-x.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index b2dae564c2b..95254b946e5 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -456,7 +456,12 @@ This takes into account combining characters and grapheme clusters." (start 0) comp) (while (< start (length string)) - (if (setq comp (find-composition-internal start nil string nil)) + (if (setq comp (find-composition-internal + start + ;; Don't search backward in the string for the + ;; start of the composition. + (min (length string) (1+ start)) + string nil)) (progn (push (substring string (car comp) (cadr comp)) result) (setq start (cadr comp))) From 3219518e5c64281237bb604e6c2977f655aff238 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 09:38:26 +0000 Subject: [PATCH 256/367] Fix 1 pixel wide border in frames on Haiku * src/haiku_support.cc (EmacsWindow.FrameResized): Add 1 to pixel widths. * src/haikuterm.c (haiku_read_socket): Use `lrint' to round widths. --- src/haiku_support.cc | 4 ++-- src/haikuterm.c | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 5f9fe7e234f..9fb98f70814 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -664,8 +664,8 @@ class EmacsWindow : public BDirectWindow { struct haiku_resize_event rq; rq.window = this; - rq.px_heightf = newHeight; - rq.px_widthf = newWidth; + rq.px_heightf = newHeight + 1.0f; + rq.px_widthf = newWidth + 1.0f; haiku_write (FRAME_RESIZED, &rq); BDirectWindow::FrameResized (newWidth, newHeight); diff --git a/src/haikuterm.c b/src/haikuterm.c index be2b6c2491f..3e5b6046f6d 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2626,8 +2626,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!f) continue; - int width = (int) b->px_widthf; - int height = (int) b->px_heightf; + int width = lrint (b->px_widthf); + int height = lrint (b->px_heightf); BView_draw_lock (FRAME_HAIKU_VIEW (f)); BView_resize_to (FRAME_HAIKU_VIEW (f), width, height); From e754973d4ddf6925b0289ce1f2cbbf415310a5da Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 09:56:29 +0000 Subject: [PATCH 257/367] Clear past end of frame on Haiku * src/haiku_support.c (EmacsWindow.FrameResized): Delete size adjustment. * src/haikuterm.c (haiku_clear_frame): Clear one pixel past the end of the frame. --- src/haiku_support.cc | 4 ++-- src/haikuterm.c | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 9fb98f70814..5f9fe7e234f 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -664,8 +664,8 @@ class EmacsWindow : public BDirectWindow { struct haiku_resize_event rq; rq.window = this; - rq.px_heightf = newHeight + 1.0f; - rq.px_widthf = newWidth + 1.0f; + rq.px_heightf = newHeight; + rq.px_widthf = newWidth; haiku_write (FRAME_RESIZED, &rq); BDirectWindow::FrameResized (newWidth, newHeight); diff --git a/src/haikuterm.c b/src/haikuterm.c index 3e5b6046f6d..97dbe3c8d38 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -218,11 +218,11 @@ haiku_clear_frame (struct frame *f) block_input (); BView_draw_lock (view); BView_StartClip (view); - BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), - FRAME_PIXEL_HEIGHT (f)); + BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f) + 1, + FRAME_PIXEL_HEIGHT (f) + 1); BView_SetHighColor (view, FRAME_BACKGROUND_PIXEL (f)); - BView_FillRectangle (view, 0, 0, FRAME_PIXEL_WIDTH (f), - FRAME_PIXEL_HEIGHT (f)); + BView_FillRectangle (view, 0, 0, FRAME_PIXEL_WIDTH (f) + 1, + FRAME_PIXEL_HEIGHT (f) + 1); BView_EndClip (view); BView_draw_unlock (view); unblock_input (); From 7e3c2b553fede9feeeb755dfeba875fece0c2f63 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Tue, 23 Nov 2021 20:56:44 +0000 Subject: [PATCH 258/367] Allow NS to handle non-text clipboard contents * src/nsselect.m (ns_get_foreign_selection): Handle non-plain text clipboard entries. (ns_string_from_pasteboard): Remove EOL conversion. (syms_of_nsselect): Define QTARGETS. --- src/nsselect.m | 80 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 77 insertions(+), 3 deletions(-) diff --git a/src/nsselect.m b/src/nsselect.m index 5ab3ef77fec..e999835014d 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -215,9 +215,74 @@ Updated by Christian Limpach (chris@nice.ch) static Lisp_Object ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target) { + NSDictionary *typeLookup; id pb; pb = ns_symbol_to_pb (symbol); - return pb != nil ? ns_string_from_pasteboard (pb) : Qnil; + + /* Dictionary for looking up NS types from MIME types, and vice versa. */ + typeLookup + = [NSDictionary + dictionaryWithObjectsAndKeys: + @"text/plain", NSPasteboardTypeURL, +#if NS_USE_NSPasteboardTypeFileURL + @"text/plain", NSPasteboardTypeFileURL, +#else + @"text/plain", NSFilenamesPboardType, +#endif + @"text/html", NSPasteboardTypeHTML, + @"text/plain", NSPasteboardTypeMultipleTextSelection, + @"application/pdf", NSPasteboardTypePDF, + @"image/png", NSPasteboardTypePNG, + @"application/rtf", NSPasteboardTypeRTF, + @"application/rtfd", NSPasteboardTypeRTFD, + @"STRING", NSPasteboardTypeString, + @"text/plain", NSPasteboardTypeTabularText, + @"image/tiff", NSPasteboardTypeTIFF, + nil]; + + if (EQ (target, QTARGETS)) + { + NSMutableArray *types = [NSMutableArray arrayWithCapacity:3]; + + NSString *type; + NSEnumerator *e = [[pb types] objectEnumerator]; + while (type = [e nextObject]) + { + NSString *val = [typeLookup valueForKey:type]; + if (val && ! [types containsObject:val]) + [types addObject:val]; + } + + Lisp_Object v = Fmake_vector (make_fixnum ([types count]+1), Qnil); + ASET (v, 0, QTARGETS); + + for (int i = 0 ; i < [types count] ; i++) + ASET (v, i+1, intern ([[types objectAtIndex:i] UTF8String])); + + return v; + } + else + { + NSData *d; + NSArray *availableTypes; + NSString *result, *t; + + if (!NILP (target)) + availableTypes + = [typeLookup allKeysForObject: + [NSString stringWithLispString:SYMBOL_NAME (target)]]; + else + availableTypes = @[NSPasteboardTypeString]; + + t = [pb availableTypeFromArray:availableTypes]; + + result = [pb stringForType:t]; + if (result) + return [result lispString]; + + d = [pb dataForType:t]; + return make_string ([d bytes], [d length]); + } } @@ -234,8 +299,6 @@ Updated by Christian Limpach (chris@nice.ch) ns_string_from_pasteboard (id pb) { NSString *type, *str; - const char *utfStr; - int length; type = [pb availableTypeFromArray: ns_return_types]; if (type == nil) @@ -260,6 +323,14 @@ Updated by Christian Limpach (chris@nice.ch) } } + /* FIXME: Is the below EOL conversion even needed? I've removed it + for now so we can see if it causes problems. */ + return [str lispString]; + +#if 0 + const char *utfStr; + int length; + /* assume UTF8 */ NS_DURING { @@ -294,6 +365,7 @@ Updated by Christian Limpach (chris@nice.ch) NS_ENDHANDLER return make_string (utfStr, length); +#endif } @@ -491,6 +563,8 @@ Updated by Christian Limpach (chris@nice.ch) DEFSYM (QTEXT, "TEXT"); DEFSYM (QFILE_NAME, "FILE_NAME"); + DEFSYM (QTARGETS, "TARGETS"); + defsubr (&Sns_disown_selection_internal); defsubr (&Sns_get_selection); defsubr (&Sns_own_selection_internal); From 8efee422e1915a000f7220e680e3165407171388 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Wed, 24 Nov 2021 08:54:37 +0100 Subject: [PATCH 259/367] Re-enable the disabledForeground X resource. * doc/emacs/xresources.texi (Lucid Resources): Document the resource. Also document the 'cursor' resource (bug#52052). * lwlib/xlwmenu.c (make_drawing_gcs): Re-enable the use of the disabledForeground resource. The use of this X resource was disabled without reason in commit ef93458b2f8 by overwriting its value with the value of the foreground resource. --- doc/emacs/xresources.texi | 5 +++++ lwlib/xlwmenu.c | 1 - 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 0e0070829c1..a7bd006df4d 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -395,6 +395,8 @@ Background color. Foreground color for a selected item. @item foreground Foreground color. +@item disabledForeground +Foreground color for a disabled menu item. @ifnottex @item horizontalSpacing Horizontal spacing in pixels between items. Default is 3. @@ -409,6 +411,9 @@ elements. Default is 1. @item borderThickness Thickness of the external borders of the menu bars and pop-up menus. Default is 1. +@item cursor +Name of the cursor to use in the menu bars and pop-up menus. Default +is @code{"right_ptr"}. @end ifnottex @item margin Margin of the menu bar, in characters. Default is 1. diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 5f8832bb362..a0a10d13db5 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -1657,7 +1657,6 @@ make_drawing_gcs (XlwMenuWidget mw) #define BRIGHTNESS(color) (((color) & 0xff) + (((color) >> 8) & 0xff) + (((color) >> 16) & 0xff)) /* Allocate color for disabled menu-items. */ - mw->menu.disabled_foreground = mw->menu.foreground; if (BRIGHTNESS(mw->menu.foreground) < BRIGHTNESS(mw->core.background_pixel)) scale = 2.3; else From a13b437c81f1f2e54555e7281480ea7e8eee8753 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 11:55:53 +0100 Subject: [PATCH 260/367] Add support for the min-width display property * doc/lispref/display.texi (Display Property): Document get-display-property. (Other Display Specs): Document min-width property. * src/dispextern.h (struct it): Add fields for min-width handling. * src/xdisp.c (find_display_property, get_display_property): New helper functions. (display_min_width): Insert stretch glyphs based on the min width. (Fget_display_property): New defun. (handle_display_prop): Handle min-width ends. (handle_single_display_spec): Handle min-width starts. --- doc/lispref/display.texi | 42 +++++++++- etc/NEWS | 7 ++ src/dispextern.h | 6 ++ src/xdisp.c | 172 ++++++++++++++++++++++++++++++++++++++- test/src/xdisp-tests.el | 16 ++++ 5 files changed, 237 insertions(+), 6 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 6b1c52b4859..dc53eeff9bf 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4874,9 +4874,7 @@ window on a minibuffer-less frame. The @code{display} text property (or overlay property) is used to insert images into text, and to control other aspects of how text -displays. The value of the @code{display} property should be a -display specification, or a list or vector containing several display -specifications. Display specifications in the same @code{display} +displays. Display specifications in the same @code{display} property value generally apply in parallel to the text they cover. If several sources (overlays and/or a text property) specify values @@ -4884,6 +4882,28 @@ for the @code{display} property, only one of the values takes effect, following the rules of @code{get-char-property}. @xref{Examining Properties}. + The value of the @code{display} property should be a display +specification, or a list or vector containing several display +specifications. + +@defun get-display-property position prop &optional object properties +This convenience function can be used to get a specific display +property, no matter whether the @code{display} property is a vector, a +list or a simple property. This is like @code{get-text-property} +(@pxref{Examining Properties}), but works on the @code{display} +property only. + +@var{position} is the position in the buffer or string to examine, and +@var{prop} is the @code{display} property to return. The optional +@var{object} argument should be either a string or a buffer, and +defaults to the current buffer. If the optional @var{properties} +argument is non-@code{nil}, it should be a @code{display} property, +and in that case, @var{position} and @var{object} are ignored. (This +can be useful if you've already gotten the @code{display} property +with @code{get-char-property}, for instance (@pxref{Examining +Properties}). +@end defun + @cindex display property, unsafe evaluation @cindex security, and display specifications Some of the display specifications allow inclusion of Lisp forms, @@ -5159,6 +5179,22 @@ text that has the specification. It displays all of these spaces be an integer or float. Characters other than spaces are not affected at all; in particular, this has no effect on tab characters. +@item (min-width (@var{width})) +This display specification adds padding to the end of the text if the +text is shorter than @var{width}. The text is partitioned using the +identity of the parameter, which is why the parameter is a list with +one element. For instance: + +@lisp +(insert (propertize "foo" '(display (min-width (6.0))))) +@end lisp + +This will add padding after @samp{foo} bringing the total width up to +the width of six normal characters. Note that the ``range'' is +identified by the @code{(6.0)} list, compared with @code{eq}. The +width can be either a character width or a pixel specification +(@pxref{Pixel Specification}). + @item (height @var{height}) This display specification makes the text taller or shorter. Here are the possibilities for @var{height}: diff --git a/etc/NEWS b/etc/NEWS index 0bf3d9368b6..1cd49c5289c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -668,6 +668,13 @@ Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 +** New function 'get-display-property'. +This is like 'get-text-property', but works on the 'display' text +property. + +** New 'min-width' 'display' property. +This allows setting a minimum width for a region. + ** Keymaps and key definitions +++ diff --git a/src/dispextern.h b/src/dispextern.h index a698f6546b1..088297157ac 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2746,6 +2746,12 @@ struct it /* For iterating over bidirectional text. */ struct bidi_it bidi_it; bidi_dir_t paragraph_embedding; + + /* For handling the :min-width property. The object is the text + property we're testing the `eq' of (nil if none), and the integer + is the x position of the start of the run of glyphs. */ + Lisp_Object min_width_property; + int min_width_start; }; diff --git a/src/xdisp.c b/src/xdisp.c index 11ea8360343..4d3b4878058 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -822,6 +822,9 @@ bool help_echo_showing_p; /* Functions to mark elements as needing redisplay. */ enum { REDISPLAY_SOME = 2}; /* Arbitrary choice. */ +static bool calc_pixel_width_or_height (double *, struct it *, Lisp_Object, + struct font *, bool, int *); + void redisplay_other_windows (void) { @@ -5141,6 +5144,149 @@ setup_for_ellipsis (struct it *it, int len) it->ellipsis_p = true; } + +static Lisp_Object +find_display_property (Lisp_Object disp, Lisp_Object prop) +{ + if (NILP (disp)) + return Qnil; + /* We have a vector of display specs. */ + if (VECTORP (disp)) + { + for (ptrdiff_t i = 0; i < ASIZE (disp); i++) + { + Lisp_Object elem = AREF (disp, i); + if (CONSP (elem) + && CONSP (XCDR (elem)) + && EQ (XCAR (elem), prop)) + return XCAR (XCDR (elem)); + } + return Qnil; + } + /* We have a list of display specs. */ + else if (CONSP (disp) + && CONSP (XCAR (disp))) + { + while (!NILP (disp)) + { + Lisp_Object elem = XCAR (disp); + if (CONSP (elem) + && CONSP (XCDR (elem)) + && EQ (XCAR (elem), prop)) + return XCAR (XCDR (elem)); + + /* Check that we have a proper list before going to the next + element. */ + if (CONSP (XCDR (disp))) + disp = XCDR (disp); + else + disp = Qnil; + } + return Qnil; + } + /* A simple display spec. */ + else if (CONSP (disp) + && CONSP (XCDR (disp)) + && EQ (XCAR (disp), prop)) + return XCAR (XCDR (disp)); + else + return Qnil; +} + +static Lisp_Object get_display_property (ptrdiff_t bufpos, Lisp_Object prop, + Lisp_Object object) +{ + return find_display_property (Fget_text_property (make_fixnum (bufpos), + + Qdisplay, object), + prop); +} + +static void +display_min_width (struct it *it, ptrdiff_t bufpos, + Lisp_Object object, Lisp_Object width_spec) +{ + /* We're being called at the end of the `min-width' sequence, + probably. */ + if (!NILP (it->min_width_property) + && !EQ (width_spec, it->min_width_property)) + { + if (!it->glyph_row) + return; + + /* Check that we're really right after the sequence of + characters covered by this `min-width'. */ + if (bufpos > BEGV + && EQ (it->min_width_property, + get_display_property (bufpos - 1, Qmin_width, object))) + { + Lisp_Object w = Qnil; + double width; +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (it->f)) + { + struct font *font = NULL; + struct face *face = FACE_FROM_ID (it->f, it->face_id); + font = face->font ? face->font : FRAME_FONT (it->f); + calc_pixel_width_or_height (&width, it, + XCAR (it->min_width_property), + font, true, NULL); + width -= it->current_x - it->min_width_start; + w = list1 (make_int (width)); + } + else +#endif + { + calc_pixel_width_or_height (&width, it, + XCAR (it->min_width_property), + NULL, true, NULL); + width -= (it->current_x - it->min_width_start) / + FRAME_COLUMN_WIDTH (it->f); + w = make_int (width); + } + + /* Insert the stretch glyph. */ + it->object = list3 (Qspace, QCwidth, w); + produce_stretch_glyph (it); + it->min_width_property = Qnil; + } + } + + /* We're at the start of a `min-width' sequence -- record the + position and the property, so that we can later see if we're at + the end. */ + if (CONSP (width_spec)) + { + if (bufpos == BEGV + || (bufpos > BEGV + && !EQ (width_spec, + get_display_property (bufpos - 1, Qmin_width, object)))) + { + it->min_width_property = width_spec; + it->min_width_start = it->current_x; + } + } +} + +DEFUN ("get-display-property", Fget_display_property, + Sget_display_property, 2, 4, 0, + doc: /* Get the `display' property PROP at POSITION. +If OBJECT, this should be a buffer or string where the property is +fetched from. This defaults to the current buffer. + +If PROPERTIES, use those properties instead of the properties at +POSITION. */) + (Lisp_Object position, Lisp_Object prop, Lisp_Object object, + Lisp_Object properties) +{ + if (NILP (properties)) + properties = Fget_text_property (position, Qdisplay, object); + else + CHECK_LIST (properties); + + return find_display_property (properties, prop); +} + /*********************************************************************** @@ -5187,16 +5333,22 @@ handle_display_prop (struct it *it) if (!it->string_from_display_prop_p) it->area = TEXT_AREA; + if (!STRINGP (it->string)) + object = it->w->contents; + propval = get_char_property_and_overlay (make_fixnum (position->charpos), Qdisplay, object, &overlay); + + /* Handle min-width ends. */ + if (! NILP (it->min_width_property) + && NILP (find_display_property (propval, Qmin_width))) + display_min_width (it, bufpos, object, Qnil); + if (NILP (propval)) return HANDLED_NORMALLY; /* Now OVERLAY is the overlay that gave us this property, or nil if it was a text property. */ - if (!STRINGP (it->string)) - object = it->w->contents; - display_replaced = handle_display_spec (it, propval, object, overlay, position, bufpos, FRAME_WINDOW_P (it->f)); @@ -5250,6 +5402,7 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, && !(CONSP (XCAR (spec)) && EQ (XCAR (XCAR (spec)), Qmargin)) && !EQ (XCAR (spec), Qleft_fringe) && !EQ (XCAR (spec), Qright_fringe) + && !EQ (XCAR (spec), Qmin_width) && !NILP (XCAR (spec))) { for (; CONSP (spec); spec = XCDR (spec)) @@ -5483,6 +5636,17 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, return 0; } + /* Handle `(min-width (WIDTH))'. */ + if (CONSP (spec) + && EQ (XCAR (spec), Qmin_width) + && CONSP (XCDR (spec)) + && CONSP (XCAR (XCDR (spec)))) + { + if (it) + display_min_width (it, bufpos, object, XCAR (XCDR (spec))); + return 0; + } + /* Handle `(slice X Y WIDTH HEIGHT)'. */ if (CONSP (spec) && EQ (XCAR (spec), Qslice)) @@ -7186,6 +7350,7 @@ reseat_1 (struct it *it, struct text_pos pos, bool set_stop_p) } /* This make the information stored in it->cmp_it invalidate. */ it->cmp_it.id = -1; + it->min_width_property = Qnil; } @@ -35121,6 +35286,7 @@ be let-bound around code that needs to disable messages temporarily. */); defsubr (&Smove_point_visually); defsubr (&Sbidi_find_overridden_directionality); defsubr (&Sdisplay__line_is_continued_p); + defsubr (&Sget_display_property); DEFSYM (Qmenu_bar_update_hook, "menu-bar-update-hook"); DEFSYM (Qoverriding_terminal_local_map, "overriding-terminal-local-map"); diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index cc67aef8e15..ae4aacd9c7c 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -154,4 +154,20 @@ int main () { nil) 138)))) +(ert-deftest test-get-display-property () + (with-temp-buffer + (insert (propertize "foo" 'face 'bold 'display '(height 2.0))) + (should (equal (get-display-property 2 'height) 2.0))) + (with-temp-buffer + (insert (propertize "foo" 'face 'bold 'display '((height 2.0) + (space-width 2.0)))) + (should (equal (get-display-property 2 'height) 2.0)) + (should (equal (get-display-property 2 'space-width) 2.0))) + (with-temp-buffer + (insert (propertize "foo bar" 'face 'bold + 'display '[(height 2.0) + (space-width 20)])) + (should (equal (get-display-property 2 'height) 2.0)) + (should (equal (get-display-property 2 'space-width) 20)))) + ;;; xdisp-tests.el ends here From 3a8e4f13fa43b3636b584f48cddf92de5dc64e4d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 11:03:58 +0000 Subject: [PATCH 261/367] Remove unused arguments to EmacsView.AfterResize * src/haiku_support.cc (EmacsView.AfterResize): Remove unused arguments. (BView_resize_to): Stop passing unused arguments. --- src/haiku_support.cc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 5f9fe7e234f..8768635069d 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -979,7 +979,7 @@ class EmacsView : public BView } void - AfterResize (float newWidth, float newHeight) + AfterResize (void) { if (offscreen_draw_view) { @@ -1657,7 +1657,7 @@ BView_resize_to (void *view, int width, int height) if (!vw->LockLooper ()) gui_abort ("Failed to lock view for resize"); vw->ResizeTo (width, height); - vw->AfterResize (width, height); + vw->AfterResize (); vw->UnlockLooper (); } From d30cdbbde40e0084c748c11e8f71a449021452c0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 11:15:06 +0000 Subject: [PATCH 262/367] Correct adjustments to frame widths in events * src/haiku_support.cc (EmacsWindow.FrameResized) (EmacsWindow.Zoom): Adjust widths to fit into the correct coordinate system. --- src/haiku_support.cc | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 8768635069d..d6d7967524c 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -664,8 +664,8 @@ class EmacsWindow : public BDirectWindow { struct haiku_resize_event rq; rq.window = this; - rq.px_heightf = newHeight; - rq.px_widthf = newWidth; + rq.px_heightf = newHeight + 1.0f; + rq.px_widthf = newWidth + 1.0f; haiku_write (FRAME_RESIZED, &rq); BDirectWindow::FrameResized (newWidth, newHeight); @@ -755,8 +755,8 @@ class EmacsWindow : public BDirectWindow rq.x = o.x; rq.y = o.y; - rq.width = w; - rq.height = h; + rq.width = w + 1; + rq.height = h + 1; if (fullscreen_p) MakeFullscreen (0); From fdafaf5e416e3a38660aedfb02dc5efd0bbd8f17 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 12:44:45 +0100 Subject: [PATCH 263/367] Fix min-width end condition handling * src/xdisp.c (handle_display_prop): Fix check for min-width ends -- they may be consecutive. --- src/xdisp.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 4d3b4878058..e8de0634a16 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5340,8 +5340,7 @@ handle_display_prop (struct it *it) Qdisplay, object, &overlay); /* Handle min-width ends. */ - if (! NILP (it->min_width_property) - && NILP (find_display_property (propval, Qmin_width))) + if (!NILP (it->min_width_property)) display_min_width (it, bufpos, object, Qnil); if (NILP (propval)) From 7878c7f596d69efb68501503da391ed645ae151e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 24 Nov 2021 13:43:32 +0100 Subject: [PATCH 264/367] * admin/notes/emba (Emacs jobset): Remove stage slow. * test/infra/Makefile.in (subdir_template): Add rule. * test/infra/gitlab-ci.yml (.job-template): Remove changes section. (.build-template, .gnustep-template, .filenotify-gio-template): (.native-comp-template): Adapt changes section. (.test-template): Add needs. Adapt artifacts paths. (stages): Remove slow. (test-all-inotify): Move up. Change stage to normal. Remove timeout. (test-filenotify-gio, test-gnustep, test-native-comp-speed0): Move needs up. * test/infra/test-jobs.yml: Regenerate. --- admin/notes/emba | 2 +- test/infra/Makefile.in | 2 + test/infra/gitlab-ci.yml | 100 ++++++++++++--------------------------- test/infra/test-jobs.yml | 64 +++++++++++++++++++++++++ 4 files changed, 98 insertions(+), 70 deletions(-) diff --git a/admin/notes/emba b/admin/notes/emba index a30e570fd47..f1b52b2cde0 100644 --- a/admin/notes/emba +++ b/admin/notes/emba @@ -35,7 +35,7 @@ The Emacs jobset is defined in the Emacs source tree, file A jobset on Gitlab is called pipeline. Emacs pipelines run through the stages 'build-images', 'platform-images' and 'native-comp-images' (create an Emacs instance by 'make bootstrap' with different -configuration parameters) as well as 'normal', 'slow', 'platforms' and +configuration parameters) as well as 'normal', 'platforms' and 'native-comp' (run respective test jobs based on the produced images). The jobs for stage 'normal' are contained in the file diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index c6b9b39e8c3..ae5a9fe50b6 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -72,6 +72,8 @@ define subdir_template @echo ' stage: normal' >>$(FILE) @echo ' extends: [.job-template, .test-template]' >>$(FILE) @echo ' rules:' >>$(FILE) + @echo ' - if: $CI_PIPELINE_SOURCE == "schedule"' >>$(FILE) + @echo ' when: never' >>$(FILE) @echo ' - changes:' >>$(FILE) $(changes) @echo ' - test/$(1)/*.el' >>$(FILE) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 47a8b519648..588ca04f3b9 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -71,32 +71,6 @@ default: .job-template: variables: test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA} - rules: - - changes: - - "**Makefile.in" - - .gitlab-ci.yml - - aclocal.m4 - - autogen.sh - - configure.ac - - lib/*.{h,c} - - lisp/**.el - - src/*.{h,c} - - test/infra/* - - test/lib-src/*.el - - test/lisp/**.el - - test/misc/*.el - - test/src/*.el - - changes: - # gfilemonitor, kqueue - - src/gfilenotify.c - - src/kqueue.c - # MS Windows - - "**w32*" - # GNUstep - - lisp/term/ns-win.el - - src/ns*.{h,m} - - src/macfont.{h,m} - when: never # These will be cached across builds. cache: key: ${CI_COMMIT_SHA} @@ -127,15 +101,17 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' when: always - changes: - - "**Makefile.in" - - .gitlab-ci.yml + - "**.in" + - "**.yml" + - GNUmakefile - aclocal.m4 - autogen.sh - configure.ac - lib/*.{h,c} + - lib/malloc/*.{h,c} - lisp/emacs-lisp/*.el - src/*.{h,c} - - test/infra/* + - test/infra/Dockerfile.emba - changes: # gfilemonitor, kqueue - src/gfilenotify.c @@ -152,6 +128,7 @@ default: - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} .test-template: + needs: [] # Do not run fast and normal test jobs when scheduled. rules: - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' @@ -162,9 +139,7 @@ default: public: true expire_in: 1 week paths: - - ${test_name}/**/*.log - - ${test_name}/**/core - - ${test_name}/core + - "**.log" when: always .gnustep-template: @@ -172,27 +147,26 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**Makefile.in" - - .gitlab-ci.yml - - configure.ac + - "**.in" + - "**.yml" - src/ns*.{h,m} - src/macfont.{h,m} - lisp/term/ns-win.el - nextstep/** - - test/infra/* + - test/infra/Dockerfile.emba .filenotify-gio-template: rules: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**Makefile.in" - - .gitlab-ci.yml + - "**.in" + - "**.yml" - lisp/autorevert.el - lisp/filenotify.el - lisp/net/tramp-sh.el - src/gfilenotify.c - - test/infra/* + - test/infra/Dockerfile.emba - test/lisp/autorevert-tests.el - test/lisp/filenotify-tests.el @@ -201,25 +175,23 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**Makefile.in" - - .gitlab-ci.yml + - "**.in" + - "**.yml" - lisp/emacs-lisp/comp.el - lisp/emacs-lisp/comp-cstr.el - src/comp.{h,m} - - test/infra/* + - test/infra/Dockerfile.emba - test/src/comp-resources/*.el - test/src/comp-tests.el timeout: 8 hours stages: - build-images -# - fast - normal - platform-images - platforms - native-comp-images - native-comp - - slow build-image-inotify: stage: build-images @@ -227,15 +199,20 @@ build-image-inotify: variables: target: emacs-inotify -# test-fast-inotify: -# stage: fast -# extends: [.job-template, .test-template] -# variables: -# target: emacs-inotify -# make_params: "-C test check" - include: '/test/infra/test-jobs.yml' +test-all-inotify: + # This tests also file monitor libraries inotify and inotifywatch. + stage: normal + extends: [.job-template, .test-template] + rules: + # Note there's no "changes" section, so this always runs on a schedule. + - if: '$CI_PIPELINE_SOURCE == "web"' + - if: '$CI_PIPELINE_SOURCE == "schedule"' + variables: + target: emacs-inotify + make_params: check-expensive + build-image-filenotify-gio: stage: platform-images extends: [.job-template, .build-template, .filenotify-gio-template] @@ -245,8 +222,8 @@ build-image-filenotify-gio: test-filenotify-gio: # This tests file monitor libraries gfilemonitor and gio. stage: platforms - needs: [build-image-filenotify-gio] extends: [.job-template, .test-template, .filenotify-gio-template] + needs: [build-image-filenotify-gio] variables: target: emacs-filenotify-gio make_params: "-k -C test autorevert-tests.log filenotify-tests.log" @@ -260,8 +237,8 @@ build-image-gnustep: test-gnustep: # This tests the GNUstep build process. stage: platforms - needs: [build-image-gnustep] extends: [.job-template, .gnustep-template] + needs: [build-image-gnustep] variables: target: emacs-gnustep make_params: install @@ -286,27 +263,12 @@ build-native-comp-speed2: test-native-comp-speed0: stage: native-comp - needs: [build-native-comp-speed0] extends: [.job-template, .test-template, .native-comp-template] + needs: [build-native-comp-speed0] variables: target: emacs-native-comp-speed0 make_params: "-C test check SELECTOR='(not (tag :unstable))'" -test-all-inotify: - # This tests also file monitor libraries inotify and inotifywatch. - stage: slow - needs: [build-image-inotify] - extends: [.job-template, .test-template] - rules: - # Note there's no "changes" section, so this always runs on a schedule. - - if: '$CI_PIPELINE_SOURCE == "web"' - - if: '$CI_PIPELINE_SOURCE == "schedule"' - variables: - target: emacs-inotify - make_params: check-expensive - # Two hours. - EMACS_TEST_TIMEOUT: 7200 - # Local Variables: # add-log-current-defun-header-regexp: "^\\([-_.[:alnum:]]+\\)[ \t]*:" # End: diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 413dfeba33a..93a409723d4 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -3,6 +3,8 @@ test-lib-src-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lib-src/*.{h,c} - test/lib-src/*.el @@ -22,6 +24,8 @@ test-lisp-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/*.el - test/lisp/*.el @@ -41,6 +45,8 @@ test-lisp-calc-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/calc/*.el - test/lisp/calc/*.el @@ -60,6 +66,8 @@ test-lisp-calendar-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/calendar/*.el - test/lisp/calendar/*.el @@ -79,6 +87,8 @@ test-lisp-cedet-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/cedet/*.el - test/lisp/cedet/*.el @@ -98,6 +108,8 @@ test-lisp-cedet-semantic-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/cedet/semantic/*.el - test/lisp/cedet/semantic/*.el @@ -117,6 +129,8 @@ test-lisp-cedet-semantic-bovine-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/cedet/semantic/bovine/*.el - test/lisp/cedet/semantic/bovine/*.el @@ -136,6 +150,8 @@ test-lisp-cedet-srecode-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/cedet/srecode/*.el - test/lisp/cedet/srecode/*.el @@ -155,6 +171,8 @@ test-lisp-emacs-lisp-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/emacs-lisp/*.el - test/lisp/emacs-lisp/*.el @@ -174,6 +192,8 @@ test-lisp-emacs-lisp-eieio-tests-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/emacs-lisp/eieio*.el - test/lisp/emacs-lisp/eieio-tests/*.el @@ -193,6 +213,8 @@ test-lisp-emacs-lisp-faceup-tests-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/emacs-lisp/faceup*.el - test/lisp/emacs-lisp/faceup-tests/*.el @@ -212,6 +234,8 @@ test-lisp-emulation-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/emulation/*.el - test/lisp/emulation/*.el @@ -231,6 +255,8 @@ test-lisp-erc-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/erc/*.el - test/lisp/erc/*.el @@ -250,6 +276,8 @@ test-lisp-eshell-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/eshell/*.el - test/lisp/eshell/*.el @@ -269,6 +297,8 @@ test-lisp-gnus-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/gnus/*.el - test/lisp/gnus/*.el @@ -288,6 +318,8 @@ test-lisp-image-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/image/*.el - test/lisp/image/*.el @@ -307,6 +339,8 @@ test-lisp-international-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/international/*.el - test/lisp/international/*.el @@ -326,6 +360,8 @@ test-lisp-mail-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/mail/*.el - test/lisp/mail/*.el @@ -345,6 +381,8 @@ test-lisp-mh-e-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/mh-e/*.el - test/lisp/mh-e/*.el @@ -364,6 +402,8 @@ test-lisp-net-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/net/*.el - test/lisp/net/*.el @@ -383,6 +423,8 @@ test-lisp-nxml-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/nxml/*.el - test/lisp/nxml/*.el @@ -402,6 +444,8 @@ test-lisp-obsolete-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/obsolete/*.el - test/lisp/obsolete/*.el @@ -421,6 +465,8 @@ test-lisp-org-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/org/*.el - test/lisp/org/*.el @@ -440,6 +486,8 @@ test-lisp-play-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/play/*.el - test/lisp/play/*.el @@ -459,6 +507,8 @@ test-lisp-progmodes-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/progmodes/*.el - test/lisp/progmodes/*.el @@ -478,6 +528,8 @@ test-lisp-so-long-tests-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/so-long*.el - test/lisp/so-long-tests/*.el @@ -497,6 +549,8 @@ test-lisp-term-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/term/*.el - test/lisp/term/*.el @@ -516,6 +570,8 @@ test-lisp-textmodes-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/textmodes/*.el - test/lisp/textmodes/*.el @@ -535,6 +591,8 @@ test-lisp-url-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/url/*.el - test/lisp/url/*.el @@ -554,6 +612,8 @@ test-lisp-vc-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - lisp/vc/*.el - test/lisp/vc/*.el @@ -573,6 +633,8 @@ test-misc-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - admin/*.el - test/misc/*.el @@ -592,6 +654,8 @@ test-src-inotify: stage: normal extends: [.job-template, .test-template] rules: + - if: I_PIPELINE_SOURCE == "schedule" + when: never - changes: - src/*.{h,c} - test/src/*.el From fc35928ec2b3be40ff7323515f948fc82ca487ca Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 24 Nov 2021 12:48:01 +0000 Subject: [PATCH 265/367] Make `yank-media' work on Haiku This works with what WebPositive does with images, at least. I don't know about other programs, but Haiku doesn't seem to standardize this very well. * lisp/term/haiku-win.el (haiku--selection-type-to-mime): Handle regular symbols. (gui-backend-get-selection): Handle special type `TARGETS'. (gui-backend-set-selection): Always clear clipboard. * src/haiku_select.cc (BClipboard_get_targets): New function. (BClipboard_set_data): New argument `clear'. All callers changed. (BClipboard_set_system_data) (BClipboard_set_primary_selection_data) (BClipboard_set_secondary_selection_data): New argument `clear'. (BClipboard_system_targets, BClipboard_primary_targets) (BClipboard_secondary_targets): New functions. * src/haikuselect.c (haiku_selection_data_1): New function. (Fhaiku_selection_targets): New function. (Fhaiku_selection_put): Allow controlling if the clipboard is cleared. (syms_of_haikuselect): New symbols and subrs. * src/haikuselect.h (BClipboard_set_system_data) (BClipboard_set_primary_selection_data) (BClipboard_set_secondary_selection_data): New argument `clear'. (BClipboard_system_targets, BClipboard_primary_targets) (BClipboard_secondary_targets): New functions. --- lisp/term/haiku-win.el | 8 +++- src/haiku_select.cc | 92 +++++++++++++++++++++++++++++++++++++----- src/haikuselect.c | 60 +++++++++++++++++++++++---- src/haikuselect.h | 16 ++++++-- 4 files changed, 155 insertions(+), 21 deletions(-) diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 36af10d2c70..7861cfb9003 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -86,15 +86,19 @@ If TYPE is nil, return \"text/plain\"." (cond ((memq type '(TEXT COMPOUND_TEXT STRING UTF8_STRING)) "text/plain") ((stringp type) type) + ((symbolp type) (symbol-name type)) (t "text/plain"))) (cl-defmethod gui-backend-get-selection (type data-type &context (window-system haiku)) - (haiku-selection-data type (haiku--selection-type-to-mime data-type))) + (if (eq data-type 'TARGETS) + (apply #'vector (mapcar #'intern + (haiku-selection-targets type))) + (haiku-selection-data type (haiku--selection-type-to-mime data-type)))) (cl-defmethod gui-backend-set-selection (type value &context (window-system haiku)) - (haiku-selection-put type "text/plain" value)) + (haiku-selection-put type "text/plain" value t)) (cl-defmethod gui-backend-selection-exists-p (selection &context (window-system haiku)) diff --git a/src/haiku_select.cc b/src/haiku_select.cc index 8d345ca6617..6cd6ee879e5 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -63,13 +63,63 @@ BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) return strndup (ptr, bt); } +static void +BClipboard_get_targets (BClipboard *cb, char **buf, int buf_size) +{ + BMessage *data; + char *name; + int32 count_found; + type_code type; + int32 i; + int index; + + if (!cb->Lock ()) + { + buf[0] = NULL; + return; + } + + data = cb->Data (); + index = 0; + + if (!data) + { + buf[0] = NULL; + cb->Unlock (); + return; + } + + for (i = 0; (data->GetInfo (B_ANY_TYPE, i, &name, + &type, &count_found) + == B_OK); ++i) + { + if (type == B_MIME_TYPE) + { + if (index < (buf_size - 1)) + { + buf[index++] = strdup (name); + + if (!buf[index - 1]) + break; + } + } + } + + buf[index] = NULL; + + cb->Unlock (); +} + static void BClipboard_set_data (BClipboard *cb, const char *type, const char *dat, - ssize_t len) + ssize_t len, bool clear) { if (!cb->Lock ()) return; - cb->Clear (); + + if (clear) + cb->Clear (); + BMessage *mdat = cb->Data (); if (!mdat) { @@ -78,7 +128,13 @@ BClipboard_set_data (BClipboard *cb, const char *type, const char *dat, } if (dat) - mdat->AddData (type, B_MIME_TYPE, dat, len); + { + if (mdat->ReplaceData (type, B_MIME_TYPE, dat, len) + == B_NAME_NOT_FOUND) + mdat->AddData (type, B_MIME_TYPE, dat, len); + } + else + mdat->RemoveName (type); cb->Commit (); cb->Unlock (); } @@ -112,32 +168,32 @@ BClipboard_find_secondary_selection_data (const char *type, ssize_t *len) void BClipboard_set_system_data (const char *type, const char *data, - ssize_t len) + ssize_t len, bool clear) { if (!system_clipboard) return; - BClipboard_set_data (system_clipboard, type, data, len); + BClipboard_set_data (system_clipboard, type, data, len, clear); } void BClipboard_set_primary_selection_data (const char *type, const char *data, - ssize_t len) + ssize_t len, bool clear) { if (!primary) return; - BClipboard_set_data (primary, type, data, len); + BClipboard_set_data (primary, type, data, len, clear); } void BClipboard_set_secondary_selection_data (const char *type, const char *data, - ssize_t len) + ssize_t len, bool clear) { if (!secondary) return; - BClipboard_set_data (secondary, type, data, len); + BClipboard_set_data (secondary, type, data, len, clear); } void @@ -146,6 +202,24 @@ BClipboard_free_data (void *ptr) std::free (ptr); } +void +BClipboard_system_targets (char **buf, int len) +{ + BClipboard_get_targets (system_clipboard, buf, len); +} + +void +BClipboard_primary_targets (char **buf, int len) +{ + BClipboard_get_targets (primary, buf, len); +} + +void +BClipboard_secondary_targets (char **buf, int len) +{ + BClipboard_get_targets (secondary, buf, len); +} + void init_haiku_select (void) { diff --git a/src/haikuselect.c b/src/haikuselect.c index 3f0441e0779..38cceb1de74 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -24,6 +24,46 @@ along with GNU Emacs. If not, see . */ #include "haikuselect.h" #include "haikuterm.h" +static Lisp_Object +haiku_selection_data_1 (Lisp_Object clipboard) +{ + Lisp_Object result = Qnil; + char *targets[256]; + + block_input (); + if (EQ (clipboard, QPRIMARY)) + BClipboard_primary_targets ((char **) &targets, 256); + else if (EQ (clipboard, QSECONDARY)) + BClipboard_secondary_targets ((char **) &targets, 256); + else if (EQ (clipboard, QCLIPBOARD)) + BClipboard_system_targets ((char **) &targets, 256); + else + { + unblock_input (); + signal_error ("Bad clipboard", clipboard); + } + + for (int i = 0; targets[i]; ++i) + { + result = Fcons (build_unibyte_string (targets[i]), + result); + free (targets[i]); + } + unblock_input (); + + return result; +} + +DEFUN ("haiku-selection-targets", Fhaiku_selection_targets, + Shaiku_selection_targets, 1, 1, 0, + doc: /* Find the types of data available from CLIPBOARD. +CLIPBOARD should be the symbol `PRIMARY', `SECONDARY' or `CLIPBOARD'. +Return the available types as a list of strings. */) + (Lisp_Object clipboard) +{ + return haiku_selection_data_1 (clipboard); +} + DEFUN ("haiku-selection-data", Fhaiku_selection_data, Shaiku_selection_data, 2, 2, 0, doc: /* Retrieve content typed as NAME from the clipboard @@ -78,15 +118,17 @@ fetch. */) } DEFUN ("haiku-selection-put", Fhaiku_selection_put, Shaiku_selection_put, - 3, 3, 0, + 3, 4, 0, doc: /* Add or remove content from the clipboard CLIPBOARD. CLIPBOARD is the symbol `PRIMARY', `SECONDARY' or `CLIPBOARD'. NAME is a MIME type denoting the type of the data to add. DATA is the string that will be placed in the clipboard, or nil if the content is -to be removed. If NAME is the string `text/utf-8' or the string -`text/plain', encode it as UTF-8 before storing it into the +to be removed. If NAME is the string "text/utf-8" or the string +"text/plain", encode it as UTF-8 before storing it into the clipboard. +CLEAR, if non-nil, means to erase all the previous contents of the clipboard. */) - (Lisp_Object clipboard, Lisp_Object name, Lisp_Object data) + (Lisp_Object clipboard, Lisp_Object name, Lisp_Object data, + Lisp_Object clear) { CHECK_SYMBOL (clipboard); CHECK_STRING (name); @@ -105,11 +147,13 @@ clipboard. */) ptrdiff_t len = !NILP (data) ? SBYTES (data) : 0; if (EQ (clipboard, QPRIMARY)) - BClipboard_set_primary_selection_data (SSDATA (name), dat, len); + BClipboard_set_primary_selection_data (SSDATA (name), dat, len, + !NILP (clear)); else if (EQ (clipboard, QSECONDARY)) - BClipboard_set_secondary_selection_data (SSDATA (name), dat, len); + BClipboard_set_secondary_selection_data (SSDATA (name), dat, len, + !NILP (clear)); else if (EQ (clipboard, QCLIPBOARD)) - BClipboard_set_system_data (SSDATA (name), dat, len); + BClipboard_set_system_data (SSDATA (name), dat, len, !NILP (clear)); else { unblock_input (); @@ -128,7 +172,9 @@ syms_of_haikuselect (void) DEFSYM (QSTRING, "STRING"); DEFSYM (QUTF8_STRING, "UTF8_STRING"); DEFSYM (Qforeign_selection, "foreign-selection"); + DEFSYM (QTARGETS, "TARGETS"); defsubr (&Shaiku_selection_data); defsubr (&Shaiku_selection_put); + defsubr (&Shaiku_selection_targets); } diff --git a/src/haikuselect.h b/src/haikuselect.h index 542d550d64e..1a3a945f98d 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -46,15 +46,25 @@ extern "C" BClipboard_find_secondary_selection_data (const char *type, ssize_t *len); extern void - BClipboard_set_system_data (const char *type, const char *data, ssize_t len); + BClipboard_set_system_data (const char *type, const char *data, ssize_t len, + bool clear); extern void BClipboard_set_primary_selection_data (const char *type, const char *data, - ssize_t len); + ssize_t len, bool clear); extern void BClipboard_set_secondary_selection_data (const char *type, const char *data, - ssize_t len); + ssize_t len, bool clear); + + extern void + BClipboard_system_targets (char **buf, int len); + + extern void + BClipboard_primary_targets (char **buf, int len); + + extern void + BClipboard_secondary_targets (char **buf, int len); /* Free the returned data. */ extern void BClipboard_free_data (void *ptr); From 9fe409f958cc9d4ca43532dfd2343826677f5bae Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Mon, 22 Nov 2021 17:42:03 +0100 Subject: [PATCH 266/367] * admin/unidata/emoji-zwj.awk: Quote functions properly. --- admin/unidata/emoji-zwj.awk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/admin/unidata/emoji-zwj.awk b/admin/unidata/emoji-zwj.awk index d4e2944ca34..e704cb45263 100644 --- a/admin/unidata/emoji-zwj.awk +++ b/admin/unidata/emoji-zwj.awk @@ -114,7 +114,7 @@ END { print " (nconc (char-table-range composition-function-table (car elt))" print " (list (vector (cdr elt)" print " 0" - print " 'compose-gstring-for-graphic)))))" + print " #'compose-gstring-for-graphic)))))" print ";; The following two blocks are derived by hand from emoji-sequences.txt" print ";; FIXME: add support for Emoji_Keycap_Sequence once we learn how to respect FE0F/VS-16" @@ -126,7 +126,7 @@ END { print " (nconc (char-table-range composition-function-table '(#x1F1E6 . #x1F1FF))" print " (list (vector \"[\\U0001F1E6-\\U0001F1FF][\\U0001F1E6-\\U0001F1FF]\"" print " 0" - print " 'compose-gstring-for-graphic))))" + print " #'compose-gstring-for-graphic))))" print ";; UK Flags" print "(set-char-table-range composition-function-table" @@ -134,7 +134,7 @@ END { print " (nconc (char-table-range composition-function-table #x1F3F4)" print " (list (vector \"\\U0001F3F4\\U000E0067\\U000E0062\\\\(?:\\U000E0065\\U000E006E\\U000E0067\\\\|\\U000E0073\\U000E0063\\U000E0074\\\\|\\U000E0077\\U000E006C\\U000E0073\\\\)\\U000E007F\"" print " 0" - print " 'compose-gstring-for-graphic))))" + print " #'compose-gstring-for-graphic))))" printf "\n(provide 'emoji-zwj)" } From 5b2ba7da4f03100dd5b889104b5256f7b8ac7927 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 24 Nov 2021 14:47:55 +0100 Subject: [PATCH 267/367] ; Fix syntax error in generated test/infra/test-jobs.yml --- test/infra/Makefile.in | 3 +- test/infra/test-jobs.yml | 64 ++++++++++++++++++++-------------------- 2 files changed, 34 insertions(+), 33 deletions(-) diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index ae5a9fe50b6..e55a6edaff2 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -34,6 +34,7 @@ SUBDIRS ?= $(shell make -s -C .. subdirs) SUBDIR_TARGETS = FILE = test-jobs.yml tn = $$$${test_name} +cps = $$$$CI_PIPELINE_SOURCE define subdir_template $(eval target = check-$(subst /,-,$(1))) @@ -72,7 +73,7 @@ define subdir_template @echo ' stage: normal' >>$(FILE) @echo ' extends: [.job-template, .test-template]' >>$(FILE) @echo ' rules:' >>$(FILE) - @echo ' - if: $CI_PIPELINE_SOURCE == "schedule"' >>$(FILE) + @echo " - if: '"'${cps} == "schedule"'"'" >>$(FILE) @echo ' when: never' >>$(FILE) @echo ' - changes:' >>$(FILE) $(changes) diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 93a409723d4..7af671d641b 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -3,7 +3,7 @@ test-lib-src-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lib-src/*.{h,c} @@ -24,7 +24,7 @@ test-lisp-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/*.el @@ -45,7 +45,7 @@ test-lisp-calc-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/calc/*.el @@ -66,7 +66,7 @@ test-lisp-calendar-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/calendar/*.el @@ -87,7 +87,7 @@ test-lisp-cedet-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/cedet/*.el @@ -108,7 +108,7 @@ test-lisp-cedet-semantic-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/cedet/semantic/*.el @@ -129,7 +129,7 @@ test-lisp-cedet-semantic-bovine-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/cedet/semantic/bovine/*.el @@ -150,7 +150,7 @@ test-lisp-cedet-srecode-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/cedet/srecode/*.el @@ -171,7 +171,7 @@ test-lisp-emacs-lisp-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/emacs-lisp/*.el @@ -192,7 +192,7 @@ test-lisp-emacs-lisp-eieio-tests-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/emacs-lisp/eieio*.el @@ -213,7 +213,7 @@ test-lisp-emacs-lisp-faceup-tests-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/emacs-lisp/faceup*.el @@ -234,7 +234,7 @@ test-lisp-emulation-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/emulation/*.el @@ -255,7 +255,7 @@ test-lisp-erc-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/erc/*.el @@ -276,7 +276,7 @@ test-lisp-eshell-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/eshell/*.el @@ -297,7 +297,7 @@ test-lisp-gnus-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/gnus/*.el @@ -318,7 +318,7 @@ test-lisp-image-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/image/*.el @@ -339,7 +339,7 @@ test-lisp-international-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/international/*.el @@ -360,7 +360,7 @@ test-lisp-mail-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/mail/*.el @@ -381,7 +381,7 @@ test-lisp-mh-e-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/mh-e/*.el @@ -402,7 +402,7 @@ test-lisp-net-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/net/*.el @@ -423,7 +423,7 @@ test-lisp-nxml-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/nxml/*.el @@ -444,7 +444,7 @@ test-lisp-obsolete-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/obsolete/*.el @@ -465,7 +465,7 @@ test-lisp-org-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/org/*.el @@ -486,7 +486,7 @@ test-lisp-play-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/play/*.el @@ -507,7 +507,7 @@ test-lisp-progmodes-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/progmodes/*.el @@ -528,7 +528,7 @@ test-lisp-so-long-tests-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/so-long*.el @@ -549,7 +549,7 @@ test-lisp-term-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/term/*.el @@ -570,7 +570,7 @@ test-lisp-textmodes-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/textmodes/*.el @@ -591,7 +591,7 @@ test-lisp-url-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/url/*.el @@ -612,7 +612,7 @@ test-lisp-vc-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - lisp/vc/*.el @@ -633,7 +633,7 @@ test-misc-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - admin/*.el @@ -654,7 +654,7 @@ test-src-inotify: stage: normal extends: [.job-template, .test-template] rules: - - if: I_PIPELINE_SOURCE == "schedule" + - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never - changes: - src/*.{h,c} From 4bfa73f9207b47d0a6a0641bbdd39963242fa2c7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 14:43:37 +0100 Subject: [PATCH 268/367] Make display_min_width work from the mode line * src/xdisp.c (display_min_width): Make this work from mode line constructs via display_string. --- src/xdisp.c | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index e8de0634a16..cda7e04522c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5214,11 +5214,18 @@ display_min_width (struct it *it, ptrdiff_t bufpos, if (!it->glyph_row) return; - /* Check that we're really right after the sequence of - characters covered by this `min-width'. */ - if (bufpos > BEGV - && EQ (it->min_width_property, - get_display_property (bufpos - 1, Qmin_width, object))) + /* When called form display_string (i.e., the mode line), + we're being called with a string as the object, and we + may be called with many sub-strings belonging to the same + :propertize run. */ + if ((bufpos == 0 + && !EQ (it->min_width_property, + get_display_property (0, Qmin_width, object))) + /* In a buffer -- check that we're really right after the + sequence of characters covered by this `min-width'. */ + || (bufpos > BEGV + && EQ (it->min_width_property, + get_display_property (bufpos - 1, Qmin_width, object)))) { Lisp_Object w = Qnil; double width; @@ -5258,6 +5265,11 @@ display_min_width (struct it *it, ptrdiff_t bufpos, if (CONSP (width_spec)) { if (bufpos == BEGV + /* Mode line (see above). */ + || (bufpos == 0 + && !EQ (it->min_width_property, + get_display_property (0, Qmin_width, object))) + /* Buffer. */ || (bufpos > BEGV && !EQ (width_spec, get_display_property (bufpos - 1, Qmin_width, object)))) From 84bf9549860aae22931951d52b194b1fcfca1556 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 14:48:13 +0100 Subject: [PATCH 269/367] Use a proportional font for the mode line * lisp/bindings.el (mode-line-position): Add min-width specs. (standard-mode-line-format): Ditto. * lisp/faces.el (mode-line): Inherit from `variable-pitch'. --- etc/NEWS | 4 ++++ lisp/bindings.el | 18 ++++++++++++++---- lisp/faces.el | 4 +++- 3 files changed, 21 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 1cd49c5289c..17568976cb8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -75,6 +75,10 @@ time. * Changes in Emacs 29.1 +--- +** The mode line now uses a proportional font by default. +To get the old monospaced mode line back, customize the 'mode-line' face. + +++ ** New function 'buffer-text-pixel-size'. This is similar to 'window-text-pixel-size', but can be used when the diff --git a/lisp/bindings.el b/lisp/bindings.el index 121e484a0ee..a4458ccd1e4 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -503,6 +503,7 @@ mouse-1: Display Line and Column Mode Menu")) `((:propertize mode-line-percent-position local-map ,mode-line-column-line-number-mode-map + display (min-width (5.0)) mouse-face mode-line-highlight ;; XXX needs better description help-echo "Window Scroll Percentage @@ -521,26 +522,31 @@ mouse-1: Display Line and Column Mode Menu"))) (10 (:propertize mode-line-position-column-line-format + display (min-width (10.0)) ,@mode-line-position--column-line-properties)) (10 (:propertize (:eval (string-replace "%c" "%C" (car mode-line-position-column-line-format))) + display (min-width (10.0)) ,@mode-line-position--column-line-properties))) (6 (:propertize mode-line-position-line-format + display (min-width (6.0)) ,@mode-line-position--column-line-properties)))) (column-number-mode (column-number-indicator-zero-based (6 (:propertize mode-line-position-column-format + display (min-width (6.0)) (,@mode-line-position--column-line-properties))) (6 (:propertize (:eval (string-replace "%c" "%C" (car mode-line-position-column-format))) + display (min-width (6.0)) ,@mode-line-position--column-line-properties)))))) "Mode line construct for displaying the position in the buffer. Normally displays the buffer percentage and, optionally, the @@ -597,10 +603,14 @@ By default, this shows the information specified by `global-mode-string'.") (let ((standard-mode-line-format (list "%e" 'mode-line-front-space - 'mode-line-mule-info - 'mode-line-client - 'mode-line-modified - 'mode-line-remote + (list + :propertize + (list "" + 'mode-line-mule-info + 'mode-line-client + 'mode-line-modified + 'mode-line-remote) + 'display '(min-width (4.0))) 'mode-line-frame-identification 'mode-line-buffer-identification " " diff --git a/lisp/faces.el b/lisp/faces.el index a07f8c652e4..e9f795caad2 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2611,9 +2611,11 @@ non-nil." (defface mode-line '((((class color) (min-colors 88)) :box (:line-width -1 :style released-button) + :inherit 'variable-pitch :background "grey75" :foreground "black") (t - :inverse-video t)) + :inverse-video t + :inherit 'variable-pitch)) "Basic mode line face for selected window." :version "21.1" :group 'mode-line-faces From 1a84b7a3289829d6f404c323f0f673e32234484f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 24 Nov 2021 10:21:49 +0100 Subject: [PATCH 270/367] Tighten `gnu` compile regexp further * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): The -fanalyzer ASCII art does not contain tabs. --- lisp/progmodes/compile.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 2d4070c389c..6e3589df7ad 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -347,9 +347,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; which is used for non-interactive programs other than ;; compilers (e.g. the "jade:" entry in compilation.txt). (? (| (: alpha (+ (in ?. ?- alnum)) ":" (? " ")) - ;; Skip indentation generated by tools like GCC's - ;; -fanalyzer. - (: (+ (in " \t")) "|"))) + ;; Skip indentation generated by GCC's -fanalyzer. + (: (+ " ") "|"))) ;; File name group. (group-n 1 From 6e1b984563c3ea2fdc06ec1ea57c13a6f0114c6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 24 Nov 2021 15:05:07 +0100 Subject: [PATCH 271/367] Add sample of -fanalyzer output (bug#51882) * etc/compilation.txt (file): Add fragment of GCC diagnostics from -fanalyzer (from Philip Kaludercic). --- etc/compilation.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/etc/compilation.txt b/etc/compilation.txt index 01d4df1b09d..34d8c53c9a6 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -310,6 +310,9 @@ G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found. file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found. {standard input}:27041: Warning: end of file not at end of a line; newline inserted boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ] + | + |board.h:60:21: + | 60 | #define I(b, C) ((C).y * (b)->width + (C).x) * Guile backtrace, 2.0.11 From c8e28813af0ece36a78872c67f419cb0a0bbb6b9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 24 Nov 2021 16:19:25 +0200 Subject: [PATCH 272/367] Minor fixes for a recent commit * src/xdisp.c (find_display_property): Fix style of comments. (Fget_display_property): Doc fix. (get_display_property): Fix style and whitespace. --- src/xdisp.c | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index cda7e04522c..59509418790 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5150,7 +5150,7 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) { if (NILP (disp)) return Qnil; - /* We have a vector of display specs. */ + /* We have a vector of display specs. */ if (VECTORP (disp)) { for (ptrdiff_t i = 0; i < ASIZE (disp); i++) @@ -5163,7 +5163,7 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) } return Qnil; } - /* We have a list of display specs. */ + /* We have a list of display specs. */ else if (CONSP (disp) && CONSP (XCAR (disp))) { @@ -5176,7 +5176,7 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) return XCAR (XCDR (elem)); /* Check that we have a proper list before going to the next - element. */ + element. */ if (CONSP (XCDR (disp))) disp = XCDR (disp); else @@ -5184,7 +5184,7 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) } return Qnil; } - /* A simple display spec. */ + /* A simple display spec. */ else if (CONSP (disp) && CONSP (XCDR (disp)) && EQ (XCAR (disp), prop)) @@ -5193,11 +5193,11 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) return Qnil; } -static Lisp_Object get_display_property (ptrdiff_t bufpos, Lisp_Object prop, - Lisp_Object object) +static +Lisp_Object get_display_property (ptrdiff_t bufpos, Lisp_Object prop, + Lisp_Object object) { return find_display_property (Fget_text_property (make_fixnum (bufpos), - Qdisplay, object), prop); } @@ -5282,12 +5282,12 @@ display_min_width (struct it *it, ptrdiff_t bufpos, DEFUN ("get-display-property", Fget_display_property, Sget_display_property, 2, 4, 0, - doc: /* Get the `display' property PROP at POSITION. + doc: /* Get the value of the `display' property PROP at POSITION. If OBJECT, this should be a buffer or string where the property is -fetched from. This defaults to the current buffer. +fetched from. If omitted, OBJECT defaults to the current buffer. -If PROPERTIES, use those properties instead of the properties at -POSITION. */) +If PROPERTIES, look for value of PROP in PROPERTIES instead of the +properties at POSITION. */) (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object properties) { From 7dfa758fef58dbfcd00baaea374260d5d3510b7f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 24 Nov 2021 16:34:25 +0200 Subject: [PATCH 273/367] ; * etc/NEWS: Fix recently added entries. --- etc/NEWS | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 17568976cb8..24b8cb27961 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -77,7 +77,11 @@ time. --- ** The mode line now uses a proportional font by default. -To get the old monospaced mode line back, customize the 'mode-line' face. +To get the old monospaced mode line back, customize the 'mode-line' +face not to inherit from the 'variable-pitch' face, or add this to +your ~/.emacs: + + (set-face-attribute 'mode-line t :inherit nil) +++ ** New function 'buffer-text-pixel-size'. @@ -677,7 +681,7 @@ This is like 'get-text-property', but works on the 'display' text property. ** New 'min-width' 'display' property. -This allows setting a minimum width for a region. +This allows setting a minimum display width for a region of text. ** Keymaps and key definitions From f1fcd321ff40315442cd77084c444585948bea85 Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Wed, 24 Nov 2021 07:27:18 -0800 Subject: [PATCH 274/367] mh-utils-tests: Add new tests of "folders +/" * test/lisp/mh-e/mh-utils-tests.el (mh-sub-folders-actual, mh-sub-folders): Add new tests of "folders +/". Rewrite tests that were using 'assoc' to use 'member' instead, so that on failure, ERT logs the list of which the element was not a member, rather than the 'nil' returned by 'assoc'. (mh-test-variant-handles-plus-slash): Factor out new helper function. (mh-folder-completion-function-08-plus-slash) (mh-folder-completion-function-09-plus-slash-tmp): Use new helper function. * test/lisp/mh-e/test-all-mh-variants.sh: LD_LIBRARY_PATH unnecessary. --- test/lisp/mh-e/mh-utils-tests.el | 47 ++++++++++++++++---------- test/lisp/mh-e/test-all-mh-variants.sh | 6 ++-- 2 files changed, 31 insertions(+), 22 deletions(-) diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index 0066c00b5b2..5f6accc6470 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -307,6 +307,14 @@ if `mh-test-utils-debug-mocks' is non-nil." (message "file-directory-p: %S -> %s" filename result)) result)) +(defun mh-test-variant-handles-plus-slash (variant) + "Returns non-nil if this MH variant handles \"folders +/\". +Mailutils 3.5, 3.7, and 3.13 are known not to." + (cond ((not (stringp variant))) ;our mock handles it + ((string-search "GNU Mailutils" variant) + nil) + (t))) ;no other known failures + (ert-deftest mh-sub-folders-actual () "Test `mh-sub-folders-actual'." @@ -314,14 +322,15 @@ if `mh-test-utils-debug-mocks' is non-nil." ;; already been normalized with ;; (mh-normalize-folder-name folder nil nil t) (with-mh-test-env - (should (equal + (should (member mh-test-rel-folder - (car (assoc mh-test-rel-folder (mh-sub-folders-actual nil))))) + (mapcar (lambda (x) (car x)) (mh-sub-folders-actual nil)))) ;; Empty string and "+" not tested since mh-normalize-folder-name ;; would change them to nil. - (should (equal "foo" - (car (assoc "foo" (mh-sub-folders-actual - (format "+%s" mh-test-rel-folder)))))) + (should (member "foo" + (mapcar (lambda (x) (car x)) + (mh-sub-folders-actual + (format "+%s" mh-test-rel-folder))))) ;; Folder with trailing slash not tested since ;; mh-normalize-folder-name would strip it. (should (equal @@ -332,6 +341,10 @@ if `mh-test-utils-debug-mocks' is non-nil." (list (list "bar") (list "foo") (list "food")) (mh-sub-folders-actual (format "+%s" mh-test-abs-folder)))) + (when (mh-test-variant-handles-plus-slash mh-variant-in-use) + (should (member "tmp" (mapcar (lambda (x) (car x)) + (mh-sub-folders-actual "+/"))))) + ;; FIXME: mh-sub-folders-actual doesn't (yet) expect to be given a ;; nonexistent folder. ;; (should (equal nil @@ -343,13 +356,12 @@ if `mh-test-utils-debug-mocks' is non-nil." (ert-deftest mh-sub-folders () "Test `mh-sub-folders'." (with-mh-test-env - (should (equal mh-test-rel-folder - (car (assoc mh-test-rel-folder (mh-sub-folders nil))))) - (should (equal mh-test-rel-folder - (car (assoc mh-test-rel-folder (mh-sub-folders ""))))) - (should (equal nil - (car (assoc mh-test-no-such-folder (mh-sub-folders - "+"))))) + (should (member mh-test-rel-folder + (mapcar (lambda (x) (car x)) (mh-sub-folders nil)))) + (should (member mh-test-rel-folder + (mapcar (lambda (x) (car x)) (mh-sub-folders "")))) + (should-not (member mh-test-no-such-folder + (mapcar (lambda (x) (car x)) (mh-sub-folders "+")))) (should (equal (list (list "bar") (list "foo") (list "food")) (mh-sub-folders (format "+%s" mh-test-rel-folder)))) (should (equal (list (list "bar") (list "foo") (list "food")) @@ -360,6 +372,9 @@ if `mh-test-utils-debug-mocks' is non-nil." (mh-sub-folders (format "+%s/foo" mh-test-rel-folder)))) (should (equal (list (list "bar") (list "foo") (list "food")) (mh-sub-folders (format "+%s" mh-test-abs-folder)))) + (when (mh-test-variant-handles-plus-slash mh-variant-in-use) + (should (member "tmp" + (mapcar (lambda (x) (car x)) (mh-sub-folders "+/"))))) ;; FIXME: mh-sub-folders doesn't (yet) expect to be given a ;; nonexistent folder. @@ -441,10 +456,8 @@ and the `should' macro requires idempotent evaluation anyway." (ert-deftest mh-folder-completion-function-08-plus-slash () "Test `mh-folder-completion-function' with `+/'." - ;; This test fails with Mailutils 3.5, 3.7, and 3.13. (with-mh-test-env - (skip-unless (not (and (stringp mh-variant-in-use) - (string-search "GNU Mailutils" mh-variant-in-use))))) + (skip-unless (mh-test-variant-handles-plus-slash mh-variant-in-use))) (mh-test-folder-completion-1 "+/" "+/" "tmp/" t) ;; case "bb" (with-mh-test-env @@ -454,10 +467,8 @@ and the `should' macro requires idempotent evaluation anyway." (ert-deftest mh-folder-completion-function-09-plus-slash-tmp () "Test `mh-folder-completion-function' with `+/tmp'." - ;; This test fails with Mailutils 3.5, 3.7, and 3.13. (with-mh-test-env - (skip-unless (not (and (stringp mh-variant-in-use) - (string-search "GNU Mailutils" mh-variant-in-use))))) + (skip-unless (mh-test-variant-handles-plus-slash mh-variant-in-use))) (mh-test-folder-completion-1 "+/tmp" "+/tmp/" "tmp/" t)) (ert-deftest mh-folder-completion-function-10-plus-slash-abs-folder () diff --git a/test/lisp/mh-e/test-all-mh-variants.sh b/test/lisp/mh-e/test-all-mh-variants.sh index e917d8155bc..eaee98fcf4d 100755 --- a/test/lisp/mh-e/test-all-mh-variants.sh +++ b/test/lisp/mh-e/test-all-mh-variants.sh @@ -79,12 +79,10 @@ for path in "${mh_sys_path[@]}"; do continue fi fi - echo "Testing with PATH $path" + echo "** Testing with PATH $path" ((++tests_total)) - # The LD_LIBRARY_PATH setting is needed - # to run locally installed Mailutils. TEST_MH_PATH=$path TEST_MH_DEBUG=$debug \ - LD_LIBRARY_PATH=/usr/local/lib HOME=/nonexistent \ + HOME=/nonexistent \ "${emacs[@]}" -l ert \ --eval "(setq load-prefer-newer t)" \ --eval "(load \"$PWD/test/lisp/mh-e/mh-utils-tests\" nil t)" \ From 764ffa76ed00f7a69e56a6898c22383a204421eb Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 24 Nov 2021 16:54:59 +0100 Subject: [PATCH 275/367] Backport Tramp fixes, don't merge * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): Use `tramp-handle-file-readable-p'. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test02-file-name-dissect): Use `make-tramp-file-name'. --- lisp/net/tramp-sshfs.el | 2 +- test/lisp/net/tramp-archive-tests.el | 29 ++++++++++++++-------------- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index a1007863453..1886031dec7 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -110,7 +110,7 @@ (file-notify-rm-watch . ignore) (file-notify-valid-p . ignore) (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-fuse-handle-file-readable-p) + (file-readable-p . tramp-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . tramp-handle-file-selinux-context) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 98012f4e909..0a484ff9bd1 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -265,21 +265,20 @@ variables, so we check the Emacs version directly." (concat (tramp-gvfs-url-file-name (tramp-make-tramp-file-name - tramp-archive-method - ;; User and Domain. - nil nil - ;; Host. - (url-hexify-string - (concat - "file://" - ;; `directory-file-name' does not leave file - ;; archive boundaries. So we must cut the - ;; trailing slash ourselves. - (substring - (file-name-directory - (tramp-archive-test-file-archive-hexlified)) - 0 -1))) - nil "/")) + (make-tramp-file-name + :method tramp-archive-method + :host + (url-hexify-string + (concat + "file://" + ;; `directory-file-name' does not leave file + ;; archive boundaries. So we must cut the + ;; trailing slash ourselves. + (substring + (file-name-directory + (tramp-archive-test-file-archive-hexlified)) + 0 -1))) + :localname "/"))) (file-name-nondirectory tramp-archive-test-file-archive))))) (should-not port) (should (string-equal localname "/bar")) From 0ccbb6f6d321df0683c6aebe5f4387618d9c85db Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 17:12:21 +0100 Subject: [PATCH 276/367] Make min-width of the U:-- wider * lisp/bindings.el (standard-mode-line-format): Make the modified bits larger since there's often a big difference between - and % characters. --- lisp/bindings.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index a4458ccd1e4..29a1baffe7b 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -610,7 +610,7 @@ By default, this shows the information specified by `global-mode-string'.") 'mode-line-client 'mode-line-modified 'mode-line-remote) - 'display '(min-width (4.0))) + 'display '(min-width (5.0))) 'mode-line-frame-identification 'mode-line-buffer-identification " " From 9d3d972f9798f6c14d700c51900bf444a916310e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 17:29:39 +0100 Subject: [PATCH 277/367] Fix typo in display_min_width comment * src/xdisp.c (display_min_width): Fix typo in comment. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 59509418790..a0efefa3a52 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5214,7 +5214,7 @@ display_min_width (struct it *it, ptrdiff_t bufpos, if (!it->glyph_row) return; - /* When called form display_string (i.e., the mode line), + /* When called from display_string (i.e., the mode line), we're being called with a string as the object, and we may be called with many sub-strings belonging to the same :propertize run. */ From b4f47d2ee2203a9f22bebeb3d09e0fb3fce2f65e Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Wed, 24 Nov 2021 17:28:45 +0100 Subject: [PATCH 278/367] Use @pxref when necessary * doc/lispref/customize.texi (Composite Types): * doc/lispref/edebug.texi (Specification List): * doc/lispref/variables.texi (Local Variables): * doc/misc/efaq.texi (Basic keys): (Informational files for Emacs): * doc/misc/flymake.texi (Locating a master file): * doc/misc/gnus.texi (Don't Panic): (Oort Gnus): * doc/misc/htmlfontify.texi (Non-interactive): * doc/misc/mh-e.texi (More About MH-E): * doc/misc/pcl-cvs.texi (Entering PCL-CVS): * doc/misc/tramp.texi (Remote processes): * doc/misc/vhdl-mode.texi (Indentation Calculation): (Custom Indentation Functions): Use @pxref when inside parens. --- doc/lispref/customize.texi | 2 +- doc/lispref/edebug.texi | 2 +- doc/lispref/variables.texi | 2 +- doc/misc/efaq.texi | 4 ++-- doc/misc/flymake.texi | 2 +- doc/misc/gnus.texi | 4 ++-- doc/misc/htmlfontify.texi | 4 ++-- doc/misc/mh-e.texi | 8 ++++---- doc/misc/pcl-cvs.texi | 4 ++-- doc/misc/tramp.texi | 6 +++--- doc/misc/vhdl-mode.texi | 6 +++--- 11 files changed, 22 insertions(+), 22 deletions(-) diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index b93b8bc015a..00287a7212a 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -737,7 +737,7 @@ If omitted, @var{key-type} and @var{value-type} default to The user can add any key matching the specified key type, but you can give some keys a preferential treatment by specifying them with the -@code{:options} (see @ref{Variable Definitions}). The specified keys +@code{:options} (@pxref{Variable Definitions}). The specified keys will always be shown in the customize buffer (together with a suitable value), with a checkbox to include or exclude or disable the key/value pair from the alist. The user will not be able to edit the keys diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 7d67cc3af11..0db77255a65 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1267,7 +1267,7 @@ balanced parentheses, recursive processing of forms, and recursion via indirect specifications. Here's a table of the possible elements of a specification list, with -their meanings (see @ref{Specification Examples}, for the referenced +their meanings (@pxref{Specification Examples}, for the referenced examples): @table @code diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index a1d1919b4bf..0d022a2a502 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -363,7 +363,7 @@ where you are in Emacs. @cindex evaluation error @cindex infinite recursion This variable defines the limit on the total number of local variable -bindings and @code{unwind-protect} cleanups (see @ref{Cleanups,, +bindings and @code{unwind-protect} cleanups (@pxref{Cleanups,, Cleaning Up from Nonlocal Exits}) that are allowed before Emacs signals an error (with data @code{"Variable binding depth exceeds max-specpdl-size"}). diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index cdb6f9b5848..757418a67ca 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -151,7 +151,7 @@ and @key{Meta} @item @key{DEL}: @key{Delete}, usually @strong{not} the same as -@key{Backspace}; same as @kbd{C-?} (see @ref{Backspace invokes help}, if +@key{Backspace}; same as @kbd{C-?} (@pxref{Backspace invokes help}, if deleting invokes Emacs help) @item @@ -793,7 +793,7 @@ informational files about Emacs and relevant aspects of the GNU project are available for you to read. The following files (and others) are available in the @file{etc} -directory of the Emacs distribution (see @ref{File-name conventions}, if +directory of the Emacs distribution (@pxref{File-name conventions}, if you're not sure where that is). Many of these files are available via the Emacs @samp{Help} menu, or by typing @kbd{C-h ?} (@kbd{M-x help-for-help}). diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index f741ee5d723..5f02a1568e2 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -1145,7 +1145,7 @@ file are parsed. For @file{file.h}, the include directives to look for are @code{#include "file.h"}, @code{#include "../file.h"}, etc. Each include is checked against a list of include directories -(see @ref{Getting the include directories}) to be sure it points to the +(@pxref{Getting the include directories}) to be sure it points to the correct @file{file.h}. First matching master file found stops the search. The master file is then diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6c892bc80a9..31e3c7d1f60 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -1004,7 +1004,7 @@ The fundamental building blocks of Gnus are @dfn{servers}, @dfn{groups}, and @dfn{articles}. Servers can be local or remote. Each server maintains a list of groups, and those groups contain articles. Because Gnus presents a unified interface to a wide variety -of servers, the vocabulary doesn't always quite line up (see @ref{FAQ +of servers, the vocabulary doesn't always quite line up (@pxref{FAQ - Glossary}, for a more complete glossary). Thus a local maildir is referred to as a ``server'' (@pxref{Finding the News}) the same as a Usenet or IMAP server is; ``groups'' (@pxref{Group Buffer}) might mean @@ -28881,7 +28881,7 @@ gnus-agent-cache nil)} reverts to the old behavior. @item Dired integration -@code{gnus-dired-minor-mode} (see @ref{Other modes}) installs key +@code{gnus-dired-minor-mode} (@pxref{Other modes}) installs key bindings in dired buffers to send a file as an attachment, open a file using the appropriate mailcap entry, and print a file using the mailcap entry. diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi index 1674565cdac..b2216924e2d 100644 --- a/doc/misc/htmlfontify.texi +++ b/doc/misc/htmlfontify.texi @@ -633,7 +633,7 @@ Convert an Emacs :foreground property to a CSS color property. (hfy-flatten-style @var{style}) @end lisp -Take @var{style} (see @ref{hfy-face-to-style-i}, @ref{hfy-face-to-style}) +Take @var{style} (@pxref{hfy-face-to-style-i}, @pxref{hfy-face-to-style}) and merge any multiple attributes appropriately. Currently only font-size is merged down to a single occurrence---others may need special handling, but I haven't encountered them yet. Returns a @ref{hfy-style-assoc}. @@ -841,7 +841,7 @@ See @ref{hfy-display-class} for details of valid values for @var{class}. @end lisp Find face in effect at point P@. If overlays are to be considered -(see @ref{hfy-optimizations}) then this may return a @code{defface} style +(@pxref{hfy-optimizations}) then this may return a @code{defface} style list of face properties instead of a face symbol. @item hfy-bgcol diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index bc788ebae09..d96c243f52b 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -1018,16 +1018,16 @@ Send multimedia messages (@pxref{Adding Attachments}). Read HTML messages (@pxref{HTML}). @c ------------------------- @item -Use aliases and identities (see @ref{Aliases}, @pxref{Identities}). +Use aliases and identities (@pxref{Aliases}, @pxref{Identities}). @c ------------------------- @item -Create different views of your mail (see @ref{Threading}, @pxref{Limits}). +Create different views of your mail (@pxref{Threading}, @pxref{Limits}). @c ------------------------- @item Deal with junk mail (@pxref{Junk}). @c ------------------------- @item -Handle signed and encrypted messages (see @ref{Reading PGP}, +Handle signed and encrypted messages (@pxref{Reading PGP}, @pxref{Sending PGP}). @c ------------------------- @item @@ -1038,7 +1038,7 @@ Process mail that was sent with @command{shar} or @command{uuencode} Use sequences conveniently (@pxref{Sequences}). @c ------------------------- @item -Use the speedbar, tool bar, and menu bar (see @ref{Speedbar}, see @ref{Tool +Use the speedbar, tool bar, and menu bar (@pxref{Speedbar}, @pxref{Tool Bar}, @pxref{Menu Bar}). @c ------------------------- @item diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index 4ba067fd81f..833326c089b 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -524,8 +524,8 @@ you can use in PCL-CVS@. They are grouped together by type. Most commands in PCL-CVS require that you have a @file{*cvs*} buffer. The commands that you use to get one are listed below. For each, a @samp{cvs} process will be run, the output will be parsed by -PCL-CVS, and the result will be printed in the @file{*cvs*} buffer (see -@ref{Buffer contents}, for a description of the buffer's contents). +PCL-CVS, and the result will be printed in the @file{*cvs*} buffer +(@pxref{Buffer contents}, for a description of the buffer's contents). @table @kbd @item M-x cvs-update diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index a17a8d67e5b..a9794eb4b71 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3389,8 +3389,8 @@ returns the exit code for it. When the user option indication that the process has been interrupted, and returns a corresponding string. -This remote process handling does not apply to @acronym{GVFS} (see -@ref{GVFS-based methods}) because the remote file system is mounted on +This remote process handling does not apply to @acronym{GVFS} +(@pxref{GVFS-based methods}) because the remote file system is mounted on the local host and @value{tramp} accesses it by changing the @code{default-directory}. @@ -3411,7 +3411,7 @@ might also add their name to this environment variable, like For @value{tramp} to find the command on the remote, it must be accessible through the default search path as setup by @value{tramp} upon first connection. Alternatively, use an absolute path or extend -@code{tramp-remote-path} (see @ref{Remote programs}): +@code{tramp-remote-path} (@pxref{Remote programs}): @lisp @group diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi index fef98a74636..7022582db51 100644 --- a/doc/misc/vhdl-mode.texi +++ b/doc/misc/vhdl-mode.texi @@ -243,7 +243,7 @@ components. Also notice that the first component, @vindex vhdl-offsets-alist @vindex offsets-alist @r{(vhdl-)} Indentation for the current line is calculated using the syntactic -component list derived in step 1 above (see @ref{Syntactic +component list derived in step 1 above (@pxref{Syntactic Analysis}). Each component contributes to the final total indentation of the line in two ways. @@ -668,7 +668,7 @@ not handled by the mode directly. @cindex custom indentation functions One of the most common ways to customize VHDL Mode is by writing @dfn{custom indentation functions} and associating them with specific -syntactic symbols (see @ref{Syntactic Symbols}). VHDL Mode itself +syntactic symbols (@pxref{Syntactic Symbols}). VHDL Mode itself uses custom indentation functions to provide more sophisticated indentation, for example when lining up selected signal assignments: @example @@ -732,7 +732,7 @@ operator on the first line of the statement. Here is the lisp code @end example @noindent Custom indent functions take a single argument, which is a syntactic -component cons cell (see @ref{Syntactic Analysis}). The +component cons cell (@pxref{Syntactic Analysis}). The function returns an integer offset value that will be added to the running total indentation for the line. Note that what actually gets returned is the difference between the column that the signal assignment From 20ab639d8946ca4c07c5238f015f8da17799c4e2 Mon Sep 17 00:00:00 2001 From: Narendra Joshi Date: Wed, 24 Nov 2021 11:58:03 -0500 Subject: [PATCH 279/367] * lisp/vcursor.el (vcursor-get-char-count): Preserve point Copyright-paperwork-exempt: yes --- lisp/vcursor.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index e219dc2d1a5..df65db39e38 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -788,9 +788,9 @@ out how much to copy." (vcursor-check) (with-current-buffer (overlay-buffer vcursor-overlay) - (let ((start (goto-char (overlay-start vcursor-overlay)))) - (- (progn (apply func args) (point)) start))) - ) + (save-excursion + (let ((start (goto-char (overlay-start vcursor-overlay)))) + (- (progn (apply func args) (point)) start))))) ;; Make sure the virtual cursor is active. Unless arg is non-nil, ;; report an error if it is not. From de9359d1d7b512e6b3488a3b9d8e12a747367055 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 24 Nov 2021 19:19:21 +0200 Subject: [PATCH 280/367] Fix documentation of 'min-width' display spec. * doc/lispref/display.texi (Other Display Specs): Clarify documentation of the 'min-width' display spec. --- doc/lispref/display.texi | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index dc53eeff9bf..fdebba939be 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5180,19 +5180,21 @@ be an integer or float. Characters other than spaces are not affected at all; in particular, this has no effect on tab characters. @item (min-width (@var{width})) -This display specification adds padding to the end of the text if the -text is shorter than @var{width}. The text is partitioned using the -identity of the parameter, which is why the parameter is a list with -one element. For instance: +This display specification ensures the text that has it takes at least +@var{width} space on display, by adding a stretch of white space to +the end of the text if the text is shorter than @var{width}. The text +is partitioned using the identity of the parameter, which is why the +parameter is a list with one element. For instance: @lisp (insert (propertize "foo" '(display (min-width (6.0))))) @end lisp This will add padding after @samp{foo} bringing the total width up to -the width of six normal characters. Note that the ``range'' is -identified by the @code{(6.0)} list, compared with @code{eq}. The -width can be either a character width or a pixel specification +the width of six normal characters. Note that the affected characters +are identified by the @code{(6.0)} list in the display property, +compared with @code{eq}. The element @var{width} can be either an +integer or a float specifying the required minimum width of the text (@pxref{Pixel Specification}). @item (height @var{height}) From 34f2878ce25a74c1283266b67575a56554684be5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 18:38:14 +0100 Subject: [PATCH 281/367] Change eshell-mode mode-line-format insinuation * lisp/eshell/esh-mode.el (eshell-mode): Tweak how the mode line is altered after recent mode-line-format changes. --- lisp/eshell/esh-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index a054cd66e27..cae5236d894 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -308,7 +308,7 @@ and the hook `eshell-exit-hook'." (make-local-variable 'eshell-command-running-string) (let ((fmt (copy-sequence mode-line-format))) (setq-local mode-line-format fmt)) - (let ((mode-line-elt (memq 'mode-line-modified mode-line-format))) + (let ((mode-line-elt (cdr (memq 'mode-line-front-space mode-line-format)))) (if mode-line-elt (setcar mode-line-elt 'eshell-command-running-string)))) From fde9363a57d0d38d592122fe5ca01aaafd0afa52 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 19:38:41 +0100 Subject: [PATCH 282/367] Add new function 'add-display-text-property' * doc/lispref/display.texi (Display Property): Document it. * lisp/emacs-lisp/subr-x.el (add-display-text-property): New function. --- doc/lispref/display.texi | 25 ++++++++++++++++ etc/NEWS | 7 +++++ lisp/emacs-lisp/subr-x.el | 45 ++++++++++++++++++++++++++++ test/lisp/emacs-lisp/subr-x-tests.el | 18 +++++++++++ 4 files changed, 95 insertions(+) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index fdebba939be..7204581e407 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4904,6 +4904,31 @@ with @code{get-char-property}, for instance (@pxref{Examining Properties}). @end defun +@defun add-display-text-property start end prop value &optional append object +Add @code{display} property @var{prop} of @var{value} to the text from +@var{start} to @var{end}. + +If any text in the region has a non-@code{nil} @code{display} +property, those properties are retained. For instance: + +@lisp +(add-display-text-property 4 8 'height 2.0) +(add-display-text-property 2 12 'raise 0.5) +@end lisp + +After doing this, the region from 2 to 4 will have the @code{raise} +@code{display} property, the region from 4 to 8 will have both the +@code{raise} and @code{height} @code{display} properties, and finally +the region from 8 to 12 will only have the @code{raise} @code{display} +property. + +If @var{append} is non-@code{nil}, append to the list of display +properties; otherwise prepend. + +If @var{object} is non-@code{nil}, it should be a string or a buffer. +If @code{nil}, this defaults to the current buffer. +@end defun + @cindex display property, unsafe evaluation @cindex security, and display specifications Some of the display specifications allow inclusion of Lisp forms, diff --git a/etc/NEWS b/etc/NEWS index 24b8cb27961..8b7c2f78508 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -676,10 +676,17 @@ Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 ++++ ** New function 'get-display-property'. This is like 'get-text-property', but works on the 'display' text property. ++++ +** New function 'add-text-display-property'. +This is like 'put-text-property', but works on the 'display' text +property. + ++++ ** New 'min-width' 'display' property. This allows setting a minimum display width for a region of text. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 95254b946e5..3ec880f8b8f 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -469,6 +469,51 @@ This takes into account combining characters and grapheme clusters." (setq start (1+ start)))) (nreverse result))) +;;;###autoload +(defun add-display-text-property (start end prop value + &optional append object) + "Add display property PROP with VALUE to the text from START to END. +If any text in the region has a non-nil `display' property, those +properties are retained. + +If APPEND is non-nil, append to the list of display properties; +otherwise prepend. + +If OBJECT is non-nil, it should be a string or a buffer. If nil, +this defaults to the current buffer." + (let ((sub-start start) + (sub-end 0) + disp) + (while (< sub-end end) + (setq sub-end (next-single-property-change sub-start 'display object + (if (stringp object) + (min (length object) end) + (min end (point-max))))) + (if (not (setq disp (get-text-property sub-start 'display object))) + ;; No old properties in this range. + (put-text-property sub-start sub-end 'display (list prop value)) + ;; We have old properties. + (let ((vector nil)) + ;; Make disp into a list. + (setq disp + (cond + ((vectorp disp) + (setq vector t) + (seq-into disp 'list)) + ((not (consp (car disp))) + (list disp)) + (t + disp))) + (setq disp + (if append + (append disp (list (list prop value))) + (append (list (list prop value)) disp))) + (when vector + (setq disp (seq-into disp 'vector))) + ;; Finally update the range. + (put-text-property sub-start sub-end 'display disp))) + (setq sub-start sub-end)))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index f9cfea888c7..69d59e84f6d 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -676,5 +676,23 @@ (buffer-string)) "foo\n"))) +(ert-deftest test-add-display-text-property () + (with-temp-buffer + (insert "Foo bar zot gazonk") + (add-display-text-property 4 8 'height 2.0) + (add-display-text-property 2 12 'raise 0.5) + (should (equal (get-text-property 2 'display) '(raise 0.5))) + (should (equal (get-text-property 5 'display) + '((raise 0.5) (height 2.0)))) + (should (equal (get-text-property 9 'display) '(raise 0.5)))) + (with-temp-buffer + (insert "Foo bar zot gazonk") + (put-text-property 4 8 'display [(height 2.0)]) + (add-display-text-property 2 12 'raise 0.5) + (should (equal (get-text-property 2 'display) '(raise 0.5))) + (should (equal (get-text-property 5 'display) + [(raise 0.5) (height 2.0)])) + (should (equal (get-text-property 9 'display) '(raise 0.5))))) + (provide 'subr-x-tests) ;;; subr-x-tests.el ends here From 388b4a12f58855f24eca8f00cd20659a9d2b81d6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 24 Nov 2021 20:46:53 +0200 Subject: [PATCH 283/367] =?UTF-8?q?*=20lisp/outline.el=20(outline-font-loc?= =?UTF-8?q?k-keywords):=20Replace=20=E2=80=98.+=E2=80=99=20with=20?= =?UTF-8?q?=E2=80=98.*=E2=80=99.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Make the regexp less restrictive and don't require the outline heading to have more text after outline-regexp until the end of the heading line (bug#51016). --- lisp/outline.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/outline.el b/lisp/outline.el index a4d2a3b7d74..2ede4e23eac 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -221,7 +221,7 @@ in the file it applies to.") (defvar outline-font-lock-keywords '( ;; Highlight headings according to the level. - (eval . (list (concat "^\\(?:" outline-regexp "\\).+") + (eval . (list (concat "^\\(?:" outline-regexp "\\).*") 0 '(if outline-minor-mode (if outline-minor-mode-cycle (if outline-minor-mode-highlight From 833a42fbcf78ec99b84a98dd6bc7c2eea6eeaef6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 20:04:25 +0100 Subject: [PATCH 284/367] Fix min-width problem with "overlapping" regions * src/xdisp.c (handle_display_prop): Fix problem with overlapping regions. --- src/xdisp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index a0efefa3a52..b7fd2249dc2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5352,7 +5352,8 @@ handle_display_prop (struct it *it) Qdisplay, object, &overlay); /* Handle min-width ends. */ - if (!NILP (it->min_width_property)) + if (!NILP (it->min_width_property) + && NILP (find_display_property (propval, Qmin_width))) display_min_width (it, bufpos, object, Qnil); if (NILP (propval)) From e99bf271587399650a6d52beea4c8f1340d66689 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 20:10:14 +0100 Subject: [PATCH 285/367] Remove APPEND argument from add-display-text-property * doc/lispref/display.texi (Display Property): Update doc. * lisp/emacs-lisp/subr-x.el (add-display-text-property): Remove the append argument -- it's nonsensical. --- doc/lispref/display.texi | 5 +---- lisp/emacs-lisp/subr-x.el | 13 +++++-------- 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 7204581e407..6742f0ea2d5 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4904,7 +4904,7 @@ with @code{get-char-property}, for instance (@pxref{Examining Properties}). @end defun -@defun add-display-text-property start end prop value &optional append object +@defun add-display-text-property start end prop value &optional object Add @code{display} property @var{prop} of @var{value} to the text from @var{start} to @var{end}. @@ -4922,9 +4922,6 @@ After doing this, the region from 2 to 4 will have the @code{raise} the region from 8 to 12 will only have the @code{raise} @code{display} property. -If @var{append} is non-@code{nil}, append to the list of display -properties; otherwise prepend. - If @var{object} is non-@code{nil}, it should be a string or a buffer. If @code{nil}, this defaults to the current buffer. @end defun diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 3ec880f8b8f..b53245b9b5f 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -471,14 +471,11 @@ This takes into account combining characters and grapheme clusters." ;;;###autoload (defun add-display-text-property (start end prop value - &optional append object) + &optional object) "Add display property PROP with VALUE to the text from START to END. If any text in the region has a non-nil `display' property, those properties are retained. -If APPEND is non-nil, append to the list of display properties; -otherwise prepend. - If OBJECT is non-nil, it should be a string or a buffer. If nil, this defaults to the current buffer." (let ((sub-start start) @@ -504,10 +501,10 @@ this defaults to the current buffer." (list disp)) (t disp))) - (setq disp - (if append - (append disp (list (list prop value))) - (append (list (list prop value)) disp))) + ;; Remove any old instances. + (when-let ((old (assoc prop disp))) + (setq disp (delete old disp))) + (setq disp (cons (list prop value) disp)) (when vector (setq disp (seq-into disp 'vector))) ;; Finally update the range. From 0854453ec2343cbfac3ac8e233cdc7bd2c8554a9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 24 Nov 2021 21:27:15 +0200 Subject: [PATCH 286/367] Revert "Use @pxref when necessary" This reverts commit b4f47d2ee2203a9f22bebeb3d09e0fb3fce2f65e. Cleanups should not be done on the release branch: that's unnecessary risk. --- doc/lispref/customize.texi | 2 +- doc/lispref/edebug.texi | 2 +- doc/lispref/variables.texi | 2 +- doc/misc/efaq.texi | 4 ++-- doc/misc/flymake.texi | 2 +- doc/misc/gnus.texi | 4 ++-- doc/misc/htmlfontify.texi | 4 ++-- doc/misc/mh-e.texi | 8 ++++---- doc/misc/pcl-cvs.texi | 4 ++-- doc/misc/tramp.texi | 6 +++--- doc/misc/vhdl-mode.texi | 6 +++--- 11 files changed, 22 insertions(+), 22 deletions(-) diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 00287a7212a..b93b8bc015a 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -737,7 +737,7 @@ If omitted, @var{key-type} and @var{value-type} default to The user can add any key matching the specified key type, but you can give some keys a preferential treatment by specifying them with the -@code{:options} (@pxref{Variable Definitions}). The specified keys +@code{:options} (see @ref{Variable Definitions}). The specified keys will always be shown in the customize buffer (together with a suitable value), with a checkbox to include or exclude or disable the key/value pair from the alist. The user will not be able to edit the keys diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 0db77255a65..7d67cc3af11 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1267,7 +1267,7 @@ balanced parentheses, recursive processing of forms, and recursion via indirect specifications. Here's a table of the possible elements of a specification list, with -their meanings (@pxref{Specification Examples}, for the referenced +their meanings (see @ref{Specification Examples}, for the referenced examples): @table @code diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 0d022a2a502..a1d1919b4bf 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -363,7 +363,7 @@ where you are in Emacs. @cindex evaluation error @cindex infinite recursion This variable defines the limit on the total number of local variable -bindings and @code{unwind-protect} cleanups (@pxref{Cleanups,, +bindings and @code{unwind-protect} cleanups (see @ref{Cleanups,, Cleaning Up from Nonlocal Exits}) that are allowed before Emacs signals an error (with data @code{"Variable binding depth exceeds max-specpdl-size"}). diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 757418a67ca..cdb6f9b5848 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -151,7 +151,7 @@ and @key{Meta} @item @key{DEL}: @key{Delete}, usually @strong{not} the same as -@key{Backspace}; same as @kbd{C-?} (@pxref{Backspace invokes help}, if +@key{Backspace}; same as @kbd{C-?} (see @ref{Backspace invokes help}, if deleting invokes Emacs help) @item @@ -793,7 +793,7 @@ informational files about Emacs and relevant aspects of the GNU project are available for you to read. The following files (and others) are available in the @file{etc} -directory of the Emacs distribution (@pxref{File-name conventions}, if +directory of the Emacs distribution (see @ref{File-name conventions}, if you're not sure where that is). Many of these files are available via the Emacs @samp{Help} menu, or by typing @kbd{C-h ?} (@kbd{M-x help-for-help}). diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 5f02a1568e2..f741ee5d723 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -1145,7 +1145,7 @@ file are parsed. For @file{file.h}, the include directives to look for are @code{#include "file.h"}, @code{#include "../file.h"}, etc. Each include is checked against a list of include directories -(@pxref{Getting the include directories}) to be sure it points to the +(see @ref{Getting the include directories}) to be sure it points to the correct @file{file.h}. First matching master file found stops the search. The master file is then diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 31e3c7d1f60..6c892bc80a9 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -1004,7 +1004,7 @@ The fundamental building blocks of Gnus are @dfn{servers}, @dfn{groups}, and @dfn{articles}. Servers can be local or remote. Each server maintains a list of groups, and those groups contain articles. Because Gnus presents a unified interface to a wide variety -of servers, the vocabulary doesn't always quite line up (@pxref{FAQ +of servers, the vocabulary doesn't always quite line up (see @ref{FAQ - Glossary}, for a more complete glossary). Thus a local maildir is referred to as a ``server'' (@pxref{Finding the News}) the same as a Usenet or IMAP server is; ``groups'' (@pxref{Group Buffer}) might mean @@ -28881,7 +28881,7 @@ gnus-agent-cache nil)} reverts to the old behavior. @item Dired integration -@code{gnus-dired-minor-mode} (@pxref{Other modes}) installs key +@code{gnus-dired-minor-mode} (see @ref{Other modes}) installs key bindings in dired buffers to send a file as an attachment, open a file using the appropriate mailcap entry, and print a file using the mailcap entry. diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi index b2216924e2d..1674565cdac 100644 --- a/doc/misc/htmlfontify.texi +++ b/doc/misc/htmlfontify.texi @@ -633,7 +633,7 @@ Convert an Emacs :foreground property to a CSS color property. (hfy-flatten-style @var{style}) @end lisp -Take @var{style} (@pxref{hfy-face-to-style-i}, @pxref{hfy-face-to-style}) +Take @var{style} (see @ref{hfy-face-to-style-i}, @ref{hfy-face-to-style}) and merge any multiple attributes appropriately. Currently only font-size is merged down to a single occurrence---others may need special handling, but I haven't encountered them yet. Returns a @ref{hfy-style-assoc}. @@ -841,7 +841,7 @@ See @ref{hfy-display-class} for details of valid values for @var{class}. @end lisp Find face in effect at point P@. If overlays are to be considered -(@pxref{hfy-optimizations}) then this may return a @code{defface} style +(see @ref{hfy-optimizations}) then this may return a @code{defface} style list of face properties instead of a face symbol. @item hfy-bgcol diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index d96c243f52b..bc788ebae09 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -1018,16 +1018,16 @@ Send multimedia messages (@pxref{Adding Attachments}). Read HTML messages (@pxref{HTML}). @c ------------------------- @item -Use aliases and identities (@pxref{Aliases}, @pxref{Identities}). +Use aliases and identities (see @ref{Aliases}, @pxref{Identities}). @c ------------------------- @item -Create different views of your mail (@pxref{Threading}, @pxref{Limits}). +Create different views of your mail (see @ref{Threading}, @pxref{Limits}). @c ------------------------- @item Deal with junk mail (@pxref{Junk}). @c ------------------------- @item -Handle signed and encrypted messages (@pxref{Reading PGP}, +Handle signed and encrypted messages (see @ref{Reading PGP}, @pxref{Sending PGP}). @c ------------------------- @item @@ -1038,7 +1038,7 @@ Process mail that was sent with @command{shar} or @command{uuencode} Use sequences conveniently (@pxref{Sequences}). @c ------------------------- @item -Use the speedbar, tool bar, and menu bar (@pxref{Speedbar}, @pxref{Tool +Use the speedbar, tool bar, and menu bar (see @ref{Speedbar}, see @ref{Tool Bar}, @pxref{Menu Bar}). @c ------------------------- @item diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index 833326c089b..4ba067fd81f 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -524,8 +524,8 @@ you can use in PCL-CVS@. They are grouped together by type. Most commands in PCL-CVS require that you have a @file{*cvs*} buffer. The commands that you use to get one are listed below. For each, a @samp{cvs} process will be run, the output will be parsed by -PCL-CVS, and the result will be printed in the @file{*cvs*} buffer -(@pxref{Buffer contents}, for a description of the buffer's contents). +PCL-CVS, and the result will be printed in the @file{*cvs*} buffer (see +@ref{Buffer contents}, for a description of the buffer's contents). @table @kbd @item M-x cvs-update diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index a9794eb4b71..a17a8d67e5b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3389,8 +3389,8 @@ returns the exit code for it. When the user option indication that the process has been interrupted, and returns a corresponding string. -This remote process handling does not apply to @acronym{GVFS} -(@pxref{GVFS-based methods}) because the remote file system is mounted on +This remote process handling does not apply to @acronym{GVFS} (see +@ref{GVFS-based methods}) because the remote file system is mounted on the local host and @value{tramp} accesses it by changing the @code{default-directory}. @@ -3411,7 +3411,7 @@ might also add their name to this environment variable, like For @value{tramp} to find the command on the remote, it must be accessible through the default search path as setup by @value{tramp} upon first connection. Alternatively, use an absolute path or extend -@code{tramp-remote-path} (@pxref{Remote programs}): +@code{tramp-remote-path} (see @ref{Remote programs}): @lisp @group diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi index 7022582db51..fef98a74636 100644 --- a/doc/misc/vhdl-mode.texi +++ b/doc/misc/vhdl-mode.texi @@ -243,7 +243,7 @@ components. Also notice that the first component, @vindex vhdl-offsets-alist @vindex offsets-alist @r{(vhdl-)} Indentation for the current line is calculated using the syntactic -component list derived in step 1 above (@pxref{Syntactic +component list derived in step 1 above (see @ref{Syntactic Analysis}). Each component contributes to the final total indentation of the line in two ways. @@ -668,7 +668,7 @@ not handled by the mode directly. @cindex custom indentation functions One of the most common ways to customize VHDL Mode is by writing @dfn{custom indentation functions} and associating them with specific -syntactic symbols (@pxref{Syntactic Symbols}). VHDL Mode itself +syntactic symbols (see @ref{Syntactic Symbols}). VHDL Mode itself uses custom indentation functions to provide more sophisticated indentation, for example when lining up selected signal assignments: @example @@ -732,7 +732,7 @@ operator on the first line of the statement. Here is the lisp code @end example @noindent Custom indent functions take a single argument, which is a syntactic -component cons cell (@pxref{Syntactic Analysis}). The +component cons cell (see @ref{Syntactic Analysis}). The function returns an integer offset value that will be added to the running total indentation for the line. Note that what actually gets returned is the difference between the column that the signal assignment From 39e2c214df7899dddbc86d063f31fe02f7987d49 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 24 Nov 2021 20:27:34 +0100 Subject: [PATCH 287/367] Some optimizations for emba jobs * test/infra/gitlab-ci.yml (.test-template): Remove. (test-all-inotify, test-filenotify-gio, test-gnustep) (test-native-comp-speed0): * test/infra/Makefile.in (subdir_template): Remove .test-template from extends. Add or adapt needs and artifacts. * test/infra/test-jobs.yml: Regenerate. --- test/infra/Makefile.in | 5 +- test/infra/gitlab-ci.yml | 43 ++++++----- test/infra/test-jobs.yml | 160 +++++++++++++++++++++++++++++++-------- 3 files changed, 154 insertions(+), 54 deletions(-) diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index e55a6edaff2..d9fc0196257 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -71,7 +71,10 @@ define subdir_template @echo >>$(FILE) @echo 'test-$(subst /,-,$(1))-inotify:' >>$(FILE) @echo ' stage: normal' >>$(FILE) - @echo ' extends: [.job-template, .test-template]' >>$(FILE) + @echo ' extends: [.job-template]' >>$(FILE) + @echo ' needs:' >>$(FILE) + @echo ' - job: build-image-inotify' >>$(FILE) + @echo ' optional: true' >>$(FILE) @echo ' rules:' >>$(FILE) @echo " - if: '"'${cps} == "schedule"'"'" >>$(FILE) @echo ' when: never' >>$(FILE) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 588ca04f3b9..15d8b252e23 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -127,21 +127,6 @@ default: - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba . - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -.test-template: - needs: [] - # Do not run fast and normal test jobs when scheduled. - rules: - - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' - when: never - - when: always - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - "**.log" - when: always - .gnustep-template: rules: - if: '$CI_PIPELINE_SOURCE == "web"' @@ -204,11 +189,21 @@ include: '/test/infra/test-jobs.yml' test-all-inotify: # This tests also file monitor libraries inotify and inotifywatch. stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: # Note there's no "changes" section, so this always runs on a schedule. - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - "**/*.log" + when: always variables: target: emacs-inotify make_params: check-expensive @@ -222,8 +217,10 @@ build-image-filenotify-gio: test-filenotify-gio: # This tests file monitor libraries gfilemonitor and gio. stage: platforms - extends: [.job-template, .test-template, .filenotify-gio-template] - needs: [build-image-filenotify-gio] + extends: [.job-template, .filenotify-gio-template] + needs: + - job: build-image-filenotify-gio + optional: true variables: target: emacs-filenotify-gio make_params: "-k -C test autorevert-tests.log filenotify-tests.log" @@ -238,7 +235,9 @@ test-gnustep: # This tests the GNUstep build process. stage: platforms extends: [.job-template, .gnustep-template] - needs: [build-image-gnustep] + needs: + - job: build-image-gnustep + optional: true variables: target: emacs-gnustep make_params: install @@ -263,8 +262,10 @@ build-native-comp-speed2: test-native-comp-speed0: stage: native-comp - extends: [.job-template, .test-template, .native-comp-template] - needs: [build-native-comp-speed0] + extends: [.job-template, .native-comp-template] + needs: + - job: build-native-comp-speed0 + optional: true variables: target: emacs-native-comp-speed0 make_params: "-C test check SELECTOR='(not (tag :unstable))'" diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 7af671d641b..33a90d6f2cb 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -1,7 +1,10 @@ test-lib-src-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -22,7 +25,10 @@ test-lib-src-inotify: test-lisp-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -43,7 +49,10 @@ test-lisp-inotify: test-lisp-calc-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -64,7 +73,10 @@ test-lisp-calc-inotify: test-lisp-calendar-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -85,7 +97,10 @@ test-lisp-calendar-inotify: test-lisp-cedet-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -106,7 +121,10 @@ test-lisp-cedet-inotify: test-lisp-cedet-semantic-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -127,7 +145,10 @@ test-lisp-cedet-semantic-inotify: test-lisp-cedet-semantic-bovine-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -148,7 +169,10 @@ test-lisp-cedet-semantic-bovine-inotify: test-lisp-cedet-srecode-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -169,7 +193,10 @@ test-lisp-cedet-srecode-inotify: test-lisp-emacs-lisp-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -190,7 +217,10 @@ test-lisp-emacs-lisp-inotify: test-lisp-emacs-lisp-eieio-tests-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -211,7 +241,10 @@ test-lisp-emacs-lisp-eieio-tests-inotify: test-lisp-emacs-lisp-faceup-tests-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -232,7 +265,10 @@ test-lisp-emacs-lisp-faceup-tests-inotify: test-lisp-emulation-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -253,7 +289,10 @@ test-lisp-emulation-inotify: test-lisp-erc-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -274,7 +313,10 @@ test-lisp-erc-inotify: test-lisp-eshell-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -295,7 +337,10 @@ test-lisp-eshell-inotify: test-lisp-gnus-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -316,7 +361,10 @@ test-lisp-gnus-inotify: test-lisp-image-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -337,7 +385,10 @@ test-lisp-image-inotify: test-lisp-international-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -358,7 +409,10 @@ test-lisp-international-inotify: test-lisp-mail-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -379,7 +433,10 @@ test-lisp-mail-inotify: test-lisp-mh-e-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -400,7 +457,10 @@ test-lisp-mh-e-inotify: test-lisp-net-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -421,7 +481,10 @@ test-lisp-net-inotify: test-lisp-nxml-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -442,7 +505,10 @@ test-lisp-nxml-inotify: test-lisp-obsolete-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -463,7 +529,10 @@ test-lisp-obsolete-inotify: test-lisp-org-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -484,7 +553,10 @@ test-lisp-org-inotify: test-lisp-play-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -505,7 +577,10 @@ test-lisp-play-inotify: test-lisp-progmodes-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -526,7 +601,10 @@ test-lisp-progmodes-inotify: test-lisp-so-long-tests-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -547,7 +625,10 @@ test-lisp-so-long-tests-inotify: test-lisp-term-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -568,7 +649,10 @@ test-lisp-term-inotify: test-lisp-textmodes-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -589,7 +673,10 @@ test-lisp-textmodes-inotify: test-lisp-url-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -610,7 +697,10 @@ test-lisp-url-inotify: test-lisp-vc-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -631,7 +721,10 @@ test-lisp-vc-inotify: test-misc-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never @@ -652,7 +745,10 @@ test-misc-inotify: test-src-inotify: stage: normal - extends: [.job-template, .test-template] + extends: [.job-template] + needs: + - job: build-image-inotify + optional: true rules: - if: '$CI_PIPELINE_SOURCE == "schedule"' when: never From 11e5c7d8ca58cc946930048b5c88c8f582d4d5d8 Mon Sep 17 00:00:00 2001 From: Matt Kramer Date: Wed, 24 Nov 2021 21:41:52 +0200 Subject: [PATCH 288/367] Fix tab-line cycling when using buffer groups (bug#52050) * lisp/tab-line.el (tab-line-switch-to-prev-tab, tab-line-switch-to-next-tab): Remove tabs that aren't associated with a buffer, such as the `group-tab' that exists when `tab-line-tabs-function' is `tab-line-tabs-buffer-groups'. Copyright-paperwork-exempt: yes --- lisp/tab-line.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 110c6e96969..af0647acf7c 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -792,7 +792,9 @@ Its effect is the same as using the `previous-buffer' command (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) (switch-to-prev-buffer window) (with-selected-window (or window (selected-window)) - (let* ((tabs (funcall tab-line-tabs-function)) + (let* ((tabs (seq-filter + (lambda (tab) (or (bufferp tab) (assq 'buffer tab))) + (funcall tab-line-tabs-function))) (pos (seq-position tabs (current-buffer) (lambda (tab buffer) @@ -816,7 +818,9 @@ Its effect is the same as using the `next-buffer' command (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) (switch-to-next-buffer window) (with-selected-window (or window (selected-window)) - (let* ((tabs (funcall tab-line-tabs-function)) + (let* ((tabs (seq-filter + (lambda (tab) (or (bufferp tab) (assq 'buffer tab))) + (funcall tab-line-tabs-function))) (pos (seq-position tabs (current-buffer) (lambda (tab buffer) From 82233c2c1dcf0c55cb56a65499e57a69a25f47bf Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Wed, 24 Nov 2021 18:38:24 -0800 Subject: [PATCH 289/367] mh-utils-tests: 'mh-sub-folders-actual' coverage * test/lisp/mh-e/mh-utils.el (mh-sub-folders-parse-no-folder) (mh-sub-folders-parse-relative-folder, mh-sub-folders-parse-root-folder): New tests. * lisp/mh-e/mh-utils.el (mh-sub-folders-parse): New function, refactored out of 'mh-sub-folders-actual' to create a testing seam. --- lisp/mh-e/mh-utils.el | 55 ++++++++++++++++++-------------- test/lisp/mh-e/mh-utils-tests.el | 46 ++++++++++++++++++++++++++ 2 files changed, 77 insertions(+), 24 deletions(-) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 992943e3042..ad23bd19118 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -562,7 +562,6 @@ Expects FOLDER to have already been normalized with (let ((arg-list `(,(expand-file-name "folders" mh-progs) nil (t nil) nil "-noheader" "-norecurse" "-nototal" ,@(if (stringp folder) (list folder) ()))) - (results ()) (current-folder (concat (with-temp-buffer (call-process (expand-file-name "folder" mh-progs) @@ -571,29 +570,37 @@ Expects FOLDER to have already been normalized with "+"))) (with-temp-buffer (apply #'call-process arg-list) - (goto-char (point-min)) - (while (not (and (eolp) (bolp))) - (goto-char (line-end-position)) - (let ((start-pos (line-beginning-position)) - (has-pos (search-backward " has " - (line-beginning-position) t))) - (when (integerp has-pos) - (while (equal (char-after has-pos) ? ) - (cl-decf has-pos)) - (cl-incf has-pos) - (while (equal (char-after start-pos) ? ) - (cl-incf start-pos)) - (let* ((name (buffer-substring start-pos has-pos)) - (first-char (aref name 0)) - (last-char (aref name (1- (length name))))) - (unless (member first-char '(?. ?# ?,)) - (when (and (equal last-char ?+) (equal name current-folder)) - (setq name (substring name 0 (1- (length name))))) - (push - (cons name - (search-forward "(others)" (line-end-position) t)) - results)))) - (forward-line 1)))) + (mh-sub-folders-parse folder current-folder)))) + +(defun mh-sub-folders-parse (folder current-folder) + "Parse the results of \"folders FOLDER\" and return a list of sub-folders. +CURRENT-FOLDER is the result of \"folder -fast\". +FOLDER will be nil or start with '+'; CURRENT-FOLDER will end with '+'. +This function is a testable helper of `mh-sub-folders-actual'." + (let ((results ())) + (goto-char (point-min)) + (while (not (and (eolp) (bolp))) + (goto-char (line-end-position)) + (let ((start-pos (line-beginning-position)) + (has-pos (search-backward " has " + (line-beginning-position) t))) + (when (integerp has-pos) + (while (equal (char-after has-pos) ? ) + (cl-decf has-pos)) + (cl-incf has-pos) + (while (equal (char-after start-pos) ? ) + (cl-incf start-pos)) + (let* ((name (buffer-substring start-pos has-pos)) + (first-char (aref name 0)) + (last-char (aref name (1- (length name))))) + (unless (member first-char '(?. ?# ?,)) + (when (and (equal last-char ?+) (equal name current-folder)) + (setq name (substring name 0 (1- (length name))))) + (push + (cons name + (search-forward "(others)" (line-end-position) t)) + results)))) + (forward-line 1))) (setq results (nreverse results)) (when (stringp folder) (setq results (cdr results)) diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index 5f6accc6470..83949204a6e 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -80,6 +80,52 @@ (mh-normalize-folder-name "+inbox////../news/" nil t))) (should (equal "+inbox/news" (mh-normalize-folder-name "+inbox////./news")))) +(ert-deftest mh-sub-folders-parse-no-folder () + "Test `mh-sub-folders-parse' with no starting folder." + (let (others-position) + (with-temp-buffer + (insert "lines without has-string are ignored\n") + (insert "onespace has no messages.\n") + (insert "twospace has no messages.\n") + (insert " precedingblanks has no messages.\n") + (insert ".leadingdot has no messages.\n") + (insert "#leadinghash has no messages.\n") + (insert ",leadingcomma has no messages.\n") + (insert "withothers has no messages ; (others)") + (setq others-position (point)) + (insert ".\n") + (insert "curf has no messages.\n") + (insert "curf+ has 123 messages.\n") + (insert "curf2+ has 17 messages.\n") + (insert "\ntotal after blank line is ignored has no messages.\n") + (should (equal + (mh-sub-folders-parse nil "curf+") + (list '("onespace") '("twospace") '("precedingblanks") + (cons "withothers" others-position) + '("curf") '("curf") '("curf2+"))))))) + +(ert-deftest mh-sub-folders-parse-relative-folder () + "Test `mh-sub-folders-parse' with folder." + (let (others-position) + (with-temp-buffer + (insert "testf+ has no messages.\n") + (insert "testf/sub1 has no messages.\n") + (insert "testf/sub2 has no messages ; (others)") + (setq others-position (point)) + (insert ".\n") + (should (equal + (mh-sub-folders-parse "+testf" "testf+") + (list '("sub1") (cons "sub2" others-position))))))) + +(ert-deftest mh-sub-folders-parse-root-folder () + "Test `mh-sub-folders-parse' with root folder." + (with-temp-buffer + (insert "/+ has no messages.\n") + (insert "//nmh-style has no messages.\n") + (should (equal + (mh-sub-folders-parse "+/" "inbox+") + '(("nmh-style")))))) + ;; Folder names that are used by the following tests. (defvar mh-test-rel-folder "rela-folder") From e37eb7f5c67f7da2c78688eda8968562fe75b767 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 25 Nov 2021 11:01:19 +0800 Subject: [PATCH 290/367] Add support for pixel wheel deltas on NS * src/xterm.c (x_coalesce_scroll_events): Update doc string. * src/nsterm.c (- mouseDown): Report pixel scroll deltas. (x_coalesce_scroll_events): New variable --- src/nsterm.m | 24 +++++++++++++++++++----- src/xterm.c | 2 +- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index e29dda684a0..17f5b98c571 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6529,6 +6529,7 @@ - (void)mouseDown: (NSEvent *)theEvent { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil]; + int x = 0, y = 0; NSTRACE ("[EmacsView mouseDown:]"); @@ -6595,22 +6596,26 @@ - (void)mouseDown: (NSEvent *)theEvent * reset the total delta for the direction we're NOT * scrolling so that small movements don't add up. */ if (abs (totalDeltaX) > abs (totalDeltaY) - && abs (totalDeltaX) > lineHeight) + && (!x_coalesce_scroll_events + || abs (totalDeltaX) > lineHeight)) { horizontal = YES; scrollUp = totalDeltaX > 0; lines = abs (totalDeltaX / lineHeight); - totalDeltaX = totalDeltaX % lineHeight; + x = totalDeltaX; + totalDeltaX = totalDeltaX % lineHeight; totalDeltaY = 0; } else if (abs (totalDeltaY) >= abs (totalDeltaX) - && abs (totalDeltaY) > lineHeight) + && (!x_coalesce_scroll_events + || abs (totalDeltaY) > lineHeight)) { horizontal = NO; scrollUp = totalDeltaY > 0; lines = abs (totalDeltaY / lineHeight); + y = totalDeltaY; totalDeltaY = totalDeltaY % lineHeight; totalDeltaX = 0; } @@ -6637,13 +6642,17 @@ - (void)mouseDown: (NSEvent *)theEvent ? ceil (fabs (delta)) : 1; scrollUp = delta > 0; + x = [theEvent scrollingDeltaX]; + y = [theEvent scrollingDeltaY]; } - if (lines == 0) + if (lines == 0 && x_coalesce_scroll_events) return; emacs_event->kind = horizontal ? HORIZ_WHEEL_EVENT : WHEEL_EVENT; - emacs_event->arg = (make_fixnum (lines)); + emacs_event->arg = list3 (make_fixnum (lines), + make_float (x), + make_float (y)); emacs_event->code = 0; emacs_event->modifiers = EV_MODIFIERS (theEvent) | @@ -10005,6 +10014,11 @@ Nil means use fullscreen the old (< 10.7) way. The old way works better with x_underline_at_descent_line, doc: /* SKIP: real doc in xterm.c. */); x_underline_at_descent_line = 0; + + DEFVAR_BOOL ("x-coalesce-scroll-events", x_coalesce_scroll_events, + doc: /* SKIP: real doc in xterm.c. */); + x_coalesce_scroll_events = true; + DEFSYM (Qx_underline_at_descent_line, "x-underline-at-descent-line"); /* Tell Emacs about this window system. */ diff --git a/src/xterm.c b/src/xterm.c index 7e0d58745e2..346cd0c38a4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15165,6 +15165,6 @@ always uses gtk_window_move and ignores the value of this variable. */); doc: /* Non-nil means send a wheel event only for scrolling at least one screen line. Otherwise, a wheel event will be sent every time the mouse wheel is moved. This option is only effective when Emacs is built with XInput -2 or with Haiku windowing support. */); +2, with Haiku windowing support, or with NS. */); x_coalesce_scroll_events = true; } From b469a0155140cf0c319963717cb43f2bf43864ec Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 25 Nov 2021 13:20:56 +0800 Subject: [PATCH 291/367] Set serial when filtering XI_KeyPress events This fixes fcitx flicker for whatever reason. * src/xterm.c (handle_one_xevent): Set serial when filtering XI_KeyPress events. --- src/xterm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xterm.c b/src/xterm.c index 346cd0c38a4..0a3aeeed703 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10648,7 +10648,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, memset (&xkey, 0, sizeof xkey); xkey.type = KeyRelease; - xkey.serial = 0; + xkey.serial = xev->serial; xkey.send_event = xev->send_event; xkey.display = xev->display; xkey.window = xev->event; From 588caf0b274e763bab0ac511f2cb95750e83f7f6 Mon Sep 17 00:00:00 2001 From: Narendra Joshi Date: Thu, 25 Nov 2021 09:58:53 +0200 Subject: [PATCH 292/367] * lisp/repeat.el (repeat-post-hook): Add check symbolp rep-map. Copyright-paperwork-exempt: yes --- lisp/repeat.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index 4dcd353e346..32ffb1884f3 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -416,7 +416,7 @@ See `describe-repeat-maps' for a list of all repeatable commands." (and (symbolp real-this-command) (get real-this-command 'repeat-map))))) (when rep-map - (when (boundp rep-map) + (when (and (symbolp rep-map) (boundp rep-map)) (setq rep-map (symbol-value rep-map))) (let ((map (copy-keymap rep-map))) From d1aa552d11484ab15944a1f3c15f607dda811d8d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 25 Nov 2021 10:43:35 +0200 Subject: [PATCH 293/367] ; * CONTRIBUTE: No cleanups on release branches, even in docs. --- CONTRIBUTE | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 8295a8e6ad4..5740004637b 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -342,7 +342,9 @@ Documentation fixes (in doc strings, in manuals, in NEWS, and in comments) should always go to the release branch, if the documentation to be fixed exists and is relevant to the release-branch codebase. Doc fixes are always considered "safe" -- even when a release branch -is in feature freeze, it can still receive doc fixes. +is in feature freeze, it can still receive doc fixes. However, this +rule is limited to fixing real problems in the documentation; cleanups +and stylistic changes are excluded. When you know that the change will be difficult to merge to the master (e.g., because the code on master has changed a lot), you can From 7fea9c8415bd04100be7857a138ad03e5a7ec4aa Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 24 Nov 2021 22:01:21 +0100 Subject: [PATCH 294/367] Define a face for shr text * lisp/net/shr.el (shr-text): New face. (shr-insert): Use it instead of hard-coding `variable-pitch'. --- lisp/net/shr.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 87bacd4fbf8..d59b0ed3629 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -162,6 +162,10 @@ cid: URL as the argument.") (defvar shr-put-image-function #'shr-put-image "Function called to put image and alt string.") +(defface shr-text '((t :inherit variable-pitch)) + "Face used for rendering text." + :version "29.1") + (defface shr-strike-through '((t :strike-through t)) "Face for elements." :version "24.1") @@ -742,7 +746,7 @@ size, and full-buffer size." (when shr-use-fonts (put-text-property font-start (point) 'face - (or shr-current-font 'variable-pitch))))))))) + (or shr-current-font 'shr-text))))))))) (defun shr-fill-lines (start end) (if (<= shr-internal-width 0) From d0ea2a87f4d7a1afbe959fe53099222e120e8858 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 25 Nov 2021 19:02:32 +0800 Subject: [PATCH 295/367] Fix scroll wheel reporting on NS * src/nsterm.m (- mouseDown): Clear scroll wheel accumulators. --- src/nsterm.m | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index 17f5b98c571..80117a41a56 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6604,7 +6604,10 @@ - (void)mouseDown: (NSEvent *)theEvent lines = abs (totalDeltaX / lineHeight); x = totalDeltaX; - totalDeltaX = totalDeltaX % lineHeight; + if (!x_coalesce_scroll_events) + totalDeltaX = 0; + else + totalDeltaX = totalDeltaX % lineHeight; totalDeltaY = 0; } else if (abs (totalDeltaY) >= abs (totalDeltaX) @@ -6616,7 +6619,10 @@ - (void)mouseDown: (NSEvent *)theEvent lines = abs (totalDeltaY / lineHeight); y = totalDeltaY; - totalDeltaY = totalDeltaY % lineHeight; + if (!x_coalesce_scroll_events) + totalDeltaY = 0; + else + totalDeltaY = totalDeltaY % lineHeight; totalDeltaX = 0; } From a22c9a34bd1cc3683b965383a59b4a50e9091776 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 25 Nov 2021 15:06:08 +0200 Subject: [PATCH 296/367] Fix 'posn-at-point' near some overlays * src/xdisp.c (pos_visible_p): Fix 'posn-at-point' for positions just after a display property that draws a fringe bitmap. (Bug#52097) --- src/xdisp.c | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 34add807986..4642541823c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1992,7 +1992,17 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, } *x = top_x; - *y = max (top_y + max (0, it.max_ascent - it.ascent), window_top_y); + /* The condition below is a heuristic fix for the situation + where move_it_to stops just after finishing the display + of a fringe bitmap, which resets it.ascent to zero, and + thus causes Y to be offset by it.max_ascent. */ + if (it.ascent == 0 && it.what == IT_IMAGE + && it.method != GET_FROM_IMAGE + && it.image_id < 0 + && it.max_ascent > 0) + *y = max (top_y, window_top_y); + else + *y = max (top_y + max (0, it.max_ascent - it.ascent), window_top_y); *rtop = max (0, window_top_y - top_y); *rbot = max (0, bottom_y - it.last_visible_y); *rowh = max (0, (min (bottom_y, it.last_visible_y) @@ -2020,7 +2030,13 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, RESTORE_IT (&it2, &it2, it2data); move_it_to (&it2, charpos, -1, -1, -1, MOVE_TO_POS); *x = it2.current_x; - *y = it2.current_y + it2.max_ascent - it2.ascent; + if (it2.ascent == 0 && it2.what == IT_IMAGE + && it2.method != GET_FROM_IMAGE + && it2.image_id < 0 + && it2.max_ascent > 0) + *y = it2.current_y; + else + *y = it2.current_y + it2.max_ascent - it2.ascent; *rtop = max (0, -it2.current_y); *rbot = max (0, ((it2.current_y + it2.max_ascent + it2.max_descent) - it.last_visible_y)); From f1606047c49d86df99c4528abd932d0cdcb2befb Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 25 Nov 2021 14:23:58 +0100 Subject: [PATCH 297/367] Indent `closure' forms better * lisp/emacs-lisp/lisp-mode.el (closure): Indent `closure' forms better (bug#52063). --- lisp/emacs-lisp/lisp-mode.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index d90d0f5f6ac..416d64558d9 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1308,6 +1308,7 @@ Lisp function does not specify a special indentation." (put 'handler-bind 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) +(put 'closure 'lisp-indent-function 2) (defun indent-sexp (&optional endpos) "Indent each line of the list starting just after point. From 6e5fd99139bb82b384ad27a8097938ea934f512d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 25 Nov 2021 15:14:22 +0100 Subject: [PATCH 298/367] Add temporary mode-line-position change * lisp/bindings.el (mode-line-position): Add interim solution to make `min-width' work here; this should be fixed for real in the display_line machinery somewhere. --- lisp/bindings.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index 29a1baffe7b..e28b06a1dcd 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -501,7 +501,7 @@ mouse-1: Display Line and Column Mode Menu")) (defvar mode-line-position `((:propertize - mode-line-percent-position + (" " mode-line-percent-position) local-map ,mode-line-column-line-number-mode-map display (min-width (5.0)) mouse-face mode-line-highlight From 4d16a2f7373a8d328f589b61ade3a2da7275501e Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 25 Nov 2021 15:29:00 +0100 Subject: [PATCH 299/367] Fix pdf generation with Texinfo 6.7 * doc/lispref/display.texi (Size of Displayed Text): Put @group inside @example (bug#52102). --- doc/lispref/display.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 386d51a91a5..b1fb9f8b956 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2026,14 +2026,14 @@ means hide the excess parts of @var{string} with a @code{display} text property (@pxref{Display Property}) showing the ellipsis, instead of actually truncating the string. -@group @example +@group (truncate-string-to-width "\tab\t" 12 4) @result{} "ab" (truncate-string-to-width "\tab\t" 12 4 ?\s) @result{} " ab " -@end example @end group +@end example This function uses @code{string-width} and @code{char-width} to find the suitable truncation point when @var{string} is too wide, so it From 1b12af26ea1d552629799ddb4fccdd9df3180ac5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 25 Nov 2021 16:24:19 +0100 Subject: [PATCH 300/367] Tag a test from process-tests.el as :unstable on emba. * test/src/process-tests.el (process-tests/multiple-threads-waiting): Tag it as :unstable on emba. --- test/src/process-tests.el | 1 + 1 file changed, 1 insertion(+) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index b831ca3bdaa..f14a460d1a5 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -787,6 +787,7 @@ have written output." (list (list process "finished\n")))))))))) (ert-deftest process-tests/multiple-threads-waiting () + :tags (if (getenv "EMACS_EMBA_CI") '(:unstable)) (skip-unless (fboundp 'make-thread)) (with-timeout (60 (ert-fail "Test timed out")) (process-tests--with-processes processes From 223c956fc6568864440fd5bc70b7f4321e0c0fb2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 25 Nov 2021 16:44:12 +0100 Subject: [PATCH 301/367] ; * admin/MAINTAINERS: Add test/infra/* --- admin/MAINTAINERS | 1 + 1 file changed, 1 insertion(+) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index b881e76e25a..33aeb528651 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -231,6 +231,7 @@ Michael Albinus lisp/net/ange-ftp.el lisp/notifications.el lisp/shadowfile.el + test/infra/* test/lisp/autorevert-tests.el test/lisp/files-tests.el (file-name-non-special) test/lisp/shadowfile-tests.el From 3dcb629f6ac227eb0f9ca46203035b16bf387911 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 25 Nov 2021 15:55:40 +0100 Subject: [PATCH 302/367] Don't display redundant 'see' in info-mode * lisp/info.el (Info-fontify-node): Don't show 'see' when displaying the result of "(See @ref" or "also @ref", but leave "Also @ref" alone. --- lisp/info.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/info.el b/lisp/info.el index cd4c867f4e6..94537c2417a 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4896,9 +4896,16 @@ first line or header line, and for breadcrumb links.") ;; an end of sentence (skip-syntax-backward " (")) (setq other-tag - (cond ((save-match-data (looking-back "\\(^\\| \\)see" + (cond ((save-match-data (looking-back "\\(^\\|[ (]\\)see" (- (point) 4))) "") + ;; We want "Also *note" to produce + ;; "Also see", but "See also *note" to produce + ;; "See also", so match case-sensitively. + ((save-match-data (let ((case-fold-search nil)) + (looking-back "\\(^\\| \\)also" + (- (point) 5)))) + "") ((save-match-data (looking-back "\\(^\\| \\)in" (- (point) 3))) "") From b711847f59143724c6c13102a08df141e4bf5589 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 25 Nov 2021 17:53:27 +0100 Subject: [PATCH 303/367] * doc/misc/flymake.texi: Correct local variable mode specification --- doc/misc/flymake.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 5f02a1568e2..ca464aff665 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -1,4 +1,4 @@ -\input texinfo @c -*-texinfo; coding: utf-8 -*- +\input texinfo @c -*- mode: texinfo; coding: utf-8 -*- @comment %**start of header @setfilename ../../info/flymake.info @set VERSION 1.2 From 96f58718a043bb50408592aa1975721396de274e Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 25 Nov 2021 18:07:04 +0100 Subject: [PATCH 304/367] Correct the :inherit property on some faces Otherwise M-x customize-face will show them as lisp-expressions rather than nice widgets. * lisp/ansi-color.el (ansi-color-bold): (ansi-color-italic): (ansi-color-underline): * lisp/faces.el (mode-line): Don't quote the face we're inheriting from. --- lisp/ansi-color.el | 6 +++--- lisp/faces.el | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 2e51264ec39..c962cbd4780 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -91,7 +91,7 @@ as a PDF file." :group 'processes) (defface ansi-color-bold - '((t :inherit 'bold)) + '((t :inherit bold)) "Face used to render bold text." :group 'ansi-colors :version "28.1") @@ -103,13 +103,13 @@ as a PDF file." :version "28.1") (defface ansi-color-italic - '((t :inherit 'italic)) + '((t :inherit italic)) "Face used to render italic text." :group 'ansi-colors :version "28.1") (defface ansi-color-underline - '((t :inherit 'underline)) + '((t :inherit underline)) "Face used to render underlined text." :group 'ansi-colors :version "28.1") diff --git a/lisp/faces.el b/lisp/faces.el index e9f795caad2..38feefba480 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2611,11 +2611,11 @@ non-nil." (defface mode-line '((((class color) (min-colors 88)) :box (:line-width -1 :style released-button) - :inherit 'variable-pitch + :inherit variable-pitch :background "grey75" :foreground "black") (t :inverse-video t - :inherit 'variable-pitch)) + :inherit variable-pitch)) "Basic mode line face for selected window." :version "21.1" :group 'mode-line-faces From d24ad504fcc342725febc187e17d6b69cc527b6b Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Thu, 25 Nov 2021 10:12:30 -0800 Subject: [PATCH 305/367] MH-E: support Mailutils "folders +/" * lisp/mh-e/mh-utils.el (mh-sub-folders-parse): Support Mailutils style of "folders +/" output. * test/lisp/mh-e/mh-utils.el: Test "folders +/" with GNU Mailutils 3.13.91 and later. --- lisp/mh-e/mh-utils.el | 7 +++++++ test/lisp/mh-e/mh-utils-tests.el | 11 +++++++---- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index ad23bd19118..b75025d6a4d 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -592,10 +592,14 @@ This function is a testable helper of `mh-sub-folders-actual'." (cl-incf start-pos)) (let* ((name (buffer-substring start-pos has-pos)) (first-char (aref name 0)) + (second-char (and (length> name 1) (aref name 1))) (last-char (aref name (1- (length name))))) (unless (member first-char '(?. ?# ?,)) (when (and (equal last-char ?+) (equal name current-folder)) (setq name (substring name 0 (1- (length name))))) + ;; nmh outputs double slash in root folder, e.g., "//tmp" + (when (and (equal first-char ?/) (equal second-char ?/)) + (setq name (substring name 1))) (push (cons name (search-forward "(others)" (line-end-position) t)) @@ -605,6 +609,9 @@ This function is a testable helper of `mh-sub-folders-actual'." (when (stringp folder) (setq results (cdr results)) (let ((folder-name-len (length (format "%s/" (substring folder 1))))) + (when (equal "+/" folder) + ;; folder "+/" includes a trailing slash + (cl-decf folder-name-len)) (setq results (mapcar (lambda (f) (cons (substring (car f) folder-name-len) (cdr f))) diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index 83949204a6e..f282a0b08f3 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -121,10 +121,12 @@ "Test `mh-sub-folders-parse' with root folder." (with-temp-buffer (insert "/+ has no messages.\n") + (insert "/ has no messages.\n") (insert "//nmh-style has no messages.\n") + (insert "/mu-style has no messages.\n") (should (equal (mh-sub-folders-parse "+/" "inbox+") - '(("nmh-style")))))) + '(("") ("nmh-style") ("mu-style")))))) ;; Folder names that are used by the following tests. @@ -259,8 +261,8 @@ The tests use this method if no configured MH variant is found." "/abso-folder/food has no messages.")) (("folders" "-noheader" "-norecurse" "-nototal" "+/") . ("/+ has no messages ; (others)." - "//abso-folder has no messages ; (others)." - "//tmp has no messages ; (others).")) + "/abso-folder has no messages ; (others)." + "/tmp has no messages ; (others).")) )) (arglist (cons (file-name-base program) args))) (let ((response-list-cons (assoc arglist argument-responses))) @@ -358,7 +360,8 @@ if `mh-test-utils-debug-mocks' is non-nil." Mailutils 3.5, 3.7, and 3.13 are known not to." (cond ((not (stringp variant))) ;our mock handles it ((string-search "GNU Mailutils" variant) - nil) + (let ((mu-version (string-remove-prefix "GNU Mailutils " variant))) + (version<= "3.13.91" mu-version))) (t))) ;no other known failures From 7f14723aa2b6c89f4e2e3895ff0fb1b931f83755 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 25 Nov 2021 20:17:58 +0200 Subject: [PATCH 306/367] ; * etc/NEWS: Fix entry about reverting to old 'mode-line' face. --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 8b7c2f78508..da56d0a338a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -81,7 +81,7 @@ To get the old monospaced mode line back, customize the 'mode-line' face not to inherit from the 'variable-pitch' face, or add this to your ~/.emacs: - (set-face-attribute 'mode-line t :inherit nil) + (set-face-attribute 'mode-line nil :inherit 'default) +++ ** New function 'buffer-text-pixel-size'. From 0c44b8edb4778bbbc536d67b617e93a152b948de Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 25 Nov 2021 20:54:07 +0200 Subject: [PATCH 307/367] Fix handling of '--dump-file' command-line option * lisp/startup.el (command-line-1): Handle "--dump-file" and "--seccomp" if they are left on the command-line. (Bug#52106) --- lisp/startup.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/startup.el b/lisp/startup.el index e1106419f10..fc085e6d0ef 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2393,6 +2393,7 @@ A fancy display is used on graphic displays, normal otherwise." ;; and long versions of what's on command-switch-alist. (longopts (append '("--funcall" "--load" "--insert" "--kill" + "--dump-file" "--seccomp" "--directory" "--eval" "--execute" "--no-splash" "--find-file" "--visit" "--file" "--no-desktop") (mapcar (lambda (elt) (concat "-" (car elt))) @@ -2554,6 +2555,11 @@ nil default-directory" name) (error "File name omitted from `-insert' option")) (insert-file-contents (command-line-normalize-file-name tem))) + ((or (equal argi "-dump-file") + (equal argi "-seccomp")) + ;; This was processed in C. + (or argval (pop command-line-args-left))) + ((equal argi "-kill") (kill-emacs t)) From 92d1bb3e38324ccd7ecdac7392801a223cf4e7af Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Thu, 25 Nov 2021 20:05:21 +0100 Subject: [PATCH 308/367] * src/emacs.c (usage_message): Fix name of --seccomp option. --- src/emacs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/emacs.c b/src/emacs.c index ad409c2887b..7ae52b1f9a0 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -265,7 +265,7 @@ Initialization options:\n\ #endif #if SECCOMP_USABLE "\ ---sandbox=FILE read Seccomp BPF filter from FILE\n\ +--seccomp=FILE read Seccomp BPF filter from FILE\n\ " #endif "\ From aa3a74d9a1173438ab351909441e50439f66b1e2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 25 Nov 2021 21:29:21 +0200 Subject: [PATCH 309/367] Update 'custom-face-attributes' * lisp/cus-face.el (custom-face-attributes): Synchronize with tables in font.c. --- lisp/cus-face.el | 34 ++++++++++++++++++++++++++-------- 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 5037ee77c7c..16fa55e8268 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -54,6 +54,7 @@ (string :tag "Font Foundry" :help-echo "Font foundry name.")) + ;; The width, weight, and slant should be in sync with font.c. (:width (choice :tag "Width" :help-echo "Font width." @@ -63,15 +64,22 @@ (const :tag "demiexpanded" semi-expanded) (const :tag "expanded" expanded) (const :tag "extracondensed" extra-condensed) + (const :tag "extra-condensed" extra-condensed) (const :tag "extraexpanded" extra-expanded) + (const :tag "extra-expanded" extra-expanded) (const :tag "medium" normal) (const :tag "narrow" condensed) (const :tag "normal" normal) + (const :tag "medium" normal) (const :tag "regular" normal) (const :tag "semicondensed" semi-condensed) + (const :tag "demicondensed" semi-condensed) + (const :tag "semi-condensed" semi-condensed) (const :tag "semiexpanded" semi-expanded) (const :tag "ultracondensed" ultra-condensed) + (const :tag "ultra-condensed" ultra-condensed) (const :tag "ultraexpanded" ultra-expanded) + (const :tag "ultra-expanded" ultra-expanded) (const :tag "wide" extra-expanded))) (:height @@ -85,22 +93,32 @@ (choice :tag "Weight" :help-echo "Font weight." :value normal ; default - (const :tag "ultralight" ultra-light) - (const :tag "extralight" extra-light) - (const :tag "light" light) (const :tag "thin" thin) + (const :tag "ultralight" ultra-light) + (const :tag "ultra-light" ultra-light) + (const :tag "extralight" ultra-light) + (const :tag "extra-light" ultra-light) + (const :tag "light" light) (const :tag "semilight" semi-light) - (const :tag "book" semi-light) + (const :tag "semi-light" semi-light) + (const :tag "demilight" semi-light) (const :tag "normal" normal) (const :tag "regular" normal) - (const :tag "medium" normal) + (const :tag "book" normal) + (const :tag "medium" medium) (const :tag "semibold" semi-bold) + (const :tag "semi-bold" semi-bold) (const :tag "demibold" semi-bold) + (const :tag "demi-bold" semi-bold) (const :tag "bold" bold) (const :tag "extrabold" extra-bold) - (const :tag "heavy" extra-bold) - (const :tag "ultrabold" ultra-bold) - (const :tag "black" ultra-bold))) + (const :tag "extra-bold" extra-bold) + (const :tag "ultrabold" extra-bold) + (const :tag "ultra-bold" extra-bold) + (const :tag "heavy" heavy) + (const :tag "black" heavy) + (const :tag "ultra-heavy" ultra-heavy) + (const :tag "ultraheavy" ultra-heavy))) (:slant (choice :tag "Slant" From 4cd6bc88090d75df54ef5af684c21454954e1cd3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 25 Nov 2021 21:55:38 +0200 Subject: [PATCH 310/367] ; * src/font.c: Comment about synchronizing with cus-face.el. --- src/font.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/font.c b/src/font.c index d423fd46b70..d780d781f62 100644 --- a/src/font.c +++ b/src/font.c @@ -60,6 +60,8 @@ struct table_entry const char *names[6]; }; +/* The following tables should be in sync with 'custom-face-attributes'. */ + /* Table of weight numeric values and their names. This table must be sorted by numeric values in ascending order and the numeric values must approximately match the weights in the font files. */ From cfaf681d3d292ceccc89c0eaaa47827665115dc6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 25 Nov 2021 22:31:47 +0200 Subject: [PATCH 311/367] ; * src/emacs.c (main): Add commentary about command-line processing. --- src/emacs.c | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/src/emacs.c b/src/emacs.c index 41c92a46155..c99b007ea78 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1342,6 +1342,39 @@ main (int argc, char **argv) init_standard_fds (); atexit (close_output_streams); + /* Command-line argument processing. + + The arguments in the argv[] array are sorted in the descending + order of their priority as defined in the standard_args[] array + below. Then the sorted arguments are processed from the highest + to the lowest priority. Each command-line argument that is + recognized by 'main', if found in argv[], causes skip_args to be + incremented, effectively removing the processed argument from the + command line. + + Then init_cmdargs is called, and conses a list of the unprocessed + command-line arguments, as strings, in 'command-line-args'. It + ignores all the arguments up to the one indexed by skip_args, as + those were already processed. + + The arguments in 'command-line-args' are further processed by + startup.el, functions 'command-line' and 'command-line-1'. The + first of them handles the arguments which need to be processed + before loading the user init file and initializing the + window-system. The second one processes the arguments that are + related to the GUI system, like -font, -geometry, and -title, and + then processes the rest of arguments whose priority is below + those that are related to the GUI system. The arguments + porcessed by 'command-line' are removed from 'command-line-args'; + the arguments processed by 'command-line-1' aren't, they are only + removed from 'command-line-args-left'. + + 'command-line-1' emits an error message for any argument it + doesn't recognize, so any command-line arguments processed in C + below whose priority is below the GUI system related switches + should be explicitly recognized, ignored, and removed from + 'command-line-args-left' in 'command-line-1'. */ + sort_args (argc, argv); argc = 0; while (argv[argc]) argc++; From 9d37be35227fcb419e7b52978f8d5a8b1379567f Mon Sep 17 00:00:00 2001 From: Alan Third Date: Thu, 25 Nov 2021 20:58:37 +0000 Subject: [PATCH 312/367] Fix selection for old GNUstep and GCC * src/nsselect.m (ns_get_foreign_selection): Remove language features not yet supported by GCC. Be more selective with which pasteboard types we use. * src/nsterm.h: Set up some more #defines for deprecated variables. --- src/nsselect.m | 12 ++++++++---- src/nsterm.h | 9 +++++++++ 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/src/nsselect.m b/src/nsselect.m index e999835014d..8b23f6f51ad 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -215,7 +215,7 @@ Updated by Christian Limpach (chris@nice.ch) static Lisp_Object ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target) { - NSDictionary *typeLookup; + NSDictionary *typeLookup; id pb; pb = ns_symbol_to_pb (symbol); @@ -229,10 +229,14 @@ Updated by Christian Limpach (chris@nice.ch) #else @"text/plain", NSFilenamesPboardType, #endif - @"text/html", NSPasteboardTypeHTML, +#ifdef NS_IMPL_COCOA + /* FIXME: I believe these are actually available in recent + versions of GNUstep. */ @"text/plain", NSPasteboardTypeMultipleTextSelection, - @"application/pdf", NSPasteboardTypePDF, @"image/png", NSPasteboardTypePNG, +#endif + @"text/html", NSPasteboardTypeHTML, + @"application/pdf", NSPasteboardTypePDF, @"application/rtf", NSPasteboardTypeRTF, @"application/rtfd", NSPasteboardTypeRTFD, @"STRING", NSPasteboardTypeString, @@ -272,7 +276,7 @@ Updated by Christian Limpach (chris@nice.ch) = [typeLookup allKeysForObject: [NSString stringWithLispString:SYMBOL_NAME (target)]]; else - availableTypes = @[NSPasteboardTypeString]; + availableTypes = [NSArray arrayWithObject:NSPasteboardTypeString]; t = [pb availableTypeFromArray:availableTypes]; diff --git a/src/nsterm.h b/src/nsterm.h index 8175f996644..a32b8fe149c 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1346,9 +1346,18 @@ enum NSWindowTabbingMode #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_14) /* Deprecated in macOS 10.14. */ +/* FIXME: Some of these new names, if not all, are actually available + in some recent version of GNUstep. */ #define NSPasteboardTypeString NSStringPboardType #define NSPasteboardTypeTabularText NSTabularTextPboardType #define NSPasteboardTypeURL NSURLPboardType +#define NSPasteboardTypeHTML NSHTMLPboardType +#define NSPasteboardTypeMultipleTextSelection NSMultipleTextSelectionPboardType +#define NSPasteboardTypePDF NSPDFPboardType +#define NSPasteboardTypePNG NSPNGPboardType +#define NSPasteboardTypeRTF NSRTFPboardType +#define NSPasteboardTypeRTFD NSRTFDPboardType +#define NSPasteboardTypeTIFF NSTIFFPboardType #define NSControlStateValueOn NSOnState #define NSControlStateValueOff NSOffState #define NSBezelStyleRounded NSRoundedBezelStyle From db3fbe884fb992376a6e00f2a051e5de9579df85 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 08:41:39 +0800 Subject: [PATCH 313/367] Add `better-pixel-scroll-mode' * etc/NEWS: Announce `better-pixel-scroll-mode'. * lisp/better-pixel-scroll.el: New file. --- etc/NEWS | 6 ++ lisp/better-pixel-scroll.el | 145 ++++++++++++++++++++++++++++++++++++ 2 files changed, 151 insertions(+) create mode 100644 lisp/better-pixel-scroll.el diff --git a/etc/NEWS b/etc/NEWS index da56d0a338a..329de2f8110 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -93,6 +93,12 @@ buffer isn't displayed. This controls the thickness of the external borders of the menu bars and pop-up menus. +--- +** New minor mode 'better-pixel-scroll-mode'. +When enabled, using this mode with a capable scroll wheel will result +in the display being scrolled precisely according to the turning of +that wheel. + ** Terminal Emacs --- diff --git a/lisp/better-pixel-scroll.el b/lisp/better-pixel-scroll.el new file mode 100644 index 00000000000..ac342a425a2 --- /dev/null +++ b/lisp/better-pixel-scroll.el @@ -0,0 +1,145 @@ +;;; better-pixel-scroll.el --- Pixel scrolling support -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This enables the use of smooth scroll events provided by XInput 2 +;; or NS to scroll the display according to the user's precise turning +;; of the mouse wheel. + +;;; Code: + +(require 'mwheel) +(require 'subr-x) + +(defvar x-coalesce-scroll-events) + +(defvar better-pixel-scroll-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [wheel-down] #'better-pixel-scroll) + (define-key map [wheel-up] #'better-pixel-scroll) + map) + "The key map used by `better-pixel-scroll-mode'.") + +(defun better-pixel-scroll-scroll-down (delta) + "Scroll the current window down by DELTA pixels. +Note that this function doesn't work if DELTA is larger than +the height of the current window." + (when-let* ((posn (posn-at-point)) + (current-y (cdr (posn-x-y posn))) + (min-y (+ (window-tab-line-height) + (window-header-line-height))) + (cursor-height (line-pixel-height)) + (window-height (window-text-height nil t)) + (next-height (save-excursion + (vertical-motion 1) + (line-pixel-height)))) + (if (and (> delta 0) + (<= cursor-height window-height)) + (while (< (- current-y min-y) delta) + (vertical-motion 1) + (setq current-y (+ current-y + (line-pixel-height))) + (when (eobp) + (error "End of buffer"))) + (when (< (- (cdr (posn-object-width-height posn)) + (cdr (posn-object-x-y posn))) + (- window-height next-height)) + (vertical-motion 1) + (setq posn (posn-at-point) + current-y (cdr (posn-x-y posn))) + (while (< (- current-y min-y) delta) + (vertical-motion 1) + (setq current-y (+ current-y + (line-pixel-height))) + (when (eobp) + (error "End of buffer"))))) + (let* ((desired-pos (posn-at-x-y 0 (+ delta + (window-tab-line-height) + (window-header-line-height)))) + (desired-start (posn-point desired-pos)) + (desired-vscroll (cdr (posn-object-x-y desired-pos)))) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))) + +(defun better-pixel-scroll-scroll-up (delta) + "Scroll the current window up by DELTA pixels." + (when-let* ((max-y (- (window-text-height nil t) + (window-tab-line-height) + (window-header-line-height))) + (posn (posn-at-point)) + (current-y (+ (cdr (posn-x-y posn)) + (cdr (posn-object-width-height posn))))) + (while (< (- max-y current-y) delta) + (when (zerop (vertical-motion -1)) + (set-window-vscroll nil 0) + (signal 'beginning-of-buffer nil)) + (setq current-y (- current-y (line-pixel-height))))) + (while (> delta 0) + (set-window-start nil (save-excursion + (goto-char (window-start)) + (when (zerop (vertical-motion -1)) + (set-window-vscroll nil 0) + (signal 'beginning-of-buffer nil)) + (setq delta (- delta (line-pixel-height))) + (point)) + t)) + (when (< delta 0) + (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) + (window-tab-line-height) + (window-header-line-height)))) + (desired-start (posn-point desired-pos)) + (desired-vscroll (cdr (posn-object-x-y desired-pos)))) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))) + +(defun better-pixel-scroll (event &optional arg) + "Scroll the display according to EVENT. +Take into account any pixel deltas in EVENT to scroll the display +according to the user's turning the mouse wheel. If EVENT does +not have precise scrolling deltas, call `mwheel-scroll' instead. +ARG is passed to `mwheel-scroll', should that be called." + (interactive (list last-input-event current-prefix-arg)) + (if (nth 4 event) + (let ((delta (round (cdr (nth 4 event)))) + (window (mwheel-event-window event))) + (if (> (abs delta) (window-text-height window t)) + (mwheel-scroll event arg) + (with-selected-window window + (if (< delta 0) + (better-pixel-scroll-scroll-down (- delta)) + (better-pixel-scroll-scroll-up delta))))) + (mwheel-scroll event arg))) + +;;;###autoload +(define-minor-mode better-pixel-scroll-mode + "Toggle pixel scrolling. +When enabled, this minor mode allows to scroll the display +precisely, according to the turning of the mouse wheel." + :global t + :group 'mouse + :keymap better-pixel-scroll-mode-map + (setq x-coalesce-scroll-events + (not better-pixel-scroll-mode))) + +(provide 'better-pixel-scroll) + +;;; better-pixel-scroll.el ends here. From fc8b87d904f63a73c3bb4db69341f0308b2bc8fa Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 13:07:54 +0800 Subject: [PATCH 314/367] Don't perform pixel scrolling when window is hscrolled * lisp/better-pixel-scroll.el (better-pixel-scroll): Call mwheel-scroll instead if window is hscrolled. --- lisp/better-pixel-scroll.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/better-pixel-scroll.el b/lisp/better-pixel-scroll.el index ac342a425a2..6101778ac0a 100644 --- a/lisp/better-pixel-scroll.el +++ b/lisp/better-pixel-scroll.el @@ -118,16 +118,17 @@ according to the user's turning the mouse wheel. If EVENT does not have precise scrolling deltas, call `mwheel-scroll' instead. ARG is passed to `mwheel-scroll', should that be called." (interactive (list last-input-event current-prefix-arg)) - (if (nth 4 event) - (let ((delta (round (cdr (nth 4 event)))) - (window (mwheel-event-window event))) - (if (> (abs delta) (window-text-height window t)) - (mwheel-scroll event arg) - (with-selected-window window + (let ((window (mwheel-event-window event))) + (if (and (nth 4 event) + (zerop (window-hscroll window))) + (let ((delta (round (cdr (nth 4 event))))) + (if (> (abs delta) (window-text-height window t)) + (mwheel-scroll event arg) + (with-selected-window window (if (< delta 0) (better-pixel-scroll-scroll-down (- delta)) (better-pixel-scroll-scroll-up delta))))) - (mwheel-scroll event arg))) + (mwheel-scroll event arg)))) ;;;###autoload (define-minor-mode better-pixel-scroll-mode From 897a101cd3b7d6b46e3b14e80e3c77373246be6a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 13:21:48 +0800 Subject: [PATCH 315/367] Make pixel scrolling through images at the first line smoother * lisp/better-pixel-scroll.el (better-pixel-scroll-scroll-up): Try to reset vscroll if already vscrolled. --- lisp/better-pixel-scroll.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/better-pixel-scroll.el b/lisp/better-pixel-scroll.el index 6101778ac0a..c1469108e05 100644 --- a/lisp/better-pixel-scroll.el +++ b/lisp/better-pixel-scroll.el @@ -88,10 +88,11 @@ the height of the current window." (current-y (+ (cdr (posn-x-y posn)) (cdr (posn-object-width-height posn))))) (while (< (- max-y current-y) delta) - (when (zerop (vertical-motion -1)) - (set-window-vscroll nil 0) - (signal 'beginning-of-buffer nil)) + (vertical-motion -1) (setq current-y (- current-y (line-pixel-height))))) + (let ((current-vscroll (window-vscroll nil t))) + (setq delta (- delta current-vscroll)) + (set-window-vscroll nil 0 t)) (while (> delta 0) (set-window-start nil (save-excursion (goto-char (window-start)) From 8887213dcf502269fb81deda640a204a801b602c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 13:33:39 +0800 Subject: [PATCH 316/367] Make tab bar option visible in the menu bar on NS * lisp/menu-bar.el (menu-bar-showhide-menu): Make `showhide-tab-bar' visible on NS as well. --- lisp/menu-bar.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 274f594f69e..8c04e35a51f 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1347,14 +1347,13 @@ mail status in mode line")) (frame-parameter (menu-bar-frame-for-menubar) 'menu-bar-lines))))) - (unless (featurep 'ns) - (bindings--define-key menu [showhide-tab-bar] - '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame - :help "Turn tab bar on/off" - :button - (:toggle . (menu-bar-positive-p - (frame-parameter (menu-bar-frame-for-menubar) - 'tab-bar-lines)))))) + (bindings--define-key menu [showhide-tab-bar] + '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame + :help "Turn tab bar on/off" + :button + (:toggle . (menu-bar-positive-p + (frame-parameter (menu-bar-frame-for-menubar) + 'tab-bar-lines))))) (if (and (boundp 'menu-bar-showhide-tool-bar-menu) (keymapp menu-bar-showhide-tool-bar-menu)) From 09c28ca073e3d4fb68fb7685d6e6ce6dd521fd0e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 06:13:27 +0000 Subject: [PATCH 317/367] Fix sign of pixel scroll events on Haiku * src/haikuterm.c (haiku_read_socket): Fix sign of scroll events. --- src/haikuterm.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/haikuterm.c b/src/haikuterm.c index 97dbe3c8d38..6bf45894065 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3033,8 +3033,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) XSETINT (inev.x, x); XSETINT (inev.y, y); - inev.arg = list3 (Qnil, make_float (px), - make_float (py)); + inev.arg = list3 (Qnil, make_float (-px), + make_float (-py)); XSETFRAME (inev.frame_or_window, f); inev.modifiers |= (signbit (inev.kind == HORIZ_WHEEL_EVENT From 3e40a56d52b932fa13d3093e15e39277a6684fec Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Fri, 26 Nov 2021 09:35:25 +0100 Subject: [PATCH 318/367] ; * lisp/cus-face.el: Remove duplicated width entry. --- lisp/cus-face.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 16fa55e8268..f83f1a2daa0 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -67,7 +67,6 @@ (const :tag "extra-condensed" extra-condensed) (const :tag "extraexpanded" extra-expanded) (const :tag "extra-expanded" extra-expanded) - (const :tag "medium" normal) (const :tag "narrow" condensed) (const :tag "normal" normal) (const :tag "medium" normal) From c56e05b968d437b807a194ecdcd308b045143846 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 17:42:51 +0800 Subject: [PATCH 319/367] Make XInput 2 builds work without cairo * src/xterm.c: Move some defines around so XI2 code doesn't get ifdef'd out if Cairo is disabled. --- src/xterm.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/xterm.c b/src/xterm.c index 0a3aeeed703..821c92c4dda 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -345,6 +345,7 @@ x_extension_initialize (struct x_display_info *dpyinfo) dpyinfo->ext_codes = ext_codes; } +#endif /* HAVE_CAIRO */ #ifdef HAVE_XINPUT2 @@ -564,6 +565,8 @@ xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id) #endif +#ifdef USE_CAIRO + void x_cr_destroy_frame_context (struct frame *f) { From 824d31e3bf22d57bc8f8011e6719b15059bea55b Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 26 Nov 2021 16:03:30 +0300 Subject: [PATCH 320/367] Remove empty lines from stash read prompt * lisp/vc/vc-git.el (vc-git-stash-read): Pass OMIT-NULLS (bug#52119). (vc-git-stash-list): Simplify. --- lisp/vc/vc-git.el | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 2d35061b269..4b6cd930744 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1688,7 +1688,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (let ((stash (completing-read prompt (split-string - (or (vc-git--run-command-string nil "stash" "list") "") "\n") + (or (vc-git--run-command-string nil "stash" "list") "") "\n" t) nil :require-match nil 'vc-git-stash-read-history))) (if (string-equal stash "") (user-error "Not a stash") @@ -1733,12 +1733,11 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (defun vc-git-stash-list () (when-let ((out (vc-git--run-command-string nil "stash" "list"))) - (delete - "" - (split-string - (replace-regexp-in-string - "^stash@" " " out) - "\n")))) + (split-string + (replace-regexp-in-string + "^stash@" " " out) + "\n" + t))) (defun vc-git-stash-get-at-point (point) (save-excursion From 673eadaeb55de71016fab371613d8e930f6d7c04 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 19:59:54 +0800 Subject: [PATCH 321/367] Explain confusing aspects of XInput 2 scroll wheel reporting * src/xterm.c (x_init_master_valuators): Explain how XInput 2 reports scroll wheel movement. (handle_one_xevent): Explain why XI2 scroll valuators are reset after each enter events. --- src/xterm.c | 43 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 42 insertions(+), 1 deletion(-) diff --git a/src/xterm.c b/src/xterm.c index 821c92c4dda..c7950c6f9fc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -372,6 +372,29 @@ x_free_xi_devices (struct x_display_info *dpyinfo) unblock_input (); } +/* The code below handles the tracking of scroll valuators on XInput + 2, in order to support scroll wheels that report information more + granular than a screen line. + + On X, when the XInput 2 extension is being utilized, the states of + the mouse wheels in each axis are stored as absolute values inside + "valuators" attached to each mouse device. To obtain the delta of + the scroll wheel from a motion event (which is used to report that + some valuator has changed), it is necessary to iterate over every + valuator that changed, and compare its previous value to the + current value of the valuator. + + Each individual valuator also has an "interval", which is the + amount you must divide that delta by in order to obtain a delta in + the terms of scroll units. + + This delta however is still intermediate, to make driver + implementations easier. The XInput developers recommend (and most + programs use) the following algorithm to convert from scroll unit + deltas to pixel deltas: + + pixels_scrolled = pow (window_height, 2.0 / 3.0) * delta; */ + /* Setup valuator tracking for XI2 master devices on DPYINFO->display. */ @@ -9874,6 +9897,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_display_set_last_user_time (dpyinfo, xi_event->time); x_detect_focus_change (dpyinfo, any, event, &inev.ie); + /* One problem behind the design of XInput 2 scrolling is + that valuators are not unique to each window, but only + the window that has grabbed the valuator's device or + the window that the device's pointer is on top of can + receive motion events. There is also no way to + retrieve the value of a valuator outside of each motion + event. + + As such, to prevent wildly inaccurate results when the + valuators have changed outside Emacs, we reset our + records of each valuator's value whenever the pointer + re-enters a frame after its valuators have potentially + been changed elsewhere. */ if (enter->detail != XINotifyInferior && enter->mode != XINotifyPassiveUngrab && enter->mode != XINotifyUngrab && any) @@ -9947,6 +9983,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, struct xi_scroll_valuator_t *val; double delta, scroll_unit; + + /* See the comment on top of + x_init_master_valuators for more details on how + scroll wheel movement is reported on XInput 2. */ delta = x_get_scroll_valuator_delta (dpyinfo, xev->deviceid, i, *values, &val); @@ -9972,7 +10012,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; } - scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); found_valuator = true; if (signbit (delta) != signbit (val->emacs_value)) @@ -9999,6 +10038,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, |= x_x_to_emacs_modifiers (dpyinfo, xev->mods.effective); + scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); + if (val->horizontal) { inev.ie.arg From 5d6e1c749a669d33db2936b106ae41ce59473ea1 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 17:42:45 +0800 Subject: [PATCH 322/367] Move the precision pixel scrolling feature to pixel-scroll.el * etc/NEWS: Update NEWS entry for 'pixel-scroll-precision-mode' * lisp/better-pixel-scroll.el: Remove file. * src/pixel-scroll.el (x-coalesce-scroll-events): New variable declaration. (pixel-scroll-precision-mode-map): New variable. (pixel-scroll-precision-scroll-down): (pixel-scroll-precision-scroll-up): (pixel-scroll-precision): New functions. (pixel-scroll-precision-mode): New minor mode. --- etc/NEWS | 10 ++- lisp/better-pixel-scroll.el | 147 ------------------------------------ lisp/pixel-scroll.el | 121 +++++++++++++++++++++++++++++ 3 files changed, 127 insertions(+), 151 deletions(-) delete mode 100644 lisp/better-pixel-scroll.el diff --git a/etc/NEWS b/etc/NEWS index 329de2f8110..3a0b46d3993 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -94,10 +94,12 @@ This controls the thickness of the external borders of the menu bars and pop-up menus. --- -** New minor mode 'better-pixel-scroll-mode'. -When enabled, using this mode with a capable scroll wheel will result -in the display being scrolled precisely according to the turning of -that wheel. +** New minor mode 'pixel-scroll-precision-mode'. +When enabled, you can scroll the display up or down by individual +pixels in a way that corresponds with the movement of your mouse +wheel, if supported by the mouse wheel. Unlike 'pixel-scroll-mode', +this mode scrolls the display pixel-by-pixel, as opposed to only +animating line-by-line scrolls. ** Terminal Emacs diff --git a/lisp/better-pixel-scroll.el b/lisp/better-pixel-scroll.el deleted file mode 100644 index c1469108e05..00000000000 --- a/lisp/better-pixel-scroll.el +++ /dev/null @@ -1,147 +0,0 @@ -;;; better-pixel-scroll.el --- Pixel scrolling support -*- lexical-binding:t -*- - -;; Copyright (C) 2021 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This enables the use of smooth scroll events provided by XInput 2 -;; or NS to scroll the display according to the user's precise turning -;; of the mouse wheel. - -;;; Code: - -(require 'mwheel) -(require 'subr-x) - -(defvar x-coalesce-scroll-events) - -(defvar better-pixel-scroll-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [wheel-down] #'better-pixel-scroll) - (define-key map [wheel-up] #'better-pixel-scroll) - map) - "The key map used by `better-pixel-scroll-mode'.") - -(defun better-pixel-scroll-scroll-down (delta) - "Scroll the current window down by DELTA pixels. -Note that this function doesn't work if DELTA is larger than -the height of the current window." - (when-let* ((posn (posn-at-point)) - (current-y (cdr (posn-x-y posn))) - (min-y (+ (window-tab-line-height) - (window-header-line-height))) - (cursor-height (line-pixel-height)) - (window-height (window-text-height nil t)) - (next-height (save-excursion - (vertical-motion 1) - (line-pixel-height)))) - (if (and (> delta 0) - (<= cursor-height window-height)) - (while (< (- current-y min-y) delta) - (vertical-motion 1) - (setq current-y (+ current-y - (line-pixel-height))) - (when (eobp) - (error "End of buffer"))) - (when (< (- (cdr (posn-object-width-height posn)) - (cdr (posn-object-x-y posn))) - (- window-height next-height)) - (vertical-motion 1) - (setq posn (posn-at-point) - current-y (cdr (posn-x-y posn))) - (while (< (- current-y min-y) delta) - (vertical-motion 1) - (setq current-y (+ current-y - (line-pixel-height))) - (when (eobp) - (error "End of buffer"))))) - (let* ((desired-pos (posn-at-x-y 0 (+ delta - (window-tab-line-height) - (window-header-line-height)))) - (desired-start (posn-point desired-pos)) - (desired-vscroll (cdr (posn-object-x-y desired-pos)))) - (unless (eq (window-start) desired-start) - (set-window-start nil desired-start t)) - (set-window-vscroll nil desired-vscroll t)))) - -(defun better-pixel-scroll-scroll-up (delta) - "Scroll the current window up by DELTA pixels." - (when-let* ((max-y (- (window-text-height nil t) - (window-tab-line-height) - (window-header-line-height))) - (posn (posn-at-point)) - (current-y (+ (cdr (posn-x-y posn)) - (cdr (posn-object-width-height posn))))) - (while (< (- max-y current-y) delta) - (vertical-motion -1) - (setq current-y (- current-y (line-pixel-height))))) - (let ((current-vscroll (window-vscroll nil t))) - (setq delta (- delta current-vscroll)) - (set-window-vscroll nil 0 t)) - (while (> delta 0) - (set-window-start nil (save-excursion - (goto-char (window-start)) - (when (zerop (vertical-motion -1)) - (set-window-vscroll nil 0) - (signal 'beginning-of-buffer nil)) - (setq delta (- delta (line-pixel-height))) - (point)) - t)) - (when (< delta 0) - (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) - (window-tab-line-height) - (window-header-line-height)))) - (desired-start (posn-point desired-pos)) - (desired-vscroll (cdr (posn-object-x-y desired-pos)))) - (unless (eq (window-start) desired-start) - (set-window-start nil desired-start t)) - (set-window-vscroll nil desired-vscroll t)))) - -(defun better-pixel-scroll (event &optional arg) - "Scroll the display according to EVENT. -Take into account any pixel deltas in EVENT to scroll the display -according to the user's turning the mouse wheel. If EVENT does -not have precise scrolling deltas, call `mwheel-scroll' instead. -ARG is passed to `mwheel-scroll', should that be called." - (interactive (list last-input-event current-prefix-arg)) - (let ((window (mwheel-event-window event))) - (if (and (nth 4 event) - (zerop (window-hscroll window))) - (let ((delta (round (cdr (nth 4 event))))) - (if (> (abs delta) (window-text-height window t)) - (mwheel-scroll event arg) - (with-selected-window window - (if (< delta 0) - (better-pixel-scroll-scroll-down (- delta)) - (better-pixel-scroll-scroll-up delta))))) - (mwheel-scroll event arg)))) - -;;;###autoload -(define-minor-mode better-pixel-scroll-mode - "Toggle pixel scrolling. -When enabled, this minor mode allows to scroll the display -precisely, according to the turning of the mouse wheel." - :global t - :group 'mouse - :keymap better-pixel-scroll-mode-map - (setq x-coalesce-scroll-events - (not better-pixel-scroll-mode))) - -(provide 'better-pixel-scroll) - -;;; better-pixel-scroll.el ends here. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 249484cf581..f6d1d0ff8ca 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -67,6 +67,7 @@ ;;; Code: (require 'mwheel) +(require 'subr-x) (defvar pixel-wait 0 "Idle time on each step of pixel scroll specified in second. @@ -90,6 +91,15 @@ is always with pixel resolution.") (defvar pixel-last-scroll-time 0 "Time when the last scrolling was made, in second since the epoch.") +(defvar x-coalesce-scroll-events) + +(defvar pixel-scroll-precision-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [wheel-down] #'pixel-scroll-precision) + (define-key map [wheel-up] #'pixel-scroll-precision) + map) + "The key map used by `pixel-scroll-precision-mode'.") + (defun pixel-scroll-in-rush-p () "Return non-nil if next scroll should be non-smooth. When scrolling request is delivered soon after the previous one, @@ -354,5 +364,116 @@ Otherwise, redisplay will reset the window's vscroll." (set-window-start nil (pixel-point-at-unseen-line) t) (set-window-vscroll nil vscroll t)) +;; FIXME: This doesn't work when DELTA is larger than the height +;; of the current window, and someone should probably fix that +;; at some point. +(defun pixel-scroll-precision-scroll-down (delta) + "Scroll the current window down by DELTA pixels. +Note that this function doesn't work if DELTA is larger than +the height of the current window." + (when-let* ((posn (posn-at-point)) + (current-y (cdr (posn-x-y posn))) + (min-y (+ (frame-char-height) + (window-tab-line-height) + (window-header-line-height))) + (cursor-height (line-pixel-height)) + (window-height (window-text-height nil t)) + (next-height (save-excursion + (vertical-motion 1) + (line-pixel-height)))) + (if (and (> delta 0) + (<= cursor-height window-height)) + (while (< (- current-y min-y) delta) + (vertical-motion 1) + (setq current-y (+ current-y + (line-pixel-height))) + (when (eobp) + (signal 'end-of-buffer nil))) + (when (< (- (cdr (posn-object-width-height posn)) + (cdr (posn-object-x-y posn))) + (- window-height next-height)) + (vertical-motion 1) + (setq posn (posn-at-point) + current-y (cdr (posn-x-y posn))) + (while (< (- current-y min-y) delta) + (vertical-motion 1) + (setq current-y (+ current-y + (line-pixel-height))) + (when (eobp) + (signal 'end-of-buffer nil))))) + (let* ((desired-pos (posn-at-x-y 0 (+ delta + (window-tab-line-height) + (window-header-line-height)))) + (desired-start (posn-point desired-pos)) + (desired-vscroll (cdr (posn-object-x-y desired-pos)))) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))) + +(defun pixel-scroll-precision-scroll-up (delta) + "Scroll the current window up by DELTA pixels." + (when-let* ((max-y (- (window-text-height nil t) + (frame-char-height) + (window-tab-line-height) + (window-header-line-height))) + (posn (posn-at-point)) + (current-y (+ (cdr (posn-x-y posn)) + (line-pixel-height)))) + (while (< (- max-y current-y) delta) + (vertical-motion -1) + (setq current-y (- current-y (line-pixel-height))))) + (let ((current-vscroll (window-vscroll nil t))) + (setq delta (- delta current-vscroll)) + (set-window-vscroll nil 0 t)) + (while (> delta 0) + (set-window-start nil (save-excursion + (goto-char (window-start)) + (when (zerop (vertical-motion -1)) + (set-window-vscroll nil 0) + (signal 'beginning-of-buffer nil)) + (setq delta (- delta (line-pixel-height))) + (point)) + t)) + (when (< delta 0) + (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) + (window-tab-line-height) + (window-header-line-height)))) + (desired-start (posn-point desired-pos)) + (desired-vscroll (cdr (posn-object-x-y desired-pos)))) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))) + +;; FIXME: This doesn't work when there's an image above the current +;; line that is taller than the window. +(defun pixel-scroll-precision (event) + "Scroll the display vertically by pixels according to EVENT. +Move the display up or down by the pixel deltas in EVENT to +scroll the display according to the user's turning the mouse +wheel." + (interactive "e") + (let ((window (mwheel-event-window event))) + (if (and (nth 4 event) + (zerop (window-hscroll window))) + (let ((delta (round (cdr (nth 4 event))))) + (if (> (abs delta) (window-text-height window t)) + (mwheel-scroll event nil) + (with-selected-window window + (if (< delta 0) + (pixel-scroll-precision-scroll-down (- delta)) + (pixel-scroll-precision-scroll-up delta))))) + (mwheel-scroll event nil)))) + +;;;###autoload +(define-minor-mode pixel-scroll-precision-mode + "Toggle pixel scrolling. +When enabled, this minor mode allows to scroll the display +precisely, according to the turning of the mouse wheel." + :global t + :group 'mouse + :keymap pixel-scroll-precision-mode-map + (setq x-coalesce-scroll-events + (not pixel-scroll-precision-mode))) + (provide 'pixel-scroll) ;;; pixel-scroll.el ends here From 3f843b25dc96867043feebb1d928bde4a7a777a3 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 26 Nov 2021 14:17:10 +0100 Subject: [PATCH 323/367] Add an intermediary face for mode lines: `mode-line-active' * doc/emacs/display.texi (Standard Faces): Document the new face. * lisp/faces.el (mode-line-active): New face. (mode-line): Don't inherit from vaiable-pitch. * src/xfaces.c (lookup_basic_face, realize_basic_faces) (syms_of_xfaces): * src/xdisp.c (window_box_height, window_text_pixel_size) (display_mode_lines, Fformat_mode_line): * src/dispextern.h (CURRENT_MODE_LINE_ACTIVE_FACE_ID_3) (CURRENT_MODE_LINE_ACTIVE_FACE_ID, enum face_id): Rename from *MODE_LINE_FACE_ID to *MODE_LINE_ACTIVE_FACE_ID. --- doc/emacs/display.texi | 24 ++++++++++++++++++++++-- etc/NEWS | 14 ++++++++++---- lisp/faces.el | 17 ++++++++++++----- src/dispextern.h | 18 +++++++++++------- src/xdisp.c | 31 ++++++++++++++++--------------- src/xfaces.c | 4 +++- 6 files changed, 74 insertions(+), 34 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 7ea754612ee..90044b1d4bb 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -716,46 +716,62 @@ frame: @table @code @item mode-line @cindex @code{mode-line} face -@cindex faces for mode lines -This face is used for the mode line of the currently selected window, +This is the base face used for the mode lines, as well as header lines and for menu bars when toolkit menus are not used. By default, it's drawn with shadows for a raised effect on graphical displays, and drawn as the inverse of the default face on non-windowed terminals. + +The @code{mode-line-active} and @code{mode-line-inactive} faces (which +are the ones used on the mode lines) inherit from this face. + +@item mode-line-active +@cindex faces for mode lines +Like @code{mode-line}, but used for the mode line of the currently +selected window. This face inherits from @code{mode-line}, so changes +in that face affect mode lines in all windows. + @item mode-line-inactive @cindex @code{mode-line-inactive} face Like @code{mode-line}, but used for mode lines of the windows other than the selected one (if @code{mode-line-in-non-selected-windows} is non-@code{nil}). This face inherits from @code{mode-line}, so changes in that face affect mode lines in all windows. + @item mode-line-highlight @cindex @code{mode-line-highlight} face Like @code{highlight}, but used for mouse-sensitive portions of text on mode lines. Such portions of text typically pop up tooltips (@pxref{Tooltips}) when the mouse pointer hovers above them. + @item mode-line-buffer-id @cindex @code{mode-line-buffer-id} face This face is used for buffer identification parts in the mode line. + @item header-line @cindex @code{header-line} face Similar to @code{mode-line} for a window's header line, which appears at the top of a window just as the mode line appears at the bottom. Most windows do not have a header line---only some special modes, such Info mode, create one. + @item header-line-highlight @cindex @code{header-line-highlight} face Similar to @code{highlight} and @code{mode-line-highlight}, but used for mouse-sensitive portions of text on header lines. This is a separate face because the @code{header-line} face might be customized in a way that does not interact well with @code{highlight}. + @item tab-line @cindex @code{tab-line} face Similar to @code{mode-line} for a window's tab line, which appears at the top of a window with tabs representing window buffers. @xref{Tab Line}. + @item vertical-border @cindex @code{vertical-border} face This face is used for the vertical divider between windows on text terminals. + @item minibuffer-prompt @cindex @code{minibuffer-prompt} face @vindex minibuffer-prompt-properties @@ -765,19 +781,23 @@ By default, Emacs automatically adds this face to the value of properties (@pxref{Text Properties,,, elisp, the Emacs Lisp Reference Manual}) used to display the prompt text. (This variable takes effect when you enter the minibuffer.) + @item fringe @cindex @code{fringe} face The face for the fringes to the left and right of windows on graphic displays. (The fringes are the narrow portions of the Emacs frame between the text area and the window's right and left borders.) @xref{Fringes}. + @item cursor The @code{:background} attribute of this face specifies the color of the text cursor. @xref{Cursor Display}. + @item tooltip This face is used for tooltip text. By default, if Emacs is built with GTK+ support, tooltips are drawn via GTK+ and this face has no effect. @xref{Tooltips}. + @item mouse This face determines the color of the mouse pointer. @end table diff --git a/etc/NEWS b/etc/NEWS index 3a0b46d3993..372d2377727 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -75,13 +75,19 @@ time. * Changes in Emacs 29.1 ++++ +** New face 'mode-line-active'. +This inherits from the 'mode-line' face, but is the face actually used +on the mode lines (along with 'mode-line-inactive'). + --- ** The mode line now uses a proportional font by default. -To get the old monospaced mode line back, customize the 'mode-line' -face not to inherit from the 'variable-pitch' face, or add this to -your ~/.emacs: +To get the old monospaced mode line back, customize the +'mode-line-active' and 'mode-line-inactive' faces not to inherit from +the 'variable-pitch' face, or add this to your ~/.emacs: - (set-face-attribute 'mode-line nil :inherit 'default) + (set-face-attribute 'mode-line-active nil :inherit 'mode-line) + (set-face-attribute 'mode-line-inactive nil :inherit 'mode-line) +++ ** New function 'buffer-text-pixel-size'. diff --git a/lisp/faces.el b/lisp/faces.el index 38feefba480..5ed6bd1766e 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2611,19 +2611,26 @@ non-nil." (defface mode-line '((((class color) (min-colors 88)) :box (:line-width -1 :style released-button) - :inherit variable-pitch :background "grey75" :foreground "black") (t - :inverse-video t - :inherit variable-pitch)) - "Basic mode line face for selected window." + :inverse-video t)) + "Face for the mode lines (for the selected window) as well as header lines. +See `mode-line-display' for the face used on mode lines." :version "21.1" :group 'mode-line-faces :group 'basic-faces) +(defface mode-line-active + '((t :inherit (mode-line variable-pitch))) + "Face for the selected mode line. +This inherits from the `mode-line' face." + :version "29.1" + :group 'mode-line-faces + :group 'basic-faces) + (defface mode-line-inactive '((default - :inherit mode-line) + :inherit (mode-line variable-pitch)) (((class color) (min-colors 88) (background light)) :weight light :box (:line-width -1 :color "grey75" :style nil) diff --git a/src/dispextern.h b/src/dispextern.h index 088297157ac..ff4e7293d85 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1477,21 +1477,23 @@ struct glyph_string compared against minibuf_window (if SELW doesn't match), and SCRW which is compared against minibuf_selected_window (if MBW matches). */ -#define CURRENT_MODE_LINE_FACE_ID_3(SELW, MBW, SCRW) \ +#define CURRENT_MODE_LINE_ACTIVE_FACE_ID_3(SELW, MBW, SCRW) \ ((!mode_line_in_non_selected_windows \ || (SELW) == XWINDOW (selected_window) \ || (minibuf_level > 0 \ && !NILP (minibuf_selected_window) \ && (MBW) == XWINDOW (minibuf_window) \ && (SCRW) == XWINDOW (minibuf_selected_window))) \ - ? MODE_LINE_FACE_ID \ + ? MODE_LINE_ACTIVE_FACE_ID \ : MODE_LINE_INACTIVE_FACE_ID) /* Return the desired face id for the mode line of window W. */ -#define CURRENT_MODE_LINE_FACE_ID(W) \ - (CURRENT_MODE_LINE_FACE_ID_3((W), XWINDOW (selected_window), (W))) +#define CURRENT_MODE_LINE_ACTIVE_FACE_ID(W) \ + (CURRENT_MODE_LINE_ACTIVE_FACE_ID_3((W), \ + XWINDOW (selected_window), \ + (W))) /* Return the current height of the mode line of window W. If not known from W->mode_line_height, look at W's current glyph matrix, or return @@ -1504,7 +1506,7 @@ struct glyph_string = (MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ ? MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ : estimate_mode_line_height \ - (XFRAME ((W)->frame), CURRENT_MODE_LINE_FACE_ID (W))))) + (XFRAME ((W)->frame), CURRENT_MODE_LINE_ACTIVE_FACE_ID (W))))) /* Return the current height of the header line of window W. If not known from W->header_line_height, look at W's current glyph matrix, or return @@ -1818,7 +1820,7 @@ face_tty_specified_color (unsigned long color) enum face_id { DEFAULT_FACE_ID, - MODE_LINE_FACE_ID, + MODE_LINE_ACTIVE_FACE_ID, MODE_LINE_INACTIVE_FACE_ID, TOOL_BAR_FACE_ID, FRINGE_FACE_ID, @@ -1836,6 +1838,7 @@ enum face_id CHILD_FRAME_BORDER_FACE_ID, TAB_BAR_FACE_ID, TAB_LINE_FACE_ID, + MODE_LINE_FACE_ID, BASIC_FACE_ID_SENTINEL }; @@ -2545,7 +2548,8 @@ struct it enum line_wrap_method line_wrap; /* The ID of the default face to use. One of DEFAULT_FACE_ID, - MODE_LINE_FACE_ID, etc, depending on what we are displaying. */ + MODE_LINE_ACTIVE_FACE_ID, etc, depending on what we are + displaying. */ int base_face_id; /* If `what' == IT_CHARACTER, the character and the length in bytes diff --git a/src/xdisp.c b/src/xdisp.c index d6b53eacea1..24049ab4e33 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1285,8 +1285,8 @@ window_box_height (struct window *w) if (ml_row && ml_row->mode_line_p) height -= ml_row->height; else - height -= estimate_mode_line_height (f, - CURRENT_MODE_LINE_FACE_ID (w)); + height -= estimate_mode_line_height + (f, CURRENT_MODE_LINE_ACTIVE_FACE_ID (w)); } } @@ -1691,7 +1691,7 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, = window_parameter (w, Qmode_line_format); w->mode_line_height - = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), + = display_mode_line (w, CURRENT_MODE_LINE_ACTIVE_FACE_ID (w), NILP (window_mode_line_format) ? BVAR (current_buffer, mode_line_format) : window_mode_line_format); @@ -3146,11 +3146,11 @@ CHECK_WINDOW_END (struct window *w) will produce glyphs in that row. BASE_FACE_ID is the id of a base face to use. It must be one of - DEFAULT_FACE_ID for normal text, MODE_LINE_FACE_ID, + DEFAULT_FACE_ID for normal text, MODE_LINE_ACTIVE_FACE_ID, MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID for displaying mode lines, or TOOL_BAR_FACE_ID for displaying the tool-bar. - If ROW is null and BASE_FACE_ID is equal to MODE_LINE_FACE_ID, + If ROW is null and BASE_FACE_ID is equal to MODE_LINE_ACTIVE_FACE_ID, MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID, the iterator will be initialized to use the corresponding mode line glyph row of the desired matrix of W. */ @@ -3196,7 +3196,7 @@ init_iterator (struct it *it, struct window *w, appropriate. */ if (row == NULL) { - if (base_face_id == MODE_LINE_FACE_ID + if (base_face_id == MODE_LINE_ACTIVE_FACE_ID || base_face_id == MODE_LINE_INACTIVE_FACE_ID) row = MATRIX_MODE_LINE_ROW (w->desired_matrix); else if (base_face_id == TAB_LINE_FACE_ID) @@ -11020,7 +11020,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, Li Lisp_Object window_mode_line_format = window_parameter (w, Qmode_line_format); - y = y + display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), + y = y + display_mode_line (w, CURRENT_MODE_LINE_ACTIVE_FACE_ID (w), NILP (window_mode_line_format) ? BVAR (current_buffer, mode_line_format) : window_mode_line_format); @@ -25813,7 +25813,8 @@ display_mode_lines (struct window *w) struct window *sel_w = XWINDOW (old_selected_window); /* Select mode line face based on the real selected window. */ - display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), + display_mode_line (w, + CURRENT_MODE_LINE_ACTIVE_FACE_ID_3 (sel_w, sel_w, w), NILP (window_mode_line_format) ? BVAR (current_buffer, mode_line_format) : window_mode_line_format); @@ -25852,11 +25853,11 @@ display_mode_lines (struct window *w) } -/* Display mode or header/tab line of window W. FACE_ID specifies which - line to display; it is either MODE_LINE_FACE_ID, HEADER_LINE_FACE_ID or - TAB_LINE_FACE_ID. FORMAT is the mode/header/tab line format to - display. Value is the pixel height of the mode/header/tab line - displayed. */ +/* Display mode or header/tab line of window W. FACE_ID specifies + which line to display; it is either MODE_LINE_ACTIVE_FACE_ID, + HEADER_LINE_FACE_ID or TAB_LINE_FACE_ID. FORMAT is the + mode/header/tab line format to display. Value is the pixel height + of the mode/header/tab line displayed. */ static int display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) @@ -26649,8 +26650,8 @@ are the selected window and the WINDOW's buffer). */) face_id = (NILP (face) || EQ (face, Qdefault)) ? DEFAULT_FACE_ID : EQ (face, Qt) ? (EQ (window, selected_window) - ? MODE_LINE_FACE_ID : MODE_LINE_INACTIVE_FACE_ID) - : EQ (face, Qmode_line) ? MODE_LINE_FACE_ID + ? MODE_LINE_ACTIVE_FACE_ID : MODE_LINE_INACTIVE_FACE_ID) + : EQ (face, Qmode_line_active) ? MODE_LINE_ACTIVE_FACE_ID : EQ (face, Qmode_line_inactive) ? MODE_LINE_INACTIVE_FACE_ID : EQ (face, Qheader_line) ? HEADER_LINE_FACE_ID : EQ (face, Qtab_line) ? TAB_LINE_FACE_ID diff --git a/src/xfaces.c b/src/xfaces.c index 174a1ca47c9..813d89e5a3e 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4857,7 +4857,7 @@ lookup_basic_face (struct window *w, struct frame *f, int face_id) switch (face_id) { case DEFAULT_FACE_ID: name = Qdefault; break; - case MODE_LINE_FACE_ID: name = Qmode_line; break; + case MODE_LINE_ACTIVE_FACE_ID: name = Qmode_line_active; break; case MODE_LINE_INACTIVE_FACE_ID: name = Qmode_line_inactive; break; case HEADER_LINE_FACE_ID: name = Qheader_line; break; case TAB_LINE_FACE_ID: name = Qtab_line; break; @@ -5569,6 +5569,7 @@ realize_basic_faces (struct frame *f) if (realize_default_face (f)) { realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID); + realize_named_face (f, Qmode_line_active, MODE_LINE_ACTIVE_FACE_ID); realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID); realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID); realize_named_face (f, Qfringe, FRINGE_FACE_ID); @@ -6945,6 +6946,7 @@ syms_of_xfaces (void) DEFSYM (Qborder, "border"); DEFSYM (Qmouse, "mouse"); DEFSYM (Qmode_line_inactive, "mode-line-inactive"); + DEFSYM (Qmode_line_active, "mode-line-active"); DEFSYM (Qvertical_border, "vertical-border"); DEFSYM (Qwindow_divider, "window-divider"); DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel"); From 43a595788de876b33cac0976548a0ce1c9add9c5 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Fri, 26 Nov 2021 14:08:24 +0100 Subject: [PATCH 324/367] Adjust custom-face-attributes for 'regular' weight Following the changes to support "medium" weight fonts, the weight for "normal" fonts is now reported as 'regular', which caused customize-face to display faces as lisp-expressions, since it didn't recognize that. This has been corrected. * lisp/cus-face.el (custom-face-attributes): Recognize 'regular' as a weight. --- lisp/cus-face.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index f83f1a2daa0..c78a327fdfa 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -102,7 +102,7 @@ (const :tag "semi-light" semi-light) (const :tag "demilight" semi-light) (const :tag "normal" normal) - (const :tag "regular" normal) + (const :tag "regular" regular) (const :tag "book" normal) (const :tag "medium" medium) (const :tag "semibold" semi-bold) From c32e8bdc23214793ffcb065ba8478570679c1f0a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 26 Nov 2021 15:50:46 +0200 Subject: [PATCH 325/367] ; * etc/NEWS: Fix wording of a recently-added entry. --- etc/NEWS | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 372d2377727..b23c63c990c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -101,11 +101,11 @@ and pop-up menus. --- ** New minor mode 'pixel-scroll-precision-mode'. -When enabled, you can scroll the display up or down by individual -pixels in a way that corresponds with the movement of your mouse -wheel, if supported by the mouse wheel. Unlike 'pixel-scroll-mode', -this mode scrolls the display pixel-by-pixel, as opposed to only -animating line-by-line scrolls. +When enabled, and if your mouse supports it, you can scroll the +display up or down at pixel resolution, according to what your mouse +wheel reports. Unlike 'pixel-scroll-mode', this mode scrolls the +display pixel-by-pixel, as opposed to only animating line-by-line +scrolls. ** Terminal Emacs From 57bb675cde25bc1b54d8eb8716b0024d5c1d5687 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 26 Nov 2021 15:26:14 +0100 Subject: [PATCH 326/367] Add new face `gnus-header' * lisp/gnus/gnus-art.el (gnus-header): New face. (gnus-header-from, gnus-header-subject, gnus-header-newsgroups) (gnus-header-name, gnus-header-content): Inherit from this new face. --- etc/NEWS | 4 ++++ lisp/gnus/gnus-art.el | 36 +++++++++++++++++++++++------------- 2 files changed, 27 insertions(+), 13 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b23c63c990c..87a7a43a5ed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -348,6 +348,10 @@ the common "utm_" trackers from URLs. ** Gnus +--- +*** New face 'gnus-header'. +All other 'gnus-header-*' faces inherit from this face now. + +++ *** New user option 'gnus-treat-emojize-symbols'. If non-nil, symbols that have an emoji representation will be diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 9594c32e816..9a56e3a9013 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -768,28 +768,37 @@ Obsolete; use the face `gnus-signature' for customizations instead." :group 'gnus-article-highlight :group 'gnus-article-signature) +(defface gnus-header + '((t nil)) + "Base face used for all Gnus header faces. +All the other `gnus-header-' faces inherit from this face." + :version "29.1" + :group 'gnus-article-headers + :group 'gnus-article-highlight) + (defface gnus-header-from '((((class color) (background dark)) - (:foreground "PaleGreen1")) + (:foreground "PaleGreen1" :inherit gnus-header)) (((class color) (background light)) - (:foreground "red3")) + (:foreground "red3" :inherit gnus-header)) (t - (:italic t))) + (:italic t :inherit gnus-header))) "Face used for displaying from headers." + :version "29.1" :group 'gnus-article-headers :group 'gnus-article-highlight) (defface gnus-header-subject '((((class color) (background dark)) - (:foreground "SeaGreen1")) + (:foreground "SeaGreen1" :inherit gnus-header)) (((class color) (background light)) - (:foreground "red4")) + (:foreground "red4" :inherit gnus-header)) (t - (:bold t :italic t))) + (:bold t :italic t :inherit gnus-header))) "Face used for displaying subject headers." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -797,7 +806,7 @@ Obsolete; use the face `gnus-signature' for customizations instead." (defface gnus-header-newsgroups '((((class color) (background dark)) - (:foreground "yellow" :italic t)) + (:foreground "yellow" :italic t :inherit gnus-header)) (((class color) (background light)) (:foreground "MidnightBlue" :italic t)) @@ -812,12 +821,12 @@ articles." (defface gnus-header-name '((((class color) (background dark)) - (:foreground "SpringGreen2")) + (:foreground "SpringGreen2" :inherit gnus-header)) (((class color) (background light)) - (:foreground "maroon")) + (:foreground "maroon" :inherit gnus-header)) (t - (:bold t))) + (:bold t :inherit gnus-header))) "Face used for displaying header names." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -825,12 +834,13 @@ articles." (defface gnus-header-content '((((class color) (background dark)) - (:foreground "SpringGreen1" :italic t)) + (:foreground "SpringGreen1" :italic t :inherit gnus-header)) (((class color) (background light)) - (:foreground "indianred4" :italic t)) + (:foreground "indianred4" :italic t :inherit gnus-header)) (t - (:italic t))) "Face used for displaying header content." + (:italic t :inherit gnus-header))) + "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) From 051e49fe3cec47f28ad8ca721d95e5b6db0c2b9c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 26 Nov 2021 15:41:22 +0100 Subject: [PATCH 327/367] Adapt test/infra/gitlab-ci.yml * test/infra/gitlab-ci.yml (test-all-inotify) (test-filenotify-gio, test-gnustep, test-native-comp-speed0): Add or adapt artifacts. --- test/infra/gitlab-ci.yml | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 15d8b252e23..dd36d19b3da 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -202,7 +202,7 @@ test-all-inotify: public: true expire_in: 1 week paths: - - "**/*.log" + - "${test_name}/**/*.log" when: always variables: target: emacs-inotify @@ -221,6 +221,13 @@ test-filenotify-gio: needs: - job: build-image-filenotify-gio optional: true + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - "${test_name}/**/*.log" + when: always variables: target: emacs-filenotify-gio make_params: "-k -C test autorevert-tests.log filenotify-tests.log" @@ -238,6 +245,13 @@ test-gnustep: needs: - job: build-image-gnustep optional: true + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - "${test_name}/**/*.log" + when: always variables: target: emacs-gnustep make_params: install @@ -266,6 +280,13 @@ test-native-comp-speed0: needs: - job: build-native-comp-speed0 optional: true + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - "${test_name}/**/*.log" + when: always variables: target: emacs-native-comp-speed0 make_params: "-C test check SELECTOR='(not (tag :unstable))'" From dd6b151c25551fe125d61a54890756d9454cc402 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Fri, 26 Nov 2021 15:54:49 +0100 Subject: [PATCH 328/367] Specify initial values for glyphless-char-display-control elements * lisp/international/characters.el (glyphless-char-display-control): Specify :value for all the elements, since nil is not a valid value. --- lisp/international/characters.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 5aefda23283..ec995743f5a 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1618,31 +1618,36 @@ function (`update-glyphless-char-display'), which updates :type '(alist :key-type (symbol :tag "Character Group") :value-type (symbol :tag "Display Method")) :options '((c0-control - (choice (const :tag "Don't display" zero-width) + (choice :value thin-space + (const :tag "Don't display" zero-width) (const :tag "Display as thin space" thin-space) (const :tag "Display as empty box" empty-box) (const :tag "Display acronym" acronym) (const :tag "Display hex code in a box" hex-code))) (c1-control - (choice (const :tag "Don't display" zero-width) + (choice :value thin-space + (const :tag "Don't display" zero-width) (const :tag "Display as thin space" thin-space) (const :tag "Display as empty box" empty-box) (const :tag "Display acronym" acronym) (const :tag "Display hex code in a box" hex-code))) (format-control - (choice (const :tag "Don't display" zero-width) + (choice :value thin-space + (const :tag "Don't display" zero-width) (const :tag "Display as thin space" thin-space) (const :tag "Display as empty box" empty-box) (const :tag "Display acronym" acronym) (const :tag "Display hex code in a box" hex-code))) (variation-selectors - (choice (const :tag "Don't display" zero-width) + (choice :value thin-space + (const :tag "Don't display" zero-width) (const :tag "Display as thin space" thin-space) (const :tag "Display as empty box" empty-box) (const :tag "Display acronym" acronym) (const :tag "Display hex code in a box" hex-code))) (no-font - (choice (const :tag "Don't display" zero-width) + (choice :value hex-code + (const :tag "Don't display" zero-width) (const :tag "Display as thin space" thin-space) (const :tag "Display as empty box" empty-box) (const :tag "Display acronym" acronym) From 11860f89a593a8cfe7efb94e86370bbbe4318fba Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Fri, 26 Nov 2021 08:51:38 -0800 Subject: [PATCH 329/367] * test/src/comp-tests.el: Eliminate byte-compiler warnings (Bug#52105). --- test/src/comp-tests.el | 35 ++++++++++++++++++++++++++--------- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 025bc2058ec..f66a1932058 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -27,14 +27,23 @@ (require 'ert) (require 'ert-x) -(require 'cl-lib) +(eval-when-compile + (require 'cl-lib) + (require 'comp)) +(eval-and-compile + (require 'comp-cstr) ;in eval-and-compile for its defstruct + (defconst comp-test-src (ert-resource-file "comp-test-funcs.el")) + (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el")) + (defconst comp-test-pure-src (ert-resource-file "comp-test-pure.el")) + (defconst comp-test-45603-src (ert-resource-file "comp-test-45603.el")) + ;; Load the test code here so the compiler can check the function + ;; names used in this file. + (load comp-test-src nil t) + (load comp-test-dyn-src nil t) + (load comp-test-pure-src nil t) + (load comp-test-45603-src nil t)) -(defconst comp-test-src (ert-resource-file "comp-test-funcs.el")) - -(defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el")) - -(when (featurep 'native-compile) - (require 'comp) +(when (native-comp-available-p) (message "Compiling tests...") (load (native-compile comp-test-src)) (load (native-compile comp-test-dyn-src))) @@ -352,6 +361,8 @@ Check that the resulting binaries do not differ." comp-test-interactive-form2-f))) (should-not (commandp #'comp-tests-doc-f))) +(declare-function comp-tests-free-fun-f nil) + (comp-deftest free-fun () "Check we are able to compile a single function." (eval '(defun comp-tests-free-fun-f () @@ -369,6 +380,8 @@ Check that the resulting binaries do not differ." (should (equal (interactive-form #'comp-tests-free-fun-f) '(interactive)))) +(declare-function comp-tests/free\fun-f nil) + (comp-deftest free-fun-silly-name () "Check we are able to compile a single function." (eval '(defun comp-tests/free\fun-f ()) t) @@ -493,7 +506,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest 45603-1 () "" - (load (native-compile (ert-resource-file "comp-test-45603.el"))) + (load (native-compile comp-test-45603-src)) (should (fboundp #'comp-test-45603--file-local-name))) (comp-deftest 46670-1 () @@ -786,6 +799,8 @@ Return a list of results." (comp-tests-mentioned-p (comp-c-func-name 'comp-tests-tco-f "F" t) insn))))))) +(declare-function comp-tests-tco-f nil) + (comp-deftest tco () "Check for tail recursion elimination." (let ((native-comp-speed 3) @@ -814,6 +829,8 @@ Return a list of results." (or (comp-tests-mentioned-p 'concat insn) (comp-tests-mentioned-p 'length insn))))))) +(declare-function comp-tests-fw-prop-1-f nil) + (comp-deftest fw-prop-1 () "Some tests for forward propagation." (let ((native-comp-speed 2) @@ -1404,7 +1421,7 @@ folded." (let ((native-comp-speed 3) (comp-post-pass-hooks '((comp-final comp-tests-pure-checker-1 comp-tests-pure-checker-2)))) - (load (native-compile (ert-resource-file "comp-test-pure.el"))) + (load (native-compile comp-test-pure-src)) (should (subr-native-elisp-p (symbol-function #'comp-tests-pure-caller-f))) (should (= (comp-tests-pure-caller-f) 4)) From 9721dcf2754ebad28ac60a9d3152fd26e4c652c4 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Fri, 26 Nov 2021 19:57:07 +0000 Subject: [PATCH 330/367] Silence NS warnings * src/nsterm.m ([EmacsView mouseDown:]): Move variables into the block where they're used. --- src/nsterm.m | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/nsterm.m b/src/nsterm.m index 80117a41a56..747539eae64 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6529,7 +6529,6 @@ - (void)mouseDown: (NSEvent *)theEvent { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil]; - int x = 0, y = 0; NSTRACE ("[EmacsView mouseDown:]"); @@ -6561,6 +6560,7 @@ - (void)mouseDown: (NSEvent *)theEvent */ bool horizontal; int lines = 0; + int x = 0, y = 0; int scrollUp = NO; /* FIXME: At the top or bottom of the buffer we should From f1116f45bcabc5628e7443a2c792971c7c23b8b1 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Nov 2021 08:34:51 +0800 Subject: [PATCH 331/367] Set initial tab bar parameter on NS * src/nsfns.m (Fx_create_frame): Initialize `tab-bar-lines' frame parameter during frame creation. --- src/nsfns.m | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/nsfns.m b/src/nsfns.m index f4d81722460..c2791aa15a9 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1365,6 +1365,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. NILP (Vmenu_bar_mode) ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtab_bar_lines, + NILP (Vtab_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qtool_bar_lines, NILP (Vtool_bar_mode) ? make_fixnum (0) : make_fixnum (1), From b0ef00f370a10398c0271b24582e10bf12a90566 Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Fri, 26 Nov 2021 20:48:45 -0800 Subject: [PATCH 332/367] time-stamp-tests.el: Test more formats * test/lisp/time-stamp-tests.el (time-stamp-format-ignored-modifiers): Additional testing with illegal formats, including "%". (time-stamp-format-multiple-conversions): Add a test with "%%%". --- test/lisp/time-stamp-tests.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index cb446eb486e..a049e5de58a 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -595,8 +595,12 @@ ;; incorrectly nested parens do not crash us (should-not (equal (time-stamp-string "%(stuffB" ref-time3) May)) (should-not (equal (time-stamp-string "%)B" ref-time3) May)) + ;; unterminated format does not crash us + (should-not (equal (time-stamp-string "%" ref-time3) May)) ;; not all punctuation is allowed - (should-not (equal (time-stamp-string "%&B" ref-time3) May))))) + (should-not (equal (time-stamp-string "%&B" ref-time3) May)) + (should-not (equal (time-stamp-string "%/B" ref-time3) May)) + (should-not (equal (time-stamp-string "%;B" ref-time3) May))))) (ert-deftest time-stamp-format-non-conversions () "Test that without a %, the text is copied literally." @@ -635,8 +639,8 @@ (concat Mon "." Monday "." Mon))) (should (equal (time-stamp-string "%5z.%5::z.%5z" ref-time1) "+0000.+00:00:00.+0000")) - ;; format letter is independent - (should (equal (time-stamp-string "%H:%M" ref-time1) "15:04"))))) + ;; format character is independent + (should (equal (time-stamp-string "%H:%M%%%S" ref-time1) "15:04%05"))))) (ert-deftest time-stamp-format-string-width () "Test time-stamp string width modifiers." From d329014574575b3f98ac68e22bdcb1ab4ddd5419 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Nov 2021 13:02:10 +0800 Subject: [PATCH 333/367] Make `pixel-scroll-precision-scroll-up' use existing logic * lisp/pixel-scroll.el (pixel-point-at-unseen-line): Rewrite to use `pixel-point-and-height-at-unseen-line'. (pixel-point-and-height-at-unseen-line): New function. (pixel-scroll-precision-scroll-up): Use existing logic to determine unseen line position. --- lisp/pixel-scroll.el | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index f6d1d0ff8ca..131519a2585 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -333,12 +333,14 @@ returns nil." (setq pos-list (cdr pos-list)))) visible-pos)) -(defun pixel-point-at-unseen-line () - "Return the character position of line above the selected window. -The returned value is the position of the first character on the -unseen line just above the scope of current window." +(defun pixel-point-and-height-at-unseen-line () + "Return the position and pixel height of line above the selected window. +The returned value is a cons of the position of the first +character on the unseen line just above the scope of current +window, and the pixel height of that line." (let* ((pos0 (window-start)) (vscroll0 (window-vscroll nil t)) + (line-height nil) (pos (save-excursion (goto-char pos0) @@ -350,11 +352,18 @@ unseen line just above the scope of current window." (tem (beginning-of-visual-line 0))) (if (eq tem ppos) (vertical-motion -1)) + (setq line-height (line-pixel-height)) (point)))))) ;; restore initial position (set-window-start nil pos0 t) (set-window-vscroll nil vscroll0 t) - pos)) + (cons pos line-height))) + +(defun pixel-point-at-unseen-line () + "Return the character position of line above the selected window. +The returned value is the position of the first character on the +unseen line just above the scope of current window." + (car (pixel-point-and-height-at-unseen-line))) (defun pixel-scroll-down-and-set-window-vscroll (vscroll) "Scroll down a line and set VSCROLL in pixels. @@ -426,14 +435,9 @@ the height of the current window." (setq delta (- delta current-vscroll)) (set-window-vscroll nil 0 t)) (while (> delta 0) - (set-window-start nil (save-excursion - (goto-char (window-start)) - (when (zerop (vertical-motion -1)) - (set-window-vscroll nil 0) - (signal 'beginning-of-buffer nil)) - (setq delta (- delta (line-pixel-height))) - (point)) - t)) + (let ((position (pixel-point-and-height-at-unseen-line))) + (set-window-start nil (car position) t) + (setq delta (- delta (cdr position))))) (when (< delta 0) (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) (window-tab-line-height) From 141425ce3b8646d589f6a3aaf16d981821b32631 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Nov 2021 13:46:35 +0800 Subject: [PATCH 334/367] Make `pixel-scroll-precision-scroll-up' slightly more robust * lisp/pixel-scroll.el (pixel-scroll-precision-scroll-up): Subtract from existing vscroll if feasible. --- lisp/pixel-scroll.el | 40 +++++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 15 deletions(-) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 131519a2585..84e1f66fa55 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -432,21 +432,31 @@ the height of the current window." (vertical-motion -1) (setq current-y (- current-y (line-pixel-height))))) (let ((current-vscroll (window-vscroll nil t))) - (setq delta (- delta current-vscroll)) - (set-window-vscroll nil 0 t)) - (while (> delta 0) - (let ((position (pixel-point-and-height-at-unseen-line))) - (set-window-start nil (car position) t) - (setq delta (- delta (cdr position))))) - (when (< delta 0) - (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) - (window-tab-line-height) - (window-header-line-height)))) - (desired-start (posn-point desired-pos)) - (desired-vscroll (cdr (posn-object-x-y desired-pos)))) - (unless (eq (window-start) desired-start) - (set-window-start nil desired-start t)) - (set-window-vscroll nil desired-vscroll t)))) + (if (<= delta current-vscroll) + (set-window-vscroll nil (- current-vscroll delta) t) + (setq delta (- delta current-vscroll)) + (set-window-vscroll nil 0 t) + (while (> delta 0) + (let ((position (pixel-point-and-height-at-unseen-line))) + (unless (cdr position) + (signal 'beginning-of-buffer nil)) + (set-window-start nil (car position) t) + ;; If the line above is taller than the window height (i.e. there's + ;; a very tall image), keep point on it. + (when (> (cdr position) (window-text-height nil t)) + (let ((vs (window-vscroll nil t))) + (goto-char (car position)) + (set-window-vscroll nil vs t))) + (setq delta (- delta (cdr position))))) + (when (< delta 0) + (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) + (window-tab-line-height) + (window-header-line-height)))) + (desired-start (posn-point desired-pos)) + (desired-vscroll (cdr (posn-object-x-y desired-pos)))) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))))) ;; FIXME: This doesn't work when there's an image above the current ;; line that is taller than the window. From 3dc9eb8bbd977b0d81d49c7b79492f6ef30e270f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Nov 2021 14:10:49 +0800 Subject: [PATCH 335/367] Remove GC prone call in `pixel-point-and-height-at-unseen-line' * lisp/pixel-scroll.el (pixel-point-and-height-at-unseen-line): Remove call to unnecessary call to `beginning-of-visual-line'. --- lisp/pixel-scroll.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 84e1f66fa55..92f66c89cef 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -346,14 +346,9 @@ window, and the pixel height of that line." (goto-char pos0) (if (bobp) (point-min) - ;; When there's an overlay string at window-start, - ;; (beginning-of-visual-line 0) stays put. - (let ((ppos (point)) - (tem (beginning-of-visual-line 0))) - (if (eq tem ppos) - (vertical-motion -1)) - (setq line-height (line-pixel-height)) - (point)))))) + (vertical-motion -1) + (setq line-height (line-pixel-height)) + (point))))) ;; restore initial position (set-window-start nil pos0 t) (set-window-vscroll nil vscroll0 t) From 828a193066bace5785ac87be75d312dace06ad68 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Nov 2021 14:57:59 +0800 Subject: [PATCH 336/367] Set motion event time when handling XI2 motion events * src/xterm.c (handle_one_xevent): Set motion event time when handling XI_Motion. --- src/xterm.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/xterm.c b/src/xterm.c index c7950c6f9fc..8045470bdd3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10085,6 +10085,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, ev.x = lrint (xev->event_x); ev.y = lrint (xev->event_y); ev.window = xev->event; + ev.time = xev->time; previous_help_echo_string = help_echo_string; help_echo_string = Qnil; From 6072370db7244a13470252e5369c4c9de3e3a9ef Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Nov 2021 09:02:12 +0200 Subject: [PATCH 337/367] ; Improve doc string of 'glyphless-char-display-control' * lisp/international/characters.el (glyphless-char-display-control): Doc fix. --- lisp/international/characters.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index ec995743f5a..3a8e968c34b 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1594,12 +1594,14 @@ GROUP must be one of these symbols: such as U+200C (ZWNJ), U+200E (LRM), but excluding characters that have graphic images, such as U+00AD (SHY). - `variation-selectors': U+FE00..U+FE0F, used for choosing between - glyph variations (e.g. Emoji vs Text - presentation). - `no-font': characters for which no suitable font is found. - For character terminals, characters that cannot - be encoded by `terminal-coding-system'. + `variation-selectors': + Characters in the range U+FE00..U+FE0F, used for + selecting alternate glyph presentations, such as + Emoji vs Text presentation, of the preceding + character(s). + `no-font': For GUI frames, characters for which no suitable + font is found; for text-mode frames, characters + that cannot be encoded by `terminal-coding-system'. METHOD must be one of these symbols: `zero-width': don't display. From f9457b8b011aa7ba9df84d3d6ab1ba88a4220345 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Nov 2021 19:23:31 +0800 Subject: [PATCH 338/367] Fix pixel scroll for overlays and text in display properties * lisp/pixel-scroll.el (pixel-scroll-precision-scroll-down): Just set vscroll if we're scrolling through an overlay or something to that effect. --- lisp/pixel-scroll.el | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 92f66c89cef..4280dc2587b 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -408,11 +408,18 @@ the height of the current window." (let* ((desired-pos (posn-at-x-y 0 (+ delta (window-tab-line-height) (window-header-line-height)))) + (object (posn-object desired-pos)) (desired-start (posn-point desired-pos)) (desired-vscroll (cdr (posn-object-x-y desired-pos)))) - (unless (eq (window-start) desired-start) - (set-window-start nil desired-start t)) - (set-window-vscroll nil desired-vscroll t)))) + (if (or (consp object) (stringp object)) + ;; We are either on an overlay or a string, so set vscroll + ;; directly. + (set-window-vscroll nil (+ (window-vscroll nil t) + delta) + t) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t))))) (defun pixel-scroll-precision-scroll-up (delta) "Scroll the current window up by DELTA pixels." From f97539876af597e2497bfde68a68878166406302 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Nov 2021 19:14:43 +0800 Subject: [PATCH 339/367] Improve documentation of wheel events * doc/lispref/commands.texi (Misc Events): Add missing parameters to `wheel-up' and `wheel-down'. --- doc/lispref/commands.texi | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index c12a97cc7df..86f84684b46 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1995,15 +1995,19 @@ frame has already been made visible, Emacs has no work to do. @cindex @code{wheel-up} event @cindex @code{wheel-down} event -@item (wheel-up @var{position}) -@itemx (wheel-down @var{position}) +@item (wheel-up @var{position} @var{clicks} @var{lines} @var{pixel-delta}) +@itemx (wheel-down @var{position} @var{clicks} @var{lines} @var{pixel-delta}) These kinds of event are generated by moving a mouse wheel. The @var{position} element is a mouse position list (@pxref{Click Events}), specifying the position of the mouse cursor when the event -occurred. The event may have additional arguments after -@var{position}. The third argument after @var{position}, if present, -is a pair of the form @w{@code{(@var{x} . @var{y})}}, where @var{x} -and @var{y} are the number of pixels to scroll by in each axis. +occurred. + +@var{clicks}, if present, is the number of times in quick succession +the wheel has been moved. @xref{Repeat Events}. @var{lines}, if +present and not @code{nil}, is the number of screen lines that should +be scrolled. @var{pixel-delta}, if present, is a pair of the form +@w{@code{(@var{x} . @var{y})}}, where @var{x} and @var{y} are the +number of pixels to scroll by in each axis. @cindex pixel-resolution wheel events You can use @var{x} and @var{y} to determine how much the mouse wheel From a937f536b35351842756bac939f21ae5f937fa61 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Nov 2021 15:01:46 +0200 Subject: [PATCH 340/367] * doc/lispref/commands.texi (Click Events): Fix wording (bug#52142). --- doc/lispref/commands.texi | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6e1d09ebb4d..35ef61700c2 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1558,8 +1558,10 @@ corner of @var{object}, which is @code{(0 . 0)}. If @var{object} is the top left corner of the character glyph clicked on. @item @var{width}, @var{height} -These are the pixel width and height of @var{object} or, if this is -@code{nil}, those of the character glyph clicked on. +If the click is on a character, either from buffer text or from +overlay or display string, these are the pixel width and height of +that character's glyph; otherwise they are dimensions of @var{object} +clicked on. @end table For clicks on a scroll bar, @var{position} has this form: From a89731a78c8cb019a18d2e70fe43d21286d88ab1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Nov 2021 17:09:51 +0200 Subject: [PATCH 341/367] Avoid assertion violations in --enable-checking builds * src/xdisp.c (gui_produce_glyphs): Make sure character glyphs don't trigger assertion violation due to negative ascent or descent. This was reporte dto happen with some fonts used by the xfont backend. --- src/xdisp.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/xdisp.c b/src/xdisp.c index 24049ab4e33..9f93799783d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -31199,6 +31199,11 @@ gui_produce_glyphs (struct it *it) it->max_ascent = max (it->max_ascent, font_ascent); it->max_descent = max (it->max_descent, font_descent); } + + if (it->ascent < 0) + it->ascent = 0; + if (it->descent < 0) + it->descent = 0; } else if (it->what == IT_COMPOSITION && it->cmp_it.ch < 0) { From 8d67a70e97a7002682f641c05b10e1a9d4586e8b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 27 Nov 2021 10:10:26 -0500 Subject: [PATCH 342/367] * test/src/comp-tests.el: Rework last patch Move `require`s out of `eval-when-compile` if the functions are called at run-time. Don't use #' to quote symbols (i.e. at those places where a lambda expression couldn't be used). Don't pre-load comp-test-45603.el and comp-test-pure.el any more. (comp-deftest pure): Use `declare-function` after loading `comp-test-pure.el` to silence the byte-compiler. --- test/src/comp-tests.el | 57 +++++++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index f66a1932058..5b20cf38ec6 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -27,27 +27,24 @@ (require 'ert) (require 'ert-x) -(eval-when-compile - (require 'cl-lib) - (require 'comp)) +(require 'cl-lib) +(require 'comp) +(require 'comp-cstr) + (eval-and-compile - (require 'comp-cstr) ;in eval-and-compile for its defstruct (defconst comp-test-src (ert-resource-file "comp-test-funcs.el")) - (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el")) - (defconst comp-test-pure-src (ert-resource-file "comp-test-pure.el")) - (defconst comp-test-45603-src (ert-resource-file "comp-test-45603.el")) - ;; Load the test code here so the compiler can check the function - ;; names used in this file. - (load comp-test-src nil t) - (load comp-test-dyn-src nil t) - (load comp-test-pure-src nil t) - (load comp-test-45603-src nil t)) + (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el"))) (when (native-comp-available-p) (message "Compiling tests...") (load (native-compile comp-test-src)) (load (native-compile comp-test-dyn-src))) +;; Load the test code here so the compiler can check the function +;; names used in this file. +(require 'comp-test-funcs comp-test-src) +(require 'comp-test-dyn-funcs comp-test-dyn-src) ;Non-standard feature name! + (defmacro comp-deftest (name args &rest docstring-and-body) "Define a test for the native compiler tagging it as :nativecomp." (declare (indent defun) @@ -75,7 +72,7 @@ Check that the resulting binaries do not differ." (copy-file comp-src comp2-src t) (let ((load-no-native t)) (load (concat comp-src "c") nil nil t t)) - (should-not (subr-native-elisp-p (symbol-function #'native-compile))) + (should-not (subr-native-elisp-p (symbol-function 'native-compile))) (message "Compiling stage1...") (let* ((t0 (current-time)) (comp1-eln (native-compile comp1-src))) @@ -372,7 +369,7 @@ Check that the resulting binaries do not differ." t) (native-compile #'comp-tests-free-fun-f) - (should (subr-native-elisp-p (symbol-function #'comp-tests-free-fun-f))) + (should (subr-native-elisp-p (symbol-function 'comp-tests-free-fun-f))) (should (= (comp-tests-free-fun-f) 3)) (should (string= (documentation #'comp-tests-free-fun-f) "Some doc.")) @@ -386,7 +383,7 @@ Check that the resulting binaries do not differ." "Check we are able to compile a single function." (eval '(defun comp-tests/free\fun-f ()) t) (native-compile #'comp-tests/free\fun-f) - (should (subr-native-elisp-p (symbol-function #'comp-tests/free\fun-f)))) + (should (subr-native-elisp-p (symbol-function 'comp-tests/free\fun-f)))) (comp-deftest bug-40187 () "Check function name shadowing. @@ -397,7 +394,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest speed--1 () "Check that at speed -1 we do not native compile." (should (= (comp-test-speed--1-f) 3)) - (should-not (subr-native-elisp-p (symbol-function #'comp-test-speed--1-f)))) + (should-not (subr-native-elisp-p (symbol-function 'comp-test-speed--1-f)))) (comp-deftest bug-42360 () "." @@ -446,7 +443,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest primitive-redefine () "Test effectiveness of primitive redefinition." (cl-letf ((comp-test-primitive-redefine-args nil) - ((symbol-function #'-) + ((symbol-function '-) (lambda (&rest args) (setq comp-test-primitive-redefine-args args) 'xxx))) @@ -467,11 +464,11 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest comp-test-defsubst () ;; Bug#42664, Bug#43280, Bug#44209. - (should-not (subr-native-elisp-p (symbol-function #'comp-test-defsubst-f)))) + (should-not (subr-native-elisp-p (symbol-function 'comp-test-defsubst-f)))) (comp-deftest primitive-redefine-compile-44221 () "Test the compiler still works while primitives are redefined (bug#44221)." - (cl-letf (((symbol-function #'delete-region) + (cl-letf (((symbol-function 'delete-region) (lambda (_ _)))) (should (subr-native-elisp-p (native-compile @@ -506,13 +503,13 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest 45603-1 () "" - (load (native-compile comp-test-45603-src)) - (should (fboundp #'comp-test-45603--file-local-name))) + (load (native-compile (ert-resource-file "comp-test-45603.el"))) + (should (fboundp 'comp-test-45603--file-local-name))) (comp-deftest 46670-1 () "" (should (string= (comp-test-46670-2-f "foo") "foo")) - (should (equal (subr-type (symbol-function #'comp-test-46670-2-f)) + (should (equal (subr-type (symbol-function 'comp-test-46670-2-f)) '(function (t) t)))) (comp-deftest 46824-1 () @@ -742,7 +739,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (comp-deftest dynamic-help-arglist () "Test `help-function-arglist' works on lisp/d (bug#42572)." (should (equal (help-function-arglist - (symbol-function #'comp-tests-ffuncall-callee-opt-rest-dyn-f) + (symbol-function 'comp-tests-ffuncall-callee-opt-rest-dyn-f) t) '(a b &optional c &rest d)))) @@ -815,7 +812,7 @@ Return a list of results." (comp-tests-tco-f (+ a b) a (- count 1)))) t) (native-compile #'comp-tests-tco-f) - (should (subr-native-elisp-p (symbol-function #'comp-tests-tco-f))) + (should (subr-native-elisp-p (symbol-function 'comp-tests-tco-f))) (should (= (comp-tests-tco-f 1 0 10) 55)))) (defun comp-tests-fw-prop-checker-1 (_) @@ -842,7 +839,7 @@ Return a list of results." (length c))) ; <= has to optimize t) (native-compile #'comp-tests-fw-prop-1-f) - (should (subr-native-elisp-p (symbol-function #'comp-tests-fw-prop-1-f))) + (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) (should (= (comp-tests-fw-prop-1-f) 6)))) (defun comp-tests-check-ret-type-spec (func-form ret-type) @@ -1421,12 +1418,14 @@ folded." (let ((native-comp-speed 3) (comp-post-pass-hooks '((comp-final comp-tests-pure-checker-1 comp-tests-pure-checker-2)))) - (load (native-compile comp-test-pure-src)) + (load (native-compile (ert-resource-file "comp-test-pure.el"))) + (declare-function comp-tests-pure-caller-f nil) + (declare-function comp-tests-pure-fibn-entry-f nil) - (should (subr-native-elisp-p (symbol-function #'comp-tests-pure-caller-f))) + (should (subr-native-elisp-p (symbol-function 'comp-tests-pure-caller-f))) (should (= (comp-tests-pure-caller-f) 4)) - (should (subr-native-elisp-p (symbol-function #'comp-tests-pure-fibn-entry-f))) + (should (subr-native-elisp-p (symbol-function 'comp-tests-pure-fibn-entry-f))) (should (= (comp-tests-pure-fibn-entry-f) 6765)))) (defvar comp-tests-cond-rw-checked-function nil From 338f7802373f1cfcc1b3749bbd46091fdef727f4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 27 Nov 2021 16:53:05 +0100 Subject: [PATCH 343/367] Simplify use of artifacts in emba files * test/infra/gitlab-ci.yml (.test-template): Re-insert. (test-all-inotify, test-filenotify-gio, test-gnustep) (test-native-comp-speed0): * test/infra/Makefile.in (subdir_template): Use it when appropriate. Remove artifacts. * test/infra/test-jobs.yml: Regenerate. --- test/infra/Makefile.in | 9 +- test/infra/gitlab-ci.yml | 43 ++---- test/infra/test-jobs.yml | 288 +++++---------------------------------- 3 files changed, 45 insertions(+), 295 deletions(-) diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index d9fc0196257..fd11d367983 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -71,7 +71,7 @@ define subdir_template @echo >>$(FILE) @echo 'test-$(subst /,-,$(1))-inotify:' >>$(FILE) @echo ' stage: normal' >>$(FILE) - @echo ' extends: [.job-template]' >>$(FILE) + @echo ' extends: [.job-template, .test-template]' >>$(FILE) @echo ' needs:' >>$(FILE) @echo ' - job: build-image-inotify' >>$(FILE) @echo ' optional: true' >>$(FILE) @@ -82,13 +82,6 @@ define subdir_template $(changes) @echo ' - test/$(1)/*.el' >>$(FILE) @echo ' - test/$(1)/*resources/**' >>$(FILE) - @echo ' artifacts:' >>$(FILE) - @echo ' name: $(tn)' >>$(FILE) - @echo ' public: true' >>$(FILE) - @echo ' expire_in: 1 week' >>$(FILE) - @echo ' paths:' >>$(FILE) - @echo ' - $(tn)/$(1)/*.log' >>$(FILE) - @echo ' when: always' >>$(FILE) @echo ' variables:' >>$(FILE) @echo ' target: emacs-inotify' >>$(FILE) @echo ' make_params: "-C test $(target)"' >>$(FILE) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index dd36d19b3da..759b8f69801 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -127,6 +127,15 @@ default: - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba . - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} +.test-template: + artifacts: + name: ${test_name} + public: true + expire_in: 1 week + paths: + - "${test_name}/**/*.log" + when: always + .gnustep-template: rules: - if: '$CI_PIPELINE_SOURCE == "web"' @@ -189,7 +198,7 @@ include: '/test/infra/test-jobs.yml' test-all-inotify: # This tests also file monitor libraries inotify and inotifywatch. stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -197,13 +206,6 @@ test-all-inotify: # Note there's no "changes" section, so this always runs on a schedule. - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - "${test_name}/**/*.log" - when: always variables: target: emacs-inotify make_params: check-expensive @@ -217,17 +219,10 @@ build-image-filenotify-gio: test-filenotify-gio: # This tests file monitor libraries gfilemonitor and gio. stage: platforms - extends: [.job-template, .filenotify-gio-template] + extends: [.job-template, .test-template, .filenotify-gio-template] needs: - job: build-image-filenotify-gio optional: true - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - "${test_name}/**/*.log" - when: always variables: target: emacs-filenotify-gio make_params: "-k -C test autorevert-tests.log filenotify-tests.log" @@ -245,13 +240,6 @@ test-gnustep: needs: - job: build-image-gnustep optional: true - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - "${test_name}/**/*.log" - when: always variables: target: emacs-gnustep make_params: install @@ -276,17 +264,10 @@ build-native-comp-speed2: test-native-comp-speed0: stage: native-comp - extends: [.job-template, .native-comp-template] + extends: [.job-template, .test-template, .native-comp-template] needs: - job: build-native-comp-speed0 optional: true - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - "${test_name}/**/*.log" - when: always variables: target: emacs-native-comp-speed0 make_params: "-C test check SELECTOR='(not (tag :unstable))'" diff --git a/test/infra/test-jobs.yml b/test/infra/test-jobs.yml index 33a90d6f2cb..bad8575b5c5 100644 --- a/test/infra/test-jobs.yml +++ b/test/infra/test-jobs.yml @@ -1,7 +1,7 @@ test-lib-src-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -12,20 +12,13 @@ test-lib-src-inotify: - lib-src/*.{h,c} - test/lib-src/*.el - test/lib-src/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lib-src/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lib-src" test-lisp-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -36,20 +29,13 @@ test-lisp-inotify: - lisp/*.el - test/lisp/*.el - test/lisp/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp" test-lisp-calc-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -60,20 +46,13 @@ test-lisp-calc-inotify: - lisp/calc/*.el - test/lisp/calc/*.el - test/lisp/calc/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/calc/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-calc" test-lisp-calendar-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -84,20 +63,13 @@ test-lisp-calendar-inotify: - lisp/calendar/*.el - test/lisp/calendar/*.el - test/lisp/calendar/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/calendar/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-calendar" test-lisp-cedet-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -108,20 +80,13 @@ test-lisp-cedet-inotify: - lisp/cedet/*.el - test/lisp/cedet/*.el - test/lisp/cedet/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/cedet/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet" test-lisp-cedet-semantic-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -132,20 +97,13 @@ test-lisp-cedet-semantic-inotify: - lisp/cedet/semantic/*.el - test/lisp/cedet/semantic/*.el - test/lisp/cedet/semantic/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/cedet/semantic/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet-semantic" test-lisp-cedet-semantic-bovine-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -156,20 +114,13 @@ test-lisp-cedet-semantic-bovine-inotify: - lisp/cedet/semantic/bovine/*.el - test/lisp/cedet/semantic/bovine/*.el - test/lisp/cedet/semantic/bovine/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/cedet/semantic/bovine/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet-semantic-bovine" test-lisp-cedet-srecode-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -180,20 +131,13 @@ test-lisp-cedet-srecode-inotify: - lisp/cedet/srecode/*.el - test/lisp/cedet/srecode/*.el - test/lisp/cedet/srecode/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/cedet/srecode/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-cedet-srecode" test-lisp-emacs-lisp-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -204,20 +148,13 @@ test-lisp-emacs-lisp-inotify: - lisp/emacs-lisp/*.el - test/lisp/emacs-lisp/*.el - test/lisp/emacs-lisp/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/emacs-lisp/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emacs-lisp" test-lisp-emacs-lisp-eieio-tests-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -228,20 +165,13 @@ test-lisp-emacs-lisp-eieio-tests-inotify: - lisp/emacs-lisp/eieio*.el - test/lisp/emacs-lisp/eieio-tests/*.el - test/lisp/emacs-lisp/eieio-tests/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/emacs-lisp/eieio-tests/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emacs-lisp-eieio-tests" test-lisp-emacs-lisp-faceup-tests-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -252,20 +182,13 @@ test-lisp-emacs-lisp-faceup-tests-inotify: - lisp/emacs-lisp/faceup*.el - test/lisp/emacs-lisp/faceup-tests/*.el - test/lisp/emacs-lisp/faceup-tests/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/emacs-lisp/faceup-tests/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emacs-lisp-faceup-tests" test-lisp-emulation-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -276,20 +199,13 @@ test-lisp-emulation-inotify: - lisp/emulation/*.el - test/lisp/emulation/*.el - test/lisp/emulation/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/emulation/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-emulation" test-lisp-erc-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -300,20 +216,13 @@ test-lisp-erc-inotify: - lisp/erc/*.el - test/lisp/erc/*.el - test/lisp/erc/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/erc/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-erc" test-lisp-eshell-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -324,20 +233,13 @@ test-lisp-eshell-inotify: - lisp/eshell/*.el - test/lisp/eshell/*.el - test/lisp/eshell/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/eshell/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-eshell" test-lisp-gnus-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -348,20 +250,13 @@ test-lisp-gnus-inotify: - lisp/gnus/*.el - test/lisp/gnus/*.el - test/lisp/gnus/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/gnus/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-gnus" test-lisp-image-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -372,20 +267,13 @@ test-lisp-image-inotify: - lisp/image/*.el - test/lisp/image/*.el - test/lisp/image/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/image/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-image" test-lisp-international-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -396,20 +284,13 @@ test-lisp-international-inotify: - lisp/international/*.el - test/lisp/international/*.el - test/lisp/international/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/international/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-international" test-lisp-mail-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -420,20 +301,13 @@ test-lisp-mail-inotify: - lisp/mail/*.el - test/lisp/mail/*.el - test/lisp/mail/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/mail/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-mail" test-lisp-mh-e-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -444,20 +318,13 @@ test-lisp-mh-e-inotify: - lisp/mh-e/*.el - test/lisp/mh-e/*.el - test/lisp/mh-e/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/mh-e/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-mh-e" test-lisp-net-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -468,20 +335,13 @@ test-lisp-net-inotify: - lisp/net/*.el - test/lisp/net/*.el - test/lisp/net/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/net/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-net" test-lisp-nxml-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -492,20 +352,13 @@ test-lisp-nxml-inotify: - lisp/nxml/*.el - test/lisp/nxml/*.el - test/lisp/nxml/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/nxml/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-nxml" test-lisp-obsolete-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -516,20 +369,13 @@ test-lisp-obsolete-inotify: - lisp/obsolete/*.el - test/lisp/obsolete/*.el - test/lisp/obsolete/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/obsolete/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-obsolete" test-lisp-org-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -540,20 +386,13 @@ test-lisp-org-inotify: - lisp/org/*.el - test/lisp/org/*.el - test/lisp/org/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/org/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-org" test-lisp-play-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -564,20 +403,13 @@ test-lisp-play-inotify: - lisp/play/*.el - test/lisp/play/*.el - test/lisp/play/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/play/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-play" test-lisp-progmodes-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -588,20 +420,13 @@ test-lisp-progmodes-inotify: - lisp/progmodes/*.el - test/lisp/progmodes/*.el - test/lisp/progmodes/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/progmodes/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-progmodes" test-lisp-so-long-tests-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -612,20 +437,13 @@ test-lisp-so-long-tests-inotify: - lisp/so-long*.el - test/lisp/so-long-tests/*.el - test/lisp/so-long-tests/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/so-long-tests/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-so-long-tests" test-lisp-term-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -636,20 +454,13 @@ test-lisp-term-inotify: - lisp/term/*.el - test/lisp/term/*.el - test/lisp/term/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/term/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-term" test-lisp-textmodes-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -660,20 +471,13 @@ test-lisp-textmodes-inotify: - lisp/textmodes/*.el - test/lisp/textmodes/*.el - test/lisp/textmodes/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/textmodes/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-textmodes" test-lisp-url-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -684,20 +488,13 @@ test-lisp-url-inotify: - lisp/url/*.el - test/lisp/url/*.el - test/lisp/url/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/url/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-url" test-lisp-vc-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -708,20 +505,13 @@ test-lisp-vc-inotify: - lisp/vc/*.el - test/lisp/vc/*.el - test/lisp/vc/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/lisp/vc/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-lisp-vc" test-misc-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -732,20 +522,13 @@ test-misc-inotify: - admin/*.el - test/misc/*.el - test/misc/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/misc/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-misc" test-src-inotify: stage: normal - extends: [.job-template] + extends: [.job-template, .test-template] needs: - job: build-image-inotify optional: true @@ -756,13 +539,6 @@ test-src-inotify: - src/*.{h,c} - test/src/*.el - test/src/*resources/** - artifacts: - name: ${test_name} - public: true - expire_in: 1 week - paths: - - ${test_name}/src/*.log - when: always variables: target: emacs-inotify make_params: "-C test check-src" From b8b2dd17c57b73357cae229e010138fd2352a46f Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 27 Nov 2021 16:24:31 -0500 Subject: [PATCH 344/367] Update to Org 9.5.1-11-g96d91b --- doc/misc/org.org | 12 +++++++++++ etc/refcards/orgcard.tex | 2 +- lisp/org/oc-csl.el | 3 ++- lisp/org/oc.el | 43 ++++++++++++++++++++-------------------- lisp/org/org-table.el | 2 +- lisp/org/org-version.el | 4 ++-- lisp/org/ox.el | 3 +++ 7 files changed, 43 insertions(+), 26 deletions(-) diff --git a/doc/misc/org.org b/doc/misc/org.org index df2724dd9c0..85117714ee9 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -10811,6 +10811,18 @@ To turn off fontification for marked up text, you can set ~org-fontify-emphasized-text~ to ~nil~. To narrow down the list of available markup syntax, you can customize ~org-emphasis-alist~. +Sometimes, when marked text also contains the marker character itself, +the result may be unsettling. For example, + +#+begin_example +/One may expect this whole sentence to be italicized, but the +following ~user/?variable~ contains =/= character, which effectively +stops emphasis there./ +#+end_example + +You can use zero width space to help Org sorting out the ambiguity. +See [[*Escape Character]] for more details. + ** Subscripts and Superscripts :PROPERTIES: :DESCRIPTION: Simple syntax for raising/lowering text. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index d3715948d65..181516172d2 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.5} +\def\orgversionnumber{9.5.1} \def\versionyear{2021} % latest update \input emacsver.tex diff --git a/lisp/org/oc-csl.el b/lisp/org/oc-csl.el index 7cd63c3ff3a..7f078d139b1 100644 --- a/lisp/org/oc-csl.el +++ b/lisp/org/oc-csl.el @@ -283,7 +283,8 @@ Label is in match group 1.") ;;; Internal functions (defun org-cite-csl--barf-without-citeproc () "Raise an error if Citeproc library is not loaded." - (unless (featurep 'citeproc) "Citeproc library is not loaded")) + (unless (featurep 'citeproc) + (error "Citeproc library is not loaded"))) (defun org-cite-csl--note-style-p (info) "Non-nil when bibliography style implies wrapping citations in footnotes. diff --git a/lisp/org/oc.el b/lisp/org/oc.el index 41fd688c060..427c087c036 100644 --- a/lisp/org/oc.el +++ b/lisp/org/oc.el @@ -1141,17 +1141,14 @@ and must return either a string, an object, or a secondary string." ;;; Internal interface with fontification (activate capability) -(defun org-cite-fontify-default (datum) - "Fontify DATUM with `org-cite' and `org-cite-key' face. -DATUM is a citation object, or a citation reference. In any case, apply -`org-cite' face on the whole citation, and `org-cite-key' face on each key." - (let* ((cite (if (eq 'citation-reference (org-element-type datum)) - (org-element-property :parent datum) - datum)) - (beg (org-element-property :begin cite)) - (end (org-with-point-at (org-element-property :end cite) - (skip-chars-backward " \t") - (point)))) +(defun org-cite-fontify-default (cite) + "Fontify CITE with `org-cite' and `org-cite-key' faces. +CITE is a citation object. The function applies `org-cite' face +on the whole citation, and `org-cite-key' face on each key." + (let ((beg (org-element-property :begin cite)) + (end (org-with-point-at (org-element-property :end cite) + (skip-chars-backward " \t") + (point)))) (add-text-properties beg end '(font-lock-multiline t)) (add-face-text-property beg end 'org-cite) (dolist (reference (org-cite-get-references cite)) @@ -1163,16 +1160,20 @@ DATUM is a citation object, or a citation reference. In any case, apply "Activate citations from up to LIMIT buffer position. Each citation encountered is activated using the appropriate function from the processor set in `org-cite-activate-processor'." - (let ((name org-cite-activate-processor)) - (let ((activate - (or (and name - (org-cite-processor-has-capability-p name 'activate) - (org-cite-processor-activate (org-cite--get-processor name))) - #'org-cite-fontify-default))) - (while (re-search-forward org-element-citation-prefix-re limit t) - (let ((cite (org-with-point-at (match-beginning 0) - (org-element-citation-parser)))) - (when cite (save-excursion (funcall activate cite)))))))) + (let* ((name org-cite-activate-processor) + (activate + (or (and name + (org-cite-processor-has-capability-p name 'activate) + (org-cite-processor-activate (org-cite--get-processor name))) + #'org-cite-fontify-default))) + (when (re-search-forward org-element-citation-prefix-re limit t) + (let ((cite (org-with-point-at (match-beginning 0) + (org-element-citation-parser)))) + (when cite + (funcall activate cite) + ;; Move after cite object and make sure to return + ;; a non-nil value. + (goto-char (org-element-property :end cite))))))) ;;; Internal interface with Org Export library (export capability) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 89c57fb06ce..e34872fb491 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -4436,7 +4436,7 @@ Optional argument NEW may specify text to replace the current field content." (col (org-table-current-column))) (when (> col 0) (skip-chars-backward "^|") - (if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")) + (if (not (looking-at " *\\(?:\\([^|\n]*?\\) *\\(|\\)\\|\\([^|\n]+?\\) *\\($\\)\\)")) (setq org-table-may-need-update t) (let* ((align (nth (1- col) org-table-last-alignment)) (width (nth (1- col) org-table-last-column-widths)) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 77b1cf4e5ff..212069e668f 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.5")) + (let ((org-release "9.5.1")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5-72-gc5d6656")) + (let ((org-git-version "release_9.5.1-11-g96d91b")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 9ab813a1b14..b27ec56c08c 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -1048,6 +1048,7 @@ BACKEND is a structure with `org-export-backend' type." (unless (org-export-backend-p backend) (error "Unknown \"%s\" back-end: Aborting export" backend))) +;;;###autoload (defun org-export-derived-backend-p (backend &rest backends) "Non-nil if BACKEND is derived from one of BACKENDS. BACKEND is an export back-end, as returned by, e.g., @@ -1858,6 +1859,7 @@ INFO is a plist containing export directives." (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) (and (functionp transcoder) transcoder))))) +;;;###autoload (defun org-export-data (data info) "Convert DATA into current back-end format. @@ -4586,6 +4588,7 @@ objects of the same type." ;; `org-export-raw-string' builds a pseudo-object out of a string ;; that any export back-end returns as-is. +;;;###autoload (defun org-export-raw-string (s) "Return a raw object containing string S. A raw string is exported as-is, with no additional processing From 2a4de5e5e5c3bb1d1022baf2b9a6f8b2acab4aa1 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Fri, 26 Nov 2021 13:59:14 -0800 Subject: [PATCH 345/367] Fix Subject when forwarding message with 2-line From * lisp/mh-e/mh-comp.el (mh-forwarded-letter-subject): Collapse two-line From headers into a single line (SF#266). Based on a suggestion from Lester Buck (many thanks!). --- lisp/mh-e/mh-comp.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 404b6b3ce75..e44c42e2800 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -638,6 +638,8 @@ See also `mh-compose-forward-as-mime-flag', (defun mh-forwarded-letter-subject (from subject) "Return a Subject suitable for a forwarded message. Original message has headers FROM and SUBJECT." + ;; Join continued lines. + (setq from (replace-regexp-in-string "\\s *\n\\s +" " " from)) (let ((addr-start (string-search "<" from)) (comment (string-search "(" from))) (cond ((and addr-start (> addr-start 0)) From 3c2afa66a217da84760849ed954245856f7e5810 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Nov 2021 09:06:11 +0800 Subject: [PATCH 346/367] Make `pixel-scroll-precision-scroll-up' work better with overlays * lisp/pixel-scroll.el (pixel-scroll-precision-scroll-up): Just set vscroll when on overlay. --- lisp/pixel-scroll.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 4280dc2587b..888320cf1ae 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -456,9 +456,14 @@ the height of the current window." (window-header-line-height)))) (desired-start (posn-point desired-pos)) (desired-vscroll (cdr (posn-object-x-y desired-pos)))) - (unless (eq (window-start) desired-start) - (set-window-start nil desired-start t)) - (set-window-vscroll nil desired-vscroll t)))))) + (let ((object (posn-object desired-pos))) + (if (or (consp object) (stringp object)) + (set-window-vscroll nil (+ (window-vscroll nil t) + (- delta)) + t) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))))))) ;; FIXME: This doesn't work when there's an image above the current ;; line that is taller than the window. From 08d1c405073f614d89bcdf7f6bd19e8c8aaf8356 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Nov 2021 10:11:53 +0800 Subject: [PATCH 347/367] Fix typos in configure.ac * configure.ac: Fix typos in wording of XInput 2 options. --- configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 9cf192d4ba9..c36dffde84c 100644 --- a/configure.ac +++ b/configure.ac @@ -487,7 +487,7 @@ OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support]) OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support]) OPTION_DEFAULT_OFF([native-compilation],[compile with Emacs Lisp native compiler support]) OPTION_DEFAULT_OFF([cygwin32-native-compilation],[use native compilation on 32-bit Cygwin]) -OPTION_DEFAULT_OFF([xinput2],[use version 2.0 the X Input Extension for input]) +OPTION_DEFAULT_OFF([xinput2],[use version 2 of the X Input Extension for input]) AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])], @@ -4389,7 +4389,7 @@ if test "${HAVE_X11}" = "yes" && test "${with_xinput2}" != "no"; then [AC_CHECK_LIB(Xi, XIGrabButton, HAVE_XINPUT2=yes)]) fi if test $HAVE_XINPUT2 = yes; then - AC_DEFINE(HAVE_XINPUT2, 1, [Define to 1 if the X Input Extension version 2.0 is present.]) + AC_DEFINE(HAVE_XINPUT2, 1, [Define to 1 if the X Input Extension version 2.0 or later is present.]) if test "$USE_GTK_TOOLKIT" = "GTK2"; then AC_MSG_WARN([You are building Emacs with GTK+ 2 and the X Input Extension version 2. This might lead to problems if your version of GTK+ is not built with support for XInput 2.]) From bd321f78eb8db839147a13a8543c0d3ca878f242 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Nov 2021 13:13:06 +0800 Subject: [PATCH 348/367] Fix xwidget popups on XI2 * src/gtkutil.c (xg_is_menu_window): Determine whether wdesc is a menu generated by a menu bar more reliably. * src/xwidget.c (xwidget_button_1): Release all XI2 grabs on click. --- src/gtkutil.c | 6 +++++- src/xwidget.c | 14 ++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/gtkutil.c b/src/gtkutil.c index 9e676cd025b..8f8db4ed372 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -853,7 +853,11 @@ xg_is_menu_window (Display *dpy, Window wdesc) { GtkWidget *fw = gtk_bin_get_child (GTK_BIN (gwdesc)); if (GTK_IS_MENU (fw)) - return true; + { + GtkWidget *parent + = gtk_menu_shell_get_parent_shell (GTK_MENU_SHELL (fw)); + return GTK_IS_MENU_BAR (parent); + } } return false; diff --git a/src/xwidget.c b/src/xwidget.c index 5da2aa1743b..e07b290acbf 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -907,6 +907,10 @@ xwidget_button_1 (struct xwidget_view *view, GdkEvent *xg_event = gdk_event_new (down_p ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE); struct xwidget *model = XXWIDGET (view->model); GtkWidget *target; +#ifdef HAVE_XINPUT2 + struct x_display_info *dpyinfo; + struct xi_device_t *xi_device; +#endif /* X and Y should be relative to the origin of view->wdesc. */ x += view->clip_left; @@ -930,6 +934,16 @@ xwidget_button_1 (struct xwidget_view *view, xg_event->button.time = time; xg_event->button.device = find_suitable_pointer (view->frame); +#ifdef HAVE_XINPUT2 + dpyinfo = FRAME_DISPLAY_INFO (view->frame); + for (int idx = 0; idx < dpyinfo->num_devices; ++idx) + { + xi_device = &dpyinfo->devices[idx]; + + XIUngrabDevice (view->dpy, xi_device->device_id, CurrentTime); + } +#endif + gtk_main_do_event (xg_event); gdk_event_free (xg_event); } From 3ce591804badfde86870aa02a1432e870028e531 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Nov 2021 13:43:19 +0800 Subject: [PATCH 349/367] Fix xwidget popups on XI2 again * src/xwidget.c (xwidget_button_1): Release seat grab. --- src/xwidget.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/xwidget.c b/src/xwidget.c index e07b290acbf..a5b96d01100 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -910,6 +910,8 @@ xwidget_button_1 (struct xwidget_view *view, #ifdef HAVE_XINPUT2 struct x_display_info *dpyinfo; struct xi_device_t *xi_device; + GdkSeat *seat; + GdkDevice *device; #endif /* X and Y should be relative to the origin of view->wdesc. */ @@ -936,12 +938,20 @@ xwidget_button_1 (struct xwidget_view *view, #ifdef HAVE_XINPUT2 dpyinfo = FRAME_DISPLAY_INFO (view->frame); + device = xg_event->button.device; + for (int idx = 0; idx < dpyinfo->num_devices; ++idx) { xi_device = &dpyinfo->devices[idx]; XIUngrabDevice (view->dpy, xi_device->device_id, CurrentTime); } + + if (device) + { + seat = gdk_device_get_seat (device); + gdk_seat_ungrab (seat); + } #endif gtk_main_do_event (xg_event); From 44c856dccc7891a9f762ebef1e386ac9eef0a920 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Nov 2021 07:39:22 +0000 Subject: [PATCH 350/367] Make haiku-win build correctly on non-Haiku systems * lisp/term/haiku-win.el (haiku-selection-targets): Add missing declaration. --- lisp/term/haiku-win.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 7861cfb9003..3c4d00f7f99 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -49,6 +49,7 @@ (declare-function x-handle-args "common-win") (declare-function haiku-selection-data "haikuselect.c") (declare-function haiku-selection-put "haikuselect.c") +(declare-function haiku-selection-targets "haikuselect.c") (declare-function haiku-put-resource "haikufns.c") (defun haiku--handle-x-command-line-resources (command-line-resources) From 1272a2cb6384e1d99586486a4903e17b43cbc3cd Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 28 Nov 2021 13:45:43 +0100 Subject: [PATCH 351/367] Adapt gitlab-ci.yml * test/infra/gitlab-ci.yml (variables): Set EMACS_TEST_TIMEOUT to 3600. (.job-template, .test-template): Another approach to catch test artifacts on emba. --- test/infra/gitlab-ci.yml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 759b8f69801..d12876e7727 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -44,8 +44,7 @@ workflow: variables: GIT_STRATEGY: fetch EMACS_EMBA_CI: 1 - # Three hours, see below. - EMACS_TEST_TIMEOUT: 10800 + EMACS_TEST_TIMEOUT: 3600 EMACS_TEST_VERBOSE: 1 # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled # DOCKER_HOST: tcp://docker:2376 @@ -91,9 +90,11 @@ default: # - docker ps -a # - printenv # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) + # Prepare test artifacts. - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} - # - ls -alR ${test_name} + - find ${test_name} ! -name "*.log" -type f -delete + - find ${test_name} -empty -type d -delete .build-template: needs: [] @@ -133,7 +134,7 @@ default: public: true expire_in: 1 week paths: - - "${test_name}/**/*.log" + - ${test_name}/ when: always .gnustep-template: From 1fffe9a210d328559da2af8facbb75286a31c74e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 28 Nov 2021 14:54:24 +0100 Subject: [PATCH 352/367] ; * lisp/org/org.el: Fix version header. --- lisp/org/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org/org.el b/lisp/org/org.el index 83b3d79cb17..1a137546192 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9,7 +9,7 @@ ;; Homepage: https://orgmode.org ;; Package-Requires: ((emacs "25.1")) -;; Version: 9.5 +;; Version: 9.5.1 ;; This file is part of GNU Emacs. ;; From 58128f9b0554f2a7fb1c6638b463f5d4fcd98c7c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 28 Nov 2021 17:05:32 +0100 Subject: [PATCH 353/367] ; Use /usr/bin/find in gitlab-ci.yml --- test/infra/gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index d12876e7727..4b97f5f0a84 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -93,8 +93,8 @@ default: # Prepare test artifacts. - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} - - find ${test_name} ! -name "*.log" -type f -delete - - find ${test_name} -empty -type d -delete + - /usr/bin/find ${test_name} ! -name "*.log" -type f -delete + - /usr/bin/find ${test_name} -empty -type d -delete .build-template: needs: [] From 1e8074f5ea9e61a6fba33ab2af0c79b9af7d7a24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 28 Nov 2021 18:00:44 +0100 Subject: [PATCH 354/367] Avoid unused argument warnings in lambda compiler macros * lisp/emacs-lisp/byte-run.el (byte-run--set-compiler-macro): Don't warn when a compiler macro with lambda-form expander does not use all the arguments of the function. Nobody expected any warning since the arguments look like free variables inside the lambda form. --- lisp/emacs-lisp/byte-run.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index d82d9454e84..ac3bb86a597 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -134,6 +134,7 @@ The return value of this function is not used." :autoload-end (eval-and-compile (defun ,cfname (,@(car data) ,@args) + (ignore ,@(remq '&rest (remq '&optional args))) ,@(cdr data)))))))) (defalias 'byte-run--set-doc-string From d50e0bdbac8e6683c6af4efa172c1b801d250486 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 28 Nov 2021 18:04:06 +0100 Subject: [PATCH 355/367] Use compiler macros for the key syntax checks Compile-time key string syntax checks are better written using compiler macros than with byte-hunk-handlers inside the compiler proper. * lisp/emacs-lisp/bytecomp.el (byte-compile-define-keymap) (byte-compile-define-keymap--define): Remove. * lisp/keymap.el (keymap--compile-check): New. (keymap-set, keymap-global-set, keymap-local-set, keymap-global-unset) (keymap-local-unset, keymap-unset, keymap-substitute) (keymap-set-after, key-translate, keymap-lookup, keymap-local-lookup) (keymap-global-lookup): Use compiler-macro for argument checks. * lisp/subr.el (define-keymap--compile): New. (define-keymap--define): Fold into define-keymap. (define-keymap): Use compiler-macro. (defvar-keymap): Use define-keymap. --- lisp/emacs-lisp/bytecomp.el | 63 ------------------------------------- lisp/keymap.el | 22 ++++++++++++- lisp/subr.el | 30 +++++++++++++++--- 3 files changed, 46 insertions(+), 69 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 566a3fdf99c..5ce5b2952b8 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5050,69 +5050,6 @@ binding slots have been popped." (_ (byte-compile-keep-pending form)))) - -;; Key syntax warnings. - -(mapc - (lambda (elem) - (put (car elem) 'byte-hunk-handler - (lambda (form) - (dolist (idx (cdr elem)) - (let ((key (elt form idx))) - (when (or (vectorp key) - (and (stringp key) - (not (key-valid-p key)))) - (byte-compile-warn "Invalid `kbd' syntax: %S" key)))) - form))) - ;; Functions and the place(s) for the key definition(s). - '((keymap-set 2) - (keymap-global-set 1) - (keymap-local-set 1) - (keymap-unset 2) - (keymap-global-unset 1) - (keymap-local-unset 1) - (keymap-substitute 2 3) - (keymap-set-after 2) - (key-translate 1 2) - (keymap-lookup 2) - (keymap-global-lookup 1) - (keymap-local-lookup 1))) - -(put 'define-keymap 'byte-hunk-handler #'byte-compile-define-keymap) -(defun byte-compile-define-keymap (form) - (let ((result nil) - (orig-form form)) - (push (pop form) result) - (while (and form - (keywordp (car form)) - (not (eq (car form) :menu))) - (unless (memq (car form) - '(:full :keymap :parent :suppress :name :prefix)) - (byte-compile-warn "Invalid keyword: %s" (car form))) - (push (pop form) result) - (when (null form) - (byte-compile-warn "Uneven number of keywords in %S" form)) - (push (pop form) result)) - ;; Bindings. - (while form - (let ((key (pop form))) - (when (stringp key) - (unless (key-valid-p key) - (byte-compile-warn "Invalid `kbd' syntax: %S" key))) - ;; No improvement. - (push key result)) - (when (null form) - (byte-compile-warn "Uneven number of key bindings in %S" form)) - (push (pop form) result)) - orig-form)) - -(put 'define-keymap--define 'byte-hunk-handler - #'byte-compile-define-keymap--define) -(defun byte-compile-define-keymap--define (form) - (when (consp (nth 1 form)) - (byte-compile-define-keymap (nth 1 form))) - form) - ;;; tags diff --git a/lisp/keymap.el b/lisp/keymap.el index a9331e16049..770a6ed20d1 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -31,6 +31,12 @@ (unless (key-valid-p key) (error "%S is not a valid key definition; see `key-valid-p'" key))) +(defun keymap--compile-check (&rest keys) + (dolist (key keys) + (when (or (vectorp key) + (and (stringp key) (not (key-valid-p key)))) + (byte-compile-warn "Invalid `kbd' syntax: %S" key)))) + (defun keymap-set (keymap key definition) "Set key sequence KEY to DEFINITION in KEYMAP. KEY is a string that satisfies `key-valid-p'. @@ -50,6 +56,7 @@ DEFINITION is anything that can be a key's definition: or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP, or an extended menu item definition. (See info node `(elisp)Extended Menu Items'.)" + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (keymap--check key) (define-key keymap (key-parse key) definition)) @@ -63,6 +70,7 @@ KEY is a string that satisfies `key-valid-p'. Note that if KEY has a local binding in the current buffer, that local binding will continue to shadow any global binding that you make with this function." + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (interactive (let* ((menu-prompting nil) (key (read-key-sequence "Set key globally: " nil t))) @@ -80,6 +88,7 @@ KEY is a string that satisfies `key-valid-p'. The binding goes in the current buffer's local map, which in most cases is shared with all other buffers in the same major mode." + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (interactive "KSet key locally: \nCSet key %s locally to command: ") (let ((map (current-local-map))) (unless map @@ -92,6 +101,7 @@ KEY is a string that satisfies `key-valid-p'. If REMOVE (interactively, the prefix arg), remove the binding instead of unsetting it. See `keymap-unset' for details." + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (interactive (list (key-description (read-key-sequence "Set key locally: ")) current-prefix-arg)) @@ -103,6 +113,7 @@ KEY is a string that satisfies `key-valid-p'. If REMOVE (interactively, the prefix arg), remove the binding instead of unsetting it. See `keymap-unset' for details." + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (interactive (list (key-description (read-key-sequence "Unset key locally: ")) current-prefix-arg)) @@ -118,6 +129,7 @@ makes a difference when there's a parent keymap. When unsetting a key in a child map, it will still shadow the same key in the parent keymap. Removing the binding will allow the key in the parent keymap to be used." + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (keymap--check key) (define-key keymap (key-parse key) nil remove)) @@ -131,6 +143,8 @@ If you don't specify OLDMAP, you can usually get the same results in a cleaner way with command remapping, like this: (define-key KEYMAP [remap OLDDEF] NEWDEF) \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" + (declare (compiler-macro + (lambda (form) (keymap--compile-check olddef newdef) form))) ;; Don't document PREFIX in the doc string because we don't want to ;; advertise it. It's meant for recursive calls only. Here's its ;; meaning @@ -170,7 +184,8 @@ Bindings are always added before any inherited map. The order of bindings in a keymap matters only when it is used as a menu, so this function is not useful for non-menu keymaps." - (declare (indent defun)) + (declare (indent defun) + (compiler-macro (lambda (form) (keymap--compile-check key) form))) (keymap--check key) (when after (keymap--check after)) @@ -350,6 +365,8 @@ This function creates a `keyboard-translate-table' if necessary and then modifies one entry in it. Both KEY and TO are strings that satisfy `key-valid-p'." + (declare (compiler-macro + (lambda (form) (keymap--compile-check from to) form))) (keymap--check from) (keymap--check to) (or (char-table-p keyboard-translate-table) @@ -389,6 +406,7 @@ position as returned by `event-start' and `event-end', and the lookup occurs in the keymaps associated with it instead of KEY. It can also be a number or marker, in which case the keymap properties at the specified buffer position instead of point are used." + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (keymap--check key) (when (and keymap (not position)) (error "Can't pass in both keymap and position")) @@ -408,6 +426,7 @@ The binding is probably a symbol with a function definition. If optional argument ACCEPT-DEFAULT is non-nil, recognize default bindings; see the description of `keymap-lookup' for more details about this." + (declare (compiler-macro (lambda (form) (keymap--compile-check keys) form))) (when-let ((map (current-local-map))) (keymap-lookup map keys accept-default))) @@ -424,6 +443,7 @@ bindings; see the description of `keymap-lookup' for more details about this. If MESSAGE (and interactively), message the result." + (declare (compiler-macro (lambda (form) (keymap--compile-check keys) form))) (interactive (list (key-description (read-key-sequence "Look up key in global keymap: ")) nil t)) diff --git a/lisp/subr.el b/lisp/subr.el index 06ea503da6a..78c72838f3f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6525,6 +6525,28 @@ not a list, return a one-element list containing OBJECT." object (list object))) +(defun define-keymap--compile (form &rest args) + ;; This compiler macro is only there for compile-time + ;; error-checking; it does not change the call in any way. + (while (and args + (keywordp (car args)) + (not (eq (car args) :menu))) + (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix)) + (byte-compile-warn "Invalid keyword: %s" (car args))) + (setq args (cdr args)) + (when (null args) + (byte-compile-warn "Uneven number of keywords in %S" form)) + (setq args (cdr args))) + ;; Bindings. + (while args + (let ((key (pop args))) + (when (and (stringp key) (not (key-valid-p key))) + (byte-compile-warn "Invalid `kbd' syntax: %S" key))) + (when (null args) + (byte-compile-warn "Uneven number of key bindings in %S" form)) + (setq args (cdr args))) + form) + (defun define-keymap (&rest definitions) "Create a new keymap and define KEY/DEFEFINITION pairs as key sequences. The new keymap is returned. @@ -6557,10 +6579,8 @@ also be the special symbol `:menu', in which case DEFINITION should be a MENU form as accepted by `easy-menu-define'. \(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" - (declare (indent defun)) - (define-keymap--define definitions)) - -(defun define-keymap--define (definitions) + (declare (indent defun) + (compiler-macro define-keymap--compile)) (let (full suppress parent name prefix keymap) ;; Handle keywords. (while (and definitions @@ -6632,7 +6652,7 @@ as the variable documentation string. (unless (zerop (% (length defs) 2)) (error "Uneven number of key/definition pairs: %s" defs)) `(defvar ,variable-name - (define-keymap--define (list ,@(nreverse opts) ,@defs)) + (define-keymap ,@(nreverse opts) ,@defs) ,@(and doc (list doc))))) (defmacro with-delayed-message (args &rest body) From 9a0492ca7c343cdad75573c17c517f7369067ea8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 28 Nov 2021 19:06:33 +0100 Subject: [PATCH 356/367] ; Don't use remq (breaks bootstrapping) --- lisp/emacs-lisp/byte-run.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index ac3bb86a597..2ce2efd2aa7 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -134,7 +134,7 @@ The return value of this function is not used." :autoload-end (eval-and-compile (defun ,cfname (,@(car data) ,@args) - (ignore ,@(remq '&rest (remq '&optional args))) + (ignore ,@(delq '&rest (delq '&optional (copy-sequence args)))) ,@(cdr data)))))))) (defalias 'byte-run--set-doc-string From 455b64c33657f05f614007947cc9028621ba21d7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 28 Nov 2021 20:18:16 +0200 Subject: [PATCH 357/367] * src/coding.c (Fdecode_coding_region, Fencode_coding_region): Doc fix. --- src/coding.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/coding.c b/src/coding.c index 02dccf5bdb0..f8004d202e5 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9454,8 +9454,9 @@ code_convert_region (Lisp_Object start, Lisp_Object end, DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region, 3, 4, "r\nzCoding system: ", - doc: /* Decode the current region from the specified coding system. -Interactively, prompt for the coding system to decode the region. + doc: /* Decode the current region using the specified coding system. +Interactively, prompt for the coding system to decode the region, and +replace the region with the decoded text. \"Decoding\" means transforming bytes into readable text (characters). If, for instance, you have a region that contains data that represents @@ -9485,7 +9486,9 @@ not fully specified.) */) DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region, 3, 4, "r\nzCoding system: ", - doc: /* Encode the current region by specified coding system. + doc: /* Encode the current region using th specified coding system. +Interactively, prompt for the coding system to encode the region, and +replace the region with the bytes that are the result of the encoding. What's meant by \"encoding\" is transforming textual data (characters) into bytes. If, for instance, you have a region that contains the From bca57086bef276cdd918edfa9f6e133899bbbbbb Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Sun, 28 Nov 2021 13:34:57 -0600 Subject: [PATCH 358/367] ; Remove an obsolete comment * src/editfns.c (Ftranspose_regions): Remove an obsolete comment about memmove, following up to commit 72af86bd8cf of 8 Jul 2010 by Andreas Schwab and commit 354f9f0fc6cc of 23 Feb 2016 by Fredrik Bergroth, both of which added calls to memmove. --- src/editfns.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index c8219decb06..5c9c34dc352 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4265,9 +4265,6 @@ ring. */) enough to use as the temporary storage? That would avoid an allocation... interesting. Later, don't fool with it now. */ - /* Working without memmove, for portability (sigh), so must be - careful of overlapping subsections of the array... */ - if (end1 == start2) /* adjacent regions */ { modify_text (start1, end2); From c8df4d1ca350e421adf49fb533627a6b1ef565bc Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 28 Nov 2021 22:59:35 +0100 Subject: [PATCH 359/367] Tweak gnus-art key binding * lisp/gnus/gnus-art.el (:keymap): Fix mnemonic key binding. --- lisp/gnus/gnus-art.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 9a56e3a9013..02f0d50be5d 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4440,7 +4440,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is "?" #'gnus-article-describe-briefly "<" #'beginning-of-buffer ">" #'end-of-buffer - "C-c TAB" #'gnus-info-find-node + "C-c C-i" #'gnus-info-find-node "C-c C-b" #'gnus-bug "R" #'gnus-article-reply-with-original "F" #'gnus-article-followup-with-original From 390361cb24e376e8a00647a7625a06d6cdcf9b4d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Nov 2021 12:39:16 +0800 Subject: [PATCH 360/367] Update XKB map on MappingNotify * src/xterm.c (handle_one_xevent): Update XKB map when X tells us the keyboard map has been updated. --- src/xterm.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/xterm.c b/src/xterm.c index 8045470bdd3..253e0eb20b0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9813,6 +9813,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_find_modifier_meanings (dpyinfo); FALLTHROUGH; case MappingKeyboard: +#ifdef HAVE_XKB + if (dpyinfo->xkb_desc) + XkbGetUpdatedMap (dpyinfo->display, XkbAllComponentsMask, + dpyinfo->xkb_desc); +#endif XRefreshKeyboardMapping ((XMappingEvent *) &event->xmapping); } goto OTHER; From c4daff9cf844ec85930bdcd2064787c92c260861 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 29 Nov 2021 05:57:13 +0100 Subject: [PATCH 361/367] * Makefile.in (PREFERRED_BRANCH): Now emacs-28. --- Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.in b/Makefile.in index 5fc1edc7a39..c36882d5bea 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1164,7 +1164,7 @@ ChangeLog: ./$(emacslog) -o $(CHANGELOG) -n $(CHANGELOG_HISTORY_INDEX_MAX) # Check that we are in a good state for changing history. -PREFERRED_BRANCH = emacs-27 +PREFERRED_BRANCH = emacs-28 preferred-branch-is-current: git branch | grep -q '^\* $(PREFERRED_BRANCH)$$' unchanged-history-files: From 0400b3c329b4bcfaea68ab24ae2d1857707a983d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Nov 2021 06:55:58 +0000 Subject: [PATCH 362/367] * doc/emacs/haiku.texi (Haiku Basics): Fix a typo. --- doc/emacs/haiku.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/haiku.texi b/doc/emacs/haiku.texi index a41804b2336..d2b7eb8408f 100644 --- a/doc/emacs/haiku.texi +++ b/doc/emacs/haiku.texi @@ -32,7 +32,7 @@ Haiku-specific application metadata, with the name @code{Emacs}. @cindex tty Emacs in haiku If you are launching Emacs from the Tracker, or want to make the Tracker open files using Emacs, you should use the binary named -@code{Emacs}; ff you are going to use Emacs in the terminal, or wish +@code{Emacs}; if you are going to use Emacs in the terminal, or wish to launch separate instances of Emacs, or do not care for the aforementioned system integration features, use the binary named @code{emacs} instead. From a1aa9cbf57a08f1c17b92b13a2bf07d504684fcc Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Nov 2021 07:12:25 +0000 Subject: [PATCH 363/367] Make overhangs in ftcrfont work on Haiku * src/ftcrfont.c (ftcrfont_draw): Dump left overhang clipping on Haiku and always set `background_filled_p'. --- src/ftcrfont.c | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 5d75f183570..820b3c0bd0c 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -539,13 +539,19 @@ ftcrfont_draw (struct glyph_string *s, return 0; } BView_cr_dump_clipping (FRAME_HAIKU_VIEW (f), cr); + + if (s->left_overhang && s->clip_head && !s->for_overlaps) + { + cairo_rectangle (cr, s->clip_head->x, 0, + FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); + cairo_clip (cr); + } #endif if (with_background) { #ifndef USE_BE_CAIRO x_set_cr_source_with_gc_background (f, s->gc); - s->background_filled_p = 1; #else struct face *face = s->face; @@ -556,6 +562,7 @@ ftcrfont_draw (struct glyph_string *s, GREEN_FROM_ULONG (col) / 255.0, BLUE_FROM_ULONG (col) / 255.0); #endif + s->background_filled_p = 1; cairo_rectangle (cr, x, y - FONT_BASE (face->font), s->width, FONT_HEIGHT (face->font)); cairo_fill (cr); From 618070d4b414c20f19a1f873ffb1d7015743599e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Nov 2021 15:36:15 +0800 Subject: [PATCH 364/367] Allow customizing the pixel delta of wheel events on X * lisp/cus-start.el: Add `x-scroll-event-delta-factor'. * src/xterm.c (handle_one_xevent): Apply scroll event delta factor to wheel events with pixel data. (Vx_scroll_event_delta_factor): New user option. --- lisp/cus-start.el | 1 + src/xterm.c | 9 +++++++++ 2 files changed, 10 insertions(+) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 68019c038e7..e895ebd5692 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -826,6 +826,7 @@ since it could result in memory overflow and make Emacs crash." (x-underline-at-descent-line display boolean "22.1") (x-stretch-cursor display boolean "21.1") (scroll-bar-adjust-thumb-portion windows boolean "24.4") + (x-scroll-event-delta-factor mouse float "29.1") ;; xselect.c (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c diff --git a/src/xterm.c b/src/xterm.c index 253e0eb20b0..a6d9c8c7a1b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10045,6 +10045,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0); + if (FLOATP (Vx_scroll_event_delta_factor)) + scroll_unit *= XFLOAT_DATA (Vx_scroll_event_delta_factor); + if (val->horizontal) { inev.ie.arg @@ -15217,4 +15220,10 @@ Otherwise, a wheel event will be sent every time the mouse wheel is moved. This option is only effective when Emacs is built with XInput 2, with Haiku windowing support, or with NS. */); x_coalesce_scroll_events = true; + + DEFVAR_LISP ("x-scroll-event-delta-factor", Vx_scroll_event_delta_factor, + doc: /* A scale to apply to pixel deltas reported in scroll events. +This option is only effective when Emacs is built with XInput 2 +support. */); + Vx_scroll_event_delta_factor = make_float (1.0); } From 4320180111422ad803f26a30e616f1f18efedb65 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Nov 2021 17:19:27 +0800 Subject: [PATCH 365/367] Fix last change for non-X platforms * lisp/cus-start.el: Don't announce `scroll-bar-adjust-thumb-portion' on non-X systems. --- lisp/cus-start.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index e895ebd5692..45b81e5bc5f 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -877,8 +877,10 @@ since it could result in memory overflow and make Emacs crash." (symbol-name symbol)) ;; Any function from fontset.c will do. (fboundp 'new-fontset)) - ((equal "scroll-bar-adjust-thumb-portion" - (symbol-name symbol)) + ((or (equal "scroll-bar-adjust-thumb-portion" + (symbol-name symbol)) + (equal "x-scroll-event-delta-factor" + (symbol-name symbol))) (featurep 'x)) (t t)))) (if (not (boundp symbol)) From 6943786b5c1fe76ea05a3a810512bd6777883710 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Mon, 29 Nov 2021 10:29:40 +0100 Subject: [PATCH 366/367] Avoid undefined behaviour when copying part of structure * src/dispnew.c (copy_row_except_pointers): Don't use address of subobject as starting point. --- src/dispnew.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dispnew.c b/src/dispnew.c index f3f110a8f27..a976bf94c5e 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -1034,7 +1034,7 @@ copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from) { enum { off = offsetof (struct glyph_row, x) }; - memcpy (&to->x, &from->x, sizeof *to - off); + memcpy ((char *) to + off, (char *) from + off, sizeof *to - off); } From d8dd705e9d82df96d67d88e1bf90373b6b4fbaa9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Nov 2021 18:25:10 +0800 Subject: [PATCH 367/367] Really make `x-scroll-event-delta-factor' dependent on system * lisp/cus-start.el: Move X specific builtins that start with "x-" before the catch-all test. --- lisp/cus-start.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 45b81e5bc5f..33b861b3408 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -857,6 +857,11 @@ since it could result in memory overflow and make Emacs crash." (featurep 'gtk)) ((string-match "clipboard-manager" (symbol-name symbol)) (boundp 'x-select-enable-clipboard-manager)) + ((or (equal "scroll-bar-adjust-thumb-portion" + (symbol-name symbol)) + (equal "x-scroll-event-delta-factor" + (symbol-name symbol))) + (featurep 'x)) ((string-match "\\`x-" (symbol-name symbol)) (fboundp 'x-create-frame)) ((string-match "selection" (symbol-name symbol)) @@ -877,11 +882,6 @@ since it could result in memory overflow and make Emacs crash." (symbol-name symbol)) ;; Any function from fontset.c will do. (fboundp 'new-fontset)) - ((or (equal "scroll-bar-adjust-thumb-portion" - (symbol-name symbol)) - (equal "x-scroll-event-delta-factor" - (symbol-name symbol))) - (featurep 'x)) (t t)))) (if (not (boundp symbol)) ;; If variables are removed from C code, give an error here!