Function: checkdoc-interactive-loop
checkdoc-interactive-loop is a byte-compiled function defined in
checkdoc.el.gz.
Signature
(checkdoc-interactive-loop START-HERE SHOWSTATUS FINDFUNC)
Documentation
Interactively loop over all errors that can be found by a given method.
If START-HERE is nil, searching starts at the beginning of the current buffer, otherwise searching starts at START-HERE. SHOWSTATUS expresses the verbosity of the search, and whether ending the search will auto-exit this function.
FINDFUNC is a symbol representing a function that will position the cursor, and return error message text to present to the user. It is assumed that the cursor will stop just before a major sexp, which will be highlighted to present the user with feedback as to the offending style.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/checkdoc.el.gz
(defun checkdoc-interactive-loop (start-here showstatus findfunc)
"Interactively loop over all errors that can be found by a given method.
If START-HERE is nil, searching starts at the beginning of the current
buffer, otherwise searching starts at START-HERE. SHOWSTATUS
expresses the verbosity of the search, and whether ending the search
will auto-exit this function.
FINDFUNC is a symbol representing a function that will position the
cursor, and return error message text to present to the user. It is
assumed that the cursor will stop just before a major sexp, which will
be highlighted to present the user with feedback as to the offending
style."
;; Determine where to start the test
(let* ((begin (prog1 (point)
(if (not start-here) (goto-char (point-min)))))
;; Assign a flag to spellcheck flag
(checkdoc-spellcheck-documentation-flag
(car (memq checkdoc-spellcheck-documentation-flag
'(buffer interactive t))))
;; Fetch the error list
(err-list (list (funcall findfunc nil)))
(cdo nil)
(returnme nil)
c)
(save-window-excursion
(if (not (car err-list)) (setq err-list nil))
;; Include whatever function point is in for good measure.
(beginning-of-defun)
(while err-list
(goto-char (cdr (car err-list)))
;; The cursor should be just in front of the offending doc string
(setq cdo (if (stringp (car (car err-list)))
(save-excursion (make-overlay
(point) (progn (forward-sexp 1)
(point))))
(make-overlay
(checkdoc-error-start (car (car err-list)))
(checkdoc-error-end (car (car err-list))))))
(unwind-protect
(progn
(overlay-put cdo 'face 'highlight)
;; Make sure the whole doc string is visible if possible.
(sit-for 0)
(if (and (= (following-char) ?\")
(not (pos-visible-in-window-p
(save-excursion (forward-sexp 1) (point))
(selected-window))))
(let ((l (count-lines (point)
(save-excursion
(forward-sexp 1) (point)))))
(if (> l (window-height))
(recenter 1)
(recenter (/ (- (window-height) l) 2))))
(recenter))
(message "%s (C-h,%se,n,p,q)" (checkdoc-error-text
(car (car err-list)))
(if (checkdoc-error-unfixable (car (car err-list)))
"" "f,"))
(save-excursion
(goto-char (checkdoc-error-start (car (car err-list))))
(if (not (pos-visible-in-window-p))
(recenter (- (window-height) 2)))
(setq c (read-event)))
(if (not (integerp c)) (setq c ??))
(cond
;; Exit condition
((eq c ?\C-g) (signal 'quit nil))
;; Request an auto-fix
((memq c '(?y ?f))
(delete-overlay cdo)
(setq cdo nil)
(goto-char (cdr (car err-list)))
;; `automatic-then-never' tells the autofix function
;; to only allow one fix to be automatic. The autofix
;; function will then set the flag to `never', allowing
;; the checker to return a different error.
(let ((checkdoc-autofix-flag 'automatic-then-never)
(fixed nil))
(funcall findfunc t)
(setq fixed (not (eq checkdoc-autofix-flag
'automatic-then-never)))
(if (not fixed)
(progn
(message "A Fix was not available.")
(sit-for 2))
(setq err-list (cdr err-list))))
(beginning-of-defun)
(let ((ne (funcall findfunc nil)))
(if ne
(setq err-list (cons ne err-list))
(cond ((not err-list)
(message "No More Stylistic Errors.")
(sit-for 2))
(t
(message
"No Additional style errors. Continuing...")
(sit-for 2))))))
;; Move to the next error (if available)
((memq c '(?n ?\s))
(let ((ne (funcall findfunc nil)))
(if (not ne)
(if showstatus
(setq returnme err-list
err-list nil)
(if (not err-list)
(message "No More Stylistic Errors.")
(message "No Additional style errors. Continuing..."))
(sit-for 2))
(setq err-list (cons ne err-list)))))
;; Go backwards in the list of errors
((memq c '(?p ?\C-?))
(if (/= (length err-list) 1)
(progn
(setq err-list (cdr err-list))
(goto-char (cdr (car err-list)))
(beginning-of-defun))
(message "No Previous Errors.")
(sit-for 2)))
;; Edit the buffer recursively.
((eq c ?e)
(checkdoc-recursive-edit
(checkdoc-error-text (car (car err-list))))
(delete-overlay cdo)
(setq err-list (cdr err-list)) ;back up the error found.
(beginning-of-defun)
(let ((ne (funcall findfunc nil)))
(if (not ne)
(if showstatus
(setq returnme err-list
err-list nil)
(message "No More Stylistic Errors.")
(sit-for 2))
(setq err-list (cons ne err-list)))))
;; Quit checkdoc
((eq c ?q)
(setq returnme err-list
err-list nil
begin (point)))
;; Goofy stuff
(t
(if (get-buffer-window checkdoc--help-buffer)
(progn
(delete-window (get-buffer-window checkdoc--help-buffer))
(kill-buffer checkdoc--help-buffer))
(with-output-to-temp-buffer checkdoc--help-buffer
(with-current-buffer standard-output
(insert
"Checkdoc Keyboard Summary:\n"
(if (checkdoc-error-unfixable (car (car err-list)))
""
(concat
"f, y - auto Fix this warning without asking"
" (if available.)\n"
" Very complex operations will still query.\n"))
"e - Enter recursive Edit. Press C-M-c to exit.\n"
"SPC, n - skip to the Next error.\n"
"DEL, p - skip to the Previous error.\n"
"q - Quit checkdoc.\n"
"C-h - Toggle this help buffer.")))
(shrink-window-if-larger-than-buffer
(get-buffer-window checkdoc--help-buffer))))))
(if cdo (delete-overlay cdo)))))
(goto-char begin)
(if (get-buffer checkdoc--help-buffer) (kill-buffer checkdoc--help-buffer))
(message "Checkdoc: Done.")
returnme))