emacs: lisp/emacs-lisp/checkdoc.el comparison

comparison lisp/emacs-lisp/checkdoc.el @ 88155:d7ddb3e565de

sync with trunk

author	Henrik Enberg <henrik.enberg@telia.com>
date	Mon, 16 Jan 2006 00:03:54 +0000
parents	45cd70f39238
children

comparison

equal deleted inserted replaced

-:8ce476d3ba36
+:d7ddb3e565de
 ;;; checkdoc.el --- check documentation strings for style requirements
-;;;  Copyright (C) 1997, 1998, 2001  Free Software Foundation
+;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.6.2
 ;; Keywords: docs, maint, lisp
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02111-1307, USA.
+;; Boston, MA 02110-1301, USA.
 ;;; Commentary:
 ;;
 ;;   The Emacs Lisp manual has a nice chapter on how to write
 ;; documentation strings.  Many stylistic suggestions are fairly
 (defmacro custom-add-option (&rest args)
 nil)
 (defmacro defcustom (var value doc &rest args)
 `(defvar ,var ,value ,doc))))
+(defvar compilation-error-regexp-alist)
+(defvar compilation-mode-font-lock-keywords)
 (defcustom checkdoc-autofix-flag 'semiautomatic
 "*Non-nil means attempt auto-fixing of doc strings.
 If this value is the symbol `query', then the user is queried before
 any change is made.  If the value is `automatic', then all changes are
 made without asking unless the change is very-complex.  If the value
 (defvar checkdoc-proper-noun-list
 '("ispell" "xemacs" "emacs" "lisp")
 "List of words (not capitalized) which should be capitalized.")
 (defvar checkdoc-proper-noun-regexp
-(let ((expr "\\<\\(")
+(let ((expr "\\_<\\(")
 	(l checkdoc-proper-noun-list))
 (while l
 (setq expr (concat expr (car l) (if (cdr l) "\\|" ""))
 	    l (cdr l)))
-(concat expr "\\)\\>"))
+(concat expr "\\)\\_>"))
 "Regular expression derived from `checkdoc-proper-noun-regexp'.")
 (defvar checkdoc-common-verbs-regexp nil
 "Regular expression derived from `checkdoc-common-verbs-regexp'.")
 )
 ;;; Compatibility
 ;;
