Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement