]> code.delx.au - gnu-emacs/blobdiff - lisp/startup.el
(python-comment-line-p, python-blank-line-p, python-skip-out,
[gnu-emacs] / lisp / startup.el
index ef0e750d7dc2a41f1d925dacd27b6354fcdeef3b..eb8898551eb0867551ad2086d554d970460af9d2 100644 (file)
@@ -1,17 +1,18 @@
 ;;; startup.el --- process Emacs shell arguments
 
 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;;   2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 (defvar command-line-processed nil
   "Non-nil once command line has been processed.")
 
-(defvar window-system initial-window-system
-  "Name of window system the selected frame is displaying through.
-The value is a symbol--for instance, `x' for X windows.
-The value is nil if the selected frame is on a text-only-terminal.")
-
-(make-variable-frame-local 'window-system)
-
 (defgroup initialization nil
   "Emacs start-up procedure."
   :group 'environment)
@@ -62,7 +54,6 @@ directory using `find-file'.  If t, open the `*scratch*' buffer."
 
 (defcustom inhibit-startup-screen nil
   "Non-nil inhibits the startup screen.
-It also inhibits display of the initial message in the `*scratch*' buffer.
 
 This is for use in your personal init file (but NOT site-start.el), once
 you are familiar with the contents of the startup screen."
@@ -180,7 +171,8 @@ This is normally copied from `default-directory' when Emacs starts.")
     ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
     ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
     ("--border-color" 1 x-handle-switch border-color)
-    ("--smid" 1 x-handle-smid))
+    ("--smid" 1 x-handle-smid)
+    ("--parent-id" 1 x-handle-parent-id))
   "Alist of X Windows options.
 Each element has the form
   (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
@@ -199,6 +191,12 @@ There is no `condition-case' around the running of these functions;
 therefore, if you set `debug-on-error' non-nil in `.emacs',
 an error in one of these functions will invoke the debugger.")
 
+(defvar before-init-time nil
+  "Value of `current-time' before Emacs begins initialization.")
+
+(defvar after-init-time nil
+  "Value of `current-time' after loading the init files.")
+
 (defvar emacs-startup-hook nil
   "Normal hook run after loading init files and handling the command line.")
 
@@ -630,7 +628,8 @@ opening the first frame (e.g. open a connection to an X server).")
     (nreverse rest)))
 
 (defun command-line ()
-  (setq command-line-default-directory default-directory)
+  (setq before-init-time (current-time)
+        command-line-default-directory default-directory)
 
   ;; Choose a reasonable location for temporary files.
   (custom-reevaluate-setting 'temporary-file-directory)
@@ -844,6 +843,9 @@ opening the first frame (e.g. open a connection to an X server).")
   (custom-reevaluate-setting 'file-name-shadow-mode)
   (custom-reevaluate-setting 'send-mail-function)
   (custom-reevaluate-setting 'focus-follows-mouse)
+  (custom-reevaluate-setting 'global-auto-composition-mode)
+  (custom-reevaluate-setting 'transient-mark-mode)
+  (custom-reevaluate-setting 'auto-encryption-mode)
 
   (normal-erase-is-backspace-setup-frame)
 
@@ -874,6 +876,10 @@ opening the first frame (e.g. open a connection to an X server).")
     ;; Run the site-start library if it exists.  The point of this file is
     ;; that it is run before .emacs.  There is no point in doing this after
     ;; .emacs; that is useless.
+    ;; Note that user-init-file is nil at this point.  Code that might
+    ;; be loaded from site-run-file and wants to test if -q was given
+    ;; should check init-file-user instead, since that is already set.
+    ;; See cus-edit.el for an example.
     (if site-run-file
        (load site-run-file t t))
 
@@ -1013,11 +1019,9 @@ opening the first frame (e.g. open a connection to an X server).")
            (with-current-buffer (window-buffer)
              (deactivate-mark)))
 
-       ;; If the user has a file of abbrevs, read it.
-        ;; FIXME: after the 22.0 release this should be changed so
-       ;; that it does not read the abbrev file when -batch is used
-       ;; on the command line.
-       (when (and (file-exists-p abbrev-file-name)
+       ;; If the user has a file of abbrevs, read it (unless -batch).
+       (when (and (not noninteractive)
+                  (file-exists-p abbrev-file-name)
                   (file-readable-p abbrev-file-name))
            (quietly-read-abbrev-file abbrev-file-name))
 
@@ -1095,6 +1099,7 @@ opening the first frame (e.g. open a connection to an X server).")
                 (eq face-ignored-fonts old-face-ignored-fonts))
       (clear-face-cache)))
 
+  (setq after-init-time (current-time))
   (run-hooks 'after-init-hook)
 
   ;; Decode all default-directory.
@@ -1148,9 +1153,7 @@ opening the first frame (e.g. open a connection to an X server).")
 
 ")
   "Initial message displayed in *scratch* buffer at startup.
-If this is nil, no message will be displayed.
-If `inhibit-startup-screen' is non-nil, then no message is displayed,
-regardless of the value of this variable."
+If this is nil, no message will be displayed."
   :type '(choice (text :tag "Message")
                 (const :tag "none" nil))
   :group 'initialization)
@@ -1161,7 +1164,7 @@ regardless of the value of this variable."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar fancy-startup-text
-  '((:face (variable-pitch :foreground "red")
+  '((:face (variable-pitch (:foreground "red"))
      "Welcome to "
      :link ("GNU Emacs"
            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1173,7 +1176,7 @@ regardless of the value of this variable."
           '("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-project))
+        '("GNU" (lambda (button) (describe-gnu-project))
           "Display info on the GNU project")))
      " operating system.\n"
      :face variable-pitch "To quit a partially entered command, type "
@@ -1207,7 +1210,7 @@ regardless of the value of this variable."
      "\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)
+     :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
      :link ("Copying Conditions" (lambda (button) (describe-copying)))
@@ -1220,7 +1223,7 @@ Each element in the list should be a list of strings or pairs
 `:face FACE', like `fancy-splash-insert' accepts them.")
 
 (defvar fancy-about-text
-  '((:face (variable-pitch :foreground "red")
+  '((:face (variable-pitch (:foreground "red"))
      "This is "
      :link ("GNU Emacs"
            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1232,17 +1235,18 @@ Each element in the list should be a list of strings or pairs
           '("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-project))
+        '("GNU" (lambda (button) (describe-gnu-project))
           "Display info on the GNU project.")))
      " operating system.\n"
      :face (lambda ()
-            (list 'variable-pitch :foreground
-                  (if (eq (frame-parameter nil 'background-mode) 'dark)
-                      "cyan" "darkblue")))
+            (list 'variable-pitch
+                  (list :foreground
+                        (if (eq (frame-parameter nil 'background-mode) 'dark)
+                            "cyan" "darkblue"))))
      "\n"
      (lambda () (emacs-version))
      "\n"
-     :face (variable-pitch :height 0.5)
+     :face (variable-pitch (:height 0.5))
      (lambda () emacs-copyright)
      "\n\n"
      :face variable-pitch
@@ -1257,11 +1261,11 @@ Each element in the list should be a list of strings or pairs
              (goto-char (point-min))))
      "\tHow to contribute improvements to Emacs\n"
      "\n"
-     :link ("GNU and Freedom" (lambda (button) (describe-project)))
+     :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)
+     :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
      :link ("Copying Conditions" (lambda (button) (describe-copying)))
@@ -1324,8 +1328,6 @@ Each element in the list should be a list of strings or pairs
 
 ;; These are temporary storage areas for the splash screen display.
 
-(defvar fancy-splash-help-echo nil)
-
 (defun fancy-splash-insert (&rest args)
   "Insert text into the current buffer, with faces.
 Arguments from ARGS should be either strings; functions called
@@ -1359,7 +1361,7 @@ a face or button specification."
                                         (funcall it)
                                       it))
                                   'face current-face
-                                  'help-echo fancy-splash-help-echo))))
+                                  'help-echo (startup-echo-area-message)))))
       (setq args (cdr args)))))
 
 
