;;; mf-splash.el --- An alternative splash screen -*- lexical-binding: t; -*-

;; Copyright (C) 2020 Nicolas .P Rougier

;; Author: Nicolas P. Rougier <nicolas.rougier@inria.fr>
;; Mondifications: Colin McLear
;; URL: https://github.com/rougier/emacs-splash
;; Keywords: startup
;; Version: 0.1
;; Package-Requires:

;; This program 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.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;;  An alternative splash screen:

;;  - "q" or <esc> kills the splash screen
;;  - Any other key open the about-emacs buffer
;;
;; Note: The screen is not shown if there are opened file buffers. For
;;       example, if you start Emacs with a filename on the command
;;       line, the splash is not shown.
;;
;; Usage:
;;
;;  (require 'mf-splash)
;;
;;; Code:
(require 'cl-lib)

(defgroup mf/splash nil
  "Extensible splash screen."
  :group 'applications)

;; See https://github.com/emacs-dashboard/emacs-dashboard/blob/master/dashboard-widgets.el
;; https://github.com/hlissner/doom-emacs/blob/eddaae40e84b5eb1f0136aaba23d918f71b6a986/core/core.el#L479

(defcustom splash-init-info
  (lambda ()
    (let ((package-count 0) (time (emacs-init-time)))
      (setq package-count (- (length load-path) (length (get 'load-path 'initial-value))))
      (if (zerop package-count)
          (format "Emacs started in %s" time)
        (format "%d packages loaded in %s" package-count time))))
  "Init info with packages loaded and init time."
  :type '(function string)
  :group 'mf/splash)

(defun spaces (n)
  "Insert N spaces."
  (cl-do ((v 0 (1+ v)))
      ((= v n))
    (insert-char ?\ )))

(defun center-text (text window-width)
  (let ((text-len (length text)))
    (kill-line 0)
    (spaces (/ (- window-width text-len) 2))
    (insert text)))

(defmacro center-button (label window-width &rest properties)
  (let ((text-len (length label)))
    `(progn
       (kill-line 0)
       (spaces (/ (- ,window-width ,text-len) 2))
       (insert-text-button ,label ,@properties))))

;;; Define Splash
(defun mf/splash-screen ()
  "A custom splash screen for Emacs."
  (interactive)
  ;; check if splash exists and switch if so
  (if (get-buffer "*splash*")
      (switch-to-buffer "*splash*")

    ;; Otherwise create splash and go...
    ;; Hide modeline before window-body-height is computed
    (let* ((splash-buffer (get-buffer-create "*splash*")))
      (with-current-buffer splash-buffer
        (setq header-line-format nil)
        (setq mode-line-format nil)))

    (let* ((buffer-read-only)
           (splash-buffer  (get-buffer-create "*splash*")))
      (with-current-buffer splash-buffer
        (let ((width (window-width)))
          (erase-buffer)

         ;; Buffer local settings
         (if (one-window-p)
             (setq mode-line-format nil))
         (setq-local cursor-type nil)
         (setq vertical-scroll-bar nil)
         (setq horizontal-scroll-bar nil)
         (setq fill-column width)
         (face-remap-add-relative 'link :underline nil)
         (if (not (display-graphic-p)) (menu-bar-mode 0))
         ;; Set padding
         (setq-local left-margin-width 15 right-margin-width 0) ; Define new widths.
         (set-window-buffer nil (current-buffer))

         ;; Insert ascii art
         ;; (goto-char width)
         ;; (save-excursion
         ;;   (insert (propertize mf/splash-ascii-art 'face 'shadow)))

         (cl-do ((l 0 (1+ l)))
            ((= l 5))
           (insert "\n"))

         ;; Insert text
         (center-text (concat
                       (propertize "Welcome to GNU Emacs"  'face 'bold)
                       " "
                       (propertize (format "%d.%d\n" emacs-major-version emacs-minor-version) 'face 'bold))
                      width)

         (forward-line 1)
         (center-text (concat (propertize (funcall splash-init-info) 'face 'shadow) "\n\n")
                      width)

         (forward-line 2)
         (center-button " [a] Agenda\n" width
                        'action (lambda (_) (mf/agenda))
                        'help-echo "Open org agenda"
                        'face 'warning
                        'follow-link t)
         (forward-line 1)
         (center-button " [f] File\n" width
                        'action (lambda (_)  (find-file))
                        'help-echo "Open file"
                        'face 'warning
                        'follow-link t)
         (forward-line 1)
         (center-button " [m] Mail\n" width
                        'action (lambda (_) (mf/gnus))
                        'help-echo "Open Gnus"
                        'face 'warning
                        'follow-link t)
         (forward-line 1)
         (center-button " [N] Notes\n" width
                             'action (lambda (_)  (org-roam-node-find))
                             'help-echo "Visit org roam notes"
                             'face 'warning
                             'follow-link t)
         (forward-line 1)
         (center-button " [P] Projects\n" width
                             'action (lambda (_)  (mf/project-find-file-and-persp))
                             'help-echo "Open project & workspace"
                             'face 'warning
                             'follow-link t)

         ;; Vertical padding to bottom
         (goto-char (point-max))

         ;; Footer text
         (save-excursion (insert-char ?\n 1)
                         (center-text (propertize (shell-command-to-string "9 fortune")
                                                  'face 'shadow)
                                      width))

         (goto-char (point-min))
         (display-buffer-same-window splash-buffer nil)))
      (switch-to-buffer "*splash*")))
  (mf/splash-mode))

(defun mf/splash-screen-kill ()
  "Kill the splash screen buffer (immediately)."
  (interactive)
  (when (get-buffer "*splash*")
    (kill-buffer "*splash*")))

;; Custom splash screen
(define-derived-mode mf/splash-mode special-mode "splash"
  "Emacs major mode for the splash screen."
  :group 'mf/splash

  (buffer-disable-undo)
  (whitespace-mode -1)
  (setq-local cursor-type nil)
  (setq-local hl-line-mode nil)
  (setq-local mode-line-format nil)
  (setq-local header-line-format nil)
  (when (>= emacs-major-version 26)
    (display-line-numbers-mode -1))
  (setq inhibit-startup-screen t
        buffer-read-only t
        truncate-lines nil
        inhibit-startup-message t
        inhibit-startup-echo-area-message t)
  (goto-char (point-min))
  (let ((map mf/splash-mode-map))
   (define-key map (kbd "a") 'mf/agenda)
   (define-key map (kbd "c") 'mf/open-emacsd)
   (define-key map (kbd "f") 'find-file)
   (define-key map (kbd "m") 'mf/gnus)
   (define-key map (kbd "N") 'org-roam-node-find)
   (define-key map (kbd "P") 'mf/project-find-file-and-persp)
   (define-key map (kbd "q") 'mf/splash-screen-kill)
   (define-key map (kbd "g") 'mf/splash-screen)
   (define-key map (kbd "n") 'next-line)
   (define-key map (kbd "p") 'previous-line)))

;; Suppress any startup message in the echo area
(run-with-idle-timer 0.05 nil (lambda() (message nil)))

;; Install hook after frame parameters have been applied and only if
;; no option on the command line
(if (and (not (member "--no-splash" command-line-args))
         (not (member "--file"      command-line-args))
         (not (member "--insert"    command-line-args))
         (not (member "--find-file" command-line-args)))
    (add-hook 'window-setup-hook 'mf/splash-screen))

;;; Provide Splash
(provide 'mf-splash)

;;; mf-splash.el ends here