Function: checkdoc-defun-info

checkdoc-defun-info is a byte-compiled function defined in checkdoc.el.gz.

Signature

(checkdoc-defun-info)

Documentation

Return a list of details about the current sexp.

It is a list of the form:
   (NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ...)
where NAME is the name, VARIABLE is t if this is a defvar, INTERACTIVE is nil if this is not an interactive function, otherwise it is the position of the interactive call, and PARAMETERS is a string which is the name of each variable in the function's argument list. The NODOCPARAMS is a sublist of parameters specified by a checkdoc comment for a given defun. If the first element is not a string, then the token checkdoc-order: <TOKEN> exists, and TOKEN is a symbol read from the comment.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/checkdoc.el.gz
(defun checkdoc-defun-info nil
  "Return a list of details about the current sexp.
It is a list of the form:
   (NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ...)
where NAME is the name, VARIABLE is t if this is a `defvar',
INTERACTIVE is nil if this is not an interactive function, otherwise
it is the position of the `interactive' call, and PARAMETERS is a
string which is the name of each variable in the function's argument
list.  The NODOCPARAMS is a sublist of parameters specified by a checkdoc
comment for a given defun.  If the first element is not a string, then
the token checkdoc-order: <TOKEN> exists, and TOKEN is a symbol read
from the comment."
  (save-excursion
    (beginning-of-defun)
    (let ((defun (looking-at
                  "(\\(?:cl-\\)?def\\(un\\|macro\\|subst\\|advice\\|generic\\|method\\)"))
	  (is-advice (looking-at "(defadvice"))
          (defun-depth (ppss-depth (syntax-ppss)))
	  (lst nil)
	  (ret nil)
	  (oo (make-vector 3 0)))	;substitute obarray for `read'
      (forward-char 1)
      (forward-sexp 1)
      (skip-chars-forward " \n\t")
      (setq ret
	    (list (buffer-substring-no-properties
		   (point) (progn (forward-sexp 1) (point)))))
      (if (not defun)
	  (setq ret (cons t ret))
	;; The variable spot
	(setq ret (cons nil ret))
	;; Interactive
	(save-excursion
          (push (and (re-search-forward "^\\s-*(interactive"
                                        (save-excursion
                                          (end-of-defun)
                                          (point))
                                        t)
                     ;; Disregard `interactive' from other parts of
                     ;; the function.
                     (= (ppss-depth (syntax-ppss))
                        (+ defun-depth 2))
                     (point))
                ret))
	(skip-chars-forward " \t\n")
	(let ((bss (buffer-substring (point) (save-excursion (forward-sexp 1)
							     (point))))
	      ;; Overload th main obarray so read doesn't intern the
	      ;; local symbols of the function we are checking.
	      ;; Without this we end up cluttering the symbol space w/
	      ;; useless symbols.
	      (obarray oo))
	  ;; Ok, check for checkdoc parameter comment here
	  (save-excursion
	    (setq ret
		  (cons
		   (let ((sl1 nil))
		     (if (re-search-forward ";\\s-+checkdoc-order:\\s-+"
					    (save-excursion (end-of-defun)
							    (point))
					    t)
			 (setq sl1 (list (cond ((looking-at "nil") 'no)
					       ((looking-at "t") 'yes)))))
		     (if (re-search-forward ";\\s-+checkdoc-params:\\s-+"
					    (save-excursion (end-of-defun)
							    (point))
					    t)
			 (let ((sl nil))
			   (goto-char (match-end 0))
			   (condition-case nil
			       (setq lst (read (current-buffer)))
			     (error (setq lst nil))) ; error in text
                           (if (not (listp lst)) ; not a list of args
                               (setq lst (list lst)))
			   (if (and lst (not (symbolp (car lst)))) ;weird arg
			       (setq lst nil))
			   (while lst
			     (setq sl (cons (symbol-name (car lst)) sl)
				   lst (cdr lst)))
			   (setq sl1 (append sl1 sl))))
		     sl1)
		   ret)))
	  ;; Read the list of parameters, but do not put the symbols in
	  ;; the standard obarray.
	  (setq lst (read bss)))
	;; This is because read will intern nil if it doesn't into the
	;; new obarray.
	(if (not (listp lst)) (setq lst nil))
	(unless is-advice
          ;; (car lst) can be something like ((foo bar) baz) from
          ;; cl-lib methods; flatten it:
	  (while lst
	    (setq ret (cons (symbol-name (car (flatten-tree (car lst)))) ret)
		  lst (cdr lst)))))
      (nreverse ret))))