diff options
Diffstat (limited to 'lisp/startup.el')
| -rw-r--r-- | lisp/startup.el | 320 |
1 files changed, 252 insertions, 68 deletions
diff --git a/lisp/startup.el b/lisp/startup.el index 9ebd4c1a707..4b42cd236c9 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -519,10 +519,60 @@ DIRS are relative." xdg-dir) (t emacs-d-dir)))) +(defvar comp--compilable) +(defvar comp--delayed-sources) +(defun startup--require-comp-safely () + "Require the native compiler avoiding circular dependencies." + (when (featurep 'native-compile) + ;; Require comp with `comp--compilable' set to nil to break + ;; circularity. + (let ((comp--compilable nil)) + (require 'comp)) + (native--compile-async comp--delayed-sources nil 'late) + (setq comp--delayed-sources nil))) + +(declare-function native--compile-async "comp.el" + (files &optional recursively load selector)) +(defun startup--honor-delayed-native-compilations () + "Honor pending delayed deferred native compilations." + (when (and (native-comp-available-p) + comp--delayed-sources) + (startup--require-comp-safely)) + (setq comp--compilable t)) + (defvar native-comp-eln-load-path) (defvar native-comp-deferred-compilation) (defvar comp-enable-subr-trampolines) +(defvar startup--original-eln-load-path nil + "Original value of `native-comp-eln-load-path'.") + +(defun startup-redirect-eln-cache (cache-directory) + "Redirect the user's eln-cache directory to CACHE-DIRECTORY. +CACHE-DIRECTORY must be a single directory, a string. +This function destructively changes `native-comp-eln-load-path' +so that its first element is CACHE-DIRECTORY. If CACHE-DIRECTORY +is not an absolute file name, it is interpreted relative +to `user-emacs-directory'. +For best results, call this function in your early-init file, +so that the rest of initialization and package loading uses +the updated value." + ;; Remove the original eln-cache. + (setq native-comp-eln-load-path (cdr native-comp-eln-load-path)) + ;; Add the new eln-cache. + (push (expand-file-name (file-name-as-directory cache-directory) + user-emacs-directory) + native-comp-eln-load-path)) + +(defun startup--update-eln-cache () + "Update the user eln-cache directory due to user customizations." + ;; Don't override user customizations! + (when (equal native-comp-eln-load-path + startup--original-eln-load-path) + (startup-redirect-eln-cache "eln-cache") + (setq startup--original-eln-load-path + (copy-sequence native-comp-eln-load-path)))) + (defun normal-top-level () "Emacs calls this function when it first starts up. It sets `command-line-processed', processes the command-line, @@ -556,18 +606,8 @@ It is the default value of the variable `top-level'." (unless (string= "" path) (push path native-comp-eln-load-path))))) (push (expand-file-name "eln-cache/" user-emacs-directory) - native-comp-eln-load-path) - ;; When $HOME is set to '/nonexistent' means we are running the - ;; testsuite, add a temporary folder in front to produce there - ;; new compilations. - (when (and (equal (getenv "HOME") "/nonexistent") - ;; We may be running in a chroot environment where we - ;; can't write anything. - (file-writable-p (expand-file-name - (or temporary-file-directory "")))) - (let ((tmp-dir (make-temp-file "emacs-testsuite-" t))) - (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) - (push tmp-dir native-comp-eln-load-path)))) + native-comp-eln-load-path)) + ;; Look in each dir in load-path for a subdirs.el file. If we ;; find one, load it, which will add the appropriate subdirs of ;; that dir into load-path. This needs to be done before setting @@ -663,7 +703,9 @@ It is the default value of the variable `top-level'." ;; native-comp-eln-load-path. (expand-file-name (decode-coding-string dir coding t))) - npath)))) + npath))) + (setq startup--original-eln-load-path + (copy-sequence native-comp-eln-load-path))) (dolist (filesym '(data-directory doc-directory exec-directory installation-directory invocation-directory invocation-name @@ -713,6 +755,7 @@ It is the default value of the variable `top-level'." (let ((old-face-font-rescale-alist face-font-rescale-alist)) (unwind-protect (command-line) + ;; Do this again, in case .emacs defined more abbreviations. (if default-directory (setq default-directory (abbreviate-file-name default-directory))) @@ -779,6 +822,7 @@ It is the default value of the variable `top-level'." (font-menu-add-default)) (unless inhibit-startup-hooks (run-hooks 'window-setup-hook)))) + ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. ;; We are careful to do it late (after term-setup-hook), although the @@ -796,7 +840,8 @@ It is the default value of the variable `top-level'." (if (string-match "\\`DISPLAY=" varval) (setq display varval)))) (when display - (delete display process-environment))))) + (delete display process-environment)))) + (startup--honor-delayed-native-compilations)) ;; Precompute the keyboard equivalents in the menu bar items. ;; Command-line options supported by tty's: @@ -975,7 +1020,11 @@ init-file, or to a default value if loading is not possible." (debug-on-error-initial (if (eq init-file-debug t) 'startup - init-file-debug))) + init-file-debug)) + ;; The init file might contain byte-code with embedded NULs, + ;; which can cause problems when read back, so disable nul + ;; byte detection. (Bug#52554) + (inhibit-null-byte-detection t)) (let ((debug-on-error debug-on-error-initial)) (condition-case-unless-debug error (when init-file-user @@ -1053,6 +1102,9 @@ the `--debug-init' option to view a complete error backtrace." (when debug-on-error-should-be-set (setq debug-on-error debug-on-error-from-init-file)))) +(defvar lisp-directory nil + "Directory where Emacs's own *.el and *.elc Lisp files are installed.") + (defun command-line () "A subroutine of `normal-top-level'. Amongst another things, it parses the command-line arguments." @@ -1084,8 +1136,7 @@ Amongst another things, it parses the command-line arguments." (let ((simple-file-name ;; Look for simple.el or simple.elc and use their directory ;; as the place where all Lisp files live. - (locate-file "simple" load-path (get-load-suffixes))) - lisp-dir) + (locate-file "simple" load-path (get-load-suffixes)))) ;; Don't abort if simple.el cannot be found, but print a warning. ;; Although in most usage we are going to cryptically abort a moment ;; later anyway, due to missing required bidi data files (eg bug#13430). @@ -1101,12 +1152,13 @@ please check its value") (unless (file-readable-p lispdir) (princ (format "Lisp directory %s not readable?" lispdir)) (terpri))) - (setq lisp-dir (file-truename (file-name-directory simple-file-name))) + (setq lisp-directory + (file-truename (file-name-directory simple-file-name))) (setq load-history (mapcar (lambda (elt) (if (and (stringp (car elt)) (not (file-name-absolute-p (car elt)))) - (cons (concat lisp-dir + (cons (concat lisp-directory (car elt)) (cdr elt)) elt)) @@ -1139,7 +1191,8 @@ please check its value") ("--no-x-resources") ("--debug-init") ("--user") ("--iconic") ("--icon-type") ("--quick") ("--no-blinking-cursor") ("--basic-display") - ("--dump-file") ("--temacs") ("--seccomp"))) + ("--dump-file") ("--temacs") ("--seccomp") + ("--init-directory"))) (argi (pop args)) (orig-argi argi) argval) @@ -1159,6 +1212,14 @@ please check its value") (t (setq argval nil argi orig-argi))))) + + ;; We handle "-scripteval" further down, but we have to + ;; inhibit loading the user init file first. (This is for + ;; "emacs -x" handling.) + (when (equal argi "-scripteval") + (setq init-file-user nil + noninteractive t)) + (cond ;; The --display arg is handled partly in C, partly in Lisp. ;; When it shows up here, we just put it back to be handled @@ -1179,6 +1240,9 @@ please check its value") (push '(vertical-scroll-bars . nil) initial-frame-alist)) ((member argi '("-q" "-no-init-file")) (setq init-file-user nil)) + ((member argi '("-init-directory")) + (setq user-emacs-directory (or argval (pop args)) + argval nil)) ((member argi '("-u" "-user")) (setq init-file-user (or argval (pop args)) argval nil)) @@ -1211,12 +1275,16 @@ please check its value") (setcdr command-line-args args))) ;; Re-evaluate predefined variables whose initial value depends on - ;; the runtime context. - (when (listp custom-delayed-init-variables) - (mapc #'custom-reevaluate-setting - ;; Initialize them in the same order they were loaded, in - ;; case there are dependencies between them. - (reverse custom-delayed-init-variables))) + ;; the runtime context. But delay the warning about + ;; `user-emacs-directory' being inaccessible until after processing + ;; the init file and the command-line arguments, in case the user + ;; customized `user-emacs-directory-warning' to nil via those. + (let ((user-emacs-directory-warning nil)) + (when (listp custom-delayed-init-variables) + (mapc #'custom-reevaluate-setting + ;; Initialize them in the same order they were loaded, in + ;; case there are dependencies between them. + (reverse custom-delayed-init-variables)))) (setq custom-delayed-init-variables t) ;; Warn for invalid user name. @@ -1255,7 +1323,8 @@ please check its value") (and (eq xdg-dir user-emacs-directory) (not (eq xdg-dir startup--xdg-config-default)))) user-emacs-directory - ;; The name is not obvious, so access more directories to calculate it. + ;; The name is not obvious, so access more directories + ;; to calculate it. (setq xdg-dir (concat "~" init-file-user "/.config/emacs/")) (startup--xdg-or-homedot xdg-dir init-file-user))) @@ -1271,6 +1340,12 @@ please check its value") startup-init-directory))) (setq early-init-file user-init-file) + ;; Amend `native-comp-eln-load-path', since the early-init file may + ;; have altered `user-emacs-directory' and/or changed the eln-cache + ;; directory. + (when (featurep 'native-compile) + (startup--update-eln-cache)) + ;; If any package directory exists, initialize the package system. (and user-init-file package-enable-at-startup @@ -1405,6 +1480,12 @@ please check its value") startup-init-directory)) t) + ;; Amend `native-comp-eln-load-path' again, since the early-init + ;; file may have altered `user-emacs-directory' and/or changed the + ;; eln-cache directory. + (when (featurep 'native-compile) + (startup--update-eln-cache)) + (when (and deactivate-mark transient-mark-mode) (with-current-buffer (window-buffer) (deactivate-mark))) @@ -1464,9 +1545,21 @@ please check its value") (list 'error (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs"))) + ;; Reevaluate `user-emacs-directory-warning' before processing + ;; '--eval' arguments, so that the user could override the default + ;; value in the '--eval' forms. + (custom-reevaluate-setting 'user-emacs-directory-warning) + ;; Process the remaining args. (command-line-1 (cdr command-line-args)) + ;; Check if `user-emacs-directory' is accessible and warn if it + ;; isn't, unless `user-emacs-directory-warning' was customized to + ;; disable that warning. + (when (and user-emacs-directory-warning + (not (file-accessible-directory-p user-emacs-directory))) + (locate-user-emacs-file "")) + ;; This is a problem because, e.g. if emacs.d/gnus.el exists, ;; trying to load gnus could load the wrong file. ;; OK, it would not matter if .emacs.d were at the end of load-path. @@ -1567,17 +1660,22 @@ If this is nil, no message will be displayed." `((:face (variable-pitch font-lock-comment-face) "Welcome to " :link ("GNU Emacs" - ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/")) + ,(lambda (_button) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/software/emacs/"))) "Browse https://www.gnu.org/software/emacs/") ", one component of the " :link ,(lambda () (if (eq system-type 'gnu/linux) `("GNU/Linux" - ,(lambda (_button) (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html")) + ,(lambda (_button) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html"))) "Browse https://www.gnu.org/gnu/linux-and-gnu.html") `("GNU" ,(lambda (_button) - (browse-url "https://www.gnu.org/gnu/thegnuproject.html")) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/gnu/thegnuproject.html"))) "Browse https://www.gnu.org/gnu/thegnuproject.html"))) " operating system.\n\n" :face variable-pitch @@ -1610,7 +1708,8 @@ If this is nil, no message will be displayed." "\n" :link ("Emacs Guided Tour" ,(lambda (_button) - (browse-url "https://www.gnu.org/software/emacs/tour/")) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/software/emacs/tour/"))) "Browse https://www.gnu.org/software/emacs/tour/") "\tOverview of Emacs features at gnu.org\n" :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual))) @@ -1633,22 +1732,31 @@ Each element in the list should be a list of strings or pairs `((:face (variable-pitch font-lock-comment-face) "This is " :link ("GNU Emacs" - ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/")) + ,(lambda (_button) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/software/emacs/"))) "Browse https://www.gnu.org/software/emacs/") - ", one component of the " + ", a text editor and more.\nIt's a component of the " :link ,(lambda () (if (eq system-type 'gnu/linux) `("GNU/Linux" ,(lambda (_button) - (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html")) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html"))) "Browse https://www.gnu.org/gnu/linux-and-gnu.html") - `("GNU" ,(lambda (_button) (describe-gnu-project)) + `("GNU" ,(lambda (_button) + (let ((browse-url-browser-function 'eww-browse-url)) + (describe-gnu-project))) "Display info on the GNU project."))) " operating system.\n" :face (variable-pitch font-lock-builtin-face) "\n" - ,(lambda () (emacs-version)) + ,(lambda () + (with-temp-buffer + (insert (emacs-version)) + (fill-region (point-min) (point-max)) + (buffer-string))) "\n" :face (variable-pitch (:height 0.8)) ,(lambda () emacs-copyright) @@ -1663,7 +1771,9 @@ Each element in the list should be a list of strings or pairs ,(lambda (_button) (info "(emacs)Contributing"))) "\tHow to report bugs and contribute improvements to Emacs\n" "\n" - :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project))) + :link ("GNU and Freedom" ,(lambda (_button) + (let ((browse-url-browser-function 'eww-browse-url)) + (describe-gnu-project)))) "\tWhy we developed GNU Emacs, and the GNU operating system\n" :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty))) "\tGNU Emacs comes with " @@ -1701,7 +1811,8 @@ Each element in the list should be a list of strings or pairs "\n" :link ("Emacs Guided Tour" ,(lambda (_button) - (browse-url "https://www.gnu.org/software/emacs/tour/")) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/software/emacs/tour/"))) "Browse https://www.gnu.org/software/emacs/tour/") "\tSee an overview of Emacs features at gnu.org\n" :link ("Emacs Manual" ,(lambda (_button) (info-emacs-manual))) @@ -1823,7 +1934,9 @@ a face or button specification." (make-button (prog1 (point) (insert-image img)) (point) 'face 'default 'help-echo "mouse-2, RET: Browse https://www.gnu.org/" - 'action (lambda (_button) (browse-url "https://www.gnu.org/")) + 'action (lambda (_button) + (let ((browse-url-browser-function 'eww-browse-url)) + (browse-url "https://www.gnu.org/"))) 'follow-link t) (insert "\n\n"))))) @@ -1832,28 +1945,35 @@ a face or button specification." (unless concise (fancy-splash-insert :face 'variable-pitch - "\nTo start... " + "\nTo start...\t" :link `("Open a File" ,(lambda (_button) (call-interactively 'find-file)) "Specify a new file's name, to edit the file") - " " + "\t\t" :link `("Open Home Directory" ,(lambda (_button) (dired "~")) "Open your home directory, to operate on its files") - " " + "\n\t" :link `("Customize Startup" ,(lambda (_button) (customize-group 'initialization)) "Change initialization settings including this screen") + "\t" + :link `("Explore Packages" + ,(lambda (_button) (call-interactively 'package-list-packages)) + "Explore, install and remove Emacs packages (requires Internet connection)") "\n")) (fancy-splash-insert :face 'variable-pitch "To quit a partially entered command, type " :face 'default "Control-g" :face 'variable-pitch ".\n") - (fancy-splash-insert :face '(variable-pitch font-lock-builtin-face) - "\nThis is " - (emacs-version) - "\n" - :face '(variable-pitch (:height 0.8)) + (save-restriction + (narrow-to-region (point) (point)) + (fancy-splash-insert :face '(variable-pitch font-lock-builtin-face) + "\nThis is " + (emacs-version) + "\n") + (fill-region (point-min) (point-max))) + (fancy-splash-insert :face '(variable-pitch (:height 0.8)) emacs-copyright "\n") (when auto-save-list-file-prefix @@ -1937,7 +2057,6 @@ splash screen in another window." (insert "\n") (fancy-startup-tail concise)) (use-local-map splash-screen-keymap) - (setq-local browse-url-browser-function 'eww-browse-url) (setq tab-width 22 buffer-read-only t) (set-buffer-modified-p nil) @@ -1975,11 +2094,11 @@ splash screen in another window." (goto-char (point-min)) (force-mode-line-update)) (use-local-map splash-screen-keymap) - (setq-local browse-url-browser-function 'eww-browse-url) (setq tab-width 22) (setq buffer-read-only t) + ;; Place point somewhere it doesn't cover a character. (goto-char (point-min)) - (forward-line 3)))) + (re-search-forward "\n$" nil nil 2)))) (defun fancy-splash-frame () "Return the frame to use for the fancy splash screen. @@ -1991,6 +2110,8 @@ we put it on this frame." ;; frame visible. (if (eq (window-system) 'w32) (sit-for 0 t)) + (if (eq (window-system) 'pgtk) + (sit-for 0.1 t)) (dolist (frame (append (frame-list) (list (selected-frame)))) (if (and (frame-visible-p frame) (not (window-minibuffer-p (frame-selected-window frame)))) @@ -2132,8 +2253,11 @@ To quit a partially entered command, type Control-g.\n") 'follow-link t) (insert "\tChange initialization settings including this screen\n") - (insert "\n" (emacs-version) - "\n" emacs-copyright)) + (save-restriction + (narrow-to-region (point) (point)) + (insert "\n" (emacs-version) "\n") + (fill-region (point-min) (point-max))) + (insert emacs-copyright)) (defun normal-no-mouse-startup-screen () "Show a splash screen suitable for displays without mouse support." @@ -2210,10 +2334,14 @@ If you have no Meta key, you may instead type ESC followed by the character.)")) (insert "\t\t") (insert-button "Open *scratch* buffer" 'action (lambda (_button) (switch-to-buffer - (startup--get-buffer-create-scratch))) + (get-scratch-buffer-create))) 'follow-link t) (insert "\n") - (insert "\n" (emacs-version) "\n" emacs-copyright "\n") + (save-restriction + (narrow-to-region (point) (point)) + (insert "\n" (emacs-version) "\n") + (fill-region (point-min) (point-max))) + (insert emacs-copyright "\n") (insert (substitute-command-keys " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) @@ -2253,7 +2381,9 @@ Type \\[describe-distribution] for information on ")) (insert "\tHow to report bugs and contribute improvements to Emacs\n\n") (insert-button "GNU and Freedom" - 'action (lambda (_button) (describe-gnu-project)) + 'action (lambda (_button) + (let ((browse-url-browser-function 'eww-browse-url)) + (describe-gnu-project))) 'follow-link t) (insert "\t\tWhy we developed GNU Emacs and the GNU system\n") @@ -2336,12 +2466,6 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'about-emacs 'display-about-screen) (defalias 'display-splash-screen 'display-startup-screen) -(defun startup--get-buffer-create-scratch () - (or (get-buffer "*scratch*") - (with-current-buffer (get-buffer-create "*scratch*") - (set-buffer-major-mode (current-buffer)) - (current-buffer)))) - ;; This avoids byte-compiler warning in the unexec build. (declare-function pdumper-stats "pdumper.c" ()) @@ -2394,6 +2518,7 @@ A fancy display is used on graphic displays, normal otherwise." ;; and long versions of what's on command-switch-alist. (longopts (append '("--funcall" "--load" "--insert" "--kill" + "--dump-file" "--seccomp" "--directory" "--eval" "--execute" "--no-splash" "--find-file" "--visit" "--file" "--no-desktop") (mapcar (lambda (elt) (concat "-" (car elt))) @@ -2533,12 +2658,23 @@ nil default-directory" name) ;; This is used to handle -script. It's not clear ;; we need to document it (it is totally internal). - ((member argi '("-scriptload")) + ((member argi '("-scriptload" "-scripteval")) (let* ((file (command-line-normalize-file-name (or argval (pop command-line-args-left)))) ;; Take file from default dir. - (file-ex (file-truename (expand-file-name file)))) - (load file-ex nil t t))) + (file-ex (expand-file-name file)) + (truename (file-truename file-ex))) + ;; We want to use the truename here if we can, + ;; because that makes `eval-after-load' work + ;; more reliably. But if the file is, for + ;; instance, /dev/stdin, the truename doesn't + ;; actually exist on some systems. + (when (file-exists-p truename) + (setq file-ex truename)) + (if (equal argi "-scripteval") + ;; This will kill Emacs. + (command-line--eval-script file-ex) + (command-line--load-script file-ex)))) ((equal argi "-insert") (setq inhibit-startup-screen t) @@ -2547,6 +2683,11 @@ nil default-directory" name) (error "File name omitted from `-insert' option")) (insert-file-contents (command-line-normalize-file-name tem))) + ((or (equal argi "-dump-file") + (equal argi "-seccomp")) + ;; This was processed in C. + (or argval (pop command-line-args-left))) + ((equal argi "-kill") (kill-emacs t)) @@ -2616,7 +2757,7 @@ nil default-directory" name) (when (eq initial-buffer-choice t) ;; When `initial-buffer-choice' equals t make sure that *scratch* ;; exists. - (startup--get-buffer-create-scratch)) + (get-scratch-buffer-create)) ;; If *scratch* exists and is empty, insert initial-scratch-message. ;; Do this before switching to *scratch* below to handle bug#9605. @@ -2640,7 +2781,7 @@ nil default-directory" name) ((functionp initial-buffer-choice) (funcall initial-buffer-choice)) ((eq initial-buffer-choice t) - (startup--get-buffer-create-scratch)) + (get-scratch-buffer-create)) (t (error "`initial-buffer-choice' must be a string, a function, or t"))))) (unless (buffer-live-p buf) @@ -2658,10 +2799,24 @@ nil default-directory" name) (nondisplayed-buffers-p nil)) (when (> displayable-buffers-len 0) (switch-to-buffer (car displayable-buffers))) - (when (> displayable-buffers-len 1) - (switch-to-buffer-other-window (car (cdr displayable-buffers))) + (cond + ;; Two buffers; display them both. + ((= displayable-buffers-len 2) + (switch-to-buffer-other-window (cadr displayable-buffers)) ;; Focus on the first buffer. (other-window -1)) + ;; More than two buffers: Ensure that the buffer display order + ;; reflects the order they were given on the command line. + ;; (This will end up with a `next-buffer' order that's in + ;; reverse order -- the final file is the focused one, and then + ;; the rest are in `next-buffer' in descending order. + ((> displayable-buffers-len 2) + (let ((bufs (reverse (cdr displayable-buffers)))) + (switch-to-buffer-other-window (pop bufs)) + (dolist (buf bufs) + (switch-to-buffer buf nil t)) + ;; Focus on the first buffer. + (other-window -1)))) (when (> displayable-buffers-len 2) (setq nondisplayed-buffers-p t)) @@ -2708,6 +2863,35 @@ nil default-directory" name) (display-startup-screen (> displayable-buffers-len 0)))))) +(defun command-line--load-script (file) + (load-with-code-conversion + file file nil t + (lambda (buffer file) + (with-current-buffer buffer + (goto-char (point-min)) + ;; Removing the #! and then calling `eval-buffer' will make the + ;; reader not signal an error if it then turns out that the + ;; buffer is empty. + (when (looking-at "#!") + (delete-line)) + (eval-buffer buffer nil file nil t))))) + +(defun command-line--eval-script (file) + (load-with-code-conversion + file file nil t + (lambda (buffer _) + (with-current-buffer buffer + (goto-char (point-min)) + (when (looking-at "#!") + (forward-line)) + (let (value form) + (while (ignore-error 'end-of-file + (setq form (read (current-buffer)))) + (setq value (eval form t))) + (kill-emacs (if (numberp value) + value + 0))))))) + (defun command-line-normalize-file-name (file) "Collapse multiple slashes to one, to handle non-Emacs file names." (save-match-data |