*** empty log message ***
[bpt/emacs.git] / lisp / startup.el
index b2e03e2..0a09199 100644 (file)
@@ -473,6 +473,28 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
        ;; ...-frame-alist.
        (if (fboundp 'frame-notice-user-settings)
            (frame-notice-user-settings))
+       (if (fboundp 'frame-set-background-mode)
+           ;; Set the faces for the initial background mode even if
+           ;; frame-notice-user-settings didn't (such as on a tty).
+           ;; frame-set-background-mode is idempotent, so it won't
+           ;; cause any harm if it's already been done.
+           (let ((frame-background-mode frame-background-mode)
+                 (frame (selected-frame))
+                 term)
+             (when (and (null window-system)
+                        ;; Don't override a possibly customized value.
+                        (null frame-background-mode)
+                        ;; Don't override user specifications.
+                        (null (frame-parameter frame 'reverse))
+                        (let ((bg (frame-parameter frame 'background-color)))
+                          (or (null bg)
+                              (member bg '(unspecified "unspecified-bg")))))
+               (setq term (getenv "TERM"))
+               (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+                                 term)
+                   (setq frame-background-mode 'light)))
+             (frame-set-background-mode (selected-frame))))
+
        ;; Now we know the user's default font, so add it to the menu.
        (if (fboundp 'font-menu-add-default)
            (font-menu-add-default))
@@ -497,6 +519,79 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
       (setq submap (cdr submap))))
     (setq define-key-rebound-commands t))
 
+;; Command-line options supported by tty's:
+(defconst tty-long-option-alist
+  '(("--name" .                "-name")
+    ("--title" .       "-T")
+    ("--reverse-video" . "-reverse")
+    ("--foreground-color" . "-fg")
+    ("--background-color" . "-bg")))
+
+;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.
+(defun tty-handle-args (args)
+  (let ((rest nil))
+    (message "%s" args)
+    (while (and args
+               (not (equal (car args) "--")))
+      (let* ((this (car args))
+            (orig-this this)
+            completion argval)
+       (setq args (cdr args))
+       ;; Check for long options with attached arguments
+       ;; and separate out the attached option argument into argval.
+       (if (string-match "^--[^=]*=" this)
+           (setq argval (substring this (match-end 0))
+                 this (substring this 0 (1- (match-end 0)))))
+       (when (string-match "^--" this)
+         (setq completion (try-completion this tty-long-option-alist))
+         (if (eq completion t)
+             ;; Exact match for long option.
+             (setq this (cdr (assoc this tty-long-option-alist)))
+           (if (stringp completion)
+               (let ((elt (assoc completion tty-long-option-alist)))
+                 ;; Check for abbreviated long option.
+                 (or elt
+                     (error "Option `%s' is ambiguous" this))
+                 (setq this (cdr elt)))
+             ;; Check for a short option.
+             (setq argval nil this orig-this))))
+       (cond ((or (string= this "-fg") (string= this "-foreground"))
+              (or argval (setq argval (car args) args (cdr args)))
+              (setq default-frame-alist
+                    (cons (cons 'foreground-color argval)
+                          default-frame-alist)))
+             ((or (string= this "-bg") (string= this "-background"))
+              (or argval (setq argval (car args) args (cdr args)))
+              (setq default-frame-alist
+                    (cons (cons 'background-color argval)
+                          default-frame-alist)))
+             ((or (string= this "-T") (string= this "-name"))
+              (or argval (setq argval (car args) args (cdr args)))
+              (setq default-frame-alist
+                    (cons
+                     (cons 'title
+                           (if (stringp argval)
+                               argval
+                             (let ((case-fold-search t)
+                                   i)
+                               (setq argval (invocation-name))
+
+                               ;; Change any . or * characters in name to
+                               ;; hyphens, so as to emulate behavior on X.
+                               (while
+                                   (setq i (string-match "[.*]" argval))
+                                 (aset argval i ?-))
+                               argval)))
+                     default-frame-alist)))
+             ((or (string= this "-r")
+                  (string= this "-rv")
+                  (string= this "-reverse"))
+              (setq default-frame-alist
+                    (cons '(reverse . t)
+                          default-frame-alist)))
+             (t (setq rest (cons this rest))))))
+      (nreverse rest)))
+
 (defun command-line ()
   (setq command-line-default-directory default-directory)
 
@@ -573,6 +668,11 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
      (setq window-system nil)
      (kill-emacs)))
 
+  ;; Windowed displays do this inside their *-win.el.
+  (when (and (not (display-graphic-p))
+            (not noninteractive))
+    (setq command-line-args (tty-handle-args command-line-args)))
+
   (let ((done nil)
        (args (cdr command-line-args)))
 
@@ -665,6 +765,23 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
     (setq-default blink-cursor t)
     (blink-cursor-mode 1))
 
+  ;; Register default TTY colors for the case the terminal hasn't a
+  ;; terminal init file.
+  (or (memq window-system '(x w32))
+      (not (tty-display-color-p))
+      (let* ((colors (cond ((eq window-system 'pc)
+                            msdos-color-values)
+                           ((eq system-type 'windows-nt)
+                            w32-tty-standard-colors)
+                           (t tty-standard-colors)))
+            (color (car colors)))
+       (while colors
+         (tty-color-define (car color) (cadr color) (cddr color))
+         (setq colors (cdr colors) color (car colors)))
+       ;; Modifying color mappings means realized faces don't
+       ;; use the right colors, so clear them.
+       (clear-face-cache)))
+
   (run-hooks 'before-init-hook)
 
   ;; Run the site-start library if it exists.  The point of this file is
@@ -796,23 +913,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
        (set-buffer "*scratch*")
        (if (eq major-mode 'fundamental-mode)
            (funcall initial-major-mode))))
-
-  ;; Register default TTY colors for the case the terminal hasn't a
-  ;; terminal init file.
-  (or (memq window-system '(x w32))
-      (not (tty-display-color-p))
-      (let* ((colors (cond ((eq window-system 'pc)
-                            msdos-color-values)
-                           ((eq system-type 'windows-nt)
-                            w32-tty-standard-colors)
-                           (t tty-standard-colors)))
-            (color (car colors)))
-       (while colors
-         (tty-color-define (car color) (cadr color) (cddr color))
-         (setq colors (cdr colors) color (car colors)))
-       ;; Modifying color mappings means realized faces don't
-       ;; use the right colors, so clear them.
-       (clear-face-cache)))
   
   ;; Load library for our terminal type.
   ;; User init file can set term-file-prefix to nil to prevent this.
@@ -1014,13 +1114,14 @@ where FACE is a valid face specification, as it can be used with
          (define-key map [mouse-movement] 'ignore)
          (setq cursor-type nil
                display-busy-cursor nil
+               buffer-undo-list t
                mode-line-format
                (propertize "---- %b %-" 'face '(:weight bold))
-               timer (run-with-timer 0 5 #'fancy-splash-screens-1
+               timer (run-with-timer 0 fancy-splash-delay
+                                     #'fancy-splash-screens-1
                                      splash-buffer))
          (recursive-edit))
       (cancel-timer timer)
-      (remove-hook 'pre-command-hook 'fancy-splash-pre-command)
       (setq display-busy-cursor old-busy-cursor)
       (kill-buffer splash-buffer))))