196 lines
7.2 KiB
EmacsLisp
196 lines
7.2 KiB
EmacsLisp
;;; +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))))))))
|
|
|
|
;;; Comment-or-uncomment-sexp
|
|
;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
|
|
|
|
(defun +lisp-uncomment-sexp (&optional n)
|
|
"Uncomment N sexps around point."
|
|
(interactive "P")
|
|
(let* ((initial-point (point-marker))
|
|
(inhibit-field-text-motion t)
|
|
(p)
|
|
(end (save-excursion
|
|
(when (elt (syntax-ppss) 4)
|
|
(re-search-backward comment-start-skip
|
|
(line-beginning-position)
|
|
t))
|
|
(setq p (point-marker))
|
|
(comment-forward (point-max))
|
|
(point-marker)))
|
|
(beg (save-excursion
|
|
(forward-line 0)
|
|
(while (and (not (bobp))
|
|
(= end (save-excursion
|
|
(comment-forward (point-max))
|
|
(point))))
|
|
(forward-line -1))
|
|
(goto-char (line-end-position))
|
|
(re-search-backward comment-start-skip
|
|
(line-beginning-position)
|
|
t)
|
|
(ignore-errors
|
|
(while (looking-at-p comment-start-skip)
|
|
(forward-char -1)))
|
|
(point-marker))))
|
|
(unless (= beg end)
|
|
(uncomment-region beg end)
|
|
(goto-char p)
|
|
;; Indentify the "top-level" sexp inside the comment.
|
|
(while (and (ignore-errors (backward-up-list) t)
|
|
(>= (point) beg))
|
|
(skip-chars-backward (rx (syntax expression-prefix)))
|
|
(setq p (point-marker)))
|
|
;; Re-comment everything before it.
|
|
(ignore-errors
|
|
(comment-region beg p))
|
|
;; And everything after it.
|
|
(goto-char p)
|
|
(forward-sexp (or n 1))
|
|
(skip-chars-forward "\r\n[:blank:]")
|
|
(if (< (point) end)
|
|
(ignore-errors
|
|
(comment-region (point) end))
|
|
;; If this is a closing delimiter, pull it up.
|
|
(goto-char end)
|
|
(skip-chars-forward "\r\n[:blank:]")
|
|
(when (eq 5 (car (syntax-after (point))))
|
|
(delete-indentation))))
|
|
;; Without a prefix, it's more useful to leave point where
|
|
;; it was.
|
|
(unless n
|
|
(goto-char initial-point))))
|
|
|
|
(defun +lisp-comment-sexp--raw ()
|
|
"Comment the sexp at point or ahead of point."
|
|
(pcase (or (bounds-of-thing-at-point 'sexp)
|
|
(save-excursion
|
|
(skip-chars-forward "\r\n[:blank:]")
|
|
(bounds-of-thing-at-point 'sexp)))
|
|
(`(,l . ,r)
|
|
(goto-char r)
|
|
(skip-chars-forward "\r\n[:blank:]")
|
|
(save-excursion
|
|
(comment-region l r))
|
|
(skip-chars-forward "\r\n[:blank:]"))))
|
|
|
|
(defun +lisp-comment-or-uncomment-sexp (&optional n)
|
|
"Comment the sexp at point and move past it.
|
|
If already inside (or before) a comment, uncomment instead.
|
|
With a prefix argument N, (un)comment that many sexps."
|
|
(interactive "P")
|
|
(if (or (elt (syntax-ppss) 4)
|
|
(< (save-excursion
|
|
(skip-chars-forward "\r\n[:blank:]")
|
|
(point))
|
|
(save-excursion
|
|
(comment-forward 1)
|
|
(point))))
|
|
(+lisp-uncomment-sexp n)
|
|
(dotimes (_ (or n 1))
|
|
(+lisp-comment-sexp--raw))))
|
|
|
|
;;; Sort `setq' constructs
|
|
;;https://emacs.stackexchange.com/questions/33039/
|
|
|
|
(defun +lisp-sort-setq ()
|
|
(interactive)
|
|
(save-excursion
|
|
(save-restriction
|
|
(let ((sort-end (progn
|
|
(end-of-defun)
|
|
(backward-char)
|
|
(point-marker)))
|
|
(sort-beg (progn
|
|
(beginning-of-defun)
|
|
(or (re-search-forward "[ \\t]*(" (point-at-eol) t)
|
|
(point-at-eol))
|
|
(forward-sexp)
|
|
(or (re-search-forward "\\<" (point-at-eol) t)
|
|
(point-at-eol))
|
|
(point-marker))))
|
|
(narrow-to-region (1- sort-beg) (1+ sort-end))
|
|
(sort-subr nil #'+lisp-sort-setq-next-record
|
|
#'+lisp-sort-setq-end-record)))))
|
|
|
|
(defun +lisp-sort-setq-next-record ()
|
|
(condition-case nil
|
|
(progn
|
|
(forward-sexp 1)
|
|
(backward-sexp))
|
|
('scan-error (end-of-buffer))))
|
|
|
|
(defun +lisp-sort-setq-end-record ()
|
|
(condition-case nil
|
|
(forward-sexp 2)
|
|
('scan-error (end-of-buffer))))
|
|
|
|
(provide '+lisp)
|
|
;;; +lisp.el ends here
|