(define-key emacs-lisp-mode-map "\C-ctf"
  #'endless/elisp-thread-first)
(define-key emacs-lisp-mode-map "\C-ctl"
  #'endless/elisp-thread-last)
(define-key emacs-lisp-mode-map "\C-ctu"
  #'endless/elisp-unwind)
(define-key emacs-lisp-mode-map "\C-cta"
  #'endless/elisp-unwind-all)

(defun endless/elisp-thread-last ()
  "Turn the form at point into a `thread-last' form."
  (interactive)
  (cljr-thread-last-all nil)
  (save-excursion
    (when (search-backward "->>" nil 'noerror)
      (replace-match "thread-last"))))

(defun endless/elisp-thread-first ()
  "Turn the form at point into a `thread-first' form."
  (interactive)
  (cljr-thread-first-all nil)
  (save-excursion
    (when (search-backward "->" nil 'noerror)
      (replace-match "thread-first"))))

(defun endless/elisp-unwind ()
  "Unwind thread at point or above point by one level.
Return nil if there are no more levels to unwind."
  (interactive)
  (let ((p (point)))
    ;; Find a thread above.
    (when (save-excursion
            (forward-sexp 1)
            (and (search-backward-regexp "\\_<thread-\\(first\\|last\\)\\_>" nil 'noerror)
                 ;; Ensure that it contains the original point.
                 (save-match-data (forward-char -1)
                                  (forward-sexp 1)
                                  (> (point) p))))
      (replace-match (if (string= (match-string 1) "first")
                         "->" "->>"))
      (let ((thread-beginnig (match-beginning 0)))
        (prog1 (cljr-unwind)
          (save-excursion
            (goto-char thread-beginnig)
            (when (looking-at "\\_<->>?\\_>")
              (replace-match (if (string= (match-string 0) "->")
                                 "thread-first" "thread-last")))))))))

(defun endless/elisp-unwind-all ()
  "Fully unwind thread at point or above point."
  (interactive)
  (while (endless/elisp-unwind)))