]> code.delx.au - gnu-emacs/blobdiff - lisp/startup.el
Merged from emacs@sv.gnu.org
[gnu-emacs] / lisp / startup.el
index 145bbcbc86ec25ff3bdd56439192f9fb585c1be4..a4197a8550231d6e53f2f74607aa74d4c7ab6c9a 100644 (file)
@@ -1,7 +1,7 @@
 ;;; startup.el --- process Emacs shell arguments
 
 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;;   2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;;   2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -47,14 +47,16 @@ The value is nil if the selected frame is on a text-only-terminal.")
   "Emacs start-up procedure."
   :group 'internal)
 
-(defcustom inhibit-startup-message nil
-  "*Non-nil inhibits the initial startup message.
+(defcustom inhibit-splash-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, once you are familiar
-with the contents of the startup message."
+with the contents of the startup screen."
   :type 'boolean
   :group 'initialization)
 
-(defvaralias 'inhibit-splash-screen 'inhibit-startup-message)
+(defvaralias 'inhibit-startup-message 'inhibit-splash-screen)
 
 (defcustom inhibit-startup-echo-area-message nil
   "*Non-nil inhibits the initial startup echo area message.
@@ -128,8 +130,7 @@ This is normally copied from `default-directory' when Emacs starts.")
     ("-bg" 1 x-handle-switch background-color)
     ("-background" 1 x-handle-switch background-color)
     ("-ms" 1 x-handle-switch mouse-color)
-    ("-itype" 0 x-handle-switch icon-type t)
-    ("-i" 0 x-handle-switch icon-type t)
+    ("-nbi" 0 x-handle-switch icon-type nil)
     ("-iconic" 0 x-handle-iconic)
     ("-xrm" 1 x-handle-xrm-switch)
     ("-cr" 1 x-handle-switch cursor-color)
@@ -150,7 +151,7 @@ This is normally copied from `default-directory' when Emacs starts.")
     ("--foreground-color" 1 x-handle-switch foreground-color)
     ("--background-color" 1 x-handle-switch background-color)
     ("--mouse-color" 1 x-handle-switch mouse-color)
-    ("--icon-type" 0 x-handle-switch icon-type t)
+    ("--no-bitmap-icon" 0 x-handle-switch icon-type nil)
     ("--iconic" 0 x-handle-iconic)
     ("--xrm" 1 x-handle-xrm-switch)
     ("--cursor-color" 1 x-handle-switch cursor-color)
@@ -205,23 +206,22 @@ the user's init file.")
   :type 'function
   :group 'initialization)
 
-(defcustom init-file-user nil
+(defvar init-file-user nil
   "Identity of user whose `.emacs' file is or was read.
 The value is nil if `-q' or `--no-init-file' was specified,
 meaning do not load any init file.
 
-Otherwise, the value may be the null string, meaning use the init file
-for the user that originally logged in, or it may be a
-string containing a user's name meaning use that person's init file.
+Otherwise, the value may be an empty string, meaning
+use the init file for the user who originally logged in,
+or it may be a string containing a user's name meaning
+use that person's init file.
 
 In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
 evaluates to the name of the directory where the `.emacs' file was
 looked for.
 
 Setting `init-file-user' does not prevent Emacs from loading
-`site-start.el'.  The only way to do that is to use `--no-site-file'."
-  :type '(choice (const :tag "none" nil) string)
-  :group 'initialization)
+`site-start.el'.  The only way to do that is to use `--no-site-file'.")
 
 (defcustom site-run-file "site-start"
   "File containing site-wide run-time initializations.
@@ -648,6 +648,24 @@ opening the first frame (e.g. open a connection to an X server).")
 
   (set-locale-environment nil)
 
+  ;; Convert preloaded file names to absolute.
+  (let ((lisp-dir
+        (file-name-directory
+         (locate-file "simple" load-path
+                      load-suffixes))))
+
+    (setq load-history
+         (mapcar (lambda (elt)
+                   (if (and (stringp (car elt))
+                            (not (file-name-absolute-p (car elt))))
+                       (cons (concat lisp-dir
+                                     (car elt)
+                                     (if (string-match "[.]el$" (car elt))
+                                         "" ".elc"))
+                             (cdr elt))
+                     elt))
+                 load-history)))
+
   ;; Convert the arguments to Emacs internal representation.
   (let ((args (cdr command-line-args)))
     (while args
@@ -727,6 +745,8 @@ opening the first frame (e.g. open a connection to an X server).")
     (and command-line-args
          (setcdr command-line-args args)))
 
+  (run-hooks 'before-init-hook)
+
   ;; Under X Window, this creates the X frame and deletes the terminal frame.
   (when (fboundp 'frame-initialize)
     (frame-initialize))
@@ -757,14 +777,21 @@ opening the first frame (e.g. open a connection to an X server).")
   ;; Can't do this init in defcustom because the relevant variables
   ;; are not set.
   (custom-reevaluate-setting 'blink-cursor-mode)
-  (custom-reevaluate-setting 'normal-erase-is-backspace)
   (custom-reevaluate-setting 'tooltip-mode)
+  (custom-reevaluate-setting 'global-font-lock-mode)
+  (custom-reevaluate-setting 'mouse-wheel-down-event)
+  (custom-reevaluate-setting 'mouse-wheel-up-event)
+  (custom-reevaluate-setting 'file-name-shadow-mode)
+  (custom-reevaluate-setting 'send-mail-function)
+
+  (normal-erase-is-backspace-setup-frame)
 
   ;; Register default TTY colors for the case the terminal hasn't a
-  ;; terminal init file.
-  ;; We do this regardles of whether the terminal supports colors
-  ;; or not, since they can switch that support on or off in
-  ;; mid-session by setting the tty-color-mode frame parameter.
+  ;; terminal init file.  We do this regardles of whether the terminal
+  ;; supports colors or not and regardless the current display type,
+  ;; since users can connect to color-capable terminals and also
+  ;; switch color support on or off in mid-session by setting the
+  ;; tty-color-mode frame parameter.
   (tty-register-default-colors)
 
   ;; Record whether the tool-bar is present before the user and site
@@ -783,8 +810,6 @@ opening the first frame (e.g. open a connection to an X server).")
        (old-font-list-limit font-list-limit)
        (old-face-ignored-fonts face-ignored-fonts))
 
-    (run-hooks 'before-init-hook)
-
     ;; 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.
@@ -796,12 +821,18 @@ opening the first frame (e.g. open a connection to an X server).")
     (setq inhibit-startup-message nil)
 
     ;; Warn for invalid user name.
-    (and init-file-user
-        (not (file-directory-p (expand-file-name (concat "~" init-file-user))))
-        (display-warning 'initialization
-                         (format "User %s has no home directory"
-                                 init-file-user)
-                         :error))
+    (when init-file-user
+      (if (string-match "[~/:\n]" init-file-user)
+         (display-warning 'initialization
+                          (format "Invalid user name %s"
+                                  init-file-user)
+                          :error)
+       (if (file-directory-p (expand-file-name (concat "~" init-file-user)))
+           nil
+         (display-warning 'initialization
+                          (format "User %s has no home directory"
+                                  init-file-user)
+                          :error))))
 
     ;; Load that user's init file, or the default one, or none.
     (let (debug-on-error-from-init-file
@@ -839,14 +870,12 @@ opening the first frame (e.g. open a connection to an X server).")
 
                      (when (eq user-init-file t)
                        ;; If we did not find ~/.emacs, try
-                       ;; ~/.emacs.d/.emacs.
+                       ;; ~/.emacs.d/init.el.
                        (let ((otherfile
                               (expand-file-name
-                               (file-name-nondirectory user-init-file-1)
+                               "init"
                                (file-name-as-directory
-                                (expand-file-name
-                                 ".emacs.d"
-                                 (file-name-directory user-init-file-1))))))
+                                (concat "~" init-file-user "/.emacs.d")))))
                          (load otherfile t t)
 
                          ;; If we did not find the user's init file,
@@ -910,6 +939,10 @@ opening the first frame (e.g. open a connection to an X server).")
                 (pop-to-buffer "*Messages*"))
               (setq init-file-had-error t)))))
 
+       (if (and deactivate-mark transient-mark-mode)
+           (with-current-buffer (window-buffer)
+             (deactivate-mark)))
+
        ;; If the user has a file of abbrevs, read it.
        (if (file-exists-p abbrev-file-name)
            (quietly-read-abbrev-file abbrev-file-name))
@@ -947,6 +980,38 @@ opening the first frame (e.g. open a connection to an X server).")
                                        (or mail-host-address
                                            (system-name)))))
 
+    ;; Originally face attributes were specified via
+    ;; `font-lock-face-attributes'.  Users then changed the default
+    ;; face attributes by setting that variable.  However, we try and
+    ;; be back-compatible and respect its value if set except for
+    ;; faces where M-x customize has been used to save changes for the
+    ;; face.
+    (when (boundp 'font-lock-face-attributes)
+      (let ((face-attributes font-lock-face-attributes))
+       (while face-attributes
+         (let* ((face-attribute (pop face-attributes))
+                (face (car face-attribute)))
+           ;; Rustle up a `defface' SPEC from a
+           ;; `font-lock-face-attributes' entry.
+           (unless (get face 'saved-face)
+             (let ((foreground (nth 1 face-attribute))
+                   (background (nth 2 face-attribute))
+                   (bold-p (nth 3 face-attribute))
+                   (italic-p (nth 4 face-attribute))
+                   (underline-p (nth 5 face-attribute))
+                   face-spec)
+               (when foreground
+                 (setq face-spec (cons ':foreground (cons foreground face-spec))))
+               (when background
+                 (setq face-spec (cons ':background (cons background face-spec))))
+               (when bold-p
+                 (setq face-spec (append '(:weight bold) face-spec)))
+               (when italic-p
+                 (setq face-spec (append '(:slant italic) face-spec)))
+               (when underline-p
+                 (setq face-spec (append '(:underline t) face-spec)))
+               (face-spec-set face (list (list t face-spec)) nil)))))))
+
     ;; If parameter have been changed in the init file which influence
     ;; face realization, clear the face cache so that new faces will
     ;; be realized.
@@ -1008,7 +1073,9 @@ 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 this is nil, no message will be displayed.
+If `inhibit-splash-screen' is non-nil, then no message is displayed,
+regardless of the value of this variable."
   :type '(choice (text :tag "Message")
                 (const :tag "none" nil))
   :group 'initialization)
@@ -1186,7 +1253,7 @@ where FACE is a valid face specification, as it can be used with
                         (emacs-version)
                         "\n"
                         :face '(variable-pitch :height 0.5)
-                        "Copyright (C) 2005 Free Software Foundation, Inc.")
+                        "Copyright (C) 2006 Free Software Foundation, Inc.")
     (and auto-save-list-file-prefix
         ;; Don't signal an error if the
         ;; directory for auto-save-list files
@@ -1226,16 +1293,32 @@ where FACE is a valid face specification, as it can be used with
     (force-mode-line-update)
     (setq fancy-current-text (cdr fancy-current-text))))
 
-
 (defun fancy-splash-default-action ()
   "Stop displaying the splash screen buffer.
 This is an internal function used to turn off the splash screen after
 the user caused an input event by hitting a key or clicking with the
 mouse."
   (interactive)
-  (push last-command-event unread-command-events)
+  (if (and (memq 'down (event-modifiers last-command-event))
+          (eq (posn-window (event-start last-command-event))
+              (selected-window)))
+      ;; This is a mouse-down event in the splash screen window.
+      ;; Ignore it and consume the corresponding mouse-up event.
+      (read-event)
+    (push last-command-event unread-command-events))
   (throw 'exit nil))
 
+(defun fancy-splash-exit ()
+  "Exit the splash screen."
+  (if (get-buffer "GNU Emacs")
+      (throw 'stop-splashing nil)))
+
+(defun fancy-splash-delete-frame (frame)
+  "Exit the splash screen after the frame is deleted."
+  ;; We can not throw from `delete-frame-events', so we set up a timer
+  ;; to exit the recursive edit as soon as Emacs is idle again.
+  (if (frame-live-p frame)
+      (run-at-time 0 nil 'fancy-splash-exit)))
 
 (defun fancy-splash-screens ()
   "Display fancy splash screens when Emacs starts."
@@ -1253,12 +1336,17 @@ mouse."
       (setq splash-buffer (current-buffer))
       (catch 'stop-splashing
        (unwind-protect
-           (let ((map (make-sparse-keymap)))
-             (use-local-map map)
-             (define-key map [switch-frame] 'ignore)
+           (let* ((map (make-sparse-keymap))
+                  (overriding-local-map map)
+                  ;; Catch if our frame is deleted; the delete-frame
+                  ;; event is unreliable and is handled by
+                  ;; `special-event-map' anyway.
+                  (delete-frame-functions (cons 'fancy-splash-delete-frame
+                                                delete-frame-functions)))
              (define-key map [t] 'fancy-splash-default-action)
              (define-key map [mouse-movement] 'ignore)
              (define-key map [mode-line t] 'ignore)
+             (define-key map [select-window] 'ignore)
              (setq cursor-type nil
                    display-hourglass nil
                    minor-mode-map-alist nil
@@ -1274,7 +1362,10 @@ mouse."
          (cancel-timer timer)
          (setq display-hourglass old-hourglass
                minor-mode-map-alist old-minor-mode-map-alist)
-         (kill-buffer splash-buffer))))))
+         (kill-buffer splash-buffer)
+         (when (frame-live-p frame)
+           (select-frame frame)
+           (switch-to-buffer fancy-splash-outer-buffer)))))))
 
 (defun fancy-splash-frame ()
   "Return the frame to use for the fancy splash screen.
@@ -1310,10 +1401,9 @@ we put it on this frame."
   (let ((prev-buffer (current-buffer)))
     (unwind-protect
        (with-current-buffer (get-buffer-create "GNU Emacs")
-         (let ((tab-width 8)
-               (mode-line-format (propertize "---- %b %-"
-                                             'face '(:weight bold))))
-
+         (setq mode-line-format (propertize "---- %b %-"
+                                            'face '(:weight bold)))
+         (let ((tab-width 8))
            (if pure-space-overflow
                (insert "Warning Warning  Pure space overflow   Warning Warning\n"))
 
@@ -1352,7 +1442,7 @@ More Manuals / Ordering Manuals    How to order printed manuals from the FSF
 ")
                  (insert "\n\n" (emacs-version)
                          "
-Copyright (C) 2005 Free Software Foundation, Inc."))
+Copyright (C) 2006 Free Software Foundation, Inc."))
 
              ;; No mouse menus, so give help using kbd commands.
 
@@ -1360,7 +1450,7 @@ Copyright (C) 2005 Free Software Foundation, Inc."))
              ;; use precomputed string to save lots of time.
              (if (and (eq (key-binding "\C-h") 'help-command)
                       (eq (key-binding "\C-xu") 'advertised-undo)
-                      (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
+                      (eq (key-binding "\C-x\C-c") 'save-buffers-kill-terminal)
                       (eq (key-binding "\C-ht") 'help-with-tutorial)
                       (eq (key-binding "\C-hi") 'info)
                       (eq (key-binding "\C-hr") 'info-emacs-manual)
@@ -1377,7 +1467,7 @@ Browse manuals     C-h i")
 Get help          %s
 Emacs manual      \\[info-emacs-manual]
 Emacs tutorial    \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
-Buy manuals        \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
+Buy manuals        \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-terminal]
 Browse manuals     \\[info]"
                                 (let ((where (where-is-internal
                                               'help-command nil t)))
@@ -1400,7 +1490,7 @@ If you have no Meta key, you may instead type ESC followed by the character.)")
 
              (insert "\n\n" (emacs-version)
                      "
-Copyright (C) 2005 Free Software Foundation, Inc.")
+Copyright (C) 2006 Free Software Foundation, Inc.")
 
              (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
                       (eq (key-binding "\C-h\C-d") 'describe-distribution)
@@ -1459,7 +1549,7 @@ Type \\[describe-distribution] for information on getting the latest version."))
 
 (defun display-startup-echo-area-message ()
   (let ((resize-mini-windows t))
-    (message (startup-echo-area-message))))
+    (message "%s" (startup-echo-area-message))))
 
 
 (defun display-splash-screen ()
@@ -1467,10 +1557,11 @@ Type \\[describe-distribution] for information on getting the latest version."))
 Fancy splash screens are used on graphic displays,
 normal otherwise."
   (interactive)
-  (if (use-fancy-splash-screens-p)
-      (fancy-splash-screens)
-    (normal-splash-screen)))
-
+  ;; Prevent recursive calls from server-process-filter.
+  (if (not (get-buffer "GNU Emacs"))
+      (if (use-fancy-splash-screens-p)
+         (fancy-splash-screens)
+       (normal-splash-screen))))
 
 (defun command-line-1 (command-line-args-left)
   (or noninteractive (input-pending-p) init-file-had-error
@@ -1543,7 +1634,7 @@ normal otherwise."
           (longopts
            (append '(("--funcall") ("--load") ("--insert") ("--kill")
                      ("--directory") ("--eval") ("--execute") ("--no-splash")
-                     ("--find-file") ("--visit") ("--file"))
+                     ("--find-file") ("--visit") ("--file") ("--no-desktop"))
                    (mapcar (lambda (elt)
                              (list (concat "-" (car elt))))
                            command-switch-alist)))
@@ -1643,6 +1734,13 @@ normal otherwise."
                 ((equal argi "-kill")
                  (kill-emacs t))
 
+               ;; This is for when they use --no-desktop with -q, or
+               ;; don't load Desktop in their .emacs.  If desktop.el
+               ;; _is_ loaded, it will handle this switch, and we
+               ;; won't see it by the time we get here.
+               ((equal argi "-no-desktop")
+                (message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
+
                 ((string-match "^\\+[0-9]+\\'" argi)
                  (setq line (string-to-number argi)))