@@ -1417,11 +1419,11 @@ a face or button specification."
               (lambda (button) (customize-group 'initialization))
               "Change initialization settings including this screen")
        "\n"))
-    (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
+    (fancy-splash-insert :face `(variable-pitch (:foreground ,fg))
                         "\nThis is "
                         (emacs-version)
                         "\n"
-                        :face '(variable-pitch :height 0.5)
+                        :face '(variable-pitch (:height 0.5))
                         emacs-copyright
                         "\n")
     (and auto-save-list-file-prefix
@@ -1437,26 +1439,27 @@ a face or button specification."
                  (regexp-quote (file-name-nondirectory
                                 auto-save-list-file-prefix)))
          t)
-        (fancy-splash-insert :face '(variable-pitch :foreground "red")
+        (fancy-splash-insert :face '(variable-pitch (:foreground "red"))
                              "\nIf an Emacs session crashed recently, "
                              "type "
                              :face '(fixed-pitch :foreground "red")
                              "Meta-x recover-session RET"
-                             :face '(variable-pitch :foreground "red")
+                             :face '(variable-pitch (:foreground "red"))
                              "\nto recover"
                              " the files you were editing."))
 
     (when concise
       (fancy-splash-insert
-       :face 'variable-pitch "\n\n"
-       :link '("Dismiss" (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*")))
+       :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 "\300\300\141\143\067\076\034\030"
@@ -1476,8 +1479,8 @@ a face or button specification."
                       (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)
-                            " Don't show this message again.")))))
+       (fancy-splash-insert :face '(variable-pitch (:height 0.9))
+                            " Never show it again.")))))
 
 (defun exit-splash-screen ()
   "Stop displaying the splash screen buffer."
@@ -1488,34 +1491,41 @@ a face or button specification."
   "Display fancy startup screen.
 If CONCISE is non-nil, display a concise version of the
 splash screen in another window."
-  (with-current-buffer (get-buffer-create "*GNU Emacs*")
-    (let ((inhibit-read-only t))
-      (erase-buffer)
-      (make-local-variable 'startup-screen-inhibit-startup-screen)
-      (if pure-space-overflow
-         (insert pure-space-overflow-message))
-      (unless concise
-       (fancy-splash-head))
-      (dolist (text fancy-startup-text)
-       (apply #'fancy-splash-insert text)
-       (insert "\n"))
-      (skip-chars-backward "\n")
-      (delete-region (point) (point-max))
-      (insert "\n")
-      (fancy-startup-tail concise))
-    (use-local-map splash-screen-keymap)
-    (setq tab-width 22)
-    (set-buffer-modified-p nil)
-    (setq buffer-read-only t)
-    (if (and view-read-only (not view-mode))
-       (view-mode-enter nil 'kill-buffer))
-    (goto-char (point-min)))
-  (if (or (window-minibuffer-p)
-         (window-dedicated-p (selected-window)))
-      (pop-to-buffer (current-buffer)))
-  (if concise
-      (display-buffer (get-buffer "*GNU Emacs*"))
-    (switch-to-buffer "*GNU Emacs*")))
+  (let ((splash-buffer (get-buffer-create "*GNU Emacs*")))
+    (with-current-buffer splash-buffer
+      (let ((inhibit-read-only t))
+       (erase-buffer)
+       (setq default-directory command-line-default-directory)
+       (make-local-variable 'startup-screen-inhibit-startup-screen)
+       (if pure-space-overflow
+           (insert pure-space-overflow-message))
+       (unless concise
+         (fancy-splash-head))
+       (dolist (text fancy-startup-text)
+         (apply #'fancy-splash-insert text)
+         (insert "\n"))
+       (skip-chars-backward "\n")
+       (delete-region (point) (point-max))
+       (insert "\n")
+       (fancy-startup-tail concise))
+      (use-local-map splash-screen-keymap)
+      (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))))
 
 (defun fancy-about-screen ()
   "Display fancy About screen."
@@ -1534,8 +1544,6 @@ splash screen in another window."
        (dolist (text fancy-about-text)
          (apply #'fancy-splash-insert text)
          (insert "\n"))
-       (unless (current-message)
-         (message fancy-splash-help-echo))
        (set-buffer-modified-p nil)
        (goto-char (point-min))
        (force-mode-line-update))
@@ -1543,7 +1551,8 @@ splash screen in another window."
       (setq tab-width 22)
       (message "%s" (startup-echo-area-message))
       (setq buffer-read-only t)
-      (goto-char (point-min)))))
+      (goto-char (point-min))
+      (forward-line 3))))
 
 (defun fancy-splash-frame ()
   "Return the frame to use for the fancy splash screen.
@@ -1577,14 +1586,17 @@ we put it on this frame."
          (> frame-height (+ image-height 19)))))))
 
 
-(defun normal-splash-screen (&optional startup)
+(defun normal-splash-screen (&optional startup concise)
   "Display non-graphic splash screen.
 If optional argument STARTUP is non-nil, display the startup screen
-after Emacs starts.  If STARTUP is nil, display the About screen."
-  (let ((prev-buffer (current-buffer)))
-    (with-current-buffer (get-buffer-create "*About GNU Emacs*")
+after Emacs starts.  If STARTUP is nil, display the About screen.
+If CONCISE is non-nil, display a concise version of the
+splash screen in another window."
+  (let ((splash-buffer (get-buffer-create "*About GNU Emacs*")))
+    (with-current-buffer splash-buffer
       (setq buffer-read-only nil)
       (erase-buffer)
+      (setq default-directory command-line-default-directory)
       (set (make-local-variable 'tab-width) 8)
       (if (not startup)
          (set (make-local-variable 'mode-line-format)
@@ -1642,15 +1654,17 @@ after Emacs starts.  If STARTUP is nil, display the About screen."
       (setq buffer-read-only t)
       (if (and view-read-only (not view-mode))
          (view-mode-enter nil 'kill-buffer))
-      (switch-to-buffer "*About GNU Emacs*")
       (if startup (rename-buffer "*GNU Emacs*" t))
-      (goto-char (point-min)))))
+      (goto-char (point-min)))
+    (if concise
+       (display-buffer splash-buffer)
+      (switch-to-buffer splash-buffer))))
 
 (defun normal-mouse-startup-screen ()
   ;; The user can use the mouse to activate menus
   ;; so give help in terms of menu items.
   (insert "\
-You can do basic editing with the menu bar and scroll bar using the mouse.
+To follow a link, click Mouse-1 on it, or move to it and type RET.
 To quit a partially entered command, type Control-g.\n")
 
   (insert "\nImportant Help menu items:\n")
@@ -1857,7 +1871,7 @@ Type \\[describe-distribution] for information on "))
   (insert "\tHow to contribute improvements to Emacs\n\n")
 
   (insert-button "GNU and Freedom"
-                'action (lambda (button) (describe-project))
+                'action (lambda (button) (describe-gnu-project))
                 'follow-link t)
   (insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
 
@@ -1882,7 +1896,7 @@ Type \\[describe-distribution] for information on "))
   (insert "\tBuying printed manuals from the FSF\n"))
 
 (defun startup-echo-area-message ()
-  (if (eq (key-binding "\C-h\C-p") 'describe-project)
+  (if (eq (key-binding "\C-h\C-a") 'about-emacs)
       "For information about GNU Emacs and the GNU system, type C-h C-a."
     (substitute-command-keys
      "For information about GNU Emacs and the GNU system, type \
@@ -1932,7 +1946,7 @@ screen."
   (if (not (get-buffer "*GNU Emacs*"))
       (if (use-fancy-splash-screens-p)
          (fancy-startup-screen concise)
-       (normal-splash-screen t))))
+       (normal-splash-screen t concise))))
 
 (defun display-about-screen ()
   "Display the *About GNU Emacs* buffer.
@@ -2070,7 +2084,7 @@ A fancy display is used on graphic displays, normal otherwise."
                     (load file nil t)))
 
                  ;; This is used to handle -script.  It's not clear
-                 ;; we need to document it.
+                 ;; we need to document it (it is totally internal).
                  ((member argi '("-scriptload"))
                   (let* ((file (command-line-normalize-file-name
                                 (or argval (pop command-line-args-left))))
@@ -2148,9 +2162,11 @@ A fancy display is used on graphic displays, normal otherwise."
                                  (expand-file-name
                                   (command-line-normalize-file-name orig-argi)
                                   dir)))
-                            (if (= file-count 1)
-                                (setq first-file-buffer (find-file file))
-                              (find-file-other-window file)))
+                            (cond ((= file-count 1)
+                                   (setq first-file-buffer (find-file file)))
+                                  (inhibit-startup-screen
+                                   (find-file-other-window file))
+                                  (t (find-file file))))
                           (or (zerop line)
                               (goto-line line))
                           (setq line 0)
@@ -2169,6 +2185,14 @@ A fancy display is used on graphic displays, normal otherwise."
            ((stringp initial-buffer-choice)
             (find-file initial-buffer-choice))))
 
+    ;; If *scratch* exists and is empty, insert initial-scratch-message.
+    (and initial-scratch-message
+        (get-buffer "*scratch*")
+        (with-current-buffer "*scratch*"
+          (when (zerop (buffer-size))
+            (insert initial-scratch-message)
+            (set-buffer-modified-p nil))))
+
     (if (or inhibit-startup-screen
            initial-buffer-choice
            noninteractive
@@ -2207,20 +2231,12 @@ A fancy display is used on graphic displays, normal otherwise."
        ;; Don't let the hook be run twice.
        (setq window-setup-hook nil))
 
-      ;; Do this now to avoid an annoying delay if the user
-      ;; clicks the menu bar during the sit-for.
-      (when (display-popup-menus-p)
-       (precompute-menubar-bindings))
-      (with-no-warnings
-       (setq menubar-bindings-done t))
-
-      ;; If *scratch* exists and is empty, insert initial-scratch-message.
-      (and initial-scratch-message
-          (get-buffer "*scratch*")
-          (with-current-buffer "*scratch*"
-            (when (zerop (buffer-size))
-              (insert initial-scratch-message)
-              (set-buffer-modified-p nil))))
+      ;; ;; Do this now to avoid an annoying delay if the user
+      ;; ;; clicks the menu bar during the sit-for.
+      ;; (when (display-popup-menus-p)
+      ;;       (precompute-menubar-bindings))
+      ;; (with-no-warnings
+      ;;       (setq menubar-bindings-done t))
 
       (if (> file-count 0)
          (display-startup-screen t)