Create new splash screen

init.el

@@ -32,6 +32,13 @@
   ;; https://github.com/melpa/melpa/pull/5008.
   (add-to-list 'load-path "~/.emacs.d/emacswiki/")
 
+  ;; --------------------------------------------------------------------------
+  ;; Load `emodule'.
+  ;; --------------------------------------------------------------------------
+
+  (add-to-list 'load-path "~/.emacs.d/emodule")
+  (require 'emodule)
+
   ;; --------------------------------------------------------------------------
   ;; Visual configuration.
   ;; --------------------------------------------------------------------------
@@ -68,6 +75,15 @@
   ;; Load the dark theme by default.
   (load-theme 'havoc-dark t) ;; Load personal theme
 
+  ;; Splash screen ------------------------------------------------------------
+
+  ;; Add path.
+  (add-to-list 'load-path "~/.emacs.d/initial-buffer")
+  (require 'initial-buffer)
+
+  ;; Set the initial buffer.
+  (setq initial-buffer-choice 'initial-buffer/goto-buffer)
+
   ;; --------------------------------------------------------------------------
   ;; Change file in which custom variable changes are saved.
   ;; --------------------------------------------------------------------------
@@ -89,14 +105,6 @@
   ;; *********************************************************************** ;;
 
 
-  ;; --------------------------------------------------------------------------
-  ;; Load `emodule'.
-  ;; --------------------------------------------------------------------------
-
-  (add-to-list 'load-path "~/.emacs.d/emodule")
-  (require 'emodule)
-  (declare-function emodule/init "emodule")
-
   ;; --------------------------------------------------------------------------
   ;; Load modules.
   ;; --------------------------------------------------------------------------

initial-buffer/initial-buffer.el

@@ -0,0 +1,216 @@
+;;; initial-buffer.el --- Initial buffer displayed at startup
+;;
+;; Copyright (C) 2018 Wojciech Kozlowski
+;;
+;; Author: Wojciech Kozlowski <wk@wojciechkozlowski.eu>
+;; Created: 5 Nov 2018
+;;
+;; This file is not part of GNU Emacs.
+;;
+;;; License: GPLv3
+;;
+;;; Commentary:
+;;
+;; The code in this file was heavily inspired by Spacemacs.
+;;
+;;; Code:
+
+(defconst initial-buffer/banner-file "~/.emacs.d/initial-buffer/blue-robot.png"
+  "Location of the banner image to use.")
+
+(defconst initial-buffer/name "*GNU Emacs*"
+  "Name of the initial buffer.")
+
+(defconst initial-buffer/recentf-list-length 10
+  "Length used for recentf list.")
+
+(defconst initial-buffer/recentf-length-threshold 75
+  "Threshold of filename length to apply different centre rules.
+If at least one file in recentf is longer than this, the list
+will not be centered, but offset by a constant instead.")
+
+(defconst initial-buffer/buttons-recentf-offset 20
+  "Relative position between the home buffer buttons and startup lists.")
+
+(defvar initial-buffer/buttons-line nil
+  "Vertical position of the home buffer buttons.
+Internal use, do not set this variable.")
+
+(defvar initial-buffer/buttons-position nil
+  "Horizontal position of the home buffer buttons.
+Internal use, do not set this variable.")
+
+(defvar initial-buffer-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'widget-button-press)
+
+    (define-key map [tab] 'widget-forward)
+    (define-key map (kbd "f") 'widget-forward)
+    (define-key map (kbd "n") 'widget-forward)
+
+    (define-key map [backtab] 'widget-backward)
+    (define-key map (kbd "b") 'widget-backward)
+    (define-key map (kbd "p") 'widget-backward)
+
+    (define-key map (kbd "r") 'initial-buffer/refresh)
+    (define-key map "q" 'quit-window)
+    map)
+  "Keymap for initial buffer mode.")
+
+(define-derived-mode initial-buffer-mode fundamental-mode "Initial buffer"
+  "Major mode for startup screen."
+  :group 'initial-buffer
+  :syntax-table nil
+  :abbrev-table nil
+  (setq buffer-read-only t
+        truncate-lines t))
+
+(defun initial-buffer/insert-banner ()
+  "Display an image banner."
+  (let* ((spec (create-image initial-buffer/banner-file))
+         (size (image-size spec))
+         (width (car size))
+         (left-margin (max 0 (floor (- (window-width) width) 2))))
+    (goto-char (point-min))
+    (insert "\n")
+    (insert (make-string left-margin ?\s))
+    (insert-image spec)
+    (insert "\n\n")))
+
+(defun initial-buffer/insert-buttons ()
+  "Create and insert the interactive buttons under the banner."
+  (goto-char (point-max))
+  (widget-create 'push-button
+                 :help-echo "Upgrade ELPA packages to the latest versions."
+                 :action (lambda (&rest ignore) (emodule/upgrade))
+                 :mouse-face 'highlight
+                 :follow-link "\C-m"
+                 (propertize "Upgrade" 'face 'font-lock-keyword-face))
+  (insert " ")
+  (widget-create 'push-button
+                 :help-echo
+                 "Restore ELPA directory if something got borked."
+                 :action (lambda (&rest ignore) (emodule/restore))
+                 :mouse-face 'highlight
+                 :follow-link "\C-m"
+                 (propertize "Restore"
+                             'face 'font-lock-keyword-face))
+  (let ((len (- (line-end-position)
+                (line-beginning-position))))
+    (initial-buffer/center-line)
+    (setq initial-buffer/buttons-line (count-lines 1 (point)))
+    (setq initial-buffer/buttons-position (- (line-end-position)
+                                             (line-beginning-position)
+                                             len)))
+  (insert "\n"))
+
+(defun initial-buffer/center-line (&optional real-width)
+  "When point is at the end of a line, center it.
+REAL-WIDTH: the real width of the line.  If the line contains an image, the size
+            of that image will be considered to be 1 by the calculation method
+            used in this function.  As a consequence, the caller must calculate
+            himself the correct length of the line taking into account the
+            images he inserted in it."
+  (let* ((width (or real-width (current-column)))
+         (margin (max 0 (floor (/ (- (window-width) width) 2)))))
+    (beginning-of-line)
+    (insert (make-string margin ?\s))
+    (end-of-line)))
+
+(defun initial-buffer/insert-file-list (list)
+  "Insert an interactive list of files in the home buffer.
+LIST-DISPLAY-NAME: the displayed title of the list.
+LIST: a list of string pathnames made interactive in this function."
+  (when (car list)
+    (mapc (lambda (el)
+            (insert "\n")
+            (widget-create 'push-button
+                           :action `(lambda (&rest ignore)
+                                      (find-file-existing ,el))
+                           :mouse-face 'highlight
+                           :follow-link "\C-m"
+                           :button-prefix ""
+                           :button-suffix ""
+                           :format "%[%t%]"
+                           (abbreviate-file-name el)))
+          list)))
+
+(defun initial-buffer/subseq (seq start end)
+  "Adapted version of `cl-subseq'.
+Use `cl-subseq', but accounting for end points greater than the size of the
+list.  Return entire list if end is omitted.
+SEQ, START and END are the same arguments as for `cl-subseq'"
+  (let ((len (length seq)))
+    (cl-subseq seq start (and (number-or-marker-p end)
+                              (min len end)))))
+
+(defun initial-buffer/get-buffer-width ()
+  "Return the length of longest line in the current buffer."
+  (save-excursion
+    (goto-char 0)
+    (let ((current-max 0))
+      (while (not (eobp))
+        (let ((line-length (- (line-end-position) (line-beginning-position))))
+          (if (< current-max line-length)
+              (setq current-max line-length)))
+        (forward-line 1))
+      current-max)))
+
+(defun initial-buffer/center-recentf ()
+  "Centre recentf list after it was inserted."
+  (let* ((lists-width (initial-buffer/get-buffer-width))
+         (margin (max 0 (- initial-buffer/buttons-position
+                           initial-buffer/buttons-recentf-offset)))
+         (final-padding (if (< lists-width initial-buffer/recentf-length-threshold)
+                            (max 0 (floor (/ (- (window-width) lists-width) 2)))
+                          margin)))
+    (goto-char (point-min))
+    (while (not (eobp))
+      (beginning-of-line)
+      (insert (make-string final-padding ?\s))
+      (forward-line))))
+
+(defun initial-buffer/insert-recentf ()
+  "Insert startup lists in home buffer."
+  (goto-char (point-max))
+  (save-restriction
+    (narrow-to-region (point) (point))
+    (recentf-mode)
+    (when (initial-buffer/insert-file-list
+           (initial-buffer/subseq recentf-list 0 initial-buffer/recentf-list-length)))
+    (initial-buffer/center-recentf)))
+
+(defun initial-buffer/goto-buffer ()
+  "Create the initial buffer and switch to it."
+  (with-current-buffer (get-buffer-create initial-buffer/name)
+    (let ((inhibit-read-only t))
+      (erase-buffer)
+      (initial-buffer/insert-banner)
+      (initial-buffer/insert-buttons)
+      (initial-buffer/insert-recentf))
+    (initial-buffer-mode)
+    (goto-char (point-min))
+    (forward-line (- initial-buffer/buttons-line 1))
+    (move-to-column (- initial-buffer/buttons-position 1))
+    (current-buffer)))
+
+(add-hook 'window-setup-hook
+          (lambda ()
+            (add-hook 'window-configuration-change-hook
+                      'initial-buffer/resize-on-hook)))
+
+(defun initial-buffer/resize-on-hook ()
+  "Hook run on window resize events to redisplay the home buffer."
+  (let ((home-buffer (get-buffer-window initial-buffer/name)))
+    (when home-buffer
+      (with-selected-window home-buffer
+        (initial-buffer/goto-buffer)))))
+
+(defun initial-buffer/refresh ()
+  "Force recreation of the spacemacs buffer."
+  (interactive)
+  (initial-buffer/goto-buffer))
+
+(provide 'initial-buffer)
+
+;;; initial-buffer.el ends here

roadmap.org

@@ -4,8 +4,8 @@
 
 ** .emacs.d
 
-   - [ ] Nicer splash screen
-   - [ ] Frontend for emodule (e.g. for updates, rollbacks, init messages)
+   - [X] Nicer splash screen
+   - [X] Frontend for emodule (e.g. for updates, rollbacks, init messages)
 
 ** Emodule
 
@@ -16,6 +16,7 @@
 
    - [X] Remove company branch from public repo
    - [X] Change author of all commits to current e-mail address
+   - [ ] Write blog post
 
 * Beyond v1.0