New macro 'compf'

diff --git a/lisp/bindings.el b/lisp/bindings.el
index 763897cf5dd155774107917821cb5710c2ecddba..e509b5e8b5724d9c32819bae4e53f084282c68ed 100644 (file)
--- 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 1ca6bb7dca23f436ad65127f57880223bf417c84..2da2a930672703318f135e30811f3482106dc6ff 100644 (file)
--- 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 fd15f155b9b79af36706893cfa4f68070a6d0623..073d04e7707fde42ad2c79108b48c301992eb050 100644 (file)
--- 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 1ee2aac662b3d92466ff6ae6baf4c378f56c5dac..5305607d31523a2fa3b3a74a57fdfa0a1e251b7d 100644 (file)
--- 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 2ce2c45b51b7303bd9aa1b5a47bbd62b4c090b9f..48ea56ba84ee1c0bfb157b8ab700b27302f519d4 100644 (file)
--- 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 baad3242cbde679ac4313456fec7b9ffae2ad87b..acf92866bdbf46c348c82f023662364eee175e0c 100644 (file)
--- 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 0c72ed708639fabfaa851984eeb8b897cf370ec8..10b406cce961cb0d91977e476f7133161784767f 100644 (file)
--- 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 f5a5f9f5ca4609ab52610f07e240b61ad12389df..5d0711d26dcba784fe723dfd0acc99adc7452fb4 100644 (file)
--- 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 9631f9f633fab6202cae52999146f352379963d4..05be9fc178c58223442e2f66809d9d2e22a3ffc9 100644 (file)
--- 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 0c72f9625db2f2cb20afbfc05728e61eea566862..83909c300a57129f8495cea845467b64d0c7098c 100644 (file)
--- 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 e9c55494e3e3ced6960590fdf498832f763f59cc..efd9f1f604faab089664f6ca2351226f8bc9dff7 100644 (file)
--- 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 2a01501f99eda97d1a6cbb9789a24c15a545dd61..5c45dc7a75d6198429b05034253f1e287eb67327 100644 (file)
--- 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 a6fdf5cad6be965c1b3dc67fe34011dfd62015d2..9ec4c51a3fac3618373a6a2be6300303f6b712a9 100644 (file)
--- 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 3ab505301d7f2b29dc52b4db573d8adf246e78fe..3ad91aea6f7ee7dbdb3b58644ebca611aa996950 100644 (file)
--- 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 f7a153371dd9a07b34974cd11fa851f5627256ec..39f2c05f12506bb92279f49da88e1715e6940aa7 100644 (file)
--- 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 150332c4c5da3b5c389eba07619e1ab0cb671f3e..14a0cacad24e13be961844ecf7c6e3fd92543c0f 100644 (file)
--- 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 6b4f6c55d7b7a26102af909c31105eecbd485768..ce01b2a49b5f83b6c21bda9eca5a7613a94ab622 100644 (file)
--- 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 e49e2828343226f28455cde6bcdab48131a1ba29..4a5bcbe3fe348066ff11794a425a6ed078a43ef0 100644 (file)
--- 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 288f7e224d71a6c40aa65f38218dee837cf53d53..0095727a494d21cbc236250ccf06e5f748f28438 100644 (file)
--- 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 fc2245e98311406f2918e72cd6c0038aaf2640c7..e75c3ef176adb52293641cb3ee6c257c3b2ea142 100644 (file)
--- 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 6956467dbec945bffd890e71985a6bce96a36b36..445c730fbdbba33b9e7ac2bec4d85c8ccc4328b5 100644 (file)
--- 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 f61e8bcfa1ca38c5db5760f7f8adc3d0961c2ee2..5c75209bfd8239b668a972c8cee9e553598715fa 100644 (file)
--- 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 65f9d92d45b4964779c8033f877d765703c741a2..1761880c2ad250106b417f0fbdb90af6b87dbd46 100644 (file)
--- 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 d42ab6b0b5be10e7a9feae134dbd2b803be3417c..2aca30e0c1aa98233f8af9b6d2ed984fe92e7f08 100644 (file)
--- 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 9156b7f5a1c71dc47fb4aa275b06879c605688ca..1f246bbabf0f329c29aab9d27b6962465a3a7728 100644 (file)
--- 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 350d0c1a224425f9a0ee2e000c7e246ad58b5121..e7f09844062136bb39e1c171e8dba7be1497e555 100644 (file)
--- 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 6ee9a49a8e4e84ac7551514b7f6b7dd4bcf51d46..642a051e490c43bb8cc1e2baf277433f8e3145dc 100644 (file)
--- 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 1c607628bcd5a3a21cdd14c1e1506228ce6f9ae0..29e862d09e6474cfed7b39b3fe713a081dfb6b33 100644 (file)
--- 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 6ae5985cf8fe2b0e19d62b705037c7c3729d9043..b4430a813ecbde5f1af97cddecfd280662c1c1a5 100644 (file)
--- 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 d1dcdf184c45916e5839546581b4d4a06e32d46b..7305b8d789237c2524202556a1b64f046e3f64f5 100644 (file)
--- 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 a647ad8f7daa2cf71ae130f7fda5fd46f26427a5..4ced3fb1b94d9efc395fb6c57fb0c8ecb4c635bb 100644 (file)
--- 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 47cda0a50cffe993e3a16a1febb87e74d34ac440..059040b64ee6b9a779c0e7e4eabdf836723533d9 100644 (file)
--- 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 e0c73cb576076dc926780653df03efc863657746..e089fc80c38ffc09131831ca784a197f26408cea 100644 (file)
--- 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 2f28df449688cf3cac4ecd315cfeb9e35822bc9b..48902a9f5c87128e115365c2fe1abe90d061ebf0 100644 (file)
--- 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 784f54ccbb87424704976debb8da50883d572a11..63b8fba9fba979b6ef7d7e58184bafb357a41fe8 100644 (file)
--- 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 daa55b14b87ae92ae9c1bca570ab2271e511782a..84e173df79e717beddc8de95f14ae1b85f0319b2 100644 (file)
--- 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 251080a4784aecd441446b68b88de14d85049729..1940953e9ebae58b989789181c0704729e0aa80c 100644 (file)
--- 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 db0510c7e84dfda01b813be2d4ed8efb99edb6b8..c9855ce95285f1316a902739e83cc12ceba091b1 100644 (file)
--- 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 3df7c5e5b8955bfc03745e86c36f496ddee5cc63..51475723620042b34b32cb8a00b43fb3fd78e475 100644 (file)
--- 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 969171022edf76a3e3f611a8c8f794ebc95c5076..f05fc934da9fcfcd19dbcee5277601b5b68b6773 100644 (file)
--- 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 a976c4fa8a4c01ea2eeed2d69f89f2dffe53c855..4294edf4540cc304e9a91bc5ec40fda53fce4859 100644 (file)
--- 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 a86dc9f1be0e564dd9d17de4c4fc2ed3e19f7980..4632b3c3fe6f4eaf821b82a4ba9d80bd1c3c6594 100644 (file)
--- 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 b907df2433bdf236b49c0de2ae4de58c14c5cfc9..c5e7cb38e72b60589db788d3df6e20df1cebfd24 100644 (file)
--- 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 c6c040e8c3a657a9e31ac8bfcde88634b4b4d4f9..056e8718d3ac04225cdb32126cedf5556c63088e 100644 (file)
--- 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 fa82b1ae4a0b55cd42cdc56c4965ba82dc332a47..f2439d7817608bfd87fd2c2884acb8a750c1b44d 100644 (file)
--- 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 8fdd968264e5249978acceee37686de5534c43a1..1f7dd158b8018a57b0e8ad0f91e72d95c96c230e 100644 (file)
--- 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 534cf93107b8d0b13dfff3133713a5b88cb86b71..400d0b3b332d3067480c6b9089137a3e59d9d2a1 100644 (file)
--- 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 c2b80b18fab3ec80089eab6bc5483c755f6df0f9..71bd0d423c93e37c7b5075b4a8e7b654335292ac 100644 (file)
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -9149,7 +9149,7 @@ block can be inserted by pressing TAB after the string \"<KEY\"."
   "Check whether `org-structure-template-alist' is set up correctly.
 In particular, check if the Org 9.2 format is used as opposed to
 previous format."
