(defun has-face-at-point (face &optional position)
  (interactive)
  (when (null position) (setq position (point)))
  (unless (consp face) (setq face (list face)))
  (let ((props (text-properties-at position)))
    (loop for (key value) on props by #'cddr
          do (when (and (eql key 'face) (member value face))
               (return t)))))

(defun face-start (face)
  (save-excursion
    (while (and (has-face-at-point face) (not (bolp)))
      (backward-char))
    (- (point) (save-excursion (move-beginning-of-line 1)) (if  (bolp) 0 -1))))

(defun R-beautify-comments ()
  (interactive)
  ;; Because this function does a lot of insertion, it would
  ;; be better to execute it in the temporary buffer, while
  ;; copying the original text of the file into it, such as
  ;; to prevent junk in the formatted buffer's history
  (let ((content (buffer-string))
        (comments '(font-lock-comment-face font-lock-comment-delimiter-face)))
    (with-temp-buffer
      (insert content)
      (save-excursion
        (goto-char (point-min))
        ;; thingatpt breaks if there are overlays with their own faces
        (let* ((commentp (has-face-at-point 'font-lock-comment-face))
               (margin
                (if commentp (face-start comments) 0))
               assumed-margin pre-comment commented-lines)
          (while (not (eobp))
            (move-end-of-line 1)
            ;; (message "has comment: %s" (has-face-at-point 'font-lock-comment-face))
            (cond
             ((and (has-face-at-point comments)
                   commentp)            ; this is a comment continued from
                                        ; the previous line
              (setq assumed-margin (face-start comments)
                    pre-comment
                    (buffer-substring-no-properties
                     (save-excursion (move-beginning-of-line 1))
                     (save-excursion (move-beginning-of-line 1)
                                     (forward-char assumed-margin) (point))))
              (message "pre-comment <%s> <- %d" pre-comment assumed-margin)
              (if (every
                   (lambda (c) (or (char-equal c ?\ ) (char-equal c ?\t)))
                   pre-comment)
                  ;; This is the comment preceded by whitespace
                  (setq commentp nil margin 0 commented-lines 0)
                (message "Continued comment %d <> %d" assumed-margin margin)
                (if (< assumed-margin margin)
                    ;; The comment found starts on the left of
                    ;; the margin of the comments found so far
                    (save-excursion
                      (move-beginning-of-line 1)
                      (forward-char assumed-margin)
                      (message "correcting indentation by: %d in line: <%s>"
                               (- margin assumed-margin)
                               (buffer-substring-no-properties
                                (save-excursion
                                  (move-beginning-of-line 1))
                                (save-excursion
                                  (move-end-of-line 1) (point))))
                      (insert (make-string (- margin assumed-margin) ?\ ))
                      (incf commented-lines))
                  ;; This could be optimized by going forward and
                  ;; collecting as many comments there are, but
                  ;; it is simpler to return and re-indent comments
                  ;; (assuming there won't be many such cases anyway.
                  (setq margin assumed-margin)
                  (move-end-of-line (- commented-lines)))))
             ((has-face-at-point comments)
              ;; This is the fresh comment
              ;; This entire block needs refactoring, it is
              ;; a repetition of the half the previous block
              (setq assumed-margin (face-start comments)
                    pre-comment
                    (buffer-substring-no-properties
                     (save-excursion (move-beginning-of-line 1))
                     (save-excursion (move-beginning-of-line 1)
                                     (forward-char assumed-margin) (point))))
              ;; (message "pre-comment <%s> <- %d" pre-comment assumed-margin)
              (unless (every
                       (lambda (c)
                         (or (char-equal c ?\ ) (char-equal c ?\t)))
                       pre-comment)
                (setq commentp t margin assumed-margin commented-lines 0)))
             (commentp
              ;; This is the line directly after a block of comments
              (setq commentp nil margin assumed-margin commented-lines 0))
             (t                         ; This is the line with no comments
              (message "test")          ; left here for testing purposes
              ;; (message "line: <%s>"
              ;;          (buffer-substring-no-properties
              ;;           (save-excursion
              ;;             (move-beginning-of-line 1))
              ;;           (save-excursion
              ;;             (move-end-of-line 1) (point))))
              ))
            (unless (eobp) (forward-char))
            ;; (message "outside while: <%s>"
            ;;          (buffer-substring-no-properties
            ;;           (save-excursion
            ;;             (move-beginning-of-line 1))
            ;;           (save-excursion
            ;;             (move-end-of-line 1) (point))))
            )
          ;; Retrieve back the formatted contnent
          (setq content (buffer-string)))))
    (erase-buffer)
    (insert content)))