unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 36b0b1e9cdf48878cfa081e83d6fc812feb71966 32432 bytes (raw)
name: lisp/emacs-lisp/loaddefs-gen.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
 
;;; loaddefs-gen.el --- generate loaddefs.el files  -*- lexical-binding: t -*-

;; Copyright (C) 2022 Free Software Foundation, Inc.

;; Keywords: maint
;; Package: emacs

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This package generates the main lisp/loaddefs.el file, as well as
;; all the other loaddefs files, like calendar/diary-loaddefs.el, etc.

;; The main entry point is `loaddefs-generate' (normally called
;; from loaddefs-generate-batch via lisp/Makefile).
;;
;; The "other" loaddefs files are specified either via a file-local
;; setting of `generated-autoload-file', or by specifying
;;
;;   ;;;###foo-autoload
;;
;; This makes the autoload go to foo-loaddefs.el in the current directory.
;; Normal ;;;###autoload specs go to the main loaddefs file.

;;; Code:

(require 'radix-tree)
(require 'lisp-mnt)
(require 'generate-lisp-file)

(defvar autoload-compute-prefixes t
  "If non-nil, autoload will add code to register the prefixes used in a file.
Standard prefixes won't be registered anyway.  I.e. if a file
\"foo.el\" defines variables or functions that use \"foo-\" as
prefix, that will not be registered.  But all other prefixes will
be included.")
(put 'autoload-compute-prefixes 'safe-local-variable #'booleanp)

(defvar autoload-ignored-definitions
  '("define-obsolete-function-alias"
    "define-obsolete-variable-alias"
    "define-category" "define-key"
    "defgroup" "defface" "defadvice"
    "def-edebug-spec"
    ;; Hmm... this is getting ugly:
    "define-widget"
    "define-erc-module"
    "define-erc-response-handler"
    "defun-rcirc-command")
  "List of strings naming definitions to ignore for prefixes.
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")

(defvar generated-autoload-file nil
  "File into which to write autoload definitions.
A Lisp file can set this in its local variables section to make
its autoloads go somewhere else.

If this is a relative file name, the directory is determined as
follows:
 - If a Lisp file defined `generated-autoload-file' as a
   file-local variable, use its containing directory.
 - Otherwise use the \"lisp\" subdirectory of `source-directory'.

The autoload file is assumed to contain a trailer starting with a
FormFeed character.")
;;;###autoload
(put 'generated-autoload-file 'safe-local-variable 'stringp)

(defvar generated-autoload-load-name nil
  "Load name for `autoload' statements generated from autoload cookies.
If nil, this defaults to the file name, sans extension.
Typically, you need to set this when the directory containing the file
is not in `load-path'.
This also affects the generated cus-load.el file.")
;;;###autoload
(put 'generated-autoload-load-name 'safe-local-variable 'stringp)

(defun loaddefs-generate--file-load-name (file outfile)
  "Compute the name that will be used to load FILE.
OUTFILE should be the name of the global loaddefs.el file, which
is expected to be at the root directory of the files we are
scanning for autoloads and will be in the `load-path'."
  (let* ((name (file-relative-name file (file-name-directory outfile)))
         (names '())
         (dir (file-name-directory outfile)))
    ;; If `name' has directory components, only keep the
    ;; last few that are really needed.
    (while name
      (setq name (directory-file-name name))
      (push (file-name-nondirectory name) names)
      (setq name (file-name-directory name)))
    (while (not name)
      (cond
       ((null (cdr names)) (setq name (car names)))
       ((file-exists-p (expand-file-name "subdirs.el" dir))
        ;; FIXME: here we only check the existence of subdirs.el,
        ;; without checking its content.  This makes it generate wrong load
        ;; names for cases like lisp/term which is not added to load-path.
        (setq dir (expand-file-name (pop names) dir)))
       (t (setq name (mapconcat #'identity names "/")))))
    (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
        (substring name 0 (match-beginning 0))
      name)))

(defun loaddefs-generate--make-autoload (form file &optional expansion)
  "Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
or macro definition or a defcustom).
If EXPANSION is non-nil, we're processing the macro expansion of an
expression, in which case we want to handle forms differently."
  (let ((car (car-safe form)) expand)
    (cond
     ((and expansion (eq car 'defalias))
      (pcase-let*
          ((`(,_ ,_ ,arg . ,rest) form)
           ;; `type' is non-nil if it defines a macro.
           ;; `fun' is the function part of `arg' (defaults to `arg').
           ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
                (and (let fun arg) (let type nil)))
            arg)
           ;; `lam' is the lambda expression in `fun' (or nil if not
           ;; recognized).
           (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
           ;; `args' is the list of arguments (or t if not recognized).
           ;; `body' is the body of `lam' (or t if not recognized).
           ((or `(lambda ,args . ,body)
                (and (let args t) (let body t)))
            lam)
           ;; Get the `doc' from `body' or `rest'.
           (doc (cond ((stringp (car-safe body)) (car body))
                      ((stringp (car-safe rest)) (car rest))))
           ;; Look for an interactive spec.
           (interactive (pcase body
                          ((or `((interactive . ,iargs) . ,_)
                               `(,_ (interactive . ,iargs) . ,_))
                           ;; List of modes or just t.
                           (if (nthcdr 1 iargs)
                               (list 'quote (nthcdr 1 iargs))
                             t)))))
        ;; Add the usage form at the end where describe-function-1
        ;; can recover it.
        (when (consp args) (setq doc (help-add-fundoc-usage doc args)))
        ;; (message "autoload of %S" (nth 1 form))
        `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))

     ((and expansion (memq car '(progn prog1)))
      (let ((end (memq :autoload-end form)))
	(when end             ;Cut-off anything after the :autoload-end marker.
          (setq form (copy-sequence form))
          (setcdr (memq :autoload-end form) nil))
        (let ((exps (delq nil (mapcar (lambda (form)
                                        (loaddefs-generate--make-autoload
                                         form file expansion))
                                      (cdr form)))))
          (when exps (cons 'progn exps)))))

     ;; For complex cases, try again on the macro-expansion.
     ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
                       define-globalized-minor-mode defun defmacro
		       easy-mmode-define-minor-mode define-minor-mode
                       define-inline cl-defun cl-defmacro cl-defgeneric
                       cl-defstruct pcase-defmacro iter-defun cl-iter-defun
                       transient-define-prefix))
           (macrop car)
	   (setq expand (let ((load-true-file-name file)
                              (load-file-name file))
                          (macroexpand form)))
	   (memq (car expand) '(progn prog1 defalias)))
      ;; Recurse on the expansion.
      (loaddefs-generate--make-autoload expand file 'expansion))

     ;; For special function-like operators, use the `autoload' function.
     ((memq car '(define-skeleton define-derived-mode
                   define-compilation-mode define-generic-mode
		   easy-mmode-define-global-mode define-global-minor-mode
		   define-globalized-minor-mode
		   easy-mmode-define-minor-mode define-minor-mode
		   cl-defun defun* cl-defmacro defmacro*
                   define-overloadable-function))
      (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
	     (name (nth 1 form))
	     (args (pcase car
                     ((or 'defun 'defmacro
                          'defun* 'defmacro* 'cl-defun 'cl-defmacro
                          'define-overloadable-function)
                      (nth 2 form))
                     ('define-skeleton '(&optional str arg))
                     ((or 'define-generic-mode 'define-derived-mode
                          'define-compilation-mode)
                      nil)
                     (_ t)))
	     (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
	     (doc (if (stringp (car body)) (pop body))))
        ;; Add the usage form at the end where describe-function-1
        ;; can recover it.
	(when (listp args) (setq doc (help-add-fundoc-usage doc args)))
        ;; `define-generic-mode' quotes the name, so take care of that
        `(autoload ,(if (listp name) name (list 'quote name))
           ,file ,doc
           ,(or (and (memq car '(define-skeleton define-derived-mode
                                  define-generic-mode
                                  easy-mmode-define-global-mode
                                  define-global-minor-mode
                                  define-globalized-minor-mode
                                  easy-mmode-define-minor-mode
                                  define-minor-mode))
                     t)
                (and (eq (car-safe (car body)) 'interactive)
                     ;; List of modes or just t.
                     (or (if (nthcdr 1 (car body))
                             (list 'quote (nthcdr 1 (car body)))
                           t))))
           ,(if macrop ''macro nil))))

     ;; For defclass forms, use `eieio-defclass-autoload'.
     ((eq car 'defclass)
      (let ((name (nth 1 form))
	    (superclasses (nth 2 form))
	    (doc (nth 4 form)))
	(list 'eieio-defclass-autoload (list 'quote name)
	      (list 'quote superclasses) file doc)))

     ;; Convert defcustom to less space-consuming data.
     ((eq car 'defcustom)
      (let* ((varname (car-safe (cdr-safe form)))
	     (props (nthcdr 4 form))
	     (initializer (plist-get props :initialize))
	     (init (car-safe (cdr-safe (cdr-safe form))))
	     (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
	     ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
	     )
	`(progn
	   ,(if (not (member initializer '(nil 'custom-initialize-default
	                                   #'custom-initialize-default
	                                   'custom-initialize-reset
	                                   #'custom-initialize-reset)))
	        form
	      `(defvar ,varname ,init ,doc))
	   ;; When we include the complete `form', this `custom-autoload'
           ;; is not indispensable, but it still helps in case the `defcustom'
           ;; doesn't specify its group explicitly, and probably in a few other
           ;; corner cases.
	   (custom-autoload ',varname ,file
                            ,(condition-case nil
                                 (null (plist-get props :set))
                               (error nil)))
           ;; Propagate the :safe property to the loaddefs file.
           ,@(when-let ((safe (plist-get props :safe)))
               `((put ',varname 'safe-local-variable ,safe))))))

     ((eq car 'defgroup)
      ;; In Emacs this is normally handled separately by cus-dep.el, but for
      ;; third party packages, it can be convenient to explicitly autoload
      ;; a group.
      (let ((groupname (nth 1 form)))
        `(let ((loads (get ',groupname 'custom-loads)))
           (if (member ',file loads) nil
             (put ',groupname 'custom-loads (cons ',file loads))))))

     ;; When processing a macro expansion, any expression
     ;; before a :autoload-end should be included.  These are typically (put
     ;; 'fun 'prop val) and things like that.
     ((and expansion (consp form)) form)

     ;; nil here indicates that this is not a special autoload form.
     (t nil))))

(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<))))))

(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)
        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))))))

      ;; 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 (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)
          (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))

(defun loaddefs-generate--compute-prefixes (load-name)
  (goto-char (point-min))
  (let ((prefs nil))
    ;; Avoid (defvar <foo>) by requiring a trailing space.
    (while (re-search-forward
            "^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
      (unless (member (match-string 1) autoload-ignored-definitions)
        (let ((name (match-string-no-properties 2)))
          (when (save-excursion
                  (goto-char (match-beginning 0))
                  (or (bobp)
                      (progn
                        (forward-line -1)
                        (not (looking-at ";;;###autoload")))))
            (push name prefs)))))
    (loaddefs-generate--make-prefixes prefs load-name)))

(defun loaddefs-generate--rubric (file &optional type feature compile)
  "Return a string giving the appropriate autoload rubric for FILE.
TYPE (default \"autoloads\") is a string stating the type of
information contained in FILE.  TYPE \"package\" acts like the default,
but adds an extra line to the output to modify `load-path'.

If FEATURE is non-nil, FILE will provide a feature.  FEATURE may
be a string naming the feature, otherwise it will be based on
FILE's name.

If COMPILE, don't include a \"don't compile\" cookie."
  (let ((lp (and (equal type "package") (setq type "autoloads"))))
    (with-temp-buffer
      (generate-lisp-file-heading
       file 'loaddefs-generate
       :title (concat "automatically extracted " (or type "autoloads"))
       :commentary (and (string-match "/lisp/loaddefs\\.el\\'" file)
                        "This file will be copied to ldefs-boot.el and checked in periodically."))
      (when lp
        (insert "(add-to-list 'load-path (directory-file-name
                         (or (file-name-directory #$) (car load-path))))\n\n"))
      (insert "\f\n;;; End of scraped data\n\n")
      (generate-lisp-file-trailer
       file :provide (and (stringp feature) feature)
       :compile compile
       :inhibit-provide (not feature))
      (buffer-string))))

(defun loaddefs-generate--insert-section-header (outbuf autoloads
                                                        load-name file time)
  "Insert into buffer OUTBUF the section-header line for FILE.
The header line lists the file name, its \"load name\", its autoloads,
and the time the FILE was last updated (the time is inserted only
if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
  (insert "\f\n;;;### ")
  (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
	 outbuf)
  (terpri outbuf)
  ;; Break that line at spaces, to avoid very long lines.
  ;; Make each sub-line into a comment.
  (with-current-buffer outbuf
    (save-excursion
      (forward-line -1)
      (while (not (eolp))
	(move-to-column 64)
	(skip-chars-forward "^ \n")
	(or (eolp)
	    (insert "\n" ";;;;;; "))))))

;;;###autoload
(defun loaddefs-generate (dir output-file &optional excluded-files
                              extra-data include-package-version
                              generate-full)
  "Generate loaddefs files for Lisp files in the directories DIRS.
DIR can be either a single directory or a list of directories.

The autoloads will be written to OUTPUT-FILE.  If any Lisp file
binds `generated-autoload-file' as a file-local variable, write
its autoloads into the specified file instead.

The function does NOT recursively descend into subdirectories of the
directory or directories specified.

If EXTRA-DATA, include this string at the start of the generated
file.  This will also force generation of OUTPUT-FILE even if
there are no autoloads to put into the file.

If INCLUDE-PACKAGE-VERSION, include package version data.

If GENERATE-FULL, don't update, but regenerate all the loaddefs files."
  (let* ((files-re (let ((tmp nil))
		     (dolist (suf (get-load-suffixes))
                       ;; We don't use module-file-suffix below because
                       ;; we don't want to depend on whether Emacs was
                       ;; built with or without modules support, nor
                       ;; what is the suffix for the underlying OS.
		       (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf)
                         (push suf tmp)))
                     (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'")))
	 (files (apply #'nconc
		       (mapcar (lambda (d)
				 (directory-files (expand-file-name d)
                                                  t files-re))
			       (if (consp dir) dir (list dir)))))
         (updating (and (file-exists-p output-file) (not generate-full)))
         (defs nil))

    ;; Collect all the autoload data.
    (let ((progress (make-progress-reporter
                     (byte-compile-info
                      (concat "Scraping files for loaddefs"))
                     0 (length files) nil 10))
          (output-time
           (file-attribute-modification-time (file-attributes output-file)))
          (file-count 0))
      (dolist (file files)
        (progress-reporter-update progress (setq file-count (1+ file-count)))
        (when (or (not updating)
                  (time-less-p output-time
                               (file-attribute-modification-time
                                (file-attributes file))))
          (setq defs (nconc
		      (loaddefs-generate--parse-file
                       file output-file
                       ;; We only want the package name from the
                       ;; excluded files.
                       (and include-package-version
                            (if (member (expand-file-name file) excluded-files)
                                'only
                              t)))
                      defs))))
      (progress-reporter-done progress))

    ;; If we have no autoloads data, but we have EXTRA-DATA, then
    ;; generate the (almost) empty file anyway.
    (if (and (not defs) extra-data)
        (with-temp-buffer
          (insert (loaddefs-generate--rubric output-file nil t))
          (search-backward "\f")
          (insert extra-data)
          (ensure-empty-lines 1)
          (write-region (point-min) (point-max) output-file nil 'silent))
      ;; We have some data, so generate the loaddef files.  First
      ;; group per output file.
      (dolist (fdefs (seq-group-by #'car defs))
        (let ((loaddefs-file (car fdefs)))
          (with-temp-buffer
            (if (and updating (file-exists-p loaddefs-file))
                (insert-file-contents loaddefs-file)
              (insert (loaddefs-generate--rubric loaddefs-file nil t))
              (search-backward "\f")
              (when extra-data
                (insert extra-data)
                (ensure-empty-lines 1)))
            ;; Then group by source file (and sort alphabetically).
            (dolist (section (sort (seq-group-by #'cadr (cdr fdefs))
                                   (lambda (e1 e2)
                                     (string<
                                      (file-name-sans-extension
                                       (file-name-nondirectory (car e1)))
                                      (file-name-sans-extension
                                       (file-name-nondirectory (car e2)))))))
              (pop section)
              (let* ((relfile (file-relative-name
                               (cadar section)
                               (file-name-directory loaddefs-file)))
                     (head (concat "\n\f\n;;; Generated autoloads from "
                                   relfile "\n\n")))
                (when (file-exists-p loaddefs-file)
                  ;; If we're updating an old loaddefs file, then see if
                  ;; there's a section here for this file already.
                  (goto-char (point-min))
                  (if (not (search-forward head nil t))
                      ;; It's a new file; put the data at the end.
                      (progn
                        (goto-char (point-max))
                        (search-backward "\f\n"))
                    ;; Delete the old version of the section.
                    (delete-region (match-beginning 0)
                                   (and (search-forward "\n\f\n;;;")
                                        (match-beginning 0)))
                    (forward-line -2)))
                (insert head)
                (dolist (def (reverse section))
                  (setq def (caddr def))
                  (if (stringp def)
                      (princ def (current-buffer))
                    (loaddefs-generate--print-form def))
                  (unless (bolp)
                    (insert "\n")))))
            (write-region (point-min) (point-max) loaddefs-file nil 'silent)
            (byte-compile-info (file-relative-name loaddefs-file lisp-directory)
                               t "GEN")))))))

(defun loaddefs-generate--print-form (def)
  "Print DEF in the way make-docfile.c expects it."
  (if (or (not (consp def))
          (not (symbolp (car def)))
          (memq (car def) '( make-obsolete
                             define-obsolete-function-alias))
          (not (stringp (nth 3 def))))
      (prin1 def (current-buffer) t)
    ;; The salient point here is that we have to have the doc string
    ;; that starts with a backslash and a newline, and there mustn't
    ;; be any newlines before that.  So -- typically
    ;; (defvar foo 'value "\
    ;; Doc string" ...).
    (insert "(")
    (dotimes (_ 3)
      (prin1 (pop def) (current-buffer)
             '(t (escape-newlines . t)
                 (escape-control-characters . t)))
      (insert " "))
    (let ((start (point)))
      (prin1 (pop def) (current-buffer) t)
      (save-excursion
        (goto-char (1+ start))
        (insert "\\\n")))
    (while def
      (insert " ")
      (prin1 (pop def) (current-buffer) t))
    (insert ")")))

(defun loaddefs-generate--excluded-files ()
  ;; Exclude those files that are preloaded on ALL platforms.
  ;; These are the ones in loadup.el where "(load" is at the start
  ;; of the line (crude, but it works).
  (let ((default-directory (file-name-directory lisp-directory))
        (excludes nil)
	file)
    (with-temp-buffer
      (insert-file-contents "loadup.el")
      (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
	(setq file (match-string 1))
	(or (string-match "\\.el\\'" file)
	    (setq file (format "%s.el" file)))
	(or (string-match "\\`site-" file)
	    (push (expand-file-name file) excludes))))
    ;; Don't scan ldefs-boot.el, either.
    (cons (expand-file-name "ldefs-boot.el") excludes)))

;;;###autoload
(defun loaddefs-generate-batch ()
  "Generate loaddefs.el files in batch mode.
This scans for ;;;###autoload forms and related things.

The first element on the command line should be the (main)
loaddefs.el output file, and the rest are the directories to
use."
  (let ((args command-line-args-left))
    (setq command-line-args-left nil)
    (loaddefs-generate (cdr args) (expand-file-name (car args)))))

(defun loaddefs-generate--emacs-batch ()
  "Generate the loaddefs for the Emacs build.
This is like `loaddefs-generate-batch', but has some specific
rules for built-in packages and excluded files."
  (let ((args command-line-args-left)
        (output-file (expand-file-name "loaddefs.el" lisp-directory)))
    (setq command-line-args-left nil)
    (loaddefs-generate
     args output-file
     (loaddefs-generate--excluded-files)
     nil t
     ;; Always do a complete update if loaddefs-gen.el has been
     ;; updated.
     (file-newer-than-file-p
      (expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory)
      output-file))))

(provide 'loaddefs-gen)

;;; loaddefs-gen.el ends here

debug log:

solving 36b0b1e9cd ...
found 36b0b1e9cd in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).