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
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
|
;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
;; Copyright (C) 1991-1997, 2001-2016 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
;; date. It interprets magic cookies of the form ";;;###autoload" in
;; lisp source files in various useful ways. To learn more, read the
;; source; if you're going to use this, you'd better be able to.
;;; Code:
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'lisp-mnt)
(eval-when-compile (require 'cl-lib))
(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)
;; This feels like it should be a defconst, but MH-E sets it to
;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
(defvar generate-autoload-cookie ";;;###autoload"
"Magic comment indicating the following form should be autoloaded.
Used by \\[update-file-autoloads]. This string should be
meaningless to Lisp (e.g., a comment).
This string is used:
\;;;###autoload
\(defun function-to-be-autoloaded () ...)
If this string appears alone on a line, the following form will be
read and an autoload made for it. If there is further text on the line,
that text will be copied verbatim to `generated-autoload-file'.")
(defvar autoload-excludes nil
"If non-nil, list of absolute file names not to scan for autoloads.")
(defconst generate-autoload-section-header "\f\n;;;### "
"String that marks the form at the start of a new file's autoload section.")
(defconst generate-autoload-section-trailer "\n;;;***\n"
"String which indicates the end of the section of autoloads for a file.")
(defconst generate-autoload-section-continuation ";;;;;; "
"String to add on each continuation of the section header form.")
;; In some ways it would be nicer to use a value that is recognizably
;; not a time-value, eg t, but that can cause issues if an older Emacs
;; that does not expect non-time-values loads the file.
(defconst autoload--non-timestamp '(0 0 0 0)
"Value to insert when `autoload-timestamps' is nil.")
(defvar autoload-timestamps nil ; experimental, see bug#22213
"Non-nil means insert a timestamp for each input file into the output.
We use these in incremental updates of the output file to decide
if we need to rescan an input file. If you set this to nil,
then we use the timestamp of the output file instead. As a result:
- for fixed inputs, the output will be the same every time
- incremental updates of the output file might not be correct if:
i) the timestamp of the output file cannot be trusted (at least
relative to that of the input files)
ii) any of the input files can be modified during the time it takes
to create the output
iii) only a subset of the input files are scanned
These issues are unlikely to happen in practice, and would arguably
represent bugs in the build system. Item iii) will happen if you
use a command like `update-file-autoloads', though, since it only
checks a single input file.")
(defvar autoload-modified-buffers) ;Dynamically scoped var.
(defun 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 . ,_) . ,_)
`(,_ (interactive . ,_) . ,_))
t))))
;; 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)))
;; (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)
(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))
(macrop car)
(setq expand (let ((load-file-name file)) (macroexpand form)))
(memq (car expand) '(progn prog1 defalias)))
(make-autoload expand file 'expansion)) ;Recurse on the 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)
(eq (car-safe (car body)) 'interactive))
,(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)))
(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
(defvar ,varname ,init ,doc)
(custom-autoload ',varname ,file
,(condition-case nil
(null (cadr (memq :set form)))
(error nil))))))
((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))))
;; Forms which have doc-strings which should be printed specially.
;; A doc-string-elt property of ELT says that (nth ELT FORM) is
;; the doc-string in FORM.
;; Those properties are now set in lisp-mode.el.
(defun autoload-find-generated-file ()
"Visit the autoload file for the current buffer, and return its buffer.
If a buffer is visiting the desired autoload file, return it."
(let ((enable-local-variables :safe)
(enable-local-eval nil))
;; We used to use `raw-text' to read this file, but this causes
;; problems when the file contains non-ASCII characters.
(let* ((delay-mode-hooks t)
(file (autoload-generated-file))
(file-missing (not (file-exists-p file))))
(when file-missing
(autoload-ensure-default-file file))
(with-current-buffer
(find-file-noselect
(autoload-ensure-file-writeable
file))
;; block backups when the file has just been created, since
;; the backups will just be the auto-generated headers.
;; bug#23203
(when file-missing
(setq buffer-backed-up t)
(save-buffer))
(current-buffer)))))
(defun autoload-generated-file ()
(expand-file-name generated-autoload-file
;; File-local settings of generated-autoload-file should
;; be interpreted relative to the file's location,
;; of course.
(if (not (local-variable-p 'generated-autoload-file))
(expand-file-name "lisp" source-directory))))
(defun autoload-read-section-header ()
"Read a section header form.
Since continuation lines have been marked as comments,
we must copy the text of the form and remove those comment
markers before we call `read'."
(save-match-data
(let ((beginning (point))
string)
(forward-line 1)
(while (looking-at generate-autoload-section-continuation)
(forward-line 1))
(setq string (buffer-substring beginning (point)))
(with-current-buffer (get-buffer-create " *autoload*")
(erase-buffer)
(insert string)
(goto-char (point-min))
(while (search-forward generate-autoload-section-continuation nil t)
(replace-match " "))
(goto-char (point-min))
(read (current-buffer))))))
(defvar autoload-print-form-outbuf nil
"Buffer which gets the output of `autoload-print-form'.")
(defun autoload-print-form (form)
"Print FORM such that `make-docfile' will find the docstrings.
The variable `autoload-print-form-outbuf' specifies the buffer to
put the output in."
(cond
;; If the form is a sequence, recurse.
((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
;; Symbols at the toplevel are meaningless.
((symbolp form) nil)
(t
(let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
(outbuf autoload-print-form-outbuf))
(if (and doc-string-elt (stringp (nth doc-string-elt form)))
;; We need to hack the printing because the
;; doc-string must be printed specially for
;; make-docfile (sigh).
(let* ((p (nthcdr (1- doc-string-elt) form))
(elt (cdr p)))
(setcdr p nil)
(princ "\n(" outbuf)
(let ((print-escape-newlines t)
(print-quoted t)
(print-escape-nonascii t))
(dolist (elt form)
(prin1 elt outbuf)
(princ " " outbuf)))
(princ "\"\\\n" outbuf)
(let ((begin (with-current-buffer outbuf (point))))
(princ (substring (prin1-to-string (car elt)) 1)
outbuf)
;; Insert a backslash before each ( that
;; appears at the beginning of a line in
;; the doc string.
(with-current-buffer outbuf
(save-excursion
(while (re-search-backward "\n[[(]" begin t)
(forward-char 1)
(insert "\\"))))
(if (null (cdr elt))
(princ ")" outbuf)
(princ " " outbuf)
(princ (substring (prin1-to-string (cdr elt)) 1)
outbuf))
(terpri outbuf)))
(let ((print-escape-newlines t)
(print-quoted t)
(print-escape-nonascii t))
(print form outbuf)))))))
(defun autoload-rubric (file &optional type feature)
"Return a string giving the appropriate autoload rubric for FILE.
TYPE (default \"autoloads\") is a string stating the type of
information contained in FILE. 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.
At present, a feature is in fact always provided, but this should
not be relied upon."
(let ((basename (file-name-nondirectory file)))
(concat ";;; " basename
" --- automatically extracted " (or type "autoloads") "\n"
";;\n"
";;; Code:\n\n"
"\n"
;; This is used outside of autoload.el, eg cus-dep, finder.
"(provide '"
(if (stringp feature)
feature
(file-name-sans-extension basename))
")\n"
";; Local Variables:\n"
";; version-control: never\n"
";; no-byte-compile: t\n"
";; no-update-autoloads: t\n"
";; coding: utf-8\n"
";; End:\n"
";;; " basename
" ends here\n")))
(defvar autoload-ensure-writable nil
"Non-nil means `autoload-ensure-default-file' makes existing file writable.")
;; Just in case someone tries to get you to overwrite a file that you
;; don't want to.
;;;###autoload
(put 'autoload-ensure-writable 'risky-local-variable t)
(defun autoload-ensure-file-writeable (file)
;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
;; which was designed to handle CVSREAD=1 and equivalent.
(and autoload-ensure-writable
(let ((modes (file-modes file)))
(if (zerop (logand modes #o0200))
;; Ignore any errors here, and let subsequent attempts
;; to write the file raise any real error.
(ignore-errors (set-file-modes file (logior modes #o0200))))))
file)
(defun autoload-ensure-default-file (file)
"Make sure that the autoload file FILE exists, creating it if needed.
If the file already exists and `autoload-ensure-writable' is non-nil,
make it writable."
(write-region (autoload-rubric file) nil file))
(defun autoload-insert-section-header (outbuf autoloads load-name file time)
"Insert the section-header line,
which lists the file name and which functions are in it, etc."
;; (cl-assert ;Make sure we don't insert it in the middle of another section.
;; (save-excursion
;; (or (not (re-search-backward
;; (concat "\\("
;; (regexp-quote generate-autoload-section-header)
;; "\\)\\|\\("
;; (regexp-quote generate-autoload-section-trailer)
;; "\\)")
;; nil t))
;; (match-end 2))))
(insert generate-autoload-section-header)
(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" generate-autoload-section-continuation))))))
(defun autoload-find-file (file)
"Fetch file and put it in a temp buffer. Return the buffer."
;; It is faster to avoid visiting the file.
(setq file (expand-file-name file))
(with-current-buffer (get-buffer-create " *autoload-file*")
(kill-all-local-variables)
(erase-buffer)
(setq buffer-undo-list t
buffer-read-only nil)
(delay-mode-hooks (emacs-lisp-mode))
(setq default-directory (file-name-directory file))
(insert-file-contents file nil)
(let ((enable-local-variables :safe)
(enable-local-eval nil))
(hack-local-variables))
(current-buffer)))
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
(defun autoload-file-load-name (file)
"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're
;; scanning for autoloads and will be in the `load-path'.
(let* ((outfile (default-value 'generated-autoload-file))
(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 generate-file-autoloads (file)
"Insert at point a loaddefs autoload section for FILE.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
If FILE is being visited in a buffer, the contents of the buffer
are used.
Return non-nil in the case where no autoloads were added at point."
(interactive "fGenerate autoloads for file: ")
(let ((generated-autoload-file buffer-file-name))
(autoload-generate-file-autoloads file (current-buffer))))
(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.")
(defconst autoload-def-prefixes-max-entries 5
"Target length of the list of definition prefixes per file.
If set too small, the prefixes will be too generic (i.e. they'll use little
memory, we'll end up looking in too many files when we need a particular
prefix), and if set too large, they will be too specific (i.e. they will
cost more memory use).")
(defconst autoload-def-prefixes-max-length 12
"Target size of definition prefixes.
Don't try to split prefixes that are already longer than that.")
(require 'radix-tree)
(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 (> (length s) 2) ;Long enough!
(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!
(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 "Not registering prefix \"%s\" from %s. Affects: %S"
prefix file dropped)
nil))))
prefixes)))
`(if (fboundp 'register-definition-prefixes)
(register-definition-prefixes ,file ',(delq nil strings)))))))
(defun autoload--setup-output (otherbuf outbuf absfile load-name)
(let ((outbuf
(or (if otherbuf
;; A file-local setting of
;; autoload-generated-file says we
;; should ignore OUTBUF.
nil
outbuf)
(autoload-find-destination absfile load-name)
;; The file has autoload cookies, but they're
;; already up-to-date. If OUTFILE is nil, the
;; entries are in the expected OUTBUF,
;; otherwise they're elsewhere.
(throw 'done otherbuf))))
(with-current-buffer outbuf
(point-marker))))
(defun autoload--print-cookie-text (output-start load-name file)
(let ((standard-output (marker-buffer output-start)))
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
(condition-case-unless-debug err
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
(autoload (make-autoload form load-name)))
(if autoload
nil
(setq autoload form))
(let ((autoload-print-form-outbuf
standard-output))
(autoload-print-form autoload)))
(error
(message "Autoload cookie error in %s:%s %S"
file (count-lines (point-min) (point)) err)))
;; Copy the rest of the line to the output.
(princ (buffer-substring
(progn
;; Back up over whitespace, to preserve it.
(skip-chars-backward " \f\t")
(if (= (char-after (1+ (point))) ? )
;; Eat one space.
(forward-char 1))
(point))
(progn (forward-line 1) (point)))))))
(defvar autoload-builtin-package-versions nil)
;; When called from `generate-file-autoloads' we should ignore
;; `generated-autoload-file' altogether. When called from
;; `update-file-autoloads' we don't know `outbuf'. And when called from
;; `update-directory-autoloads' it's in between: we know the default
;; `outbuf' but we should obey any file-local setting of
;; `generated-autoload-file'.
(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
"Insert an autoload section for FILE in the appropriate buffer.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
If FILE is being visited in a buffer, the contents of the buffer are used.
OUTBUF is the buffer in which the autoload statements should be inserted.
If OUTBUF is nil, it will be determined by `autoload-generated-file'.
If provided, OUTFILE is expected to be the file name of OUTBUF.
If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
different from OUTFILE, then OUTBUF is ignored.
Return non-nil if and only if FILE adds no autoloads to OUTFILE
\(or OUTBUF if OUTFILE is nil). The actual return value is
FILE's modification time."
;; Include the file name in any error messages
(condition-case err
(let (load-name
(print-length nil)
(print-level nil)
(float-output-format nil)
(visited (get-file-buffer file))
(otherbuf nil)
(absfile (expand-file-name file))
(defs '())
;; nil until we found a cookie.
output-start)
(when
(catch 'done
(with-current-buffer (or visited
;; It is faster to avoid visiting the file.
(autoload-find-file file))
;; Obey the no-update-autoloads file local variable.
(unless no-update-autoloads
(or noninteractive (message "Generating autoloads for %s..." file))
(setq load-name
(if (stringp generated-autoload-load-name)
generated-autoload-load-name
(autoload-file-load-name absfile)))
;; FIXME? Comparing file-names for equality with just equal
;; is fragile, eg if one has an automounter prefix and one
;; does not, but both refer to the same physical file.
(when (and outfile
(not
(if (memq system-type '(ms-dos windows-nt))
(equal (downcase outfile)
(downcase (autoload-generated-file)))
(equal outfile (autoload-generated-file)))))
(setq otherbuf t))
(save-excursion
(save-restriction
(widen)
(when autoload-builtin-package-versions
(let ((version (lm-header "version"))
package)
(and version
(setq version (ignore-errors (version-to-list version)))
(setq package (or (lm-header "package")
(file-name-sans-extension
(file-name-nondirectory file))))
(setq output-start (autoload--setup-output
otherbuf outbuf absfile load-name))
(let ((standard-output (marker-buffer output-start))
(print-quoted t))
(princ `(push (purecopy
',(cons (intern package) version))
package--builtin-versions))
(princ "\n")))))
;; Do not insert autoload entries for excluded files.
(unless (member absfile autoload-excludes)
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward " \t\n\f")
(cond
((looking-at (regexp-quote generate-autoload-cookie))
;; If not done yet, figure out where to insert this text.
(unless output-start
(setq output-start (autoload--setup-output
otherbuf outbuf absfile load-name)))
(autoload--print-cookie-text output-start load-name file))
((looking-at ";")
;; Don't read the comment.
(forward-line 1))
(t
;; Avoid (defvar <foo>) by requiring a trailing space.
;; Also, ignore this prefix business
;; for ;;;###tramp-autoload and friends.
(when (and (equal generate-autoload-cookie ";;;###autoload")
(looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
(not (member
(match-string 1)
'("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-response-handler"
"defun-rcirc-command"))))
(push (match-string 2) defs))
(forward-sexp 1)
(forward-line 1)))))))
(when (and autoload-compute-prefixes defs)
;; This output needs to always go in the main loaddefs.el,
;; regardless of generated-autoload-file.
;; FIXME: the files that don't have autoload cookies but
;; do have definitions end up listed twice in loaddefs.el:
;; once for their register-definition-prefixes and once in
;; the list of "files without any autoloads".
(let ((form (autoload--make-defs-autoload defs load-name)))
(cond
((null form)) ;All defs obey the default rule, yay!
((not otherbuf)
(unless output-start
(setq output-start (autoload--setup-output
nil outbuf absfile load-name)))
(let ((autoload-print-form-outbuf
(marker-buffer output-start)))
(autoload-print-form form)))
(t
(let* ((other-output-start
;; To force the output to go to the main loaddefs.el
;; rather than to generated-autoload-file,
;; there are two cases: if outbuf is non-nil,
;; then passing otherbuf=nil is enough, but if
;; outbuf is nil, that won't cut it, so we
;; locally bind generated-autoload-file.
(let ((generated-autoload-file
(default-value 'generated-autoload-file)))
(autoload--setup-output nil outbuf absfile load-name)))
(autoload-print-form-outbuf
(marker-buffer other-output-start)))
(autoload-print-form form)
(with-current-buffer (marker-buffer other-output-start)
(save-excursion
;; Insert the section-header line which lists
;; the file name and which functions are in it, etc.
(goto-char other-output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
(marker-buffer other-output-start)
"actual autoloads are elsewhere" load-name relfile
(if autoload-timestamps
(nth 5 (file-attributes absfile))
autoload--non-timestamp))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer)))))))
(when output-start
(let ((secondary-autoloads-file-buf
(if otherbuf (current-buffer))))
(with-current-buffer (marker-buffer output-start)
(cl-assert (> (point) output-start))
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
(goto-char output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
(marker-buffer output-start)
() load-name relfile
(if secondary-autoloads-file-buf
;; MD5 checksums are much better because they do not
;; change unless the file changes (so they'll be
;; equal on two different systems and will change
;; less often than time-stamps, thus leading to fewer
;; unneeded changes causing spurious conflicts), but
;; using time-stamps is a very useful optimization,
;; so we use time-stamps for the main autoloads file
;; (loaddefs.el) where we have special ways to
;; circumvent the "random change problem", and MD5
;; checksum in secondary autoload files where we do
;; not need the time-stamp optimization because it is
;; already provided by the primary autoloads file.
(md5 secondary-autoloads-file-buf
;; We'd really want to just use
;; `emacs-internal' instead.
nil nil 'emacs-mule-unix)
(if autoload-timestamps
(nth 5 (file-attributes relfile))
autoload--non-timestamp)))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer))))
(or noninteractive
(message "Generating autoloads for %s...done" file)))
(or visited
;; We created this buffer, so we should kill it.
(kill-buffer (current-buffer))))
(or (not output-start)
;; If the entries were added to some other buffer, then the file
;; doesn't add entries to OUTFILE.
otherbuf))
(nth 5 (file-attributes absfile))))
(error
;; Probably unbalanced parens in forward-sexp. In that case, the
;; condition is scan-error, and the signal data includes point
;; where the error was found; we'd like to convert that to
;; line:col, but line-number-at-pos gets the wrong line in batch
;; mode for some reason.
;;
;; At least this gets the file name in the error message; the
;; developer can use goto-char to get to the error position.
(error "%s:0:0: error: %s: %s" file (car err) (cdr err)))
))
(defun autoload-save-buffers ()
(while autoload-modified-buffers
(with-current-buffer (pop autoload-modified-buffers)
(let ((version-control 'never))
(save-buffer)))))
;; FIXME This command should be deprecated.
;; See http://debbugs.gnu.org/22213#41
;;;###autoload
(defun update-file-autoloads (file &optional save-after outfile)
"Update the autoloads for FILE.
If prefix arg SAVE-AFTER is non-nil, save the buffer too.
If FILE binds `generated-autoload-file' as a file-local variable,
autoloads are written into that file. Otherwise, the autoloads
file is determined by OUTFILE. If called interactively, prompt
for OUTFILE; if called from Lisp with OUTFILE nil, use the
existing value of `generated-autoload-file'.
Return FILE if there was no autoload cookie in it, else nil."
(interactive (list (read-file-name "Update autoloads for file: ")
current-prefix-arg
(read-file-name "Write autoload definitions to file: ")))
(let* ((generated-autoload-file (or outfile generated-autoload-file))
(autoload-modified-buffers nil)
;; We need this only if the output file handles more than one input.
;; See http://debbugs.gnu.org/22213#38 and subsequent.
(autoload-timestamps t)
(no-autoloads (autoload-generate-file-autoloads file)))
(if autoload-modified-buffers
(if save-after (autoload-save-buffers))
(if (called-interactively-p 'interactive)
(message "Autoload section for %s is up to date." file)))
(if no-autoloads file)))
(defun autoload-find-destination (file load-name)
"Find the destination point of the current buffer's autoloads.
FILE is the file name of the current buffer.
LOAD-NAME is the name as it appears in the output.
Returns a buffer whose point is placed at the requested location.
Returns nil if the file's autoloads are up-to-date, otherwise
removes any prior now out-of-date autoload entries."
(catch 'up-to-date
(let* ((buf (current-buffer))
(existing-buffer (if buffer-file-name buf))
(output-file (autoload-generated-file))
(output-time (if (file-exists-p output-file)
(nth 5 (file-attributes output-file))))
(found nil))
(with-current-buffer (autoload-find-generated-file)
;; This is to make generated-autoload-file have Unix EOLs, so
;; that it is portable to all platforms.
(or (eq 0 (coding-system-eol-type buffer-file-coding-system))
(set-buffer-file-coding-system 'unix))
(or (> (buffer-size) 0)
(error "Autoloads file %s lacks boilerplate" buffer-file-name))
(or (file-writable-p buffer-file-name)
(error "Autoloads file %s is not writable" buffer-file-name))
(widen)
(goto-char (point-min))
;; Look for the section for LOAD-NAME.
(while (and (not found)
(search-forward generate-autoload-section-header nil t))
(let ((form (autoload-read-section-header)))
(cond ((string= (nth 2 form) load-name)
;; We found the section for this file.
;; Check if it is up to date.
(let ((begin (match-beginning 0))
(last-time (nth 4 form))
(file-time (nth 5 (file-attributes file))))
(if (and (or (null existing-buffer)
(not (buffer-modified-p existing-buffer)))
(cond
;; FIXME? Arguably we should throw a
;; user error, or some kind of warning,
;; if we were called from update-file-autoloads,
;; which can update only a single input file.
;; It's not appropriate to use the output
;; file modtime in such a case,
;; if there are multiple input files
;; contributing to the output.
((and output-time
(member last-time
(list t autoload--non-timestamp)))
(not (time-less-p output-time file-time)))
;; last-time is the time-stamp (specifying
;; the last time we looked at the file) and
;; the file hasn't been changed since.
((listp last-time)
(not (time-less-p last-time file-time)))
;; last-time is an MD5 checksum instead.
((stringp last-time)
(equal last-time
(md5 buf nil nil 'emacs-mule)))))
(throw 'up-to-date nil)
(autoload-remove-section begin)
(setq found t))))
((string< load-name (nth 2 form))
;; We've come to a section alphabetically later than
;; LOAD-NAME. We assume the file is in order and so
;; there must be no section for LOAD-NAME. We will
;; insert one before the section here.
(goto-char (match-beginning 0))
(setq found t)))))
(or found
(progn
;; No later sections in the file. Put before the last page.
(goto-char (point-max))
(search-backward "\f" nil t)))
(unless (memq (current-buffer) autoload-modified-buffers)
(push (current-buffer) autoload-modified-buffers))
(current-buffer)))))
(defun autoload-remove-section (begin)
(goto-char begin)
(search-forward generate-autoload-section-trailer)
(delete-region begin (point)))
;;;###autoload
(defun update-directory-autoloads (&rest dirs)
"Update autoload definitions for Lisp files in the directories DIRS.
In an interactive call, you must give one argument, the name of a
single directory. In a call from Lisp, you can supply multiple
directories as separate arguments, but this usage is discouraged.
The function does NOT recursively descend into subdirectories of the
directory or directories specified.
In an interactive call, prompt for a default output file for the
autoload definitions, and temporarily bind the variable
`generated-autoload-file' to this value. When called from Lisp,
use the existing value of `generated-autoload-file'. If any Lisp
file binds `generated-autoload-file' as a file-local variable,
write its autoloads into the specified file instead."
(interactive "DUpdate autoloads from directory: ")
(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 (dir)
(directory-files (expand-file-name dir)
t files-re))
dirs)))
(done ()) ;Files processed; to remove duplicates.
(changed nil) ;Non-nil if some change occurred.
(last-time)
;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings.
(no-autoloads nil)
(autoload-modified-buffers nil)
(generated-autoload-file
(if (called-interactively-p 'interactive)
(read-file-name "Write autoload definitions to file: ")
generated-autoload-file))
(output-time
(if (file-exists-p generated-autoload-file)
(nth 5 (file-attributes generated-autoload-file)))))
(with-current-buffer (autoload-find-generated-file)
(save-excursion
;; Canonicalize file names and remove the autoload file itself.
(setq files (delete (file-relative-name buffer-file-name)
(mapcar #'file-relative-name files)))
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(let* ((form (autoload-read-section-header))
(file (nth 3 form)))
(cond ((and (consp file) (stringp (car file)))
;; This is a list of files that have no autoload cookies.
;; There shouldn't be more than one such entry.
;; Remove the obsolete section.
(autoload-remove-section (match-beginning 0))
(setq last-time (nth 4 form))
(if (member last-time (list t autoload--non-timestamp))
(setq last-time output-time))
(dolist (file file)
(let ((file-time (nth 5 (file-attributes file))))
(when (and file-time
(not (time-less-p last-time file-time)))
;; file unchanged
(push file no-autoloads)
(setq files (delete file files))))))
((not (stringp file)))
((or (not (file-exists-p file))
;; Remove duplicates as well, just in case.
(member file done))
;; Remove the obsolete section.
(setq changed t)
(autoload-remove-section (match-beginning 0)))
((not (time-less-p (let ((oldtime (nth 4 form)))
(if (member oldtime
(list
t autoload--non-timestamp))
output-time
oldtime))
(nth 5 (file-attributes file))))
;; File hasn't changed.
nil)
(t
(setq changed t)
(autoload-remove-section (match-beginning 0))
(if (autoload-generate-file-autoloads
;; Passing `current-buffer' makes it insert at point.
file (current-buffer) buffer-file-name)
(push file no-autoloads))))
(push file done)
(setq files (delete file files)))))
;; Elements remaining in FILES have no existing autoload sections yet.
(let ((no-autoloads-time (or last-time '(0 0 0 0))) file-time)
(dolist (file files)
(cond
;; Passing nil as second argument forces
;; autoload-generate-file-autoloads to look for the right
;; spot where to insert each autoloads section.
((setq file-time
(autoload-generate-file-autoloads file nil buffer-file-name))
(push file no-autoloads)
(if (time-less-p no-autoloads-time file-time)
(setq no-autoloads-time file-time)))
(t (setq changed t))))
(when no-autoloads
;; Sort them for better readability.
(setq no-autoloads (sort no-autoloads 'string<))
;; Add the `no-autoloads' section.
(goto-char (point-max))
(search-backward "\f" nil t)
(autoload-insert-section-header
(current-buffer) nil nil no-autoloads (if autoload-timestamps
no-autoloads-time
autoload--non-timestamp))
(insert generate-autoload-section-trailer)))
;; Don't modify the file if its content has not been changed, so `make'
;; dependencies don't trigger unnecessarily.
(if (not changed)
(set-buffer-modified-p nil)
(let ((version-control 'never))
(save-buffer)))
;; In case autoload entries were added to other files because of
;; file-local autoload-generated-file settings.
(autoload-save-buffers))))
(define-obsolete-function-alias 'update-autoloads-from-directories
'update-directory-autoloads "22.1")
;;;###autoload
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
Calls `update-directory-autoloads' on the command line arguments.
Definitions are written to `generated-autoload-file' (which
should be non-nil)."
;; For use during the Emacs build process only.
;; 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).
(unless autoload-excludes
(let ((default-directory (file-name-directory generated-autoload-file))
file)
(when (file-readable-p "loadup.el")
(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) autoload-excludes)))))))
(let ((args command-line-args-left))
(setq command-line-args-left nil)
(apply #'update-directory-autoloads args)))
(provide 'autoload)
;;; autoload.el ends here
|