Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca

[gnu-emacs] / lisp / startup.el

diff --git a/lisp/startup.el b/lisp/startup.el
index a0122c7455506801dcb91335a36199ab7c725ca0..5406c0f6513142d7d26efe2a3d755bb974862792 100644 (file)
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,6 +1,7 @@
 ;;; startup.el --- process Emacs shell arguments  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1985-1986, 1992, 1994-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation,
+;; Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -41,15 +42,20 @@
 (defcustom initial-buffer-choice nil
   "Buffer to show after starting Emacs.
 If the value is nil and `inhibit-startup-screen' is nil, show the
-startup screen.  If the value is a string, visit the specified file
-or directory using `find-file'.  If t, open the `*scratch*'
-buffer."
+startup screen.  If the value is a string, switch to a buffer
+visiting the file or directory specified by that string.  If the
+value is a function, switch to the buffer returned by that
+function.  If t, open the `*scratch*' buffer.
+
+A string value also causes emacsclient to open the specified file
+or directory when no target file is specified."
   :type '(choice
          (const     :tag "Startup screen" nil)
          (directory :tag "Directory" :value "~/")
          (file      :tag "File" :value "~/.emacs")
+          (function  :tag "Function")
          (const     :tag "Lisp scratch buffer" t))
-  :version "23.1"
+  :version "24.4"
   :group 'initialization)
 
 (defcustom inhibit-startup-screen nil
@@ -216,8 +222,8 @@ and VALUE is the value which is given to that frame parameter
     ("-fn" 1 x-handle-switch font)
     ("-font" 1 x-handle-switch font)
     ("-ib" 1 x-handle-numeric-switch internal-border-width)
-    ;;("-g" .               x-handle-geometry)
-    ;;("-geometry" .        x-handle-geometry)
+    ("-g" 1 x-handle-geometry)
+    ("-geometry" 1 x-handle-geometry)
     ("-fg" 1 x-handle-switch foreground-color)
     ("-foreground" 1 x-handle-switch foreground-color)
     ("-bg" 1 x-handle-switch background-color)
@@ -968,7 +974,6 @@ Amongst another things, it parses the command-line arguments."
                  (not (eq 0 (cdr tool-bar-lines)))))))
 
   (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
-       (old-font-list-limit font-list-limit)
        (old-face-ignored-fonts face-ignored-fonts))
 
     ;; Run the site-start library if it exists.  The point of this file is
@@ -1159,7 +1164,6 @@ the `--debug-init' option to view a complete error backtrace."
     ;; face realization, clear the face cache so that new faces will
     ;; be realized.
     (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed)
-                (eq font-list-limit old-font-list-limit)
                 (eq face-ignored-fonts old-face-ignored-fonts))
       (clear-face-cache)))
 
@@ -1568,27 +1572,24 @@ a face or button specification."
                       :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)
-                           "Meta-x recover-session RET"
-                           :face '(variable-pitch font-lock-comment-face)
-                           "\nto recover"
-                           " the files you were editing."))
+  (when auto-save-list-file-prefix
+    (let ((dir  (file-name-directory auto-save-list-file-prefix))
+         (name (file-name-nondirectory auto-save-list-file-prefix))
+         files)
+      ;; Don't warn if the directory for auto-save-list files does not
+      ;; yet exist.
+      (and (file-directory-p dir)
+          (setq files (directory-files dir nil (concat "\\`" name) t))
+          (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
+                               (if (= (length files) 1)
+                                   "\nAn auto-save file list was found.  "
+                                 "\nAuto-save file lists were found.  ")
+                               "If an Emacs session crashed recently,\ntype "
+                               :link `("M-x recover-session RET"
+                                       ,(lambda (_button)
+                                          (call-interactively
+                                           'recover-session)))
+                               " to recover the files you were editing."))))
 
   (when concise
     (fancy-splash-insert
@@ -1692,7 +1693,6 @@ splash screen in another window."
        (force-mode-line-update))
       (use-local-map splash-screen-keymap)
       (setq tab-width 22)
-      (message "%s" (startup-echo-area-message))
       (setq buffer-read-only t)
       (goto-char (point-min))
       (forward-line 3))))
@@ -2326,10 +2326,14 @@ A fancy display is used on graphic displays, normal otherwise."
             (set-buffer-modified-p nil))))
 
     (when initial-buffer-choice
-      (cond ((eq initial-buffer-choice t)
-            (switch-to-buffer (get-buffer-create "*scratch*")))
-           ((stringp initial-buffer-choice)
-            (find-file initial-buffer-choice))))
+      (let ((buf
+             (cond ((stringp initial-buffer-choice)
+                   (find-file-noselect initial-buffer-choice))
+                  ((functionp initial-buffer-choice)
+                   (funcall initial-buffer-choice)))))
+       (switch-to-buffer
+        (if (buffer-live-p buf) buf (get-buffer-create "*scratch*"))
+        'norecord)))
 
     (if (or inhibit-startup-screen
            initial-buffer-choice