commit 91175a1fae92d521377bde8687d96b17556d1458 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Mon Apr 25 05:51:42 2022 +0000 Delete some unused functions on Haiku * src/haiku_support.cc (haiku_current_workspace) (BWindow_workspaces): * src/haiku_support.h: Remove unused functions and prototypes. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index eb9379f17d..f19631a22a 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -3071,20 +3071,6 @@ BView_emacs_delete (void *view) delete vw; } -/* Return the current workspace. */ -uint32_t -haiku_current_workspace (void) -{ - return current_workspace (); -} - -/* Return a bitmask consisting of workspaces WINDOW is on. */ -uint32_t -BWindow_workspaces (void *window) -{ - return ((BWindow *) window)->Workspaces (); -} - /* Create a popup menu. */ void * BPopUpMenu_new (const char *name) diff --git a/src/haiku_support.h b/src/haiku_support.h index 0280f2cc18..6660b011a6 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -457,7 +457,6 @@ extern void BWindow_center_on_screen (void *); extern void BWindow_change_decoration (void *, int); extern void BWindow_set_tooltip_decoration (void *); extern void BWindow_set_avoid_focus (void *, int); -extern uint32_t BWindow_workspaces (void *); extern void BWindow_zoom (void *); extern void BWindow_set_min_size (void *, int, int); extern void BWindow_set_size_alignment (void *, int, int); @@ -550,7 +549,6 @@ extern void BView_convert_to_screen (void *, int *, int *); extern void BView_convert_from_screen (void *, int *, int *); extern void BView_emacs_delete (void *); -extern uint32_t haiku_current_workspace (void); extern void *BPopUpMenu_new (const char *); commit c6809e97e4e74a3d29c69eab86aad7de9fcd3293 Author: Po Lu Date: Mon Apr 25 13:42:44 2022 +0800 Get rid of autorelease warnings during building on GNUstep * src/emacs.c (decode_env_path): * src/nsfns.m (ns_appkit_version_str): * src/nsterm.m (ns_term_shutdown): Setup autorelease when objects might be autoreleased during building. diff --git a/src/emacs.c b/src/emacs.c index 3100852b2c..ca99a8c787 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -3153,6 +3153,9 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) { const char *path, *p; Lisp_Object lpath, element, tem; +#ifdef NS_SELF_CONTAINED + void *autorelease = NULL; +#endif /* Default is to use "." for empty path elements. But if argument EMPTY is true, use nil instead. */ Lisp_Object empty_element = empty ? Qnil : build_string ("."); @@ -3180,6 +3183,8 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) if (!path) { #ifdef NS_SELF_CONTAINED + /* ns_relocate needs a valid autorelease pool around it. */ + autorelease = ns_alloc_autorelease_pool (); path = ns_relocate (defalt); #else path = defalt; @@ -3282,6 +3287,11 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) else break; } + +#ifdef NS_SELF_CONTAINED + if (autorelease) + ns_release_autorelease_pool (autorelease); +#endif return Fnreverse (lpath); } diff --git a/src/nsfns.m b/src/nsfns.m index f3dc235b89..cff31f7fe0 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -891,7 +891,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. ns_appkit_version_str (void) { NSString *tmp; + Lisp_Object string; + NSAutoreleasePool *autorelease; + autorelease = [[NSAutoreleasePool alloc] init]; #ifdef NS_IMPL_GNUSTEP tmp = [NSString stringWithFormat:@"gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION)]; #elif defined (NS_IMPL_COCOA) @@ -901,7 +904,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. #else tmp = [NSString initWithUTF8String:@"ns-unknown"]; #endif - return [tmp lispString]; + string = [tmp lispString]; + [autorelease release]; + + return string; } diff --git a/src/nsterm.m b/src/nsterm.m index 5a6a4d663b..4737cb1b35 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5404,20 +5404,21 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. void ns_term_shutdown (int sig) { + NSAutoreleasePool *pool; + /* We also need an autorelease pool here, since this can be called + during dumping. */ + pool = [[NSAutoreleasePool alloc] init]; [[NSUserDefaults standardUserDefaults] synchronize]; + [pool release]; /* code not reached in emacs.c after this is called by shut_down_emacs: */ if (STRINGP (Vauto_save_list_file_name)) unlink (SSDATA (Vauto_save_list_file_name)); if (sig == 0 || sig == SIGTERM) - { - [NSApp terminate: NSApp]; - } - else // force a stack trace to happen - { - emacs_abort (); - } + [NSApp terminate: NSApp]; + else /* Force a stack trace to happen. */ + emacs_abort (); } commit 45372fb1f4862a94b57dee2c5ac0cc870d589de4 Author: Po Lu Date: Mon Apr 25 12:13:22 2022 +0800 * src/nsfns.m (Fns_list_colors): Fix autoreleasing. diff --git a/src/nsfns.m b/src/nsfns.m index 720ed3f88e..f3dc235b89 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -2103,6 +2103,7 @@ Frames are listed from topmost (first) to bottommost (last). */) Lisp_Object list = Qnil; NSEnumerator *colorlists; NSColorList *clist; + NSAutoreleasePool *pool; if (!NILP (frame)) { @@ -2112,7 +2113,9 @@ Frames are listed from topmost (first) to bottommost (last). */) } block_input (); - + /* This can be called during dumping, so we need to set up a + temporary autorelease pool. */ + pool = [[NSAutoreleasePool alloc] init]; colorlists = [[NSColorList availableColorLists] objectEnumerator]; while ((clist = [colorlists nextObject])) { @@ -2123,12 +2126,9 @@ Frames are listed from topmost (first) to bottommost (last). */) NSString *cname; while ((cname = [cnames nextObject])) list = Fcons ([cname lispString], list); -/* for (i = [[clist allKeys] count] - 1; i >= 0; i--) - list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i] - UTF8String]), list); */ } } - + [pool release]; unblock_input (); return list; commit 3780741116f7ad5f320f7741a22a0bd8a8238621 Author: Po Lu Date: Mon Apr 25 09:00:13 2022 +0800 Set last user time during drag-and-drop * src/xterm.c (XTmouse_position): Set last user time if track-mouse is drag-source or dropping. diff --git a/src/xterm.c b/src/xterm.c index 4661f731cd..0f93e4807f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10717,6 +10717,16 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, #endif /* USE_X_TOOLKIT */ } + /* Set last user time to avoid confusing some window managers + about the tooltip displayed during drag-and-drop. */ + + if ((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && (dpyinfo->last_user_time + < dpyinfo->last_mouse_movement_time)) + x_display_set_last_user_time (dpyinfo, + dpyinfo->last_mouse_movement_time); + if ((!f1 || FRAME_TOOLTIP_P (f1)) && (EQ (track_mouse, Qdropping) || EQ (track_mouse, Qdrag_source)) commit 7d5e9b8d8170920c93e69e51abe7dc064f0257bb Author: Po Lu Date: Mon Apr 25 00:40:53 2022 +0000 Fix 32-bit Haiku build * src/haiku_support.h (be_get_ui_color): Fix prototype. diff --git a/src/haiku_support.h b/src/haiku_support.h index 3337df5551..0280f2cc18 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -639,7 +639,7 @@ extern int be_get_display_screens (void); extern bool be_use_subpixel_antialiasing (void); extern const char *be_find_setting (const char *); extern haiku_font_family_or_style *be_list_font_families (size_t *); -extern int be_get_ui_color (const char *, uint32 *); +extern int be_get_ui_color (const char *, uint32_t *); extern void BMessage_delete (void *); commit 8b071c77b0d7200fcc6659d395113ac4d9d778a5 Author: Karl Fogel Date: Sun Apr 24 14:07:21 2022 -0500 Improve sorting in the bookmark list buffer - Ensure that the bookmark bmenu buffer sorts when it should. - Sort case-insensitively and by locale-dependent collation order. - Rename "Bookmark" column to "Bookmark Name". - Coordinate that column's sort toggle and `bookmark-sort-flag'. - Document the new behavior. * lisp/bookmark.el (bookmark-bmenu--name-predicate, bookmark-bmenu--type-predicate, bookmark-bmenu--file-predicate): Use `string-collate-lessp' with IGNORE-CASE argument, instead of plain `string<'. (bookmark-bmenu--revert): Sort based on `bookmark-sort-flag'. (bookmark-bmenu-mode): Document the new behavior. Rename the "Bookmark" column to "Bookmark Name" for clarity & documentabilty. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 31876c83a2..6c46268a34 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1824,7 +1824,29 @@ Don't affect the buffer ring order." (list location))]) entries))) (tabulated-list-init-header) - (setq tabulated-list-entries (reverse entries))) + ;; The value of `bookmark-sort-flag' might have changed since the + ;; last time the buffer contents were generated, so re-check it. + (if bookmark-sort-flag + (progn + (setq tabulated-list-sort-key '("Bookmark Name" . nil)) + (setq tabulated-list-entries entries)) + (setq tabulated-list-sort-key nil) + ;; And since we're not sorting by bookmark name, show bookmarks + ;; according to order of creation, with the most recently + ;; created bookmarks at the top and the least recently created + ;; at the bottom. + ;; + ;; Note that clicking the column sort toggle for the bookmark + ;; name column will invoke the `tabulated-list-mode' sort, which + ;; uses `bookmark-bmenu--name-predicate' to sort lexically by + ;; bookmark name instead of by (reverse) creation order. + ;; Clicking the toggle again will reverse the lexical sort, but + ;; the sort will still be lexical not creation-order. However, + ;; if the user reverts the buffer, then the above check of + ;; `bookmark-sort-flag' will happen again and the buffer will + ;; go back to a creation-order sort. This is all expected + ;; behavior, as documented in `bookmark-bmenu-mode'. + (setq tabulated-list-entries (reverse entries)))) (tabulated-list-print t)) ;;;###autoload @@ -1868,6 +1890,18 @@ deletion, or > if it is flagged for displaying." Each line describes one of the bookmarks in Emacs. Letters do not insert themselves; instead, they are commands. Bookmark names preceded by a \"*\" have annotations. + +If `bookmark-sort-flag' is non-nil, then sort the list by +bookmark name (case-insensitively, in collation order); the +direction of that sort can be reversed by using the column sort +toggle for the bookmark name column. + +If `bookmark-sort-flag' is nil, then sort the list by bookmark +creation order, with most recently created bookmarks on top. +However, the column sort toggle will still activate (and +thereafter toggle the direction of) lexical sorting by bookmark name. +At any time you may use \\[revert-buffer] to go back to sorting by creation order. + \\ \\[bookmark-bmenu-mark] -- mark bookmark to be displayed. \\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed. @@ -1900,20 +1934,23 @@ Bookmark names preceded by a \"*\" have annotations. in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. \\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark. -\\[bookmark-bmenu-search] -- incrementally search for bookmarks." +\\[bookmark-bmenu-search] -- incrementally search for bookmarks. +\\[revert-buffer] -- refresh the buffer, and thus refresh the sort order (useful + if `bookmark-sort-flag' is nil)." (setq truncate-lines t) (setq buffer-read-only t) ;; FIXME: The header could also display the current default bookmark file ;; according to `bookmark-bookmarks-timestamp'. (setq tabulated-list-format `[("" 1) ;; Space to add "*" for bookmark with annotation - ("Bookmark" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate) + ("Bookmark Name" + ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate) ("Type" 8 bookmark-bmenu--type-predicate) ,@(if bookmark-bmenu-toggle-filenames '(("File" 0 bookmark-bmenu--file-predicate)))]) (setq tabulated-list-padding bookmark-bmenu-marks-width) (when bookmark-sort-flag - (setq tabulated-list-sort-key '("Bookmark" . nil))) + (setq tabulated-list-sort-key '("Bookmark Name" . nil))) (add-hook 'tabulated-list-revert-hook #'bookmark-bmenu--revert nil t)' (setq revert-buffer-function 'bookmark-bmenu--revert) (tabulated-list-init-header)) @@ -1922,17 +1959,19 @@ Bookmark names preceded by a \"*\" have annotations. (defun bookmark-bmenu--name-predicate (a b) "Predicate to sort \"*Bookmark List*\" buffer by the name column. This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." - (string< (caar a) (caar b))) + (string-collate-lessp (caar a) (caar b) nil t)) (defun bookmark-bmenu--type-predicate (a b) "Predicate to sort \"*Bookmark List*\" buffer by the type column. This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." - (string< (elt (cadr a) 2) (elt (cadr b) 2))) + (string-collate-lessp (elt (cadr a) 2) (elt (cadr b) 2) nil t)) (defun bookmark-bmenu--file-predicate (a b) "Predicate to sort \"*Bookmark List*\" buffer by the file column. This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." - (string< (bookmark-location (car a)) (bookmark-location (car b)))) + (string-collate-lessp (bookmark-location (car a)) + (bookmark-location (car b)) + nil t)) (defun bookmark-bmenu-toggle-filenames (&optional show) commit b3e009ba9834c187160ecb99d34fb1f8bd222eed Author: Aleksandr Vityazev Date: Sun Apr 24 17:19:46 2022 +0200 Fix typo in cl.texi example * doc/misc/cl.texi (Argument Lists): Fix typo (bug#55092). diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 2008f5a079..6134b97751 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -444,7 +444,7 @@ the ``rest'' argument is bound to the keyword list as it appears in the call. For example: @example -(cl-defun find-thing (thing &rest rest &key need &allow-other-keys) +(cl-defun find-thing (thing thing-list &rest rest &key need &allow-other-keys) (or (apply 'cl-member thing thing-list :allow-other-keys t rest) (if need (error "Thing not found")))) @end example commit 1a6fa4c5d51e105a90ab4c5f5f26a0e01f25500b Author: Lars Ingebrigtsen Date: Sun Apr 24 16:06:43 2022 +0200 Use `C-c C-k' instead of `C-c C-d' to abort in string-edit * lisp/textmodes/string-edit.el (string-edit-mode-map): Use `C-c C-k' to abort. diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el index 9f28fe773f..2a4c9abfad 100644 --- a/lisp/textmodes/string-edit.el +++ b/lisp/textmodes/string-edit.el @@ -40,7 +40,7 @@ When the user finishes editing (with `C-c C-c'), SUCCESS-CALLBACK is called with the resulting string. -If the user aborts (with `C-c C-d'), ABORT-CALLBACK (if any) is +If the user aborts (with `C-c C-k'), ABORT-CALLBACK (if any) is called with no parameters. If present, HELP-TEXT will be inserted at the start of the @@ -71,7 +71,7 @@ buffer, but won't be included in the resulting string." (defun read-string-from-buffer (string &optional help-text) "Switch to a new buffer to edit STRING in a recursive edit. -The user finishes editing with `C-c C-c', or aborts with `C-c C-d'). +The user finishes editing with `C-c C-c', or aborts with `C-c C-k'). If present, HELP-TEXT will be inserted at the start of the buffer, but won't be included in the resulting string." @@ -89,7 +89,7 @@ buffer, but won't be included in the resulting string." (defvar-keymap string-edit-mode-map "C-c C-c" #'string-edit-done - "C-c C-d" #'string-edit-abort) + "C-c C-k" #'string-edit-abort) (define-derived-mode string-edit-mode text-mode "String" "Mode for editing strings." commit 07f8fafe6ba095bb5a811d947ad2772dad058d4f Author: Lars Ingebrigtsen Date: Sun Apr 24 16:03:12 2022 +0200 Further help-fns--editable-variable fixes * lisp/help-fns.el (help-fns--editable-variable): Don't bug out on non-symbols. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 12a4ecf2f3..23cfb04798 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1303,8 +1303,9 @@ it is displayed along with the global value." (defun help-fns--editable-variable (start end variable value buffer) (when (and (readablep value) - (not (and (symbolp value) (boundp value))) - (not (and (symbolp value) (fboundp value))) + (or (not (symbolp value)) + (and (not (and (symbolp value) (boundp value))) + (not (and (symbolp value) (fboundp value))))) help-enable-variable-value-editing) (add-text-properties start end commit ae3e3900a2aaf8cfb13bacbb31290726b23cc35f Author: Lars Ingebrigtsen Date: Sun Apr 24 15:48:29 2022 +0200 Provide help when doing (shell-command "... &") on buffer collisions * lisp/simple.el (shell-command--same-buffer-confirm): New function (bug#13649). (shell-command): Use it to provide fuller help. diff --git a/lisp/simple.el b/lisp/simple.el index 75720d895c..1ff101cfcd 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4296,25 +4296,21 @@ impose the use of a shell (with its need to quote arguments)." (cond ((eq async-shell-command-buffer 'confirm-kill-process) ;; If will kill a process, query first. - (if (yes-or-no-p "A command is running in the default buffer. Kill it? ") - (kill-process proc) - (user-error "Shell command in progress"))) + (shell-command--same-buffer-confirm "Kill it") + (kill-process proc)) ((eq async-shell-command-buffer 'confirm-new-buffer) ;; If will create a new buffer, query first. - (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ") - (setq buffer (generate-new-buffer bname)) - (user-error "Shell command in progress"))) + (shell-command--same-buffer-confirm "Use a new buffer") + (setq buffer (generate-new-buffer bname))) ((eq async-shell-command-buffer 'new-buffer) ;; It will create a new buffer. (setq buffer (generate-new-buffer bname))) ((eq async-shell-command-buffer 'confirm-rename-buffer) ;; If will rename the buffer, query first. - (if (yes-or-no-p "A command is running in the default buffer. Rename it? ") - (progn - (with-current-buffer buffer - (rename-uniquely)) - (setq buffer (get-buffer-create bname))) - (user-error "Shell command in progress"))) + (shell-command--same-buffer-confirm "Rename it") + (with-current-buffer buffer + (rename-uniquely)) + (setq buffer (get-buffer-create bname))) ((eq async-shell-command-buffer 'rename-buffer) ;; It will rename the buffer. (with-current-buffer buffer @@ -4362,6 +4358,24 @@ impose the use of a shell (with its need to quote arguments)." (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))))) +(defun shell-command--same-buffer-confirm (action) + (let ((help-form + (format + "There's a command already running in the default buffer, +so we can't start a new one in the same one. + +Answering \"yes\" will %s. + +Answering \"no\" will exit without doing anything, and won't +start the new command. + +Also see the `async-shell-command-buffer' variable." + (downcase action)))) + (unless (yes-or-no-p + (format "A command is running in the default buffer. %s? " + action)) + (user-error "Shell command in progress")))) + (defun max-mini-window-lines (&optional frame) "Compute maximum number of lines for echo area in FRAME. As defined by `max-mini-window-height'. FRAME defaults to the commit 8ee21db4af0f1d3a11b943fa113201dd45e01784 Author: Lars Ingebrigtsen Date: Sun Apr 24 15:14:53 2022 +0200 Add new function `read-string-from-buffer'. * doc/lispref/minibuf.texi (Text from Minibuffer): Document it. * lisp/textmodes/string-edit.el: New file. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index f05f087ba7..986da6365f 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -244,6 +244,13 @@ This function works by calling the value)) @end group @end smallexample + +@findex read-string-from-buffer +If you have a long string (for instance, one that is several lines +long) that you wish to edit, using @code{read-string} may not be +ideal. In that case, popping to a new, normal buffer where the user +can edit the string may be more convenient, and you can use the +@code{read-string-from-buffer} function to do that. @end defun @defun read-regexp prompt &optional defaults history diff --git a/etc/NEWS b/etc/NEWS index 04231ff16f..81e3003e05 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1469,6 +1469,17 @@ functions. * Lisp Changes in Emacs 29.1 +--- +** New function 'string-edit'. +This is meant to be used when the user has to edit a (potentially) +long string. It pops you to a new buffer where you can edit the +string, and a callback is called when the user types 'C-c C-c'. + ++++ +** New function 'read-string-from-buffer'. +This is a modal version of 'string-edit', and can be used as an +alternative to 'read-string'. + +++ ** The return value of 'clear-message-function' is not ignored anymore. If the function returns 'dont-clear-message', then the message is not diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el new file mode 100644 index 0000000000..9f28fe773f --- /dev/null +++ b/lisp/textmodes/string-edit.el @@ -0,0 +1,122 @@ +;;; string-edit.el --- editing long strings -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) + +(defface string-edit-help-text + '((t (:inherit font-lock-comment-face))) + "Face used on `string-edit' help text." + :group 'text + :version "29.1") + +(defvar string-edit--success-callback) +(defvar string-edit--abort-callback) + +(cl-defun string-edit (string success-callback + &key abort-callback help-text) + "Switch to a new buffer to edit STRING. +When the user finishes editing (with `C-c C-c'), SUCCESS-CALLBACK +is called with the resulting string. + +If the user aborts (with `C-c C-d'), ABORT-CALLBACK (if any) is +called with no parameters. + +If present, HELP-TEXT will be inserted at the start of the +buffer, but won't be included in the resulting string." + (pop-to-buffer-same-window (generate-new-buffer "*edit string*")) + (when help-text + (let ((inhibit-read-only t)) + (insert help-text) + (ensure-empty-lines 0) + (add-text-properties (point-min) (point) + (list 'intangible t + 'face 'string-edit-help-text + 'read-only t)) + (insert (propertize (make-separator-line) 'rear-nonsticky t)) + (add-text-properties (point-min) (point) + (list 'string-edit--help-text t)))) + (let ((start (point))) + (insert string) + (goto-char start)) + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + (string-edit-mode) + (setq-local string-edit--success-callback success-callback) + (when abort-callback + (setq-local string-edit--abort-callback abort-callback)) + (message "%S" (substitute-command-keys + "Type `C-c C-c' when you've finished editing"))) + +(defun read-string-from-buffer (string &optional help-text) + "Switch to a new buffer to edit STRING in a recursive edit. +The user finishes editing with `C-c C-c', or aborts with `C-c C-d'). + +If present, HELP-TEXT will be inserted at the start of the +buffer, but won't be included in the resulting string." + (string-edit + string + (lambda (edited) + (setq string edited) + (exit-recursive-edit)) + :help-text help-text + :abort-callback (lambda () + (exit-recursive-edit) + (error "Aborted edit"))) + (recursive-edit) + string) + +(defvar-keymap string-edit-mode-map + "C-c C-c" #'string-edit-done + "C-c C-d" #'string-edit-abort) + +(define-derived-mode string-edit-mode text-mode "String" + "Mode for editing strings." + :interactive nil) + +(defun string-edit-done () + "Finish editing the string and call the callback function. +This will kill the current buffer." + (interactive) + (goto-char (point-min)) + ;; Skip past the help text. + (when-let ((match (text-property-search-forward + 'string-edit--help-text nil t))) + (goto-char (prop-match-beginning match))) + (let ((string (buffer-substring (point) (point-max))) + (callback string-edit--success-callback)) + (kill-buffer (current-buffer)) + (funcall callback string))) + +(defun string-edit-abort () + "Abort editing the current string." + (interactive) + (let ((callback string-edit--abort-callback)) + (kill-buffer (current-buffer)) + (when callback + (funcall callback)))) + +(provide 'string-edit) + +;;; string-edit.el ends here commit 98ec8c3bc884613782021944eaf080196521147e Author: Eli Zaretskii Date: Sun Apr 24 15:48:50 2022 +0300 ; * etc/NEWS: Fix last change. diff --git a/etc/NEWS b/etc/NEWS index 73df079ce5..04231ff16f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -420,8 +420,8 @@ command also works for non-Emoji characters.) *** The 'C-h .' command now accepts a prefix argument. 'C-u C-h .' would previously inhibit displaying a warning message if there's no local help at point. This has been changed to call -call 'button-describe'/'widget-describe' and display button/widget -help instead. +'button-describe'/'widget-describe' and display button/widget help +instead. --- *** New user option 'help-enable-variable-value-editing'. commit f3434fe2f3f1ae6abebb64f6198569e43ba0ee73 Author: Eli Zaretskii Date: Sun Apr 24 15:47:08 2022 +0300 ; Fix last change 'display-local-help' and its documentation * etc/NEWS: * doc/emacs/help.texi (Help Summary): Fix typo and wording of documentation of 'C-u C-h .'. * lisp/help-at-pt.el (display-local-help): Avoid byte-compiler warnings. Fix wording of doc string. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index ee3d898019..a4b329d089 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -182,9 +182,10 @@ programming language you are editing (@code{info-lookup-symbol}). @item C-h . Display the help message for a special text area, if point is in one (@code{display-local-help}). (These include, for example, links in -@file{*Help*} buffers.) @xref{Help Echo}. If you use a prefix for -this command, and point as on a button or a widget, this command will -pop to a new buffer that describes the button/widget. +@file{*Help*} buffers.) @xref{Help Echo}. If you invoke +this command with a prefix argument, @kbd{C-u C-h .}, and point is on +a button or a widget, this command will pop a new buffer that +describes that button/widget. @end table @node Key Help diff --git a/etc/NEWS b/etc/NEWS index 48ff8c3708..73df079ce5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -417,10 +417,11 @@ command also works for non-Emoji characters.) ** Help +++ -*** The 'C-h .' command now takes a prefix to display button/widget help. +*** The 'C-h .' command now accepts a prefix argument. 'C-u C-h .' would previously inhibit displaying a warning message if -there's no local help at point. This has been changed to trigger a -call 'button-describe'/'widget-describe' instead. +there's no local help at point. This has been changed to call +call 'button-describe'/'widget-describe' and display button/widget +help instead. --- *** New user option 'help-enable-variable-value-editing'. diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index 5bdaa35c0b..1a6d374db0 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -81,6 +81,9 @@ If this produces no string either, return nil." (echo (help-at-pt-string))) (if (and kbd (not (eq kbd t))) kbd echo))) +(declare-function widget-describe "wid-edit" (&optional widget-or-pos)) +(declare-function widget-at "wid-edit" (&optional pos)) + ;;;###autoload (defun display-local-help (&optional inhibit-warning describe-button) "Display local help in the echo area. @@ -95,8 +98,8 @@ is displayed. If INHIBIT-WARNING is non-nil, this prevents display of a message in case there is no help. -If DESCRIBE-BUTTON in non-nil (interactively, the prefix), and -there's a button/widget at point, pop to a buffer describing that +If DESCRIBE-BUTTON in non-nil (interactively, the prefix arg), and +there's a button/widget at point, pop a buffer describing that button/widget instead." (interactive (list nil current-prefix-arg)) (let ((help (help-at-pt-kbd-string))) commit 4d5fd0174905863bea4110865a0c124f8999e273 Author: Lars Ingebrigtsen Date: Sun Apr 24 13:53:17 2022 +0200 Allow 'C-u C-h .' to describe button/widgets * doc/emacs/help.texi (Help Summary): Document it. * lisp/help-at-pt.el (display-local-help): Display button/widget help (bug#54963). diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 1f743ccd88..ee3d898019 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -182,7 +182,9 @@ programming language you are editing (@code{info-lookup-symbol}). @item C-h . Display the help message for a special text area, if point is in one (@code{display-local-help}). (These include, for example, links in -@file{*Help*} buffers.) @xref{Help Echo}. +@file{*Help*} buffers.) @xref{Help Echo}. If you use a prefix for +this command, and point as on a button or a widget, this command will +pop to a new buffer that describes the button/widget. @end table @node Key Help diff --git a/etc/NEWS b/etc/NEWS index 4dd56e005e..48ff8c3708 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -416,6 +416,12 @@ command also works for non-Emoji characters.) ** Help ++++ +*** The 'C-h .' command now takes a prefix to display button/widget help. +'C-u C-h .' would previously inhibit displaying a warning message if +there's no local help at point. This has been changed to trigger a +call 'button-describe'/'widget-describe' instead. + --- *** New user option 'help-enable-variable-value-editing'. If enabled, 'e' on a value in *Help* will pop you to a new buffer diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index c5a9a93482..5bdaa35c0b 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -82,24 +82,33 @@ If this produces no string either, return nil." (if (and kbd (not (eq kbd t))) kbd echo))) ;;;###autoload -(defun display-local-help (&optional arg) +(defun display-local-help (&optional inhibit-warning describe-button) "Display local help in the echo area. -This displays a short help message, namely the string produced by -the `kbd-help' property at point. If `kbd-help' does not produce -a string, but the `help-echo' property does, then that string is -printed instead. +This command, by default, displays a short help message, namely +the string produced by the `kbd-help' property at point. If +`kbd-help' does not produce a string, but the `help-echo' +property does, then that string is printed instead. The string is passed through `substitute-command-keys' before it is displayed. -A numeric argument ARG prevents display of a message in case -there is no help. While ARG can be used interactively, it is -mainly meant for use from Lisp." - (interactive "P") +If INHIBIT-WARNING is non-nil, this prevents display of a message +in case there is no help. + +If DESCRIBE-BUTTON in non-nil (interactively, the prefix), and +there's a button/widget at point, pop to a buffer describing that +button/widget instead." + (interactive (list nil current-prefix-arg)) (let ((help (help-at-pt-kbd-string))) - (if help - (message "%s" (substitute-command-keys help)) - (if (not arg) (message "No local help at point"))))) + (cond + ((and describe-button (button-at (point))) + (button-describe)) + ((and describe-button (widget-at (point))) + (widget-describe)) + (help + (message "%s" (substitute-command-keys help))) + ((not inhibit-warning) + (message "No local help at point"))))) (defvar help-at-pt-timer nil "Non-nil means that a timer is set that checks for local help. commit e632c7bd80c728af76873e1358e6f2bfb4ff7c54 Author: Lars Ingebrigtsen Date: Sun Apr 24 13:39:36 2022 +0200 Ensure that the global sql-buffer variable is set * lisp/progmodes/sql.el (sql-product-interactive): Set the expected global value of sql-buffer (bug#55088). diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 18b0274fbf..5e5f5e13fe 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4644,6 +4644,9 @@ the call to \\[sql-product-interactive] with (setq sql-buffer (buffer-name new-sqli-buffer)) (run-hooks 'sql-set-sqli-hook))) + ;; Also set the global value. + (setq-default sql-buffer (buffer-name new-sqli-buffer)) + ;; Make sure the connection is complete ;; (Sometimes start up can be slow) ;; and call the login hook