blob: 3267fd951fe7e793d86bc086a0e9afc163f559ba (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
;;; +lisp.el --- extra lisp functionality -*- lexical-binding: t -*-
;;; Code:
;;; Sort sexps in a region.
;; https://github.com/alphapapa/unpackaged.el
(defun +lisp-skip-whitespace ()
(while (looking-at (rx (1+ (or space "\n"))))
(goto-char (match-end 0))))
(defun +lisp-skip-both ()
(while (cond ((or (nth 4 (syntax-ppss))
(ignore-errors
(save-excursion
(forward-char 1)
(nth 4 (syntax-ppss)))))
(forward-line 1))
((looking-at (rx (1+ (or space "\n"))))
(goto-char (match-end 0))))))
(defun +lisp-sort-sexps (beg end &optional key-fn sort-fn)
"Sort sexps between BEG and END.
Comments stay with the code below.
Optional argument KEY-FN will determine where in each sexp to
start sorting. e.g. (lambda (sexp) (symbol-name (car sexp)))
Optional argument SORT-FN will determine how to sort two sexps'
strings. It's passed to `sort'. By default, it sorts the sexps
with `string<' starting with the key determined by KEY-FN."
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char beg)
(+lisp-skip-both)
(cl-destructuring-bind (sexps markers)
(cl-loop do (+lisp-skip-whitespace)
for start = (point-marker)
for sexp = (ignore-errors
(read (current-buffer)))
for end = (point-marker)
while sexp
;; Collect the real string, then one used for sorting.
collect (cons (buffer-substring (marker-position start)
(marker-position end))
(save-excursion
(goto-char (marker-position start))
(+lisp-skip-both)
(if key-fn
(funcall key-fn sexp)
(buffer-substring
(point)
(marker-position end)))))
into sexps
collect (cons start end)
into markers
finally return (list sexps markers))
(setq sexps (sort sexps (if sort-fn sort-fn
(lambda (a b)
(string< (cdr a) (cdr b))))))
(cl-loop for (real . sort) in sexps
for (start . end) in markers
do (progn
(goto-char (marker-position start))
(insert-before-markers real)
(delete-region (point) (marker-position end))))))))
(provide '+lisp)
;;; +lisp.el ends here
|
