-
Notifications
You must be signed in to change notification settings - Fork 2
/
header2.el
1217 lines (1104 loc) · 51.8 KB
/
header2.el
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
;;; header2.el --- Support for creation and update of file headers.
;;
;; Filename: header2.el
;; Description: Support for creation and update of file headers.
;; Author: Lynn Slater
;; Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2013, Drew Adams, all rights reserved.
;; Copyright (C) 1989 Free Software Foundation, Inc.
;; Copyright (C) 1988 Lynn Randolph Slater, Jr.
;; Created: Tue Aug 4 17:06:46 1987
;; Version:
;; Last-Updated: Thu Oct 24 10:33:27 2013 (+0800)
;; By: Gu Weigang
;; Update #: 1857
;; URL: http://www.emacswiki.org/header2.el
;; Doc URL: http://emacswiki.org/AutomaticFileHeaders
;; Keywords: tools, docs, maint, abbrev, local
;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Support for creation and update of file headers.
;;
;; Some of this code and commentary were originally written by Lynn
;; Slater as file `header.el'. Drew Adams updated it and maintains it
;; as `header2.el'. The original is here:
;; `http://www.emacswiki.org/cgi-bin/wiki/download/OriginalHeaderEl'.
;;
;; Commands (interactive functions) defined here:
;;
;; `make-header', `make-revision', `make-divider',
;; `make-box-comment', `update-file-header'.
;;
;; Other functions defined here:
;;
;; `auto-make-header', `auto-update-file-header',
;; `delete-and-forget-line', `header-AFS', `header-author',
;; `header-blank', `header-code', `header-commentary',
;; `header-compatibility', `header-copyright',
;; `header-creation-date', `header-date-string',
;; `header-description', `header-doc-url',`header-end-line',
;; `header-eof', `header-file-name', `header-free-software',
;; `header-history', `header-keywords', `header-lib-requires',
;; `header-maintainer', `header-mode-line',
;; `header-modification-author', `header-modification-date',
;; `header-multiline', `header-prefix-string', `header-rcs-id',
;; `header-rcs-log', `header-sccs', `header-shell', `header-status',
;; `header-title', `header-toc', `header-update-count',
;; `header-url', `header-version', `headerable-file-p',
;; `make-box-comment', `make-divider', `make-revision',
;; `register-file-header-action', `section-comment-start',
;; `true-mode-name', `uniquify-list', `update-file-name',
;; `update-last-modified-date', `update-last-modifier',
;; `update-lib-requires', `update-write-count'.
;;
;; User options (variables) defined here:
;;
;; `header-copyright-notice', `header-date-format',
;; `header-history-label', `header-max', `make-header-hook'.
;;
;; Other variables defined here:
;;
;; `file-header-update-alist', `header-auto-update-enabled',
;; `header-multiline', `header-prefix-string', `return-to'.
;;
;;
;; To have Emacs update file headers automatically whenever you save a
;; file, put this in your init file (~/.emacs):
;;
;; (add-hook 'write-file-hooks 'auto-update-file-header)
;;
;; To have Emacs add a file header whenever you create a new file in
;; some mode, put this in your init file (~/.emacs):
;;
;; (add-hook 'emacs-lisp-mode-hook 'auto-make-header)
;; (add-hook 'c-mode-common-hook 'auto-make-header)
;; ...
;;
;;
;;
;; From the original header.el text by Lynn Slater:
;;
;; This file is particularly useful with the file-declarations
;; package also by Lynn Slater. Read the first 20% of this file
;; to learn how to customize.
;;
;; From: eddie.mit.edu!think!ames!indetech.com!lrs (Lynn Slater)
;; To: [email protected]
;; Subject: Automatic header creation and maintenance
;; Date: Wed, 1 Nov 89 09:33 PST
;;
;; Enclosed is code to automatically create and maintain file
;; headers. This code is cleaner and mush more easily customized
;; than any of my previous header postings.
;;
;; New in this release are customizations that allow headers to be
;; created and maintained from the command line. This is good for
;; projects with some vi die-hards or when headers are being added
;; in mass for the first time.
;;
;; Example:
;; cd $EMACS/lisp
;; headers -make *.el
;;
;; I have found file headers to be very valuable in project
;; development. I always know who has been where and how many
;; times they were there. Most often, I also know what they did.
;; The update count and last modified date are very useful in
;; determining the proper version of a file to use. I have often
;; thought that it would be easier to integrate patches from
;; individuals to gnu tools such as gcc and g++ if I knew for
;; certain what version of a particular file they were working
;; from. If all had headers, I would see the update count and
;; date in the "diff -c" output and would be able to find or
;; recreate the file to patch accordingly.
;;
;; In this message are three files:
;; header.el - Emacs header functions and instructions
;; headers.1 - Man page for command line headers useage
;; headers - Shell script for command-line headers.
;;
;; Text by Lynn Slater, updated as needed:
;;
;; Mode-specific headers:
;; ---------------------
;; Not all headers need look alike. Suppose that you have a unix script mode
;; and want it to have a shell specifier line that all other headers do not
;; have. To do this, Place the following line in a hook called when the
;; mode is invoked or in the code that establishes the mode:
;;
;; (add-hook 'make-header-hook 'header-shell nil t)
;; The header building blocks are sensitive to the different comment
;; characters in different modes.
;; Mode specific update actions:
;; ----------------------------
;; Suppose something needs to be automatically maintained only in certain
;; modes. An example is the .TH macro in man pages. You can create mode-
;; specific update actions by placing code like the following in the
;; mode creation function of the mode hook.
;;
;; (register-file-header-action
;; "^\.TH[ \t]+[^\" \t]+[ \t]+[^\" \t]+[ \t]+\"\\([^\"]*\\)\""
;; 'update-last-modified-date-macro)
;;
;; Define individual header elements. These are the building blocks
;; used to construct a site specific header. You may add your own
;; functions either in this file or in your `.emacs' file. The
;; variable `make-header-hook' specifies the functions that will
;; actually be called.
;;
;; Note on change-control systems:
;;
;; If you use `header2.el' in a change-control system, such as RCS,
;; you might need to leave it checked out. This is because any
;; change-control keywords in the file will be expanded during
;; check-in. Normally, you will want those keywords to be inserted
;; in file headers unexpanded.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change Log:
;;
;; 2012/08/23 dadams
;; Added: header-doc-url.
;; make-header-hook: Added header-doc-url to default value.
;; 2011/12/19 dadams
;; delete-and-forget-line: Use line-end-position, not end-of-line + point.
;; 2011/11/15 dadams
;; header-date-string:
;; Use UTC format from http://www.w3.org/TR/NOTE-datetime. Thx to Lennart Borgman.
;; 2011/02/03 dadams
;; Added: header-auto-update-enabled.
;; auto-update-file-header: Respect header-auto-update-enabled. Thx to Le Wang.
;; 2011/01/04 dadams
;; Removed autoload cookies from non-interactive functions.
;; 2010/08/03 dadams
;; update-file-name: Use ---, not just -, in title line, per newer standard.
;; make-revision: Escape ; in string, for Emacs 20 (else C-M-q problem).
;; 2010/04/12 dadams
;; header-history-label: Change log -> Change Log.
;; 2009/10/25 dadams
;; Renamings from lib-require.el. If you use that library, you must update it.
;; lib-requires-header -> libreq-file-header
;; insert-lib-requires-as-comment -> libreq-insert-lib-requires-as-comment
;; 2009/09/24 dadams
;; header-multiline: Use a marker for END, and go to it after insert multiline.
;; header-eof: Go to point-max and insert newline.
;; 2008/09/06 dadams
;; update-write-count: Keep rest of line, after number. Thx to Johan Vromans.
;; Added update-VCS-version, commented out.
;; 2008/08/06 dadams
;; header-date-string: Use %z, not %Z - the latter no longer works on Windows.
;; 2008/07/11 dadams
;; header-title, header-file-name, header-eof:
;; Use buffer-file-name, if available. Thx Juan Miguel Cejuela for suggestion.
;; 2008/03/14 dadams
;; header-free-software: Update version 2 -> version 3 of GPL.
;; 2008/01/18 dadams
;; header-creation-date: Added time zone also. Thx to Sebastian Luque.
;; Added: header-date-(string|format).
;; header-creation-date, update-last-modified-date: Use header-date-format.
;; 2007/12/12 dadams
;; INCOMPATIBLE CHANGE - If you previously used update-file-header as a
;; write-file-hook, change it to auto-update-file-header.
;; Added auto-update-file-header. Uses new update-file-header.
;; update-file-header: Made unconditional. Thx to Lennart Borgman.
;; 2007/03/25 dadams
;; make-header: Use let*, so comment-end-p is bound in header-prefix-string.
;; 2006/01/13 dadams
;; Added: header-url.
;; 2006/01/07 dadams
;; Added :link.
;; 2005/11/04 dadams
;; update-last-modified-date: Added timezone.
;; 2005/10/21 dadams
;; Added header-free-software, header-multiline (vars & fns).
;; Updated make-header-hooks.
;; update-lib-requires:
;; Use error msg if insert-lib-requires-as-comment errors.
;; Made buffer-file-name filter outermost.
;; Got rid of locate-library filter.
;; header-code, header-eof: Include comment-end case.
;; Changed defvar to defcustom.
;; auto-make-header: Make sure its a file buffer.
;; Protect lib-requires-header with boundp.
;; Renamed make-header-hooks to make-header-hook.
;; Cleaned up Commentary. Added .emacs instructions, note on change control.
;; header-prefix-string: Don't bother to bind comment-end-p.
;; 2005/10/19 dadams
;; Increased header max default value from 2000 to 50000.
;; 2005/10/18 dadams
;; Added: update-lib-requires, header-lib-requires, header-version.
;; make-header-hooks:
;; Use header-version, not header-rcs-id. Use header-lib-requires.
;; Don't use header-rcs-log.
;; update-last-modifier: inlined code for non-empty-name-p.
;; Require lib-requires.el.
;; 2004/10/01 dadams
;; auto-make-header: not if read-only
;; header-rcs-log: Split string so it won't be overwritten by vc.el
;; Thanks to Steve Taylor for this fix.
;; 2004/06/04 dadams
;; header-eof: Removed "`" and "'" around file name.
;; 1996/04/04 dadams
;; Mods for modes like C, etc.
;; 1. make-header-hooks: Removed header-blank before: header-commentary,
;; header-history and header-code. Added 2 header-blank's after
;; header-commentary.
;; 2. Added section-comment-start.
;; 3. header-file-name: Only use header-prefix-string if 1-char comment-start.
;; 4. header-commentary,header-history,header-code: Use section-comment-start.
;; 5. header-code: Only add ":\n\n\n\n\n" if 1-char comment-start.
;; 6. header-eof: Removed extra " ".
;; 1996/03/18 dadams
;; Added defvars for return-to, explicit-shell-file-name, c-style .
;; 1996/02/12 dadams
;; Added auto-make-header.
;; 1995/09/04 dadams
;; Adapted to std GNU maintenance form (see file lisp-mnt.el).
;; 1) Distinguished sections from subsections. Changed order.
;; 2) No longer use header-mode-line (conflicts with GNU maintenance std).
;; 3) Added header-eof, header-history-label.
;; 4) Removed header-purpose (use just header-commentary).
;; 5) Redefined: make-revision, header-file-name, header-history,
;; header-rcs-id, header-sccs, header-copyright.
;; 1995/08/08 dadams
;; Added header-maintainer, header-keywords, header-commentary, header-code.
;; 1995/08/02 dadams
;; header-rcs -> header-rcs-id, header-rcs-log, and changed order.
;; 1995/07/31 dadams
;; 1. Corrected SCCS & RCS strings (need to be uninstantiated here).\
;; 2. Added defvar for header-prefix-string (not really needed).
;; 3. Commented out stuff that needs Lynn Slater's command-line-hooks.
;; 28-Apr-1995 dadams
;; Added default for comment-start in make-revision.
;; 11/11/89 -- Darryl Okahata, HP NMD (darrylo%[email protected])
;; 25-Sep-1989 Lynn Slater
;; added -default-mode ahd headerable-file-p
;; 10-Sep-1989 Lynn Slater
;; Seperated out header-mode-line and header-end. Headers are now really
;; easy to modify. Added instructions for mode-specific headers.
;; 8-Aug-1989 Lynn Slater
;; Changed structure to allow site/user customized headers
;; 24-Jun-1989 Lynn Slater
;; restructured file, made the order of header actions not be significant.
;; 22-Jun-1989 Lynn Slater
;; Made file header actions easier to declare
;; Made sccs and rcs support be user settable.
;; Added c-style support
;; 25-Jan-1989 Lynn Slater
;; Added make-doc command
;; 25-Jan-1989 Lynn Slater
;; made the make-revision command include the last-modified data
;; 31-Aug-1988 Lynn Slater
;; Made the make-revision work in most modes
;; Added the update-file-name command
;; 1-Mar-1988 Lynn Slater
;; made the headers be as sensitive as possible to the proper
;; comment chars.
;; 1-Mar-1988 Lynn Slater
;; Made the mode be declared in each header
;; 26-Feb-1988 Lynn Slater
;; added the make-revision call
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program 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, or (at your option)
;; any later version.
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'lib-requires nil t)
;; (no error if not found):
;; libreq-insert-lib-requires-as-comment, libreq-file-header
;;;;;;;;;;;;;;;;;;;;;;
(provide 'header2)
(require 'header2) ; Ensure loaded before compile.
;; Quiet byte-compiler.
(defvar comment-end-p)
(defvar comment-start-p)
(defvar c-style)
(defvar explicit-shell-file-name)
;; User Options (Variables) --------------------------------
(defgroup Automatic-File-Header nil
"File header insertion and updating."
:group 'files :group 'editing :group 'convenience :group 'programming
:group 'development
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
header2.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download"
"http://www.emacswiki.org/cgi-bin/wiki/header2.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/AutomaticFileHeaders#header2")
:link '(emacs-commentary-link :tag "Commentary" "header2")
)
(defcustom header-max 50000
"*Maximum number of chars to examine for header updating."
:type 'integer :group 'Automatic-File-Header)
(defcustom header-copyright-notice nil
"*Copyright notice to be inserted into file headers."
:type '(choice (const :tag "No copyright notice (value nil)" nil) string)
:group 'Automatic-File-Header)
(defcustom header-date-format t
"*Date/time format for header timestamp.
The value can be a string, t, or nil.
A string value is passed to `format-time-string'.
t means use local time with timezone; nil means use UTC."
:group 'Automatic-File-Header
:type '(choice
(const :tag "Local time, with timezone" t)
(const :tag "UTC" nil)
(string :tag "Custom format")))
;; Change this as you like.
;; Note that the Elisp manual, node Library Headers, suggests putting copyright just
;; after header-description. That is not done here, by default, because I feel that
;; copyright is not the first information people are looking for. Otherwise, this
;; default value corresponds to what the Elisp manual recommends for Emacs Lisp.
(defcustom make-header-hook '(
;;header-mode-line
header-title
header-blank
header-file-name
header-description
;;header-status
header-author
header-maintainer
header-copyright
header-creation-date
;;header-rcs-id
header-version
;;header-sccs
header-modification-date
header-modification-author
header-update-count
;;header-url
;;header-doc-url
;;header-keywords
;;header-compatibility
header-blank
header-lib-requires
header-end-line
;;header-commentary
;;header-blank
;;header-blank
;;header-blank
;;header-end-line
header-history
header-blank
header-blank
;; header-rcs-log
header-end-line
header-free-software
header-code
header-eof
)
"*Functions that insert header elements.
Each function is started on a new line and is expected to end in a new line.
Each function may insert any number of lines, but each line, including the
first, must be started with the value of `header-prefix-string'.
\(This variable holds the same value as would be returned by calling
`header-prefix-string' but is faster to access.) Each function may set the
following global variables:
`header-prefix-string' -- mode-specific comment sequence
`return-to' -- character position to which point will be moved after header
functions are processed. Any header function may set this,
but only the last setting will take effect.
It is reasonable to locally set these hooks according to certain modes.
For example, a table of contents might only apply to code development modes
and `header-shell' might only apply to shell scripts. See instructions in
file `header2.el' to do this."
:type 'hook :group 'Automatic-File-Header)
(defcustom header-history-label "Change Log:" ; Was "HISTORY:" before.
"*Label introducing change log history."
:type 'string :group 'Automatic-File-Header)
(defcustom header-free-software
"This program is part of \"Baidu Darwin PHP Software\"; you can redistribute it and/or
modify it under the terms of the Baidu General Private License as
published by Baidu Campus.
You should have received a copy of the Baidu General Private License
along with this program; see the file COPYING. If not, write to
the Baidu Campus NO.10 Shangdi 10th Street Haidian District, Beijing The People's
Republic of China, 100085."
"*Text saying that this is free software"
:type 'string :group 'Automatic-File-Header)
;;; Internal variables -------------------------------------
(defvar header-auto-update-enabled t
"Non-nil means file-header updating is enabled for current buffer.")
(make-variable-buffer-local 'header-auto-update-enabled)
(when (boundp 'safe-local-variable-values)
(add-to-list 'safe-local-variable-values '(header-auto-update-enabled)))
(defvar return-to nil
"Position to move point to after header fns are processed.
Any header function may set this. The last setting will take effect.")
(defvar header-multiline ""
"Multiline text to be inserted as a comment.
Leave the global value of this as\"\", and bind the value as needed.")
(defvar file-header-update-alist ()
"Used by `update-file-header' to know what to do in a file.
Is a list of sets of cons cells where the car is a regexp string and the cdr is
the function to call if the string is found near the start of the file.")
(defvar header-prefix-string ""
"Mode-specific comment prefix string for use in headers.")
;;; Functions ----------------------------------------------
(defsubst header-blank ()
"Insert an empty comment to file header (after `header-prefix-string')."
(insert header-prefix-string "\n"))
;; Major section headings
(defsubst section-comment-start ()
"Comment start of major section headings."
(if (= (length comment-start) 1) ; e.g. Lisp: ";; \n;;;"
(concat header-prefix-string "\n" comment-start header-prefix-string)
(concat "\n" comment-start))) ; e.g. C: "\n/*"
(defsubst header-title ()
"Insert buffer's file name and leave room for a description.
In `emacs-lisp-mode', this should produce the title line for library
packages."
(insert (concat comment-start (and (= 1 (length comment-start)) header-prefix-string)
(if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(buffer-name))
" --- " "\n"))
(setq return-to (1- (point))))
(defsubst header-file-name ()
"Insert \"Filename: \" line, using buffer's file name."
(insert header-prefix-string "Filename: "
(if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(buffer-name))
"\n"))
(defsubst header-description ()
"Insert \"Description: \" line."
(insert header-prefix-string "Description: \n"))
(defsubst header-author ()
"Insert current user's name (`user-full-name') as this file's author."
(insert header-prefix-string "Author: " (user-full-name) " "))
(defsubst header-maintainer ()
"Insert \"Maintainer: \" line."
(insert header-prefix-string "Maintainer: \n"))
(defun header-copyright ()
"Insert `header-copyright-notice', unless nil."
(when header-copyright-notice
(let ((start (point)))
(insert header-copyright-notice)
(save-restriction
(narrow-to-region start (point))
(goto-char (point-min))
;; Must now insert header prefix. Cannot just replace string,
;; because that would cause too many undo boundries.
(insert header-prefix-string)
(while (progn (skip-chars-forward "^\n") (looking-at "\n"))
(forward-char 1) (unless (eolp) (insert header-prefix-string)))
(goto-char (point-max))))))
(defsubst header-creation-date ()
"Insert today's time, date, and time zone as file creation date."
(insert header-prefix-string "Created: ")
(insert (header-date-string) "\n"))
(defun header-date-string ()
"Current date and time."
(format-time-string
(cond ((stringp header-date-format) header-date-format)
(header-date-format "%a %b %e %T %Y (%z)")
(t "%Y-%m-%dT%T%z")) ; An alternative: "%a %b %e %T %Y (UTC)"
(current-time)
(not header-date-format)))
(defsubst header-rcs-id ()
"Insert lines to record RCS id information (\"$Id$\n\")."
(insert header-prefix-string "Version: $Id$\n"))
(defsubst header-version ()
"Insert lines to record version information."
(insert header-prefix-string "Version: \n"))
(defsubst header-sccs ()
"Insert a line to record SCCS version information."
(insert header-prefix-string "Version: %W% %E% %U%\n"))
(defsubst header-commentary ()
"Insert \"Commentary: \" line."
(insert (concat (section-comment-start) "Commentary: \n")))
(defsubst header-history ()
"Insert `header-history-label' into header for use by `make-revision'.
Without this, `make-revision' inserts `header-history-label' after the header."
(insert (concat (section-comment-start) header-history-label "\n")))
(defun header-free-software ()
"Insert text saying that this is free software."
(let ((header-multiline header-free-software))
(header-multiline)))
;; Variable `comment-end-p' is free here. It is bound in `make-header'.
(defun header-multiline ()
"Insert multiline comment. The comment text is in `header-multiline'."
(let ((lineno 1)
beg end nb-lines)
(beginning-of-line)
(if comment-end-p
(insert "\n" comment-start)
(header-blank)
(insert header-prefix-string))
(setq beg (point))
(insert header-multiline)
(setq end (point-marker)
nb-lines (count-lines beg end))
(goto-char beg)
(forward-line 1)
(while (< lineno nb-lines)
(insert header-prefix-string)
(forward-line 1)
(setq lineno (1+ lineno)))
(goto-char end)
(when comment-end-p (insert "\n"))
(insert comment-end)
(insert "\n")
(unless comment-end-p
(header-blank)
(header-end-line))))
;; Variable `comment-end-p' is free here. It is bound in `make-header'.
(defsubst header-code ()
"Insert \"Code: \" line."
(insert (concat (section-comment-start) "Code:" (and comment-end-p comment-end)
"\n\n\n")))
;; Variable `comment-end-p' is free here. It is bound in `make-header'.
(defsubst header-eof ()
"Insert comment indicating end of file."
(goto-char (point-max))
(insert "\n")
(unless comment-end-p (header-end-line))
(insert comment-start
(concat (and (= 1 (length comment-start)) header-prefix-string)
(if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(buffer-name))
" ends here"
(if comment-end-p comment-end "\n"))))
(defsubst header-modification-date ()
"Insert todays date as the time of last modification.
This is normally overwritten with each file save."
(insert header-prefix-string "Last-Updated: \n"))
(defsubst header-modification-author ()
"Insert current user's name as the last person who modified the file.
This is normally overwritten with each file save."
(insert header-prefix-string " By: \n"))
(defsubst header-update-count ()
"Insert a count of the number of times the file has been saved."
(insert header-prefix-string " Update #: 0\n"))
(defsubst header-url ()
"Insert \"URL: \" line."
(insert header-prefix-string "URL: \n"))
(defsubst header-doc-url ()
"Insert \"Doc URL: \" line."
(insert header-prefix-string "Doc URL: \n"))
(defsubst header-keywords ()
"Insert \"Keywords: \" line."
(insert header-prefix-string "Keywords: \n"))
(defsubst header-compatibility ()
"Insert a \"Compatibility: \" line."
(insert header-prefix-string "Compatibility: \n"))
(defsubst header-lib-requires ()
"Insert list of libraries required by this one."
(when (and (eq major-mode 'emacs-lisp-mode) (boundp 'libreq-file-header))
(insert libreq-file-header) ; Defined in `lib-requires.el'.
(insert ";; None\n;;\n")))
(defsubst header-status ()
"Insert a \"Status: \" line."
(insert header-prefix-string "Status: \n"))
(defsubst header-toc ()
"Insert a \"Table of Contents: \" line."
(insert header-prefix-string "Table of Contents: \n" header-prefix-string
"\n"))
(defsubst header-rcs-log ()
"Insert lines to record RCS log information (\"$Log$\n\")."
(insert header-prefix-string
(concat "RCS $" ; String split prevents `vc.el' overwrite.
"Log$\n"))) ; Thanks to Steve Taylor.
(defsubst header-AFS ()
"Insert a line to record SHAPE information."
(insert header-prefix-string "AFSID: $__Header$\n"))
(defsubst header-shell ()
"Insert a kernal shell specifier line.
Uses the same shell named in `explicit-shell-file-name', the ESHELL
environment variable, the SHELL environment variable, or
'/bin/sh'. (This is the same shell that the shell command uses.)"
(insert "#!" (or (and (boundp 'explicit-shell-file-name)
explicit-shell-file-name)
(getenv "ESHELL")
(getenv "SHELL")
"/bin/sh")
"\n"))
;; Variable `comment-start-p' is free here. It is bound in `make-header'.
(defun header-mode-line ()
"Insert a \" -*- Mode: \" line."
(let* ((mode-declaration (concat " -*- Mode: " (true-mode-name)
(if (assoc 'c-style (buffer-local-variables))
(concat "; C-Style: " (symbol-name c-style))
"")
" -*- "))
(md-length (length mode-declaration)))
(insert (cond ((and comment-start (= 1 (length comment-start)))
;; Assume comment start char is also fill char.
(concat comment-start comment-start
(make-string (/ (- 77 md-length) 2)
(aref comment-start 0))
mode-declaration
(make-string (/ (- 78 md-length) 2)
(aref comment-start 0))))
(comment-start-p ; Assume spaces fill the gaps.
(concat comment-start
(make-string (/ (- 79 md-length
(length comment-start)) 2)
?\ )
mode-declaration))
(t ; No comment-start. Assume Lisp.
(concat ";;" (make-string (/ (- 77 md-length) 2) ?\;)
mode-declaration
(make-string (/ (- 78 md-length) 2) ?\;))))
"\n")))
;; Variables `comment-start-p' and `comment-end-p' are free here.
;; They are bound in `make-header'.
(defsubst header-end-line ()
"Insert a divider line."
(insert (cond (comment-end-p comment-end)
((and comment-start (= 1 (length comment-start)))
(make-string 70 (aref comment-start 0)))
(comment-start-p comment-start)
(t (make-string 70 ?\;)))
"\n"))
;; User function to declare header actions on a save file.
;; See examples at the end of this file.
;; Invoke from `site-init.el' or in `.emacs'.
;; -------------------------------------------------------
(defun register-file-header-action (regexp function-to-call)
"Record FUNCTION-TO-CALL as the action to take if REGEXP is found
in the file header when a file is written. The function will be called
with the cursor located just after the matched REGEXP. Calling this twice
with the same args overwrites the previous FUNCTION-TO-CALL."
(let ((ml (assoc regexp file-header-update-alist)))
(if ml
(setcdr ml function-to-call);; overwrite old defn
;; This entry is new to us. Add to the master alist
(setq file-header-update-alist (cons (cons regexp function-to-call)
file-header-update-alist)))))
;; Register the automatic actions to take for file headers during a save
;; See the second part of the file for explanations.
;; ---------------------------------------------------------------------
;; (register-file-header-action "^.* *\\(.*\\) *\\-\\-" 'update-file-name)
(register-file-header-action "Version[ \t]*: " 'update-working-revision)
(register-file-header-action "Last-Updated[ \t]*: " 'update-last-modified-date)
(register-file-header-action " By[ \t]*: " 'update-last-modifier)
(register-file-header-action " Update #[ \t]*: " 'update-write-count)
(when (boundp 'libreq-file-header)
(register-file-header-action libreq-file-header 'update-lib-requires))
;; Header and file division header creation code
;; ---------------------------------------------
(defun true-mode-name ()
"Return name of mode in a form such that mode may be re-established
by calling the function named by appending \"-name\" to this string.
This differs from variable `mode-name' in that this is guaranteed to
work even when the value has embedded spaces or other junk."
(let ((major-mode-name (symbol-name major-mode)))
(capitalize (substring major-mode-name 0
(or (string-match "-mode" major-mode-name)
(length major-mode-name))))))
;; Variable `comment-end-p' is free here. It is bound in `make-header'.
(defun header-prefix-string ()
"Return a mode-specific prefix string for use in headers.
Is sensitive to language-dependent comment conventions."
(cond
;; E.g. Lisp.
((and comment-start (= 1 (length comment-start)))
(concat comment-start comment-start " "))
;; E.g. C++ and ADA.
;; Special case, three letter comment-start where the first and
;; second letters are the same.
((and comment-start (= 3 (length comment-start))
(equal (aref comment-start 1) (aref comment-start 0)))
comment-start)
;; E.g. C.
;; Other three-letter comment-start -> grab the middle character
((and comment-start (= 3 (length comment-start)))
(concat " " (list (aref comment-start 1)) " "))
((and comment-start (not comment-end-p))
;; Note: no comment end implies that the full comment-start must be
;; used on each line.
comment-start)
(t ";; "))) ; Use Lisp as default.
;; Usable as a programming language mode hook.
(defun auto-make-header ()
"Call `make-header' if current buffer is empty and is a file buffer."
(and (zerop (buffer-size)) (not buffer-read-only) (buffer-file-name)
(make-header)))
;;;###autoload
(defun make-header ()
"Insert (mode-dependent) header comment at beginning of file.
A header is composed of a mode line, a body, and an end line. The body is
constructed by calling the functions in `make-header-hook'. The mode line
and end lines start and terminate block comments. The body lines continue
the comment."
(interactive)
(beginning-of-buffer) ; Leave mark at old location.
;; Use `let*' because `header-prefix-string' refers to `comment-end-p'.
(let* ((return-to nil) ; To be set by `make-header-hook'.
(comment-start-p (and comment-start (not (string= "" comment-start))))
(comment-end-p (and comment-end (not (string= "" comment-end))))
(header-prefix-string (header-prefix-string))) ; Cache result.
(mapcar #'funcall make-header-hook)
(when return-to (goto-char return-to))))
;;;###autoload
(defun make-revision ()
"Prepare for a new history revision. Insert history line if inexistant."
(interactive)
(setq comment-start (or comment-start "\;")) ; Use Lisp comment as default.
(let ((header-prefix-string (header-prefix-string))
(logical-comment-start (if (= 1 (length comment-start))
(concat comment-start comment-start " ")
comment-start)))
;; Look for the history line
(beginning-of-buffer) ; Leave a mark behind.
(if (re-search-forward (concat "^\\(" (and comment-start
(regexp-quote comment-start))
(regexp-quote (header-prefix-string)) "\\|"
(if (and comment-start
(not (string= "" comment-start)))
(concat "\\|"
(regexp-quote comment-start))
"")
"\\)" " *\\(" header-history-label
"\\|HISTORY\\)") ; Backward compatibility.
header-max t)
(end-of-line)
;; We did not find a history line, add one
(goto-char (point-min))
;; find the first line that is not part of the header
(while (and (< (point) header-max)
(looking-at (concat "[ \t]*\\("
(regexp-quote (header-prefix-string))
(if (and comment-start
(not (string= "" comment-start)))
(concat "\\|" (regexp-quote comment-start))
"")
(if (and comment-end (not (string= "" comment-end)))
(concat "\\|" (regexp-quote comment-end))
"")
"\\)")))
(forward-line 1))
(insert "\n" logical-comment-start header-history-label)
(save-excursion (insert "\n" comment-end)))
;; We are now on the line with the header-history-label label
(insert "\n" header-prefix-string
(let ((str (current-time-string)))
(concat (if (equal ?\ (aref str 8))
(substring str 9 10)
(substring str 8 10))
"-" (substring str 4 7) "-" (substring str 20 24)))
" " (user-full-name)
;;" |>Ident<|\n"
" \n" header-prefix-string " ")
;; Add details about the history of the file before its modification
(when (save-excursion (re-search-backward "Last-Updated[ \t]*: \\(.+\\)$" nil t))
(insert "Last-Updated: " (buffer-substring (match-beginning 1) (match-end 1)))
(when (save-excursion (re-search-backward " Update #[ \t]*: \\([0-9]+\\)$" nil t))
(insert " #" (buffer-substring (match-beginning 1) (match-end 1))))
(when (save-excursion (re-search-backward " By[ \t]*: \\(.+\\)$" nil t))
(insert " (" (buffer-substring (match-beginning 1) (match-end 1)) ")"))
(insert "\n" header-prefix-string " "))))
;;;###autoload
(defun make-divider (&optional end-col)
"Insert a comment divider line: the comment start, filler, and end.
END-COL is the last column of the divider line."
(interactive)
(insert comment-start)
(when (= 1 (length comment-start)) (insert comment-start))
(insert (make-string (max 2 (- (or end-col (- fill-column 2))
(length comment-end) 2 (current-column)))
(aref comment-start
(if (= 1 (length comment-start)) 0 1))))
(insert (concat comment-end "\n")))
;;;###autoload
(defun make-box-comment (&optional end-col)
"Insert an empty (mode dependent) box comment.
END-COL is the last column of the divider line."
(interactive)
(unless (= 0 (current-column)) (forward-line 1))
(insert comment-start)
(when (= 1 (length comment-start)) (insert comment-start))
(unless (char-equal (preceding-char) ? ) (insert ? ))
(insert (make-string (max 2 (- (or end-col fill-column ) (length comment-end)
2 (current-column)))
(aref comment-start
(if (= 1 (length comment-start)) 0 1))))
(insert "\n" (header-prefix-string) )
(save-excursion
(insert "\n" (header-prefix-string)
(make-string (max 2 (- (or end-col fill-column)
(length comment-end) 2 (current-column)))
(aref comment-start
(if (= 1 (length comment-start)) 0 1)))
comment-end "\n")))
;; Automatic Header update code
;; ----------------------------
;;;###autoload
(defun update-file-header ()
"Update file header.
Search the first `header-max' chars in buffer using regexps in
`file-header-update-alist'. When a match is found, apply the
corresponding function with point located just after the match.
The functions can use `match-beginning' and `match-end' to find
the strings that cause them to be invoked."
(interactive)
(save-excursion
(save-restriction ; Only search `header-max' chars.
(narrow-to-region 1 (min header-max (1- (buffer-size))))
(let ((patterns file-header-update-alist))
;; Do not record this call as a command in command history.
(setq last-command nil)
(while patterns
(goto-char (point-min))
(when (re-search-forward (car (car patterns)) nil t)
;; Position cursor at end of match.
(goto-char (match-end 0))
;;(message "do %s" (car patterns)) (sit-for 1)
(funcall (cdr (car patterns))))
(setq patterns (cdr patterns)))))))
(defun auto-update-file-header ()
"Update file header if file is modified.
Call `update-file-header' if:
`header-auto-update-enabled' is non-nil,
the file is modified,
it is longer than 100 chars,
and the buffer is not read-only.
Return nil, for use on a hook."
(and header-auto-update-enabled
(> (buffer-size) 100)
(buffer-modified-p)
(not buffer-read-only)
(update-file-header)
nil))
;; Define individual file header actions. These are the building
;; blocks of automatic header maintenance.
;; -----------------------------------------------------------------------
(defsubst delete-and-forget-line ()
"Delete current line and return it. Do not add it to the `kill-ring'."
(let* ((start (point))
(stop (line-end-position))
(str (buffer-substring start stop)))
(delete-region start stop)
str))
(defun update-write-count ()
(let* ((str (delete-and-forget-line))
(rem (read-from-string str))
(num (car rem)))
(if (numberp num)
(insert (format "%s" (1+ num)) (substring str (cdr rem)))
(insert str)
(error "Invalid number for update count `%s'" str))))
;;; ;;;###autoload
;;; (defun update-VCS-version ()