comparison lisp/emacs-lisp/checkdoc.el @ 111443:72390b0b6207

* lisp/emacs-lisp/checkdoc.el (checkdoc-display-status-buffer) (checkdoc-interactive-loop, checkdoc-recursive-edit): Avoid princ-list. (checkdoc-syntax-table): Initialize in the declaration. (emacs-lisp-mode-hook): Use just checkdoc-minor-mode now that it turns the mode on unconditionally.

111442:7094295b2a61

is `semiautomatic' or any other value, then simple fixes are made
without asking, and complex changes are made by asking the user first.
The value `never' is the same as nil, never ask or change anything."
  :group 'checkdoc
  :type '(choice (const automatic)
		 (const query)
		 (const never)
		 (other :tag "semiautomatic" semiautomatic)))

(defcustom checkdoc-bouncy-flag t
  "Non-nil means to \"bounce\" to auto-fix locations.
Setting this to nil will silently make fixes that require no user
interaction.  See `checkdoc-autofix-flag' for auto-fixing details."

  buffer      - Spell-check when style checking the whole buffer
  interactive - Spell-check during any interactive check.
  t           - Always spell-check"
  :group 'checkdoc
  :type '(choice (const nil)
		 (const defun)
		 (const buffer)
		 (const interactive)
		 (const t)))

(defvar checkdoc-ispell-lisp-words
  '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs")
  "List of words that are correct when spell-checking Lisp documentation.")

Set `checkdoc-verb-check-experimental-flag' to nil to avoid this costly
and experimental check.  Do not modify this list without setting
the value of `checkdoc-common-verbs-regexp' to nil which cause it to
be re-created.")

(defvar checkdoc-syntax-table nil
  "Syntax table used by checkdoc in document strings.")

(if checkdoc-syntax-table
    nil
  (setq checkdoc-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
  ;; When dealing with syntax in doc strings, make sure that - are encompassed
  ;; in words so we can use cheap \\> to get the end of a symbol, not the
  ;; end of a word in a conglomerate.
  (modify-syntax-entry ?- "w" checkdoc-syntax-table)
  )


;;; Compatibility
;;
(defalias 'checkdoc-make-overlay
  (if (featurep 'xemacs) 'make-extent 'make-overlay))

  "Display and update the status buffer for the current checkdoc mode.
CHECK is a list of four strings stating the current status of each
test; the nth string describes the status of the nth test."
  (let (temp-buffer-setup-hook)
    (with-output-to-temp-buffer "*Checkdoc Status*"
      (princ-list
       "Buffer comments and tags:  " (nth 0 check) "\n"
       "Documentation style:       " (nth 1 check) "\n"
       "Message/Query text style:  " (nth 2 check) "\n"
       "Unwanted Spaces:           " (nth 3 check)
       )))
  (shrink-window-if-larger-than-buffer
   (get-buffer-window "*Checkdoc Status*"))
  (message nil)
  (sit-for 0))

		    (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))

		(if (get-buffer-window "*Checkdoc Help*")
		    (progn
		      (delete-window (get-buffer-window "*Checkdoc Help*"))
		      (kill-buffer "*Checkdoc Help*"))
		  (with-output-to-temp-buffer "*Checkdoc Help*"
		    (princ-list
		     "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*"))))))
	  (if cdo (checkdoc-delete-overlay cdo)))))
    (goto-char begin)
    (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))

(defun checkdoc-recursive-edit (msg)
  "Enter recursive edit to permit a user to fix some error checkdoc has found.
MSG is the error that was found, which is displayed in a help buffer."
  (with-output-to-temp-buffer "*Checkdoc Help*"
    (princ-list
     "Error message:\n  " msg
     "\n\nEdit to fix this problem, and press C-M-c to continue."))
  (shrink-window-if-larger-than-buffer
   (get-buffer-window "*Checkdoc Help*"))
  (message "When you're done editing press C-M-c to continue.")
  (unwind-protect
      (recursive-edit)

separate buffer.  Otherwise print a message.  This returns the error
if there is one."
  (interactive "P")
  (if take-notes (checkdoc-start-section "checkdoc-comments"))
  (if (not buffer-file-name)
     (error "Can only check comments for a file buffer"))
  (let* ((checkdoc-spellcheck-documentation-flag
	  (car (memq checkdoc-spellcheck-documentation-flag
                     '(buffer t))))
	 (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
	 (e (checkdoc-file-comments-engine))
	(checkdoc-generate-compile-warnings-flag
	 (or take-notes checkdoc-generate-compile-warnings-flag)))
    (if e (error "%s" (checkdoc-error-text e)))
    (checkdoc-show-diagnostics)
    e))

;;;###autoload

Optional argument INTERACT permits more interactive fixing."
  (interactive "P")
  (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces"))
  (let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
	 (e (checkdoc-rogue-space-check-engine nil nil interact))
	(checkdoc-generate-compile-warnings-flag
	 (or take-notes checkdoc-generate-compile-warnings-flag)))
    (if (not (called-interactively-p 'interactive))
	e
      (if e
	  (message "%s" (checkdoc-error-text e))
	(checkdoc-show-diagnostics)

  "Keymap used to override evaluation key-bindings for documentation checking.")

;; Add in a menubar with easy-menu

(easy-menu-define
 nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
 '("CheckDoc"
   ["Interactive Buffer Style Check" checkdoc t]
   ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
   ["Check Buffer" checkdoc-current-buffer t]
   ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
   "---"
   ["Interactive Style Check" checkdoc-interactive t]
   ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
   ["Find First Style Error" checkdoc-start t]
   ["Find First Style or Spelling  Error" checkdoc-ispell-start t]
   ["Next Style Error" checkdoc-continue t]
   ["Next Style or Spelling  Error" checkdoc-ispell-continue t]
   ["Interactive Message Text Style Check" checkdoc-message-interactive t]
   ["Interactive Message Text Style and Spelling Check"
    checkdoc-ispell-message-interactive t]
   ["Check Message Text" checkdoc-message-text t]
   ["Check and Spell Message Text" checkdoc-ispell-message-text t]
   ["Check Comment Style" checkdoc-comments buffer-file-name]
   ["Check Comment Style and Spelling" checkdoc-ispell-comments
    buffer-file-name]
   ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
   "---"
   ["Check Defun" checkdoc-defun t]
   ["Check and Spell Defun" checkdoc-ispell-defun t]
   ["Check and Evaluate Defun" checkdoc-eval-defun t]
   ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
   ))
;; XEmacs requires some weird stuff to add this menu in a minor mode.
;; What is it?

;;;###autoload
(define-minor-mode checkdoc-minor-mode

		     (recenter 0)))
	(other-window -1)
	(setq checkdoc-pending-errors nil)
	nil)))

(custom-add-option 'emacs-lisp-mode-hook
		   (lambda () (checkdoc-minor-mode 1)))

(add-to-list 'debug-ignored-errors
	     "Argument `.*' should appear (as .*) in the doc string")
(add-to-list 'debug-ignored-errors
	     "Lisp symbol `.*' should appear in quotes")

111443:72390b0b6207

is `semiautomatic' or any other value, then simple fixes are made
without asking, and complex changes are made by asking the user first.
The value `never' is the same as nil, never ask or change anything."
  :group 'checkdoc
  :type '(choice (const automatic)
          (const query)
          (const never)
          (other :tag "semiautomatic" semiautomatic)))

