diff options
Diffstat (limited to 'lisp/startup.el')
| -rw-r--r-- | lisp/startup.el | 145 |
1 files changed, 112 insertions, 33 deletions
diff --git a/lisp/startup.el b/lisp/startup.el index f20c61bdfed..c54ab89b337 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -519,6 +519,19 @@ DIRS are relative." xdg-dir) (t emacs-d-dir)))) +(defvar comp--delayed-sources) +(defvar comp--loadable) +(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) + (require 'comp) + (setq comp--loadable t) + (native--compile-async comp--delayed-sources nil 'late) + (setq comp--delayed-sources nil))) + (defvar native-comp-eln-load-path) (defun normal-top-level () "Emacs calls this function when it first starts up. @@ -785,7 +798,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: @@ -1361,7 +1375,11 @@ please check its value") ;; should check init-file-user instead, since that is already set. ;; See cus-edit.el for an example. (when site-run-file - (load "/etc/emacs/site-start.d/00debian.el") + (let ((file "/etc/emacs/site-start.d/00debian.el")) + ;; When the Emacs build invokes Emacs, such as in the + ;; Makefile rule for ${unidir}/emoji-labels.el, 00debian.el + ;; might not exist. Should be fine to just skip the load. + (when (file-readable-p file) (load file))) ;; Sites should not disable the startup screen. ;; Only individuals should disable the startup screen. (let ((inhibit-startup-screen inhibit-startup-screen)) @@ -1557,17 +1575,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 @@ -1600,7 +1623,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))) @@ -1623,22 +1647,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) @@ -1653,7 +1686,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 " @@ -1691,7 +1726,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))) @@ -1789,9 +1825,19 @@ a face or button specification." (window-width (window-width))) (when img (when (> window-width image-width) - ;; Center the image in the window. - (insert (propertize " " 'display - `(space :align-to (+ center (-0.5 . ,img))))) + ;; Center the image above text. + ;; NB. The logo used to be centered in the window, which made + ;; it align poorly with the non-centered text on large + ;; displays. Arguably it would be better to center both + ;; text and image, but this will do for now. -- SK + (let ((text-width 80) + ;; The below value chosen to avoid splash screen being + ;; visually unbalanced. This needs to be eye-balled. + (adjust-left 3)) + (insert (propertize " " 'display + `(space :align-to (+ ,(- (/ text-width 2) + adjust-left) + (-0.5 . ,img)))))) ;; Change the color of the XPM version of the splash image ;; so that it is visible with a dark frame background. @@ -1803,7 +1849,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"))))) @@ -1812,28 +1860,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 @@ -1917,7 +1972,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) @@ -1955,11 +2009,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. @@ -1971,6 +2025,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)))) @@ -2112,8 +2168,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." @@ -2193,7 +2252,11 @@ If you have no Meta key, you may instead type ESC followed by the character.)")) (startup--get-buffer-create-scratch))) '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 ")) @@ -2233,7 +2296,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") @@ -2374,6 +2439,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))) @@ -2517,7 +2583,15 @@ nil default-directory" name) (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)))) + (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)) (load file-ex nil t t))) ((equal argi "-insert") @@ -2527,6 +2601,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)) |