commit f103e89c1d2c4610f2f6812bdbef65c308d143d9 (HEAD, refs/remotes/origin/master) Author: Andrew G Cohen Date: Mon Sep 7 08:58:42 2020 +0800 Add aliases for recent Gnus nnselect changes * lisp/org/ol-gnus.el (org-gnus-store-link): Change 'nnir to 'nnselect. * lisp/gnus/gnus-group.el: Define obsolete function alias for 'gnus-group-make-nnir-group to 'gnus-group-read-ephemeral-search-group. * lisp/gnus/gnus-sum.el: Define obsolete variable alias for 'gnus-refer-thread-use-nnir to 'gnus-refer-thread-use-search. * lisp/gnus/nnselect.el: Define obsolete variable alias for 'nnir-retrieve-headers-override-function to 'nnselect-retrieve-headers-override-function. * lisp/gnus/nnir.el: Restore definition of 'nnir-summary-line-format and mark obsolete. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index a90243b8b6..fcaa6d7859 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3185,6 +3185,9 @@ mail messages or news articles in files that have numeric names." (cons 'nnselect-args (nnir-make-specs nnir-extra-parms specs))))))))) +(define-obsolete-function-alias 'gnus-group-make-nnir-group + 'gnus-group-read-ephemeral-search-group "28.1") + (defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs) "Create an nnselect group based on a search. Prompt for a search query and determine the groups to search as diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index dc4f1c6a38..80427434bd 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -144,11 +144,14 @@ If t, fetch all the available old headers." :type '(choice number (sexp :menu-tag "other" t))) +(define-obsolete-variable-alias 'gnus-refer-thread-use-nnir + 'gnus-refer-thread-use-search "28.1") + (defcustom gnus-refer-thread-use-search nil "Search an entire server when referring threads. A nil value will only search for thread-related articles in the current group." - :version "24.1" + :version "28.1" :group 'gnus-thread :type 'boolean) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 6ba0334ceb..c46903a458 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -211,6 +211,26 @@ By default this is the name of an email header field.") "Search groups in Gnus with assorted search engines." :group 'gnus) +(make-obsolete-variable 'nnir-summary-line-format "The formating +specs previously unique to this variable may now be set in +'gnus-summary-line-format." "28.1") + +(defcustom nnir-summary-line-format nil + "The format specification of the lines in an nnir summary buffer. + +All the items from `gnus-summary-line-format' are available, along +with three items unique to nnir summary buffers: + +%Z Search retrieval score value (integer) +%G Article original full group name (string) +%g Article original short group name (string) + +If nil this will use `gnus-summary-line-format'." + :version "24.1" + :type '(choice (const :tag "gnus-summary-line-format" nil) string) + :group 'nnir) + + (defcustom nnir-ignored-newsgroups "" "Newsgroups to skip when searching. Any newsgroup in the active file matching this regexp will be diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 1965a2614f..4916286e37 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -238,6 +238,9 @@ as `(keyfunc member)' and the corresponding element is just "Virtual groups in Gnus with arbitrary selection methods." :group 'gnus) +(define-obsolete-variable-alias 'nnir-retrieve-headers-override-function + 'nnselect-retrieve-headers-override-function "28.1") + (defcustom nnselect-retrieve-headers-override-function nil "A function that retrieves article headers for ARTICLES from GROUP. The retrieved headers should populate the `nntp-server-buffer'. @@ -245,8 +248,7 @@ Returns either the retrieved header format 'nov or 'headers. If this variable is nil, or if the provided function returns nil, `gnus-retrieve-headers' will be called instead." - :version "24.1" :type '(function) :group 'nnselect) - + :version "28.1" :type '(function) :group 'nnselect) ;; Gnus backend interface functions. diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el index 99472315f6..71d55cd7c8 100644 --- a/lisp/org/ol-gnus.el +++ b/lisp/org/ol-gnus.el @@ -34,7 +34,7 @@ (require 'gnus-sum) (require 'gnus-util) (require 'nnheader) -(require 'nnir) +(require 'nnselect) (require 'ol) @@ -140,9 +140,9 @@ If `org-store-link' was called with a prefix arg the meaning of (`(nnvirtual . ,_) (save-excursion (car (nnvirtual-map-article (gnus-summary-article-number))))) - (`(nnir . ,_) + (`(nnselect . ,_) (save-excursion - (nnir-article-group (gnus-summary-article-number)))) + (nnselect-article-group (gnus-summary-article-number)))) (_ gnus-newsgroup-name))) (header (if (eq major-mode 'gnus-article-mode) ;; When in an article, first move to summary commit d39ae6f5860ecf6ebbeedc08bf3aafa5befaf510 Author: Lars Ingebrigtsen Date: Mon Sep 7 02:26:02 2020 +0200 Use variable-pitch fonts in the eww headers * lisp/net/eww.el (eww--limit-string-pixelwise) (eww--pixel-column): New functions. (eww-update-header-line-format): Use variable pitch fonts in the header line. diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index c95449762e..24fced15a9 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -181,6 +181,7 @@ different input formats." (gnus-message 9 "Length %d; trying quant %d" (length attempt) quant)) (setq done t))) + (setq a attempt) (if done (mm-with-unibyte-buffer (insert attempt) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index da71d46923..07aa48aeae 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -667,41 +667,73 @@ Currently this means either text/html or application/xhtml+xml." eww-image-link-keymap eww-link-keymap)))) +(defun eww--limit-string-pixelwise (string pixels) + (if (not pixels) + string + (with-temp-buffer + (insert string) + (if (< (eww--pixel-column) pixels) + string + ;; Iterate to find appropriate length. + (while (and (> (eww--pixel-column) pixels) + (not (bobp))) + (forward-char -1)) + ;; Return at least one character. + (buffer-substring (point-min) (max (point) + (1+ (point-min)))))))) + +(defun eww--pixel-column () + (if (not (get-buffer-window (current-buffer))) + (save-window-excursion + ;; Avoid errors if the selected window is a dedicated one, + ;; and they just want to insert a document into it. + (set-window-dedicated-p nil nil) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size nil (line-beginning-position) (point)))) + (car (window-text-pixel-size nil (line-beginning-position) (point))))) + (defun eww-update-header-line-format () (setq header-line-format (and eww-header-line-format - (let ((title (plist-get eww-data :title)) + (let ((title (propertize (plist-get eww-data :title) + 'face 'variable-pitch)) (peer (plist-get eww-data :peer)) - (url (plist-get eww-data :url))) + (url (propertize (plist-get eww-data :url) + 'face 'variable-pitch))) (when (zerop (length title)) - (setq title "[untitled]")) + (setq title (propertize "[untitled]" 'face 'variable-pitch))) + ;; This connection has is https. + (when peer + (add-face-text-property 0 (length title) + (if (plist-get peer :warnings) + 'eww-invalid-certificate + 'eww-valid-certificate) + t title)) ;; Limit the length of the title so that the host name ;; of the URL is always visible. (when url (let* ((parsed (url-generic-parse-url url)) - (host-length (length (format "%s://%s" - (url-type parsed) - (url-host parsed)))) - (width (window-width))) + (host-length (shr-string-pixel-width + (format "%s://%s" (url-type parsed) + (url-host parsed)))) + (width (window-width nil t))) (cond ;; The host bit is wider than the window, so nix ;; the title. - ((> (+ host-length 5) width) + ((> (+ host-length (shr-string-pixel-width "xxxxx")) width) (setq title "")) ;; Trim the title. - ((> (+ (length title) host-length 2) width) - (setq title (concat - (substring title 0 (- width - host-length - 5)) - "...")))))) - ;; This connection has is https. - (when peer - (setq title - (propertize title 'face - (if (plist-get peer :warnings) - 'eww-invalid-certificate - 'eww-valid-certificate)))) + ((> (+ (shr-string-pixel-width (concat title "xx")) + host-length) + width) + (setq title + (concat + (eww--limit-string-pixelwise + title (- width host-length + (shr-string-pixel-width + (propertize "...: " 'face + 'variable-pitch)))) + (propertize "..." 'face 'variable-pitch))))))) (replace-regexp-in-string "%" "%%" (format-spec commit 670c41cf1270ca4e91c11a9f75af742b23a87260 Author: Lars Ingebrigtsen Date: Mon Sep 7 00:45:04 2020 +0200 Add edebug form to subr--with-wrapper-hook-no-warnings * lisp/subr.el (subr--with-wrapper-hook-no-warnings): Add a debug form to allow edebugging some stuff. diff --git a/lisp/subr.el b/lisp/subr.el index 08ff38ff8c..b1537fd27a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1823,6 +1823,7 @@ FUN is then called once." (defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body) "Like (with-wrapper-hook HOOK ARGS BODY), but without warnings." + (declare (debug (form sexp body))) ;; We need those two gensyms because CL's lexical scoping is not available ;; for function arguments :-( (let ((funs (make-symbol "funs")) commit a3ca5318760b350309e50adf38fabc259c48ba06 Author: Stefan Kangas Date: Mon Sep 7 02:02:21 2020 +0200 ; Fix typos diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index cb06dd4cce..dd8ae39c7e 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -1,4 +1,4 @@ -;;; package-test.el --- Tests for the Emacs package system -*- lexical-binding:t -*- +;;; package-tests.el --- Tests for the Emacs package system -*- lexical-binding:t -*- ;; Copyright (C) 2013-2020 Free Software Foundation, Inc. @@ -805,4 +805,4 @@ Must called from within a `tar-mode' buffer." (provide 'package-test) -;;; package-test.el ends here +;;; package-tests.el ends here commit 7d567981c8bef27e9b8482f2aeb0932d31c6f973 Author: Reuben Thomas Date: Fri Sep 4 01:58:04 2020 +0100 Add enchant-2 to list of default spelling checker programs * lisp/textmodes/ispell.el (ispell-program-name): Check `enchant-2', as it is likely to be a suitable version. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 86452ff1e8..11f90f41a8 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -198,14 +198,13 @@ Must be greater than 1." :type 'integer :group 'ispell) -;; XXX Add enchant to this list once enchant >= 2.1.0 is widespread. -;; Before that, adding it is useless, as if it is found, it will just -;; cause an error; and one of the other spelling engines below is -;; almost certainly installed in any case, for enchant to use. (defcustom ispell-program-name (or (executable-find "aspell") (executable-find "ispell") (executable-find "hunspell") + ;; Enchant is commonly installed as `enchant-2', so use this + ;; name and avoid old versions of `enchant'. + (executable-find "enchant-2") "ispell") "Program invoked by \\[ispell-word] and \\[ispell-region] commands." :type 'string @@ -330,7 +329,7 @@ The function must take one string argument and return a string." :group 'ispell) ;; FIXME framepop.el last updated c 2003 (?), -;; probably something else replaces it these days. +;; use posframe. (defcustom ispell-use-framepop-p nil "When non-nil ispell uses framepop to display choices in a dedicated frame. You can set this variable to dynamically use framepop if you are in a commit ca9c02af1944975679a46b3f2c35fec20a9479a8 Author: Philip K Date: Mon Sep 7 00:17:15 2020 +0200 Allow CSS completion with multiple rules on one line * css-mode.el (css--complete-property-value): Check for semi-colon when completing property values (bug#43242). diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 8c824461d2..03edd4703e 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1356,21 +1356,17 @@ the string PROPERTY." (defun css--complete-property-value () "Complete property value at point." - (let ((property - (save-excursion - (re-search-backward ":[^/]" (line-beginning-position) t) - (when (eq (char-after) ?:) - (let ((property-end (point))) - (skip-chars-backward "-[:alnum:]") - (let ((prop (buffer-substring (point) property-end))) - (car (member prop css-property-ids)))))))) + (let ((property (and (looking-back "\\([[:alnum:]-]+\\):[^/][^;]*" + (line-beginning-position) t) + (member (match-string-no-properties 1) + css-property-ids)))) (when property (let ((end (point))) (save-excursion (skip-chars-backward "[:graph:]") (list (point) end (append '("inherit" "initial" "unset") - (css--property-values property)))))))) + (css--property-values (car property))))))))) (defvar css--html-tags (mapcar #'car html-tag-alist) "List of HTML tags. commit 816975f4bbf906c838753e7e43f74b5a190376b6 Author: Lars Ingebrigtsen Date: Sun Sep 6 23:44:09 2020 +0200 Use format-prompt in some read-string calls * lisp/progmodes/prolog.el (prolog-help-on-predicate): * lisp/cmuscheme.el (scheme-trace-procedure): * lisp/calendar/todo-mode.el (todo-convert-legacy-files): Use format-prompt in some read-string calls (that have default values). * lisp/printing.el (pr-interactive-regexp): No need to use "" as the default value, because that's the default default value. (pr-interactive-n-up): Use read-number instead of read-string and then parsing the string. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 0da87a7e88..3975a9ba6a 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -4726,9 +4726,8 @@ name in `todo-directory'. See also the documentation string of (todo-convert-legacy-date-time))) (forward-line)) (setq file (concat todo-directory - (read-string - (format "Save file as (default \"%s\"): " default) - nil nil default) + (read-string (format-prompt "Save file as" default) + nil nil default) ".todo")) (unless (file-exists-p todo-directory) (make-directory todo-directory)) diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index d4bec95eba..7191b933e4 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -327,9 +327,8 @@ With a prefix argument switch off tracing of procedure PROC." (interactive (list (let ((current (symbol-at-point)) (action (if current-prefix-arg "Untrace" "Trace"))) - (if current - (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current)) - (read-string (format "%s procedure: " action)))) + (read-string (format-prompt "%s procedure" current action) + nil nil (and current (symbol-name current)))) current-prefix-arg)) (when (= (length proc) 0) (error "Invalid procedure name")) diff --git a/lisp/printing.el b/lisp/printing.el index b8879befae..86a2434c0d 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -5284,22 +5284,18 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-interactive-n-up (mess) - (or (stringp mess) (setq mess "*")) - (save-match-data - (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ") - (prompt "") - (str (read-string (format fmt-prompt prompt mess) nil nil "1")) - int) - (while (if (string-match "^\\s *[0-9]+$" str) - (setq int (string-to-number str) - prompt (cond ((< int 1) "Integer below 1; ") - ((> int 100) "Integer above 100; ") - (t nil))) - (setq prompt "Invalid integer syntax; ")) - (ding) - (setq str - (read-string (format fmt-prompt prompt mess) str nil "1"))) - int))) + (unless (stringp mess) + (setq mess "*")) + (let (int) + (while (or (< (setq int (read-number (format "[%s] N-up printing:" mess) 1)) + 0) + (> int 100)) + (if (< int 0) + (message "Integer below 1") + (message "Integer above 100")) + (sit-for 1) + (ding)) + int)) (defun pr-interactive-dir (mess) @@ -5323,7 +5319,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-interactive-regexp (mess) - (read-string (format "[%s] File regexp to print: " mess) nil nil "")) + (read-string (format "[%s] File regexp to print: " mess))) (defun pr-interactive-dir-args (mess) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index a209d21807..fa281ddf4e 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -2369,12 +2369,8 @@ In effect it sets the `fill-prefix' when inside comments and then calls ;; in prolog-help-function-i (t (let* ((word (prolog-atom-under-point)) - (predicate (read-string - (format "Help on predicate%s: " - (if word - (concat " (default " word ")") - "")) - nil nil word)) + (predicate (read-string (format-prompt "Help on predicate" word) + nil nil word)) ;;point ) (if prolog-help-function-i commit 1b390c3cbf996d7d77e3c2d823ca891b8c0f09c6 Author: dickmao Date: Sun Sep 6 23:19:34 2020 +0200 Make list-processes--refresh work for pipe processes, too * lisp/simple.el (list-processes--refresh): Don't bug out in the presence of a `pipe' process (bug#43202). diff --git a/lisp/simple.el b/lisp/simple.el index bc92ecf8e5..86db34a5c5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4372,7 +4372,7 @@ Also, delete any process that is exited or signaled." ((thread-name (process-thread p))) (t "--"))) (cmd - (if (memq type '(network serial)) + (if (memq type '(network serial pipe)) (let ((contact (process-contact p t t))) (if (eq type 'network) (format "(%s %s)" commit 1921d2176bb9127d2483a1c8a470abfc3f4eec33 Author: Lars Ingebrigtsen Date: Sun Sep 6 23:11:17 2020 +0200 Use format-prompt in calls to read-from-minibuffer with default value * lisp/tab-bar.el (tab-bar-rename-tab) (tab-bar-rename-tab-by-name): * lisp/simple.el (next-matching-history-element): Use format-prompt in calls to read-from-minibuffer with at default value. diff --git a/lisp/simple.el b/lisp/simple.el index 376585d8e8..bc92ecf8e5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2200,12 +2200,12 @@ Normally, history elements are matched case-insensitively if makes the search case-sensitive." (interactive (let* ((enable-recursive-minibuffers t) - (regexp (read-from-minibuffer "Next element matching (regexp): " - nil - minibuffer-local-map - nil - 'minibuffer-history-search-history - (car minibuffer-history-search-history)))) + (regexp (read-from-minibuffer + (format-prompt "Next element matching (regexp)" + (car minibuffer-history-search-history)) + nil minibuffer-local-map nil + 'minibuffer-history-search-history + (car minibuffer-history-search-history)))) ;; Use the last regexp specified, by default, if input is empty. (list (if (string= regexp "") (if minibuffer-history-search-history diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index d8f932e7a4..56c936e773 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1028,7 +1028,7 @@ function `tab-bar-tab-name-function'." (tab-index (or current-prefix-arg (1+ (tab-bar--current-tab-index tabs)))) (tab-name (alist-get 'name (nth (1- tab-index) tabs)))) (list (read-from-minibuffer - "New name for tab (leave blank for automatic naming): " + (format-prompt "New name for tab" tab-name) nil nil nil nil tab-name) current-prefix-arg))) (let* ((tabs (funcall tab-bar-tabs-function)) @@ -1057,7 +1057,7 @@ function `tab-bar-tab-name-function'." (alist-get 'name tab)) (funcall tab-bar-tabs-function))))) (list tab-name (read-from-minibuffer - "New name for tab (leave blank for automatic naming): " + (format-prompt "New name for tab" tab-name) nil nil nil nil tab-name)))) (tab-bar-rename-tab new-name (1+ (tab-bar--tab-index-by-name tab-name)))) commit 95268cdb7e63c2ef881d74039284bbb88e132d84 Author: Lars Ingebrigtsen Date: Sun Sep 6 22:59:48 2020 +0200 Use format-prompt in read-string calls (that have default values) * lisp/vc/vc-annotate.el (vc-annotate): * lisp/vc/log-edit.el (log-edit-comment-search-backward) (log-edit-comment-search-forward): * lisp/textmodes/rst.el (rst-insert-list-new-item): * lisp/server.el (server-force-delete): * lisp/mpc.el (mpc): * lisp/frame.el (set-frame-name): * lisp/emulation/cua-rect.el (cua-sequence-rectangle): * lisp/cedet/semantic/symref/list.el (semantic-symref-regexp): * lisp/calendar/todo-mode.el (todo-read-time): Use `format-prompt' in `read-string' calls that have defaults. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 02a7316f26..0da87a7e88 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -6110,11 +6110,12 @@ Valid time strings are those matching `diary-time-regexp'. Typing `' at the prompt returns the current time, if the user option `todo-always-add-time-string' is non-nil, otherwise the empty string (i.e., no time string)." - (let (valid answer) + (let ((default (when todo-always-add-time-string + (format-time-string "%H:%M"))) + valid answer) (while (not valid) - (setq answer (read-string "Enter a clock time: " nil nil - (when todo-always-add-time-string - (format-time-string "%H:%M")))) + (setq answer (read-string (format-prompt "Enter a clock time" default) + nil nil default)) (when (or (string= "" answer) (string-match diary-time-regexp answer)) (setq valid t))) diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 23f5f89274..fc7f9dbcb6 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -85,10 +85,12 @@ current project to find references to the input SYM. The references are the organized by file and the name of the function they are used in. Display the references in `semantic-symref-results-mode'." - (interactive (list (let ((tag (semantic-current-tag))) - (read-string " Symrefs for: " nil nil - (when tag - (regexp-quote (semantic-tag-name tag))))))) + (interactive (list (let* ((tag (semantic-current-tag)) + (default (when tag + (regexp-quote + (semantic-tag-name tag))))) + (read-string (format-prompt " Symrefs for" default) + nil nil default)))) ;; FIXME: Shouldn't the input be in Emacs regexp format, for ;; consistency? Converting it to extended is not hard. (semantic-fetch-tags) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 663995a0a1..d2c6dd06b6 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -1150,9 +1150,9 @@ The numbers are formatted according to the FORMAT string." (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (string-to-number - (read-string "Start value: (0) " nil nil "0"))) + (read-string (format-prompt "Start value" 0) nil nil "0"))) (string-to-number - (read-string "Increment: (1) " nil nil "1")) + (read-string (format-prompt "Increment" 1) nil nil "1")) (read-string (concat "Format: (" cua--rectangle-seq-format ") ")))) (if (= (length format) 0) (setq format cua--rectangle-seq-format) diff --git a/lisp/frame.el b/lisp/frame.el index 05da1ea7b8..7751ae1303 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1581,8 +1581,9 @@ When called interactively, prompt for the name of the frame. On text terminals, the frame name is displayed on the mode line. On graphical displays, it is displayed on the frame's title bar." (interactive - (list (read-string "Frame name: " nil nil - (cdr (assq 'name (frame-parameters)))))) + (let ((default (cdr (assq 'name (frame-parameters))))) + (list (read-string (format-prompt "Frame name" default) nil nil + default)))) (modify-frame-parameters (selected-frame) (list (cons 'name name)))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 47fe4dea7f..d22b7ab450 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -2750,7 +2750,9 @@ If stopped, start playback." (if current-prefix-arg ;; FIXME: We should provide some completion here, especially for the ;; case where the user specifies a local socket/file name. - (setq mpc-host (read-string "MPD host and port: " nil nil mpc-host))) + (setq mpc-host (read-string + (format-prompt "MPD host and port" mpc-host) + nil nil mpc-host))) nil)) (let* ((song-buf (mpc-songs-buf)) (song-win (get-buffer-window song-buf 0))) diff --git a/lisp/server.el b/lisp/server.el index 9934e1c1be..436a6ca0c7 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -728,7 +728,8 @@ If server is running, it is first stopped. NAME defaults to `server-name'. With argument, ask for NAME." (interactive (list (if current-prefix-arg - (read-string "Server name: " nil nil server-name)))) + (read-string (format-prompt "Server name" server-name) + nil nil server-name)))) (when server-mode (with-temp-message nil (server-mode -1))) (let ((file (expand-file-name (or name server-name) (if server-use-tcp diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index db17a90a71..f2fcd62c87 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2371,21 +2371,23 @@ also arranged by `rst-insert-list-new-tag'." (save-match-data (cond ((equal cnt "a") - (let ((itemno (read-string "Give starting value [a]: " - nil nil "a"))) + (let ((itemno (read-string + (format-prompt "Give starting value" "a") + nil nil "a"))) (downcase (substring itemno 0 1)))) ((equal cnt "A") - (let ((itemno (read-string "Give starting value [A]: " - nil nil "A"))) + (let ((itemno (read-string + (format-prompt "Give starting value" "A") + nil nil "A"))) (upcase (substring itemno 0 1)))) ((equal cnt "I") - (let ((itemno (read-number "Give starting value [1]: " 1))) + (let ((itemno (read-number "Give starting value: " 1))) (rst-arabic-to-roman itemno))) ((equal cnt "i") - (let ((itemno (read-number "Give starting value [1]: " 1))) + (let ((itemno (read-number "Give starting value: " 1))) (downcase (rst-arabic-to-roman itemno)))) ((equal cnt "1") - (let ((itemno (read-number "Give starting value [1]: " 1))) + (let ((itemno (read-number "Give starting value: " 1))) (number-to-string itemno))))))) (if no (setq itemstyle (replace-match no t t itemstyle))) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index cd19b4e065..1c69bdf413 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -244,7 +244,9 @@ If the optional argument STRIDE is present, that is a step-width to use when going through the comment ring." ;; Why substring rather than regexp ? -sm (interactive - (list (read-string "Comment substring: " nil nil log-edit-last-comment-match))) + (list (read-string (format-prompt "Comment substring" + log-edit-last-comment-match) + nil nil log-edit-last-comment-match))) (unless stride (setq stride 1)) (if (string= str "") (setq str log-edit-last-comment-match) @@ -261,7 +263,9 @@ when going through the comment ring." (defun log-edit-comment-search-forward (str) "Search forwards through comment history for a substring match of STR." (interactive - (list (read-string "Comment substring: " nil nil log-edit-last-comment-match))) + (list (read-string (format-prompt "Comment substring" + log-edit-last-comment-match) + nil nil log-edit-last-comment-match))) (log-edit-comment-search-backward str -1)) (defun log-edit-comment-to-change-log (&optional whoami file-name) diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 18bcc6c2f1..5198bccf84 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -408,7 +408,7 @@ should be applied to the background or to the foreground." (if (null current-prefix-arg) vc-annotate-display-mode (float (string-to-number - (read-string "Annotate span days (default 20): " + (read-string (format-prompt "Annotate span days" 20) nil nil "20"))))))) (vc-ensure-vc-buffer) (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef commit 52a92c6e7bab2861be47a4637a924b2a74b24b66 Author: Stefan Kangas Date: Sun Sep 6 17:56:26 2020 +0200 Add autoload cookie to eshell-bookmark-jump * lisp/eshell/esh-mode.el (eshell-bookmark-jump): Add autoload cookie, so we can jump to bookmarks before having used eshell. Problem noted by Stefan Monnier. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index ecdfd285f9..e0e86348bd 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -1018,6 +1018,7 @@ This function could be in the list `eshell-output-filter-functions'." (location . ,default-directory) (handler . eshell-bookmark-jump))) +;;;###autoload (defun eshell-bookmark-jump (bookmark) "Default bookmark handler for Eshell buffers." (let ((default-directory (bookmark-prop-get bookmark 'location))) commit 875c8d5082fd2a8bd1a70fe94694c7324991b506 Merge: 9ba575aeb3 660d13bd7b Author: Michael Albinus Date: Sun Sep 6 20:45:45 2020 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 9ba575aeb3a28a856f40675510c5ccfcd10ef665 Author: Michael Albinus Date: Sun Sep 6 20:45:29 2020 +0200 More work on D-Bus error messages * lisp/net/dbus.el (dbus-get-property): Adapt docstring. (dbus-set-property): Handle case of `:write' access type. (dbus-get-other-registered-properties): Rename from `dbus-get-other-registered-property'. (dbus-property-handler): Fix thinkos. * src/dbusbind.c (xd_read_message_1): Add error_name to event args in case of DBUS_MESSAGE_TYPE_ERROR. * test/lisp/net/dbus-tests.el (dbus--test-enabled-session-bus) (dbus--test-enabled-system-bus): Make them defconst. (dbus--test-service, dbus--test-path, dbus--test-interface): New defconst. Replace all occurences of `dbus-service-emacs' by `dbus--test-service'. (dbus--test-method-handler): New defun. (dbus-test04-register-method, dbus-test05-register-property): New tests. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index ad5ff8d450..ba6a66d79c 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -565,8 +565,9 @@ placed in the queue. `:already-owner': Service is already the primary owner." ;; Add Peer handler. - (dbus-register-method bus service nil dbus-interface-peer "Ping" - #'dbus-peer-handler 'dont-register) + (dbus-register-method + bus service nil dbus-interface-peer "Ping" + #'dbus-peer-handler 'dont-register) ;; Add ObjectManager handler. (dbus-register-method @@ -1423,7 +1424,7 @@ be \"out\"." (defun dbus-get-property (bus service path interface property) "Return the value of PROPERTY of INTERFACE. It will be checked at BUS, SERVICE, PATH. The result can be any -valid D-Bus value, or nil if there is no PROPERTY." +valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read." (dbus-ignore-errors ;; "Get" returns a variant, so we must use the `car'. (car @@ -1440,8 +1441,11 @@ successfully set return VALUE. Otherwise, return nil." (dbus-call-method bus service path dbus-interface-properties "Set" :timeout 500 interface property (list :variant value)) - ;; Return VALUE. - (dbus-get-property bus service path interface property))) + ;; Return VALUE. The property could have the `:write' access type, + ;; so we ignore errors in `dbus-get-property'. + (or + (dbus-ignore-errors (dbus-get-property bus service path interface property)) + value))) (defun dbus-get-all-properties (bus service path interface) "Return all properties of INTERFACE at BUS, SERVICE, PATH. @@ -1465,7 +1469,8 @@ Filter out not matching PATH." (gethash (list :property bus interface property) dbus-registered-objects-table))) -(defun dbus-get-other-registered-property (bus _service path interface property) +(defun dbus-get-other-registered-properties + (bus _service path interface property) "Return PROPERTY entry of `dbus-registered-objects-table'. Filter out matching PATH." ;; Remove matching entries. @@ -1551,7 +1556,7 @@ clients from discovering the still incomplete interface." (cons (if emits-signal (list access :emits-signal) (list access)) value)) - (dbus-get-other-registered-property + (dbus-get-other-registered-properties bus service path interface property)))) (puthash key val dbus-registered-objects-table) @@ -1578,7 +1583,7 @@ It will be registered for all objects created by `dbus-register-property'." `(:error ,dbus-error-invalid-args ,(format-message "No such property \"%s\" at path \"%s\"" property path))) - ((eq (car object) :write) + ((memq :write (car object)) `(:error ,dbus-error-access-denied ,(format-message "Property \"%s\" at path \"%s\" is not readable" property path))) @@ -1596,14 +1601,14 @@ It will be registered for all objects created by `dbus-register-property'." `(:error ,dbus-error-invalid-args ,(format-message "No such property \"%s\" at path \"%s\"" property path))) - ((eq (car object) :read) + ((memq :read (car object)) `(:error ,dbus-error-property-read-only ,(format-message "Property \"%s\" at path \"%s\" is not writable" property path))) (t (puthash (list :property bus interface property) (cons (append (butlast (car entry)) (list (cons (car object) value))) - (dbus-get-other-registered-property + (dbus-get-other-registered-properties bus service path interface property)) dbus-registered-objects-table) ;; Send the "PropertiesChanged" signal. @@ -1625,15 +1630,17 @@ It will be registered for all objects created by `dbus-register-property'." (let (result) (maphash (lambda (key val) - (dolist (item val) - (when (and (equal (butlast key) (list :property bus interface)) - (string-equal path (nth 2 item)) - (not (functionp (car (last item))))) - (push - (list :dict-entry - (car (last key)) - (list :variant (cdar (last item)))) - result)))) + (when (consp val) + (dolist (item val) + (when (and (equal (butlast key) (list :property bus interface)) + (string-equal path (nth 2 item)) + (consp (car (last item))) + (not (memq :write (caar (last item))))) + (push + (list :dict-entry + (car (last key)) + (list :variant (cdar (last item)))) + result))))) dbus-registered-objects-table) ;; Return the result, or an empty array. (list :array (or result '(:signature "{sv}")))))))) diff --git a/src/dbusbind.c b/src/dbusbind.c index 4fce92521a..b637c0e58a 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1508,7 +1508,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) int mtype; dbus_uint32_t serial; unsigned int ui_serial; - const char *uname, *path, *interface, *member; + const char *uname, *path, *interface, *member, *error_name; dmessage = dbus_connection_pop_message (connection); @@ -1544,10 +1544,11 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) path = dbus_message_get_path (dmessage); interface = dbus_message_get_interface (dmessage); member = dbus_message_get_member (dmessage); + error_name =dbus_message_get_error_name (dmessage); - XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s", + XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s", XD_MESSAGE_TYPE_TO_STRING (mtype), - ui_serial, uname, path, interface, member, + ui_serial, uname, path, interface, member, error_name, XD_OBJECT_TO_STRING (args)); if (mtype == DBUS_MESSAGE_TYPE_INVALID) @@ -1571,7 +1572,10 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) EVENT_INIT (event); event.kind = DBUS_EVENT; event.frame_or_window = Qnil; - event.arg = Fcons (value, args); + event.arg = + Fcons (value, + (mtype == DBUS_MESSAGE_TYPE_ERROR) + ? (Fcons (build_string (error_name), args)) : args); } else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */ diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 45c9851365..5e72145997 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -25,16 +25,25 @@ (defvar dbus-debug nil) (declare-function dbus-get-unique-name "dbusbind.c" (bus)) -(defvar dbus--test-enabled-session-bus +(defconst dbus--test-enabled-session-bus (and (featurep 'dbusbind) (dbus-ignore-errors (dbus-get-unique-name :session))) "Check, whether we are registered at the session bus.") -(defvar dbus--test-enabled-system-bus +(defconst dbus--test-enabled-system-bus (and (featurep 'dbusbind) (dbus-ignore-errors (dbus-get-unique-name :system))) "Check, whether we are registered at the system bus.") +(defconst dbus--test-service "org.gnu.Emacs.TestDBus" + "Test service.") + +(defconst dbus--test-path "/org/gnu/Emacs/TestDBus" + "Test object path.") + +(defconst dbus--test-interface "org.gnu.Emacs.TestDBus" + "Test interface.") + (defun dbus--test-availability (bus) "Test availability of D-Bus BUS." (should (dbus-list-names bus)) @@ -85,19 +94,19 @@ (defun dbus--test-register-service (bus) "Check service registration at BUS." ;; Cleanup. - (dbus-ignore-errors (dbus-unregister-service bus dbus-service-emacs)) + (dbus-ignore-errors (dbus-unregister-service bus dbus--test-service)) ;; Register an own service. - (should (eq (dbus-register-service bus dbus-service-emacs) :primary-owner)) - (should (member dbus-service-emacs (dbus-list-known-names bus))) - (should (eq (dbus-register-service bus dbus-service-emacs) :already-owner)) - (should (member dbus-service-emacs (dbus-list-known-names bus))) + (should (eq (dbus-register-service bus dbus--test-service) :primary-owner)) + (should (member dbus--test-service (dbus-list-known-names bus))) + (should (eq (dbus-register-service bus dbus--test-service) :already-owner)) + (should (member dbus--test-service (dbus-list-known-names bus))) ;; Unregister the service. - (should (eq (dbus-unregister-service bus dbus-service-emacs) :released)) - (should-not (member dbus-service-emacs (dbus-list-known-names bus))) - (should (eq (dbus-unregister-service bus dbus-service-emacs) :non-existent)) - (should-not (member dbus-service-emacs (dbus-list-known-names bus))) + (should (eq (dbus-unregister-service bus dbus--test-service) :released)) + (should-not (member dbus--test-service (dbus-list-known-names bus))) + (should (eq (dbus-unregister-service bus dbus--test-service) :non-existent)) + (should-not (member dbus--test-service (dbus-list-known-names bus))) ;; `dbus-service-dbus' is reserved for the BUS itself. (should-error (dbus-register-service bus dbus-service-dbus)) @@ -106,7 +115,7 @@ (ert-deftest dbus-test02-register-service-session () "Check service registration at `:session' bus." (skip-unless (and dbus--test-enabled-session-bus - (dbus-register-service :session dbus-service-emacs))) + (dbus-register-service :session dbus--test-service))) (dbus--test-register-service :session) (let ((service "org.freedesktop.Notifications")) @@ -124,7 +133,7 @@ (ert-deftest dbus-test02-register-service-system () "Check service registration at `:system' bus." (skip-unless (and dbus--test-enabled-system-bus - (dbus-register-service :system dbus-service-emacs))) + (dbus-register-service :system dbus--test-service))) (dbus--test-register-service :system)) (ert-deftest dbus-test02-register-service-own-bus () @@ -148,7 +157,7 @@ This includes initialization and closing the bus." (featurep 'dbusbind) (dbus-init-bus bus) (dbus-get-unique-name bus) - (dbus-register-service bus dbus-service-emacs)))) + (dbus-register-service bus dbus--test-service)))) ;; Run the test. (dbus--test-register-service bus)) @@ -159,19 +168,194 @@ This includes initialization and closing the bus." "Check `dbus-interface-peer' methods." (skip-unless (and dbus--test-enabled-session-bus - (dbus-register-service :session dbus-service-emacs) + (dbus-register-service :session dbus--test-service) ;; "GetMachineId" is not implemented (yet). When it returns a ;; value, another D-Bus client like dbus-monitor is reacting ;; on `dbus-interface-peer'. We cannot test then. (not (dbus-ignore-errors (dbus-call-method - :session dbus-service-emacs dbus-path-dbus + :session dbus--test-service dbus-path-dbus dbus-interface-peer "GetMachineId" :timeout 100))))) - (should (dbus-ping :session dbus-service-emacs 100)) - (dbus-unregister-service :session dbus-service-emacs) - (should-not (dbus-ping :session dbus-service-emacs 100))) + (should (dbus-ping :session dbus--test-service 100)) + (dbus-unregister-service :session dbus--test-service) + (should-not (dbus-ping :session dbus--test-service 100))) + +(defun dbus--test-method-handler (&rest args) + "Method handler for `dbus-test04-register-method'." + (cond + ;; No argument. + ((null args) + :ignore) + ;; One argument. + ((= 1 (length args)) + (car args)) + ;; Two arguments. + ((= 2 (length args)) + `(:error ,dbus-error-invalid-args + ,(format-message "Wrong arguments %s" args))) + ;; More than two arguments. + (t (signal 'dbus-error (cons "D-Bus signal" args))))) + +(ert-deftest dbus-test04-register-method () + "Check method registration for an own service." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((method "Method") + (handler #'dbus--test-method-handler)) + + (should + (equal + (dbus-register-method + :session dbus--test-service dbus--test-path + dbus--test-interface method handler) + `((:method :session ,dbus--test-interface ,method) + (,dbus--test-service ,dbus--test-path ,handler)))) + + ;; No argument, returns nil. + (should-not + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method)) + ;; One argument, returns the argument. + (should + (string-equal + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method "foo") + "foo")) + ;; Two arguments, D-Bus error activated as `(:error ...)' list. + (should + (equal + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method "foo" "bar")) + `(dbus-error ,dbus-error-invalid-args "Wrong arguments (foo bar)"))) + ;; Three arguments, D-Bus error activated by `dbus-error' signal. + (should + (equal + (should-error + (dbus-call-method + :session dbus--test-service dbus--test-path + dbus--test-interface method "foo" "bar" "baz")) + `(dbus-error + ,dbus-error-failed + "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\"")))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + +(ert-deftest dbus-test05-register-property () + "Check property registration for an own service." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((property1 "Property1") + (property2 "Property2") + (property3 "Property3")) + + ;; `:read' property. + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 :read "foo") + `((:property :session "org.gnu.Emacs.TestDBus" ,property1) + (,dbus--test-service ,dbus--test-path)))) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1) + "foo")) + (should-not ;; Due to `:read' access type. + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 "foofoo")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1) + "foo")) + + ;; `:write' property. + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2 :write "bar") + `((:property :session "org.gnu.Emacs.TestDBus" ,property2) + (,dbus--test-service ,dbus--test-path)))) + (should-not ;; Due to `:write' access type. + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2)) + (should + (string-equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2 "barbar") + "barbar")) + (should-not ;; Due to `:write' access type. + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2)) + + ;; `:readwrite' property. + (should + (equal + (dbus-register-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3 :readwrite "baz") + `((:property :session "org.gnu.Emacs.TestDBus" ,property3) + (,dbus--test-service ,dbus--test-path)))) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3) + "baz")) + (should + (string-equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3 "bazbaz") + "bazbaz")) + (should + (string-equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property3) + "bazbaz")) + + ;; `dbus-get-all-properties'. We cannot retrieve a value for + ;; the property with `:write' access type. + (let ((result + (dbus-get-all-properties + :session dbus--test-service dbus--test-path + dbus--test-interface))) + (should (string-equal (cdr (assoc property1 result)) "foo")) + (should (string-equal (cdr (assoc property3 result)) "bazbaz")) + (should-not (assoc property2 result)))) + + ;; FIXME: This is wrong! The properties are missing. + ;; (should + ;; (equal + ;; (dbus-get-all-managed-objects + ;; :session dbus--test-service dbus--test-path) + ;; `((,dbus--test-path + ;; ((,dbus-interface-peer) + ;; (,dbus-interface-objectmanager) + ;; (,dbus-interface-properties))))))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) (defun dbus-test-all (&optional interactive) "Run all tests for \\[dbus]." commit 660d13bd7b47c1b7db990adcc671b55b6f1f83f2 Author: Lars Ingebrigtsen Date: Sun Sep 6 20:35:11 2020 +0200 Use format-prompt in calls to completing-read with a default value * lisp/textmodes/rst.el (rst-insert-list-new-item): * lisp/tab-bar.el (tab-bar-switch-to-tab): * lisp/profiler.el (profiler-start): * lisp/frame.el (set-frame-font): * lisp/erc/erc.el (erc-join-channel): * lisp/emacs-lock.el (emacs-lock--set-mode): * lisp/emacs-lisp/elp.el (elp-set-master): * lisp/emacs-lisp/checkdoc.el () (checkdoc-this-string-valid-engine): * lisp/calendar/todo-mode.el (todo-find-filtered-items-file): * lisp/calendar/calendar.el (calendar-set-date-style): Use `format-prompt' in calls to completing-read that has a default value, but didn't mention that in the prompt. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 574261456f..20887af484 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -994,7 +994,7 @@ pre-existing calendar windows." "Set the style of calendar and diary dates to STYLE (a symbol). The valid styles are described in the documentation of `calendar-date-style'." (interactive (list (intern - (completing-read "Date style: " + (completing-read (format-prompt "Date style" "american") '("american" "european" "iso") nil t nil nil "american")))) (or (memq style '(american european iso)) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 0e4446f77d..02a7316f26 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -4076,7 +4076,9 @@ regexp items." ((equal (file-name-extension f) "todt") "top") ((equal (file-name-extension f) "tody") "diary")))) (push (cons (concat sf-name " (" type ")") f) falist))) - (setq file (completing-read "Choose a filtered items file: " falist nil t nil + (setq file (completing-read (format-prompt "Choose a filtered items file" + (caar falist)) + falist nil t nil 'todo--fifiles-history (caar falist))) (setq file (cdr (assoc-string file falist))) (find-file file) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 1029b52220..23121c245e 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1573,7 +1573,8 @@ mouse-[0-3]\\)\\)\\>")) ;; a prefix. (let ((disambiguate (completing-read - "Disambiguating Keyword (default variable): " + (format-prompt "Disambiguating Keyword" + "variable") '(("function") ("command") ("variable") ("option") ("symbol")) nil t nil nil "variable"))) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index f68c0faf09..a94978ac47 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -342,9 +342,9 @@ Use optional LIST if provided instead." (interactive (list (intern - (completing-read "Master function: " obarray - #'elp--instrumented-p - t nil nil (if elp-master (symbol-name elp-master)))))) + (let ((default (if elp-master (symbol-name elp-master)))) + (completing-read (format-prompt "Master function" default) + obarray #'elp--instrumented-p t nil nil default))))) ;; When there's a master function, recording is turned off by default. (setq elp-master funsym elp-record-p nil) diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 5f393a01e8..ba75a93035 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -176,11 +176,12 @@ Return a value appropriate for `kill-buffer-query-functions' (which see)." arg) ((and (eq arg current-prefix-arg) (consp current-prefix-arg)) ;; called with C-u M-x emacs-lock-mode, so ask the user - (intern (completing-read "Locking mode: " - '("all" "exit" "kill") - nil t nil nil - (symbol-name - emacs-lock-default-locking-mode)))) + (intern (completing-read + (format-prompt "Locking mode" + emacs-lock-default-locking-mode) + '("all" "exit" "kill") + nil t nil nil + (symbol-name emacs-lock-default-locking-mode)))) ((eq mode t) ;; turn on, so use previous setting, or customized default (or emacs-lock--old-mode emacs-lock-default-locking-mode)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8712113790..e7e43f8734 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4072,7 +4072,8 @@ If `point' is at the beginning of a channel name, use that as default." (table (when (erc-server-buffer-live-p) (set-buffer (process-buffer erc-server-process)) erc-channel-list))) - (completing-read "Join channel: " table nil nil nil nil chnl)) + (completing-read (format-prompt "Join channel" chnl) + table nil nil nil nil chnl)) (when (or current-prefix-arg erc-prompt-for-channel-key) (read-from-minibuffer "Channel key (RET for none): " nil)))) (erc-cmd-JOIN channel (when (>= (length key) 1) key))) diff --git a/lisp/frame.el b/lisp/frame.el index 70088545a6..05da1ea7b8 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1412,12 +1412,12 @@ as though the font-related attributes of the `default' face had been \"set in this session\", so that the font is applied to future frames." (interactive (let* ((completion-ignore-case t) - (font (completing-read "Font name: " + (default (frame-parameter nil 'font)) + (font (completing-read (format-prompt "Font name" default) ;; x-list-fonts will fail with an error ;; if this frame doesn't support fonts. (x-list-fonts "*" nil (selected-frame)) - nil nil nil nil - (frame-parameter nil 'font)))) + nil nil nil nil default))) (list font current-prefix-arg nil))) (when (or (stringp font) (fontp font)) (let* ((this-frame (selected-frame)) diff --git a/lisp/profiler.el b/lisp/profiler.el index 3243e6432f..0a5ddc1df4 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -816,7 +816,7 @@ If MODE is `cpu' or `cpu+mem', time-based profiler will be started. Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started." (interactive (list (if (not (fboundp 'profiler-cpu-start)) 'mem - (intern (completing-read "Mode (default cpu): " + (intern (completing-read (format-prompt "Mode" "cpu") '("cpu" "mem" "cpu+mem") nil t nil nil "cpu"))))) (cl-ecase mode diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index cee88cb427..d8f932e7a4 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -665,7 +665,8 @@ to get the name of the last visited tab, the second last, and so on." (let* ((recent-tabs (mapcar (lambda (tab) (alist-get 'name tab)) (tab-bar--tabs-recent)))) - (list (completing-read "Switch to tab by name (default recent): " + (list (completing-read (format-prompt "Switch to tab by name" + (car recent-tabs)) recent-tabs nil nil nil nil recent-tabs)))) (tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0)))) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 5fadec491a..db17a90a71 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2363,7 +2363,7 @@ If user selects enumerations, a further prompt is given. User need to input a starting item, for example 'e' for 'A)' style. The position is also arranged by `rst-insert-list-new-tag'." (let* ((itemstyle (completing-read - "Select preferred item style [#.]: " + (format-prompt "Select preferred item style" "#.") rst-initial-items nil t nil nil "#.")) (cnt (if (string-match (rst-re 'cntexp-tag) itemstyle) (match-string 0 itemstyle))) commit 3444f397c7d20ca59f7b18f6fe95aa79b33727e5 Author: Lars Ingebrigtsen Date: Sun Sep 6 19:04:00 2020 +0200 Use a popup menu for