From: Eshel Yaron Date: Mon, 15 Jul 2024 18:48:11 +0000 (+0200) Subject: New function 'completing-read-case-insensitive' X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e2b9d8815e60f64dc1150cac26a4d4c1c2c9fd05;p=emacs.git New function 'completing-read-case-insensitive' --- diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 0934f926d53..b5a6b641fbd 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -160,9 +160,8 @@ Reads a year, month and day." (calendar-extract-year (calendar-bahai-from-absolute (calendar-absolute-from-gregorian today))))) - (completion-ignore-case t) (month (cdr (assoc - (completing-read + (completing-read-case-insensitive "Bahá’í calendar month name: " (mapcar 'list (append calendar-bahai-month-name-array nil)) diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el index 1700d1c262b..47b56e64813 100644 --- a/lisp/calendar/cal-coptic.el +++ b/lisp/calendar/cal-coptic.el @@ -144,9 +144,8 @@ Reads a year, month, and day." (calendar-coptic-from-absolute (calendar-absolute-from-gregorian today))) calendar-coptic-name)) - (completion-ignore-case t) (month (cdr (assoc-string - (completing-read + (completing-read-case-insensitive (format "%s calendar month name: " calendar-coptic-name) (mapcar 'list (append calendar-coptic-month-name-array nil)) diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index fcc0d44c7c8..c0655ba22c9 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -353,9 +353,8 @@ Echo French Revolutionary date unless NOECHO is non-nil." (reverse (mapcar #'calendar-french-trim-feast feasts)))))))) - (completion-ignore-case t) (month (cdr (assoc-string - (completing-read + (completing-read-case-insensitive "Mois ou \"jour complémentaire\" ou fête: " month-list nil t) diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index fea8e957e46..3a67141117a 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -234,9 +234,8 @@ Reads a year, month, and day." (month-array (if (calendar-hebrew-leap-year-p year) calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year)) - (completion-ignore-case t) (month (cdr (assoc-string - (completing-read + (completing-read-case-insensitive "Hebrew calendar month name: " (mapcar 'list (append month-array nil)) (if (= year 3761) @@ -687,9 +686,8 @@ from the cursor position." (lambda (x) (> x 0)) (calendar-extract-year today))) (month-array calendar-month-name-array) - (completion-ignore-case t) (month (cdr (assoc-string - (completing-read + (completing-read-case-insensitive "Month of death (name): " (mapcar 'list (append month-array nil)) nil t) diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el index 9fb3fd631bd..36d1322a6e3 100644 --- a/lisp/calendar/cal-islam.el +++ b/lisp/calendar/cal-islam.el @@ -150,9 +150,8 @@ Reads a year, month, and day." (calendar-islamic-from-absolute (calendar-absolute-from-gregorian today))))) (month-array calendar-islamic-month-name-array) - (completion-ignore-case t) (month (cdr (assoc-string - (completing-read + (completing-read-case-insensitive "Islamic calendar month name: " (mapcar 'list (append month-array nil)) nil t) diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index 1ae4049890e..6151afb1794 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -103,9 +103,8 @@ Driven by the variable `calendar-date-display-form'." (calendar-absolute-from-gregorian today))))) (month-array calendar-month-name-array) - (completion-ignore-case t) (month (cdr (assoc-string - (completing-read + (completing-read-case-insensitive "Julian calendar month name: " (mapcar 'list (append month-array nil)) nil t) diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index e62e9d10ccf..907fddefe29 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el @@ -134,32 +134,32 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using (defun calendar-mayan-read-haab-date () "Prompt for a Mayan haab date." - (let* ((completion-ignore-case t) - (haab-day (calendar-read-sexp + (let* ((haab-day (calendar-read-sexp "Haab kin (0-19)" (lambda (x) (and (>= x 0) (< x 20))))) (haab-month-list (append calendar-mayan-haab-month-name-array (and (< haab-day 5) '("Uayeb")))) (haab-month (cdr (assoc-string - (completing-read "Haab uinal: " - (mapcar 'list haab-month-list) - nil t) + (completing-read-case-insensitive + "Haab uinal: " + (mapcar 'list haab-month-list) + nil t) (calendar-make-alist haab-month-list 1) t)))) (cons haab-day haab-month))) (defun calendar-mayan-read-tzolkin-date () "Prompt for a Mayan tzolkin date." - (let* ((completion-ignore-case t) - (tzolkin-count (calendar-read-sexp + (let* ((tzolkin-count (calendar-read-sexp "Tzolkin kin (1-13)" (lambda (x) (and (> x 0) (< x 14))))) (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) (tzolkin-name (cdr (assoc-string - (completing-read "Tzolkin uinal: " - (mapcar 'list tzolkin-name-list) - nil t) + (completing-read-case-insensitive + "Tzolkin uinal: " + (mapcar 'list tzolkin-name-list) + nil t) (calendar-make-alist tzolkin-name-list 1) t)))) (cons tzolkin-count tzolkin-name))) diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index d01881f0a13..d2f54c03229 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el @@ -165,9 +165,8 @@ Reads a year, month, and day." (calendar-persian-from-absolute (calendar-absolute-from-gregorian (calendar-current-date)))))) - (completion-ignore-case t) (month (cdr (assoc - (completing-read + (completing-read-case-insensitive "Persian calendar month name: " (mapcar 'list (append calendar-persian-month-name-array nil)) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 345687d1775..8cc35e48b5b 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2335,13 +2335,14 @@ returned is (month year)." defyear)) (month-array calendar-month-name-array) (defmon (aref month-array (1- (calendar-extract-month default-date)))) - (completion-ignore-case t) (month (cdr (assoc-string (let ((completion-extra-properties '(:category calendar-month))) - (completing-read + (completing-read-case-insensitive (format-prompt "Month name" defmon) - (append month-array nil) + (completion-table-with-metadata + (append month-array nil) + '((category . calendar-month))) nil t nil nil defmon)) (calendar-make-alist month-array 1) t))) (defday (calendar-extract-day default-date)) diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index c7499938c6a..dbdab007bd1 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -393,8 +393,7 @@ If called with an optional prefix argument ARG, prompts for month and year. This function is suitable for execution in an init file." (interactive "P") (save-excursion - (let* ((completion-ignore-case t) - (date (if arg (calendar-read-date t) + (let* ((date (if arg (calendar-read-date t) (calendar-current-date))) (displayed-month (calendar-extract-month date)) (displayed-year (calendar-extract-year date))) @@ -467,10 +466,10 @@ values." (lambda (x) (>= x start-year)) start-year start-year)) - (completion-ignore-case t) (lists (holiday-available-holiday-lists)) (choice (capitalize - (completing-read "List (TAB for choices): " lists nil t))) + (completing-read-case-insensitive + "List (TAB for choices): " lists nil t))) (which (if (string-equal choice "Ask") (symbol-value (read-variable "Enter list name: ")) (cdr (assoc choice lists)))) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 8f1c739f785..c75dd4b5914 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -6008,23 +6008,25 @@ form but the absolute truename is returned. With non-nil ARCHIVE return the absolute truename of a todo archive file. With non-nil MUSTMATCH the name of an existing file must be chosen; otherwise, a new file name is allowed." - (let* ((completion-ignore-case todo-completion-ignore-case) - (files (mapcar #'todo-short-file-name + (let* ((files (mapcar #'todo-short-file-name ;; (funcall todo-files-function archive))) (if archive todo-archives todo-files))) - (file (completing-read prompt files nil mustmatch nil nil - (if files - ;; If user hit RET without - ;; choosing a file, default to - ;; current or default file. - (todo-short-file-name - (or todo-current-todo-file - (and todo-show-current-file - todo-global-current-todo-file) - (todo-absolute-file-name - todo-default-todo-file))) - ;; Trigger prompt for initial file. - "")))) + (file (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case + todo-completion-ignore-case)) + (completing-read prompt files nil mustmatch nil nil + (if files + ;; If user hit RET without + ;; choosing a file, default to + ;; current or default file. + (todo-short-file-name + (or todo-current-todo-file + (and todo-show-current-file + todo-global-current-todo-file) + (todo-absolute-file-name + todo-default-todo-file))) + ;; Trigger prompt for initial file. + ""))))) (unless (file-exists-p todo-directory) (make-directory todo-directory)) (unless (or mustmatch (member file files)) @@ -6056,8 +6058,8 @@ categories from `todo-category-completions-files'." (archive (eq match-type 'archive)) (file0 (when (and file (> (length todo-files) 1)) (todo-read-file-name (concat "Choose a" (if archive - "n archive" - " todo") + "n archive" + " todo") " file: ") archive t))) (completions (unless file0 (todo-category-completions archive))) @@ -6073,24 +6075,27 @@ categories from `todo-category-completions-files'." todo-categories)) (t completions))) - (completion-ignore-case todo-completion-ignore-case) - (cat (completing-read prompt categories nil - (eq match-type 'todo) nil nil - ;; Unless we're adding a category via - ;; todo-add-category, set default - ;; for existing categories to the - ;; current category of the chosen - ;; file or else of the current file. - (if (and categories (not add)) - (with-current-buffer - (find-file-noselect - (or file0 - todo-current-todo-file - (todo-absolute-file-name - todo-default-todo-file))) - (todo-current-category)) - ;; Trigger prompt for initial category. - ""))) + (cat + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case + todo-completion-ignore-case)) + (completing-read prompt categories nil + (eq match-type 'todo) nil nil + ;; Unless we're adding a category via + ;; todo-add-category, set default + ;; for existing categories to the + ;; current category of the chosen + ;; file or else of the current file. + (if (and categories (not add)) + (with-current-buffer + (find-file-noselect + (or file0 + todo-current-todo-file + (todo-absolute-file-name + todo-default-todo-file))) + (todo-current-category)) + ;; Trigger prompt for initial category. + "")))) (catfil (cdr (assoc cat completions))) (str "Category \"%s\" from which file (TAB for choices)? ")) ;; If we do category completion and the chosen category name @@ -6121,7 +6126,7 @@ categories from `todo-category-completions-files'." ;; moving, confirm that it should be added, then validate. (unless add (if (todo-y-or-n-p (format "Add new category \"%s\" to file \"%s\"? " - cat (todo-short-file-name file0))) + cat (todo-short-file-name file0))) (progn (when (assoc cat categories) (let ((todo-categories categories)) @@ -6210,13 +6215,17 @@ number of the last the day of the month." (let* ((marray todo-month-name-array) (mlist (append marray nil)) (mabarray todo-month-abbrev-array) - (mablist (append mabarray nil)) - (completion-ignore-case todo-completion-ignore-case)) - (setq monthname (completing-read - "Month name (RET for current month, * for any month): " - mlist nil t nil nil - (calendar-month-name - (calendar-extract-month (calendar-current-date)) t)) + (mablist (append mabarray nil))) + (setq monthname + (minibuffer-with-setup-hook + (lambda () + (setq-local completion-ignore-case + todo-completion-ignore-case)) + (completing-read + "Month name (RET for current month, * for any month): " + mlist nil t nil nil + (calendar-month-name + (calendar-extract-month (calendar-current-date)) t))) month (1+ (- (length mlist) (length (or (member monthname mlist) (member monthname mablist)))))) @@ -6261,7 +6270,9 @@ number of the last the day of the month." (defun todo-read-dayname () "Choose name of a day of the week with completion and return it." - (let ((completion-ignore-case todo-completion-ignore-case)) + (minibuffer-with-setup-hook + (lambda () + (setq-local completion-ignore-case todo-completion-ignore-case)) (completing-read "Enter a day name: " (append calendar-day-name-array nil) nil t))) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index f8cba24fc60..f79672f44b8 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -135,7 +135,6 @@ usually more efficient than that of a simplified version: (save-match-data ;; Recurse on the sorted list. (let* ((max-lisp-eval-depth 10000) - (completion-ignore-case nil) (open (cond ((stringp paren) paren) (paren "\\("))) (re (if strings (regexp-opt-group diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index c158b443b89..ea87a2e50ae 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -775,11 +775,9 @@ In server buffers, also prompt for a channel." "Internally controlled items for `erc-nick-popup-alist'.") (defun erc-nick-popup (nick) - (let* ((completion-ignore-case t) - (alist (append erc-nick-popup-alist erc-button--nick-popup-alist)) - (action (completing-read (format-message - "What action to take on `%s'? " nick) - alist)) + (let* ((alist (append erc-nick-popup-alist erc-button--nick-popup-alist)) + (action (completing-read-case-insensitive + (format-message "What action to take on `%s'? " nick) alist)) (code (cdr (assoc action alist)))) (when code (erc-set-active-buffer (current-buffer)) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index a5ca05b137a..f74ed58171e 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1584,13 +1584,13 @@ As an example: Choose port at random if multiple candidates exist, but always prefer TLS without asking. When a port can't be determined, return the host alone sans URL formatting (for compatibility)." - (let* ((completion-ignore-case t) - (net (intern - (completing-read "Network: " - (delete-dups - (mapcar (lambda (x) - (list (nth 1 x))) - erc-server-alist))))) + (let* ((net (intern + (completing-read-case-insensitive + "Network: " + (delete-dups + (mapcar (lambda (x) + (list (nth 1 x))) + erc-server-alist))))) (s-choose (lambda (entry) (and (equal (nth 1 entry) net) (if-let ((b (string-search ": " (car entry)))) @@ -1599,7 +1599,8 @@ return the host alone sans URL formatting (for compatibility)." (cdr entry)) entry)))) (s-entries (delq nil (mapcar s-choose erc-server-alist))) - (srv (assoc (completing-read "Server: " s-entries) s-entries)) + (srv (assoc (completing-read-case-insensitive "Server: " s-entries) + s-entries)) (host (nth 2 srv)) (pspec (nthcdr 3 srv)) (ports (erc-ports-list (or (cadr pspec) (car pspec)))) diff --git a/lisp/faces.el b/lisp/faces.el index d88d9885c01..27f5a705190 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1335,8 +1335,7 @@ Value is the new attribute value." ;; Capitalize NAME (we don't use `capitalize' because that capitalizes ;; each word in a string separately). (setq name (concat (upcase (substring name 0 1)) (substring name 1))) - (let* ((completion-ignore-case t) - (value (completing-read + (let* ((value (completing-read-case-insensitive (format-prompt "%s for face `%s'" default name face) completion-alist nil nil nil nil default))) (if (equal value "") default value))) @@ -1430,10 +1429,10 @@ of a global face. Value is the new attribute value." (defun read-face-font (face &optional frame) "Read the name of a font for FACE on FRAME. If optional argument FRAME is nil or omitted, use the selected frame." - (let ((completion-ignore-case t)) - (completing-read (format-message - "Set font attributes of face `%s' from font: " face) - (append (fontset-list) (x-list-fonts "*" nil frame))))) + (completing-read-case-insensitive + (format-message + "Set font attributes of face `%s' from font: " face) + (append (fontset-list) (x-list-fonts "*" nil frame)))) (defun read-all-face-attributes (face &optional frame) @@ -2071,8 +2070,7 @@ the candidate, otherwise changes the background color of the candidates. The optional argument FACE determines the other face attributes of the candidates on display." (interactive "i\np\ni\np") ; Always convert to RGB interactively. - (let* ((completion-ignore-case t) - (color-alist + (let* ((color-alist `(("foreground at point" . ,(foreground-color-at-point)) ("background at point" . ,(background-color-at-point)) ,@(if allow-empty-name '(("" . unspecified))) @@ -2083,7 +2081,7 @@ face attributes of the candidates on display." (faces--string-with-color name color foreground face))) color-alist)) - (color (completing-read + (color (completing-read-case-insensitive (or prompt "Color (name or #RGB triplet): ") ;; Completing function for reading colors, accepting ;; both color names and RGB triplets. diff --git a/lisp/frame.el b/lisp/frame.el index d2376f1e339..ba4879c79fa 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1452,13 +1452,13 @@ as though the font-related attributes of the `default' face had been If INHIBIT-CUSTOMIZE is non-nil, don't update the user's Customization settings." (interactive - (let* ((completion-ignore-case t) - (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 default))) + (let* ((default (frame-parameter nil 'font)) + (font (completing-read-case-insensitive + (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 default))) (list font current-prefix-arg nil))) (when (or (stringp font) (fontp font)) (let* ((this-frame (selected-frame)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index c7730e5ef67..4b0b88a8939 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9624,14 +9624,15 @@ If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list - (let ((completion-ignore-case t)) + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case t)) (gnus-completing-read "Header name" (mapcar #'symbol-name (append - '(Number Subject From Lines Date Message-ID - Xref References Body) - gnus-extra-headers)) + '(Number Subject From Lines Date Message-ID + Xref References Body) + gnus-extra-headers)) 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 98f63571389..cf695c20bc1 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8345,7 +8345,6 @@ regular text mode tabbing command." (1+ (point))) (point)) (skip-chars-backward "^, \t\n") (point)))) - (completion-ignore-case t) (e (progn (skip-chars-forward "^,\t\n ") (point))) (collection (when (and (boundp 'gnus-active-hashtb) gnus-active-hashtb) diff --git a/lisp/info.el b/lisp/info.el index b1732429c40..cd70f4bfbb0 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2022,10 +2022,10 @@ A node name can have the form \"NODENAME\", referring to a node in the current Info file, or \"(FILENAME)NODENAME\", referring to a node in FILENAME. \"(FILENAME)\" is a short format to go to the Top node in FILENAME." - (let* ((completion-ignore-case t) - (Info-read-node-completion-table (Info-build-node-completions)) - (nodename (completing-read prompt #'Info-read-node-name-1 nil t nil - 'Info-minibuf-history default))) + (let* ((Info-read-node-completion-table (Info-build-node-completions)) + (nodename (completing-read-case-insensitive + prompt #'Info-read-node-name-1 nil t nil + 'Info-minibuf-history default))) (if (equal nodename "") (Info-read-node-name prompt) nodename))) @@ -2714,8 +2714,7 @@ If FORK is non-nil (interactively with a prefix arg), show the node in a new Info buffer. If FORK is a string, it is the name to use for the new buffer." (interactive - (let ((completion-ignore-case t) - (case-fold-search t) + (let ((case-fold-search t) completions default alt-default (start-point (point)) str i bol eol) (save-excursion ;; Store end and beginning of line. @@ -2753,9 +2752,9 @@ new buffer." (if (eq (length completions) 1) (setq default (car completions))) (if completions - (let ((input (completing-read (format-prompt "Follow reference named" - default) - completions nil t))) + (let ((input (completing-read-case-insensitive + (format-prompt "Follow reference named" default) + completions nil t))) (list (if (equal input "") default input) current-prefix-arg)) diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index 33a87b51e43..a73c1a7867a 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -401,9 +401,9 @@ rigorous support it is recommended to use an input method instead. Also note that many of these characters can be input with the regular \\`C-x 8' map without having to specify a language here." - (interactive (list (let ((completion-ignore-case t)) - (completing-read "Set which language? " - iso-transl-language-alist nil t)))) + (interactive (list (completing-read-case-insensitive + "Set which language? " + iso-transl-language-alist nil t))) (iso-transl-define-keys (cdr (assoc lang iso-transl-language-alist)))) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 27aad2dd266..700e48fe29c 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1277,12 +1277,12 @@ in the European submenu in each of those two menus." If KEY is nil, read any language environment. Prompt with PROMPT. DEFAULT is the default choice of language environment. This returns a language environment name as a string." - (let* ((completion-ignore-case t) - (name (completing-read prompt - language-info-alist - (and key - (lambda (elm) (and (listp elm) (assq key elm)))) - t nil nil default))) + (let* ((name (completing-read-case-insensitive + prompt + language-info-alist + (and key + (lambda (elm) (and (listp elm) (assq key elm)))) + t nil nil default))) (if (and (> (length name) 0) (or (not key) (get-language-info name key))) @@ -1462,14 +1462,14 @@ If INHIBIT-NULL is non-nil, null input signals an error. The return value is a string." (if default (setq prompt (format prompt default))) - (let* ((completion-ignore-case t) - ;; This binding is necessary because input-method-history is + (let* (;; This binding is necessary because input-method-history is ;; buffer local. - (input-method (completing-read prompt input-method-alist - nil t nil 'input-method-history - (if (and default (symbolp default)) - (symbol-name default) - default)))) + (input-method (completing-read-case-insensitive + prompt input-method-alist + nil t nil 'input-method-history + (if (and default (symbolp default)) + (symbol-name default) + default)))) (if (and input-method (symbolp input-method)) (setq input-method (symbol-name input-method))) (if (> (length input-method) 0) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 725592c9a10..50ed8753604 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -1011,9 +1011,8 @@ This shows which font is used for which character(s)." (error "No fontsets being used") (let ((fontset-list (nconc (fontset-list) - (mapcar 'cdr fontset-alias-alist))) - (completion-ignore-case t)) - (list (completing-read + (mapcar 'cdr fontset-alias-alist)))) + (list (completing-read-case-insensitive (format-prompt "Fontset" "used by the current frame") fontset-list nil t))))) (let ((help-buffer-under-preparation t)) diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index ba3df9af02f..c2c02c9c282 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -58,10 +58,9 @@ If the argument is t, we use the default cyrillic transliteration. If the argument is nil, we return the display table to its standard state." (interactive (list - (let* ((completion-ignore-case t)) - (completing-read - (format-prompt "Cyrillic language" "nil") - cyrillic-language-alist nil t nil nil nil)))) + (completing-read-case-insensitive + (format-prompt "Cyrillic language" "nil") + cyrillic-language-alist nil t nil nil nil))) (or standard-display-table (setq standard-display-table (make-display-table))) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 083bab62cab..f99dbd48de9 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -2214,9 +2214,8 @@ place. It affects how `mail-extract-address-components' works." (defun what-domain (domain) "Convert mail domain DOMAIN to the country it corresponds to." (interactive - (let ((completion-ignore-case t)) - (list (completing-read "Domain: " - mail-extr-all-top-level-domains nil t)))) + (list (completing-read-case-insensitive + "Domain: " mail-extr-all-top-level-domains nil t))) (or (setq domain (intern-soft (downcase domain) mail-extr-all-top-level-domains)) (error "No such domain")) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index a720df51d14..cf641cfb652 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -527,10 +527,9 @@ This also saves the value of `send-mail-function' via Customize." To change it later, customize the option `send-mail-function'.\n")) (goto-char (point-min)) (display-buffer (current-buffer)) - (let ((completion-ignore-case t)) - (completing-read - (format-prompt "Send mail via" (caar options)) - options nil 'require-match nil nil (car options)))))) + (completing-read-case-insensitive + (format-prompt "Send mail via" (caar options)) + options nil 'require-match nil nil (car options))))) ;; Return the choice. (cdr (assoc-string choice options t)))) diff --git a/lisp/man.el b/lisp/man.el index 7bc90f6fc82..903fc9c24f0 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1106,9 +1106,8 @@ for the current invocation." ;; so you're accustomed not to bother about the case ;; ("man -k" is case-insensitive similarly, so the ;; table has everything available to complete) - (completion-ignore-case t) Man-completion-cache ;Don't cache across calls. - (input (completing-read + (input (completing-read-case-insensitive (format-prompt "Manual entry" (and (not (equal default-entry "")) default-entry)) @@ -1888,10 +1887,9 @@ Returns t if section is found, nil otherwise." (let* ((default (if (member Man--last-section Man--sections) Man--last-section (car Man--sections))) - (completion-ignore-case t) (prompt (format-prompt "Go to section" default)) - (chosen (completing-read prompt Man--sections - nil nil nil nil default))) + (chosen (completing-read-case-insensitive + prompt Man--sections nil nil nil nil default))) (list chosen)) man-common) (setq Man--last-section section) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0347cd67098..f7c404dcb06 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -6853,5 +6853,16 @@ TOP-LEVEL-P is non-nil." "Hook run in minibuffer after pushing new input to `completion-history'." :type 'hook) +(defun completing-read-case-insensitive + ( prompt collection &optional + predicate require-match initial-input + hist def inherit-input-method) + "`completing-read' with `completion-ignore-case' set to t in the minibuffer." + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case t)) + (completing-read + prompt collection predicate require-match + initial-input hist def inherit-input-method))) + (provide 'minibuffer) ;;; minibuffer.el ends here diff --git a/lisp/mpc.el b/lisp/mpc.el index 768c70c2e3a..bcf027b391c 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1578,9 +1578,9 @@ when constructing the set of constraints." "Create a new browser for TAG." (interactive (list - (let ((completion-ignore-case t)) - (intern - (completing-read "Tag: " mpc-tag-browser-tagtypes nil 'require-match))))) + (intern + (completing-read-case-insensitive + "Tag: " mpc-tag-browser-tagtypes nil 'require-match)))) (let* ((newbuf (mpc-tagbrowser-buf tag)) (win (get-buffer-window newbuf 0))) (if win (select-window win) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 25983e397c3..6938a7f52fe 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1568,14 +1568,14 @@ Further arguments are currently ignored." (defun dictionary-completing-read-word (dictionary) "Prompt for a word with completion based on matches in DICTIONARY." - (let* ((completion-ignore-case t) - (dictionary-default-dictionary dictionary) + (let* ((dictionary-default-dictionary dictionary) (word-at-point (thing-at-point 'word t)) (default (dictionary-match-word word-at-point))) - (completing-read (format-prompt dictionary-read-word-prompt default) - (external-completion-table 'dictionary-definition - #'dictionary-match-word) - nil t nil 'dictionary-word-history default t))) + (completing-read-case-insensitive + (format-prompt dictionary-read-word-prompt default) + (external-completion-table 'dictionary-definition + #'dictionary-match-word) + nil t nil 'dictionary-word-history default t))) (defun dictionary-dictionaries () "Return the list of dictionaries the server supports. diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 89f45ae1049..d0833fe4dd1 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -1638,13 +1638,12 @@ Return t if a new feed was activated, nil otherwise." (defun newsticker-treeview-jump (feed-name) "Jump to feed FEED-NAME in newsticker treeview." (interactive - (list (let ((completion-ignore-case t)) - (completing-read - "Jump to feed/group: " - (append '("new" "obsolete" "immortal" "all") - (mapcar #'car (append newsticker-url-list - newsticker-url-list-defaults))) - nil t)))) + (list (completing-read-case-insensitive + "Jump to feed/group: " + (append '("new" "obsolete" "immortal" "all") + (mapcar #'car (append newsticker-url-list + newsticker-url-list-defaults))) + nil t))) (newsticker--treeview-unfold-node feed-name)) ;; ====================================================================== @@ -1731,9 +1730,9 @@ return a nested list." "Add group NAME to group PARENT." (interactive (list (read-string "Name of new group: ") - (let ((completion-ignore-case t)) - (completing-read "Name of parent group (optional): " (newsticker--group-all-groups) - nil t)))) + (completing-read-case-insensitive + "Name of parent group (optional): " (newsticker--group-all-groups) + nil t))) (if (newsticker--group-get-group name) (error "Group %s exists already" name)) (let ((p (if (and parent (not (string= parent ""))) @@ -1748,11 +1747,11 @@ return a nested list." (defun newsticker-group-delete-group (name) "Delete group NAME." (interactive - (list (let ((completion-ignore-case t)) - (completing-read "Delete group: " - (newsticker--group-names) - nil t (car (newsticker--group-find-parent-group - newsticker--treeview-current-feed)))))) + (list (completing-read-case-insensitive + "Delete group: " + (newsticker--group-names) + nil t (car (newsticker--group-find-parent-group + newsticker--treeview-current-feed))))) (let ((parent-group (newsticker--group-find-parent-group name))) (unless parent-group (error "Parent %s does not exist" parent-group)) @@ -1781,11 +1780,11 @@ return a nested list." (defun newsticker-group-rename-group (old-name new-name) "Rename group OLD-NAME to NEW-NAME." (interactive - (list (let* ((completion-ignore-case t)) - (completing-read "Rename group: " - (newsticker--group-names) - nil t (car (newsticker--group-find-parent-group - newsticker--treeview-current-feed)))) + (list (completing-read-case-insensitive + "Rename group: " + (newsticker--group-names) + nil t (car (newsticker--group-find-parent-group + newsticker--treeview-current-feed))) (read-string "Rename to: "))) (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name)) (newsticker--group-manage-orphan-feeds) @@ -1812,13 +1811,14 @@ return a nested list." "Move feed NAME to group GROUP-NAME. Update treeview afterwards unless NO-UPDATE is non-nil." (interactive - (let ((completion-ignore-case t)) - (list (completing-read "Name of feed or group to move: " - (append (mapcar #'car newsticker-url-list) - (newsticker--group-names)) - nil t newsticker--treeview-current-feed) - (completing-read "Name of new parent group: " (newsticker--group-names) - nil t)))) + (list (completing-read-case-insensitive + "Name of feed or group to move: " + (append (mapcar #'car newsticker-url-list) + (newsticker--group-names)) + nil t newsticker--treeview-current-feed) + (completing-read-case-insensitive + "Name of new parent group: " (newsticker--group-names) + nil t))) (let* ((group (if (and group-name (not (string= group-name ""))) (newsticker--group-get-group group-name) newsticker-groups)) diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index 016b7a39d9d..19d70541969 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -507,7 +507,9 @@ lines for the purposes of this function." "Read from the minibuffer, with completion. Like `completing-read', but the variable `snmp-completion-ignore-case' controls whether case is significant." - (let ((completion-ignore-case snmp-completion-ignore-case)) + (minibuffer-with-setup-hook + (lambda () + (setq-local completion-ignore-case snmp-completion-ignore-case)) (completing-read prompt table pred require init hist))) ;; OBJECT-TYPE macro template diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index cff838fca51..28cbfbd5952 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -257,9 +257,9 @@ hotlist. Please submit bug reports and other feedback to the author, Neil W. Van Dyke ." (interactive) - (let* ((completion-ignore-case t) - (item (assoc-string - (completing-read "WebJump to site: " webjump-sites nil t) + (let* ((item (assoc-string + (completing-read-case-insensitive + "WebJump to site: " webjump-sites nil t) webjump-sites t)) (name (car item)) (expr (cdr item)) @@ -321,8 +321,8 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke (car urls)) (defun webjump-read-choice (name what choices &optional default) - (let* ((completion-ignore-case t) - (choice (completing-read (concat name " " what ": ") choices nil t))) + (let* ((choice (completing-read-case-insensitive + (concat name " " what ": ") choices nil t))) (if (webjump-null-or-blank-string-p choice) default (cdr (assoc choice choices))))) diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el index 3e55bc5d4b9..a8b65c1ca23 100644 --- a/lisp/nxml/rng-loc.el +++ b/lisp/nxml/rng-loc.el @@ -73,15 +73,16 @@ It is nil if using a vacuous schema.") (defun rng-read-type-id () (condition-case err - (let ((type-ids (rng-possible-type-ids)) - (completion-ignore-case nil)) - (completing-read "Document type id: " - (mapcar (lambda (x) (cons x nil)) - type-ids) - nil - t - nil - 'rng-document-type-history)) + (let ((type-ids (rng-possible-type-ids))) + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case nil)) + (completing-read "Document type id: " + (mapcar (lambda (x) (cons x nil)) + type-ids) + nil + t + nil + 'rng-document-type-history))) (nxml-file-parse-error (nxml-display-file-parse-error err)))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 60f213fe751..76d103648d7 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -1975,10 +1975,9 @@ src block, then return nil." (defun org-babel-goto-named-src-block (name) "Go to a source-code block with NAME." (interactive - (let ((completion-ignore-case t) - (case-fold-search t) + (let ((case-fold-search t) (all-block-names (org-babel-src-block-names))) - (list (completing-read + (list (completing-read-case-insensitive "source-block name: " all-block-names nil t (let* ((context (org-element-context)) (type (org-element-type context)) @@ -1993,7 +1992,7 @@ src block, then return nil." ((memq type '(babel-call inline-babel-call)) ;#+CALL: (org-element-property :call context)) ((car (org-element-property :results context))) ;#+RESULTS: - ((let ((symbol (thing-at-point 'symbol))) ;Symbol. + ((let ((symbol (thing-at-point 'symbol))) ;Symbol. (and symbol (member-ignore-case symbol all-block-names) symbol))) @@ -2035,9 +2034,8 @@ to `org-babel-named-src-block-regexp'." (defun org-babel-goto-named-result (name) "Go to a result with NAME." (interactive - (let ((completion-ignore-case t)) - (list (completing-read "Source-block name: " - (org-babel-result-names) nil t)))) + (list (completing-read-case-insensitive + "Source-block name: " (org-babel-result-names) nil t))) (let ((point (org-babel-find-named-result name))) (if point ;; taken from `org-open-at-point' diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index 7070f48abcf..8d83f0e3913 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -120,11 +120,8 @@ BACKEND is the current export backend." (require 'man) (concat "man:" - (let ((completion-ignore-case t) ; See `man' comments. - (Man-completion-cache)) ; See `man' implementation. - (completing-read - "Manual entry: " - 'Man-completion-table)))) + (let ((Man-completion-cache)) ; See `man' implementation. + (completing-read-case-insensitive "Manual entry: " 'Man-completion-table)))) (provide 'ol-man) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index b2a5ff92734..2e3429b7847 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -4971,16 +4971,15 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) (let* ((today (calendar-gregorian-from-absolute (org-today))) - (completion-ignore-case t) todo-keywords org-select-this-todo-keyword todo-entries all-todo-entries files file pos) (catch 'exit (setq org-agenda-buffer-name (org-agenda--get-buffer-name (when org-agenda-sticky - (if (stringp org-select-this-todo-keyword) - (format "*Org Agenda(%s:%s)*" (or org-keys "t") - org-select-this-todo-keyword) - (format "*Org Agenda(%s)*" (or org-keys "t")))))) + (if (stringp org-select-this-todo-keyword) + (format "*Org Agenda(%s:%s)*" (or org-keys "t") + org-select-this-todo-keyword) + (format "*Org Agenda(%s)*" (or org-keys "t")))))) (org-agenda-prepare "TODO") (setq todo-keywords org-todo-keywords-for-agenda org-select-this-todo-keyword (cond ((stringp arg) arg) @@ -4990,9 +4989,11 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (setq org-select-this-todo-keyword (mapconcat #'identity (let ((crm-separator "|")) - (completing-read-multiple - "Keyword (or KWD1|KWD2|...): " - (mapcar #'list todo-keywords) nil nil)) + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case t)) + (completing-read-multiple + "Keyword (or KWD1|KWD2|...): " + (mapcar #'list todo-keywords) nil nil))) "|"))) (when (equal arg 0) (setq org-select-this-todo-keyword nil)) @@ -5060,7 +5061,6 @@ The prefix arg TODO-ONLY limits the search to TODO entries." match (nth 1 org-agenda-overriding-arguments))) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) - (completion-ignore-case t) (org--matcher-tags-todo-only todo-only) rtn rtnall files file pos matcher buffer) @@ -8296,9 +8296,8 @@ also press `-' or `+' to switch between filtering and excluding." (unless (local-variable-p 'org-global-tags-completion-table) (setq-local org-global-tags-completion-table (org-global-tags-completion-table))) - (let ((completion-ignore-case t)) - (setq tag (completing-read - "Tag: " org-global-tags-completion-table nil t)))) + (setq tag (completing-read-case-insensitive + "Tag: " org-global-tags-completion-table nil t))) (cond ((eq char ?\r) (org-agenda-filter-show-all-tag) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 9dea34449a7..22d756ecc2d 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -677,7 +677,6 @@ this function appends the default value from (cdr x)) (cons (concat (car x) extra) (cdr x)))) org-refile-target-table)) - (completion-ignore-case t) cdef (prompt (let ((default (or (car org-refile-history) (and (assoc cbnex tbl) (setq cdef cbnex) @@ -685,9 +684,12 @@ this function appends the default value from (org-format-prompt prompt default))) pa answ parent-target child parent old-hist) (setq old-hist org-refile-history) - (setq answ (funcall cfunc prompt tbl nil (not new-nodes) - nil 'org-refile-history - (or cdef (car org-refile-history)))) + (setq answ + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case t)) + (funcall cfunc prompt tbl nil (not new-nodes) + nil 'org-refile-history + (or cdef (car org-refile-history))))) (if (setq pa (org-refile--get-location answ tbl)) (let ((last-refile-loc (car org-refile-history))) (org-refile-check-position pa) diff --git a/lisp/org/org.el b/lisp/org/org.el index 96b0e0b0ce1..01f26452720 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -13534,44 +13534,48 @@ Optional argument DEFAULT provides a default value for PROPERTY." ((member default allowed) default) (t nil)))) (org-trim - (if allowed - (funcall set-function - prompt allowed nil - (not (get-text-property 0 'org-unrestricted (caar allowed))) - default nil default) - (let ((all (mapcar #'list - (append (org-property-values property) - (and epom - (org-with-point-at epom - (org-property-values property))))))) - (funcall set-function prompt all nil nil default nil current)))))) + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case t)) + (if allowed + (funcall set-function + prompt allowed nil + (not (get-text-property 0 'org-unrestricted (caar allowed))) + default nil default) + (let ((all (mapcar #'list + (append (org-property-values property) + (and epom + (org-with-point-at epom + (org-property-values property))))))) + (funcall set-function prompt all nil nil default nil current))))))) (defvar org-last-set-property nil) (defvar org-last-set-property-value nil) (defun org-read-property-name () "Read a property name." - (let ((completion-ignore-case t) - (default-prop (or (and (org-at-property-p) + (let ((default-prop (or (and (org-at-property-p) (match-string-no-properties 2)) org-last-set-property))) - (org-completing-read - (concat "Property" - (if default-prop (concat " [" default-prop "]") "") - ": ") - (mapcar #'list (org-buffer-property-keys nil t t)) - nil nil nil nil default-prop))) + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case t)) + (org-completing-read + (concat "Property" + (if default-prop (concat " [" default-prop "]") "") + ": ") + (mapcar #'list (org-buffer-property-keys nil t t)) + nil nil nil nil default-prop)))) (defun org-set-property-and-value (use-last) "Allow setting [PROPERTY]: [value] direction from prompt. When use-default, don't even ask, just use the last \"[PROPERTY]: [value]\" string from the history." (interactive "P") - (let* ((completion-ignore-case t) - (pv (or (and use-last org-last-set-property-value) - (org-completing-read - "Enter a \"[Property]: [value]\" pair: " - nil nil nil nil nil - org-last-set-property-value))) + (let* ((pv (or (and use-last org-last-set-property-value) + (minibuffer-with-setup-hook + (lambda () (setq-local completion-ignore-case t)) + (org-completing-read + "Enter a \"[Property]: [value]\" pair: " + nil nil nil nil nil + org-last-set-property-value)))) prop val) (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv) (setq prop (match-string 1 pv) @@ -13628,13 +13632,12 @@ part of the buffer." (defun org-delete-property (property) "In the current entry, delete PROPERTY." (interactive - (let* ((completion-ignore-case t) - (cat (org-entry-get (point) "CATEGORY")) + (let* ((cat (org-entry-get (point) "CATEGORY")) (props0 (org-entry-properties nil 'standard)) (props (if cat props0 (delete `("CATEGORY" . ,(org-get-category)) props0))) (prop (if (< 1 (length props)) - (completing-read "Property: " props nil t) + (completing-read-case-insensitive "Property: " props nil t) (caar props)))) (list prop))) (if (not property) @@ -13646,11 +13649,10 @@ part of the buffer." "Remove PROPERTY globally, from all entries. This function ignores narrowing, if any." (interactive - (let* ((completion-ignore-case t) - (prop (completing-read - "Globally remove property: " - (mapcar #'list (org-buffer-property-keys))))) - (list prop))) + (list + (completing-read-case-insensitive + "Globally remove property: " + (mapcar #'list (org-buffer-property-keys))))) (org-with-wide-buffer (goto-char (point-min)) (let ((count 0) diff --git a/lisp/proced.el b/lisp/proced.el index 1d257b6bd4d..bd362fd727e 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -2127,17 +2127,20 @@ supported but discouraged. It will be removed in a future version of Emacs." (let* ((process-alist (proced-marked-processes)) (pnum (if (= 1 (length process-alist)) "1 process" - (format "%d processes" (length process-alist)))) - (completion-ignore-case t) - (completion-extra-properties - `(:annotation-function - ,(lambda (s) (cdr (assoc s proced-signal-list)))))) + (format "%d processes" (length process-alist))))) (proced-with-processes-buffer process-alist - (list (completing-read (format-prompt "Send signal [%s]" - "TERM" pnum) - proced-signal-list - nil nil nil nil "TERM") - process-alist))) + (list + (minibuffer-with-setup-hook + (lambda () + (setq-local completion-ignore-case t + completion-extra-properties + `(:annotation-function + ,(lambda (s) (cdr (assoc s proced-signal-list)))))) + (completing-read (format-prompt "Send signal [%s]" + "TERM" pnum) + proced-signal-list + nil nil nil nil "TERM")) + process-alist))) proced-mode) (unless (and signal process-alist) @@ -2146,23 +2149,26 @@ supported but discouraged. It will be removed in a future version of Emacs." ;; of the code required for interactive and noninteractive calls so that ;; the command can be used more flexibly in noninteractive ways, too. (unless (get 'proced-send-signal 'proced-outdated) - (put 'proced-send-signal 'proced-outdated t) - (message "Outdated usage of `proced-send-signal'") - (sit-for 2)) + (put 'proced-send-signal 'proced-outdated t) + (message "Outdated usage of `proced-send-signal'") + (sit-for 2)) (setq process-alist (proced-marked-processes)) (unless signal (let ((pnum (if (= 1 (length process-alist)) "1 process" - (format "%d processes" (length process-alist)))) - (completion-ignore-case t) - (completion-extra-properties - `(:annotation-function - ,(lambda (s) (cdr (assoc s proced-signal-list)))))) + (format "%d processes" (length process-alist))))) (proced-with-processes-buffer process-alist - (setq signal (completing-read (format-prompt "Send signal [%s]" - "TERM" pnum) - proced-signal-list - nil nil nil nil "TERM")))))) + (setq signal + (minibuffer-with-setup-hook + (lambda () + (setq-local completion-ignore-case t + completion-extra-properties + `(:annotation-function + ,(lambda (s) (cdr (assoc s proced-signal-list)))))) + (completing-read (format-prompt "Send signal [%s]" + "TERM" pnum) + proced-signal-list + nil nil nil nil "TERM"))))))) (let (failures) ;; Why not always use `signal-process'? See @@ -2173,7 +2179,7 @@ supported but discouraged. It will be removed in a future version of Emacs." (if (string-match "\\`[0-9]+\\'" signal) (string-to-number signal) (make-symbol signal)) - signal))) ; number + signal))) ; number (dolist (process process-alist) (condition-case err (unless (zerop (funcall @@ -2181,7 +2187,7 @@ supported but discouraged. It will be removed in a future version of Emacs." (file-remote-p default-directory))) (proced-log "%s\n" (cdr process)) (push (cdr process) failures)) - (error ; catch errors from failed signals + (error ; catch errors from failed signals (proced-log "%s\n" err) (proced-log "%s\n" (cdr process)) (push (cdr process) failures))))) @@ -2196,7 +2202,7 @@ supported but discouraged. It will be removed in a future version of Emacs." (proced-log (current-buffer)) (proced-log "%s\n" (cdr process)) (push (cdr process) failures)) - (error ; catch errors from failed signals + (error ; catch errors from failed signals (proced-log (current-buffer)) (proced-log "%s\n" (cdr process)) (push (cdr process) failures))))))) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 1364214329a..4dcbccf1c64 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1459,11 +1459,11 @@ Return \(LEVEL OPTION LOCATION)." (if (atom (cdr kind)) (list level nil (cdr kind)) (let* ((table (elt antlr-options-alists (1- level))) - (completion-ignore-case t) ;dynamic - (input (completing-read (format "Insert %s option: " - (elt antlr-options-headings - (1- level))) - table))) + (input (completing-read-case-insensitive + (format "Insert %s option: " + (elt antlr-options-headings + (1- level))) + table))) (list level input (cdr kind)))))) (defun antlr-options-menu-filter (level _menu-items) @@ -1840,12 +1840,12 @@ table is the resulting alist of TABLE-X concatenated with TABLE where TABLE can also be a function evaluation to an alist. Used inside `antlr-options-alists'." - (let* ((completion-ignore-case t) ; dynamic - (table0 (and (or table table-x) + (let* ((table0 (and (or table table-x) (append table-x (if (functionp table) (funcall table) table)))) (input (if table0 - (completing-read prompt table0 nil nil initial-contents) + (completing-read-case-insensitive + prompt table0 nil nil initial-contents) (read-from-minibuffer prompt initial-contents)))) (if (and as-string (or (eq as-string t) diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index ff6371d9368..e0ab37a6dea 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -378,12 +378,9 @@ calls c-set-style internally in this way whilst initializing a buffer; if c-set-style is called like this from anywhere else, it will usually behave as a null operation." (interactive - (list (let ((completion-ignore-case t) - (prompt (format "Which %s indentation style? " - mode-name))) - (completing-read prompt c-style-alist nil t nil - 'c-set-style-history - c-indentation-style)))) + (list (completing-read-case-insensitive + (format "Which %s indentation style? " mode-name) + c-style-alist nil t nil 'c-set-style-history c-indentation-style))) (or c-buffer-is-cc-mode (error "Buffer %s is not a CC Mode buffer (c-set-style)" (buffer-name))) (or (stringp stylename) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 573e5ef85a9..90b0259696d 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -820,9 +820,7 @@ tags table for BUF and its (recursively) included tags tables." "Using tags, return a completion table for the text around point. If no tags table is loaded, do nothing and return nil." (when (or tags-table-list tags-file-name) - (let ((completion-ignore-case (find-tag--completion-ignore-case)) - (pattern (find-tag--default)) - beg) + (let ((pattern (find-tag--default)) beg) (when pattern (save-excursion ;; Avoid end-of-buffer error.