bug#13837: 24.2; Make it possible to turn whitespace-mode only when there are no existing problems

[Reuben Thomas]

On 28 February 2013 16:23, Stefan Monnier <monnier@iro.umontreal.ca> wrote:
>
> You can … refactor the
> whitespace-report-region so as to provide whitespace-test-region.

Here's an attempt at that:

(defun whitespace-test-region (start end)
  "Find whether there are whitespace problems in a region.

Return a list of whitespace problems (hence, nil if there is no
whitespace problem).

A whitespace problem is one of the following:

* If `indent-tabs-mode' is non-nil:
   empty        1. empty lines at beginning of buffer.
   empty        2. empty lines at end of buffer.
   trailing        3. SPACEs or TABs at end of line.
   indentation        4. 8 or more SPACEs at beginning of line.
   space-before-tab    5. SPACEs before TAB.
   space-after-tab    6. 8 or more SPACEs after TAB.

* If `indent-tabs-mode' is nil:
   empty        1. empty lines at beginning of buffer.
   empty        2. empty lines at end of buffer.
   trailing        3. SPACEs or TABs at end of line.
   indentation        4. TABS at beginning of line.
   space-before-tab    5. SPACEs before TAB.
   space-after-tab    6. 8 or more SPACEs after TAB.

See `whitespace-style' for documentation.
See also `whitespace-cleanup' and `whitespace-cleanup-region' for
cleaning up these problems."
  (save-excursion
    (save-match-data                ;FIXME: Why?
      (let* ((has-bogus nil)
             (rstart    (min start end))
             (rend      (max start end))
             (bogus-list
              (mapcar
               #'(lambda (option)
                   (goto-char rstart)
                   (let ((regexp
                          (cond
                           ((eq (car option) 'indentation)
                            (whitespace-indentation-regexp))
                           ((eq (car option) 'indentation::tab)
                            (whitespace-indentation-regexp 'tab))
                           ((eq (car option) 'indentation::space)
                            (whitespace-indentation-regexp 'space))
                           ((eq (car option) 'space-after-tab)
                            (whitespace-space-after-tab-regexp))
                           ((eq (car option) 'space-after-tab::tab)
                            (whitespace-space-after-tab-regexp 'tab))
                           ((eq (car option) 'space-after-tab::space)
                            (whitespace-space-after-tab-regexp 'space))
                           (t
                            (cdr option)))))
                     (and (re-search-forward regexp rend t)
                          t)))
               whitespace-report-list)))
        bogus-list))))

(defun whitespace-report-region (start end &optional force report-if-bogus)
  "Report some whitespace problems in a region.

Return nil if there is no whitespace problem; otherwise, return
non-nil.

If FORCE is non-nil or \\[universal-argument] was pressed just
before calling `whitespace-report-region' interactively, it
forces `whitespace-style' to have:

   empty
   indentation
   space-before-tab
   trailing
   space-after-tab

If REPORT-IF-BOGUS is non-nil, it reports only when there are any
whitespace problems in buffer.

For a description of whitespace problems, see
`whitespace-test-region'."
  (interactive "r")
  (setq force (or current-prefix-arg force))
  (save-excursion
    (let ((bogus-list (whitespace-test-region start end)))
      (when (if report-if-bogus bogus-list t)
        (whitespace-kill-buffer whitespace-report-buffer-name)
        ;; `whitespace-indent-tabs-mode' is local to current buffer
        ;; `whitespace-tab-width' is local to current buffer
        (let ((ws-indent-tabs-mode whitespace-indent-tabs-mode)
              (ws-tab-width whitespace-tab-width))
          (with-current-buffer (get-buffer-create
                                whitespace-report-buffer-name)
            (erase-buffer)
            (insert (if ws-indent-tabs-mode
                        (car whitespace-report-text)
                      (cdr whitespace-report-text)))
            (goto-char (point-min))
            (forward-line 3)
            (dolist (option whitespace-report-list)
              (forward-line 1)
              (whitespace-mark-x
               27 (memq (car option) whitespace-style))
              (whitespace-mark-x 7 (car bogus-list))
              (setq bogus-list (cdr bogus-list)))
            (forward-line 1)
            (whitespace-insert-value ws-indent-tabs-mode)
            (whitespace-insert-value ws-tab-width)
            (when bogus-list
              (goto-char (point-max))
              (insert " Type `M-x whitespace-cleanup'"
                      " to cleanup the buffer.\n\n"
                      " Type `M-x whitespace-cleanup-region'"
                      " to cleanup a region.\n\n"))
            (whitespace-display-window (current-buffer)))))
      (null bogus-list))))