From 1f3cb887da975141ef0f784b5e4755b19e4716d0 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 19 Feb 2025 16:47:16 +0100 Subject: [PATCH] New macro 'compf' --- lisp/bindings.el | 3 +-- lisp/calc/calc-mode.el | 3 +-- lisp/calendar/cal-bahai.el | 2 +- lisp/calendar/cal-persia.el | 2 +- lisp/cus-edit.el | 4 +-- lisp/cus-theme.el | 2 +- lisp/dabbrev.el | 2 +- lisp/dnd.el | 2 +- lisp/emacs-lisp/advice.el | 3 +-- lisp/emacs-lisp/byte-opt.el | 2 +- lisp/emacs-lisp/bytecomp.el | 5 ++-- lisp/emacs-lisp/chart.el | 2 +- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/icons.el | 4 +-- lisp/emacs-lisp/loaddefs-gen.el | 3 +-- lisp/emacs-lisp/nadvice.el | 2 +- lisp/emacs-lisp/re-builder.el | 3 +-- lisp/emacs-lisp/trace.el | 6 ++--- lisp/env.el | 2 +- lisp/erc/erc.el | 2 +- lisp/files.el | 4 +-- lisp/gnus/gnus-agent.el | 3 +-- lisp/gnus/gnus-art.el | 6 ++--- lisp/gnus/gnus-draft.el | 2 +- lisp/gnus/gnus-group.el | 3 +-- lisp/gnus/gnus-sum.el | 6 ++--- lisp/gnus/gnus-util.el | 3 +-- lisp/help-fns.el | 3 +-- lisp/help.el | 11 +++----- lisp/hexl.el | 2 +- lisp/htmlfontify.el | 4 +-- lisp/image-mode.el | 2 +- lisp/image.el | 2 +- lisp/info.el | 4 +-- lisp/international/mule-diag.el | 2 +- lisp/international/quail.el | 2 +- lisp/mail/mailalias.el | 4 +-- lisp/mail/smtpmail.el | 2 +- lisp/mail/supercite.el | 4 +-- lisp/minibuffer.el | 8 +++--- lisp/net/mairix.el | 2 +- lisp/net/tramp-container.el | 2 +- lisp/org/ob-core.el | 6 ++--- lisp/org/org-agenda.el | 2 +- lisp/org/org-colview.el | 2 +- lisp/org/org-pcomplete.el | 2 +- lisp/org/org-table.el | 2 +- lisp/org/org.el | 4 +-- lisp/org/ox-html.el | 2 +- lisp/org/ox-publish.el | 2 +- lisp/play/decipher.el | 2 +- lisp/proced.el | 2 +- lisp/progmodes/elisp-mode.el | 7 ++--- lisp/progmodes/flymake.el | 2 +- lisp/progmodes/gud.el | 4 +-- lisp/progmodes/hideif.el | 2 +- lisp/progmodes/mixal-mode.el | 2 +- lisp/progmodes/octave.el | 2 +- lisp/progmodes/project.el | 6 ++--- lisp/progmodes/refactor.el | 4 +-- lisp/progmodes/sh-script.el | 3 +-- lisp/progmodes/sql.el | 4 +-- lisp/progmodes/which-func.el | 2 +- lisp/register.el | 2 +- lisp/simple.el | 6 ++--- lisp/subr.el | 45 +++++++++++++++++++++++++-------- lisp/textmodes/reftex-index.el | 2 +- lisp/textmodes/reftex-ref.el | 2 +- lisp/textmodes/reftex.el | 4 +-- lisp/textmodes/tex-mode.el | 2 +- lisp/vc/vc-dir.el | 5 ++-- lisp/vc/vc.el | 6 ++--- lisp/window.el | 2 +- 73 files changed, 139 insertions(+), 138 deletions(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index 763897cf5dd..e509b5e8b57 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -423,8 +423,7 @@ a menu, so this function is not useful for non-menu keymaps." map))) ;; Sort the bindings and make a new keymap from them. (setq bindings - (sort bindings :key (compose #'bindings--menu-item-string - #'cdr-safe))) + (sort bindings :key (compf bindings--menu-item-string cdr-safe))) (nconc (make-sparse-keymap prompt) bindings))) (defvar mode-line-major-mode-keymap diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index 1ca6bb7dca2..2da2a930672 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -271,8 +271,7 @@ (interactive) (calc-wrapper (let (pos - (vals (mapcar (lambda (v) (symbol-value (car v))) - calc-mode-var-list))) + (vals (mapcar (compf symbol-value car) calc-mode-var-list))) (unless calc-settings-file (error "No `calc-settings-file' specified")) (set-buffer (find-file-noselect (substitute-in-file-name diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index fd15f155b9b..073d04e7707 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -156,7 +156,7 @@ Reads a year, month and day." (let* ((today (calendar-current-date)) (year (calendar-read-sexp "Bahá’í calendar year (not 0)" - (lambda (x) (not (zerop x))) + (compf not zerop) (calendar-extract-year (calendar-bahai-from-absolute (calendar-absolute-from-gregorian today))))) diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index 1ee2aac662b..5305607d315 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el @@ -160,7 +160,7 @@ Gregorian date Sunday, December 31, 1 BC." Reads a year, month, and day." (let* ((year (calendar-read-sexp "Persian calendar year (not 0)" - (lambda (x) (not (zerop x))) + (compf not zerop) (calendar-extract-year (calendar-persian-from-absolute (calendar-absolute-from-gregorian diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 2ce2c45b51b..48ea56ba84e 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1216,7 +1216,7 @@ If OTHER-WINDOW is non-nil, display in another window." (pop-to-buffer-same-window name))))) (put 'customize-group 'minibuffer-action - (cons (lambda (g) (save-selected-window (customize-group g))) + (cons (compf save-selected-window customize-group) "customize")) ;;;###autoload @@ -1631,7 +1631,7 @@ If TYPE is `groups', include only groups." "*Customize Apropos*"))) (put 'customize-apropos 'minibuffer-action - (cons (lambda (p) (save-selected-window (customize-apropos p))) + (cons (compf save-selected-window customize-apropos) "customize-apropos")) ;;;###autoload diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index baad3242cbd..acf92866bdb 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -737,7 +737,7 @@ Theme files are named *-theme.el in `")) (defun custom-theme-selections-toggle (widget &optional event) (when (widget-value widget) ;; Deactivate multiple-selections. - (if (< 1 (length (delq nil (mapcar (lambda (x) (widget-value (cdr x))) + (if (< 1 (length (delq nil (mapcar (compf widget-value cdr) custom--listed-themes)))) (error "More than one theme is currently selected"))) (widget-toggle-action widget event) diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 0c72ed70863..10b406cce96 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -74,7 +74,7 @@ addition to the current buffer and the visible buffers.") found (length expansions)) ;; Then all visible buffers. (when (< found dabbrev-maximum-expansions) - (walk-windows (compose search #'window-buffer) nil 'visible) + (walk-windows (compf [search] window-buffer) nil 'visible) (setq expansions (nconc expansions more) more nil)) ;; Then try other buffers. (when (< found dabbrev-maximum-expansions) diff --git a/lisp/dnd.el b/lisp/dnd.el index f5a5f9f5ca4..5d0711d26dc 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -235,7 +235,7 @@ for it will be modified." ;; While unassessed handlers still exist... (while list ;; Sort list by the number of URLs assigned to each handler. - (setq list (sort list :key (compose #'length #'cdr) :reverse t)) + (setq list (sort list :key (compf length cdr) :reverse t)) ;; Call the handler in its car before removing each URL from ;; URLs. (let ((handler (caar list)) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 9631f9f633f..05be9fc178c 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1859,8 +1859,7 @@ function at point for which PREDICATE returns non-nil)." (intern function)))) (defvar ad-advice-class-completion-table - (mapcar (lambda (class) (list (symbol-name class))) - ad-advice-classes)) + (mapcar (compf list symbol-name) ad-advice-classes)) (defun ad-read-advice-class (function &optional prompt default) "Read a valid advice class with completion from the minibuffer. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0c72f9625db..83909c300a5 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -709,7 +709,7 @@ If this function returns nil, then FORM never returns." (or (byte-opt--return-p then) (byte-opt--every #'byte-opt--return-p else)))) (`(,(or 'and 'or) . ,exps) - (not (byte-opt--every (lambda (exp) (not (byte-opt--return-p exp))) exps))) + (not (byte-opt--every (compf not byte-opt--return-p) exps))) (`(while ,exp . ,exps) (and (not (byte-compile-trueconstp exp)) (byte-opt--every #'byte-opt--return-p exps))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e9c55494e3e..efd9f1f604f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -371,7 +371,7 @@ for the Emacs build itself.") (put 'byte-compile-warnings 'safe-local-variable (lambda (v) (or (symbolp v) - (null (delq nil (mapcar (lambda (x) (not (symbolp x))) v)))))) + (null (delq nil (mapcar (compf not symbolp) v)))))) ;;;###autoload (defun byte-compile-warning-enabled-p (warning &optional symbol) @@ -4656,8 +4656,7 @@ Return (TAIL VAR TEST CASES), where: jump-table test-objects body tag default-tag) ;; TODO: Once :linear-search is implemented for `make-hash-table' ;; set it to t for cond forms with a small number of cases. - (let ((nvalues (apply #'+ (mapcar (lambda (case) (length (car case))) - cases)))) + (let ((nvalues (apply #'+ (mapcar (compf length car) cases)))) (setq jump-table (make-hash-table :test test :size nvalues))) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 2a01501f99e..5c45dc7a75d 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -721,7 +721,7 @@ DIR is assumed to be a directory, verified by the caller." (let* ((data (garbage-collect))) ;; Let's create the chart! (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" - (mapcar (lambda (x) (symbol-name (car x))) data) + (mapcar (compf symbol-name car) data) "Storage Items" (mapcar (lambda (x) (* (nth 1 x) (nth 2 x))) data) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index a6fdf5cad6b..9ec4c51a3fa 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1345,7 +1345,7 @@ checking of documentation strings. (or checkdoc-common-verbs-regexp (setq checkdoc-common-verbs-regexp (concat "\\<\\(" - (mapconcat (lambda (e) (concat (car e))) + (mapconcat (compf concat car) checkdoc-common-verbs-wrong-voice "\\|") "\\)\\>")))) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 3ab505301d7..3ad91aea6f7 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -89,10 +89,10 @@ the icon is used as a button and you click it." name 'custom-icon)) (defun icon-spec-keywords (spec) - (seq-drop-while (lambda (e) (not (keywordp e))) (cdr spec))) + (seq-drop-while (compf not keywordp) (cdr spec))) (defun icon-spec-values (spec) - (seq-take-while (lambda (e) (not (keywordp e))) (cdr spec))) + (seq-take-while (compf not keywordp) (cdr spec))) (defun iconp (object) "Return nil if OBJECT is not an icon. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index f7a153371dd..39f2c05f125 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -633,8 +633,7 @@ instead of just updating them with the new/changed autoloads." (progress-reporter-done progress)) ;; First group per output file. - (dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x))) - defs)) + (dolist (fdefs (seq-group-by (compf expand-file-name car) defs)) (let ((loaddefs-file (car fdefs)) hash) (with-temp-buffer diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 150332c4c5d..14a0cacad24 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -540,7 +540,7 @@ or an autoload and it preserves `fboundp'. Instead of the actual function to remove, FUNCTION can also be the `name' of the piece of advice." (interactive - (let* ((pred (lambda (sym) (advice--p (advice--symbol-function sym)))) + (let* ((pred (compf advice--p advice--symbol-function)) (default (when-let* ((f (function-called-at-point)) ((funcall pred f))) (symbol-name f))) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 6b4f6c55d7b..ce01b2a49b5 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -820,8 +820,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (require 'rx) (defconst reb-rx-font-lock-keywords (let ((constituents (mapcar #'symbol-name rx--builtin-forms)) - (syntax (mapcar (lambda (rec) (symbol-name (car rec))) - rx--syntax-codes)) + (syntax (mapcar (compf symbol-name car) rx--syntax-codes)) (categories (mapcar (lambda (rec) (symbol-name (car rec))) rx--categories))) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index e49e2828343..4a5bcbe3fe3 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -268,9 +268,9 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\" (minibuffer-with-setup-hook (lambda () (setq minibuffer-action - (cons (compose action #'intern) "trace")) + (cons (compf [action] intern) "trace")) (setq minibuffer-alternative-action - (cons (compose #'untrace-function #'intern) "untrace"))) + (cons (compf untrace-function intern) "untrace"))) (completing-read (format-prompt prompt default) (completion-table-with-metadata @@ -348,7 +348,7 @@ was not traced this is a noop." (advice-remove function trace-advice-name)) (put 'untrace-function 'minibuffer-action - (cons (compose #'untrace-function #'intern) "untrace")) + (cons (compf untrace-function intern) "untrace")) (defun untrace-all () "Untraces all currently traced functions." diff --git a/lisp/env.el b/lisp/env.el index 288f7e224d7..0095727a494 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -100,7 +100,7 @@ Use `$$' to insert a single dollar sign." ;; How 'bout we lookup other tables than the env? ;; E.g. we could accept bookmark names as well! (if (memq system-type '(windows-nt ms-dos)) - (lambda (var) (getenv (upcase var))) + (compf getenv upcase) t))) (defun setenv-internal (env variable value keep-empty) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fc2245e9831..e75c3ef176a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7614,7 +7614,7 @@ secret key associated with the letter k." modes) (setq out (cl-sort out #'< :key #'car)) (pcase as-type - ('strings (mapcar (lambda (o) (char-to-string (car o))) out)) + ('strings (mapcar (compf char-to-string car) out)) ('string (apply #'string (mapcar #'car out))) ((and (pred natnump) c) (let (keys vals) diff --git a/lisp/files.el b/lisp/files.el index 6956467dbec..445c730fbdb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2020,7 +2020,7 @@ automatically choosing a major mode, use \\[find-file-literally]." (pop-to-buffer-same-window value)))) (put 'find-file 'minibuffer-action - (cons (lambda (file) (display-buffer (find-file-noselect file))) + (cons (compf display-buffer find-file-noselect) "find")) (defun find-file-other-window (filename &optional wildcards) @@ -5019,7 +5019,7 @@ This does nothing if either `enable-local-variables' or nil))) ;; Sort the entries from nearest dir to furthest dir. (setq items (sort (nreverse items) - :key (lambda (x) (length (car-safe x))) :reverse t)) + :key (compf length car-safe) :reverse t)) ;; Filter out duplicates, preferring the settings from the nearest dir ;; and from the first hook function. (let ((seen nil)) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index f61e8bcfa1c..5c75209bfd8 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -756,8 +756,7 @@ be a select method." (intern (gnus-completing-read "Add to category" - (mapcar (lambda (cat) (symbol-name (car cat))) - gnus-category-alist) + (mapcar (compf symbol-name car) gnus-category-alist) t)) current-prefix-arg)) (let ((cat (assq category gnus-category-alist)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 65f9d92d45b..1761880c2ad 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1998,11 +1998,11 @@ always hide." (ignore-errors (equal (sort (mapcar - (lambda (x) (downcase (cadr x))) + (compf downcase cadr) (mail-extract-address-components from t)) #'string<) (sort (mapcar - (lambda (x) (downcase (cadr x))) + (compf downcase cadr) (mail-extract-address-components reply-to t)) #'string<)))) (gnus-article-hide-header "reply-to"))))) @@ -5574,7 +5574,7 @@ CHARSET may either be a string or a symbol." (mm-enable-external t)) (if (not (stringp method)) (gnus-mime-view-part-as-type - nil (lambda (type) (stringp (mailcap-mime-info type)))) + nil (compf stringp mailcap-mime-info)) (when handle (mm-display-part handle nil t)))))) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index d42ab6b0b5b..2aca30e0c1a 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -245,7 +245,7 @@ If DONT-POP is nil, display the buffer after setting it up." (let ((article narticle)) (message-mail nil nil nil nil (if dont-pop - (lambda (buf) (set-buffer (gnus-get-buffer-create buf))))) + (compf set-buffer gnus-get-buffer-create))) (let ((inhibit-read-only t)) (erase-buffer)) (if (not (gnus-request-restore-buffer article group)) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 9156b7f5a1c..1f246bbabf0 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3043,8 +3043,7 @@ If SOLID (the prefix), create a solid group." (gnus-string-or (gnus-completing-read "Search engine type" - (mapcar (lambda (elem) (symbol-name (car elem))) - nnweb-type-definition) + (mapcar (compf symbol-name car) nnweb-type-definition) t nil 'gnus-group-web-type-history) default-type)) (search diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 350d0c1a224..e7f09844062 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5288,7 +5288,7 @@ or a straight list of headers." (cddar thread))) (setq gnus-tmp-gathered (nconc (mapcar - (lambda (h) (mail-header-number (car h))) + (compf mail-header-number car) (cddar thread)) gnus-tmp-gathered)) (setq thread (cons (list (caar thread) @@ -5300,7 +5300,7 @@ or a straight list of headers." ;; We print adopted articles with empty subject fields. (setq gnus-tmp-gathered (nconc (mapcar - (lambda (h) (mail-header-number (car h))) + (compf mail-header-number car) (cddar thread)) gnus-tmp-gathered)) (setq gnus-tmp-level -1)) @@ -5334,7 +5334,7 @@ or a straight list of headers." ((not (memq number gnus-newsgroup-limit)) (setq gnus-tmp-gathered (nconc (mapcar - (lambda (h) (mail-header-number (car h))) + (compf mail-header-number car) (cdar thread)) gnus-tmp-gathered)) (setq gnus-tmp-new-adopts (if (cdar thread) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 6ee9a49a8e4..642a051e490 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1221,8 +1221,7 @@ CHOICE is a list of the choice char and help message at IDX." (message "%s (%s): " prompt (concat - (mapconcat (lambda (s) (char-to-string (car s))) - choice ", ") + (mapconcat (compf char-to-string car) choice ", ") ", ?")) (setq tchar (read-char)) (when (not (assq tchar choice)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 1c607628bcd..29e862d09e6 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1968,8 +1968,7 @@ If FRAME is omitted or nil, use the selected frame." (:fontset . "Fontset") (:extend . "Extend") (:inherit . "Inherit"))) - (max-width (apply #'max (mapcar (lambda (x) (length (cdr x))) - attrs)))) + (max-width (apply #'max (mapcar (compf length cdr) attrs)))) (dolist (a attrs) (let ((attr (face-attribute face (car a) frame))) (insert (make-string (- max-width (length (cdr a))) ?\s) diff --git a/lisp/help.el b/lisp/help.el index 6ae5985cf8f..b4430a813ec 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -581,8 +581,8 @@ a minor mode." (memq source modes)) (push source modes)))) (let* ((names (mapcar - (compose (apply-partially #'string-replace "-mode" "") - #'symbol-name) + (compf (apply-partially #'string-replace "-mode" "") + symbol-name) modes)) (max (seq-max (cons 0 (mapcar #'string-width names)))) (choices @@ -686,9 +686,7 @@ defaults to all active keymaps. See also `current-active-maps'." ((eq active-map (current-local-map)) 'local) (t (car (rassq active-map minor-mode-map-alist))))) pm)))) - (let* ((m (seq-max (cons 0 (mapcar (compose #'string-width - #'key-description - #'car) + (let* ((m (seq-max (cons 0 (mapcar (compf string-width key-description car) help--complete-keys-alist)))) (bindings (mapcar (pcase-lambda (`(,e ,b . ,s)) @@ -1023,8 +1021,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." nil) (put 'where-is 'minibuffer-action - (cons (lambda (cmd) (where-is (intern cmd))) - "show keys")) + (cons (compf where-is intern) "show keys")) (defun help-key-description (key untranslated) (let ((string (help--key-description-fontified key))) diff --git a/lisp/hexl.el b/lisp/hexl.el index d1dcdf184c4..7305b8d7892 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -393,7 +393,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (let ((textre (if (> (length string) 80) (regexp-quote string) - (mapconcat (lambda (c) (regexp-quote (string c))) string + (mapconcat (compf regexp-quote string) string "\\(?:\n\\(?:[:a-f0-9]+ \\)+ \\)?")))) (if (string-match "\\` ?\\([a-f0-9]+ \\)*[a-f0-9]+ ?\\'" string) (concat textre "\\|" diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index a647ad8f7da..4ced3fb1b94 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -744,8 +744,8 @@ may happen." (cond ((equal color "unspecified-fg") (setq color "black")) ((equal color "unspecified-bg") (setq color "white"))) - (let ((white (mapcar (lambda (I) (float (1+ I))) (hfy-color-vals "white"))) - (rgb16 (mapcar (lambda (I) (float (1+ I))) (hfy-color-vals color)))) + (let ((white (mapcar (compf float 1+) (hfy-color-vals "white"))) + (rgb16 (mapcar (compf float 1+) (hfy-color-vals color)))) (if rgb16 ;;(apply #'format "rgb(%d, %d, %d)" ;; Use #rrggbb instead, it is smaller diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 47cda0a50cf..059040b64ee 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1042,7 +1042,7 @@ Otherwise, display the image by calling `image-mode'." (when (image-get-display-property) (image-toggle-display-text) ;; Update image display. - (mapc (lambda (window) (redraw-frame (window-frame window))) + (mapc (compf redraw-frame window-frame) (get-buffer-window-list (current-buffer) 'nomini 'visible)) (image-toggle-display-image))) diff --git a/lisp/image.el b/lisp/image.el index e0c73cb5760..e089fc80c38 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1128,7 +1128,7 @@ recognizes these files as having image type `imagemagick'. If Emacs is compiled without ImageMagick support, this does nothing." (when (fboundp 'imagemagick-types) - (let* ((types (mapcar (lambda (type) (downcase (symbol-name type))) + (let* ((types (mapcar (compf downcase symbol-name) (imagemagick-filter-types))) (re (if types (concat "\\." (regexp-opt types) "\\'"))) (ama-elt (car (member (cons imagemagick--file-regexp 'image-mode) diff --git a/lisp/info.el b/lisp/info.el index 2f28df44968..48902a9f5c8 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -869,7 +869,7 @@ See a list of available Info commands in `Info-mode'." (info-pop-to-buffer file-or-node buffer)) (put 'info 'minibuffer-action - (cons (lambda (f) (save-selected-window (info f))) "info")) + (cons (compf save-selected-window info) "info")) (defun info-setup (file-or-node buffer) "Display Info node FILE-OR-NODE in BUFFER." @@ -5564,7 +5564,7 @@ completion alternatives to currently visited manuals." (generate-new-buffer-name "*info*"))))) (put 'info-display-manual 'minibuffer-action - (cons (lambda (m) (save-selected-window (info-display-manual m))) + (cons (compf save-selected-window info-display-manual) "display")) (defun info--filter-manual-names (names) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 784f54ccbb8..63b8fba9fba 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -209,7 +209,7 @@ DEFAULT-VALUE, if non-nil, is the default value. INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially. See the documentation of the function `completing-read' for the detailed meanings of these arguments." - (let* ((table (mapcar (lambda (x) (list (symbol-name x))) charset-list)) + (let* ((table (mapcar (compf list symbol-name) charset-list)) (charset (completing-read prompt table nil t initial-input 'charset-history default-value))) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index daa55b14b87..84e173df79e 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -2888,7 +2888,7 @@ when keys in RULES are input. The generated map can be set for the current Quail package by the function `quail-install-map' (which see)." - (let ((state-alist (mapcar (lambda (x) (list (car x))) table)) + (let ((state-alist (mapcar (compf list car) table)) tail elt) ;; STATE-ALIST is an alist of states vs the corresponding sub Quail ;; map. It is now initialized to ((STATE-0) (STATE-1) ...). diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 251080a4784..1940953e9eb 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -489,9 +489,7 @@ PREFIX is the string we want to complete." (eq mail-names t)) (setq mail-names (sort (append (if (consp mail-aliases) - (mapcar - (lambda (a) (list (car a))) - mail-aliases)) + (mapcar (compf list car) mail-aliases)) (if (consp mail-local-names) mail-local-names) (or directory diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index db0510c7e84..c9855ce9528 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -810,7 +810,7 @@ Returns an error if the server cannot be contacted." ;; language environments. See ;; https://lists.gnu.org/archive/html/emacs-devel/2007-03/msg01760.html. (with-case-table ascii-case-table - (mapcar (lambda (s) (intern (downcase s))) + (mapcar (compf intern downcase) (split-string (substring line 4) "[ ]"))))) (when (= (length name) 1) (setq name (car name))) diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index 3df7c5e5b89..51475723620 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -599,7 +599,7 @@ the list should be unique." (mapconcat #'car alist ", ") "? (" (mapconcat - (lambda (elt) (char-to-string (cdr elt))) alist "/") + (compf char-to-string cdr) alist "/") ") ")) (p prompt) event) @@ -1183,7 +1183,7 @@ to the auto-selected attribution string." ;; query for confirmation (if query-p - (let* ((query-alist (mapcar (lambda (entry) (list (cdr entry))) + (let* ((query-alist (mapcar (compf list cdr) sc-attributions)) (minibuffer-local-completion-map sc-minibuffer-local-completion-map) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 969171022ed..f05fc934da9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4674,7 +4674,7 @@ Return the new suffix." (if completion-lazy-hilit (prog1 comps (setq completion-lazy-hilit-fn hilit-fn)) (setq completion-lazy-hilit-fn nil) - (mapcar (compose hilit-fn #'copy-sequence) comps)))) + (mapcar (compf [hilit-fn] copy-sequence) comps)))) ;;; Partial-completion-mode style completion. @@ -5928,7 +5928,7 @@ predicates together." (if-let ((neg (get-text-property 0 'negated desc))) (minibuffer--add-completions-predicate (cdr neg) (car neg)) (minibuffer--add-completions-predicate - (compose #'not fn) + (compf not [fn]) (propertize (concat "-(" desc ")") 'negated (cons desc fn))))) (user-error "`%s' is not a description of a current predicate" desc)) ;; Negate the entire predicate. @@ -6724,8 +6724,8 @@ action instead." (setq dir (file-name-as-directory (expand-file-name dir))) (dired-noselect (cons dir - (mapcar (compose (lambda (file) (file-relative-name file dir)) - #'directory-file-name) + (mapcar (compf (lambda (file) (file-relative-name file dir)) + directory-file-name) (seq-filter #'file-exists-p (mapcar (lambda (file) (expand-file-name file dir)) files)))))) diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index a976c4fa8a4..4294edf4540 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -347,7 +347,7 @@ messages. Results will be put into the default search file." "Use a saved search for querying Mairix." (interactive) (let* ((completions - (mapcar (lambda (el) (list (car el))) mairix-saved-searches)) + (mapcar (compf list car) mairix-saved-searches)) (search (completing-read "Name of search: " completions)) (query (assoc search mairix-saved-searches)) (folder (nth 2 query))) diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index a86dc9f1be0..4632b3c3fe6 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -535,7 +535,7 @@ see its function help for a description of the format." (shell-command-to-string (concat program " list --all -q"))) ;; Ignore header line. (lines (cdr (split-string raw-list "\n"))) - (first-words (mapcar (lambda (line) (car (split-string line))) + (first-words (mapcar (compf car split-string) lines)) (machines (seq-take-while (lambda (name) name) first-words))) (mapcar (lambda (m) (list nil m)) machines)))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index b907df2433b..c5e7cb38e72 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -1051,9 +1051,7 @@ completion from lists of common args and values." (header-arg (or header-arg (completing-read "Header Arg: " - (mapcar - (lambda (header-spec) (symbol-name (car header-spec))) - headers)))) + (mapcar (compf symbol-name car) headers)))) (vals (cdr (assoc (intern header-arg) headers))) (value (or value (cond @@ -2185,7 +2183,7 @@ block of the same language as the previous." (mapcar #'symbol-name (delete-dups (append (mapcar #'car org-babel-load-languages) - (mapcar (lambda (el) (intern (car el))) + (mapcar (compf intern car) org-src-lang-modes))))))) (body (delete-and-extract-region (if (org-region-active-p) (mark) (point)) (point)))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index c6c040e8c3a..056e8718d3a 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -10805,7 +10805,7 @@ The prefix arg is passed through to the command if possible." "[S]catter [f]unction " (and org-agenda-bulk-custom-functions (format " Custom: [%s]" - (mapconcat (lambda (f) (char-to-string (car f))) + (mapconcat (compf char-to-string car) org-agenda-bulk-custom-functions ""))))) (catch 'exit diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index fa82b1ae4a0..f2439d78176 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -949,7 +949,7 @@ details." "Summary: " (delete-dups (cons '("") ;Allow empty operator. - (mapcar (lambda (x) (list (car x))) + (mapcar (compf list car) (append org-columns-summary-types org-columns-summary-types-default)))) diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index 8fdd968264e..1f7dd158b80 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -383,7 +383,7 @@ This needs more work, to handle headings with lots of spaces in them." (let ((lst (pcomplete-uniquify-list (or (remq nil - (mapcar (lambda (x) (org-string-nw-p (car x))) + (mapcar (compf org-string-nw-p car) org-current-tag-alist)) (mapcar #'car (org-get-buffer-tags)))))) (dolist (tag (org-get-tags nil t)) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 534cf93107b..400d0b3b332 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -6012,7 +6012,7 @@ information." ;; Call costly `org-export-table-cell-address' only if ;; absolutely necessary, i.e., if one ;; of :fmt :efmt :hfmt has a "plist type" value. - ,(and (cl-some (lambda (v) (integerp (car-safe v))) + ,(and (cl-some (compf integerp car-safe) (list efmt hfmt fmt)) '(1+ (cdr (org-export-table-cell-address cell info)))))) (when contents diff --git a/lisp/org/org.el b/lisp/org/org.el index c2b80b18fab..71bd0d423c9 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9149,7 +9149,7 @@ block can be inserted by pressing TAB after the string \" (cl-second a) (cl-second b))))) (decipher-insert-frequency-counts freq-list total-chars) ;; Display letters in order of frequency: - (insert ?\n (mapconcat (lambda (a) (char-to-string (car a))) + (insert ?\n (mapconcat (compf char-to-string car) freq-list nil) "\n\n") ;; Display list of digrams in order of frequency: diff --git a/lisp/proced.el b/lisp/proced.el index 30717d87f10..600188282fc 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1250,7 +1250,7 @@ PPID is a parent PID. PID1, PID2, ... are the child processes of PPID. The children alist inherits the sorting order of PROCESS-ALIST. The list of children does not include grandchildren." ;; The PPIDs inherit the sorting order of PROCESS-ALIST. - (let ((process-tree (mapcar (lambda (a) (list (car a))) process-alist)) + (let ((process-tree (mapcar (compf list car) process-alist)) ppid) (dolist (process process-alist) (setq ppid (cdr (assq 'ppid (cdr process)))) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 22279744841..99c70a09e4a 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -648,7 +648,8 @@ be used instead. (add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t) (add-hook 'refactor-backend-functions #'elisp-refactor-backend nil t) - (add-hook 'context-menu-functions #'elisp-context-menu 10 t)) + (add-hook 'context-menu-functions #'elisp-context-menu 10 t) + (alist-set "compf" prettify-symbols-alist ?∘ #'equal)) ;; Font-locking support. @@ -2468,9 +2469,9 @@ for each element of ARGS." (pcase (read (current-buffer)) (`(,(and head (pred symbolp)) . ,tail) (list (symbol-name head) - (mapcar (compose + (mapcar (compf (apply-partially #'concat "arg") - #'number-to-string) + number-to-string) (number-sequence 1 (length tail))))) (_ (rec (cdr ps)))))))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 4a9090ffe92..fb751085583 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -835,7 +835,7 @@ Return to original margin width if ORIG-WIDTH is non-nil." (cl-sort (mapcar (lambda (o) (overlay-get o 'flymake-diagnostic)) src-ovs) #'> - :key (lambda (d) (flymake--severity (flymake-diagnostic-type d))))) + :key (compf flymake--severity flymake-diagnostic-type))) (summary (concat " " diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 6c36d08c9ee..9e20e33ce88 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3382,8 +3382,8 @@ class of the file (using s to separate nested class ids)." ;; Syntax-symbol returns the symbol of the *first* element ;; in the syntactical analysis result list, syntax-point ;; returns the buffer position of same - (syntax-symbol (lambda (x) (c-langelem-sym (car x)))) - (syntax-point (lambda (x) (c-langelem-pos (car x))))) + (syntax-symbol (compf c-langelem-sym car)) + (syntax-point (compf c-langelem-pos car))) (setq f (file-name-sans-extension (file-truename f))) ;; Search through classpath list for an entry that is ;; contained in f diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index d55789d1f58..4a6af60852f 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -2812,7 +2812,7 @@ With optional prefix argument ARG, also hide the #ifdefs themselves." "Set `hide-ifdef-env' to the define list specified by NAME." (interactive (list (completing-read "Use define list: " - (mapcar (lambda (x) (symbol-name (car x))) + (mapcar (compf symbol-name car) hide-ifdef-define-alist) nil t))) (if (stringp name) (setq name (intern name))) diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 91c6a3f038b..d14c7b2384c 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -1069,7 +1069,7 @@ EXECUTION-TIME holds info about the time it takes, number or string.") (defvar mixal-font-lock-keywords `(("^\\([A-Z0-9a-z]+\\)" (1 mixal-font-lock-label-face)) - (,(regexp-opt (mapcar (lambda (x) (symbol-name (car x))) + (,(regexp-opt (mapcar (compf symbol-name car) mixal-operation-codes-alist) 'words) . mixal-font-lock-operation-code-face) (,(regexp-opt mixal-assembly-pseudoinstructions 'words) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index d9b3c26a70c..7b101b702df 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1658,7 +1658,7 @@ code line." (define-button-type 'octave-help-function 'follow-link t - 'action (lambda (b) (octave-help (button-label b)))) + 'action (compf octave-help button-label)) (defvar octave-help-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index c2a2cab94ca..6c71320ae24 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1785,9 +1785,7 @@ With some possible metadata (to be decided).") (read (current-buffer)) (end-of-file (warn "Failed to read the projects list file due to unexpected EOF"))))))) - (unless (seq-every-p - (lambda (elt) (stringp (car-safe elt))) - project--list) + (unless (seq-every-p (compf stringp car-safe) project--list) (warn "Contents of %s are in wrong format, resetting" project-list-file) (setq project--list nil)))) @@ -1816,7 +1814,7 @@ With some possible metadata (to be decided).") (defsubst project--update-roots-cache () (setq project--roots-cache - (mapcar (compose #'expand-file-name #'car) project--list))) + (mapcar (compf expand-file-name car) project--list))) (defun project--remember-dir (root &optional no-write) "Add project root ROOT to the front of the project list. diff --git a/lisp/progmodes/refactor.el b/lisp/progmodes/refactor.el index c4fc2ec5f8c..24e8bdf2d65 100644 --- a/lisp/progmodes/refactor.el +++ b/lisp/progmodes/refactor.el @@ -152,7 +152,7 @@ operations that BACKEND supports.") (defun refactor-completing-read-operation (operations) (intern (completing-read "Refactor operation: " - (mapcar (compose #'symbol-name #'cadr) + (mapcar (compf symbol-name cadr) operations) nil t))) @@ -375,7 +375,7 @@ argument is the token corresponding to that text replacement.") (defun refactor-query-apply-edits (edits) "Suggest applying each edit in EDITS in turn." - (let ((change-group (mapcan (compose #'prepare-change-group #'car) edits)) + (let ((change-group (mapcan (compf prepare-change-group car) edits)) (undo-outer-limit nil) (undo-limit most-positive-fixnum) (undo-strong-limit most-positive-fixnum) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 2fb8c260800..7a745c380b6 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2374,8 +2374,7 @@ whose value is the shell name (don't quote it)." ;; Maybe there could be a separate variable that lists ;; the shells, used here and to construct i-mode-alist. ;; But the following is probably good enough: - (append (mapcar (lambda (e) (symbol-name (car e))) - sh-ancestor-alist) + (append (mapcar (compf symbol-name car) sh-ancestor-alist) '("csh" "rc" "sh")) nil nil nil nil sh-shell-file) (eq executable-query 'function) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index d897f77e865..8c9d5242ef1 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2666,7 +2666,7 @@ Optional argument DEFAULT is the default minibuffer argument." (format-prompt prompt default) (completion-table-dynamic (lambda (&rest _) - (mapcar (compose #'symbol-name #'car) sql-product-alist))) + (mapcar (compf symbol-name car) sql-product-alist))) nil t nil 'sql-product-history default))) (defun sql-add-product (product display &rest plist) @@ -4301,7 +4301,7 @@ is specified in the connection settings." "Connection: " (completion-table-dynamic (lambda (&rest _) - (mapcar (compose #'symbol-name #'car) + (mapcar (compf symbol-name car) sql-connection-alist))) nil t nil 'sql-connection-history) current-prefix-arg) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index eb3c0d51b08..c94dfd72c4c 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -175,7 +175,7 @@ doing an update." :type 'sexp) ;;;###autoload (put 'which-func-format 'risky-local-variable t) -(defvar which-func-imenu-joiner-function (lambda (x) (car (last x))) +(defvar which-func-imenu-joiner-function (compf car last) "Function to join together multiple levels of imenu nomenclature. Called with a single argument, a list of strings giving the names of the menus we had to traverse to get to the item. Returns a diff --git a/lisp/register.el b/lisp/register.el index fe8dbe11000..34e8221e17d 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -512,7 +512,7 @@ Second argument VERBOSE means produce a more detailed description." (save-window-excursion (set-window-configuration stored-window-config) (concat - (mapconcat (lambda (w) (buffer-name (window-buffer w))) + (mapconcat (compf buffer-name window-buffer) (window-list (selected-frame)) ", ") (unless (eq current-frame window-config-frame) " in another frame")))) diff --git a/lisp/simple.el b/lisp/simple.el index 8f9216d2cc2..64ca5e09111 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -454,7 +454,7 @@ where `next-error-function' is bound to an appropriate function." (interactive (list (get-buffer (read-buffer "Select next-error buffer: " nil nil - (lambda (b) (next-error-buffer-p (cdr b))))))) + (compf next-error-buffer-p cdr))))) (setq next-error-last-buffer buffer)) (defalias 'goto-next-locus 'next-error) @@ -10402,7 +10402,7 @@ after it has been set up properly in other respects." (setting-constant nil))) ;E.g. for enable-multibyte-characters. lvars) - (setq mark-ring (mapcar (lambda (mk) (copy-marker (marker-position mk))) + (setq mark-ring (mapcar (compf copy-marker marker-position) mark-ring)) ;; Run any hooks (typically set up by the major mode @@ -11238,7 +11238,7 @@ particular action on the input you type there." (unless (assq (car plist) alist) (push (cons (car plist) "") alist)) (setq plist (cddr plist))) - (mapcar (compose #'symbol-name #'car) alist)) + (mapcar (compf symbol-name car) alist)) '((category . text-property) (affixation-function . read-text-property-affixation))) nil nil nil diff --git a/lisp/subr.el b/lisp/subr.el index 5b224b1fc67..403177f048e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -192,6 +192,39 @@ pair. (setq pairs (cdr (cdr pairs)))) (macroexp-progn (nreverse expr)))) +(defmacro compf (&rest funs) + "Expand to the function composition of FUNS, outermost function first. + +For example, (compf car cdr) expands to (lambda (x) (car (cdr x))), +which does the same as `cadr'. + +FUNS may contain symbols which refer to functions, such as `car' and +`cdr' in the example above, and it can also contain `lambda' functions +and other forms which evaluate to function values. To refer to a local +variable VAR that is bound to a function, wrap VAR in a vector, as in: + + (let ((foo (lambda (...) ...))) + (compf ignore [foo] always)) + +If FUNS is empty, expand to `identity'." + (cond + ((null funs) '#'identity) + ((length= funs 1) + (let ((fun (car funs))) + (cond + ((symbolp fun) `#',fun) ; Function name. + ((vectorp fun) (aref fun 0)) ; Local variable reference. + (t fun)))) ; `lambda' and other forms. + (t + (let* ((x (gensym "x")) (arg x)) + (dolist (fun (reverse funs)) + (setq arg + (cond + ((symbolp fun) `(,fun ,arg)) + ((vectorp fun) `(funcall ,(aref fun 0) ,arg)) + (t `(funcall ,fun ,arg))))) + `(lambda (,x) ,arg))))) + (defmacro defvar-local (var val &optional docstring) "Define VAR as a buffer-local variable with default value VAL. Like `defvar' but additionally marks the variable as being automatically @@ -6044,7 +6077,7 @@ command is called from a keyboard macro?" ;; Now `frame' should be "the function from which we were called". (pcase (cons frame nextframe) ;; No subr calls `interactive-p', so we can rule that out. - (`((,_ ,(pred (lambda (f) (subr-primitive-p (indirect-function f)))) . ,_) . ,_) nil) + (`((,_ ,(pred (compf subr-primitive-p indirect-function)) . ,_) . ,_) nil) ;; In case # without going through the ;; `funcall-interactively' symbol (bug#3984). (`(,_ . (t ,(pred (lambda (f) @@ -7094,16 +7127,6 @@ and return the value found in PLACE instead." ,(funcall setter val) ,val))))) -(defun compose (&rest funs) - "Return the function composition of FUNS. - -For example, (compose #\\='car #\\='car #\\='cdr) returns a function -that does the same thing as `caadr'." - (if funs - (lambda (x) - (funcall (car funs) (funcall (apply #'compose (cdr funs)) x))) - #'identity)) - (defsubst plusp (number) "Return t if NUMBER is positive." (> number 0)) (defsubst minusp (number) "Return t if NUMBER is negative." (< number 0)) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index a7930bb3c8f..e42f26989fe 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -2064,7 +2064,7 @@ Does not do a `save-excursion'." (defun reftex-index-select-phrases-macro (&optional delay) "Offer a list of possible index macros and have the user select one." (let* ((prompt (concat "Select macro: [" - (mapconcat (lambda (x) (char-to-string (car x))) + (mapconcat (compf char-to-string car) reftex-index-phrases-macro-data "") "] ")) (help (concat "Select an indexing macro\n========================\n" diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 4a4c4df4c58..3ac20a0dcfc 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -866,7 +866,7 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." (reftex-this-word "-a-zA-Z0-9_*.:"))) (label (completing-read (format-prompt "Label" default) docstruct - (lambda (x) (stringp (car x))) t nil nil + (compf stringp car) t nil nil default)) (selection (assoc label docstruct)) (where (progn diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 5618aae9535..43960b99d68 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -980,7 +980,7 @@ This enforces rescanning the buffer on next use." (lambda (a b) (< (downcase (car a)) (downcase (car b)))))) (setq reftex-query-index-macro-prompt (concat "Index macro: [" - (mapconcat (lambda (x) (char-to-string (car x))) + (mapconcat (compf char-to-string car) reftex-key-to-index-macro-alist "") "]")) (setq i 0 @@ -1017,7 +1017,7 @@ This enforces rescanning the buffer on next use." "\\)[{ \t]+\\([^} \t\n\r]+\\)")) (section-re (concat wbol reftex-section-pre-regexp "\\(" - (mapconcat (lambda (x) (regexp-quote (car x))) + (mapconcat (compf regexp-quote car) reftex-section-levels-all "\\|") "\\)" reftex-section-post-regexp)) (appendix-re (concat wbol "\\(\\\\appendix\\)")) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 531c7e6a9f5..78fb2f7d126 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2252,7 +2252,7 @@ of the current buffer." (defun tex-summarize-command (cmd) (if (not (stringp cmd)) "" (mapconcat #'identity - (mapcar (lambda (s) (car (split-string s))) + (mapcar (compf car split-string) (split-string cmd "\\s-*\\(?:;\\|&&\\)\\s-*")) "&"))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 54914bfd663..74a4d631e79 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1006,7 +1006,7 @@ If a prefix argument is given, ignore all marked files." (defun vc-dir-marked-files () "Return the list of marked files." (mapcar - (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem))) + (compf expand-file-name vc-dir-fileinfo->name) (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked))) (defun vc-dir-marked-only-files-and-states () @@ -1443,8 +1443,7 @@ These are the commands available for use in the file status buffer: (intern (completing-read "Use VC backend: " - (mapcar (lambda (b) (list (symbol-name b))) - vc-handled-backends) + (mapcar (compf list symbol-name) vc-handled-backends) nil t nil nil))))) (unless backend (setq backend (vc-responsible-backend dir))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 5652ceb84a9..72057180a15 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1397,8 +1397,7 @@ from which to check out the file(s)." (revision-downcase (downcase revision))) (if (member revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) - vc-handled-backends)) + (mapcar (compf downcase symbol-name) vc-handled-backends)) (let ((vsym (intern-soft revision-downcase))) (dolist (file files) (vc-transfer-file file vsym))) (dolist (file files) @@ -1457,8 +1456,7 @@ from which to check out the file(s)." (revision-downcase (downcase revision))) (if (member revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) - vc-handled-backends)) + (mapcar (compf downcase symbol-name) vc-handled-backends)) (let ((vsym (intern revision-downcase))) (dolist (file files) (vc-transfer-file file vsym))) (vc-checkin ready-for-commit backend nil nil revision))))))) diff --git a/lisp/window.el b/lisp/window.el index 88c569f684d..dac3a35f328 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5444,7 +5444,7 @@ BUFFER-OR-NAME from all window-local buffer lists and removes any (t (bury-buffer-internal buffer))))) (put 'quit-windows-on 'minibuffer-action - (cons (lambda (b) (save-selected-window (quit-windows-on b))) + (cons (compf save-selected-window quit-windows-on) "quit windows showing buffer")) -- 2.39.5