Tweak startup image choice logic.
[bpt/emacs.git] / lisp / startup.el
index 1cbf2f7..e71fe32 100644 (file)
@@ -41,7 +41,7 @@
 (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 string, visit the specified file
+startup screen.  If the value is string, visit the specified file
 or directory using `find-file'.  If t, open the `*scratch*'
 buffer."
   :type '(choice
@@ -65,6 +65,8 @@ once you are familiar with the contents of the startup screen."
 
 (defvar startup-screen-inhibit-startup-screen nil)
 
+;; FIXME? Why does this get such weirdly extreme treatment, when the
+;; more important inhibit-startup-screen does not.
 (defcustom inhibit-startup-echo-area-message nil
   "Non-nil inhibits the initial startup echo area message.
 Setting this variable takes effect
@@ -99,16 +101,15 @@ the remaining command-line args are in the variable `command-line-args-left'.")
   "List of command-line args not yet processed.")
 
 (defvaralias 'argv 'command-line-args-left
-  ;; FIXME: Bad name for a dynamically bound variable.
   "List of command-line args not yet processed.
 This is a convenience alias, so that one can write \(pop argv\)
 inside of --eval command line arguments in order to access
 following arguments.")
+(internal-make-var-non-special 'argv)
 
-(with-no-warnings
-  ;; FIXME: Bad name for a dynamically bound variable
-  (defvar argi nil
-    "Current command-line argument."))
+(defvar argi nil
+  "Current command-line argument.")
+(internal-make-var-non-special 'argi)
 
 (defvar command-line-functions nil    ;; lrs 7/31/89
   "List of functions to process unrecognized command-line arguments.
@@ -337,7 +338,9 @@ this variable usefully is to set it while building and dumping Emacs."
          (error "Customizing `site-run-file' does not work")))
 
 (defcustom mail-host-address nil
-  "Name of this machine, for purposes of naming users."
+  "Name of this machine, for purposes of naming users.
+If non-nil, Emacs uses this instead of `system-name' when constructing
+email addresses."
   :type '(choice (const nil) string)
   :group 'mail)
 
@@ -464,6 +467,10 @@ DIRS are relative."
       (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
 
 (defun normal-top-level ()
+  "Emacs calls this function when it first starts up.
+It sets `command-line-processed', processes the command-line,
+reads the initialization files, etc.
+It is the default value of the variable `top-level'."
   (if command-line-processed
       (message "Back to top level.")
     (setq command-line-processed t)
@@ -482,13 +489,20 @@ DIRS are relative."
     ;; of that dir into load-path,
     ;; Look for a leim-list.el file too.  Loading it will register
     ;; available input methods.
-    (let ((tail load-path) dir)
+    (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))
-        (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
+       (or (string-match (concat "\\`" 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.
@@ -701,6 +715,8 @@ opening the first frame (e.g. open a connection to an X server).")
 (defvar server-process)
 
 (defun command-line ()
+  "A subroutine of `normal-top-level'.
+Amongst another things, it parses the command-line arguments."
   (setq before-init-time (current-time)
        after-init-time nil
         command-line-default-directory default-directory)
@@ -888,33 +904,12 @@ opening the first frame (e.g. open a connection to an X server).")
 
   (run-hooks 'before-init-hook)
 
-  ;; Under X, this creates the X frame and deletes the terminal frame.
+  ;; Under X, create the X frame and delete the terminal frame.
   (unless (daemonp)
-
-    ;; If X resources are available, use them to initialize the values
-    ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of
-    ;; `no-blinking-cursor' and the `cursor' face.
-    (cond
-     ((or noninteractive emacs-basic-display)
-      (setq menu-bar-mode nil
-           tool-bar-mode nil
-           no-blinking-cursor t))
-     ((memq initial-window-system '(x w32 ns))
-      (let ((no-vals  '("no" "off" "false" "0")))
-       (if (member (x-get-resource "menuBar" "MenuBar") no-vals)
-           (setq menu-bar-mode nil))
-       (if (member (x-get-resource "toolBar" "ToolBar") no-vals)
-           (setq tool-bar-mode nil))
-       (if (member (x-get-resource "cursorBlink" "CursorBlink")
-                   no-vals)
-           (setq no-blinking-cursor t)))
-      ;; If the cursorColor X resource exists, alter the `cursor' face
-      ;; spec, but mark it as changed outside of Customize.
-      (let ((color (x-get-resource "cursorColor" "CursorColor")))
-       (when color
-         (put 'cursor 'theme-face
-              `((changed ((t :background ,color)))))
-         (put 'cursor 'face-modified t)))))
+    (if (or noninteractive emacs-basic-display)
+       (setq menu-bar-mode nil
+             tool-bar-mode nil
+             no-blinking-cursor t))
     (frame-initialize))
 
   (when (fboundp 'x-create-frame)
@@ -929,7 +924,7 @@ opening the first frame (e.g. open a connection to an X server).")
              emacs-basic-display
              (and (memq window-system '(x w32 ns))
                   (not (member (x-get-resource "cursorBlink" "CursorBlink")
-                               '("off" "false")))))
+                               '("no" "off" "false" "0")))))
     (setq no-blinking-cursor t))
 
   ;; Re-evaluate predefined variables whose initial value depends on
@@ -1152,38 +1147,6 @@ the `--debug-init' option to view a complete error backtrace."
                                            (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.
@@ -1281,6 +1244,29 @@ the `--debug-init' option to view a complete error backtrace."
       (with-no-warnings
        (emacs-session-restore x-session-previous-id))))
 
+(defun x-apply-session-resources ()
+  "Apply X resources which specify initial values for Emacs variables.
+This is called from a window-system initialization function, such
+as `x-initialize-window-system' for X, either at startup (prior
+to reading the init file), or afterwards when the user first
+opens a graphical frame.
+
+This can set the values of `menu-bar-mode', `tool-bar-mode', and
+`no-blinking-cursor', as well as the `cursor' face.  Changed
+settings will be marked as \"CHANGED outside of Customize\"."
+  (let ((no-vals  '("no" "off" "false" "0"))
+       (settings '(("menuBar" "MenuBar" menu-bar-mode nil)
+                   ("toolBar" "ToolBar" tool-bar-mode nil)
+                   ("cursorBlink" "CursorBlink" no-blinking-cursor t))))
+    (dolist (x settings)
+      (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals)
+         (set (nth 2 x) (nth 3 x)))))
+  (let ((color (x-get-resource "cursorColor" "Foreground")))
+    (when color
+      (put 'cursor 'theme-face
+          `((changed ((t :background ,color)))))
+      (put 'cursor 'face-modified t))))
+
 (defcustom initial-scratch-message (purecopy "\
 ;; This buffer is for notes you don't want to save, and for Lisp evaluation.
 ;; If you want to create a file, visit that file with C-x C-f,
@@ -1505,7 +1491,8 @@ a face or button specification."
                                   (if (image-type-available-p 'xpm)
                                       "splash.xpm"
                                     "splash.pbm"))
-                                 ((image-type-available-p 'svg)
+                                 ((or (image-type-available-p 'svg)
+                                      (image-type-available-p 'imagemagick))
                                   "splash.svg")
                                  ((image-type-available-p 'png)
                                   "splash.png")
@@ -2076,6 +2063,7 @@ A fancy display is used on graphic displays, normal otherwise."
 (defalias 'display-splash-screen 'display-startup-screen)
 
 (defun command-line-1 (args-left)
+  "A subroutine of `command-line'."
   (display-startup-echo-area-message)
   (when (and pure-space-overflow
             (not noninteractive))
@@ -2330,6 +2318,7 @@ A fancy display is used on graphic displays, normal otherwise."
     (if (or inhibit-startup-screen
            initial-buffer-choice
            noninteractive
+            (daemonp)
            inhibit-x-resources)
 
        ;; Not displaying a startup screen.  If 3 or more files
@@ -2372,9 +2361,7 @@ A fancy display is used on graphic displays, normal otherwise."
       ;; (with-no-warnings
       ;;       (setq menubar-bindings-done t))
 
-      (if (> file-count 0)
-         (display-startup-screen t)
-       (display-startup-screen nil)))))
+      (display-startup-screen (> file-count 0)))))
 
 (defun command-line-normalize-file-name (file)
   "Collapse multiple slashes to one, to handle non-Emacs file names."