mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/checkdoc.el (checkdoc-display-status-buffer)

Browse source 
(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.
This commit is contained in:
Stefan Monnier 2010-11-08 15:01:01 -05:00
parent db94771e23
commit 1398b795ef
2 changed files with 77 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

6
lisp/ChangeLog
View file

@ -1,5 +1,11 @@
2010-11-08 Stefan Monnier <monnier@iro.umontreal.ca> 2010-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
* 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.
* emacs-lisp/cl-macs.el (extent-data, extent-face, extent-priority) * emacs-lisp/cl-macs.el (extent-data, extent-face, extent-priority)
(extent-end-position, extent-start-position): Remove setf method for (extent-end-position, extent-start-position): Remove setf method for
non-existing functions (bug#7319). non-existing functions (bug#7319).

147
lisp/emacs-lisp/checkdoc.el
View file

@ -201,9 +201,9 @@ 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." The value `never' is the same as nil, never ask or change anything."
:group 'checkdoc :group 'checkdoc
:type '(choice (const automatic) :type '(choice (const automatic)
(const query) (const query)
(const never) (const never)
(other :tag "semiautomatic" semiautomatic))) (other :tag "semiautomatic" semiautomatic)))
(defcustom checkdoc-bouncy-flag t (defcustom checkdoc-bouncy-flag t
"Non-nil means to \"bounce\" to auto-fix locations. "Non-nil means to \"bounce\" to auto-fix locations.
@ -250,10 +250,10 @@ system. Possible values are:
t - Always spell-check" t - Always spell-check"
:group 'checkdoc :group 'checkdoc
:type '(choice (const nil) :type '(choice (const nil)
(const defun) (const defun)
(const buffer) (const buffer)
(const interactive) (const interactive)
(const t))) (const t)))
(defvar checkdoc-ispell-lisp-words (defvar checkdoc-ispell-lisp-words
'("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs") '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs")
@ -429,19 +429,15 @@ and experimental check. Do not modify this list without setting
the value of `checkdoc-common-verbs-regexp' to nil which cause it to the value of `checkdoc-common-verbs-regexp' to nil which cause it to
be re-created.") be re-created.")
(defvar checkdoc-syntax-table nil (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.") "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 ;;; Compatibility
;; ;;
(defalias 'checkdoc-make-overlay (defalias 'checkdoc-make-overlay
@ -515,12 +511,11 @@ CHECK is a list of four strings stating the current status of each
test; the nth string describes the status of the nth test." test; the nth string describes the status of the nth test."
(let (temp-buffer-setup-hook) (let (temp-buffer-setup-hook)
(with-output-to-temp-buffer "*Checkdoc Status*" (with-output-to-temp-buffer "*Checkdoc Status*"
(princ-list (mapc #'princ
"Buffer comments and tags: " (nth 0 check) "\n" (list "Buffer comments and tags: " (nth 0 check)
"Documentation style: " (nth 1 check) "\n" "\nDocumentation style: " (nth 1 check)
"Message/Query text style: " (nth 2 check) "\n" "\nMessage/Query text style: " (nth 2 check)
"Unwanted Spaces: " (nth 3 check) "\nUnwanted Spaces: " (nth 3 check)))))
)))
(shrink-window-if-larger-than-buffer (shrink-window-if-larger-than-buffer
(get-buffer-window "*Checkdoc Status*")) (get-buffer-window "*Checkdoc Status*"))
(message nil) (message nil)
@ -623,7 +618,7 @@ style."
(recenter (/ (- (window-height) l) 2)))) (recenter (/ (- (window-height) l) 2))))
(recenter)) (recenter))
(message "%s (C-h,%se,n,p,q)" (checkdoc-error-text (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text
(car (car err-list))) (car (car err-list)))
(if (checkdoc-error-unfixable (car (car err-list))) (if (checkdoc-error-unfixable (car (car err-list)))
"" "f,")) "" "f,"))
(save-excursion (save-excursion
@ -713,20 +708,21 @@ style."
(delete-window (get-buffer-window "*Checkdoc Help*")) (delete-window (get-buffer-window "*Checkdoc Help*"))
(kill-buffer "*Checkdoc Help*")) (kill-buffer "*Checkdoc Help*"))
(with-output-to-temp-buffer "*Checkdoc Help*" (with-output-to-temp-buffer "*Checkdoc Help*"
(princ-list (with-current-buffer standard-output
"Checkdoc Keyboard Summary:\n" (insert
(if (checkdoc-error-unfixable (car (car err-list))) "Checkdoc Keyboard Summary:\n"
"" (if (checkdoc-error-unfixable (car (car err-list)))
(concat ""
"f, y - auto Fix this warning without asking (if\ (concat
"f, y - auto Fix this warning without asking (if\
available.)\n" available.)\n"
" Very complex operations will still query.\n") " Very complex operations will still query.\n")
) )
"e - Enter recursive Edit. Press C-M-c to exit.\n" "e - Enter recursive Edit. Press C-M-c to exit.\n"
"SPC, n - skip to the Next error.\n" "SPC, n - skip to the Next error.\n"
"DEL, p - skip to the Previous error.\n" "DEL, p - skip to the Previous error.\n"
"q - Quit checkdoc.\n" "q - Quit checkdoc.\n"
"C-h - Toggle this help buffer.")) "C-h - Toggle this help buffer.")))
(shrink-window-if-larger-than-buffer (shrink-window-if-larger-than-buffer
(get-buffer-window "*Checkdoc Help*")))))) (get-buffer-window "*Checkdoc Help*"))))))
(if cdo (checkdoc-delete-overlay cdo))))) (if cdo (checkdoc-delete-overlay cdo)))))
@ -826,9 +822,9 @@ assumes that the cursor is already positioned to perform the fix."
"Enter recursive edit to permit a user to fix some error checkdoc has found. "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." MSG is the error that was found, which is displayed in a help buffer."
(with-output-to-temp-buffer "*Checkdoc Help*" (with-output-to-temp-buffer "*Checkdoc Help*"
(princ-list (mapc #'princ
"Error message:\n " msg (list "Error message:\n " msg
"\n\nEdit to fix this problem, and press C-M-c to continue.")) "\n\nEdit to fix this problem, and press C-M-c to continue.")))
(shrink-window-if-larger-than-buffer (shrink-window-if-larger-than-buffer
(get-buffer-window "*Checkdoc Help*")) (get-buffer-window "*Checkdoc Help*"))
(message "When you're done editing press C-M-c to continue.") (message "When you're done editing press C-M-c to continue.")
@ -947,14 +943,14 @@ if there is one."
(interactive "P") (interactive "P")
(if take-notes (checkdoc-start-section "checkdoc-comments")) (if take-notes (checkdoc-start-section "checkdoc-comments"))
(if (not buffer-file-name) (if (not buffer-file-name)
(error "Can only check comments for a file buffer")) (error "Can only check comments for a file buffer"))
(let* ((checkdoc-spellcheck-documentation-flag (let* ((checkdoc-spellcheck-documentation-flag
(car (memq checkdoc-spellcheck-documentation-flag (car (memq checkdoc-spellcheck-documentation-flag
'(buffer t)))) '(buffer t))))
(checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
(e (checkdoc-file-comments-engine)) (e (checkdoc-file-comments-engine))
(checkdoc-generate-compile-warnings-flag (checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag))) (or take-notes checkdoc-generate-compile-warnings-flag)))
(if e (error "%s" (checkdoc-error-text e))) (if e (error "%s" (checkdoc-error-text e)))
(checkdoc-show-diagnostics) (checkdoc-show-diagnostics)
e)) e))
@ -970,8 +966,8 @@ Optional argument INTERACT permits more interactive fixing."
(if take-notes (checkdoc-start-section "checkdoc-rogue-spaces")) (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces"))
(let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) (let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
(e (checkdoc-rogue-space-check-engine nil nil interact)) (e (checkdoc-rogue-space-check-engine nil nil interact))
(checkdoc-generate-compile-warnings-flag (checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag))) (or take-notes checkdoc-generate-compile-warnings-flag)))
(if (not (called-interactively-p 'interactive)) (if (not (called-interactively-p 'interactive))
e e
(if e (if e
@ -1210,34 +1206,34 @@ generating a buffered list of errors."
;; Add in a menubar with easy-menu ;; Add in a menubar with easy-menu
(easy-menu-define (easy-menu-define
nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu" nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu"
'("CheckDoc" '("CheckDoc"
["Interactive Buffer Style Check" checkdoc t] ["Interactive Buffer Style Check" checkdoc t]
["Interactive Buffer Style and Spelling Check" checkdoc-ispell t] ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
["Check Buffer" checkdoc-current-buffer t] ["Check Buffer" checkdoc-current-buffer t]
["Check and Spell Buffer" checkdoc-ispell-current-buffer t] ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
"---" "---"
["Interactive Style Check" checkdoc-interactive t] ["Interactive Style Check" checkdoc-interactive t]
["Interactive Style and Spelling Check" checkdoc-ispell-interactive t] ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
["Find First Style Error" checkdoc-start t] ["Find First Style Error" checkdoc-start t]
["Find First Style or Spelling Error" checkdoc-ispell-start t] ["Find First Style or Spelling Error" checkdoc-ispell-start t]
["Next Style Error" checkdoc-continue t] ["Next Style Error" checkdoc-continue t]
["Next Style or Spelling Error" checkdoc-ispell-continue t] ["Next Style or Spelling Error" checkdoc-ispell-continue t]
["Interactive Message Text Style Check" checkdoc-message-interactive t] ["Interactive Message Text Style Check" checkdoc-message-interactive t]
["Interactive Message Text Style and Spelling Check" ["Interactive Message Text Style and Spelling Check"
checkdoc-ispell-message-interactive t] checkdoc-ispell-message-interactive t]
["Check Message Text" checkdoc-message-text t] ["Check Message Text" checkdoc-message-text t]
["Check and Spell Message Text" checkdoc-ispell-message-text t] ["Check and Spell Message Text" checkdoc-ispell-message-text t]
["Check Comment Style" checkdoc-comments buffer-file-name] ["Check Comment Style" checkdoc-comments buffer-file-name]
["Check Comment Style and Spelling" checkdoc-ispell-comments ["Check Comment Style and Spelling" checkdoc-ispell-comments
buffer-file-name] buffer-file-name]
["Check for Rogue Spaces" checkdoc-rogue-spaces t] ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
"---" "---"
["Check Defun" checkdoc-defun t] ["Check Defun" checkdoc-defun t]
["Check and Spell Defun" checkdoc-ispell-defun t] ["Check and Spell Defun" checkdoc-ispell-defun t]
["Check and Evaluate Defun" checkdoc-eval-defun t] ["Check and Evaluate Defun" checkdoc-eval-defun t]
["Check and Evaluate Buffer" checkdoc-eval-current-buffer t] ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
)) ))
;; XEmacs requires some weird stuff to add this menu in a minor mode. ;; XEmacs requires some weird stuff to add this menu in a minor mode.
;; What is it? ;; What is it?
@ -2657,8 +2653,7 @@ function called to create the messages."
(setq checkdoc-pending-errors nil) (setq checkdoc-pending-errors nil)
nil))) nil)))
(custom-add-option 'emacs-lisp-mode-hook (custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
(lambda () (checkdoc-minor-mode 1)))
(add-to-list 'debug-ignored-errors (add-to-list 'debug-ignored-errors
"Argument `.*' should appear (as .*) in the doc string") "Argument `.*' should appear (as .*) in the doc string")