fantastic-ret for org-mode

One of the reasons I liked org-mode for a while as an outliner (basically the only think I use it for) was this fantastic-ret that I sometimes forget was written by myself and isn’t a standard part of org. The lisp is a bit awful because it was one of the first things I wrote for Emacs Lisp over a decade ago.

It makes it so that return toggles level so you hit return a couple of times until it’s the right level. That’s fantastic.

(defcustom fantastic-ret-in-position "^\\** *"
  "On a line immediately following BOL, any number of asterisks, and then any number of spaces"
  :type 'regexp)

(defun find-level ()
  (save-excursion
    (move-beginning-of-line nil)
    (setq level 0)
    (while (looking-at "\\*")
      (setq level (1+ level))
      (forward-char))
    level))

(defun find-previous-level ()
  (save-excursion
    (while (and (zerop (forward-line -1)) (zerop (find-level))))
    (find-level)))

(defun new-line-same-level ()
  (let ((amount (find-level)))
    (newline)
    (insert-char ?* amount)
    (unless (zerop amount) (insert-char ?  1))))

(defun change-level ()
  (let* ((my-level (find-level))
	 (prev-level (find-previous-level))
	 (amount
	  (cond ((eq my-level prev-level)
		 (1+ prev-level))
		((zerop my-level)
		 prev-level)
		((> my-level prev-level)
		 (max 0 (1- prev-level)))
		(t (max 0 (1- my-level))))))
    (move-beginning-of-line nil)
    (while (looking-at "[* ]") (delete-char 1))
    (insert-char ?* amount)
    (unless (zerop amount) (insert-char ?  1))))

(defun org-fantastic-ret ()
  (interactive)
  (let ((context (if org-return-follows-link (org-element-context)
		   (org-element-at-point))))
    (cond
     ((and org-return-follows-link
	   (or (and (eq 'link (org-element-type context))
		    ;; Ensure point is not on the white spaces after
		    ;; the link.
		    (let ((origin (point)))
		      (org-with-point-at (org-element-property :end context)
			(skip-chars-backward " \t")
			(> (point) origin))))
	       (org-in-regexp org-ts-regexp-both nil t)
	       (org-in-regexp org-tsr-regexp-both nil  t)
	       (org-in-regexp org-any-link-re nil t)))
      (call-interactively #'org-open-at-point))
     (t   (if (looking-back fantastic-ret-in-position)
	      (change-level)
	    (new-line-same-level))))))

(defun org-boring-ret ()
  (interactive)
  (newline)
  (move-beginning-of-line nil))

(eval-after-load 'org
  '(define-key org-mode-map "\r" 'org-fantastic-ret))

(eval-after-load 'org
  '(define-key org-mode-map [(control return)] 'org-boring-ret))