declare smobs in alloc.c
[bpt/emacs.git] / lisp / startup.el
index cc40f9e..aa44884 100644 (file)
@@ -1,8 +1,8 @@
 ;;; startup.el --- process Emacs shell arguments  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994-2014 Free Software Foundation, Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: internal
 ;; Package: emacs
 
   "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, 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.
+visiting the file or directory that the string specifies.  If the
+value is a function, call it with no arguments and switch to the buffer
+that it returns.  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."
+If you use `emacsclient' with no target file, then it obeys any
+string or function value that this variable has."
   :type '(choice
          (const     :tag "Startup screen" nil)
          (directory :tag "Directory" :value "~/")
          (file      :tag "File" :value "~/.emacs")
-         (const     :tag "Notes buffer" remember-notes)
+         ;; Note sure about hard-coding this as an option...
+         (const     :tag "Remember Mode notes buffer" remember-notes)
          (function  :tag "Function")
          (const     :tag "Lisp scratch buffer" t))
-  :version "24.4"
+  :version "23.1"
   :group 'initialization)
 
 (defcustom inhibit-startup-screen nil
@@ -281,14 +282,20 @@ these functions will invoke the debugger.")
   "Normal hook run after loading init files and handling the command line.")
 
 (defvar term-setup-hook nil
-  "Normal hook run after loading terminal-specific Lisp code.
-It also follows `emacs-startup-hook'.  This hook exists for users to set,
-so as to override the definitions made by the terminal-specific file.
-Emacs never sets this variable itself.")
+  "Normal hook run immediately after `emacs-startup-hook'.
+In new code, there is no reason to use this instead of `emacs-startup-hook'.
+If you want to execute terminal-specific Lisp code, for example
+to override the definitions made by the terminal-specific file,
+see `tty-setup-hook'.")
+
+(make-obsolete-variable 'term-setup-hook
+                       "use either `emacs-startup-hook' or \
+`tty-setup-hook' instead." "24.4")
 
 (defvar inhibit-startup-hooks nil
-  "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
-This is because we already did so.")
+  "Non-nil means don't run some startup hooks, because we already did.
+Currently this applies to: `emacs-startup-hook', `term-setup-hook',
+and `window-setup-hook'.")
 
 (defvar keyboard-type nil
   "The brand of keyboard you are using.
@@ -297,9 +304,12 @@ keys for use under X.  It is used in a fashion analogous to the
 environment variable TERM.")
 
 (defvar window-setup-hook nil
-  "Normal hook run to initialize window system display.
-Emacs runs this hook after processing the command line arguments and loading
-the user's init file.")
+  "Normal hook run after loading init files and handling the command line.
+This is very similar to `emacs-startup-hook'.  The only difference
+is that this hook runs after frame parameters have been set up in
+response to any settings from your init file.  Unless this matters
+to you, use `emacs-startup-hook' instead.  (The name of this hook
+is due to historical reasons, and does not reflect its purpose very well.)")
 
 (defcustom initial-major-mode 'lisp-interaction-mode
   "Major mode command symbol to use for the initial `*scratch*' buffer."
@@ -441,8 +451,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
       (let* ((this-dir (car dirs))
             (contents (directory-files this-dir))
             (default-directory this-dir)
-            (canonicalized (if (fboundp 'untranslated-canonical-name)
-                               (untranslated-canonical-name this-dir))))
+            (canonicalized (if (fboundp 'w32-untranslated-canonical-name)
+                               (w32-untranslated-canonical-name this-dir))))
        ;; The Windows version doesn't report meaningful inode numbers, so
        ;; use the canonicalized absolute file name of the directory instead.
        (setq attrs (or canonicalized
@@ -489,40 +499,101 @@ It is the default value of the variable `top-level'."
   (if command-line-processed
       (message "Back to top level.")
     (setq command-line-processed t)
-    (let ((dir default-directory))
-      (with-current-buffer "*Messages*"
-        (messages-buffer-mode)
-        ;; Make it easy to do like "tail -f".
-        (set (make-local-variable 'window-point-insertion-type) t)
-        ;; Give *Messages* the same default-directory as *scratch*,
-        ;; just to keep things predictable.
-       (setq default-directory dir)))
-    ;; `user-full-name' is now known; reset its standard-value here.
-    (put 'user-full-name 'standard-value
-        (list (default-value 'user-full-name)))
-    ;; Look in each dir in load-path for a subdirs.el file.
-    ;; If we find one, load it, which will add the appropriate subdirs
-    ;; of that dir into load-path,
+
+    ;; Look in each dir in load-path for a subdirs.el file.  If we
+    ;; find one, load it, which will add the appropriate subdirs of
+    ;; that dir into load-path.  This needs to be done before setting
+    ;; the locale environment, because the latter might need to load
+    ;; some support files.
     ;; Look for a leim-list.el file too.  Loading it will register
     ;; available input methods.
     (let ((tail load-path)
           (lispdir (expand-file-name "../lisp" data-directory))
-         ;; For out-of-tree builds, leim-list is generated in the build dir.
-;;;          (leimdir (expand-file-name "../leim" doc-directory))
           dir)
       (while tail
         (setq dir (car tail))
         (let ((default-directory dir))
           (load (expand-file-name "subdirs.el") t t t))
-       ;; Do not scan standard directories that won't contain a leim-list.el.
-       ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
-       (or (string-match (concat "\\`" lispdir) dir)
-           (let ((default-directory dir))
-             (load (expand-file-name "leim-list.el") t t t)))
+        ;; Do not scan standard directories that won't contain a leim-list.el.
+        ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
+        ;; (Except the preloaded one in lisp/leim.)
+        (or (string-prefix-p lispdir dir)
+            (let ((default-directory dir))
+              (load (expand-file-name "leim-list.el") t t t)))
         ;; We don't use a dolist loop and we put this "setq-cdr" command at
         ;; the end, because the subdirs.el files may add elements to the end
         ;; of load-path and we want to take it into account.
         (setq tail (cdr tail))))
+
+    ;; Set the default strings to display in mode line for end-of-line
+    ;; formats that aren't native to this platform.  This should be
+    ;; done before calling set-locale-environment, as the latter might
+    ;; use these mnemonics.
+    (cond
+     ((memq system-type '(ms-dos windows-nt))
+      (setq eol-mnemonic-unix "(Unix)"
+           eol-mnemonic-mac  "(Mac)"))
+     (t                                   ; this is for Unix/GNU/Linux systems
+      (setq eol-mnemonic-dos  "(DOS)"
+           eol-mnemonic-mac  "(Mac)")))
+
+    (set-locale-environment nil)
+    ;; Decode all default-directory's (probably, only *scratch* exists
+    ;; at this point).  default-directory of *scratch* is the basis
+    ;; for many other file-name variables and directory lists, so it
+    ;; is important to decode it ASAP.
+    (when locale-coding-system
+      (let ((coding (if (eq system-type 'windows-nt)
+                       ;; MS-Windows build converts all file names to
+                       ;; UTF-8 during startup.
+                       'utf-8
+                     locale-coding-system)))
+       (save-excursion
+         (dolist (elt (buffer-list))
+           (set-buffer elt)
+           (if default-directory
+               (setq default-directory
+                     (decode-coding-string default-directory coding t)))))
+
+       ;; Decode all the important variables and directory lists, now
+       ;; that we know the locale's encoding.  This is because the
+       ;; values of these variables are until here unibyte undecoded
+       ;; strings created by build_unibyte_string.  data-directory in
+       ;; particular is used to construct many other standard
+       ;; directory names, so it must be decoded ASAP.  Note that
+       ;; charset-map-path cannot be decoded here, since we could
+       ;; then be trapped in infinite recursion below, when we load
+       ;; subdirs.el, because encoding a directory name might need to
+       ;; load a charset map, which will want to encode
+       ;; charset-map-path, which will want to load the same charset
+       ;; map...  So decoding of charset-map-path is delayed until
+       ;; further down below.
+       (dolist (pathsym '(load-path exec-path))
+         (let ((path (symbol-value pathsym)))
+           (if (listp path)
+               (set pathsym (mapcar (lambda (dir)
+                                      (decode-coding-string dir coding t))
+                                    path)))))
+       (dolist (filesym '(data-directory doc-directory exec-directory
+                                         installation-directory
+                                         invocation-directory invocation-name
+                                         source-directory
+                                         shared-game-score-directory))
+         (let ((file (symbol-value filesym)))
+           (if (stringp file)
+               (set filesym (decode-coding-string file coding t)))))))
+
+    (let ((dir default-directory))
+      (with-current-buffer "*Messages*"
+        (messages-buffer-mode)
+        ;; Make it easy to do like "tail -f".
+        (set (make-local-variable 'window-point-insertion-type) t)
+        ;; Give *Messages* the same default-directory as *scratch*,
+        ;; just to keep things predictable.
+       (setq default-directory dir)))
+    ;; `user-full-name' is now known; reset its standard-value here.
+    (put 'user-full-name 'standard-value
+        (list (default-value 'user-full-name)))
     ;; If the PWD environment variable isn't accurate, delete it.
     (let ((pwd (getenv "PWD")))
       (and (stringp pwd)
@@ -536,6 +607,17 @@ It is the default value of the variable `top-level'."
               (setq process-environment
                     (delete (concat "PWD=" pwd)
                             process-environment)))))
+    ;; Now, that other directories were searched, and any charsets we
+    ;; need for encoding them are already loaded, we are ready to
+    ;; decode charset-map-path.
+    (if (listp charset-map-path)
+       (let ((coding (if (eq system-type 'windows-nt)
+                         'utf-8
+                       locale-coding-system)))
+         (setq charset-map-path
+               (mapcar (lambda (dir)
+                         (decode-coding-string dir coding t))
+                       charset-map-path))))
     (setq default-directory (abbreviate-file-name default-directory))
     (let ((old-face-font-rescale-alist face-font-rescale-alist))
       (unwind-protect
@@ -567,9 +649,7 @@ It is the default value of the variable `top-level'."
                                       (emacs-pid)
                                       (system-name))))))))
        (unless inhibit-startup-hooks
-         (run-hooks 'emacs-startup-hook)
-         (and term-setup-hook
-              (run-hooks 'term-setup-hook)))
+         (run-hooks 'emacs-startup-hook 'term-setup-hook))
 
        ;; Don't do this if we failed to create the initial frame,
        ;; for instance due to a dense colormap.
@@ -605,8 +685,8 @@ It is the default value of the variable `top-level'."
        ;; Now we know the user's default font, so add it to the menu.
        (if (fboundp 'font-menu-add-default)
            (font-menu-add-default))
-       (and window-setup-hook
-            (run-hooks 'window-setup-hook))))
+       (unless inhibit-startup-hooks
+         (run-hooks 'window-setup-hook))))
     ;; Subprocesses of Emacs do not have direct access to the terminal, so
     ;; unless told otherwise they should only assume a dumb terminal.
     ;; We are careful to do it late (after term-setup-hook), although the
@@ -659,7 +739,6 @@ opening the first frame (e.g. open a connection to an X server).")
 (defun tty-handle-args (args)
   "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
   (let (rest)
-    (message "%S" args)
     (while (and args
                (not (equal (car args) "--")))
       (let* ((argi (pop args))
@@ -756,18 +835,6 @@ Amongst another things, it parses the command-line arguments."
   ;;! ;; Choose a good default value for split-window-keep-point.
   ;;! (setq split-window-keep-point (> baud-rate 2400))
 
-  ;; Set the default strings to display in mode line for
-  ;; end-of-line formats that aren't native to this platform.
-  (cond
-   ((memq system-type '(ms-dos windows-nt))
-    (setq eol-mnemonic-unix "(Unix)"
-          eol-mnemonic-mac  "(Mac)"))
-   (t                                   ; this is for Unix/GNU/Linux systems
-    (setq eol-mnemonic-dos  "(DOS)"
-          eol-mnemonic-mac  "(Mac)")))
-
-  (set-locale-environment nil)
-
   ;; Convert preloaded file names in load-history to absolute.
   (let ((simple-file-name
         ;; Look for simple.el or simple.elc and use their directory
@@ -801,7 +868,7 @@ please check its value")
                    load-history))))
 
   ;; Convert the arguments to Emacs internal representation.
-  (let ((args (cdr command-line-args)))
+  (let ((args command-line-args))
     (while args
       (setcar args
              (decode-coding-string (car args) locale-coding-system t))
@@ -1211,19 +1278,6 @@ the `--debug-init' option to view a complete error backtrace."
   (setq after-init-time (current-time))
   (run-hooks 'after-init-hook)
 
-  ;; Decode all default-directory.
-  (if (and (default-value 'enable-multibyte-characters) locale-coding-system)
-      (save-excursion
-       (dolist (elt (buffer-list))
-         (set-buffer elt)
-         (if default-directory
-             (setq default-directory
-                   (decode-coding-string default-directory
-                                         locale-coding-system t))))
-       (setq command-line-default-directory
-             (decode-coding-string command-line-default-directory
-                                   locale-coding-system t))))
-
   ;; If *scratch* exists and init file didn't change its mode, initialize it.
   (if (get-buffer "*scratch*")
       (with-current-buffer "*scratch*"
@@ -1233,8 +1287,9 @@ the `--debug-init' option to view a complete error backtrace."
   ;; Load library for our terminal type.
   ;; User init file can set term-file-prefix to nil to prevent this.
   (unless (or noninteractive
-              initial-window-system)
-    (tty-run-terminal-initialization (selected-frame)))
+              initial-window-system
+              (daemonp))
+    (tty-run-terminal-initialization (selected-frame) nil t))
 
   ;; Update the out-of-memory error message based on user's key bindings
   ;; for save-some-buffers.
@@ -1245,6 +1300,29 @@ the `--debug-init' option to view a complete error backtrace."
   ;; Process the remaining args.
   (command-line-1 (cdr command-line-args))
 
+  ;; This is a problem because, e.g. if emacs.d/gnus.el exists,
+  ;; trying to load gnus could load the wrong file.
+  ;; OK, it would not matter if .emacs.d were at the end of load-path.
+  ;; but for the sake of simplicity, we discourage it full-stop.
+  ;; Ref eg http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00056.html
+  ;;
+  ;; A bad element could come from user-emacs-file, the command line,
+  ;; or EMACSLOADPATH, so we basically always have to check.
+  (let (warned)
+    (dolist (dir load-path)
+      (and (not warned)
+          (string-match-p "/[._]emacs\\.d/?\\'" dir)
+          (string-equal (file-name-as-directory (expand-file-name dir))
+                        (expand-file-name user-emacs-directory))
+          (setq warned t)
+          (display-warning 'initialization
+                           (format "Your `load-path' seems to contain
+your `.emacs.d' directory: %s\n\
+This is likely to cause problems...\n\
+Consider using a subdirectory instead, e.g.: %s" dir
+(expand-file-name "lisp" user-emacs-directory))
+                            :warning))))
+
   ;; If -batch, terminate after processing the command options.
   (if noninteractive (kill-emacs t))
 
@@ -1325,8 +1403,9 @@ If this is nil, no message will be displayed."
             `("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")))
+          `("GNU" ,(lambda (_button)
+                    (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
+           "Browse http://www.gnu.org/gnu/thegnuproject.html")))
      " operating system.\n\n"
      :face variable-pitch
      :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
@@ -1519,24 +1598,26 @@ a face or button specification."
 
 (declare-function image-size "image.c" (spec &optional pixels frame))
 
+(defun fancy-splash-image-file ()
+  (cond ((stringp fancy-splash-image) fancy-splash-image)
+       ((display-color-p)
+        (cond ((<= (display-planes) 8)
+               (if (image-type-available-p 'xpm)
+                   "splash.xpm"
+                 "splash.pbm"))
+              ((or (image-type-available-p 'svg)
+                   (image-type-available-p 'imagemagick))
+               "splash.svg")
+              ((image-type-available-p 'png)
+               "splash.png")
+              ((image-type-available-p 'xpm)
+               "splash.xpm")
+              (t "splash.pbm")))
+       (t "splash.pbm")))
+
 (defun fancy-splash-head ()
   "Insert the head part of the splash screen into the current buffer."
-  (let* ((image-file (cond ((stringp fancy-splash-image)
-                           fancy-splash-image)
-                          ((display-color-p)
-                           (cond ((<= (display-planes) 8)
-                                  (if (image-type-available-p 'xpm)
-                                      "splash.xpm"
-                                    "splash.pbm"))
-                                 ((or (image-type-available-p 'svg)
-                                      (image-type-available-p 'imagemagick))
-                                  "splash.svg")
-                                 ((image-type-available-p 'png)
-                                  "splash.png")
-                                 ((image-type-available-p 'xpm)
-                                  "splash.xpm")
-                                 (t "splash.pbm")))
-                          (t "splash.pbm")))
+  (let* ((image-file (fancy-splash-image-file))
         (img (create-image image-file))
         (image-width (and img (car (image-size img))))
         (window-width (window-width)))
@@ -1672,6 +1753,7 @@ splash screen in another window."
        (insert "\n")
        (fancy-startup-tail concise))
       (use-local-map splash-screen-keymap)
+      (setq-local browse-url-browser-function 'eww-browse-url)
       (setq tab-width 22
            buffer-read-only t)
       (set-buffer-modified-p nil)
@@ -1709,6 +1791,7 @@ splash screen in another window."
        (goto-char (point-min))
        (force-mode-line-update))
       (use-local-map splash-screen-keymap)
+      (setq-local browse-url-browser-function 'eww-browse-url)
       (setq tab-width 22)
       (setq buffer-read-only t)
       (goto-char (point-min))
@@ -1720,6 +1803,10 @@ Returning non-nil does not mean we should necessarily
 use the fancy splash screen, but if we do use it,
 we put it on this frame."
   (let (chosen-frame)
+    ;; MS-Windows needs this to have a chance to make the initial
+    ;; frame visible.
+    (if (eq system-type 'windows-nt)
+       (sit-for 0 t))
     (dolist (frame (append (frame-list) (list (selected-frame))))
       (if (and (frame-visible-p frame)
               (not (window-minibuffer-p (frame-selected-window frame))))
@@ -1730,14 +1817,11 @@ we put it on this frame."
   "Return t if fancy splash screens should be used."
   (when (and (display-graphic-p)
              (or (and (display-color-p)
-                (image-type-available-p 'xpm))
+                     (image-type-available-p 'xpm))
                  (image-type-available-p 'pbm)))
     (let ((frame (fancy-splash-frame)))
       (when frame
-       (let* ((img (create-image (or fancy-splash-image
-                                     (if (and (display-color-p)
-                                              (image-type-available-p 'xpm))
-                                         "splash.xpm" "splash.pbm"))))
+       (let* ((img (create-image (fancy-splash-image-file)))
               (image-height (and img (cdr (image-size img nil frame))))
               ;; We test frame-height so that, if the frame is split
               ;; by displaying a warning, that doesn't cause the normal
@@ -2087,12 +2171,11 @@ A fancy display is used on graphic displays, normal otherwise."
            ;; This approach loses for "-batch -L DIR --eval "(require foo)",
            ;; if foo is intended to be found in DIR.
            ;;
-           ;; ;; The directories listed in --directory/-L options will *appear*
-           ;; ;; at the front of `load-path' in the order they appear on the
-           ;; ;; command-line.  We cannot do this by *placing* them at the front
-           ;; ;; in the order they appear, so we need this variable to hold them,
-           ;; ;; temporarily.
-           ;; extra-load-path
+           ;; The directories listed in --directory/-L options will *appear*
+           ;; at the front of `load-path' in the order they appear on the
+           ;; command-line.  We cannot do this by *placing* them at the front
+           ;; in the order they appear, so we need this variable to hold them,
+           ;; temporarily.
            ;;
            ;; To DTRT we keep track of the splice point and modify `load-path'
            ;; straight away upon any --directory/-L option.
@@ -2172,13 +2255,22 @@ A fancy display is used on graphic displays, normal otherwise."
                   (eval (read (or argval (pop command-line-args-left)))))
 
                  ((member argi '("-L" "-directory"))
-                  (setq tem (expand-file-name
-                             (command-line-normalize-file-name
-                              (or argval (pop command-line-args-left)))))
-                  (cond (splice (setcdr splice (cons tem (cdr splice)))
-                                (setq splice (cdr splice)))
-                        (t (setq load-path (cons tem load-path)
-                                 splice load-path))))
+                  ;; -L :/foo adds /foo to the _end_ of load-path.
+                  (let (append)
+                    (if (string-match-p
+                         (format "\\`%s" path-separator)
+                         (setq tem (or argval (pop command-line-args-left))))
+                        (setq tem (substring tem 1)
+                              append t))
+                    (setq tem (expand-file-name
+                               (command-line-normalize-file-name tem)))
+                    (cond (append (setq load-path
+                                        (append load-path (list tem)))
+                                  (if splice (setq splice load-path)))
+                          (splice (setcdr splice (cons tem (cdr splice)))
+                                  (setq splice (cdr splice)))
+                          (t (setq load-path (cons tem load-path)
+                                   splice load-path)))))
 
                  ((member argi '("-l" "-load"))
                   (let* ((file (command-line-normalize-file-name
@@ -2342,10 +2434,7 @@ A fancy display is used on graphic displays, normal otherwise."
       ;; If there are no switches to process, we might as well
       ;; run this hook now, and there may be some need to do it
       ;; before doing any output.
-      (run-hooks 'emacs-startup-hook)
-      (and term-setup-hook
-          (run-hooks 'term-setup-hook))
-      (setq inhibit-startup-hooks t)
+      (run-hooks 'emacs-startup-hook 'term-setup-hook)
 
       ;; It's important to notice the user settings before we
       ;; display the startup message; otherwise, the settings
@@ -2357,10 +2446,9 @@ A fancy display is used on graphic displays, normal otherwise."
       ;; If there are no switches to process, we might as well
       ;; run this hook now, and there may be some need to do it
       ;; before doing any output.
-      (when window-setup-hook
-       (run-hooks 'window-setup-hook)
-       ;; Don't let the hook be run twice.
-       (setq window-setup-hook nil))
+      (run-hooks 'window-setup-hook)
+
+      (setq inhibit-startup-hooks t)
 
       ;; ;; Do this now to avoid an annoying delay if the user
       ;; ;; clicks the menu bar during the sit-for.