;;; crafted-startup.el --- Crafted Emacs splash screen on startup -*- lexical-binding: t; -*- ;; Copyright (C) 2022 ;; SPDX-License-Identifier: MIT ;; Author: System Crafters Community ;;; Commentary: ;; Provide a fancy splash screen similar to the Emacs default splash ;; screen or the Emacs about page. ;;; Code: (require 'crafted-updates) (defgroup crafted-startup '() "Startup configuration for Crafted Emacs" :tag "Crafted Startup" :group 'crafted) (define-obsolete-variable-alias 'rational-startup-inhibit-splash 'crafted-startup-inhibit-splash "1") (defcustom crafted-startup-inhibit-splash nil "Disable the Crafted Emacs Splash screen" :type 'boolean :group 'crafted-startup) (define-obsolete-variable-alias 'rational-startup-recentf-count 'crafted-startup-recentf-count "1") (defcustom crafted-startup-recentf-count 10 "The number of recent files to display on the splash screen" :type 'number :group 'crafted-startup) (defconst crafted-startup-text `((:face (variable-pitch font-lock-comment-face (:height 1.5) bold) ,(let* ((welcome-text "Welcome to Crafted Emacs!\n\n") (welcome-len (length welcome-text)) (welcome-mid (/ welcome-len 2))) (concat (make-string (abs (- (/ (window-width) 2) welcome-mid)) ? ) welcome-text)) :face variable-pitch :link ("View Crafted Emacs Manual" ,(lambda (_button) (info "crafted-emacs"))) "\tView the Crafted Emacs manual using Info\n" "\n")) "A list of texts to show in the middle part of splash screens. Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") (defvar crafted-startup-screen-inhibit-startup-screen nil) (defun crafted-startup-tail (&optional concise) "Insert the tail part of the splash screen into the current buffer." (fancy-splash-insert :face 'variable-pitch "\nTo start... " :link `("Open a File" ,(lambda (_button) (call-interactively 'find-file)) "Specify a new file's name, to edit the file") " " :link `("Open Home Directory" ,(lambda (_button) (dired "~")) "Open your home directory, to operate on its files") " " :link `("Open Crafted Config Directory" ,(lambda (_button) (dired crafted-config-path)) "Open the Crafted Emacs configuration directory, to operate on its files") " " :link `("Customize Crafted Emacs" ,(lambda (_button) (customize-group 'crafted)) "Change initialization settings including this screen") "\n") (fancy-splash-insert :face '(variable-pitch (:height 0.7)) "\n\nTurn this screen off by adding:\n" :face '(default font-lock-keyword-face) "`(customize-set-variable 'crafted-startup-inhibit-splash t)'\n" :face '(variable-pitch (:height 0.7)) " to your " crafted-config-file "\n" "Or check the box and click the link below, which will do the same thing.") (fancy-splash-insert :face 'variable-pitch "\n" :link `("Dismiss this startup screen" ,(lambda (_button) (when crafted-startup-screen-inhibit-startup-screen (customize-set-variable 'crafted-startup-inhibit-splash t) (customize-mark-to-save 'crafted-startup-inhibit-splash) (custom-save-all)) (quit-windows-on "*Crafted Emacs*" t))) " ") (when custom-file (let ((checked (create-image "checked.xpm" nil nil :ascent 'center)) (unchecked (create-image "unchecked.xpm" nil nil :ascent 'center))) (insert-button " " :on-glyph checked :off-glyph unchecked 'checked nil 'display unchecked 'follow-link t 'action (lambda (button) (if (overlay-get button 'checked) (progn (overlay-put button 'checked nil) (overlay-put button 'display (overlay-get button :off-glyph)) (setq crafted-startup-screen-inhibit-startup-screen nil)) (overlay-put button 'checked t) (overlay-put button 'display (overlay-get button :on-glyph)) (setq crafted-startup-screen-inhibit-startup-screen t)))))) (fancy-splash-insert :face '(variable-pitch (:height 0.9)) " Never show it again.")) (defun crafted-startup-recentf () (message "Showing recents on splash screen") (fancy-splash-insert :face '(variable-pitch font-lock-string-face italic) (condition-case recentf-list (if (not (seq-empty-p recentf-list)) "Recent Files:\n" "\n") (error "\n"))) (condition-case recentf-list (if (not (seq-empty-p recentf-list)) (dolist (file (seq-take recentf-list crafted-startup-recentf-count)) (fancy-splash-insert :face 'default :link `(,file ,(lambda (_button) (find-file file))) "\n")) "\n") (error "\n"))) (defun crafted-startup-screen (&optional concise) "Display fancy startup screen. If CONCISE is non-nil, display a concise version of the splash screen in another window." (message "Loading Crafted Startup Screen") (let ((splash-buffer (get-buffer-create "*Crafted Emacs*"))) (with-current-buffer splash-buffer (let ((inhibit-read-only t)) (erase-buffer) (setq default-directory command-line-default-directory) (make-local-variable 'crafted-startup-screen-inhibit-startup-screen) (if pure-space-overflow (insert pure-space-overflow-message)) (dolist (text crafted-startup-text) (apply #'fancy-splash-insert text) (insert "\n")) (crafted-updates-check-for-latest) (if (> (condition-case nil (crafted-updates--get-new-commit-count) (error 0)) 0) (fancy-splash-insert :face '(variable-pitch font-lock-keyword-face bold) (format "%s : " (crafted-updates-status-message)) :face '(variable-pitch font-lock-keyword-face) :link `(" Show Updates " ,(lambda (_button) (crafted-updates-show-latest))) :face '(variable-pitch font-lock-keyword-face) :link `(" Get Updates " ,(lambda (_button) (crafted-updates-pull-latest t))) "\n") (fancy-splash-insert :face '(variable-pitch font-lock-keyword-face bold) (format "%s\n" (condition-case nil (crafted-updates-status-message) (error "Crafted Emacs status could not be determined."))))) (insert "\n\n") (crafted-startup-recentf) (skip-chars-backward "\n") (delete-region (point) (point-max)) (insert "\n") (crafted-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) (if (and view-read-only (not view-mode)) (view-mode-enter nil 'kill-buffer)) (goto-char (point-min)) (forward-line (if concise 2 4))) (if concise (progn (display-buffer splash-buffer) ;; If the splash screen is in a split window, fit it. (let ((window (get-buffer-window splash-buffer t))) (or (null window) (eq window (selected-window)) (eq window (next-window window)) (fit-window-to-buffer window)))) (switch-to-buffer splash-buffer)))) (provide 'crafted-startup) ;;; crafted-startup.el ends here