commit c5c6d5cf1c886635579142d67b743421043fe5d9 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sat Apr 16 04:04:25 2022 +0000 Add some missing multilingual keys to Haiku * src/haiku_support.cc (keysym_from_raw_char): Support keys found on some East Asian keyboards. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index ddcd908fd2..e7c157dac8 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -96,24 +96,29 @@ enum /* X11 keysyms that we use. */ enum { - KEY_BACKSPACE = 0xff08, - KEY_TAB = 0xff09, - KEY_RETURN = 0xff0d, - KEY_PAUSE = 0xff13, - KEY_ESCAPE = 0xff1b, - KEY_DELETE = 0xffff, - KEY_HOME = 0xff50, - KEY_LEFT_ARROW = 0xff51, - KEY_UP_ARROW = 0xff52, - KEY_RIGHT_ARROW = 0xff53, - KEY_DOWN_ARROW = 0xff54, - KEY_PAGE_UP = 0xff55, - KEY_PAGE_DOWN = 0xff56, - KEY_END = 0xff57, - KEY_PRINT = 0xff61, - KEY_INSERT = 0xff63, + KEY_BACKSPACE = 0xff08, + KEY_TAB = 0xff09, + KEY_RETURN = 0xff0d, + KEY_PAUSE = 0xff13, + KEY_ESCAPE = 0xff1b, + KEY_DELETE = 0xffff, + KEY_HOME = 0xff50, + KEY_LEFT_ARROW = 0xff51, + KEY_UP_ARROW = 0xff52, + KEY_RIGHT_ARROW = 0xff53, + KEY_DOWN_ARROW = 0xff54, + KEY_PAGE_UP = 0xff55, + KEY_PAGE_DOWN = 0xff56, + KEY_END = 0xff57, + KEY_PRINT = 0xff61, + KEY_INSERT = 0xff63, /* This is used to indicate the first function key. */ - KEY_F1 = 0xffbe, + KEY_F1 = 0xffbe, + /* These are found on some multilingual keyboards. */ + KEY_HANGUL = 0xff31, + KEY_HANGUL_HANJA = 0xff34, + KEY_HIRIGANA_KATAGANA = 0xff27, + KEY_ZENKAKU_HANKAKU = 0xff2a, }; static color_space dpy_color_space = B_NO_COLOR_SPACE; @@ -302,6 +307,19 @@ keysym_from_raw_char (int32 raw, int32 key, unsigned *code) break; + case B_HANGUL: + *code = KEY_HANGUL; + break; + case B_HANGUL_HANJA: + *code = KEY_HANGUL_HANJA; + break; + case B_KATAKANA_HIRAGANA: + *code = KEY_HIRIGANA_KATAGANA; + break; + case B_HANKAKU_ZENKAKU: + *code = KEY_ZENKAKU_HANKAKU; + break; + default: return 0; } commit 1fed6e7b56d956668f2d4b5f99fc8592ddf66645 Author: Po Lu Date: Sat Apr 16 08:54:40 2022 +0800 Handle errors getting selection ownership when starting DND * src/xterm.c (x_clear_dnd_targets): New function. (x_dnd_begin_drag_and_drop): Handle errors in `x_own_selection'. diff --git a/src/xterm.c b/src/xterm.c index f80b2ad2f0..c5b31553ae 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9435,6 +9435,13 @@ x_top_window_to_frame (struct x_display_info *dpyinfo, int wdesc) #endif /* USE_X_TOOLKIT || USE_GTK */ +static void +x_clear_dnd_targets (void) +{ + if (x_dnd_unwind_flag) + x_set_dnd_targets (NULL, 0); +} + /* This function is defined far away from the rest of the XDND code so it can utilize `x_any_window_to_frame'. */ @@ -9479,8 +9486,16 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, } if (CONSP (local_value)) - x_own_selection (QXdndSelection, - Fnth (make_fixnum (1), local_value), frame); + { + ref = SPECPDL_INDEX (); + + record_unwind_protect_void (x_clear_dnd_targets); + x_dnd_unwind_flag = true; + x_own_selection (QXdndSelection, + Fnth (make_fixnum (1), local_value), frame); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + } else { x_set_dnd_targets (NULL, 0); commit c3ab8f188ef801ba2a8227a0732a75adeea315ab Author: Philip Kaludercic Date: Fri Apr 15 21:12:56 2022 +0200 Improve buffer-match-p documentation * doc/lispref/windows.texi (Choosing Window): Document that buffer-match-p is used by display-buffer-alist. * etc/NEWS: Mention buffer-match-p and match-buffers. * lisp/window.el (display-buffer-alist): Update documentation as for display-buffer-assq-regexp. (display-buffer-assq-regexp): Rename buffer-name to buffer-or-name. (display-buffer): Pass the buffer directly to display-buffer-assq-regexp,. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 43f222d57f..abc8adae83 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2596,13 +2596,11 @@ default value is an empty display action, i.e., @w{@code{(nil . nil)}}. @defopt display-buffer-alist The value of this option is an alist mapping conditions to display -actions. Each condition may be either a regular expression matching a -buffer name or a function that takes two arguments: a buffer name and -the @var{action} argument passed to @code{display-buffer}. If either -the name of the buffer passed to @code{display-buffer} matches a -regular expression in this alist, or the function specified by a -condition returns non-@code{nil}, then @code{display-buffer} uses the -corresponding display action to display the buffer. +actions. Each condition is passed to @code{buffer-match-p}, along +with the buffer name and the @var{action} argument passed to +@code{display-buffer}. If it returns a non-nil value, then +@code{display-buffer} uses the corresponding display action to display +the buffer. @end defopt @defopt display-buffer-base-action diff --git a/etc/NEWS b/etc/NEWS index 7d474ac107..14d970fe11 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1492,6 +1492,13 @@ them towards or away from each other. This hook is run before 'x-popup-menu' is about to display a deck-of-cards menu on screen. +** New function 'buffer-match-p' +Check if a buffer matches a condition, specified using a DSL. + +** New function 'match-buffers' +Use 'buffer-match-p' to gather a list of buffers that match a +condition. + ** Text security and suspiciousness +++ diff --git a/lisp/window.el b/lisp/window.el index 2da2f8bb2c..ea90995541 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7440,9 +7440,9 @@ Its value takes effect before processing the ACTION argument of If non-nil, this is an alist of elements (CONDITION . ACTION), where: - CONDITION is either a regexp matching buffer names, or a - function that takes two arguments - a buffer name and the - ACTION argument of `display-buffer' - and returns a boolean. + CONDITION is passed to `buffer-match-p', along with the buffer + that is to be displayed and the ACTION argument of + `display-buffer', to check if ACTION should be used. ACTION is a cons cell (FUNCTIONS . ALIST), where FUNCTIONS is an action function or a list of action functions and ALIST is an @@ -7495,14 +7495,14 @@ all fail. It should never be set by programs or users. See `display-buffer'.") (put 'display-buffer-fallback-action 'risky-local-variable t) -(defun display-buffer-assq-regexp (buffer-name alist action) +(defun display-buffer-assq-regexp (buffer-or-name alist action) "Retrieve ALIST entry corresponding to BUFFER-NAME. -This returns the cdr of the alist entry ALIST if either its key -satisfied a BUFFER-NAME per `buffer-match'. ACTION should have -the form of the action argument passed to `display-buffer'." +This returns the cdr of the alist entry ALIST if key and +buffer-or-name satisfy `buffer-match-p'. ACTION should have the +form of the action argument passed to `display-buffer'." (catch 'match (dolist (entry alist) - (when (buffer-match-p (car entry) buffer-name action) + (when (buffer-match-p (car entry) buffer-or-name action) (throw 'match (cdr entry)))))) (defvar display-buffer--same-window-action @@ -7672,7 +7672,7 @@ specified by the ACTION argument." ;; Otherwise, use the defined actions. (let* ((user-action (display-buffer-assq-regexp - (buffer-name buffer) display-buffer-alist action)) + buffer display-buffer-alist action)) (special-action (display-buffer--special-action buffer)) ;; Extra actions from the arguments to this function: (extra-action commit fdd8b5913baa3a8f7cbb8b51ad6d092a41c04a90 Author: Philip Kaludercic Date: Sat Mar 12 22:18:49 2022 +0100 Add rcirc-cycle-completion-flag * doc/misc/rcirc.texi: Document new option. * lisp/net/rcirc.el (rcirc-cycle-completion-flag): Add new option. (rcirc-mode): Respect new option. diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index b18ab2a6b2..8253e40408 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -154,8 +154,11 @@ deego: fsbot rules! @cindex nick completion @cindex completion of nicks +@vindex rcirc-cycle-completion-flag @kindex TAB Since this is so common, you can use @key{TAB} to do nick completion. +By default rcirc will use the default completion system, but you can +enable @code{rcirc-cycle-completion-flag} to cycle nicks in place. @node Getting started with rcirc @section Getting started with rcirc diff --git a/etc/NEWS b/etc/NEWS index 350a4f6da1..7d474ac107 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -506,6 +506,12 @@ are met. The conditions are given by the argument, which can be +++ *** New command 'rcirc-when'. ++++ +*** New user option 'rcirc-cycle-completion-flag'. +Rcirc will use the default 'completion-at-point' mechanism. The +conventional IRC behaviour of completing by cycling through the +available options can be restored by enabling this option. + * Editing Changes in Emacs 29.1 --- diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 9d1600ed72..5fe65cc7b3 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -433,6 +433,20 @@ will be killed." :version "28.1" :type 'boolean) +(defcustom rcirc-cycle-completion-flag nil + "Non-nil means to use cycling for completion in rcirc buffers. +See the Info node `(emacs) Completion Options' for background on +what cycling completion means." + :version "29.1" + :set (lambda (sym val) + (dolist (buf (match-buffers '(major-mode . rcirc-mode))) + (with-current-buffer buf + (if val + (setq-local completion-cycle-threshold t) + (kill-local-variable 'completion-cycle-threshold)))) + (set-default sym val)) + :type 'boolean) + (defvar-local rcirc-nick nil "The nickname used for the current connection.") @@ -1434,7 +1448,8 @@ PROCESS is the process object used for communication. (add-hook 'completion-at-point-functions 'rcirc-completion-at-point nil 'local) - (setq-local completion-cycle-threshold t) + (when rcirc-cycle-completion-flag + (setq-local completion-cycle-threshold t)) (run-mode-hooks 'rcirc-mode-hook)) commit dfee2790549df4be0fa841a00faafb50c9347f30 Author: Po Lu Date: Fri Apr 15 12:22:26 2022 +0000 Fix default registry of Haiku font backend * src/haiku_support.h (struct haiku_zoom_event): Fix coding style. (enum haiku_font_specification): Move FSPECs over here. * src/haikufont.c (haikufont_apply_registry) (haikufont_get_fallback_entity, haikufont_pattern_to_entity) (haikufont_spec_or_entity_to_pattern, haikufont_list): Use `iso10646-1' as the default registry instead of `utf8', which is not a registry. diff --git a/src/haiku_support.h b/src/haiku_support.h index 8462df268f..9935906f0e 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -221,19 +221,21 @@ struct haiku_menu_bar_help_event struct haiku_zoom_event { void *window; - bool zoomed; }; -#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) +enum haiku_font_specification + { + FSPEC_FAMILY = 1, + FSPEC_STYLE = 1 << 1, + FSPEC_SLANT = 1 << 2, + FSPEC_WEIGHT = 1 << 3, + FSPEC_SPACING = 1 << 4, + FSPEC_WANTED = 1 << 5, + FSPEC_NEED_ONE_OF = 1 << 6, + FSPEC_WIDTH = 1 << 7, + FSPEC_LANGUAGE = 1 << 8, + }; typedef char haiku_font_family_or_style[64]; @@ -395,11 +397,8 @@ extern "C" #ifdef __cplusplus typedef void *haiku; -extern void -haiku_put_pixel (haiku, int, int, unsigned long); - -extern unsigned long -haiku_get_pixel (haiku, int, int); +extern void haiku_put_pixel (haiku, int, int, unsigned long); +extern unsigned long haiku_get_pixel (haiku, int, int); #endif extern port_id port_application_to_emacs; diff --git a/src/haikufont.c b/src/haikufont.c index b9f6dc2fe8..f2ead5d6c2 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -149,6 +149,7 @@ haikufont_apply_registry (struct haiku_font_pattern *pattern, 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; @@ -183,7 +184,7 @@ haikufont_get_fallback_entity (void) 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_REGISTRY_INDEX, Qiso10646_1); 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)); @@ -387,7 +388,7 @@ haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) 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_REGISTRY_INDEX, Qiso10646_1); 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)); @@ -423,8 +424,7 @@ haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) } static void -haikufont_spec_or_entity_to_pattern (Lisp_Object ent, - int list_p, +haikufont_spec_or_entity_to_pattern (Lisp_Object ent, int list_p, struct haiku_font_pattern *ptn) { Lisp_Object tem; @@ -591,27 +591,29 @@ haikufont_match (struct frame *f, Lisp_Object font_spec) static Lisp_Object haikufont_list (struct frame *f, Lisp_Object font_spec) { - block_input (); - Lisp_Object lst = Qnil; + Lisp_Object lst, tem; + struct haiku_font_pattern ptn, *found, *pt; + lst = Qnil; + + block_input (); /* 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)); + 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); + found = BFont_find (&ptn); haikufont_done_with_query_pattern (&ptn); if (found) { - for (struct haiku_font_pattern *pt = found; - pt; pt = pt->next) + for (pt = found; pt; pt = pt->next) lst = Fcons (haikufont_pattern_to_entity (pt), lst); haiku_font_pattern_free (found); } commit 2d4c5f0b8594c85a4877da3dd9527cab3066dd17 Author: Lars Ingebrigtsen Date: Fri Apr 15 14:06:26 2022 +0200 Enable dragging resizing final column in vtable * lisp/emacs-lisp/vtable.el (vtable--insert-line): Insert the divider after the final column, too, so that the size can be dragged. diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 525dc9359f..7148844b63 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -522,8 +522,7 @@ This also updates the displayed table." ellipsis) value)))) (start (point)) - ;; Don't insert the separator and the divider after the - ;; final column. + ;; Don't insert the separator after the final column. (last (= index (- (length line) 2)))) (if (eq (vtable-column-align column) 'left) (progn @@ -552,7 +551,7 @@ This also updates the displayed table." (add-face-text-property start (point) (elt column-colors (mod index (length column-colors))))) - (when (and divider (not last)) + (when divider (insert divider) (setq start (point)))))) (cdr line)) commit 8e464272bdffeb6eb61c3335caea4b415e569549 Author: Po Lu Date: Fri Apr 15 11:58:09 2022 +0000 ; * src/haiku_support.h: Fix header coding style. diff --git a/src/haiku_support.h b/src/haiku_support.h index 237cedd8fc..8462df268f 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -632,10 +632,10 @@ extern bool be_drag_message (void *, void *, bool, void (*) (void), extern bool be_drag_and_drop_in_progress (void); #ifdef __cplusplus -extern void *find_appropriate_view_for_draw (void *vw); +extern void *find_appropriate_view_for_draw (void *); } -extern _Noreturn void gui_abort (const char *msg); +extern _Noreturn void gui_abort (const char *); #endif /* _cplusplus */ #endif /* _HAIKU_SUPPORT_H_ */ commit 4ac25d53af464b7436746ad230f59157c9b32b26 Author: Po Lu Date: Fri Apr 15 11:57:14 2022 +0000 Clean up keysyms from Haiku headers * src/haiku_support.cc (keysym_from_raw_char): Add keysym numbers here and use those instead. * src/haiku_support.h: Delete all the X11 keysym definitions. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 4fd2fc4aa5..ddcd908fd2 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -81,6 +81,7 @@ along with GNU Emacs. If not, see . */ #include "haiku_support.h" +/* Some messages that Emacs sends to itself. */ enum { SCROLL_BAR_UPDATE = 3000, @@ -92,6 +93,29 @@ enum QUIT_APPLICATION = 3006, }; +/* X11 keysyms that we use. */ +enum + { + KEY_BACKSPACE = 0xff08, + KEY_TAB = 0xff09, + KEY_RETURN = 0xff0d, + KEY_PAUSE = 0xff13, + KEY_ESCAPE = 0xff1b, + KEY_DELETE = 0xffff, + KEY_HOME = 0xff50, + KEY_LEFT_ARROW = 0xff51, + KEY_UP_ARROW = 0xff52, + KEY_RIGHT_ARROW = 0xff53, + KEY_DOWN_ARROW = 0xff54, + KEY_PAGE_UP = 0xff55, + KEY_PAGE_DOWN = 0xff56, + KEY_END = 0xff57, + KEY_PRINT = 0xff61, + KEY_INSERT = 0xff63, + /* This is used to indicate the first function key. */ + KEY_F1 = 0xffbe, + }; + static color_space dpy_color_space = B_NO_COLOR_SPACE; static key_map *key_map = NULL; static char *key_chars = NULL; @@ -219,62 +243,62 @@ keysym_from_raw_char (int32 raw, int32 key, unsigned *code) switch (raw) { case B_BACKSPACE: - *code = XK_BackSpace; + *code = KEY_BACKSPACE; break; case B_RETURN: - *code = XK_Return; + *code = KEY_RETURN; break; case B_TAB: - *code = XK_Tab; + *code = KEY_TAB; break; case B_ESCAPE: - *code = XK_Escape; + *code = KEY_ESCAPE; break; case B_LEFT_ARROW: - *code = XK_Left; + *code = KEY_LEFT_ARROW; break; case B_RIGHT_ARROW: - *code = XK_Right; + *code = KEY_RIGHT_ARROW; break; case B_UP_ARROW: - *code = XK_Up; + *code = KEY_UP_ARROW; break; case B_DOWN_ARROW: - *code = XK_Down; + *code = KEY_DOWN_ARROW; break; case B_INSERT: - *code = XK_Insert; + *code = KEY_INSERT; break; case B_DELETE: - *code = XK_Delete; + *code = KEY_DELETE; break; case B_HOME: - *code = XK_Home; + *code = KEY_HOME; break; case B_END: - *code = XK_End; + *code = KEY_END; break; case B_PAGE_UP: - *code = XK_Page_Up; + *code = KEY_PAGE_UP; break; case B_PAGE_DOWN: - *code = XK_Page_Down; + *code = KEY_PAGE_DOWN; break; case B_FUNCTION_KEY: - *code = XK_F1 + key - 2; + *code = KEY_F1 + key - 2; - if (*code - XK_F1 == 12) - *code = XK_Print; - else if (*code - XK_F1 == 13) + if (*code - KEY_F1 == 12) + *code = KEY_PRINT; + else if (*code - KEY_F1 == 13) /* Okay, Scroll Lock is a bit too much: keyboard.c doesn't know about it yet, and it shouldn't, since that's a modifier key. - *code = XK_Scroll_Lock; */ + *code = KEY_SCROLL_LOCK; */ return -1; - else if (*code - XK_F1 == 14) - *code = XK_Pause; + else if (*code - KEY_F1 == 14) + *code = KEY_PAUSE; break; diff --git a/src/haiku_support.h b/src/haiku_support.h index eb54fe75dd..237cedd8fc 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -638,44 +638,6 @@ 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_ */ // Local Variables: commit 68e6430959892dc755a80e05da2fedc530b5a924 Author: Lars Ingebrigtsen Date: Fri Apr 15 13:58:41 2022 +0200 Add some mouse-face bits to vtable * lisp/emacs-lisp/vtable.el (make-vtable) (vtable--insert-header-line): Put mouse-face on draggable bits. diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index d620f23726..525dc9359f 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -158,6 +158,7 @@ See info node `(vtable)Top' for vtable documentation." " " 'display (list 'space :width (list (vtable--compute-width table divider-width))))) + 'mouse-face 'highlight 'keymap (define-keymap "" #'vtable--drag-resize-column @@ -629,6 +630,7 @@ This also updates the displayed table." (let* ((name (propertize (vtable-column-name column) 'face (list 'header-line (vtable-face table)) + 'mouse-face 'header-line-highlight 'keymap cmap)) (start (point)) (indicator (vtable--indicator table index)) commit 4bc36f09b9eb27a8c5e4c6fdc630d9476897c04b Author: Lars Ingebrigtsen Date: Fri Apr 15 13:45:00 2022 +0200 Tweak sorting indicator placement in vtable * lisp/emacs-lisp/vtable.el (vtable--insert-header-line): Tweak sorting indicator position. diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index ec7e4b4a6b..d620f23726 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -645,7 +645,10 @@ This also updates the displayed table." (+ (- (elt widths index) (string-pixel-width displayed) indicator-width - (vtable-separator-width table)) + (vtable-separator-width table) + ;; We want the indicator to not be quite flush + ;; right. + (/ (vtable--char-width table) 2.0)) (if last 0 spacer)))) (if (or (not last) (zerop indicator-width) @@ -674,6 +677,10 @@ This also updates the displayed table." (list (- fill-width pre-fill)))))))) (when (and divider (not last)) (insert (propertize divider 'keymap dmap))) + (insert (propertize + " " 'display + (list 'space :width (list + (/ (vtable--char-width table) 2.0))))) (put-text-property start (point) 'vtable-column index))) (vtable-columns table)) (insert "\n") commit c4768cda7f84a4368500685d1525fa93990e5aa0 Author: Lars Ingebrigtsen Date: Fri Apr 15 13:37:05 2022 +0200 Make the sorting indicator prettier in vtable * lisp/emacs-lisp/vtable.el (vtable--insert-header-line): Place the sorting indicator flush right in the heading. diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index f2c20b6a80..ec7e4b4a6b 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -635,20 +635,43 @@ This also updates the displayed table." (indicator-width (string-pixel-width indicator)) (last (= index (1- (length (vtable-columns table))))) displayed) - (insert - (setq displayed - (concat - (if (> (string-pixel-width name) - (- (elt widths index) indicator-width)) - (vtable--limit-string - name (- (elt widths index) indicator-width)) - name) - indicator)) - (propertize " " 'display - (list 'space :width - (list (+ (- (elt widths index) - (string-pixel-width displayed)) - (if last 0 spacer)))))) + (setq displayed + (if (> (string-pixel-width name) + (- (elt widths index) indicator-width)) + (vtable--limit-string + name (- (elt widths index) indicator-width)) + name)) + (let ((fill-width + (+ (- (elt widths index) + (string-pixel-width displayed) + indicator-width + (vtable-separator-width table)) + (if last 0 spacer)))) + (if (or (not last) + (zerop indicator-width) + (< (seq-reduce #'+ widths 0) (window-width nil t))) + ;; Normal case. + (insert + displayed + (propertize " " 'display + (list 'space :width (list fill-width))) + indicator) + ;; This is the final column, and we have a sorting + ;; indicator, and the table is too wide for the window. + (let* ((pre-indicator (string-pixel-width + (buffer-substring (point-min) (point)))) + (pre-fill + (- (window-width nil t) + pre-indicator + (string-pixel-width displayed)))) + (insert + displayed + (propertize " " 'display + (list 'space :width (list pre-fill))) + indicator + (propertize " " 'display + (list 'space :width + (list (- fill-width pre-fill)))))))) (when (and divider (not last)) (insert (propertize divider 'keymap dmap))) (put-text-property start (point) 'vtable-column index))) commit 09ac2c73eefa62416bcf825ed5ceff67c06115f8 Author: Po Lu Date: Fri Apr 15 11:25:25 2022 +0000 Fix dismissal of tooltips on Haiku * src/haikuterm.c (haiku_mouse_or_wdesc_frame): New argument `accept_tooltip'. (haiku_read_socket): Use it when handling MOUSE_MOTION events. diff --git a/src/haikuterm.c b/src/haikuterm.c index 74a34fdb4b..559ec58926 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -409,7 +409,7 @@ haiku_frame_raise_lower (struct frame *f, bool raise_p) } static struct frame * -haiku_mouse_or_wdesc_frame (void *window) +haiku_mouse_or_wdesc_frame (void *window, bool accept_tooltip) { struct frame *lm_f = (gui_mouse_grabbed (x_display_list) ? x_display_list->last_mouse_frame @@ -423,7 +423,7 @@ haiku_mouse_or_wdesc_frame (void *window) struct frame *w_f = haiku_window_to_frame (window); /* Do not return a tooltip frame. */ - if (!w_f || FRAME_TOOLTIP_P (w_f)) + if (!w_f || (FRAME_TOOLTIP_P (w_f) && !accept_tooltip)) return EQ (track_mouse, Qdropping) ? lm_f : NULL; else /* When dropping it would be probably nice to raise w_f @@ -2952,7 +2952,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case MOUSE_MOTION: { struct haiku_mouse_motion_event *b = buf; - struct frame *f = haiku_mouse_or_wdesc_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window, true); Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; Lisp_Object frame; @@ -2967,7 +2967,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (any_help_event_p) do_help = -1; - break; } @@ -3134,7 +3133,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case BUTTON_DOWN: { struct haiku_button_event *b = buf; - struct frame *f = haiku_mouse_or_wdesc_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window, false); Lisp_Object tab_bar_arg = Qnil; int tab_bar_p = 0, tool_bar_p = 0; bool up_okay_p = false; commit f36ff9da170abeada75d7c3d29ba420ffe7c02f4 Author: Lars Ingebrigtsen Date: Fri Apr 15 11:46:40 2022 +0200 Allow using faces for colors in vtable * doc/misc/vtable.texi (Making A Table): Adjust color documentation. * lisp/emacs-lisp/vtable.el (make-vtable): Mix more. (vtable--compute-colors): Mix both foreground and background colors. (vtable--make-color-face, vtable--face-blend): New functions. (vtable--insert-line): Adjust usage. diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index 5a3957758c..296dc520a1 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -392,16 +392,18 @@ If present, this should be a list of color names to be used as the background color on the rows. If there are fewer colors here than there are rows, the rows will be repeated. The most common use case here is to have alternating background colors on the rows, so -this would usually be a list of two colors. +this would usually be a list of two colors. This can also be a list +of faces to be used. @item :column-colors If present, this should be a list of color names to be used as the background color on the columns. If there are fewer colors here than there are columns, the colors will be repeated. The most common use case here is to have alternating background colors on the columns, so -this would usually be a list of two colors. If both -@code{:row-colors} and @code{:column-colors} is present, the colors -will be ``blended'' to produce the final colors in the table. +this would usually be a list of two colors. This can also be a list +of faces to be used. If both @code{:row-colors} and +@code{:column-colors} is present, the colors will be ``blended'' to +produce the final colors in the table. @item :actions This uses the same syntax as @code{define-keymap}, but doesn't refer diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 5b86844010..f2c20b6a80 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -145,8 +145,8 @@ See info node `(vtable)Top' for vtable documentation." :ellipsis ellipsis))) ;; Compute missing column data. (setf (vtable-columns table) (vtable--compute-columns table)) - ;; Compute colors if we have to mix them. - (when (and row-colors column-colors) + ;; Compute the colors. + (when (or row-colors column-colors) (setf (slot-value table '-cached-colors) (vtable--compute-colors row-colors column-colors))) ;; Compute the divider. @@ -175,9 +175,41 @@ See info node `(vtable)Top' for vtable documentation." table)) (defun vtable--compute-colors (row-colors column-colors) - (cl-loop for row in row-colors - collect (cl-loop for column in column-colors - collect (vtable--color-blend row column)))) + (cond + ((null column-colors) + (mapcar #'vtable--make-color-face row-colors)) + ((null row-colors) + (mapcar #'vtable--make-color-face column-colors)) + (t + (cl-loop for row in row-colors + collect (cl-loop for column in column-colors + collect (vtable--face-blend + (vtable--make-color-face row) + (vtable--make-color-face column))))))) + +(defun vtable--make-color-face (object) + (if (stringp object) + (list :background object) + object)) + +(defun vtable--face-blend (face1 face2) + (let ((foreground (vtable--face-color face1 face2 #'face-foreground + :foreground)) + (background (vtable--face-color face1 face2 #'face-background + :background))) + `(,@(and foreground (list :foreground foreground)) + ,@(and background (list :background background))))) + +(defun vtable--face-color (face1 face2 accessor slot) + (let ((col1 (if (facep face1) + (funcall accessor face1) + (plist-get face1 slot))) + (col2 (if (facep face2) + (funcall accessor face2) + (plist-get face2 slot)))) + (if (and col1 col2) + (vtable--color-blend col1 col2) + (or col1 col2)))) ;;; FIXME: This is probably not the right way to blend two colors, is ;;; it? @@ -441,10 +473,11 @@ This also updates the displayed table." (let ((start (point)) (columns (vtable-columns table)) (column-colors - (if (vtable-row-colors table) - (elt (slot-value table '-cached-colors) - (mod line-number (length (vtable-row-colors table)))) - (vtable-column-colors table))) + (and (vtable-column-colors table) + (if (vtable-row-colors table) + (elt (slot-value table '-cached-colors) + (mod line-number (length (vtable-row-colors table)))) + (slot-value table '-cached-colors)))) (divider (vtable-divider table)) (keymap (slot-value table '-cached-keymap))) (seq-do-indexed @@ -517,8 +550,7 @@ This also updates the displayed table." (when column-colors (add-face-text-property start (point) - (list :background - (elt column-colors (mod index (length column-colors)))))) + (elt column-colors (mod index (length column-colors))))) (when (and divider (not last)) (insert divider) (setq start (point)))))) @@ -526,11 +558,10 @@ This also updates the displayed table." (insert "\n") (put-text-property start (point) 'vtable-object (car line)) (unless column-colors - (when-let ((row-colors (vtable-row-colors table))) + (when-let ((row-colors (slot-value table '-cached-colors))) (add-face-text-property start (point) - (list :background - (elt row-colors (mod line-number (length row-colors))))))))) + (elt row-colors (mod line-number (length row-colors)))))))) (defun vtable--cache-key () (cons (frame-terminal) (window-width))) commit 2b92b57923ff14a0cd2feab966a9e6a676f75f11 Author: Eli Zaretskii Date: Fri Apr 15 12:22:15 2022 +0300 ; * src/fringe.c: Include pgtkterm.h only in HAVE_PGTK builds. diff --git a/src/fringe.c b/src/fringe.c index bc4e0f1f13..bf0b5fde76 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -30,7 +30,9 @@ along with GNU Emacs. If not, see . */ #include "termhooks.h" #include "pdumper.h" -#include "pgtkterm.h" +#ifdef HAVE_PGTK +# include "pgtkterm.h" +#endif /* Fringe bitmaps are represented in three different ways: commit cc2a1b27806bff8431ebc8563ae5252267e3b178 Author: Lars Ingebrigtsen Date: Fri Apr 15 11:10:05 2022 +0200 Allow dragging the divider in vtable * lisp/emacs-lisp/vtable.el (vtable): Add a keymap cache. (make-vtable): Allow dragging the divider. (vtable-insert): Don't put the table keymap over the entire line -- avoid the divider, which has its own keymap. (vtable--drag-resize-column): Adjust to the in-buffer divider dragging. diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 9201fea365..5b86844010 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -66,8 +66,9 @@ (ellipsis :initarg :ellipsis :accessor vtable-ellipsis) (column-colors :initarg :column-colors :accessor vtable-column-colors) (row-colors :initarg :row-colors :accessor vtable-row-colors) - (-cached-colors :initform nil :accessor vtable--cached-colors) - (-cache :initform (make-hash-table :test #'equal))) + (-cached-colors :initform nil) + (-cache :initform (make-hash-table :test #'equal)) + (-cached-keymap :initform nil)) "An object to hold the data for a table.") (defvar-keymap vtable-map @@ -146,16 +147,23 @@ See info node `(vtable)Top' for vtable documentation." (setf (vtable-columns table) (vtable--compute-columns table)) ;; Compute colors if we have to mix them. (when (and row-colors column-colors) - (setf (vtable--cached-colors table) + (setf (slot-value table '-cached-colors) (vtable--compute-colors row-colors column-colors))) ;; Compute the divider. (when (or divider divider-width) (setf (vtable-divider table) - (or divider - (propertize - " " 'display - (list 'space :width - (list (vtable--compute-width table divider-width))))))) + (propertize + (or (copy-sequence divider) + (propertize + " " 'display + (list 'space :width + (list (vtable--compute-width table divider-width))))) + 'keymap + (define-keymap + "" #'vtable--drag-resize-column + "" #'ignore)))) + ;; Compute the keymap. + (setf (slot-value table '-cached-keymap) (vtable--make-keymap table)) (unless sort-by (seq-do-indexed (lambda (column index) (when (vtable-column-primary column) @@ -424,8 +432,7 @@ This also updates the displayed table." ellipsis ellipsis-width) (setq line-number (1+ line-number)))) (add-text-properties start (point) - (list 'keymap (vtable--make-keymap table) - 'rear-nonsticky t + (list 'rear-nonsticky t 'vtable table)) (goto-char start))) @@ -435,10 +442,11 @@ This also updates the displayed table." (columns (vtable-columns table)) (column-colors (if (vtable-row-colors table) - (elt (vtable--cached-colors table) + (elt (slot-value table '-cached-colors) (mod line-number (length (vtable-row-colors table)))) (vtable-column-colors table))) - (divider (vtable-divider table))) + (divider (vtable-divider table)) + (keymap (slot-value table '-cached-keymap))) (seq-do-indexed (lambda (elem index) (let ((value (nth 0 elem)) @@ -505,6 +513,7 @@ This also updates the displayed table." (list 'space :width (list spacer)))))) (put-text-property start (point) 'vtable-column index) + (put-text-property start (point) 'keymap keymap) (when column-colors (add-face-text-property start (point) @@ -624,10 +633,21 @@ If NEXT, do the next column." (obj (posn-object pos-start))) (with-current-buffer (window-buffer (posn-window pos-start)) (let ((column - (get-text-property (if obj (cdr obj) - (posn-point pos-start)) - 'vtable-column - (car obj))) + ;; In the header line we have a text property on the + ;; divider. + (or (get-text-property (if obj (cdr obj) + (posn-point pos-start)) + 'vtable-column + (car obj)) + ;; For reasons of efficiency, we don't have that in + ;; the buffer itself, so find the column. + (save-excursion + (goto-char (posn-point pos-start)) + (1+ + (get-text-property + (prop-match-beginning + (text-property-search-backward 'vtable-column)) + 'vtable-column))))) (start-x (car (posn-x-y pos-start))) (end-x (car (posn-x-y (event-end e))))) (when (or (> column 0) next) commit e95c545180a63cce49e8cdeff0d2660c2ddac9ec Author: Lars Ingebrigtsen Date: Fri Apr 15 11:06:44 2022 +0200 Fix off-by-one error in text-property-search-backward * lisp/emacs-lisp/text-property-search.el (text-property-search-backward): Fix off-by-one error -- this would result in not finding the previous (non-)match when at the first character in a field. diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 9f86a28eb6..2494e94807 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -166,7 +166,6 @@ and if a matching region is found, place point at the start of the region." (let ((origin (point)) (ended nil) pos) - (forward-char -1) ;; Find the previous candidate. (while (not ended) (setq pos (previous-single-property-change (point) property)) commit 504779f744ccc33c2177dafa34e21d83f6c640a0 Author: Po Lu Date: Fri Apr 15 16:43:15 2022 +0800 More PGTK related cleanup * src/pgtkfns.c (x_set_foreground_color, x_set_background_color) (x_set_border_color, x_set_cursor_color, x_set_title) (x_set_menu_bar_lines, x_set_tab_bar_lines, x_set_tool_bar_lines) (x_set_child_frame_border_width, x_set_internal_border_width) (x_set_icon_type, x_set_icon_name, x_set_cursor_type) (x_set_mouse_color, x_set_undecorated, x_set_skip_taskbar) (x_set_override_redirect, pgtk_frame_parm_handlers) (Fx_create_frame): Rename most `x_' functions to `pgtk_' ones. All callers changed. * src/pgtkmenu.c (Fx_menu_bar_open_internal): Remove duplicate doc string definition. * src/pgtkterm.c (x_set_offset, pgtk_iconify_frame) (x_set_parent_frame, x_set_no_focus_on_map, x_set_no_accept_focus) (x_set_z_group, x_set_cursor_gc, x_set_mouse_face_gc) (x_set_mode_line_face_gc, x_set_glyph_string_gc) (x_set_glyph_string_clipping, x_set_glyph_string_clipping_exactly) (x_setup_relief_color, x_setup_relief_colors) (x_set_clip_rectangles, x_draw_relief_rect, x_draw_box_rect) (x_draw_glyph_string_box, x_draw_image_relief) (x_draw_image_foreground, x_draw_stretch_glyph_string) (pgtk_draw_glyph_string, x_set_toolkit_scroll_bar_thumb) (x_set_toolkit_horizontal_scroll_bar_thumb) (pgtk_set_vertical_scroll_bar, pgtk_set_horizontal_scroll_bar) (x_set_frame_alpha, frame_highlight, frame_unhighlight) (pgtk_create_terminal, map_event): Rename most `x_' functions to `pgtk_' ones. All callers changed. * src/pgtkterm.h: Update prototypes. diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 537d4152b6..e677f04629 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -177,7 +177,7 @@ pgtk_display_info_for_name (Lisp_Object name) static void -x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { unsigned long fg, old_fg; @@ -204,7 +204,7 @@ x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) static void -x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { unsigned long bg; @@ -246,7 +246,7 @@ pgtk_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } static void -x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int pix; @@ -257,7 +257,7 @@ x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } static void -x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { unsigned long fore_pixel, pixel; struct pgtk_output *x = f->output_data.pgtk; @@ -381,7 +381,7 @@ pgtk_implicitly_set_name (struct frame *f, Lisp_Object arg, If NAME is nil, use the frame name as the title. */ static void -x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) +pgtk_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)) @@ -407,7 +407,7 @@ pgtk_set_doc_edited (void) static void -x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +pgtk_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { int nlines; /* Right now, menu bars don't work properly in minibuf-only frames; @@ -453,7 +453,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) The frame's height doesn't change. */ static void -x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { int nlines; @@ -545,7 +545,7 @@ x_change_tool_bar_height (struct frame *f, int height) /* Toolbar support. */ static void -x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +pgtk_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { int nlines; @@ -564,7 +564,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) } static void -x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int border = check_int_nonnegative (arg); @@ -582,7 +582,7 @@ x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object ol } static void -x_set_internal_border_width (struct frame *f, Lisp_Object arg, +pgtk_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int border = check_int_nonnegative (arg); @@ -600,7 +600,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, } static void -x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { bool result; @@ -630,7 +630,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } static void -x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { bool result; @@ -663,7 +663,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) /* This is the same as the xfns.c definition. */ static void -x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { set_frame_cursor_types (f, arg); } @@ -671,12 +671,12 @@ x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) /* called to set mouse pointer color, but all other terms use it to initialize pointer types (and don't set the color ;) */ static void -x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { } /** - * x_set_undecorated: + * pgtk_set_undecorated: * * Set frame F's `undecorated' parameter. If non-nil, F's window-system * window is drawn without decorations, title, minimize/maximize boxes @@ -688,7 +688,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) * Some window managers may not honor this parameter. */ static void -x_set_undecorated (struct frame *f, Lisp_Object new_value, +pgtk_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { if (!EQ (new_value, old_value)) @@ -699,7 +699,7 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, } /** - * x_set_skip_taskbar: + * pgtk_set_skip_taskbar: * * Set frame F's `skip-taskbar' parameter. If non-nil, this should * remove F's icon from the taskbar associated with the display of F's @@ -709,7 +709,7 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, * Some window managers may not honor this parameter. */ static void -x_set_skip_taskbar (struct frame *f, Lisp_Object new_value, +pgtk_set_skip_taskbar (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { if (!EQ (new_value, old_value)) @@ -720,7 +720,7 @@ x_set_skip_taskbar (struct frame *f, Lisp_Object new_value, } /** - * x_set_override_redirect: + * pgtk_set_override_redirect: * * Set frame F's `override_redirect' parameter which, if non-nil, hints * that the window manager doesn't want to deal with F. Usually, such @@ -729,7 +729,7 @@ x_set_skip_taskbar (struct frame *f, Lisp_Object new_value, * Some window managers may not honor this parameter. */ static void -x_set_override_redirect (struct frame *f, Lisp_Object new_value, +pgtk_set_override_redirect (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { if (!EQ (new_value, old_value)) @@ -974,31 +974,31 @@ unless TYPE is `png'. */) frame_parm_handler pgtk_frame_parm_handlers[] = { gui_set_autoraise, /* generic OK */ gui_set_autolower, /* generic OK */ - x_set_background_color, - x_set_border_color, + pgtk_set_background_color, + pgtk_set_border_color, gui_set_border_width, - x_set_cursor_color, - x_set_cursor_type, + pgtk_set_cursor_color, + pgtk_set_cursor_type, gui_set_font, /* generic OK */ - x_set_foreground_color, - x_set_icon_name, - x_set_icon_type, - x_set_child_frame_border_width, - x_set_internal_border_width, /* generic OK */ + pgtk_set_foreground_color, + pgtk_set_icon_name, + pgtk_set_icon_type, + pgtk_set_child_frame_border_width, + pgtk_set_internal_border_width, /* generic OK */ gui_set_right_divider_width, gui_set_bottom_divider_width, - x_set_menu_bar_lines, - x_set_mouse_color, + pgtk_set_menu_bar_lines, + pgtk_set_mouse_color, x_explicitly_set_name, gui_set_scroll_bar_width, /* generic OK */ gui_set_scroll_bar_height, /* generic OK */ - x_set_title, + pgtk_set_title, gui_set_unsplittable, /* generic OK */ gui_set_vertical_scroll_bars, /* generic OK */ gui_set_horizontal_scroll_bars, /* generic OK */ gui_set_visibility, /* generic OK */ - x_set_tab_bar_lines, - x_set_tool_bar_lines, + pgtk_set_tab_bar_lines, + pgtk_set_tool_bar_lines, pgtk_set_scroll_bar_foreground, pgtk_set_scroll_bar_background, gui_set_screen_gamma, /* generic OK */ @@ -1012,13 +1012,13 @@ frame_parm_handler pgtk_frame_parm_handlers[] = { pgtk_set_sticky, pgtk_set_tool_bar_position, 0, /* x_set_inhibit_double_buffering */ - x_set_undecorated, - x_set_parent_frame, - x_set_skip_taskbar, - x_set_no_focus_on_map, - x_set_no_accept_focus, - x_set_z_group, - x_set_override_redirect, + pgtk_set_undecorated, + pgtk_set_parent_frame, + pgtk_set_skip_taskbar, + pgtk_set_no_focus_on_map, + pgtk_set_no_accept_focus, + pgtk_set_z_group, + pgtk_set_override_redirect, gui_set_no_special_glyphs, pgtk_set_alpha_background, }; @@ -1514,10 +1514,11 @@ This function is an internal primitive--use `make-frame' instead. */ ) init_frame_faces (f); /* We have to call adjust_frame_size here since otherwise - x_set_tool_bar_lines will already work with the character sizes - installed by init_frame_faces while the frame's pixel size is still - calculated from a character size of 1 and we subsequently hit the - (height >= 0) assertion in window_box_height. + pgtk_set_tool_bar_lines will already work with the character + sizes installed by init_frame_faces while the frame's pixel size + is still calculated from a character size of 1 and we + subsequently hit the (height >= 0) assertion in + window_box_height. The non-pixelwise code apparently worked around this because it had one frame line vs one toolbar line which left us with a zero @@ -1525,14 +1526,12 @@ This function is an internal primitive--use `make-frame' instead. */ ) Also process `min-width' and `min-height' parameters right here because `frame-windows-min-size' needs them. */ - tem = - gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, - RES_TYPE_NUMBER); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, + RES_TYPE_NUMBER); if (NUMBERP (tem)) store_frame_param (f, Qmin_width, tem); - tem = - gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, - RES_TYPE_NUMBER); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, + RES_TYPE_NUMBER); if (NUMBERP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), @@ -2374,13 +2373,6 @@ x_get_focus_frame (struct frame *frame) return focus; } -/* ========================================================================== - - Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'. - - ========================================================================== */ - - DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, doc: /* Internal function called by `color-defined-p', which see. */) (Lisp_Object color, Lisp_Object frame) @@ -3877,12 +3869,6 @@ DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, return NILP (enable) ? Qnil : Qt; } -/* ========================================================================== - - Lisp interface declaration - - ========================================================================== */ - void syms_of_pgtkfns (void) { diff --git a/src/pgtkmenu.c b/src/pgtkmenu.c index bd63af3b22..eec9f419d0 100644 --- a/src/pgtkmenu.c +++ b/src/pgtkmenu.c @@ -62,19 +62,14 @@ pgtk_menu_set_in_use (bool in_use) struct frame *f = XFRAME (frame); if (in_use && FRAME_Z_GROUP_ABOVE (f)) - x_set_z_group (f, Qabove_suspended, Qabove); + pgtk_set_z_group (f, Qabove_suspended, Qabove); else if (!in_use && FRAME_Z_GROUP_ABOVE_SUSPENDED (f)) - x_set_z_group (f, Qabove, Qabove_suspended); + pgtk_set_z_group (f, Qabove, Qabove_suspended); } } DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i", - doc: /* Start key navigation of the menu bar in FRAME. - This initially opens the first menu bar item and you can then navigate with the - arrow keys, select a menu entry with the return key or cancel with the - escape key. If FRAME has no menu bar this function does nothing. - - If FRAME is nil or not given, use the selected frame. */) + doc: /* SKIP: real doc in USE_GTK definition in xmenu.c. */) (Lisp_Object frame) { GtkWidget *menubar; diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 0bb41cb446..a59abba625 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -606,10 +606,7 @@ x_calc_absolute_position (struct frame *f) which means, do adjust for borders but don't change the gravity. */ static void -x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) -/* -------------------------------------------------------------------------- - External: Position the window - -------------------------------------------------------------------------- */ +pgtk_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) { if (change_gravity > 0) { @@ -712,7 +709,7 @@ pgtk_iconify_frame (struct frame *f) /* Make sure the X server knows where the window should be positioned, in case the user deiconifies with the window manager. */ if (!FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f)) - x_set_offset (f, f->left_pos, f->top_pos, 0); + pgtk_set_offset (f, f->left_pos, f->top_pos, 0); SET_FRAME_ICONIFIED (f, true); SET_FRAME_VISIBLE (f, 0); @@ -900,29 +897,8 @@ x_display_pixel_width (struct pgtk_display_info *dpyinfo) } void -x_set_parent_frame (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value) -/* -------------------------------------------------------------------------- - Set frame F's `parent-frame' parameter. If non-nil, make F a child - frame of the frame specified by that parameter. Technically, this - makes F's window-system window a child window of the parent frame's - window-system window. If nil, make F's window-system window a - top-level window--a child of its display's root window. - - A child frame's `left' and `top' parameters specify positions - relative to the top-left corner of its parent frame's native - rectangle. On macOS moving a parent frame moves all its child - frames too, keeping their position relative to the parent - unaltered. When a parent frame is iconified or made invisible, its - child frames are made invisible. When a parent frame is deleted, - its child frames are deleted too. - - Whether a child frame has a tool bar may be window-system or window - manager dependent. It's advisable to disable it via the frame - parameter settings. - - Some window managers may not honor this parameter. - -------------------------------------------------------------------------- */ +pgtk_set_parent_frame (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { struct frame *p = NULL; @@ -1023,20 +999,11 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, } } - +/* Doesn't work on wayland. */ void -x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value) -/* Set frame F's `no-focus-on-map' parameter which, if non-nil, means - * that F's window-system window does not want to receive input focus - * when it is mapped. (A frame's window is mapped when the frame is - * displayed for the first time and when the frame changes its state - * from `iconified' or `invisible' to `visible'.) - * - * Some window managers may not honor this parameter. */ +pgtk_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { - /* doesn't work on wayland. */ - if (!EQ (new_value, old_value)) { xg_set_no_focus_on_map (f, new_value); @@ -1045,36 +1012,16 @@ x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, } void -x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value) -/* Set frame F's `no-accept-focus' parameter which, if non-nil, hints - * that F's window-system window does not want to receive input focus - * via mouse clicks or by moving the mouse into it. - * - * If non-nil, 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. */ +pgtk_set_no_accept_focus (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { - /* doesn't work on wayland. */ - xg_set_no_accept_focus (f, new_value); FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); } void -x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) -/* Set frame F's `z-group' parameter. If `above', F's window-system - window is displayed above all windows that do not have the `above' - property set. If nil, F's window is shown below all windows that - have the `above' property set and above all windows that have the - `below' property set. If `below', F's window is displayed below - all windows that do. - - Some window managers may not honor this parameter. */ +pgtk_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { - /* doesn't work on wayland. */ - if (!FRAME_GTK_OUTER_WIDGET (f)) return; @@ -1135,7 +1082,7 @@ pgtk_initialize_display_info (struct pgtk_display_info *dpyinfo) face. */ static void -x_set_cursor_gc (struct glyph_string *s) +pgtk_set_cursor_gc (struct glyph_string *s) { if (s->font == FRAME_FONT (s->f) && s->face->background == FRAME_BACKGROUND_PIXEL (s->f) @@ -1173,7 +1120,7 @@ x_set_cursor_gc (struct glyph_string *s) /* Set up S->gc of glyph string S for drawing text in mouse face. */ static void -x_set_mouse_face_gc (struct glyph_string *s) +pgtk_set_mouse_face_gc (struct glyph_string *s) { prepare_face_for_display (s->f, s->face); @@ -1202,7 +1149,7 @@ x_set_mouse_face_gc (struct glyph_string *s) matrix was built, so there isn't much to do, here. */ static void -x_set_mode_line_face_gc (struct glyph_string *s) +pgtk_set_mode_line_face_gc (struct glyph_string *s) { s->xgcv.foreground = s->face->foreground; s->xgcv.background = s->face->background; @@ -1214,7 +1161,7 @@ x_set_mode_line_face_gc (struct glyph_string *s) pattern. */ static void -x_set_glyph_string_gc (struct glyph_string *s) +pgtk_set_glyph_string_gc (struct glyph_string *s) { prepare_face_for_display (s->f, s->face); @@ -1226,17 +1173,17 @@ x_set_glyph_string_gc (struct glyph_string *s) } else if (s->hl == DRAW_INVERSE_VIDEO) { - x_set_mode_line_face_gc (s); + pgtk_set_mode_line_face_gc (s); s->stippled_p = s->face->stipple != 0; } else if (s->hl == DRAW_CURSOR) { - x_set_cursor_gc (s); + pgtk_set_cursor_gc (s); s->stippled_p = false; } else if (s->hl == DRAW_MOUSE_FACE) { - x_set_mouse_face_gc (s); + pgtk_set_mouse_face_gc (s); s->stippled_p = s->face->stipple != 0; } else if (s->hl == DRAW_IMAGE_RAISED || s->hl == DRAW_IMAGE_SUNKEN) @@ -1254,7 +1201,7 @@ x_set_glyph_string_gc (struct glyph_string *s) line or menu if we don't have X toolkit support. */ static void -x_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr) +pgtk_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr) { XRectangle r[2]; int n = get_glyph_string_clip_rects (s, r, 2); @@ -1275,8 +1222,8 @@ x_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr) the area of SRC. */ static void -x_set_glyph_string_clipping_exactly (struct glyph_string *src, - struct glyph_string *dst, cairo_t * cr) +pgtk_set_glyph_string_clipping_exactly (struct glyph_string *src, + struct glyph_string *dst, cairo_t * cr) { dst->clip[0].x = src->x; dst->clip[0].y = src->y; @@ -1813,8 +1760,8 @@ x_erase_corners_for_relief (struct frame *f, unsigned long color, int x, be allocated, use DEFAULT_PIXEL, instead. */ static void -x_setup_relief_color (struct frame *f, struct relief *relief, double factor, - int delta, unsigned long default_pixel) +pgtk_setup_relief_color (struct frame *f, struct relief *relief, double factor, + int delta, unsigned long default_pixel) { Emacs_GC xgcv; struct pgtk_output *di = FRAME_X_OUTPUT (f); @@ -1833,7 +1780,7 @@ x_setup_relief_color (struct frame *f, struct relief *relief, double factor, /* Set up colors for the relief lines around glyph string S. */ static void -x_setup_relief_colors (struct glyph_string *s) +pgtk_setup_relief_colors (struct glyph_string *s) { struct pgtk_output *di = FRAME_X_OUTPUT (s->f); unsigned long color; @@ -1853,17 +1800,17 @@ x_setup_relief_colors (struct glyph_string *s) if (TRUE) { di->relief_background = color; - x_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000, - WHITE_PIX_DEFAULT (s->f)); - x_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000, - BLACK_PIX_DEFAULT (s->f)); + pgtk_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000, + WHITE_PIX_DEFAULT (s->f)); + pgtk_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000, + BLACK_PIX_DEFAULT (s->f)); } } static void -x_set_clip_rectangles (struct frame *f, cairo_t * cr, XRectangle * rectangles, - int n) +pgtk_set_clip_rectangles (struct frame *f, cairo_t *cr, + XRectangle *rectangles, int n) { if (n > 0) { @@ -1909,7 +1856,7 @@ x_draw_relief_rect (struct frame *f, bottom_right_color = FRAME_X_OUTPUT (f)->white_relief.xgcv.foreground; } - x_set_clip_rectangles (f, cr, clip_rect, 1); + pgtk_set_clip_rectangles (f, cr, clip_rect, 1); if (left_p) { @@ -1985,7 +1932,7 @@ x_draw_box_rect (struct glyph_string *s, foreground_backup = s->xgcv.foreground; s->xgcv.foreground = s->face->box_color; - x_set_clip_rectangles (s->f, cr, clip_rect, 1); + pgtk_set_clip_rectangles (s->f, cr, clip_rect, 1); /* Top. */ pgtk_fill_rectangle (s->f, s->xgcv.foreground, @@ -2055,7 +2002,7 @@ x_draw_glyph_string_box (struct glyph_string *s) vwidth, left_p, right_p, &clip_rect); else { - x_setup_relief_colors (s); + pgtk_setup_relief_colors (s); x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth, vwidth, raised_p, true, true, left_p, right_p, &clip_rect); @@ -2219,7 +2166,7 @@ x_draw_image_relief (struct glyph_string *s) if (s->slice.y + s->slice.height == s->img->height) y1 += thick + extra_y, bot_p = true; - x_setup_relief_colors (s); + pgtk_setup_relief_colors (s); get_glyph_string_clip_rect (s, &r); x_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p, top_p, bot_p, left_p, right_p, &r); @@ -2303,7 +2250,7 @@ x_draw_image_foreground (struct glyph_string *s) if (s->img->cr_data) { cairo_t *cr = pgtk_begin_cr_clip (s->f); - x_set_glyph_string_clipping (s, cr); + pgtk_set_glyph_string_clipping (s, cr); x_cr_draw_image (s->f, &s->xgcv, s->img->cr_data, s->slice.x, s->slice.y, s->slice.width, s->slice.height, x, y, true); @@ -2455,7 +2402,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) x = s->x; if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) { - x_set_mouse_face_gc (s); + pgtk_set_mouse_face_gc (s); color = s->xgcv.foreground; } else @@ -2464,7 +2411,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) cairo_t *cr = pgtk_begin_cr_clip (s->f); get_glyph_string_clip_rect (s, &r); - x_set_clip_rectangles (s->f, cr, &r, 1); + pgtk_set_clip_rectangles (s->f, cr, &r, 1); if (s->face->stipple) { @@ -2519,8 +2466,8 @@ pgtk_draw_glyph_string (struct glyph_string *s) if (next->first_glyph->type != IMAGE_GLYPH) { cairo_t *cr = pgtk_begin_cr_clip (next->f); - x_set_glyph_string_gc (next); - x_set_glyph_string_clipping (next, cr); + pgtk_set_glyph_string_gc (next); + pgtk_set_glyph_string_clipping (next, cr); if (next->first_glyph->type == STRETCH_GLYPH) x_draw_stretch_glyph_string (next); else @@ -2531,7 +2478,7 @@ pgtk_draw_glyph_string (struct glyph_string *s) } /* Set up S->gc, set clipping and draw S. */ - x_set_glyph_string_gc (s); + pgtk_set_glyph_string_gc (s); cairo_t *cr = pgtk_begin_cr_clip (s->f); @@ -2543,10 +2490,10 @@ pgtk_draw_glyph_string (struct glyph_string *s) || s->first_glyph->type == COMPOSITE_GLYPH)) { - x_set_glyph_string_clipping (s, cr); + pgtk_set_glyph_string_clipping (s, cr); x_draw_glyph_string_background (s, true); x_draw_glyph_string_box (s); - x_set_glyph_string_clipping (s, cr); + pgtk_set_glyph_string_clipping (s, cr); relief_drawn_p = true; } else if (!s->clip_head /* draw_glyphs didn't specify a clip mask. */ @@ -2556,9 +2503,9 @@ pgtk_draw_glyph_string (struct glyph_string *s) /* We must clip just this glyph. left_overhang part has already drawn when s->prev was drawn, and right_overhang part will be drawn later when s->next is drawn. */ - x_set_glyph_string_clipping_exactly (s, s, cr); + pgtk_set_glyph_string_clipping_exactly (s, s, cr); else - x_set_glyph_string_clipping (s, cr); + pgtk_set_glyph_string_clipping (s, cr); switch (s->first_glyph->type) { @@ -2749,9 +2696,9 @@ pgtk_draw_glyph_string (struct glyph_string *s) enum draw_glyphs_face save = prev->hl; prev->hl = s->hl; - x_set_glyph_string_gc (prev); + pgtk_set_glyph_string_gc (prev); cairo_save (cr); - x_set_glyph_string_clipping_exactly (s, prev, cr); + pgtk_set_glyph_string_clipping_exactly (s, prev, cr); if (prev->first_glyph->type == CHAR_GLYPH) x_draw_glyph_string_foreground (prev); else @@ -2775,9 +2722,9 @@ pgtk_draw_glyph_string (struct glyph_string *s) enum draw_glyphs_face save = next->hl; next->hl = s->hl; - x_set_glyph_string_gc (next); + pgtk_set_glyph_string_gc (next); cairo_save (cr); - x_set_glyph_string_clipping_exactly (s, next, cr); + pgtk_set_glyph_string_clipping_exactly (s, next, cr); if (next->first_glyph->type == CHAR_GLYPH) x_draw_glyph_string_foreground (next); else @@ -4133,16 +4080,16 @@ x_create_horizontal_toolkit_scroll_bar (struct frame *f, displaying PORTION out of a whole WHOLE, and our position POSITION. */ static void -x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, - int position, int whole) +pgtk_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, + int position, int whole) { xg_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); } static void -x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, - int portion, int position, - int whole) +pgtk_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, + int portion, int position, + int whole) { xg_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); } @@ -4294,7 +4241,7 @@ pgtk_set_vertical_scroll_bar (struct window *w, int portion, int whole, unblock_input (); } - x_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); + pgtk_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); XSETVECTOR (barobj, bar); wset_vertical_scroll_bar (w, barobj); @@ -4375,7 +4322,7 @@ pgtk_set_horizontal_scroll_bar (struct window *w, int portion, int whole, unblock_input (); } - x_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); + pgtk_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); XSETVECTOR (barobj, bar); wset_horizontal_scroll_bar (w, barobj); @@ -4673,7 +4620,7 @@ set_opacity_recursively (GtkWidget * w, gpointer data) } static void -x_set_frame_alpha (struct frame *f) +pgtk_set_frame_alpha (struct frame *f) { struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); double alpha = 1.0; @@ -4739,7 +4686,7 @@ frame_highlight (struct frame *f) unblock_input (); gui_update_cursor (f, true); - x_set_frame_alpha (f); + pgtk_set_frame_alpha (f); } static void @@ -4775,7 +4722,7 @@ frame_unhighlight (struct frame *f) unblock_input (); gui_update_cursor (f, true); - x_set_frame_alpha (f); + pgtk_set_frame_alpha (f); } @@ -4929,7 +4876,7 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo) terminal->query_colors = pgtk_query_colors; terminal->get_focus_frame = x_get_focus_frame; terminal->focus_frame_hook = pgtk_focus_frame; - terminal->set_frame_offset_hook = x_set_offset; + terminal->set_frame_offset_hook = pgtk_set_offset; terminal->free_pixmap = pgtk_free_pixmap; terminal->toolkit_position_hook = pgtk_toolkit_position; @@ -5587,9 +5534,9 @@ map_event (GtkWidget *widget, /* The `z-group' is reset every time a frame becomes invisible. Handle this here. */ if (FRAME_Z_GROUP (f) == z_group_above) - x_set_z_group (f, Qabove, Qnil); + pgtk_set_z_group (f, Qabove, Qnil); else if (FRAME_Z_GROUP (f) == z_group_below) - x_set_z_group (f, Qbelow, Qnil); + pgtk_set_z_group (f, Qbelow, Qnil); } SET_FRAME_VISIBLE (f, 1); diff --git a/src/pgtkterm.h b/src/pgtkterm.h index 321c923db5..cc763f00f0 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -523,14 +523,10 @@ extern int x_display_pixel_width (struct pgtk_display_info *); /* Implemented in pgtkterm.c */ extern void x_destroy_window (struct frame *f); -extern void x_set_parent_frame (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); -extern void x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); -extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); -extern void x_set_z_group (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); +extern void pgtk_set_parent_frame (struct frame *f, Lisp_Object, Lisp_Object); +extern void pgtk_set_no_focus_on_map (struct frame *, Lisp_Object, Lisp_Object); +extern void pgtk_set_no_accept_focus (struct frame *, Lisp_Object, Lisp_Object); +extern void pgtk_set_z_group (struct frame *, Lisp_Object, Lisp_Object); /* Cairo related functions implemented in pgtkterm.c */ extern void pgtk_cr_update_surface_desired_size (struct frame *, int, int, bool); commit bdceac0d5a413d89aae4785c884eab1f446ae3ad Author: Po Lu Date: Fri Apr 15 16:08:28 2022 +0800 Clean up some extraneous stuff in pgtkfns.c * src/pgtkfns.c (Fx_gtk_debug): Fix doc string and remove extra version check. (syms_of_pgtkfns): Delete left over defvar from NS port. diff --git a/src/pgtkfns.c b/src/pgtkfns.c index e6ce5e2f44..537d4152b6 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -3864,9 +3864,8 @@ nil, it defaults to the selected frame. */) return unbind_to (count, font); } -#if GTK_CHECK_VERSION (3, 14, 0) DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, - doc: /* Toggle interactive GTK debugging. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object enable) { gboolean enable_debug = !NILP (enable); @@ -3877,7 +3876,6 @@ DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, return NILP (enable) ? Qnil : Qt; } -#endif /* GTK_CHECK_VERSION (3, 14, 0) */ /* ========================================================================== @@ -3901,27 +3899,6 @@ syms_of_pgtkfns (void) doc: /* SKIP: real doc in xfns.c. */); Vx_cursor_fore_pixel = Qnil; - DEFVAR_LISP ("pgtk-icon-type-alist", Vpgtk_icon_type_alist, - doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames. -If the title of a frame matches REGEXP, then IMAGE.tiff is -selected as the image of the icon representing the frame when it's -miniaturized. If an element is t, then Emacs tries to select an icon -based on the filetype of the visited file. - -The images have to be installed in a folder called English.lproj in the -Emacs folder. You have to restart Emacs after installing new icons. - -Example: Install an icon Gnus.tiff and execute the following code - -(setq pgtk-icon-type-alist -(append pgtk-icon-type-alist -\\='((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\" -. \"Gnus\")))) - -When you miniaturize a Group, Summary or Article frame, Gnus.tiff will -be used as the image of the icon representing the frame. */); - Vpgtk_icon_type_alist = list1 (Qt); - Fprovide (intern_c_string ("gtk"), Qnil); DEFVAR_LISP ("gtk-version-string", Vgtk_version_string, @@ -3977,10 +3954,7 @@ be used as the image of the icon representing the frame. */); defsubr (&Sx_open_connection); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); - -#if GTK_CHECK_VERSION (3, 14, 0) defsubr (&Sx_gtk_debug); -#endif defsubr (&Spgtk_hide_others); defsubr (&Spgtk_hide_emacs); commit 1a3bad431d841e52a61e5f1f09b4ebe7fbbd70da Author: Philip Kaludercic Date: Thu Apr 14 10:24:27 2022 +0200 Update project-kill-buffer-conditions to match buffer-match-p * project.el (project-kill-buffer-conditions): Document the deprecation of the use of derived-mode (project--buffer-check): Have `major-mode' behave like `derived-mode' did previously, and issue a warning of `derived-mode' is used. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index daaf86f327..ac6aa0ced2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1201,18 +1201,22 @@ displayed." (display-buffer-other-frame buffer-or-name)) (defcustom project-kill-buffer-conditions - '(buffer-file-name ; All file-visiting buffers are included. + `(buffer-file-name ; All file-visiting buffers are included. ;; Most of the temp buffers in the background: - (major-mode . fundamental-mode) + ,(lambda (buf) + (not (eq (buffer-local-value 'major-mode buf) + 'fundamental-mode))) ;; non-text buffer such as xref, occur, vc, log, ... - (and (derived-mode . special-mode) - (not (major-mode . help-mode))) - (derived-mode . compilation-mode) - (derived-mode . dired-mode) - (derived-mode . diff-mode) - (derived-mode . comint-mode) - (derived-mode . eshell-mode) - (derived-mode . change-log-mode)) + (and (major-mode . special-mode) + ,(lambda (buf) + (not (eq (buffer-local-value 'major-mode buf) + 'help-mode)))) + (major-mode . compilation-mode) + (major-mode . dired-mode) + (major-mode . diff-mode) + (major-mode . comint-mode) + (major-mode . eshell-mode) + (major-mode . change-log-mode)) "List of conditions to kill buffers related to a project. This list is used by `project-kill-buffers'. Each condition is either: @@ -1222,10 +1226,11 @@ Each condition is either: - a cons-cell, where the car describes how to interpret the cdr. The car can be one of the following: * `major-mode': the buffer is killed if the buffer's major - mode is eq to the cons-cell's cdr - * `derived-mode': the buffer is killed if the buffer's major mode is derived from the major mode denoted by the cons-cell's - cdr + cdr. + * `derived-mode': the buffer is killed if the buffer's major + mode is eq to the cons-cell's cdr (this is deprecated and will + result in a warning if used). * `not': the cdr is interpreted as a negation of a condition. * `and': the cdr is a list of recursive conditions, that all have to be met. @@ -1285,10 +1290,13 @@ form of CONDITIONS." (string-match-p c (buffer-name buf))) ((symbolp c) (funcall c buf)) - ((eq (car-safe c) 'major-mode) - (eq (buffer-local-value 'major-mode buf) - (cdr c))) ((eq (car-safe c) 'derived-mode) + (warn "The use of `derived-mode' in \ +`project--buffer-check' is deprecated.") + (provided-mode-derived-p + (buffer-local-value 'major-mode buf) + (cdr c))) + ((eq (car-safe c) 'major-mode) (provided-mode-derived-p (buffer-local-value 'major-mode buf) (cdr c))) commit 59ecf25fc86081c9df05b84194c36414c225c265 Author: Philip Kaludercic Date: Thu Mar 10 10:59:52 2022 +0100 * window.el (display-buffer-assq-regexp): Use buffer-match diff --git a/lisp/window.el b/lisp/window.el index dd297a3169..2da2f8bb2c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7498,19 +7498,12 @@ all fail. It should never be set by programs or users. See (defun display-buffer-assq-regexp (buffer-name alist action) "Retrieve ALIST entry corresponding to BUFFER-NAME. This returns the cdr of the alist entry ALIST if either its key -is a string that matches BUFFER-NAME, as reported by -`string-match-p'; or if the key is a function that returns -non-nil when called with three arguments: the ALIST key, -BUFFER-NAME and ACTION. ACTION should have the form of the -action argument passed to `display-buffer'." +satisfied a BUFFER-NAME per `buffer-match'. ACTION should have +the form of the action argument passed to `display-buffer'." (catch 'match (dolist (entry alist) - (let ((key (car entry))) - (when (or (and (stringp key) - (string-match-p key buffer-name)) - (and (functionp key) - (funcall key buffer-name action))) - (throw 'match (cdr entry))))))) + (when (buffer-match-p (car entry) buffer-name action) + (throw 'match (cdr entry)))))) (defvar display-buffer--same-window-action '(display-buffer-same-window commit ea54062fdf013768fbc64ad20846cba55af44909 Author: Philip Kaludercic Date: Mon Mar 7 20:49:42 2022 +0100 Generalise buffer matching from project.el * subr.el (buffer-match): Add function to check if a buffer satisfies a condition. (match-buffers): Returns all buffers that satisfy a condition. diff --git a/lisp/subr.el b/lisp/subr.el index e7d5d36461..d0b73db019 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6651,4 +6651,63 @@ is inserted before adjusting the number of empty lines." If OMIT-NULLS, empty lines will be removed from the results." (split-string string "\n" omit-nulls)) +(defun buffer-match-p (condition buffer-or-name &optional arg) + "Return non-nil if BUFFER-OR-NAME matches CONDITION. +CONDITION is either: +- a regular expression, to match a buffer name, +- a predicate function that takes a buffer object and ARG as + arguments, and returns non-nil if the buffer matches, +- a cons-cell, where the car describes how to interpret the cdr. + The car can be one of the following: + * `major-mode': the buffer matches if the buffer's major + mode is derived from the major mode denoted by the cons-cell's + cdr + * `not': the cdr is interpreted as a negation of a condition. + * `and': the cdr is a list of recursive conditions, that all have + to be met. + * `or': the cdr is a list of recursive condition, of which at + least one has to be met." + (letrec + ((buffer (get-buffer buffer-or-name)) + (match + (lambda (conditions) + (catch 'match + (dolist (condition conditions) + (when (cond + ((stringp condition) + (string-match-p condition (buffer-name buffer))) + ((functionp condition) + (if (eq 1 (cdr (func-arity condition))) + (funcall condition buffer) + (funcall condition buffer arg))) + ((eq (car-safe condition) 'major-mode) + (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + (cdr condition))) + ((eq (car-safe condition) 'not) + (not (funcall match (cdr condition)))) + ((eq (car-safe condition) 'or) + (funcall match (cdr condition))) + ((eq (car-safe condition) 'and) + (catch 'fail + (dolist (c conditions) + (unless (funcall match c) + (throw 'fail nil))) + t))) + (throw 'match t))))))) + (funcall match (list condition)))) + +(defun match-buffers (condition &optional buffers arg) + "Return a list of buffers that match CONDITION. +See `buffer-match' for details on CONDITION. By default all +buffers are checked, this can be restricted by passing an +optional argument BUFFERS, set to a list of buffers to check. +ARG is passed to `buffer-match', for predicate conditions in +CONDITION." + (let (bufs) + (dolist (buf (or buffers (buffer-list))) + (when (buffer-match-p condition (get-buffer buf) arg) + (push buf bufs))) + bufs)) + ;;; subr.el ends here commit 4d2aa420bd09ac5109a4c13bd163386ea276297e Author: Po Lu Date: Fri Apr 15 15:09:18 2022 +0800 Fix core string lookup with modifiers on XI2 * src/xterm.c (handle_one_xevent): Clean modifiers from xkey.state before giving it to XLookupString. diff --git a/src/xterm.c b/src/xterm.c index 289ea06d92..f80b2ad2f0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -17535,6 +17535,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, char *copy_bufptr = copy_buffer; int copy_bufsiz = sizeof (copy_buffer); ptrdiff_t i; + uint old_state; struct xi_device_t *device, *source; coding = Qlatin_1; @@ -17779,9 +17780,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, else #endif { + old_state = xkey.state; + xkey.state &= ~ControlMask; + xkey.state &= ~(dpyinfo->meta_mod_mask + | dpyinfo->super_mod_mask + | dpyinfo->hyper_mod_mask + | dpyinfo->alt_mod_mask); + nbytes = XLookupString (&xkey, copy_bufptr, copy_bufsiz, &keysym, NULL); + + xkey.state = old_state; } }