procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add convenience functions for generating Emacs Lisp files

Browse source 
* lisp/url/url-cookie.el (url-cookie-write-file):
* lisp/international/titdic-cnv.el (tit-process-header):
* lisp/international/ja-dic-cnv.el (skkdic-convert):
* lisp/international/emoji.el (emoji--generate-file):
* lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--rubric)

* admin/unidata/unidata-gen.el (unidata-gen-file)
(unidata-gen-charprop): Use the new functions.

* lisp/emacs-lisp/generate-file.el: New file to provide
convenience functions for generated files.  It's not always
trivial to know which parts of the trailer that has to be
obfuscated to avoid not getting byte-compiled etc, and some parts
of the headers/trailers are usually forgotten when hand-coding
these.
This commit is contained in:
Lars Ingebrigtsen 2022-06-05 16:36:25 +02:00
parent ac6660a2d0
commit 9d2f4a8d5a
7 changed files with 160 additions and 104 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
admin/unidata/unidata-gen.el
View file

@ -89,6 +89,7 @@
;; PROPn: string representing the nth property value
(eval-when-compile (require 'cl-lib))
(require 'generate-file)
(defvar unidata-list nil)
@ -1422,13 +1423,14 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(or elt (user-error "Unknown output file: %s" basename))
(or noninteractive (message "Generating %s..." file))
(with-temp-file file
(insert ";;; " basename " -*- lexical-binding:t -*-
;; " copyright "
;; Generated from Unicode data files by unidata-gen.el.
;; The sources for this file are found in the admin/unidata/ directory in
;; the Emacs sources. The Unicode data files are used under the
;; Unicode Terms of Use, as contained in the file copyright.html in that
;; same directory.\n")
(generate-file-heading
basename
:text (concat copyright " \
Generated from Unicode data files by unidata-gen.el. \
The sources for this file are found in the admin/unidata/ directory in \
the Emacs sources. The Unicode data files are used under the \
Unicode Terms of Use, as contained in the file copyright.html in that \
same directory."))
(dolist (proplist (cdr elt))
(let ((prop (unidata-prop-prop proplist))
(index (unidata-prop-index proplist))
@ -1446,21 +1448,15 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(set-char-table-extra-slot table 3 describer))
(insert (format "(define-char-code-property '%S\n %S\n %S)\n"
prop table docstring))))
(insert ";; Local Variables:\n"
";; coding: utf-8\n"
";; version-control: never\n"
";; no-byte-compile: t\n"
";; no-update-autoloads: t\n"
";; End:\n\n"
(format ";;; %s ends here\n" basename)))))
(generate-file-trailer basename :inhibit-provide t))))
(or noninteractive (message "Generating %s...done" file)))
(defun unidata-gen-charprop (&optional charprop-file text)
(or charprop-file (setq charprop-file (pop command-line-args-left)))
(with-temp-file charprop-file
(insert ";; Automatically generated by unidata-gen.el."
" -*- lexical-binding: t -*-\n"
";; See the admin/unidata/ directory in the Emacs sources.\n")
(generate-file-heading
charprop-file
:text "Automatically generated by unidata-gen.el. See the admin/unidata/ directory in the Emacs sources.")
(if text
(insert text)
(dolist (elt unidata-file-alist)
@ -1469,19 +1465,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(unidata-prop-prop proplist) (car elt)
(unidata-prop-docstring proplist))))))
(or noninteractive (message "Writing %s..." charprop-file))
(insert "\n"
(format "(provide '%s)\n"
(file-name-sans-extension
(file-name-nondirectory charprop-file)))
" \n"
";; Local Variables:\n"
";; coding: utf-8\n"
";; version-control: never\n"
";; no-byte-compile: t\n"
";; no-update-autoloads: t\n"
";; End:\n\n"
(format ";;; %s ends here\n"
(file-name-nondirectory charprop-file)))))
(generate-file-trailer charprop-file)))
(defun unidata-gen-scripts (&optional file)
;; Running from Makefile.

111
lisp/emacs-lisp/generate-file.el Normal file
View file

@ -0,0 +1,111 @@
;;; generate-file.el --- utility functions for generated 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:
;;; Code:
(eval-when-compile (require 'cl-lib))
(cl-defun generate-file-heading (file &key description text (code t))
"Insert a standard header for FILE.
This header will specify that this is a generated file that
should not be edited.
If `standard-output' is bound to a buffer, insert in that buffer.
If no, insert at point in the current buffer.
DESCRIPTION (if any) will be used in the first line.
TEXT (if given) will be inserted as a comment.
If CODE is non-nil (which is the default), a Code: line is
inserted."
(with-current-buffer (if (bufferp standard-output)
standard-output
(current-buffer))
(insert ";;; " (file-name-nondirectory file)
" --- "
(or description "automatically generated")
" (do not edit) "
" -*- lexical-binding: t -*-\n\n"
";; This file is part of GNU Emacs.\n\n")
(when text
(insert ";;; Commentary:\n\n")
(let ((start (point))
(fill-prefix ";; "))
(insert ";; " text)
(fill-region start (point))))
(ensure-empty-lines 1)
(when code
(insert ";;; Code:\n\n"))))
(cl-defun generate-file-trailer (file &key version inhibit-provide
(coding 'utf-8-emacs-unix) autoloads
compile provide)
"Insert a standard trailer for FILE.
By default, this trailer inhibits version control, byte
compilation, updating autoloads, and uses a `utf-8-emacs-unix'
coding system. These can be inhibited by providing non-nil
values to the VERSION, NO-PROVIDE, AUTOLOADS and COMPILE
keyword arguments.
CODING defaults to `utf-8-emacs-unix'. Use a nil value to
inhibit generating this setting, or a coding system value to use
that.
If PROVIDE is non-nil, use that in the `provide' statement
instead of using FILE as the basis.
If `standard-output' is bound to a buffer, insert in that buffer.
If no, insert at point in the current buffer."
(with-current-buffer (if (bufferp standard-output)
standard-output
(current-buffer))
(ensure-empty-lines 1)
(unless inhibit-provide
(insert (format "(provide '%s)\n\n"
(or provide
(file-name-sans-extension
(file-name-nondirectory file))))))
;; Some of the strings below are chopped into bits to inhibit
;; automatic scanning tools from thinking that they are actual
;; directives.
(insert ";; Local " "Variables:\n")
(unless version
(insert ";; version-control: never\n"))
(unless compile
(insert ";; no-byte-" "compile: t\n")) ;; #$ is byte-compiled into nil.
(unless autoloads
(insert ";; no-update-autoloads: t\n"))
(when coding
(insert (format ";; coding: %s\n"
(if (eq coding t)
'utf-8-emacs-unix
coding))))
(insert
";; End:\n\n"
";;; " (file-name-nondirectory file) " ends here\n")))
(provide 'generate-file)
;;; generate-file.el ends here

41
lisp/emacs-lisp/loaddefs-gen.el
View file

@ -40,6 +40,7 @@
(require 'radix-tree)
(require 'lisp-mnt)
(require 'generate-file)
(defvar autoload-compute-prefixes t
"If non-nil, autoload will add code to register the prefixes used in a file.
@ -437,32 +438,20 @@ 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."
(let ((basename (file-name-nondirectory file))
(lp (if (equal type "package") (setq type "autoloads"))))
(concat ";;; " basename
" --- automatically extracted " (or type "autoloads")
" -*- lexical-binding: t -*-\n"
(when (string-match "/lisp/loaddefs\\.el\\'" file)
";; This file will be copied to ldefs-boot.el and checked in periodically.\n")
";;\n"
";;; Code:\n\n"
(if lp
"(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))\n\n")
" \n;;; End of scraped data\n\n"
;; This is used outside of autoload.el, eg cus-dep, finder.
(if feature
(format "(provide '%s)\n"
(if (stringp feature) feature
(file-name-sans-extension basename))))
";; Local Variables:\n"
";; version-control: never\n"
";; no-byte-compile: t\n" ;; #$ is byte-compiled into nil.
";; no-update-autoloads: t\n"
";; coding: utf-8-emacs-unix\n"
";; End:\n"
";;; " basename
" ends here\n")))
(let ((lp (and (equal type "package") (setq type "autoloads"))))
(with-temp-buffer
(generate-file-heading
file
:description (concat "automatically extracted " (or type "autoloads"))
:text (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 " \n;;; End of scraped data\n\n")
(generate-file-trailer file :provide (and (stringp feature) feature)
:inhibit-provide (not feature))
(buffer-string))))
(defun loaddefs-generate--insert-section-header (outbuf autoloads
load-name file time)

18
lisp/international/emoji.el
View file

@ -31,6 +31,7 @@
(require 'cl-extra)
(require 'transient)
(require 'multisession)
(require 'generate-file)
(defgroup emoji nil
"Inserting Emojis."
@ -415,8 +416,8 @@ the name is not known."
(dolist (glyph glyphs)
(remhash glyph emoji--derived)))
(with-temp-buffer
(insert ";; Generated file -- do not edit. -*- lexical-binding:t -*-
;; Copyright © 1991-2021 Unicode, Inc.
(generate-file-heading file)
(insert ";; Copyright © 1991-2021 Unicode, Inc.
;; Generated from Unicode data files by emoji.el.
;; The source for this file is found in the admin/unidata/emoji-test.txt
;; file in the Emacs sources. The Unicode data files are used under the
@ -426,18 +427,7 @@ the name is not known."
(insert (format "(defconst %s '" var))
(pp (symbol-value var) (current-buffer))
(insert (format "\n) ;; End %s\n\n" var)))
(insert ";; Local" " Variables:
;; coding: utf-8
;; version-control: never
;; no-byte-"
;; Obfuscate to not inhibit compilation of this file, too.
"compile: t
;; no-update-autoloads: t
;; End:
\(provide 'emoji-labels)
\;;; emoji-labels.el ends here\n")
(generate-file-trailer file)
(write-region (point-min) (point-max) file)))
(defun emoji--base-name (name derivations)

16
lisp/international/ja-dic-cnv.el
View file

@ -44,6 +44,8 @@
;;; Code:
(require 'generate-file)
;; Name of a file to generate from SKK dictionary.
(defvar ja-dic-filename "ja-dic.el")
@ -340,13 +342,11 @@ Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
(with-current-buffer buf
(erase-buffer)
(buffer-disable-undo)
(insert ";;; ja-dic.el --- dictionary for Japanese input method"
" -*- lexical-binding:t -*-\n"
";;\tGenerated by the command `skkdic-convert'\n"
(generate-file-heading ja-dic-filename :code nil)
(insert ";;\tGenerated by the `skkdic-convert' function.\n"
";;\tOriginal SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)
"\n\n"
";; This file is part of GNU Emacs.\n\n"
";;; Start of the header of the original SKK dictionary.\n\n")
(set-buffer skkbuf)
(goto-char 1)
@ -394,13 +394,7 @@ Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
;; Postfix
(with-current-buffer buf
(goto-char (point-max))
(insert ";;\n(provide 'ja-dic)\n\n"
";; Local Variables:\n"
";; version-control: never\n"
";; no-update-autoloads: t\n"
";; coding: utf-8\n"
";; End:\n\n"
";;; ja-dic.el ends here\n")))
(generate-file-trailer ja-dic-filename :compile t)))
;; Save the working buffer.
(set-buffer buf)

28
lisp/international/titdic-cnv.el
View file

@ -62,6 +62,7 @@
;;; Code:
(require 'quail)
(require 'generate-file)
;; List of values of key "ENCODE:" and the corresponding Emacs
;; coding-system and language environment name.
@ -269,13 +270,12 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲,
(tit-moveleft ",<")
(tit-keyprompt nil))
(princ (format ";;; %s -*- lexical-binding:t -*-\n"
(file-name-nondirectory filename)))
(generate-file-heading filename :code nil)
(princ ";; Quail package `")
(princ package)
(princ "\n")
(princ (substitute-command-keys
";; Generated by the command `titdic-convert'\n"))
";; Generated by the `titdic-convert' function.\n"))
(princ ";;\tOriginal TIT dictionary file: ")
(princ (file-name-nondirectory filename))
(princ "\n\n")
@ -521,11 +521,8 @@ the generated Quail package is saved."
;; Process the body part
(tit-process-body)
(princ ";; Local Variables:\n")
(princ ";; version-control: never\n")
(princ ";; no-update-autoloads: t\n")
(princ ";; End:\n"))))))
(generate-file-trailer
filename :inhibit-provide t :compile t :coding nil))))))
;;;###autoload
(defun batch-titdic-convert (&optional force)
@ -1135,11 +1132,10 @@ the generated Quail package is saved."
;; Explicitly set eol format to `unix'.
(setq coding-system-for-write 'utf-8-unix)
(with-temp-file (expand-file-name quailfile dirname)
(insert (format ";;; %s -*- lexical-binding:t -*-\n"
(file-name-nondirectory quailfile)))
(generate-file-heading quailfile)
(insert (format-message ";; Quail package `%s'\n" name))
(insert (format-message
";; Generated by the command `miscdic-convert'\n"))
";; Generated by the `miscdic-convert' function.\n"))
(insert ";; Source dictionary file: " dicfile "\n")
(insert ";; Copyright notice of the source file\n")
(insert ";;------------------------------------------------------\n")
@ -1161,11 +1157,8 @@ the generated Quail package is saved."
(let ((dicbuf (current-buffer)))
(with-current-buffer dstbuf
(funcall converter dicbuf)))))
(insert ";; Local Variables:\n"
";; version-control: never\n"
";; no-update-autoloads: t\n"
";; End:\n\n"
";;; " quailfile " ends here\n")))
(generate-file-trailer
quailfile :inhibit-provide t :compile t :coding nil)))
(setq tail (cdr tail)))))
(defun batch-miscdic-convert ()
@ -1228,7 +1221,4 @@ The library is named pinyin.el, and contains the constant
(insert "(provide 'pinyin)\n"))
(kill-emacs 0)))
;; Prevent "Local Variables" above confusing Emacs.
;;; titdic-cnv.el ends here

6
lisp/url/url-cookie.el
View file

@ -26,6 +26,7 @@
(require 'url-util)
(require 'url-parse)
(require 'url-domsuf)
(require 'generate-file)
(eval-when-compile (require 'cl-lib))
@ -158,10 +159,7 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
(insert ")\n(setq url-cookie-secure-storage\n '")
(pp url-cookie-secure-storage (current-buffer)))
(insert ")\n")
(insert " \n;; Local Variables:\n"
";; version-control: never\n"
";; no-byte-compile: t\n"
";; End:\n")
(generate-file-trailer fname :inhibit-provide t :autoloads t)
(setq-local version-control 'never)
(write-file fname))
(setq url-cookies-changed-since-last-save nil))))