-  (let ((elm (cl-remove-if-not (lambda (x) (listp (cdr x)))
+  (let ((elm (cl-remove-if-not (compf listp cdr)
                               (or (symbol-value checklist)
                                   org-structure-template-alist))))
     (when elm
@@ -12074,7 +12074,7 @@ FLAG specifies the type of completion operation to perform.  This
 function is passed as a collection function to `completing-read',
 which see."
   (let ((completion-ignore-case nil)   ;tags are case-sensitive
-       (confirm (lambda (x) (stringp (car x))))
+       (confirm (compf stringp car))
        (prefix "")
         begin)
     (when (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)

diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index 10db3b62a277d16d029be85eee76871fdd352a70..d94cced4a968f276d7e07cd27bff9d6d38a1f0e9 100644 (file)
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -1983,7 +1983,7 @@ INFO is a plist used as a communication channel."
                                   (concat "text/html;charset=" charset)))
 
      (let ((viewport-options
-           (cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell)))
+           (cl-remove-if-not (compf org-string-nw-p cadr)
                              (plist-get info :html-viewport))))
        (if viewport-options
           (org-html--build-meta-entry "name" "viewport"

diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index bb9e0bd2e303f511a5d3e4e09ff34a6091bc0d75..ab59d3d8feca62fa96d5c6a0bc5c5198e6b42240 100644 (file)
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -1144,7 +1144,7 @@ This function is meant to be used as a final output filter.  See
    ;; cells.  Actually used references are extracted from
    ;; `:internal-references', with references as strings removed.  See
    ;; `org-export-get-reference' for details.
-   (cl-remove-if (lambda (pair) (stringp (car pair)))
+   (cl-remove-if (compf stringp car)
                 (plist-get info :internal-references)))
   ;; Return output unchanged.
   output)

diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index ac001697ff28905452e2b92578930cebf2a3c2a1..4baee6434939a84cda14c1e8977d8038aaf49746 100644 (file)
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -895,7 +895,7 @@ Creates the statistics buffer if it doesn't exist."
                             (lambda (a b) (> (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 30717d87f108e5c8ab1661a513c77d7125d39c3d..600188282fcdde12a3ff0f6a8419038f8f25aba2 100644 (file)
--- 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 2227974484199ce9b9b39f124499f44f63212014..99c70a09e4af4f5df35d1f1af94fa36b428af98d 100644 (file)
--- 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 4a9090ffe92077647eb10cb2bd6657e67c1bd304..fb751085583f3bfeec74af5d2b7e1304543cfe1b 100644 (file)
--- 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 6c36d08c9ee29a1f3eee8c4d3064d57b643822c2..9e20e33ce885c85c740d390567e56fbac37cce7c 100644 (file)
--- 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 d55789d1f588f1ea34afd0f6cb2c37723d2d4f3f..4a6af60852f5b4492472dc4a6842751579cdf2fc 100644 (file)
--- 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 91c6a3f038be108cd81cf4275928ccb501f21e43..d14c7b2384c2edfd07b7ba132cefb20f1e1e8882 100644 (file)
--- 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 d9b3c26a70c5339a8e4e40f0cbd968d874c0bb08..7b101b702df931da5bf2bdd43d3cf40260dbb97e 100644 (file)
--- 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 c2a2cab94cadf3063b407ebc3030fba3a58e5747..6c71320ae245593bc97e2f85bcf3e55108f53c03 100644 (file)
--- 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 c4fc2ec5f8cf85371f36e6258bc5ce1560625cad..24e8bdf2d650d3100b52bd0baa921f8121e326db 100644 (file)
--- 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 2fb8c2608009524b9f1763f6589acb516cc71f19..7a745c380b6314fb7081265fe7e7edee869717e9 100644 (file)
--- 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 d897f77e8654e404991065c5e46ae227408c9929..8c9d5242ef1b4ac37b052b76aa1a2bca66126dbd 100644 (file)
--- 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 eb3c0d51b08a13b66fa2cf285c0895e993b635ae..c94dfd72c4c992619f862ca56893c0efd7c2606b 100644 (file)
--- 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 fe8dbe110002e49350bf28deb3249805dce317d1..34e8221e17de4ad8fd176fd6e16561c32bcec31f 100644 (file)
--- 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 8f9216d2cc28d2b8552e8f8eb5f3ad065ef9a409..64ca5e091116f6a1aa8c1a426f575b0926833b42 100644 (file)
--- 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 5b224b1fc6785d528fc6c973fd4d240a02dfa066..403177f048edf812eced3675dabe7bd523c58f57 100644 (file)
--- 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 #<subr funcall-interactively> 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 a7930bb3c8f7bbb787ff12f7fe01db414866ccff..e42f26989fecef49ab11989c71117563d722c324 100644 (file)
--- 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 4a4c4df4c5854341711de8010d34a159ac02e5a3..3ac20a0dcfc7a9347187288a96d0101ebf49eba3 100644 (file)
--- 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 5618aae953514b36882fb53f684825b607e161ff..43960b99d68a74ee226ea51c6f3e573507a215c0 100644 (file)
--- 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 531c7e6a9f5a8b7e0aa430db539f7e3efd55aa88..78fb2f7d1261b08c5f2d81f1e2b70069ec14f575 100644 (file)
--- 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 54914bfd6638f09434cb489767f60e391b04cf84..74a4d631e79b4a0d56ad081eadfa9031208a652b 100644 (file)
--- 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 5652ceb84a9aadc5b20aff48e77e468b93c89e14..72057180a15670690782dd3d52b125dcaa4db840 100644 (file)
--- 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 88c569f684d9ee0a15a1c1797b656a53a3e72e6c..dac3a35f328b7bfea30bfb22ef1c38f1316b36af 100644 (file)
--- 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"))
 
 \f