Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Beautify single line comments

By: a guest on Nov 18th, 2012  |  syntax: Lisp  |  size: 5.65 KB  |  views: 41  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. (defun has-face-at-point (face &optional position)
  2.   (interactive)
  3.   (when (null position) (setq position (point)))
  4.   (unless (consp face) (setq face (list face)))
  5.   (let ((props (text-properties-at position)))
  6.     (loop for (key value) on props by #'cddr
  7.           do (when (and (eql key 'face) (member value face))
  8.                (return t)))))
  9.  
  10. (defun face-start (face)
  11.   (save-excursion
  12.     (while (and (has-face-at-point face) (not (bolp)))
  13.       (backward-char))
  14.     (- (point) (save-excursion (move-beginning-of-line 1)) (if  (bolp) 0 -1))))
  15.  
  16. (defun R-beautify-comments ()
  17.   (interactive)
  18.   ;; Because this function does a lot of insertion, it would
  19.   ;; be better to execute it in the temporary buffer, while
  20.   ;; copying the original text of the file into it, such as
  21.   ;; to prevent junk in the formatted buffer's history
  22.   (let ((content (buffer-string))
  23.         (comments '(font-lock-comment-face font-lock-comment-delimiter-face)))
  24.     (with-temp-buffer
  25.       (insert content)
  26.       (save-excursion
  27.         (goto-char (point-min))
  28.         ;; thingatpt breaks if there are overlays with their own faces
  29.         (let* ((commentp (has-face-at-point 'font-lock-comment-face))
  30.                (margin
  31.                 (if commentp (face-start comments) 0))
  32.                assumed-margin pre-comment commented-lines)
  33.           (while (not (eobp))
  34.             (move-end-of-line 1)
  35.             ;; (message "has comment: %s" (has-face-at-point 'font-lock-comment-face))
  36.             (cond
  37.              ((and (has-face-at-point comments)
  38.                    commentp)            ; this is a comment continued from
  39.                                         ; the previous line
  40.               (setq assumed-margin (face-start comments)
  41.                     pre-comment
  42.                     (buffer-substring-no-properties
  43.                      (save-excursion (move-beginning-of-line 1))
  44.                      (save-excursion (move-beginning-of-line 1)
  45.                                      (forward-char assumed-margin) (point))))
  46.               (message "pre-comment <%s> <- %d" pre-comment assumed-margin)
  47.               (if (every
  48.                    (lambda (c) (or (char-equal c ?\ ) (char-equal c ?\t)))
  49.                    pre-comment)
  50.                   ;; This is the comment preceded by whitespace
  51.                   (setq commentp nil margin 0 commented-lines 0)
  52.                 (message "Continued comment %d <> %d" assumed-margin margin)
  53.                 (if (< assumed-margin margin)
  54.                     ;; The comment found starts on the left of
  55.                     ;; the margin of the comments found so far
  56.                     (save-excursion
  57.                       (move-beginning-of-line 1)
  58.                       (forward-char assumed-margin)
  59.                       (message "correcting indentation by: %d in line: <%s>"
  60.                                (- margin assumed-margin)
  61.                                (buffer-substring-no-properties
  62.                                 (save-excursion
  63.                                   (move-beginning-of-line 1))
  64.                                 (save-excursion
  65.                                   (move-end-of-line 1) (point))))
  66.                       (insert (make-string (- margin assumed-margin) ?\ ))
  67.                       (incf commented-lines))
  68.                   ;; This could be optimized by going forward and
  69.                   ;; collecting as many comments there are, but
  70.                   ;; it is simpler to return and re-indent comments
  71.                   ;; (assuming there won't be many such cases anyway.
  72.                   (setq margin assumed-margin)
  73.                   (move-end-of-line (- commented-lines)))))
  74.              ((has-face-at-point comments)
  75.               ;; This is the fresh comment
  76.               ;; This entire block needs refactoring, it is
  77.               ;; a repetition of the half the previous block
  78.               (setq assumed-margin (face-start comments)
  79.                     pre-comment
  80.                     (buffer-substring-no-properties
  81.                      (save-excursion (move-beginning-of-line 1))
  82.                      (save-excursion (move-beginning-of-line 1)
  83.                                      (forward-char assumed-margin) (point))))
  84.               ;; (message "pre-comment <%s> <- %d" pre-comment assumed-margin)
  85.               (unless (every
  86.                        (lambda (c)
  87.                          (or (char-equal c ?\ ) (char-equal c ?\t)))
  88.                        pre-comment)
  89.                 (setq commentp t margin assumed-margin commented-lines 0)))
  90.              (commentp
  91.               ;; This is the line directly after a block of comments
  92.               (setq commentp nil margin assumed-margin commented-lines 0))
  93.              (t                         ; This is the line with no comments
  94.               (message "test")          ; left here for testing purposes
  95.               ;; (message "line: <%s>"
  96.               ;;          (buffer-substring-no-properties
  97.               ;;           (save-excursion
  98.               ;;             (move-beginning-of-line 1))
  99.               ;;           (save-excursion
  100.               ;;             (move-end-of-line 1) (point))))
  101.               ))
  102.             (unless (eobp) (forward-char))
  103.             ;; (message "outside while: <%s>"
  104.             ;;          (buffer-substring-no-properties
  105.             ;;           (save-excursion
  106.             ;;             (move-beginning-of-line 1))
  107.             ;;           (save-excursion
  108.             ;;             (move-end-of-line 1) (point))))
  109.             )
  110.           ;; Retrieve back the formatted contnent
  111.           (setq content (buffer-string)))))
  112.     (erase-buffer)
  113.     (insert content)))
clone this paste RAW Paste Data