[elpa] 09/35: Change startup messages

[Matthew Fidler]

mlf176f2 pushed a commit to branch externals/ergoemacs-mode
in repository elpa.

commit 1a33867dc9e8575869190c5b5d49fc9c466d871f
Author: Matthew L. Fidler <address@hidden>
Date:   Mon Jul 7 09:56:28 2014 -0500

    Change startup messages
---
 ergoemacs-advices.el |   88 ++++++++++++++++++++++++++++++++++++++++++++++
 ergoemacs-themes.el  |   95 +++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 182 insertions(+), 1 deletions(-)

diff --git a/ergoemacs-advices.el b/ergoemacs-advices.el
index 45e0d52..3307236 100644
--- a/ergoemacs-advices.el
+++ b/ergoemacs-advices.el
@@ -194,6 +194,94 @@ This assumes any key defined while running a hook is a 
user-defined hook."
   (let ((ergoemacs-run-mode-hooks t))
     ad-do-it))
 
+(defadvice fancy-startup-tail (around ergoemacs-fancy-startup-tail activate)
+  "Modify fancy startup to use ergoemacs-mode keys"
+  (if (not ergoemacs-mode) (progn ad-do-it)
+    (unless concise
+      (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 `("Customize Startup"
+               ,(lambda (_button) (customize-group 'initialization))
+               "Change initialization settings including this screen")
+       "\n"))
+    (fancy-splash-insert
+     :face 'variable-pitch "To quit a partially entered command, type "
+     :face 'default (substitute-command-keys "\\[keyboard-quit]")
+     :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))
+                         emacs-copyright
+                         "\n")
+    (and auto-save-list-file-prefix
+         ;; Don't signal an error if the
+         ;; directory for auto-save-list files
+         ;; does not yet exist.
+         (file-directory-p (file-name-directory
+                            auto-save-list-file-prefix))
+         (directory-files
+          (file-name-directory auto-save-list-file-prefix)
+          nil
+          (concat "\\`"
+                  (regexp-quote (file-name-nondirectory
+                                 auto-save-list-file-prefix)))
+          t)
+         (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
+                              "\nIf an Emacs session crashed recently, "
+                              "type "
+                              :face '(fixed-pitch font-lock-comment-face)
+                              (substitute-command-keys "\\[recover-session]")
+                              :face '(variable-pitch font-lock-comment-face)
+                              "\nto recover"
+                              " the files you were editing."))
+    (when concise
+      (fancy-splash-insert
+       :face 'variable-pitch "\n"
+       :link `("Dismiss this startup screen"
+               ,(lambda (_button)
+                  (when startup-screen-inhibit-startup-screen
+                    (customize-set-variable 'inhibit-startup-screen t)
+                    (customize-mark-to-save 'inhibit-startup-screen)
+                    (custom-save-all))
+                  (let ((w (get-buffer-window "*GNU Emacs*")))
+                    (and w (not (one-window-p)) (delete-window w)))
+                  (kill-buffer "*GNU Emacs*")))
+       "  ")
+      (when (or user-init-file 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 startup-screen-inhibit-startup-screen
+                                      nil))
+                       (overlay-put button 'checked t)
+                       (overlay-put button 'display
+                                    (overlay-get button :on-glyph))
+                       (setq startup-screen-inhibit-startup-screen t)))))
+        (fancy-splash-insert :face '(variable-pitch (:height 0.9))
+                             " Never show it again.")))))
+
 
 ;;; Unfortunately, the advice route doesn't seem to work for these
 ;;; functions :(
diff --git a/ergoemacs-themes.el b/ergoemacs-themes.el
index 3cc3e37..b0f61f3 100644
--- a/ergoemacs-themes.el
+++ b/ergoemacs-themes.el
@@ -49,7 +49,100 @@
         org-special-ctrl-a/e t
         ido-vertical-define-keys 'C-n-C-p-up-down-left-right
         scroll-error-top-bottom t
-        initial-scratch-message (substitute-command-keys ";; This buffer is 
for notes you don't want to save, and for Lisp evaluation.\n;; If you want to 
create a file, visit that file with \\[find-file],\n;; then enter the text in 
that file's own buffer."))
+        initial-scratch-message (substitute-command-keys ";; This buffer is 
for notes you don't want to save, and for Lisp evaluation.\n;; If you want to 
create a file, visit that file with \\[find-file],\n;; then enter the text in 
that file's own buffer.")
+        ;; Remove tutorial and guided tour, since the keys don't apply...
+        fancy-startup-text
+        `((:face (variable-pitch font-lock-comment-face)
+                 "Welcome to "
+                 :link ("GNU Emacs"
+                        ,(lambda (_button) (browse-url 
"http://www.gnu.org/software/emacs/";))
+                        "Browse http://www.gnu.org/software/emacs/";)
+                 ", one component of the "
+                 :link
+                 ,(lambda ()
+                    (if (eq system-type 'gnu/linux)
+                        `("GNU/Linux"
+                          ,(lambda (_button) (browse-url 
"http://www.gnu.org/gnu/linux-and-gnu.html";))
+                          "Browse http://www.gnu.org/gnu/linux-and-gnu.html";)
+                      `("GNU" ,(lambda (_button) (describe-gnu-project))
+                        "Display info on the GNU project")))
+                 " operating system.\n\n"
+                 "\n"
+                 ;; :link ("Emacs Guided Tour"
+                 ;;        ,(lambda (_button)
+                 ;;           (browse-url 
"http://www.gnu.org/software/emacs/tour/";))
+                 ;;        "Browse http://www.gnu.org/software/emacs/tour/";)
+                 ;; "\tOverview of Emacs features at gnu.org\n"
+                 :link ("View Emacs Manual" ,(lambda (_button) 
(info-emacs-manual)))
+                 "\tView the Emacs manual using Info\n"
+                 :link ("Absence of Warranty" ,(lambda (_button) 
(describe-no-warranty)))
+                 "\tGNU Emacs comes with "
+                 :face (variable-pitch (:slant oblique))
+                 "ABSOLUTELY NO WARRANTY\n"
+                 :face variable-pitch
+                 :link ("Copying Conditions" ,(lambda (_button) 
(describe-copying)))
+                 "\tConditions for redistributing and changing Emacs\n"
+                 :link ("Ordering Manuals" ,(lambda (_button) 
(view-order-manuals)))
+                 "\tPurchasing printed copies of manuals\n"
+                 "\n"))
+        ;;
+        fancy-about-text
+        `((:face (variable-pitch font-lock-comment-face)
+                 "This is "
+                 :link ("GNU Emacs"
+                        ,(lambda (_button) (browse-url 
"http://www.gnu.org/software/emacs/";))
+                        "Browse http://www.gnu.org/software/emacs/";)
+                 ", one component of the "
+                 :link
+                 ,(lambda ()
+                    (if (eq system-type 'gnu/linux)
+                        `("GNU/Linux"
+                          ,(lambda (_button)
+                             (browse-url 
"http://www.gnu.org/gnu/linux-and-gnu.html";))
+                          "Browse http://www.gnu.org/gnu/linux-and-gnu.html";)
+                      `("GNU" ,(lambda (_button) (describe-gnu-project))
+                        "Display info on the GNU project.")))
+                 " operating system.\n"
+                 :face (variable-pitch font-lock-builtin-face)
+                 "\n"
+                 ,(lambda () (emacs-version))
+                 "\n"
+                 :face (variable-pitch (:height 0.8))
+                 ,(lambda () emacs-copyright)
+                 "\n\n"
+                 :face variable-pitch
+                 :link ("Authors"
+                        ,(lambda (_button)
+                           (view-file (expand-file-name "AUTHORS" 
data-directory))
+                           (goto-char (point-min))))
+                 "\tMany people have contributed code included in GNU Emacs\n"
+                 :link ("Contributing"
+                        ,(lambda (_button)
+                           (view-file (expand-file-name "CONTRIBUTE" 
data-directory))
+                           (goto-char (point-min))))
+                 "\tHow to contribute improvements to Emacs\n"
+                 "\n"
+                 :link ("GNU and Freedom" ,(lambda (_button) 
(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 "
+                 :face (variable-pitch (:slant oblique))
+                 "ABSOLUTELY NO WARRANTY\n"
+                 :face variable-pitch
+                 :link ("Copying Conditions" ,(lambda (_button) 
(describe-copying)))
+                 "\tConditions for redistributing and changing Emacs\n"
+                 :link ("Getting New Versions" ,(lambda (_button) 
(describe-distribution)))
+                 "\tHow to obtain the latest version of Emacs\n"
+                 :link ("Ordering Manuals" ,(lambda (_button) 
(view-order-manuals)))
+                 "\tBuying printed manuals from the FSF\n"
+                 "\n"
+                 ;; :link ("Emacs Guided Tour"
+                 ;;        ,(lambda (_button)
+                 ;;           (browse-url 
"http://www.gnu.org/software/emacs/tour/";))
+                 ;;        "Browse http://www.gnu.org/software/emacs/tour/";)
+                 ;; "\tSee an overview of Emacs features at gnu.org"
+                ))
+        )
   (add-hook 'kill-buffer-hook 'ergoemacs-save-buffer-to-recently-closed)
   (undo-tree-mode 1)
   (shift-select-mode t)