Function: bytecomp--check-cus-type

bytecomp--check-cus-type is a byte-compiled function defined in bytecomp.el.gz.

Signature

(bytecomp--check-cus-type TYPE)

Documentation

Warn about common mistakes in the defcustom type TYPE.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/bytecomp.el.gz
(defun bytecomp--check-cus-type (type)
  "Warn about common mistakes in the `defcustom' type TYPE."
  (let ((invalid-types
         '(
           ;; Lisp type predicates, often confused with customization types:
           functionp numberp integerp fixnump natnump floatp booleanp
           characterp listp stringp consp vectorp symbolp keywordp
           hash-table-p facep
           ;; other mistakes occasionally seen (oh yes):
           or and nil t
           interger intger lits bool boolen constant filename
           kbd any list-of auto
           ;; from botched backquoting
           \, \,@ \`
           )))
    (cond
     ((consp type)
      (let* ((head (car type))
             (tail (cdr type)))
        (while (and (keywordp (car tail)) (cdr tail))
          (setq tail (cddr tail)))
        (cond
         ((plist-member (cdr type) :convert-widget) nil)
         ((let ((tl tail))
            (and (not (keywordp (car tail)))
                 (progn
                   (while (and tl (not (keywordp (car tl))))
                     (setq tl (cdr tl)))
                   (and tl
                        (progn
                          (bytecomp--cus-warn
                           tl "misplaced %S keyword in `%S' type" (car tl) head)
                          t))))))
         ((memq head '(choice radio))
          (unless tail
            (bytecomp--cus-warn type "`%S' without any types inside" head))
          (let ((clauses tail)
                (constants nil)
                (tags nil))
            (while clauses
              (let* ((ty (car clauses))
                     (ty-head (car-safe ty)))
                (when (and (eq ty-head 'other) (cdr clauses))
                  (bytecomp--cus-warn ty "`other' not last in `%S'" head))
                (when (memq ty-head '(const other))
                  (let ((ty-tail (cdr ty))
                        (val nil))
                    (while (and (keywordp (car ty-tail)) (cdr ty-tail))
                      (when (eq (car ty-tail) :value)
                        (setq val (cadr ty-tail)))
                      (setq ty-tail (cddr ty-tail)))
                    (when ty-tail
                      (setq val (car ty-tail)))
                    (when (member val constants)
                      (bytecomp--cus-warn
                       ty "duplicated value in `%S': `%S'" head val))
                    (push val constants)))
                (let ((tag (and (consp ty) (plist-get (cdr ty) :tag))))
                  (when (stringp tag)
                    (when (member tag tags)
                      (bytecomp--cus-warn
                       ty "duplicated :tag string in `%S': %S" head tag))
                    (push tag tags)))
                (bytecomp--check-cus-type ty))
              (setq clauses (cdr clauses)))))
         ((eq head 'cons)
          (unless (= (length tail) 2)
            (bytecomp--cus-warn
             type "`cons' requires 2 type specs, found %d" (length tail)))
          (dolist (ty tail)
            (bytecomp--check-cus-type ty)))
         ((memq head '(list group vector set repeat))
          (unless tail
            (bytecomp--cus-warn type "`%S' without type specs" head))
          (dolist (ty tail)
            (bytecomp--check-cus-type ty)))
         ((memq head '(alist plist))
          (let ((key-tag (memq :key-type (cdr type)))
                (value-tag (memq :value-type (cdr type))))
            (when key-tag
              (bytecomp--check-cus-type (cadr key-tag)))
            (when value-tag
              (bytecomp--check-cus-type (cadr value-tag)))))
         ((memq head '(const other))
          (let* ((value-tag (memq :value (cdr type)))
                 (n (length tail))
                 (val (car tail)))
            (cond
             ((or (> n 1) (and value-tag tail))
              (bytecomp--cus-warn type "`%S' with too many values" head))
             (value-tag
              (setq val (cadr value-tag)))
             ;; ;; This is a useful check but it results in perhaps
             ;; ;; a bit too many complaints.
             ;; ((null tail)
             ;;  (bytecomp--cus-warn
             ;;   type "`%S' without value is implicitly nil" head))
             )
            (when (memq (car-safe val) '(quote function))
              (bytecomp--cus-warn type "`%S' with quoted value: %S" head val))))
         ((eq head 'quote)
          (bytecomp--cus-warn type "type should not be quoted: %S" (cadr type)))
         ((memq head invalid-types)
          (bytecomp--cus-warn type "`%S' is not a valid type" head))
         ((or (not (symbolp head)) (keywordp head))
          (bytecomp--cus-warn type "irregular type `%S'" head))
         )))
     ((or (not (symbolp type)) (keywordp type))
      (bytecomp--cus-warn type "irregular type `%S'" type))
     ((memq type '( list cons group vector choice radio const other
                    function-item variable-item set repeat restricted-sexp))
      (bytecomp--cus-warn type "`%S' without arguments" type))
     ((memq type invalid-types)
      (bytecomp--cus-warn type "`%S' is not a valid type" type))
     )))