]> git.eshelyaron.com Git - emacs.git/commitdiff
; Simplify many 'sort' invocations using new interface
authorEshel Yaron <me@eshelyaron.com>
Sat, 30 Mar 2024 09:08:07 +0000 (10:08 +0100)
committerEshel Yaron <me@eshelyaron.com>
Sat, 30 Mar 2024 13:45:09 +0000 (14:45 +0100)
39 files changed:
lisp/abbrev.el
lisp/allout-widgets.el
lisp/autoinsert.el
lisp/bindings.el
lisp/bookmark.el
lisp/bs.el
lisp/calc/calc-aent.el
lisp/calc/calc-ext.el
lisp/calc/calc-forms.el
lisp/calc/calc-graph.el
lisp/calc/calc-help.el
lisp/calc/calc-map.el
lisp/calc/calc-poly.el
lisp/calc/calc-prog.el
lisp/calc/calc-rewr.el
lisp/calc/calc-units.el
lisp/calc/calcalg3.el
lisp/calendar/appt.el
lisp/calendar/icalendar.el
lisp/calendar/todo-mode.el
lisp/cedet/ede/pmake.el
lisp/cedet/semantic/chart.el
lisp/cedet/semantic/edit.el
lisp/cedet/semantic/find.el
lisp/cedet/semantic/sort.el
lisp/cedet/semantic/util.el
lisp/comint.el
lisp/cus-dep.el
lisp/cus-edit.el
lisp/dabbrev.el
lisp/dired-aux.el
lisp/dnd.el
lisp/emacs-lisp/byte-run.el
lisp/emacs-lisp/cl-generic.el
lisp/emacs-lisp/comp-cstr.el
lisp/emacs-lisp/eieio-opt.el
lisp/emacs-lisp/eldoc.el
lisp/emacs-lisp/ert.el
lisp/subr.el

index 188eeb720c07528c05c7dcec4638ed6c17183c8f..4be54c4a19300feeca3fb2477acf96fd66cef921 100644 (file)
@@ -261,10 +261,7 @@ abbrevs have been saved."
               ;; user keeps their home directory in a revision
               ;; control system, and therefore keeps multiple
               ;; slightly-differing loosely synchronized copies.
