Function: loaddefs-generate--parse-file

loaddefs-generate--parse-file is a byte-compiled function defined in loaddefs-gen.el.gz.

Signature

(loaddefs-generate--parse-file FILE MAIN-OUTFILE &optional PACKAGE-DATA)

Documentation

Examining FILE for ;;;###autoload statements.

MAIN-OUTFILE is the main loaddefs file these statements are destined for, but this can be overridden by the buffer-local setting of generated-autoload-file in FILE, and by ;;;###foo-autoload statements.

If PACKAGE-DATA is only, return only the package data. If t, include the package data with the rest of the data. Otherwise, don't include.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/loaddefs-gen.el.gz
(defun loaddefs-generate--parse-file (file main-outfile &optional package-data)
  "Examining FILE for ;;;###autoload statements.
MAIN-OUTFILE is the main loaddefs file these statements are
destined for, but this can be overridden by the buffer-local
setting of `generated-autoload-file' in FILE, and
by ;;;###foo-autoload statements.

If PACKAGE-DATA is `only', return only the package data.  If t,
include the package data with the rest of the data.  Otherwise,
don't include."
  (let ((defs nil)
        (load-name (loaddefs-generate--file-load-name file main-outfile))
        (compute-prefixes t)
        read-symbol-shorthands
        local-outfile inhibit-autoloads)
    (with-temp-buffer
      (insert-file-contents file)
      (goto-char (point-max))
      ;; We "open-code" this version of `hack-local-variables',
      ;; because it's really slow in bootstrap-emacs.
      (when (search-backward ";; Local Variables:" (- (point-max) 1000) t)
        (save-excursion
          (when (re-search-forward "generated-autoload-file: *" nil t)
            ;; Buffer-local file that should be interpreted relative to
            ;; the .el file.
            (setq local-outfile (expand-file-name (read (current-buffer))
                                                  (file-name-directory file)))))
        (save-excursion
          (when (re-search-forward "generated-autoload-load-name: *" nil t)
            (setq load-name (read (current-buffer)))))
        (save-excursion
          (when (re-search-forward "no-update-autoloads: *" nil t)
            (setq inhibit-autoloads (read (current-buffer)))))
        (save-excursion
          (when (re-search-forward "autoload-compute-prefixes: *" nil t)
            (setq compute-prefixes (read (current-buffer)))))
        (save-excursion
          ;; Since we're "open-coding", we have to repeat more
          ;; complicated logic in `hack-local-variables'.
          (when-let ((beg
                      (re-search-forward "read-symbol-shorthands: *" nil t)))
            ;; `read-symbol-shorthands' alist ends with two parens.
            (let* ((end (re-search-forward ")[;\n\s]*)"))
                   (commentless (replace-regexp-in-string
                                 "\n\\s-*;+" ""
                                 (buffer-substring beg end)))
                   (unsorted-shorthands (car (read-from-string commentless))))
              (setq read-symbol-shorthands
                    (sort unsorted-shorthands
                          (lambda (sh1 sh2)
                            (> (length (car sh1)) (length (car sh2))))))))))

      ;; We always return the package version (even for pre-dumped
      ;; files).
      (if (not package-data)
          ;; We have to switch `emacs-lisp-mode' when scanning
          ;; loaddefs for packages so that `syntax-ppss' later gives
          ;; correct results.
          (emacs-lisp-mode)
        (let ((version (lm-header "version"))
              package)
          (when (and version
                     (setq version (ignore-errors (version-to-list version)))
                     (setq package (or (lm-header "package")
                                       (file-name-sans-extension
                                        (file-name-nondirectory file)))))
            (push (list (or local-outfile main-outfile) file
                        `(push (purecopy ',(cons (intern package) version))
                               package--builtin-versions))
                  defs))))

      ;; Obey the `no-update-autoloads' file local variable.
      (when (and (not inhibit-autoloads)
                 (not (eq package-data 'only)))
        (goto-char (point-min))
        ;; The cookie might be like ;;;###tramp-autoload...
        (while (re-search-forward lisp-mode-autoload-regexp nil t)
          (when (or package-data
                    ;; Outside of the main Emacs build (`package-data'
                    ;; is set in the Emacs build), check that we don't
                    ;; have an autoload cookie on the first column of a
                    ;; doc string or the like.  (The Emacs tree
                    ;; shouldn't contain any such instances.)
                    (not (ppss-string-terminator
                          (save-match-data (syntax-ppss)))))
            ;; ... and if we have one of these names, then alter outfile.
            (let* ((aname (match-string 2))
                   (to-file (if aname
                                (expand-file-name
                                 (concat aname "-loaddefs.el")
                                 (file-name-directory file))
                              (or local-outfile main-outfile))))
              (if (eolp)
                  ;; We have a form following.
                  (let* ((form (prog1
                                   (read (current-buffer))
                                 (unless (bolp)
                                   (forward-line 1))))
                         (autoload (or (loaddefs-generate--make-autoload
                                        form load-name)
                                       form)))
                    ;; We get back either an autoload form, or a tree
                    ;; structure of `(progn ...)' things, so unravel that.
                    (let ((forms (if (eq (car autoload) 'progn)
                                     (cdr autoload)
                                   (list autoload))))
                      (while forms
                        (let ((elem (pop forms)))
                          (if (eq (car elem) 'progn)
                              ;; More recursion; add it to the start.
                              (setq forms (nconc (cdr elem) forms))
                            ;; We have something to add to the defs; do it.
                            (push (list to-file file elem) defs))))))
                ;; Just put the rest of the line into the loaddefs.
                ;; FIXME: We skip the first space if there's more
                ;; whitespace after.
                (when (looking-at-p " [\t ]")
                  (forward-char 1))
                (push (list to-file file
                            (buffer-substring (point) (line-end-position)))
                      defs)))))

        (when (and autoload-compute-prefixes
                   compute-prefixes)
          (with-demoted-errors "%S"
            (when-let
                ((form (loaddefs-generate--compute-prefixes load-name)))
              ;; This output needs to always go in the main loaddefs.el,
              ;; regardless of `generated-autoload-file'.
              (push (list main-outfile file form) defs))))))
    defs))