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