Function: autoload--make-defs-autoload

autoload--make-defs-autoload is a byte-compiled function defined in autoload.el.gz.

Signature

(autoload--make-defs-autoload DEFS FILE)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/autoload.el.gz
(defun autoload--make-defs-autoload (defs file)

  ;; Remove the defs that obey the rule that file foo.el (or
  ;; foo-mode.el) uses "foo-" as prefix.
  ;; FIXME: help--symbol-completion-table still doesn't know how to use
  ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix.
  ;;(let ((prefix
  ;;       (concat (substring file 0 (string-match "-mode\\'" file)) "-")))
  ;;  (dolist (def (prog1 defs (setq defs nil)))
  ;;    (unless (string-prefix-p prefix def)
  ;;      (push def defs))))

  ;; Then compute a small set of prefixes that cover all the
  ;; remaining definitions.
  (let* ((tree (let ((tree radix-tree-empty))
                 (dolist (def defs)
                   (setq tree (radix-tree-insert tree def t)))
                 tree))
         (prefixes nil))
    ;; Get the root prefixes, that we should include in any case.
    (radix-tree-iter-subtrees
     tree (lambda (prefix subtree)
            (push (cons prefix subtree) prefixes)))
    ;; In some cases, the root prefixes are too short, e.g. if you define
    ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
    (dolist (pair (prog1 prefixes (setq prefixes nil)))
      (let ((s (car pair)))
        (if (or (and (> (length s) 2)   ; Long enough!
                     ;; But don't use "def" from deffoo-pkg-thing.
                     (not (string= "def" s)))
                (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
                (radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
            (push pair prefixes) ;Keep it as is.
          (radix-tree-iter-subtrees
           (cdr pair) (lambda (prefix subtree)
                        (push (cons (concat s prefix) subtree) prefixes))))))
    ;; FIXME: The expansions done below are mostly pointless, such as
    ;; for `yenc', where we replace "yenc-" with an exhaustive list (5
    ;; elements).
    ;; (while
    ;;     (let ((newprefixes nil)
    ;;           (changes nil))
    ;;       (dolist (pair prefixes)
    ;;         (let ((prefix (car pair)))
    ;;           (if (or (> (length prefix) autoload-def-prefixes-max-length)
    ;;                   (radix-tree-lookup (cdr pair) ""))
    ;;               ;; No point splitting it any further.
    ;;               (push pair newprefixes)
    ;;             (setq changes t)
    ;;             (radix-tree-iter-subtrees
    ;;              (cdr pair) (lambda (sprefix subtree)
    ;;                           (push (cons (concat prefix sprefix) subtree)
    ;;                                 newprefixes))))))
    ;;       (and changes
    ;;            (<= (length newprefixes)
    ;;                autoload-def-prefixes-max-entries)
    ;;            (let ((new nil)
    ;;                  (old nil))
    ;;              (dolist (pair prefixes)
    ;;                (unless (memq pair newprefixes) ;Not old
    ;;                  (push pair old)))
    ;;              (dolist (pair newprefixes)
    ;;                (unless (memq pair prefixes) ;Not new
    ;;                  (push pair new)))
    ;;              (cl-assert new)
    ;;              (message "Expanding %S to %S"
    ;;                       (mapcar #'car old) (mapcar #'car new))
    ;;              t)
    ;;            (setq prefixes newprefixes)
    ;;            (< (length prefixes) autoload-def-prefixes-max-entries))))

    ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
    (when prefixes
      (let ((strings
             (mapcar
              (lambda (x)
                (let ((prefix (car x)))
                  (if (or (> (length prefix) 2) ;Long enough!
                          (and (eq (length prefix) 2)
                               (string-match "[[:punct:]]" prefix)))
                      prefix
                    ;; Some packages really don't follow the rules.
                    ;; Drop the most egregious cases such as the
                    ;; one-letter prefixes.
                    (let ((dropped ()))
                      (radix-tree-iter-mappings
                       (cdr x) (lambda (s _)
                                 (push (concat prefix s) dropped)))
                      (message "%s:0: Warning: Not registering prefix \"%s\".  Affects: %S"
                               file prefix dropped)
                      nil))))
              prefixes)))
        `(register-definition-prefixes ,file ',(sort (delq nil strings)
						     'string<))))))