-              (sort (copy-sequence abbrev-table-name-list)
-                    (lambda (s1 s2)
-                      (string< (symbol-name s1)
-                               (symbol-name s2)))))
+              (sort (copy-sequence abbrev-table-name-list)))
        (if (abbrev--table-symbols table)
             (insert-abbrev-table-description table nil)))
       (when (unencodable-char-position (point-min) (point-max) 'utf-8)
@@ -1158,7 +1155,7 @@ a call to `define-abbrev-table' that, when evaluated, will define
 the abbrev table NAME exactly as it is currently defined.
 Abbrevs marked as \"system abbrevs\" are ignored."
   (let ((symbols (abbrev--table-symbols name readable)))
-    (setq symbols (sort symbols 'string-lessp))
+    (setq symbols (sort symbols))
     (let ((standard-output (current-buffer)))
       (if readable
           (progn
@@ -1247,8 +1244,7 @@ SORTFUN is passed to `sort' to change the default ordering."
                              entries))))
                  table)
     (nconc (make-sparse-keymap prompt)
-           (sort entries (lambda (x y)
-                           (funcall sortfun (nth 2 x) (nth 2 y)))))))
+           (sort entries :key #'caddr :lessp sortfun))))
 
 (defface abbrev-table-name
   '((t :inherit font-lock-function-name-face))
index 7f5831d4124ecc00c2aca7c6d56859bc96525a92..3c7ffa6c8fe881fd73e6a9ddde1472c1be71d8ca 100644 (file)
@@ -964,8 +964,7 @@ Records changes in `allout-widgets-changes-record'."
 
 Generally invoked via `allout-exposure-change-functions'."
 
-  (let ((changes (sort changes (lambda (this next)
-                                 (< (cadr this) (cadr next)))))
+  (let ((changes (sort changes :key #'cadr))
         ;; have to distinguish between concealing and exposing so that, eg,
         ;; `allout-expose-topic's mix is handled properly.
         handled-expose
index 641016fb62241edad576c5081da19f52be2ae3a4..3a87c5610a41f7b25871d5cbddd2916441e9d986 100644 (file)
@@ -176,7 +176,7 @@ If this contains a %s, that will be replaced by the matching rule."
                              (let ((name (symbol-name mode)))
                                (when (string-match "-mode\\'" name)
                                  (push name modes)))))
-                 (sort modes 'string<)))
+                 (sort modes)))
      (completing-read "Local variables for mode: " v1 nil t)
      " . (("
      (let ((all-variables
index d45c561bb65a1d5a3f09694f1e5c2a44626cc69c..34820d70adcbaa36a5512a2cb0739204bf0be08c 100644 (file)
@@ -446,10 +446,8 @@ 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
-                (lambda (a b)
-                  (string< (bindings--menu-item-string (cdr-safe a))
-                           (bindings--menu-item-string (cdr-safe b))))))
+          (sort bindings :key (compose #'bindings--menu-item-string
+                                       #'cdr-safe)))
     (nconc (make-sparse-keymap prompt) bindings)))
 
 (defvar mode-line-major-mode-keymap
index e3feabde5c98782fa134053e7bf4766de4d78648..e8f7117678eeb50e918fe4cb285a9f4d3f30807d 100644 (file)
@@ -549,7 +549,7 @@ copy of the alist.  Otherwise, just return `bookmark-alist', which by default
 is ordered from most recently created to least recently created bookmark."
   (let ((copy (copy-alist bookmark-alist)))
     (cond ((eq bookmark-sort-flag t)
-           (sort copy (lambda (x y) (string-lessp (car x) (car y)))))
+           (sort copy))
           ((eq bookmark-sort-flag 'last-modified)
            (sort copy (lambda (x y)
                         (let ((tx (bookmark-get-last-modified x))
index 9db93ea0423462114014b9d8a00889e33ce14b0f..d6b2d16608f452a6a726e00e03596163adfe3ef7 100644 (file)
@@ -960,8 +960,7 @@ WHAT is a value of nil, `never', or `always'."
   "Set text properties for the sort described by SORT-DESCRIPTION.
 SORT-DESCRIPTION is an element of `bs-sort-functions'.
 Default is `bs--current-sort-function'."
-  (let ((sort-description (or sort-description
-                             bs--current-sort-function)))
+  (let ((sort-description (or sort-description bs--current-sort-function)))
     (save-excursion
       (goto-char (point-min))
       (when (and (nth 2 sort-description)
index a21efc0238d463707bdb9fae9a5ac33d371a52b1..0bc222d9a0388307a4aa7a85a670ada8e9b59593 100644 (file)
@@ -659,9 +659,8 @@ The value t means abort and give an error message.")
            (setq p (cdr p)))
          (setq calc-user-tokens (mapconcat 'identity
                                             (sort (mapcar #'car math-toks)
-                                                  (lambda (x y)
-                                                    (> (length x)
-                                                       (length y))))
+                                                  :key #'length
+                                                  :reverse t)
                                            "\\|")
                calc-last-main-parse-table mtab
                calc-last-user-lang-parse-table ltab
index 191149892a8ef98f82802705ca6ab84a7e2f9bc8..1a9ca69278e5b9da3163f0a68a50553b2a371875 100644 (file)
@@ -1919,8 +1919,7 @@ calc-kill calc-kill-region calc-yank))))
   (interactive)
   (let* ((calc-z-prefix-msgs nil)
         (calc-z-prefix-buf "")
-        (kmap (sort (copy-sequence (calc-user-key-map))
-                     (lambda (x y) (< (car x) (car y)))))
+        (kmap (sort (copy-sequence (calc-user-key-map))))
         (flags (apply #'logior
                        (mapcar (lambda (k)
                                  (calc-user-function-classify (car k)))
index c5d050444e3df23ef0ba017c16b3a89dc9c948e3..cd261832dc45f97373e747809f222ae336d8287d 100644 (file)
@@ -1994,7 +1994,7 @@ and ends on the last Sunday of October at 2 a.m."
        (setq math-holidays-cache (list (list -1)  ; 0: days list
                                        (list -1)  ; 1: inverse-days list
                                        nil        ; 2: exprs
-                                       (sort weekdays '<)
+                                       (sort weekdays)
                                        (or limit '(intv 3 1 2737))
                                        nil        ; 5: (lo.hi) expanded years
                                        (cons exprs days)
index fb817b1bc3dea5f070d0ac4522feb66a06caf8af..c355b37346cbda6fbcb57dd6b2b8b80adac63ba3 100644 (file)
        (let ((math-arglist nil))
          (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
          (calc-default-formula-arglist calc-graph-yvalue)
-         (setq math-arglist (sort math-arglist 'string-lessp))
+         (setq math-arglist (sort math-arglist))
          (or (cdr math-arglist)
              (error "%s does not contain enough unassigned variables" calc-graph-yname))
          (and (cdr (cdr math-arglist))
index 6ba49137b73353263c537b8801a52c1a13aac931..9f7a222340eab1c8e5957ca4f2a33d4187f671d4 100644 (file)
                          (while (string-match "," notes)
                            (aset notes (match-beginning 0) ? ))
                          (setq notes (sort (car (read-from-string
-                                                 (format "(%s)" notes)))
-                                           '<))
+                                                 (format "(%s)" notes)))))
                          (with-output-to-temp-buffer "*Help*"
                            (princ (format "%s\n\n" msg))
                            (set-buffer "*Calc Summary*")
index f8dad435c757a535025ea8d7c89da731bbd51a01..b1716d0b1006e86e32a1679b56e44fe6c27f0bfe 100644 (file)
                     (progn
                       (calc-default-formula-arglist expr)
                       (setq record-entry t
-                            math-arglist (sort math-arglist 'string-lessp))
+                            math-arglist (sort math-arglist))
                       (if calc-verify-arglist
                           (setq math-arglist (read-from-minibuffer
                                          "Function argument list: "
index c5a7ee66cc8a811b83c39e13e1721b247d6f9edd..2e148bfbc6d59194aacd8c36fc4ec08757790dcd 100644 (file)
   "Sort the terms of a sum into canonical order."
   (if (memq (car-safe expr) '(+ -))
       (math-list-to-sum
-       (sort (math-sum-to-list expr)
-             (lambda (a b) (math-beforep (car a) (car b)))))
+       (sort (math-sum-to-list expr) :key #'car :lessp #'math-beforep))
     expr))
 
 (defun math-list-to-sum (lst)
index 8dff7f1f264295560ec29b124ba14398fee5579b..d5430203a72f1f18ea8795947d7065de4b9dd7f3 100644 (file)
                               (nreverse (cdr (reverse (cdr form)))))
               form (nth (1- (length form)) form))
        (calc-default-formula-arglist form)
-       (setq math-arglist (sort math-arglist 'string-lessp)))
+       (setq math-arglist (sort math-arglist)))
      (message "Define user key: z-")
      (setq key (read-char))
      (if (= (calc-user-function-classify key) 0)
         (if (setq entry (assq calc-language comps))
             (put func 'math-compose-forms (delq entry comps)))
        (calc-default-formula-arglist comp)
-       (setq math-arglist (sort math-arglist 'string-lessp))
+       (setq math-arglist (sort math-arglist))
        (while
           (progn
             (setq calc-user-formula-alist
index cc70ded17c2e161b021e92cd0d4de68942dab412..cf5742ef712cbd9ffda1ba0b1fa2e90c4ced2da0 100644 (file)
        (setq rules (cdr rules)))
       (if nil-rules
          (setq rule-set (cons (cons nil nil-rules) rule-set)))
-      (setq all-heads (mapcar #'car
-                              (sort all-heads (lambda (x y)
-                                                (< (cdr x) (cdr y))))))
+      (setq all-heads (mapcar #'car (sort all-heads :key #'cdr)))
       (let ((set rule-set)
            rule heads ptr)
        (while set
            (setq rule-set (cons (cons '- (cdr plus)) rule-set))))
       (cons (list 'schedule math-iterations name
                  (or math-schedule
-                     (sort math-all-phases '<)
+                     (sort math-all-phases)
                      (list 1)))
            rule-set))))
 
index fba2b9c50fba7164551372bceefaf95138d80285..1449b98b084276247977ef080b85fb7e1a0bf6d0 100644 (file)
@@ -1109,9 +1109,7 @@ If COMP or STD is non-nil, put that in the units table instead."
               (setq math-decompose-units-cache
                     (cons entry
                           (sort ulist
-                                 (lambda (x y)
-                                   (not (Math-lessp (nth 1 x)
-                                                    (nth 1 y)))))))))
+                                 :key #'cadr :lessp #'Math-lessp :reverse t)))))
         (cdr math-decompose-units-cache))))
 
 (defun math-decompose-unit-part (unit)
index 26952b8b10cec5dd72231cb1a440477fca8c22a7..88d01df6920cda82ebd77948f1ba3f8a7659ce37 100644 (file)
     (while p
       (setq vars (delq (assoc (car-safe p) vars) vars)
            p (cdr p)))
-    (sort (mapcar #'car vars)
-          (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
+    (sort (mapcar #'car vars) :key #'cadr)))
 
 ;; The variables math-all-vars-vars (the vars for math-all-vars) and
 ;; math-all-vars-found are local to math-all-vars-in, but are used by
index 7572e70628395fd8d7f90d8f67dd1dcddf767104..69c09a76e3a81875a308b387b58afd0c5df242e9 100644 (file)
@@ -667,7 +667,7 @@ Any appointments made with `appt-add' are not affected by this function."
 (defun appt-sort-list (appt-list)
   "Sort an appointment list, putting earlier items at the front.
 APPT-LIST is a list of the same format as `appt-time-msg-list'."
-  (sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2)))))
+  (sort appt-list :key #'caar))
 
 
 (defun appt-convert-time (time2conv)
index d7e62e1baf39b8ae572b807a1b341ad798c61843..b8d5862f8c2078e8eb3ea82205c9fd34ae3bd332 100644 (file)
@@ -591,7 +591,7 @@ ALIST is a VTIMEZONE potentially containing historical records."
                                                      (and (memq (car p) '(DTSTART RDATE))
                                                           (car (cddr p))))
                                                    n))
-                                     'string-greaterp))))
+                                     :reverse t))))
                      (a-recent (funcall get-recent (car (cddr a))))
                      (b-recent (funcall get-recent (car (cddr b)))))
                 (string-greaterp a-recent b-recent))))))))
@@ -1223,7 +1223,7 @@ Returns an alist."
              (p-sta (or (string-match "%t" icalendar-import-format) -1))
              (p-url (or (string-match "%u" icalendar-import-format) -1))
              (p-uid (or (string-match "%U" icalendar-import-format) -1))
-             (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) '<))
+             (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid)))
             (ct 0)
              pos-cla pos-des pos-loc pos-org pos-sta pos-url pos-uid) ;pos-sum
         (dotimes (i (length p-list))
index 12287299a7fbbc8e3114002647c0b8e82d94fe93..a3fb3c32b276eabd7d29a5a7a0511fb5d36dd4f9 100644 (file)
@@ -76,9 +76,7 @@ truenames (those with the extension \".toda\")."
                   (mapcar #'file-truename
                    (directory-files todo-directory t
                                     (if archives "\\.toda\\'" "\\.todo\\'") t)))))
-    (sort files (lambda (s1 s2) (let ((cis1 (upcase s1))
-                                     (cis2 (upcase s2)))
-                                 (string< cis1 cis2))))))
+    (sort files :key #'upcase)))
 
 (defcustom todo-files-function #'todo-files
   "Function returning the value of the variable `todo-files'.
index e6d989946db3525e6107315ff9a8211a4793b3ab..e69660a9d699bf9af557b84e200c6e9fac1b7b0b 100644 (file)
@@ -468,7 +468,7 @@ These are removed with make clean."
   (let ((mc (ede-map-targets
             this #'ede-proj-makefile-garbage-patterns))
        (uniq nil))
-    (setq mc (sort (apply #'append mc) #'string<))
+    (setq mc (sort (apply #'append mc)))
     ;; Filter out duplicates from the targets.
     (while mc
       (if (and (car uniq) (string= (car uniq) (car mc)))
index a87ae19ee0c932269146a093f680b9a951f13b42..dc3e84d9a312b75c0664d7f8035bcbe5ed14ff03 100644 (file)
@@ -83,7 +83,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
                          dbt))
         (nums nil)
         (fh (/ (- (frame-height) 7) 4)))
-    (setq numnuts (sort numnuts (lambda (a b) (> (car a) (car b)))))
+    (setq numnuts (sort numnuts :reverse t))
     (setq names (mapcar #'cdr numnuts)
          nums (mapcar #'car numnuts))
     (if (> (length names) fh)
@@ -125,7 +125,7 @@ items are charted.  TAGTABLE is passed to
         (namelabel (cdr (assoc 'function semantic-symbol->name-assoc-list)))
         (names nil)
         (nums nil))
-    (setq cplx (sort cplx (lambda (a b) (> (cdr a) (cdr b)))))
+    (setq cplx (sort cplx :key #'cdr :reverse t))
     (while (and cplx (<= (length names) (/ (- (frame-height) 7) 4)))
       (setq names (cons (semantic-tag-name (car (car cplx)))
                        names)
index 9dfb96f1fa12fd8bd2a34c78d9ff4cf1887e5eea..d1c01e2670b46907fa99c170a1d88a3159c84e67 100644 (file)
@@ -144,8 +144,7 @@ Optional argument BUFFER is the buffer to search for changes in."
        (when (overlay-get (car ol) 'semantic-change)
          (setq ret (cons (car ol) ret)))
        (setq ol (cdr ol)))
-      (sort ret (lambda (a b) (< (overlay-start a)
-                                 (overlay-start b)))))))
+      (sort ret :key #'overlay-start))))
 
 (defun semantic-edits-change-function-handle-changes  (start end _length)
   "Run whenever a buffer controlled by `semantic-mode' change.
index 14fbcbc00f8c08bb528ad2591c1ad756da51b4cd..befe36320bd715d1c9b8b5b783f129f481e3eb6e 100644 (file)
@@ -80,8 +80,7 @@ from largest to smallest via the start location."
                     (semantic-tag-p tmp))
            (setq ret (cons tmp ret))))
        (setq ol (cdr ol)))
-      (sort ret (lambda (a b) (< (semantic-tag-start a)
-                                (semantic-tag-start b)))))))
+      (sort ret :key #'semantic-tag-start))))
 
 ;;;###autoload
 (defun semantic-find-tag-by-overlay-in-region (start end &optional buffer)
@@ -99,8 +98,7 @@ Optional BUFFER argument specifies the buffer to use."
                     (semantic-tag-p tmp))
            (setq ret (cons tmp ret))))
        (setq ol (cdr ol)))
-      (sort ret (lambda (a b) (< (semantic-tag-start a)
-                                (semantic-tag-start b)))))))
+      (sort ret :key #'semantic-tag-start))))
 
 ;;;###autoload
 (defun semantic-find-tag-by-overlay-next (&optional start buffer)
index 5e2dca03f64ebde7e1c3c5893517e8384e308b57..2073d573ac6ba684d0b2e38007e5a6894092ba3c 100644 (file)
@@ -90,68 +90,56 @@ each tag."
 (defun semantic-sort-tags-by-name-increasing (tags)
   "Sort TAGS by name in increasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (string-lessp (semantic-tag-name a)
-                            (semantic-tag-name b)))))
+  (sort tags :key #'semantic-tag-name))
 
 (defun semantic-sort-tags-by-name-decreasing (tags)
   "Sort TAGS by name in decreasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (string-lessp (semantic-tag-name b)
-                            (semantic-tag-name a)))))
+  (sort tags :key #'semantic-tag-name :reverse t))
 
 (defun semantic-sort-tags-by-type-increasing (tags)
   "Sort TAGS by type in increasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (string-lessp (semantic-sort-tag-type a)
-                            (semantic-sort-tag-type b)))))
+  (sort tags :key #'semantic-sort-tag-type))
 
 (defun semantic-sort-tags-by-type-decreasing (tags)
   "Sort TAGS by type in decreasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (string-lessp (semantic-sort-tag-type b)
-                            (semantic-sort-tag-type a)))))
+  (sort tags :key #'semantic-sort-tag-type :reverse t))
 
 (defun semantic-sort-tags-by-name-increasing-ci (tags)
   "Sort TAGS by name in increasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (semantic-string-lessp-ci (semantic-tag-name a)
-                                        (semantic-tag-name b)))))
+  (sort tags :key #'semantic-tag-name :lessp #'semantic-string-lessp-ci))
 
 (defun semantic-sort-tags-by-name-decreasing-ci (tags)
   "Sort TAGS by name in decreasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (semantic-string-lessp-ci (semantic-tag-name b)
-                                        (semantic-tag-name a)))))
+  (sort tags
+        :key #'semantic-tag-name :lessp #'semantic-string-lessp-ci
+        :reverse t))
 
 (defun semantic-sort-tags-by-type-increasing-ci (tags)
   "Sort TAGS by type in increasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (semantic-string-lessp-ci (semantic-sort-tag-type a)
-                                        (semantic-sort-tag-type b)))))
+  (sort tags :key #'semantic-sort-tag-type :lessp #'semantic-string-lessp-ci))
 
 (defun semantic-sort-tags-by-type-decreasing-ci (tags)
   "Sort TAGS by type in decreasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b)
-              (semantic-string-lessp-ci (semantic-sort-tag-type b)
-                                        (semantic-sort-tag-type a)))))
+  (sort tags
+        :key #'semantic-sort-tag-type :lessp #'semantic-string-lessp-ci
+        :reverse t))
 
 (defun semantic-sort-tags-by-name-then-type-increasing (tags)
   "Sort TAGS by name, then type in increasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b) (semantic-tag-lessp-name-then-type a b))))
+  (sort tags #'semantic-tag-lessp-name-then-type))
 
 (defun semantic-sort-tags-by-name-then-type-decreasing (tags)
   "Sort TAGS by name, then type in increasing order with side effects.
 Return the sorted list."
-  (sort tags (lambda (a b) (semantic-tag-lessp-name-then-type b a))))
+  (sort tags #'semantic-tag-lessp-name-then-type))
 \f
 ;;; Unique
 ;;
index f3c33c16ebc2050668f9ab1cc4996d9f5e001d00..49be2e9e1047948ec02f8ca4a1c95d45ec952cad 100644 (file)
@@ -427,7 +427,7 @@ determining which symbols are considered."
       (setq completion (try-completion pattern collection predicate))
       (if (string= pattern completion)
          (let ((list (all-completions pattern collection predicate)))
-           (setq list (sort list #'string<))
+           (setq list (sort list))
            (if (> (length list) 1)
                (with-output-to-temp-buffer "*Completions*"
                  (display-completion-list
index a8fe095e99c4376ea7875e9ccd35ff884010da1c..83cb996e355a57329f250db27587a415fa66d8da 100644 (file)
@@ -3473,7 +3473,7 @@ specifying a common substring for adding the faces
 `completions-first-difference' and `completions-common-part' to
 the completions."
   (let ((window (get-buffer-window "*Completions*" 0)))
-    (setq completions (sort completions 'string-lessp))
+    (setq completions (sort completions))
     (if (and (eq last-command this-command)
             window (window-live-p window) (window-buffer window)
             (buffer-name (window-buffer window))
index 55965841a761b9eb5317a1d64b6beefc0a6fd401..b8b3269394844eb86a2f997c42d0de5dd79d78a9 100644 (file)
@@ -172,9 +172,9 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
                    (when found
                      (push (cons (symbol-name symbol)
                                  (with-output-to-string
-                                   (prin1 (sort found #'string<))))
+                                   (prin1 (sort found))))
                            alist))))))
-    (dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2)))))
+    (dolist (e (sort alist))
       (insert "(custom--add-custom-loads '" (car e) " '" (cdr e) ")\n")))
   (insert "\
 
@@ -223,7 +223,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
                                        (with-output-to-string
                                          (prin1 (get symbol 'custom-tag)))))
                              groups)))))))
-    (dolist (e (sort groups (lambda (e1 e2) (string< (car e1) (car e2)))))
+    (dolist (e (sort groups))
       (insert "(custom-put-if-not '" (car e) " 'custom-version '"
              (nth 1 e) ")\n")
       (insert "(custom-put-if-not '" (car e) " 'group-documentation "
@@ -234,7 +234,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
 
     (insert "\n(defvar custom-versions-load-alist "
            (if version-alist "'" ""))
-    (prin1 (sort version-alist (lambda (e1 e2) (version< (car e1) (car e2))))
+    (prin1 (sort version-alist :key #'car :lessp #'version<)
           (current-buffer))
     (insert "\n  \"For internal use by custom.
 This is an alist whose members have as car a version string, and as
index 0348bff2f56da741cb12ceabc152aaf544cc3d72..18ca3ee3c83a2e3c4bdc04b363acf20e6fbe2bad 100644 (file)
@@ -5076,7 +5076,7 @@ This function does not save the buffer."
                  (or (null (get symbol 'theme-value))
                      (eq 'user (caar (get symbol 'theme-value)))))
             (nconc saved-list (list symbol)))))
-      (setq saved-list (sort (cdr saved-list) 'string<))
+      (setq saved-list (sort (cdr saved-list)))
       (unless (bolp)
        (princ "\n"))
       (princ "(custom-set-variables
@@ -5156,7 +5156,7 @@ This function does not save the buffer."
         (if (and (get symbol 'saved-face)
                  (eq 'user (car (car-safe (get symbol 'theme-face)))))
             (nconc saved-list (list symbol)))))
-      (setq saved-list (sort (cdr saved-list) 'string<))
+      (setq saved-list (sort (cdr saved-list)))
       ;; The default face must be first, since it affects the others.
       (if (memq 'default saved-list)
          (setq saved-list (cons 'default (delq 'default saved-list))))
@@ -5804,8 +5804,7 @@ This stores EXP (without evaluating it) as the saved spec for SYMBOL."
  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.\n")
-        (dolist (value (sort values (lambda (s1 s2)
-                                      (string< (car s1) (car s2)))))
+        (dolist (value (sort values))
          (unless (bolp)
            (insert "\n"))
           (insert "  '")
index 63eba4b999123975c3ede68860e6fbc390b821f6..6305540f691ee0739ae92542f612b559d7f9988c 100644 (file)
@@ -408,7 +408,7 @@ then it searches *all* buffers."
          (table
           (lambda (s p a)
             (if (eq a 'metadata)
-                `(metadata (sort-function . ,#'identity)
+                '(metadata (sort-function . identity)
                            (category . dabbrev))
               (when (eq list 'uninitialized)
                 (save-excursion
index 0b2e4e43c64794242320e0b28bcfc99592d9e736..2b716b0b5b6c23b29c1cbb302def3d4dda09e0e0 100644 (file)
@@ -693,7 +693,7 @@ with a prefix argument."
     ;; and remove the versions not to be deleted.
     (let ((fval dired-file-version-alist))
       (while fval
-       (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
+       (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)))))
               (v-count (length sorted-v-list)))
          (if (> v-count (+ early-retention late-retention))
              (rplacd (nthcdr early-retention sorted-v-list)
@@ -2720,7 +2720,7 @@ Optional arg HOW-TO determines how to treat the target.
                                                 (dired-current-directory))))))
                               (delq (selected-window)
                                     (window-list-1 nil 'nomini 'visible)))
-                      (lambda (a b) (> (car a) (car b))))))
+                      :reverse t)))
 
 (defun dired-dwim-target-directory ()
   ;; Try to guess which target directory the user may want.
@@ -3317,10 +3317,7 @@ This function takes some pains to conform to `ls -lR' output."
 (defun dired-alist-sort ()
   ;; Keep the alist sorted on buffer position.
   (setq dired-subdir-alist
-       (sort dired-subdir-alist
-             (lambda (elt1 elt2)
-                (> (cdr elt1)
-                   (cdr elt2))))))
+       (sort dired-subdir-alist :key #'cdr :reverse t)))
 
 (defun dired-kill-tree (dirname &optional remember-marks kill-root)
   "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
index 1fc1ab45b84dc05055f8b3f06ddf57ba794f1b6b..f7eb074076eb88476ec54de76d0777f8e6e954bd 100644 (file)
@@ -230,9 +230,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 (lambda (first second)
-                                (> (length (cdr first))
-                                   (length (cdr second))))))
+        (setq list (sort list :key (compose #'length #'cdr) :reverse t))
         ;; Call the handler in its car before removing each URL from
         ;; URLs.
         (let ((handler (caar list))
index cc1768210266f08f7bd28488622bd245a3b9d0e7..76e0a4fe11b516a64a596417fd24a2ed6be83a20 100644 (file)
@@ -690,7 +690,7 @@ read, return an appropriate warning message as a string.
 Otherwise, return nil.  For internal use only."
   ;; This is called from lread.c and therefore needs to be preloaded.
   (if lread--unescaped-character-literals
-      (let ((sorted (sort lread--unescaped-character-literals #'<)))
+      (let ((sorted (sort lread--unescaped-character-literals)))
         (format "unescaped character literals %s detected, %s expected!"
                 (mapconcat (lambda (char) (format-message "`?%c'" char))
                            sorted ", ")
index 248fd8b7d57bc8fb220be5a8ac865597bb332050..5b497b1bd262587d7e92214669bc0fbf099e4938 100644 (file)
@@ -628,9 +628,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
           (unless (member generalizer (cdr x))
             (setf (cdr x)
                   (sort (cons generalizer (cdr x))
-                        (lambda (x y)
-                          (> (cl--generic-generalizer-priority x)
-                             (cl--generic-generalizer-priority y)))))))
+                        :key #'cl--generic-generalizer-priority
+                        :reverse t))))
         (setq i (1+ i))))
     ;; We used to (setcar me method), but that can cause false positives in
     ;; the hash-consing table of the method-builder (bug#20644).
index cbfb9540f03094539f34542e24b92b5dfb0c0ba9..718217c38ac20fdc67eedafe525277bad1c5f41b 100644 (file)
@@ -344,8 +344,7 @@ Return them as multiple value."
                 ;; "most general" to "least general"
                 with typess = (sort (mapcar #'comp-supertypes
                                             (apply #'append typesets))
-                                    (lambda (l1 l2)
-                                      (<= (length l1) (length l2))))
+                                    :key #'length :lessp #'<=)
                 with res = '()
                 for types in typess
                 ;; Don't keep this type if it's a subtype of one of
index bf6be1690e425390ebaae3708c8f2bda3fcadb09..08def2b0fbd70e2b08b6af778d98cb40be477af3 100644 (file)
@@ -170,9 +170,7 @@ are not abstract."
   "Display a list of all the methods and what features are used."
   (interactive)
   (let* ((meth1 (cl-generic-all-functions))
-        (meth (sort meth1 (lambda (a b)
-                            (string< (symbol-name a)
-                                     (symbol-name b)))))
+        (meth (sort meth1))
         (buff (get-buffer-create "*EIEIO Method List*"))
         (methidx 0)
         (standard-output buff)
index 24afd03fbe6b373738d1662e9238e46e772c8089..1a7dad4e02661b878e269fbc85204fe93e240e02 100644 (file)
@@ -900,8 +900,7 @@ the docstrings eventually produced, using
           (run-hook-with-args
            'eldoc-display-functions (mapcar #'cdr
                                             (setq docs-registered
-                                                  (sort docs-registered
-                                                        (lambda (a b) (< (car a) (car b))))))
+                                                  (sort docs-registered)))
            interactive))
          (make-callback
           (method origin)
index 8ab57d2b23859ba31386d671a004c2d3d15ea9fa..0f66cca2ca46acb170352f77f2575185ee918817 100644 (file)
@@ -1800,7 +1800,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
     (unless (or (null tests) (zerop high))
       (message "\nLONG-RUNNING TESTS")
       (message "------------------")
-      (setq tests (ntake high (sort tests (lambda (x y) (> (car x) (car y))))))
+      (setq tests (ntake high (sort tests :reverse t)))
       (message "%s" (mapconcat #'cdr tests "\n")))
     ;; More details on hydra and emba, where the logs are harder to get to.
     (when (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
@@ -2771,8 +2771,7 @@ To be used in the ERT results buffer."
                         collect (list test
                                       (float-time (time-subtract
                                                    end-time start-time))))))
-    (setq data (sort data (lambda (a b)
-                            (> (cl-second a) (cl-second b)))))
+    (setq data (sort data :key #'cadr :reverse t))
     (pop-to-buffer buffer)
     (let ((inhibit-read-only t))
       (buffer-disable-undo)
index 31610832ab9c172eff9540f4fb35390e5f9fe988..94529ed959ad61970c503fcf89f1034c0dc3935a 100644 (file)
@@ -7577,4 +7577,14 @@ 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))
+
 ;;; subr.el ends here