;;; +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