;; 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)
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
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))
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
(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
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
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))
"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)
(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
(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)))
(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)
(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))
(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*")
(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: "
"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)
(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
(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))))
(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)
(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
(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)
(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))))))))
(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))
(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'.
(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)))
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)
(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)
(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.
(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)
(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)
(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
;;
(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
`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))
(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 "\
(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 "
(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
(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
(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))))
;; 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 " '")
(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
;; 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)
(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.
(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.
;; 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))
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 ", ")
(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).
;; "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
"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)
(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)
(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"))
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)
,(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