-(if (string-match "X[Ee]macs" emacs-version)
+(defalias 'checkdoc-make-overlay
-(progn
+(if (featurep 'xemacs) 'make-extent 'make-overlay))
-(defalias 'checkdoc-make-overlay 'make-extent)
+(defalias 'checkdoc-overlay-put
-(defalias 'checkdoc-overlay-put 'set-extent-property)
+(if (featurep 'xemacs) 'set-extent-property 'overlay-put))
-(defalias 'checkdoc-delete-overlay 'delete-extent)
+(defalias 'checkdoc-delete-overlay
-(defalias 'checkdoc-overlay-start 'extent-start)
+(if (featurep 'xemacs) 'delete-extent 'delete-overlay))
-(defalias 'checkdoc-overlay-end 'extent-end)
+(defalias 'checkdoc-overlay-start
-(defalias 'checkdoc-mode-line-update 'redraw-modeline)
+(if (featurep 'xemacs) 'extent-start 'overlay-start))
-(defalias 'checkdoc-call-eval-buffer 'eval-buffer)
+(defalias 'checkdoc-overlay-end
-)
+(if (featurep 'xemacs) 'extent-end 'overlay-end))
-(defalias 'checkdoc-make-overlay 'make-overlay)
+(defalias 'checkdoc-mode-line-update
-(defalias 'checkdoc-overlay-put 'overlay-put)
+(if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
-(defalias 'checkdoc-delete-overlay 'delete-overlay)
+(defalias 'checkdoc-char=
-(defalias 'checkdoc-overlay-start 'overlay-start)
+(if (featurep 'xemacs) 'char= '=))
-(defalias 'checkdoc-overlay-end 'overlay-end)
-(defalias 'checkdoc-mode-line-update 'force-mode-line-update)
-(defalias 'checkdoc-call-eval-buffer 'eval-current-buffer)
-)
-;; Emacs 20s have MULE characters which don't equate to numbers.
-(if (fboundp 'char=)
-(defalias 'checkdoc-char= 'char=)
-(defalias 'checkdoc-char= '=))
-;; Read events, not characters
-(defalias 'checkdoc-read-event 'read-event)
 ;;; User level commands
 ;;
 ;;;###autoload
 (defun checkdoc ()
 (setcar (cdr (cdr (cdr status))) "Ok"))
 (checkdoc-display-status-buffer status)))
 (defun checkdoc-display-status-buffer (check)
 "Display and update the status buffer for the current checkdoc mode.
-CHECK is a vector stating the current status of each test as an
+CHECK is a list of four strings stating the current status of each
-element is the status of that level of test."
+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"
 checkdoc status window instead of the usual behavior."
 (interactive "P")
 (let ((checkdoc-spellcheck-documentation-flag
 	 (car (memq checkdoc-spellcheck-documentation-flag
 '(interactive t)))))
-(checkdoc-interactive-loop start-here showstatus 'checkdoc-next-error)))
+(prog1
+;; Due to a design flaw, this will never spell check
+;; docstrings.
+(checkdoc-interactive-loop start-here showstatus
+'checkdoc-next-error)
+;; This is a workaround to perform spell checking.
+(checkdoc-interactive-ispell-loop start-here))))
 ;;;###autoload
 (defun checkdoc-message-interactive (&optional start-here showstatus)
 "Interactively check the current buffer for message string errors.
 Prefix argument START-HERE will start the checking from the current
 checkdoc status window instead of the usual behavior."
 (interactive "P")
 (let ((checkdoc-spellcheck-documentation-flag
 	 (car (memq checkdoc-spellcheck-documentation-flag
 '(interactive t)))))
-(checkdoc-interactive-loop start-here showstatus
+(prog1
-			       'checkdoc-next-message-error)))
+;; Due to a design flaw, this will never spell check messages.
+(checkdoc-interactive-loop start-here showstatus
+'checkdoc-next-message-error)
+;; This is a workaround to perform spell checking.
+(checkdoc-message-interactive-ispell-loop start-here))))
 (defun checkdoc-interactive-loop (start-here showstatus findfunc)
 "Interactively loop over all errors that can be found by a given method.
-Searching starts at START-HERE.  SHOWSTATUS expresses the verbosity
-of the search, and whether ending the search will auto-exit this function.
+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."
 			   "" "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 (checkdoc-read-event)))1
+		(setq c (read-event)))
 	      (if (not (integerp c)) (setq c ??))
 	      (cond
 	       ;; Exit condition
 	       ((checkdoc-char= c ?\C-g) (signal 'quit nil))
 	       ;; Request an auto-fix
 		(checkdoc-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 than set the flag to 'never, allowing
+		;; 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
 		      (progn
 			(message "A Fix was not available.")
 			(sit-for 2))
 		    (setq err-list (cdr err-list))))
 		(beginning-of-defun)
-		(let ((pe (car err-list))
+		(let ((ne (funcall findfunc nil)))
-		      (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)
-	       ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\ ))
+	       ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\s))
 		(let ((ne (funcall findfunc nil)))
 		  (if (not ne)
 		      (if showstatus
 			  (setq returnme err-list
 				err-list nil)
 	       ;; Quit checkdoc
 	       ((checkdoc-char= c ?q)
 		(setq returnme err-list
 		      err-list nil
 		      begin (point)))
-	       ;; Goofy s tuff
+	       ;; Goofy stuff
 	       (t
 		(if (get-buffer-window "*Checkdoc Help*")
 		    (progn
 		      (delete-window (get-buffer-window "*Checkdoc Help*"))
 		      (kill-buffer "*Checkdoc Help*"))
 (goto-char begin)
 (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))
 (message "Checkdoc: Done.")
 returnme))
+(defun checkdoc-interactive-ispell-loop (start-here)
+"Interactively spell check doc strings in the current buffer.
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE."
+(when checkdoc-spellcheck-documentation-flag
+(save-excursion
+;; Move point to where we need to start.
+(if start-here
+;; Include whatever function point is in for good measure.
+(beginning-of-defun)
+(goto-char (point-min)))
+;; Loop over docstrings.
+(while (checkdoc-next-docstring)
+(message "Searching for doc string spell error...%d%%"
+(/ (* 100 (point)) (point-max)))
+(if (looking-at "\"")
+(checkdoc-ispell-docstring-engine
+(save-excursion (forward-sexp 1) (point-marker)))))
+(message "Checkdoc: Done."))))
+(defun checkdoc-message-interactive-ispell-loop (start-here)
+"Interactively spell check messages in the current buffer.
+If START-HERE is nil, searching starts at the beginning of the current
+buffer, otherwise searching starts at START-HERE."
+(when checkdoc-spellcheck-documentation-flag
+(save-excursion
+;; Move point to where we need to start.
+(if start-here
+;; Include whatever function point is in for good measure.
+(beginning-of-defun)
+(goto-char (point-min)))
+;; Loop over message strings.
+(while (checkdoc-message-text-next-string (point-max))
+(message "Searching for message string spell error...%d%%"
+(/ (* 100 (point)) (point-max)))
+(if (looking-at "\"")
+(checkdoc-ispell-docstring-engine
+(save-excursion (forward-sexp 1) (point-marker)))))
+(message "Checkdoc: Done."))))
 (defun checkdoc-next-error (enable-fix)
 "Find and return the next checkdoc error list, or nil.
 Only documentation strings are checked.
-Add error vector is of the form (WARNING . POSITION) where WARNING
+An error list is of the form (WARNING . POSITION) where WARNING is the
-is the warning text, and POSITION is the point in the buffer where the
+warning text, and POSITION is the point in the buffer where the error
-error was found.  We can use points and not markers because we promise
+was found.  We can use points and not markers because we promise not
-not to edit the buffer before point without re-executing this check.
+to edit the buffer before point without re-executing this check.
 Argument ENABLE-FIX will enable auto-fixing while looking for the next
 error.  This argument assumes that the cursor is already positioned to
 perform the fix."
 (if enable-fix
 (checkdoc-this-string-valid)
 "Evaluate and check documentation for the current buffer.
 Evaluation is done first because good documentation for something that
 doesn't work is just not useful.  Comments, doc strings, and rogue
 spacing are all verified."
 (interactive)
-(checkdoc-call-eval-buffer nil)
+(eval-buffer nil)
 (checkdoc-current-buffer t))
 ;;;###autoload
 (defun checkdoc-current-buffer (&optional take-notes)
 "Check current buffer for document, comment, error style, and rogue spaces.
 "Find the next doc string in the current buffer which has a style error.
 Prefix argument TAKE-NOTES means to continue through the whole buffer and
 save warnings in a separate buffer.  Second optional argument START-POINT
 is the starting location.  If this is nil, `point-min' is used instead."
 (interactive "P")
-(let ((wrong nil) (msg nil) (errors nil)
+(let ((wrong nil) (msg nil)
 	;; Assign a flag to spellcheck flag
 	(checkdoc-spellcheck-documentation-flag
 	 (car (memq checkdoc-spellcheck-documentation-flag
 '(buffer t))))
 	(checkdoc-autofix-flag (if take-notes 'never
 	(if msg (setq wrong (point)))))
 (if wrong
 	(progn
 	  (goto-char wrong)
 	  (if (not take-notes)
-	      (error (checkdoc-error-text msg)))))
+	      (error "%s" (checkdoc-error-text msg)))))
 (checkdoc-show-diagnostics)
 (if (interactive-p)
 	(message "No style warnings."))))
 (defun checkdoc-next-docstring ()
 '(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 (checkdoc-error-text e)))
+(if e (error "%s" (checkdoc-error-text e)))
 (checkdoc-show-diagnostics)
 e))
 ;;;###autoload
 (defun checkdoc-rogue-spaces (&optional take-notes interact)
 	  (or take-notes checkdoc-generate-compile-warnings-flag)))
 (setq e (checkdoc-message-text-search))
 (if (not (interactive-p))
 	e
 (if e
-	  (error (checkdoc-error-text e))
+	  (error "%s" (checkdoc-error-text e))
 	(checkdoc-show-diagnostics)))
 (goto-char p))
 (if (interactive-p) (message "Checking interactive message text...done.")))
 ;;;###autoload
 	     (beg (save-excursion (beginning-of-defun) (point)))
 	     (end (save-excursion (end-of-defun) (point)))
 	     (msg (checkdoc-this-string-valid)))
 	(if msg (if no-error
 		    (message (checkdoc-error-text msg))
-		  (error (checkdoc-error-text msg)))
+		  (error "%s" (checkdoc-error-text msg)))
 	  (setq msg (checkdoc-message-text-search beg end))
 	  (if msg (if no-error
 		      (message (checkdoc-error-text msg))
-		    (error (checkdoc-error-text msg)))
+		    (error "%s" (checkdoc-error-text msg)))
 	    (setq msg (checkdoc-rogue-space-check-engine beg end))
 	    (if msg (if no-error
 			(message (checkdoc-error-text msg))
-		      (error (checkdoc-error-text msg))))))
+		      (error "%s" (checkdoc-error-text msg))))))
 	(if (interactive-p) (message "Checkdoc: done."))))))
 ;;; Ispell interface for forcing a spell check
 ;;
 (define-minor-mode checkdoc-minor-mode
 "Toggle Checkdoc minor mode, a mode for checking Lisp doc strings.
 With prefix ARG, turn Checkdoc minor mode on iff ARG is positive.
 In Checkdoc minor mode, the usual bindings for `eval-defun' which is
-bound to \\<checkdoc-minor-mode-map> \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
+bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
 checking of documentation strings.
 \\{checkdoc-minor-mode-map}"
 nil " CDoc" nil
 :group 'checkdoc)
 ;; It is not practical to use `\\[...]' very many times, because
 ;; display of the documentation string will become slow.  So use this
 ;; to describe the most important commands in your major mode, and
 ;; then use `\\{...}' to display the rest of the mode's keymap.
 (save-excursion
-(if (re-search-forward "\\\\\\\\\\[\\w+" e t
+(if (and (re-search-forward "\\\\\\\\\\[\\w+" e t
-			      (1+ checkdoc-max-keyref-before-warn))
+				   (1+ checkdoc-max-keyref-before-warn))
+		(not (re-search-forward "\\\\\\\\{\\w+}" e t)))
 	   (checkdoc-create-error
 	    "Too many occurrences of \\[function].  Use \\{keymap} instead"
 	    s (marker-position e))))
 ;; Ambiguous quoted symbol.  When a symbol is both bound and fbound,
 ;; and is referred to in documentation, it should be prefixed with
 		     ;; We didn't actually replace anything.  Here we find
 		     ;; out what special word form they wish to use as
 		     ;; a prefix.
 		     (let ((disambiguate
 			    (completing-read
-			     "Disambiguating Keyword (default: variable): "
+			     "Disambiguating Keyword (default variable): "
 			     '(("function") ("command") ("variable")
 			       ("option") ("symbol"))
 			     nil t nil nil "variable")))
 		       (goto-char (1- mb))
 		       (insert disambiguate " ")
 	     ;;
 	     ;; This is the least important of the above tests.  Make sure
 	     ;; it occurs last.
 	     (and checkdoc-verb-check-experimental-flag
 		  (save-excursion
-		    ;; Maybe rebuild the monster-regex
+		    ;; Maybe rebuild the monster-regexp
 		    (checkdoc-create-common-verbs-regexp)
 		    (let ((lim (save-excursion
 				 (end-of-line)
 				 ;; check string-continuation
 				 (if (checkdoc-char= (preceding-char) ?\\)
 Since Ispell isn't Lisp-smart, we must pre-process the doc string
 before using the Ispell engine on it."
 (if (or (not checkdoc-spellcheck-documentation-flag)
 	  ;; If the user wants no questions or fixing, then we must
 	  ;; disable spell checking as not useful.
-;; FIXME: Somehow, `checkdoc-autofix-flag' is always nil
+	  (not checkdoc-autofix-flag)
-;; when `checkdoc-ispell-docstring-engine' is called to be
-;; used on a docstring.  As a workround, I commented out the
-;; next line.
-	  ;; (not checkdoc-autofix-flag)
 	  (eq checkdoc-autofix-flag 'never))
 nil
 (checkdoc-ispell-init)
 (save-excursion
 (skip-chars-forward "^a-zA-Z")
 	;; * A footer.  Not compartmentalized from lm-verify: too bad.
 	;;              The following is partially clipped from lm-verify
 	(save-excursion
 	  (goto-char (point-max))
 	  (if (not (re-search-backward
-		    (concat "^;;;[ \t]+" fn "\\(" (regexp-quote fe)
+		    (concat "^;;;[ \t]+" (regexp-quote fn) "\\(" (regexp-quote fe)
 			    "\\)?[ \t]+ends here[ \t]*$"
 			    "\\|^;;;[ \t]+ End of file[ \t]+"
-			    fn "\\(" (regexp-quote fe) "\\)?")
+			    (regexp-quote fn) "\\(" (regexp-quote fe) "\\)?")
 		    nil t))
 	      (if (checkdoc-y-or-n-p "No identifiable footer!  Add one? ")
 		  (progn
 		    (goto-char (point-max))
 		    (insert "\n(provide '" fn ")\n\n;;; " fn fe " ends here\n"))
 ;; Let's spellcheck the commentary section.  This is the only
 ;; section that is easy to pick out, and it is also the most
 ;; visible section (with the finder).
 (let ((cm (lm-commentary-mark)))
-	(if cm
+(when cm
-	    (save-excursion
+(save-excursion
-	      (goto-char (lm-commentary-mark))
+(goto-char cm)
-	      ;; Spellcheck between the commentary, and the first
+(let ((e (copy-marker (lm-commentary-end))))
-	      ;; non-comment line.  We could use lm-commentary, but that
+;; Since the comments talk about Lisp, use the
-	      ;; returns a string, and Ispell wants to talk to a buffer.
+;; specialized spell-checker we also used for doc
-	      ;; Since the comments talk about Lisp, use the specialized
+;; strings.
-	      ;; spell-checker we also used for doc strings.
+(checkdoc-sentencespace-region-engine (point) e)
-	      (let ((e (save-excursion (re-search-forward "^[^;]" nil t)
+(checkdoc-proper-noun-region-engine (point) e)
-				       (point))))
+(checkdoc-ispell-docstring-engine e)))))
-		(checkdoc-sentencespace-region-engine (point) e)
-		(checkdoc-proper-noun-region-engine (point) e)
-		(checkdoc-ispell-docstring-engine e)))))
-;;; test comment out code
-;;;       (foo 1 3)
-;;;       (bar 5 7)
 (setq
 err
 (or
 	;; Generic Full-file checks (should be comment related)
 	(checkdoc-run-hooks 'checkdoc-comment-style-hooks)
 	ret)))
 ;;; Warning management
 ;;
 (defvar checkdoc-output-font-lock-keywords
-'(("\\(\\w+\\.el\\): \\(\\w+\\)"
+'(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)"
 (1 font-lock-function-name-face)
-(2 font-lock-comment-face))
+(2 font-lock-comment-face)))
-("^\\(\\w+\\.el\\):" 1 font-lock-function-name-face)
-(":\\([0-9]+\\):" 1 font-lock-constant-face))
 "Keywords used to highlight a checkdoc diagnostic buffer.")
-(defvar checkdoc-output-mode-map nil
+(defvar checkdoc-output-error-regex-alist
-"Keymap used in `checkdoc-output-mode'.")
+'(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2)))
 (defvar checkdoc-pending-errors nil
 "Non-nil when there are errors that have not been displayed yet.")
-(if checkdoc-output-mode-map
+(define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc"
-nil
+"Set up the major mode for the buffer containing the list of errors."
-(setq checkdoc-output-mode-map (make-sparse-keymap))
+(set (make-local-variable 'compilation-error-regexp-alist)
-(if (not (string-match "XEmacs" emacs-version))
+checkdoc-output-error-regex-alist)
-(define-key checkdoc-output-mode-map [mouse-2]
+(set (make-local-variable 'compilation-mode-font-lock-keywords)
-	'checkdoc-find-error-mouse))
+checkdoc-output-font-lock-keywords))
-(define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error)
-(define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error))
-(defun checkdoc-output-mode ()
-"Create and setup the buffer used to maintain checkdoc warnings.
-\\<checkdoc-output-mode-map>\\[checkdoc-find-error]  - Go to this error location
-\\[checkdoc-find-error-mouse] - Goto the error clicked on."
-(if (get-buffer checkdoc-diagnostic-buffer)
-(get-buffer checkdoc-diagnostic-buffer)
-(save-excursion
-(set-buffer (get-buffer-create checkdoc-diagnostic-buffer))
-(kill-all-local-variables)
-(setq mode-name "Checkdoc"
-	    major-mode 'checkdoc-output-mode)
-(set (make-local-variable 'font-lock-defaults)
-	   '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
-(use-local-map checkdoc-output-mode-map)
-(run-hooks 'checkdoc-output-mode-hook)
-(current-buffer))))
-(defun checkdoc-find-error-mouse (e)
-;; checkdoc-params: (e)
-"Call `checkdoc-find-error' where the user clicks the mouse."
-(interactive "e")
-(mouse-set-point e)
-(checkdoc-find-error))
-(defun checkdoc-find-error ()
-"In a checkdoc diagnostic buffer, find the error under point."
-(interactive)
-(beginning-of-line)
-(if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):")
-(let ((l (string-to-int (match-string 3)))
-	    (f (match-string 1)))
-	(if (not (get-file-buffer f))
-	    (error "Can't find buffer %s" f))
-	(switch-to-buffer-other-window (get-file-buffer f))
-	(goto-line l))))
 (defun checkdoc-buffer-label ()
 "The name to use for a checkdoc buffer in the error list."
 (if (buffer-file-name)
-(file-name-nondirectory (buffer-file-name))
+(file-relative-name (buffer-file-name))
 (concat "#<buffer "(buffer-name) ">")))
 (defun checkdoc-start-section (check-type)
 "Initialize the checkdoc diagnostic buffer for a pass.
 Create the header so that the string CHECK-TYPE is displayed as the
 function called to create the messages."
-(checkdoc-output-to-error-buffer
+(let ((dir default-directory)
-"\n\n\C-l\n*** "
+	(label (checkdoc-buffer-label)))
-(checkdoc-buffer-label) ": " check-type " V " checkdoc-version))
+(with-current-buffer (get-buffer-create checkdoc-diagnostic-buffer)
+(checkdoc-output-mode)
+(setq default-directory dir)
+(goto-char (point-max))
+(insert "\n\n\C-l\n*** " label ": " check-type " V " checkdoc-version))))
 (defun checkdoc-error (point msg)
 "Store POINT and MSG as errors in the checkdoc diagnostic buffer."
 (setq checkdoc-pending-errors t)
-(checkdoc-output-to-error-buffer
+(let ((text (list "\n" (checkdoc-buffer-label) ":"
-"\n" (checkdoc-buffer-label) ":"
+		    (int-to-string
-(int-to-string (count-lines (point-min) (or point 1))) ": "
+		     (count-lines (point-min) (or point (point-min))))
-msg))
+		    ": " msg)))
+(with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
-(defun checkdoc-output-to-error-buffer (&rest text)
+(goto-char (point-max))
-"Place TEXT into the checkdoc diagnostic buffer."
+(apply 'insert text))))
-(save-excursion
-(set-buffer (checkdoc-output-mode))
-(goto-char (point-max))
-(apply 'insert text)))
 (defun checkdoc-show-diagnostics ()
 "Display the checkdoc diagnostic buffer in a temporary window."
 (if checkdoc-pending-errors
 (let ((b (get-buffer checkdoc-diagnostic-buffer)))
 (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")
 (add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
 (provide 'checkdoc)
+;;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
 ;;; checkdoc.el ends here

Mercurial > emacs

comparison lisp/emacs-lisp/checkdoc.el @ 88155:d7ddb3e565de