commit cbbe235a9093c6939b4984843e11247b3b991b7c (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Jan 4 06:48:08 2022 +0000 Make menu bar key navigation work on Haiku * src/haiku_support.cc (menu_bar_active_p): New variable. (DispatchMessage): Pass through key events if the menu bar is active. (MenusBeginning, MenusEnd): Set `menu_bar_active_p' according to the state of the menu bar. (BMenuBar_delete): Clear `menu_bar_active_p'. * src/haikufns.c (haiku_free_frame_resources): Block input only after checking that F is a window system frame. * src/haikumenu.c (Fhaiku_menu_bar_open): Update doc string. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 2171b7bf81..84f5756f8c 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -266,6 +266,7 @@ class EmacsWindow : public BWindow int zoomed_p = 0; int shown_flag = 0; volatile int was_shown_p = 0; + bool menu_bar_active_p = false; EmacsWindow () : BWindow (BRect (0, 0, 0, 0), "", B_TITLED_WINDOW_LOOK, B_NORMAL_WINDOW_FEEL, B_NO_SERVER_SIDE_WINDOW_MODIFIERS) @@ -563,6 +564,15 @@ class EmacsWindow : public BWindow if (msg->what == B_KEY_DOWN || msg->what == B_KEY_UP) { struct haiku_key_event rq; + + /* Pass through key events to the regular dispatch mechanism + if the menu bar active, so that key navigation can work. */ + if (menu_bar_active_p) + { + BWindow::DispatchMessage (msg, handler); + return; + } + rq.window = this; int32_t code = msg->GetInt32 ("raw_char", 0); @@ -635,6 +645,7 @@ class EmacsWindow : public BWindow rq.window = this; haiku_write (MENU_BAR_OPEN, &rq); + menu_bar_active_p = true; } void @@ -644,6 +655,7 @@ class EmacsWindow : public BWindow rq.window = this; haiku_write (MENU_BAR_CLOSE, &rq); + menu_bar_active_p = false; } void @@ -908,6 +920,14 @@ class EmacsMenuBar : public BMenuBar { } + void + AttachedToWindow (void) + { + BWindow *window = Window (); + + window->SetKeyMenuBar (this); + } + void FrameResized (float newWidth, float newHeight) { @@ -2274,8 +2294,14 @@ BMenuBar_delete (void *menubar) { BView *vw = (BView *) menubar; BView *p = vw->Parent (); + EmacsWindow *window = (EmacsWindow *) p->Window (); + if (!p->LockLooper ()) gui_abort ("Failed to lock menu bar parent while removing menubar"); + window->SetKeyMenuBar (NULL); + /* MenusEnded isn't called if the menu bar is destroyed + before it closes. */ + window->menu_bar_active_p = false; vw->RemoveSelf (); p->UnlockLooper (); delete vw; diff --git a/src/haikufns.c b/src/haikufns.c index f010867fd9..4a0d2272d0 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1291,8 +1291,8 @@ haiku_free_frame_resources (struct frame *f) Lisp_Object bar; struct scroll_bar *b; - block_input (); check_window_system (f); + block_input (); hlinfo = MOUSE_HL_INFO (f); window = FRAME_HAIKU_WINDOW (f); diff --git a/src/haikumenu.c b/src/haikumenu.c index 5cfcc75132..f335bdacb4 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -630,12 +630,12 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_ } 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. */) + doc: /* Show and 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 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); commit 693815e90f90d977405dc9cd2857505a375caf96 Author: Po Lu Date: Tue Jan 4 06:10:25 2022 +0000 Improve Haiku frame restacking logic * src/haiku_support.cc (BWindow_is_active): * src/haiku_support.h (BWindow_is_active): New functions. * src/haikufns.c (Fhaiku_frame_restack): Prevent the newly raised frame from being sent to the back of the display. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index effd4c33a9..2171b7bf81 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -3002,3 +3002,10 @@ BWindow_send_behind (void *window, void *other_window) w->SendBehind (other); w->UnlockLooper (); } + +bool +BWindow_is_active (void *window) +{ + BWindow *w = (BWindow *) window; + return w->IsActive (); +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 2b61ec1ac1..ef90374f69 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -826,6 +826,9 @@ extern "C" extern void BWindow_send_behind (void *window, void *other_window); + extern bool + BWindow_is_active (void *window); + #ifdef __cplusplus extern void * find_appropriate_view_for_draw (void *vw); diff --git a/src/haikufns.c b/src/haikufns.c index 0b7972f945..f010867fd9 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -2341,11 +2341,39 @@ Some window managers may refuse to restack windows. */) block_input (); if (NILP (above)) - BWindow_send_behind (FRAME_HAIKU_WINDOW (f1), - FRAME_HAIKU_WINDOW (f2)); + { + /* If the window that is currently active will be sent behind + another window, make the window that it is being sent behind + active first, to avoid both windows being moved to the back of + the display. */ + + if (BWindow_is_active (FRAME_HAIKU_WINDOW (f1)) + /* But don't do this if any of the frames involved have + child frames, since they are guaranteed to be in front of + their toplevel parents. */ + && !FRAME_PARENT_FRAME (f1) + && !FRAME_PARENT_FRAME (f2)) + { + BWindow_activate (FRAME_HAIKU_WINDOW (f2)); + BWindow_sync (FRAME_HAIKU_WINDOW (f2)); + } + + BWindow_send_behind (FRAME_HAIKU_WINDOW (f1), + FRAME_HAIKU_WINDOW (f2)); + } else - BWindow_send_behind (FRAME_HAIKU_WINDOW (f2), - FRAME_HAIKU_WINDOW (f1)); + { + if (BWindow_is_active (FRAME_HAIKU_WINDOW (f2)) + && !FRAME_PARENT_FRAME (f1) + && !FRAME_PARENT_FRAME (f2)) + { + BWindow_activate (FRAME_HAIKU_WINDOW (f1)); + BWindow_sync (FRAME_HAIKU_WINDOW (f1)); + } + + BWindow_send_behind (FRAME_HAIKU_WINDOW (f2), + FRAME_HAIKU_WINDOW (f1)); + } BWindow_sync (FRAME_HAIKU_WINDOW (f1)); BWindow_sync (FRAME_HAIKU_WINDOW (f2)); commit 3a7a88d2f896b42e3bf43f7e1f5c166e2c743d73 Merge: f3481f21f7 565fd09d9b Author: Po Lu Date: Tue Jan 4 05:26:40 2022 +0000 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit f3481f21f710ab41980623728917704bb25b3ae5 Author: Po Lu Date: Tue Jan 4 05:22:56 2022 +0000 Find a way to make restacking frames work on Haiku * doc/lispref/frames.texi (Raising and Lowering): Update documentation to reflect that restacking frames is now supported on Haiku. * lisp/frame.el (haiku-frame-restack): New declaration. (frame-restack): Use `haiku-frame-restack' on Haiku. * src/haiku_support.cc (BWindow_send_behind): * src/haiku_support.h (BWindow_send_behind): * src/haikufns.c (Fhaiku_frame_restack): New functions. (syms_of_haikufns): New subr `haiku-frame-restack'. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index bb5d4bf291..ceaa11529f 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3165,8 +3165,7 @@ 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}.@footnote{Restacking frames is not supported on -Haiku, due to limitations imposed by the system.} +obscure @var{frame2}. Technically, this function may be thought of as an atomic action performed in two steps: The first step removes @var{frame1}'s diff --git a/lisp/frame.el b/lisp/frame.el index 60ef563e59..62b73f3157 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2019,6 +2019,7 @@ Return nil if DISPLAY contains no Emacs frame." (declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above)) (declare-function ns-frame-restack "nsfns.m" (frame1 frame2 &optional above)) (declare-function pgtk-frame-restack "pgtkfns.c" (frame1 frame2 &optional above)) +(declare-function haiku-frame-restack "haikufns.c" (frame1 frame2 &optional above)) (defun frame-restack (frame1 frame2 &optional above) "Restack FRAME1 below FRAME2. @@ -2049,6 +2050,8 @@ Some window managers may refuse to restack windows." (w32-frame-restack frame1 frame2 above)) ((eq frame-type 'ns) (ns-frame-restack frame1 frame2 above)) + ((eq frame-type 'haiku) + (haiku-frame-restack frame1 frame2 above)) ((eq frame-type 'pgtk) (pgtk-frame-restack frame1 frame2 above)))) (error "Cannot restack frames"))) diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 74e9765903..effd4c33a9 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2990,3 +2990,15 @@ BWindow_set_size_alignment (void *window, int align_width, int align_height) #endif w->UnlockLooper (); } + +void +BWindow_send_behind (void *window, void *other_window) +{ + BWindow *w = (BWindow *) window; + BWindow *other = (BWindow *) other_window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window in order to send it behind another"); + w->SendBehind (other); + w->UnlockLooper (); +} diff --git a/src/haiku_support.h b/src/haiku_support.h index dd5e168d14..2b61ec1ac1 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -823,6 +823,9 @@ extern "C" extern void BWindow_sync (void *window); + extern void + BWindow_send_behind (void *window, void *other_window); + #ifdef __cplusplus extern void * find_appropriate_view_for_draw (void *vw); diff --git a/src/haikufns.c b/src/haikufns.c index 6cd12f129c..0b7972f945 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -2321,6 +2321,39 @@ DEFUN ("x-display-save-under", Fx_display_save_under, return Qnil; } +DEFUN ("haiku-frame-restack", Fhaiku_frame_restack, Shaiku_frame_restack, 2, 3, 0, + doc: /* Restack FRAME1 below FRAME2. +This means that if both frames are visible and the display areas of +these frames overlap, FRAME2 (partially) obscures FRAME1. If optional +third argument ABOVE is non-nil, restack FRAME1 above FRAME2. This +means that if both frames are visible and the display areas of these +frames overlap, FRAME1 (partially) obscures FRAME2. + +Some window managers may refuse to restack windows. */) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) +{ + struct frame *f1 = decode_live_frame (frame1); + struct frame *f2 = decode_live_frame (frame2); + + check_window_system (f1); + check_window_system (f2); + + block_input (); + + if (NILP (above)) + BWindow_send_behind (FRAME_HAIKU_WINDOW (f1), + FRAME_HAIKU_WINDOW (f2)); + else + BWindow_send_behind (FRAME_HAIKU_WINDOW (f2), + FRAME_HAIKU_WINDOW (f1)); + BWindow_sync (FRAME_HAIKU_WINDOW (f1)); + BWindow_sync (FRAME_HAIKU_WINDOW (f2)); + + unblock_input (); + + return Qnil; +} + frame_parm_handler haiku_frame_parm_handlers[] = { gui_set_autoraise, @@ -2415,6 +2448,7 @@ syms_of_haikufns (void) defsubr (&Shaiku_put_resource); defsubr (&Shaiku_frame_list_z_order); defsubr (&Sx_display_save_under); + defsubr (&Shaiku_frame_restack); tip_timer = Qnil; staticpro (&tip_timer); commit 565fd09d9b92167c3cafd1b49c5e69e3c0e88e25 Author: Stefan Kangas Date: Tue Jan 4 05:38:00 2022 +0100 * test/src/doc-tests.el: New file. diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el new file mode 100644 index 0000000000..8dabba9035 --- /dev/null +++ b/test/src/doc-tests.el @@ -0,0 +1,43 @@ +;;; doc-tests.el --- tests for doc.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2022 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) + +(ert-deftest doc-tests-documentation/c-primitive () + (should (stringp (documentation 'defalias)))) + +(ert-deftest doc-tests-documentation/preloaded () + (should (stringp (documentation 'defun)))) + +(ert-deftest doc-tests-documentation/autoloaded-macro () + (skip-unless noninteractive) + (should (autoloadp (symbol-function 'rx))) + (should (stringp (documentation 'rx)))) ; See Bug#52969. + +(ert-deftest doc-tests-documentation/autoloaded-defun () + (skip-unless noninteractive) + (should (autoloadp (symbol-function 'tetris))) + (should (stringp (documentation 'tetris)))) ; See Bug#52969. + +(ert-deftest doc-tests-quoting-style () + (should (memq (text-quoting-style) '(grave straight curve)))) + +;;; doc-tests.el ends here commit 6668a7608cac6f09d4adc3282fce9a7c03e56792 Author: Po Lu Date: Tue Jan 4 11:16:46 2022 +0800 Add effective group to xkey events when handling XI key press events * src/xterm.c (handle_one_xevent): Add effective group to xkey.state when translating XI key events. diff --git a/src/xterm.c b/src/xterm.c index 31e39280b3..8202e8fb00 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10668,7 +10668,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, xkey.root = xev->root; xkey.subwindow = xev->child; xkey.time = xev->time; - xkey.state = xev->mods.effective; + xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) + | (xev->group.effective << 13)); xkey.keycode = xev->detail; xkey.same_screen = True; commit 24a52df738d717472c203e9ac41ffac282c45921 Author: Stefan Kangas Date: Tue Jan 4 03:52:18 2022 +0100 Fix two unused variable warnings in make-docfile.c * lib-src/make-docfile.c (scan_lisp_file): Fix unused variable warnings. diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 199f1dbbcc..f42b1988a2 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -1329,8 +1329,6 @@ scan_lisp_file (const char *filename, const char *mode) { FILE *infile; int c; - int i; - int flen = strlen (filename); if (generate_globals) fatal ("scanning lisp file when -g specified"); commit 417a3ebaa2d5e6673398808637395b485fe6ae76 Author: Stefan Kangas Date: Tue Jan 4 03:50:59 2022 +0100 Test that buffer exists in shortdoc-all-groups-work * test/lisp/emacs-lisp/shortdoc-tests.el (shortdoc-all-groups-work): Test that the shortdoc buffer was created. diff --git a/test/lisp/emacs-lisp/shortdoc-tests.el b/test/lisp/emacs-lisp/shortdoc-tests.el index 326d43eead..8515b9fdfb 100644 --- a/test/lisp/emacs-lisp/shortdoc-tests.el +++ b/test/lisp/emacs-lisp/shortdoc-tests.el @@ -47,10 +47,13 @@ (ert-deftest shortdoc-all-groups-work () "Test that all defined shortdoc groups display correctly." (dolist (group (mapcar (lambda (x) (car x)) shortdoc--groups)) - (unwind-protect - (shortdoc-display-group group) - (when-let ((buf (get-buffer (format "*Shortdoc %s*" group)))) - (kill-buffer buf))))) + (let ((buf-name (format "*Shortdoc %s*" group)) buf) + (unwind-protect + (progn + (shortdoc-display-group group) + (should (setq buf (get-buffer buf-name)))) + (when buf + (kill-buffer buf)))))) (provide 'shortdoc-tests) commit cd7e7834ba5d40e3181054f02693f64ace6fd6aa Author: Po Lu Date: Tue Jan 4 02:21:23 2022 +0000 Fix Haiku bitmap sanity checks * src/haikufns.c (haiku_get_pixel, haiku_put_pixel): Fix sanity checking of coordinate values. diff --git a/src/haikufns.c b/src/haikufns.c index 036da7975f..6cd12f129c 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1238,7 +1238,7 @@ haiku_get_pixel (haiku bitmap, int x, int y) BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, &bytes_per_row, &mono_p); - if (x < left || x > right || y < top || y > bottom) + if (x < 0 || x > right - left || y < 0 || y > bottom - top) emacs_abort (); if (!mono_p) @@ -1263,7 +1263,7 @@ haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel) BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, &bytes_per_row, &mono_p); - if (x < left || x > right || y < top || y > bottom) + if (x < 0 || x > right - left || y < 0 || y > bottom - top) emacs_abort (); if (mono_p) commit a89bc0fe9ca81421a592171d10287ae69fd5910b Author: Po Lu Date: Tue Jan 4 02:01:30 2022 +0000 Fix fringe bitmap display on haiku again * src/haiku_draw_support.cc (BView_DrawBitmapWithEraseOp): Fix off-by-one errors. diff --git a/src/haiku_draw_support.cc b/src/haiku_draw_support.cc index b0bc786ccf..76a5d2e59c 100644 --- a/src/haiku_draw_support.cc +++ b/src/haiku_draw_support.cc @@ -310,9 +310,9 @@ BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x, if (bm->ColorSpace () == B_GRAY1) { rgb_color low_color = vw->LowColor (); - for (int y = 0; y <= bc.Bounds ().Height () + 1; ++y) + for (int y = 0; y <= bc.Bounds ().Height (); ++y) { - for (int x = 0; x <= bc.Bounds ().Width () + 1; ++x) + 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); commit 7eb86a1788aebe70f7a111673bfc31d11d0e8612 Author: Po Lu Date: Tue Jan 4 01:30:27 2022 +0000 Fix duplicate file panel display on Haiku * lisp/term/haiku-win.el (x-file-dialog): Fix up prompt to look better. * src/haiku_support.cc (be_popup_file_dialog): Remove duplicate call to `Show'. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index c219ab2944..f3c94db6a3 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -114,7 +114,10 @@ If TYPE is nil, return \"text/plain\"." (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) + (haiku-read-file-name (if (not (string-suffix-p ": " prompt)) + prompt + (substring prompt 0 (- (length prompt) 2))) + (selected-frame) (or dir (and default_filename (file-name-directory default_filename))) mustmatch only_dir_p diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 04470a3b96..74e9765903 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2682,7 +2682,6 @@ be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int be_popup_file_dialog_safe_set_target (panel, w); panel->Show (); - panel->Window ()->Show (); unblock_input_function (); void *buf = alloca (200); commit 5c63786cb9873ab2b61b5ad511c84df9cd56ce87 Author: Stefan Kangas Date: Mon Jan 3 21:40:38 2022 +0100 New test shortdoc-all-groups-work * test/lisp/emacs-lisp/shortdoc-tests.el (shortdoc-all-groups-work): New test. See Bug#52969. diff --git a/test/lisp/emacs-lisp/shortdoc-tests.el b/test/lisp/emacs-lisp/shortdoc-tests.el index 1c4125e301..326d43eead 100644 --- a/test/lisp/emacs-lisp/shortdoc-tests.el +++ b/test/lisp/emacs-lisp/shortdoc-tests.el @@ -44,6 +44,14 @@ (should (shortdoc-tests--tree-contains expr fun)))) (setq props (cddr props)))))))) +(ert-deftest shortdoc-all-groups-work () + "Test that all defined shortdoc groups display correctly." + (dolist (group (mapcar (lambda (x) (car x)) shortdoc--groups)) + (unwind-protect + (shortdoc-display-group group) + (when-let ((buf (get-buffer (format "*Shortdoc %s*" group)))) + (kill-buffer buf))))) + (provide 'shortdoc-tests) ;;; shortdoc-tests.el ends here commit 460f35e96df1c39ce2ba0f424b36365a2f9e9825 Author: Stefan Monnier Date: Mon Jan 3 15:04:12 2022 -0500 Revert part of 59732a83c8 to fix bug#52969 While we don't need to put docstrings of .elc files into etc/DOC, we still need to put those of `loaddefs.el` there since we don't have a "dynamic docstring" feature for the non-compiled files and keeping the actual docstrings in the heap would be prohibitive. * src/Makefile.in ($(etc)/DOC): Scan `lisp/loaddefs.el` still. * lib-src/make-docfile.c (scan_lisp_file): New function. (scan_file): Use it. (skip_white, read_lisp_symbol, search_lisp_doc_at_eol): New functions. diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 33ed5ec0c9..199f1dbbcc 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -19,8 +19,8 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -/* The arguments given to this program are all the C files - of GNU Emacs. .c files are allowed. +/* The arguments given to this program are all the C and some Lisp source files + of GNU Emacs. .el and .c files are allowed. A .o file can also be specified; the .c file it was made from is used. This helps the makefile pass the correct list of files. Option -d DIR means change to DIR before looking for files. @@ -65,6 +65,7 @@ along with GNU Emacs. If not, see . */ #endif /* not DOS_NT */ static void scan_file (char *filename); +static void scan_lisp_file (const char *filename, const char *mode); static void scan_c_file (char *filename, const char *mode); static void scan_c_stream (FILE *infile); static void start_globals (void); @@ -234,9 +235,14 @@ put_filename (char *filename) static void scan_file (char *filename) { + ptrdiff_t len = strlen (filename); + if (!generate_globals) put_filename (filename); - scan_c_file (filename, "r"); + if (len > 3 && !strcmp (filename + len - 3, ".el")) + scan_lisp_file (filename, "r"); + else + scan_c_file (filename, "r"); } static void @@ -1214,4 +1220,354 @@ scan_c_stream (FILE *infile) fatal ("read error"); } +/* Read a file of Lisp source code. + Looks for + (defun NAME ARGS DOCSTRING ...) + (defmacro NAME ARGS DOCSTRING ...) + (defsubst NAME ARGS DOCSTRING ...) + (autoload (quote NAME) FILE DOCSTRING ...) + (defvar NAME VALUE DOCSTRING) + (defconst NAME VALUE DOCSTRING) + (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) + (fset (quote NAME) #[... DOCSTRING ...]) + (defalias (quote NAME) #[... DOCSTRING ...]) + (custom-declare-variable (quote NAME) VALUE DOCSTRING ...) + starting in column zero. + (quote NAME) may appear as 'NAME as well. + + We also look for #@LENGTH CONTENTS^_ at the beginning of the line. + When we find that, we save it for the following defining-form, + and we use that instead of reading a doc string within that defining-form. + + For defvar, defconst, and fset we skip to the docstring with a kludgy + formatting convention: all docstrings must appear on the same line as the + initial open-paren (the one in column zero) and must contain a backslash + and a newline immediately after the initial double-quote. No newlines + must appear between the beginning of the form and the first double-quote. + For defun, defmacro, and autoload, we know how to skip over the + arglist, but the doc string must still have a backslash and newline + immediately after the double quote. + The only source files that follow this convention are autoload-generated + files like loaddefs.el; + The NAME and DOCSTRING are output. + NAME is preceded by `F' for a function or `V' for a variable. + An entry is output only if DOCSTRING has \ newline just after the opening ". + */ + +static void +skip_white (FILE *infile) +{ + int c; + do + c = getc (infile); + while (c_isspace (c)); + + ungetc (c, infile); +} + +static void +read_lisp_symbol (FILE *infile, char *buffer) +{ + int c; + char *fillp = buffer; + + skip_white (infile); + while (true) + { + c = getc (infile); + if (c == '\\') + { + c = getc (infile); + if (c < 0) + return; + *fillp++ = c; + } + else if (c_isspace (c) || c == '(' || c == ')' || c < 0) + { + ungetc (c, infile); + *fillp = 0; + break; + } + else + *fillp++ = c; + } + + if (! buffer[0]) + fprintf (stderr, "## expected a symbol, got '%c'\n", c); + + skip_white (infile); +} + +static bool +search_lisp_doc_at_eol (FILE *infile) +{ + int c = 0, c1 = 0, c2 = 0; + + /* Skip until the end of line; remember two previous chars. */ + while (c != '\n' && c != '\r' && c != EOF) + { + c2 = c1; + c1 = c; + c = getc (infile); + } + + /* If two previous characters were " and \, + this is a doc string. Otherwise, there is none. */ + if (c2 != '"' || c1 != '\\') + { +#ifdef DEBUG + fprintf (stderr, "## non-docstring found\n"); +#endif + ungetc (c, infile); + return false; + } + return true; +} + +static void +scan_lisp_file (const char *filename, const char *mode) +{ + FILE *infile; + int c; + int i; + int flen = strlen (filename); + + if (generate_globals) + fatal ("scanning lisp file when -g specified"); + + infile = fopen (filename, mode); + if (infile == NULL) + { + perror (filename); + exit (EXIT_FAILURE); + } + + c = '\n'; + while (!feof (infile)) + { + char buffer[BUFSIZ]; + char type; + + /* If not at end of line, skip till we get to one. */ + if (c != '\n' && c != '\r') + { + c = getc (infile); + continue; + } + /* Skip the line break. */ + while (c == '\n' || c == '\r') + c = getc (infile); + + if (c != '(') + continue; + + read_lisp_symbol (infile, buffer); + + if (! strcmp (buffer, "defun") + || ! strcmp (buffer, "defmacro") + || ! strcmp (buffer, "defsubst")) + { + type = 'F'; + read_lisp_symbol (infile, buffer); + + /* Skip the arguments: either "nil" or a list in parens. */ + + c = getc (infile); + if (c == 'n') /* nil */ + { + if ((c = getc (infile)) != 'i' + || (c = getc (infile)) != 'l') + { + fprintf (stderr, "## unparsable arglist in %s (%s)\n", + buffer, filename); + continue; + } + } + else if (c != '(') + { + fprintf (stderr, "## unparsable arglist in %s (%s)\n", + buffer, filename); + continue; + } + else + while (! (c == ')' || c < 0)) + c = getc (infile); + skip_white (infile); + + /* If the next three characters aren't `dquote bslash newline' + then we're not reading a docstring. + */ + if ((c = getc (infile)) != '"' + || (c = getc (infile)) != '\\' + || ((c = getc (infile)) != '\n' && c != '\r')) + { +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + continue; + } + } + + else if (! strcmp (buffer, "defvar") + || ! strcmp (buffer, "defconst") + || ! strcmp (buffer, "defcustom")) + { + type = 'V'; + read_lisp_symbol (infile, buffer); + + if (!search_lisp_doc_at_eol (infile)) + continue; + } + + else if (! strcmp (buffer, "custom-declare-variable") + || ! strcmp (buffer, "defvaralias") + ) + { + type = 'V'; + + c = getc (infile); + if (c == '\'') + read_lisp_symbol (infile, buffer); + else + { + if (c != '(') + { + fprintf (stderr, + "## unparsable name in custom-declare-variable in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + if (strcmp (buffer, "quote")) + { + fprintf (stderr, + "## unparsable name in custom-declare-variable in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + c = getc (infile); + if (c != ')') + { + fprintf (stderr, + "## unparsable quoted name in custom-declare-variable in %s\n", + filename); + continue; + } + } + + if (!search_lisp_doc_at_eol (infile)) + continue; + } + + else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) + { + type = 'F'; + + c = getc (infile); + if (c == '\'') + read_lisp_symbol (infile, buffer); + else + { + if (c != '(') + { + fprintf (stderr, "## unparsable name in fset in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + if (strcmp (buffer, "quote")) + { + fprintf (stderr, "## unparsable name in fset in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + c = getc (infile); + if (c != ')') + { + fprintf (stderr, + "## unparsable quoted name in fset in %s\n", + filename); + continue; + } + } + + if (!search_lisp_doc_at_eol (infile)) + continue; + } + + else if (! strcmp (buffer, "autoload")) + { + type = 'F'; + c = getc (infile); + if (c == '\'') + read_lisp_symbol (infile, buffer); + else + { + if (c != '(') + { + fprintf (stderr, "## unparsable name in autoload in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + if (strcmp (buffer, "quote")) + { + fprintf (stderr, "## unparsable name in autoload in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + c = getc (infile); + if (c != ')') + { + fprintf (stderr, + "## unparsable quoted name in autoload in %s\n", + filename); + continue; + } + } + skip_white (infile); + c = getc (infile); + if (c != '\"') + { + fprintf (stderr, "## autoload of %s unparsable (%s)\n", + buffer, filename); + continue; + } + read_c_string_or_comment (infile, 0, false, 0); + + if (!search_lisp_doc_at_eol (infile)) + continue; + } + +#ifdef DEBUG + else if (! strcmp (buffer, "if") + || ! strcmp (buffer, "byte-code")) + continue; +#endif + + else + { +#ifdef DEBUG + fprintf (stderr, "## unrecognized top-level form, %s (%s)\n", + buffer, filename); +#endif + continue; + } + + /* At this point, we should gobble a doc string from the input file. + The opening quote (and leading backslash-newline) + have already been read. */ + + printf ("\037%c%s\n", type, buffer); + read_c_string_or_comment (infile, 1, false, 0); + } + if (ferror (infile) || fclose (infile) != 0) + fatal ("%s: read error", filename); +} + + /* make-docfile.c ends here */ diff --git a/src/Makefile.in b/src/Makefile.in index 6379582660..83210b1317 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -642,11 +642,13 @@ endif ## for the first time, this prevents any variation between configurations ## in the contents of the DOC file. ## -$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(doc_obj) +$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(doc_obj) $(lispsource)/loaddefs.el $(AM_V_GEN)$(MKDIR_P) $(etc) $(AM_V_at)rm -f $(etc)/DOC $(AM_V_at)$(libsrc)/make-docfile -d $(srcdir) \ $(SOME_MACHINE_OBJECTS) $(doc_obj) > $(etc)/DOC + $(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \ + loaddefs.el $(libsrc)/make-docfile$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT): \ $(lib)/libgnu.a commit ab5ee3e29e916d4009b301841e9780aad564a6a0 Author: Po Lu Date: Mon Jan 3 13:57:13 2022 +0000 * src/haiku_font_support.cc (BFont_char_bounds): Fix bearings. diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index 298bc73f29..6ea10b2e47 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -126,9 +126,28 @@ BFont_have_char_block (void *font, int32_t beg, int32_t end) 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. */ +/* Compute bounds for MB_STR, a character in multibyte encoding, used + with FONT. The distance to move rightwards before reaching to the + next character's left escapement boundary is returned in ADVANCE, + the left bearing in LB, and the right bearing in RB. + + The left bearing is the amount of pixels from the left escapement + boundary (origin) to the left-most pixel that constitutes the glyph + corresponding to mb_str, and RB is the amount of pixels from the + origin to the right-most pixel constituting the glyph. + + Both the left and right bearings are positive values measured + towards the right, which means that the left bearing will only be + negative if the left-most pixel is to the left of the origin. + + The bearing values correspond to X11 XCharStruct semantics, which + is what Emacs code operates on. Haiku itself uses a slightly + different scheme, where the "left edge" is the distance from the + origin to the left-most pixel, where leftwards is negative and + rightwards is positive, and the "right edge" is the distance (where + leftwards is similarly negative) between the right-most pixel and + the right escapement boundary, which is the left escapement + boundary plus the advance. */ void BFont_char_bounds (void *font, const char *mb_str, int *advance, int *lb, int *rb) @@ -140,9 +159,9 @@ BFont_char_bounds (void *font, const char *mb_str, int *advance, 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); + *advance = std::ceil (escapement * size); + *lb = std::ceil (edge_info.left * size); + *rb = *advance + std::ceil (edge_info.right * size); } /* The same, but for a variable amount of chars. */ commit c7768382cc08c6861ed514316a27050b4104fbf4 Author: Po Lu Date: Mon Jan 3 11:07:29 2022 +0000 Synchronize at a better place when making a frame visible on Haiku * src/haiku_support.cc (BWindow_set_visible): Stop synchronizing here. * src/haikufns.c (haiku_visualize_frame): (haiku_unvisualize_frame): Sychronize after visibility changes. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 64f9aa8a55..04470a3b96 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1661,7 +1661,6 @@ BWindow_set_visible (void *window, int visible_p) win->Minimize (false); win->EmacsHide (); } - win->Sync (); } /* Change the title of WINDOW to the multibyte string TITLE. */ diff --git a/src/haikufns.c b/src/haikufns.c index 743ecf1aef..036da7975f 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1393,6 +1393,7 @@ haiku_visualize_frame (struct frame *f) if (FRAME_NO_FOCUS_ON_MAP (f) && !FRAME_NO_ACCEPT_FOCUS (f)) BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), 0); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); haiku_set_offset (f, f->left_pos, f->top_pos, 0); @@ -1409,6 +1410,7 @@ haiku_unvisualize_frame (struct frame *f) block_input (); BWindow_set_visible (FRAME_HAIKU_WINDOW (f), 0); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); SET_FRAME_VISIBLE (f, 0); SET_FRAME_ICONIFIED (f, 0); commit 4efaabaf272a557e68e7dd0e183afee3ef7ef4bc Author: Po Lu Date: Mon Jan 3 10:16:06 2022 +0000 Implement AC line status for the Haiku battery function * lisp/battery.el (battery--search-haiku-acpi-status): Return `fully-charged' instead of `normal'. (battery-haiku-acpi-battery): Implement %L for AC line status. diff --git a/lisp/battery.el b/lisp/battery.el index f4d59f30bb..45334163fa 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -651,7 +651,7 @@ Last Full Charge \\([[:digit:]]+\\)") ((not (zerop (logand state 2))) 'charging) ((not (zerop (logand state 1))) 'discharging) ((not (zerop (logand state 4))) 'critical) - (t 'normal)) + (t 'fully-charged)) :design-capacity design-capacity :design-voltage design-voltage :last-full-charge last-full-charge))) @@ -663,6 +663,7 @@ This function only works on Haiku systems with an ACPI battery. The following %-sequences are provided: %c Current capacity (mAh) %r Current rate of charge or discharge +%L AC line status (verbose) %B Battery status (verbose) %b Battery status: empty means high, `-' means low, `!' means critical, and `+' means charging @@ -688,6 +689,8 @@ The following %-sequences are provided: "-") ((eq state 'critical) "!") (t "")))) + (cons ?L (if (not (eq (plist-get list :state) 'discharging)) + "on-line" "off-line")) (cons ?p (format "%.0f" (* 100 (/ (plist-get list :capacity) (plist-get list :last-full-charge)))))) commit bd9a09bb6b9d636386b8336089e21f0ec15091cf Author: Stefan Kangas Date: Mon Jan 3 09:02:29 2022 +0100 elide-head: Make GPL regexp more forgiving * lisp/elide-head.el (elide-head-headers-to-hide): Make GPL regexp more forgiving. * test/lisp/elide-head-tests.el (elide-head--add-test): New macro. (elide-head--test-headers-to-hide/gpl2-1) (elide-head--test-headers-to-hide/gpl3-1) (elide-head--test-headers-to-hide/gpl3-2) (elide-head--test-headers-to-hide/gpl3-3) (elide-head--test-headers-to-hide/gpl3-4): New tests. diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 619d350c80..dab51cabc4 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -52,9 +52,14 @@ (defcustom elide-head-headers-to-hide `(;; GNU GPL ("is free software[:;] you can redistribute it" . - "\\(If not, see \\|\ -Boston, MA 0211\\(1-1307\\|0-1301\\), USA\\|\ -675 Mass Ave, Cambridge, MA 02139, USA\\)\\.") + ,(rx (or (seq "If not, see " (? "<") + "http" (? "s") "://www.gnu.org/licenses/" + (? ">") (? " ")) + (seq "Boston, MA " (? " ") + "0211" (or "1-1307" "0-1301") + (or " " ", ") "USA") + "675 Mass Ave, Cambridge, MA 02139, USA") + (? "."))) ;; FreeBSD license / Modified BSD license (3-clause) (,(rx (or "The Regents of the University of California. All rights reserved." "Redistribution and use in source and binary")) diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el index 7c820db975..804617f48f 100644 --- a/test/lisp/elide-head-tests.el +++ b/test/lisp/elide-head-tests.el @@ -58,5 +58,110 @@ (elide-head-show) (should-not (overlays-at 14))))) +(defmacro elide-head--add-test (name text search-str) + `(ert-deftest ,(intern (format "elide-head--test-headers-to-hide/%s" name)) () + (with-temp-buffer + (insert ,text) + (elide-head) + (goto-char (point-min)) + (re-search-forward ,search-str) + (let ((o (car (overlays-at (match-beginning 0))))) + (should (overlayp o)) + (should (overlay-get o 'invisible)) + (should (overlay-get o 'evaporate)))))) + + +;;; GPLv3 + +;; from Emacs +(elide-head--add-test gpl3-1 "\ +;; 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 is distributed in the hope that") + +;; from libtorrent +(elide-head--add-test gpl3-2 "\ + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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 + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +" "This library is distributed in the hope that") + +;; from notmuch +(elide-head--add-test gpl3-3 "\ + * This program 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. + * + * This program 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 this program. If not, see https://www.gnu.org/licenses/ . +" "This program is distributed in the hope that") + +;; from fribok +(elide-head--add-test gpl3-4 "\ +/*************************************************************************** + * Copyright (C) 2007, 2009 by J. Random Hacker * + * * + * This program 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. * + * * + * This program 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 this program. If not, see *. + * * + ***************************************************************************/ +" "This program is distributed in the hope that") + + +;;; GPLv2 + +;; from jackmeter +(elide-head--add-test gpl2-1 "\ + This program 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 2 + of the License, or (at your option) any later version. + + This program 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 this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +" "This program is distributed in the hope that") + (provide 'elide-head-tests) ;;; elide-head-tests.el ends here