diff options
author | Case Duckworth | 2022-10-17 21:41:28 -0500 |
---|---|---|
committer | Case Duckworth | 2022-10-17 21:41:28 -0500 |
commit | aab5bfd074e57d06a79e39d7c7c4760e1f385a06 (patch) | |
tree | 7b111190a44458a970355f7a327cc5278c850293 /lisp/+lisp.el | |
parent | asoi (diff) | |
download | emacs-aab5bfd074e57d06a79e39d7c7c4760e1f385a06.tar.gz emacs-aab5bfd074e57d06a79e39d7c7c4760e1f385a06.zip |
Bankruptcy 9
Diffstat (limited to 'lisp/+lisp.el')
-rw-r--r-- | lisp/+lisp.el | 195 |
1 files changed, 0 insertions, 195 deletions
diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index a78e40e..0000000 --- a/lisp/+lisp.el +++ /dev/null | |||
@@ -1,195 +0,0 @@ | |||
1 | ;;; +lisp.el --- extra lisp functionality -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | ;;; Sort sexps in a region. | ||
6 | ;; https://github.com/alphapapa/unpackaged.el | ||
7 | |||
8 | (defun +lisp-skip-whitespace () | ||
9 | (while (looking-at (rx (1+ (or space "\n")))) | ||
10 | (goto-char (match-end 0)))) | ||
11 | |||
12 | (defun +lisp-skip-both () | ||
13 | (while (cond ((or (nth 4 (syntax-ppss)) | ||
14 | (ignore-errors | ||
15 | (save-excursion | ||
16 | (forward-char 1) | ||
17 | (nth 4 (syntax-ppss))))) | ||
18 | (forward-line 1)) | ||
19 | ((looking-at (rx (1+ (or space "\n")))) | ||
20 | (goto-char (match-end 0)))))) | ||
21 | |||
22 | (defun +lisp-sort-sexps (beg end &optional key-fn sort-fn) | ||
23 | "Sort sexps between BEG and END. | ||
24 | Comments stay with the code below. | ||
25 | |||
26 | Optional argument KEY-FN will determine where in each sexp to | ||
27 | start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) | ||
28 | |||
29 | Optional argument SORT-FN will determine how to sort two sexps' | ||
30 | strings. It's passed to `sort'. By default, it sorts the sexps | ||
31 | with `string<' starting with the key determined by KEY-FN." | ||
32 | (interactive "r") | ||
33 | (save-excursion | ||
34 | (save-restriction | ||
35 | (narrow-to-region beg end) | ||
36 | (goto-char beg) | ||
37 | (+lisp-skip-both) | ||
38 | (cl-destructuring-bind (sexps markers) | ||
39 | (cl-loop do (+lisp-skip-whitespace) | ||
40 | for start = (point-marker) | ||
41 | for sexp = (ignore-errors | ||
42 | (read (current-buffer))) | ||
43 | for end = (point-marker) | ||
44 | while sexp | ||
45 | ;; Collect the real string, then one used for sorting. | ||
46 | collect (cons (buffer-substring (marker-position start) | ||
47 | (marker-position end)) | ||
48 | (save-excursion | ||
49 | (goto-char (marker-position start)) | ||
50 | (+lisp-skip-both) | ||
51 | (if key-fn | ||
52 | (funcall key-fn sexp) | ||
53 | (buffer-substring | ||
54 | (point) | ||
55 | (marker-position end))))) | ||
56 | into sexps | ||
57 | collect (cons start end) | ||
58 | into markers | ||
59 | finally return (list sexps markers)) | ||
60 | (setq sexps (sort sexps (if sort-fn sort-fn | ||
61 | (lambda (a b) | ||
62 | (string< (cdr a) (cdr b)))))) | ||
63 | (cl-loop for (real . sort) in sexps | ||
64 | for (start . end) in markers | ||
65 | do (progn | ||
66 | (goto-char (marker-position start)) | ||
67 | (insert-before-markers real) | ||
68 | (delete-region (point) (marker-position end)))))))) | ||
69 | |||
70 | ;;; Comment-or-uncomment-sexp | ||
71 | ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html | ||
72 | |||
73 | (defun +lisp-uncomment-sexp (&optional n) | ||
74 | "Uncomment N sexps around point." | ||
75 | (interactive "P") | ||
76 | (let* ((initial-point (point-marker)) | ||
77 | (inhibit-field-text-motion t) | ||
78 | (p) | ||
79 | (end (save-excursion | ||
80 | (when (elt (syntax-ppss) 4) | ||
81 | (re-search-backward comment-start-skip | ||
82 | (line-beginning-position) | ||
83 | t)) | ||
84 | (setq p (point-marker)) | ||
85 | (comment-forward (point-max)) | ||
86 | (point-marker))) | ||
87 | (beg (save-excursion | ||
88 | (forward-line 0) | ||
89 | (while (and (not (bobp)) | ||
90 | (= end (save-excursion | ||
91 | (comment-forward (point-max)) | ||
92 | (point)))) | ||
93 | (forward-line -1)) | ||
94 | (goto-char (line-end-position)) | ||
95 | (re-search-backward comment-start-skip | ||
96 | (line-beginning-position) | ||
97 | t) | ||
98 | (ignore-errors | ||
99 | (while (looking-at-p comment-start-skip) | ||
100 | (forward-char -1))) | ||
101 | (point-marker)))) | ||
102 | (unless (= beg end) | ||
103 | (uncomment-region beg end) | ||
104 | (goto-char p) | ||
105 | ;; Indentify the "top-level" sexp inside the comment. | ||
106 | (while (and (ignore-errors (backward-up-list) t) | ||
107 | (>= (point) beg)) | ||
108 | (skip-chars-backward (rx (syntax expression-prefix))) | ||
109 | (setq p (point-marker))) | ||
110 | ;; Re-comment everything before it. | ||
111 | (ignore-errors | ||
112 | (comment-region beg p)) | ||
113 | ;; And everything after it. | ||
114 | (goto-char p) | ||
115 | (forward-sexp (or n 1)) | ||
116 | (skip-chars-forward "\r\n[:blank:]") | ||
117 | (if (< (point) end) | ||
118 | (ignore-errors | ||
119 | (comment-region (point) end)) | ||
120 | ;; If this is a closing delimiter, pull it up. | ||
121 | (goto-char end) | ||
122 | (skip-chars-forward "\r\n[:blank:]") | ||
123 | (when (eq 5 (car (syntax-after (point)))) | ||
124 | (delete-indentation)))) | ||
125 | ;; Without a prefix, it's more useful to leave point where | ||
126 | ;; it was. | ||
127 | (unless n | ||
128 | (goto-char initial-point)))) | ||
129 | |||
130 | (defun +lisp-comment-sexp--raw () | ||
131 | "Comment the sexp at point or ahead of point." | ||
132 | (pcase (or (bounds-of-thing-at-point 'sexp) | ||
133 | (save-excursion | ||
134 | (skip-chars-forward "\r\n[:blank:]") | ||
135 | (bounds-of-thing-at-point 'sexp))) | ||
136 | (`(,l . ,r) | ||
137 | (goto-char r) | ||
138 | (skip-chars-forward "\r\n[:blank:]") | ||
139 | (save-excursion | ||
140 | (comment-region l r)) | ||
141 | (skip-chars-forward "\r\n[:blank:]")))) | ||
142 | |||
143 | (defun +lisp-comment-or-uncomment-sexp (&optional n) | ||
144 | "Comment the sexp at point and move past it. | ||
145 | If already inside (or before) a comment, uncomment instead. | ||
146 | With a prefix argument N, (un)comment that many sexps." | ||
147 | (interactive "P") | ||
148 | (if (or (elt (syntax-ppss) 4) | ||
149 | (< (save-excursion | ||
150 | (skip-chars-forward "\r\n[:blank:]") | ||
151 | (point)) | ||
152 | (save-excursion | ||
153 | (comment-forward 1) | ||
154 | (point)))) | ||
155 | (+lisp-uncomment-sexp n) | ||
156 | (dotimes (_ (or n 1)) | ||
157 | (+lisp-comment-sexp--raw)))) | ||
158 | |||
159 | ;;; Sort `setq' constructs | ||
160 | ;;https://emacs.stackexchange.com/questions/33039/ | ||
161 | |||
162 | (defun +lisp-sort-setq () | ||
163 | (interactive) | ||
164 | (save-excursion | ||
165 | (save-restriction | ||
166 | (let ((sort-end (progn | ||
167 | (end-of-defun) | ||
168 | (backward-char) | ||
169 | (point-marker))) | ||
170 | (sort-beg (progn | ||
171 | (beginning-of-defun) | ||
172 | (or (re-search-forward "[ \\t]*(" (point-at-eol) t) | ||
173 | (point-at-eol)) | ||
174 | (forward-sexp) | ||
175 | (or (re-search-forward "\\<" (point-at-eol) t) | ||
176 | (point-at-eol)) | ||
177 | (point-marker)))) | ||
178 | (narrow-to-region (1- sort-beg) (1+ sort-end)) | ||
179 | (sort-subr nil #'+lisp-sort-setq-next-record | ||
180 | #'+lisp-sort-setq-end-record))))) | ||
181 | |||
182 | (defun +lisp-sort-setq-next-record () | ||
183 | (condition-case nil | ||
184 | (progn | ||
185 | (forward-sexp 1) | ||
186 | (backward-sexp)) | ||
187 | ('scan-error (end-of-buffer)))) | ||
188 | |||
189 | (defun +lisp-sort-setq-end-record () | ||
190 | (condition-case nil | ||
191 | (forward-sexp 2) | ||
192 | ('scan-error (end-of-buffer)))) | ||
193 | |||
194 | (provide '+lisp) | ||
195 | ;;; +lisp.el ends here | ||