(defcustom checkdoc-bouncy-flag t
  "Non-nil means to \"bounce\" to auto-fix locations.
Setting this to nil will silently make fixes that require no user
interaction.  See `checkdoc-autofix-flag' for auto-fixing details."

  buffer      - Spell-check when style checking the whole buffer
  interactive - Spell-check during any interactive check.
  t           - Always spell-check"
  :group 'checkdoc
  :type '(choice (const nil)
          (const defun)
          (const buffer)
          (const interactive)
          (const t)))

(defvar checkdoc-ispell-lisp-words
  '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs")
  "List of words that are correct when spell-checking Lisp documentation.")

Set `checkdoc-verb-check-experimental-flag' to nil to avoid this costly
and experimental check.  Do not modify this list without setting
the value of `checkdoc-common-verbs-regexp' to nil which cause it to
be re-created.")

(defvar checkdoc-syntax-table
  (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
    ;; When dealing with syntax in doc strings, make sure that - are
    ;; encompassed in words so we can use cheap \\> to get the end of a symbol,
    ;; not the end of a word in a conglomerate.
    (modify-syntax-entry ?- "w" checkdoc-syntax-table)
    st)
  "Syntax table used by checkdoc in document strings.")

;;; Compatibility
;;
(defalias 'checkdoc-make-overlay
  (if (featurep 'xemacs) 'make-extent 'make-overlay))

  "Display and update the status buffer for the current checkdoc mode.
CHECK is a list of four strings stating the current status of each
test; the nth string describes the status of the nth test."
  (let (temp-buffer-setup-hook)
    (with-output-to-temp-buffer "*Checkdoc Status*"
      (mapc #'princ
            (list "Buffer comments and tags:  " (nth 0 check)
                  "\nDocumentation style:       " (nth 1 check)
                  "\nMessage/Query text style:  " (nth 2 check)
                  "\nUnwanted Spaces:           " (nth 3 check)))))
  (shrink-window-if-larger-than-buffer
   (get-buffer-window "*Checkdoc Status*"))
  (message nil)
  (sit-for 0))

		    (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))

		(if (get-buffer-window "*Checkdoc Help*")
		    (progn
		      (delete-window (get-buffer-window "*Checkdoc Help*"))
		      (kill-buffer "*Checkdoc Help*"))
		  (with-output-to-temp-buffer "*Checkdoc Help*"
                    (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*"))))))
	  (if cdo (checkdoc-delete-overlay cdo)))))
    (goto-char begin)
    (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))

(defun checkdoc-recursive-edit (msg)
  "Enter recursive edit to permit a user to fix some error checkdoc has found.
MSG is the error that was found, which is displayed in a help buffer."
  (with-output-to-temp-buffer "*Checkdoc Help*"
    (mapc #'princ
          (list "Error message:\n  " msg
                "\n\nEdit to fix this problem, and press C-M-c to continue.")))
  (shrink-window-if-larger-than-buffer
   (get-buffer-window "*Checkdoc Help*"))
  (message "When you're done editing press C-M-c to continue.")
  (unwind-protect
      (recursive-edit)

separate buffer.  Otherwise print a message.  This returns the error
if there is one."
  (interactive "P")
  (if take-notes (checkdoc-start-section "checkdoc-comments"))
  (if (not buffer-file-name)
      (error "Can only check comments for a file buffer"))
  (let* ((checkdoc-spellcheck-documentation-flag
	  (car (memq checkdoc-spellcheck-documentation-flag
                     '(buffer t))))
	 (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
	 (e (checkdoc-file-comments-engine))
         (checkdoc-generate-compile-warnings-flag
          (or take-notes checkdoc-generate-compile-warnings-flag)))
    (if e (error "%s" (checkdoc-error-text e)))
    (checkdoc-show-diagnostics)
    e))

;;;###autoload

Optional argument INTERACT permits more interactive fixing."
  (interactive "P")
  (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces"))
  (let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
	 (e (checkdoc-rogue-space-check-engine nil nil interact))
         (checkdoc-generate-compile-warnings-flag
          (or take-notes checkdoc-generate-compile-warnings-flag)))
    (if (not (called-interactively-p 'interactive))
	e
      (if e
	  (message "%s" (checkdoc-error-text e))
	(checkdoc-show-diagnostics)

  "Keymap used to override evaluation key-bindings for documentation checking.")

;; Add in a menubar with easy-menu

(easy-menu-define
  nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
  '("CheckDoc"
    ["Interactive Buffer Style Check" checkdoc t]
    ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
    ["Check Buffer" checkdoc-current-buffer t]
    ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
    "---"
    ["Interactive Style Check" checkdoc-interactive t]
    ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
    ["Find First Style Error" checkdoc-start t]
    ["Find First Style or Spelling  Error" checkdoc-ispell-start t]
    ["Next Style Error" checkdoc-continue t]
    ["Next Style or Spelling  Error" checkdoc-ispell-continue t]
    ["Interactive Message Text Style Check" checkdoc-message-interactive t]
    ["Interactive Message Text Style and Spelling Check"
     checkdoc-ispell-message-interactive t]
    ["Check Message Text" checkdoc-message-text t]
    ["Check and Spell Message Text" checkdoc-ispell-message-text t]
    ["Check Comment Style" checkdoc-comments buffer-file-name]
    ["Check Comment Style and Spelling" checkdoc-ispell-comments
     buffer-file-name]
    ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
    "---"
    ["Check Defun" checkdoc-defun t]
    ["Check and Spell Defun" checkdoc-ispell-defun t]
    ["Check and Evaluate Defun" checkdoc-eval-defun t]
    ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
    ))
;; XEmacs requires some weird stuff to add this menu in a minor mode.
;; What is it?

;;;###autoload
(define-minor-mode checkdoc-minor-mode

		     (recenter 0)))
	(other-window -1)
	(setq checkdoc-pending-errors nil)
	nil)))

(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)

(add-to-list 'debug-ignored-errors
	     "Argument `.*' should appear (as .*) in the doc string")
(add-to-list 'debug-ignored-errors
	     "Lisp symbol `.*' should appear in quotes")