Function: loaddefs-generate--make-prefixes

loaddefs-generate--make-prefixes is a byte-compiled function defined in loaddefs-gen.el.gz.

Signature

(loaddefs-generate--make-prefixes DEFS FILE)

Aliases

autoload--make-defs-autoload

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/loaddefs-gen.el.gz
(defun loaddefs-generate--make-prefixes (defs file)
  ;; Remove the defs that obey the rule that file foo.el (or
  ;; foo-mode.el) uses "foo-" as prefix.  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))))))
    (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<))))))