]> code.delx.au - gnu-emacs/blobdiff - lisp/startup.el
lisp/startup.el (argi): Declare as global variable (bug#9275).
[gnu-emacs] / lisp / startup.el
index ebfed7027359dc2e9f756b9b770b80cdd608bec9..0dee969fb5abbce40b4cd5878c1399afc2fc6314 100644 (file)
@@ -41,8 +41,9 @@
 (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 or
-directory using `find-file'.  If t, open the `*scratch*' buffer."
+startup screen.  If the value is string, visit the specified file
+or directory using `find-file'.  If t, open the `*scratch*'
+buffer."
   :type '(choice
          (const     :tag "Startup screen" nil)
          (directory :tag "Directory" :value "~/")
@@ -104,6 +105,11 @@ This is a convenience alias, so that one can write \(pop argv\)
 inside of --eval command line arguments in order to access
 following arguments.")
 
+(with-no-warnings
+  ;; FIXME: Bad name for a dynamically bound variable
+  (defvar argi nil
+    "Current command-line argument."))
+
 (defvar command-line-functions nil    ;; lrs 7/31/89
   "List of functions to process unrecognized command-line arguments.
 Each function should access the dynamically bound variables
@@ -906,7 +912,8 @@ opening the first frame (e.g. open a connection to an X server).")
       ;; spec, but mark it as changed outside of Customize.
       (let ((color (x-get-resource "cursorColor" "CursorColor")))
        (when color
-         (face-spec-set 'cursor `((t (:background ,color))))
+         (put 'cursor 'theme-face
+              `((changed ((t :background ,color)))))
          (put 'cursor 'face-modified t)))))
     (frame-initialize))
 
@@ -1026,10 +1033,9 @@ opening the first frame (e.g. open a connection to an X server).")
                              "~/.emacs")
                             ((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
                              ;; Also support _emacs for compatibility, but warn about it.
-                             (display-warning
-                              'initialization
-                              "`_emacs' init file is deprecated, please use `.emacs'"
-                              :warning)
+                             (push '(initialization
+                                     "`_emacs' init file is deprecated, please use `.emacs'")
+                                   delayed-warnings-list)
                              "~/_emacs")
                             (t ;; But default to .emacs if _emacs does not exist.
                              "~/.emacs"))))
@@ -1096,7 +1102,8 @@ the `--debug-init' option to view a complete error backtrace."
                      user-init-file
                      (get (car error) 'error-message)
                      (if (cdr error) ": " "")
-                     (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", "))
+                     (mapconcat (lambda (s) (prin1-to-string s t))
+                                 (cdr error) ", "))
              :warning)
             (setq init-file-had-error t))))
 
@@ -1292,25 +1299,25 @@ If this is nil, no message will be displayed."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defconst fancy-startup-text
-  '((:face (variable-pitch (:foreground "red"))
+  `((:face (variable-pitch font-lock-comment-face)
      "Welcome to "
      :link ("GNU Emacs"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+           ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
            "Browse http://www.gnu.org/software/emacs/")
      ", one component of the "
      :link
-     (lambda ()
+     ,(lambda ()
        (if (eq system-type 'gnu/linux)
-          '("GNU/Linux"
-            (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
+            `("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))
+          `("GNU" ,(lambda (_button) (describe-gnu-project))
           "Display info on the GNU project")))
      " operating system.\n\n"
      :face variable-pitch
-     :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+     :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
      "\tLearn basic keystroke commands"
-     (lambda ()
+     ,(lambda ()
        (let* ((en "TUTORIAL")
              (tut (or (get-language-info current-language-environment
                                          'tutorial)
@@ -1328,19 +1335,20 @@ If this is nil, no message will be displayed."
           (concat " (" title ")"))))
      "\n"
      :link ("Emacs Guided Tour"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+           ,(lambda (_button)
+               (browse-url "http://www.gnu.org/software/emacs/tour/"))
            "Browse http://www.gnu.org/software/emacs/tour/")
      "\tOverview of Emacs features at gnu.org\n"
-     :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
+     :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
      "\tView the Emacs manual using Info\n"
-     :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
+     :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
      :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
-     :link ("Copying Conditions" (lambda (button) (describe-copying)))
+     :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
      "\tConditions for redistributing and changing Emacs\n"
-     :link ("Ordering Manuals" (lambda (button) (view-order-manuals)))
+     :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
      "\tPurchasing printed copies of manuals\n"
      "\n"))
   "A list of texts to show in the middle part of splash screens.
@@ -1348,61 +1356,58 @@ Each element in the list should be a list of strings or pairs
 `:face FACE', like `fancy-splash-insert' accepts them.")
 
 (defconst fancy-about-text
-  '((:face (variable-pitch (:foreground "red"))
+  `((:face (variable-pitch font-lock-comment-face)
      "This is "
      :link ("GNU Emacs"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+           ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
            "Browse http://www.gnu.org/software/emacs/")
      ", one component of the "
      :link
-     (lambda ()
+     ,(lambda ()
        (if (eq system-type 'gnu/linux)
-          '("GNU/Linux"
-            (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
+          `("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))
+        `("GNU" ,(lambda (_button) (describe-gnu-project))
           "Display info on the GNU project.")))
      " operating system.\n"
-     :face (lambda ()
-            (list 'variable-pitch
-                  (list :foreground
-                        (if (eq (frame-parameter nil 'background-mode) 'dark)
-                            "cyan" "darkblue"))))
+     :face (variable-pitch font-lock-builtin-face)
      "\n"
-     (lambda () (emacs-version))
+     ,(lambda () (emacs-version))
      "\n"
      :face (variable-pitch (:height 0.8))
-     (lambda () emacs-copyright)
+     ,(lambda () emacs-copyright)
      "\n\n"
      :face variable-pitch
      :link ("Authors"
-           (lambda (button)
+           ,(lambda (_button)
              (view-file (expand-file-name "AUTHORS" data-directory))
              (goto-char (point-min))))
      "\tMany people have contributed code included in GNU Emacs\n"
      :link ("Contributing"
-           (lambda (button)
+           ,(lambda (_button)
              (view-file (expand-file-name "CONTRIBUTE" data-directory))
              (goto-char (point-min))))
      "\tHow to contribute improvements to Emacs\n"
      "\n"
-     :link ("GNU and Freedom" (lambda (button) (describe-gnu-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)))
+     :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
      :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
-     :link ("Copying Conditions" (lambda (button) (describe-copying)))
+     :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
      "\tConditions for redistributing and changing Emacs\n"
-     :link ("Getting New Versions" (lambda (button) (describe-distribution)))
+     :link ("Getting New Versions" ,(lambda (_button) (describe-distribution)))
      "\tHow to obtain the latest version of Emacs\n"
-     :link ("Ordering Manuals" (lambda (button) (view-order-manuals)))
+     :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
      "\tBuying printed manuals from the FSF\n"
      "\n"
-     :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+     :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
      "\tLearn basic Emacs keystroke commands"
-     (lambda ()
+     ,(lambda ()
        (let* ((en "TUTORIAL")
              (tut (or (get-language-info current-language-environment
                                          'tutorial)
@@ -1420,10 +1425,10 @@ Each element in the list should be a list of strings or pairs
           (concat " (" title ")"))))
      "\n"
      :link ("Emacs Guided Tour"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+           ,(lambda (_button)
+               (browse-url "http://www.gnu.org/software/emacs/tour/"))
            "Browse http://www.gnu.org/software/emacs/tour/")
-     "\tSee an overview of Emacs features at gnu.org"
-     ))
+     "\tSee an overview of Emacs features at gnu.org"))
   "A list of texts to show in the middle part of the About screen.
 Each element in the list should be a list of strings or pairs
 `:face FACE', like `fancy-splash-insert' accepts them.")
@@ -1533,93 +1538,91 @@ a face or button specification."
 
 (defun fancy-startup-tail (&optional concise)
   "Insert the tail part of the splash screen into the current buffer."
-  (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
-               "cyan" "darkblue")))
-    (unless concise
-      (fancy-splash-insert
-       :face 'variable-pitch
-       "\nTo start...     "
-       :link '("Open a File"
-              (lambda (_button) (call-interactively 'find-file))
-              "Specify a new file's name, to edit the file")
-       "     "
-       :link '("Open Home Directory"
-              (lambda (_button) (dired "~"))
-              "Open your home directory, to operate on its files")
-       "     "
-       :link '("Customize Startup"
-              (lambda (_button) (customize-group 'initialization))
-              "Change initialization settings including this screen")
-       "\n"))
+  (unless concise
+    (fancy-splash-insert
+     :face 'variable-pitch
+     "\nTo start...     "
+     :link `("Open a File"
+            ,(lambda (_button) (call-interactively 'find-file))
+            "Specify a new file's name, to edit the file")
+     "     "
+     :link `("Open Home Directory"
+            ,(lambda (_button) (dired "~"))
+            "Open your home directory, to operate on its files")
+     "     "
+     :link `("Customize Startup"
+            ,(lambda (_button) (customize-group 'initialization))
+            "Change initialization settings including this screen")
+     "\n"))
+  (fancy-splash-insert
+   :face 'variable-pitch "To quit a partially entered command, type "
+   :face 'default "Control-g"
+   :face 'variable-pitch ".\n")
+  (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face)
+                      "\nThis is "
+                      (emacs-version)
+                      "\n"
+                      :face '(variable-pitch (:height 0.8))
+                      emacs-copyright
+                      "\n")
+  (and auto-save-list-file-prefix
+       ;; Don't signal an error if the
+       ;; directory for auto-save-list files
+       ;; does not yet exist.
+       (file-directory-p (file-name-directory
+                         auto-save-list-file-prefix))
+       (directory-files
+       (file-name-directory auto-save-list-file-prefix)
+       nil
+       (concat "\\`"
+               (regexp-quote (file-name-nondirectory
+                              auto-save-list-file-prefix)))
+       t)
+       (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
+                           "\nIf an Emacs session crashed recently, "
+                           "type "
+                           :face '(fixed-pitch font-lock-comment-face)
+                           "Meta-x recover-session RET"
+                           :face '(variable-pitch font-lock-comment-face)
+                           "\nto recover"
+                           " the files you were editing."))
+
+  (when concise
     (fancy-splash-insert
-     :face 'variable-pitch "To quit a partially entered command, type "
-     :face 'default "Control-g"
-     :face 'variable-pitch ".\n")
-    (fancy-splash-insert :face `(variable-pitch (:foreground ,fg))
-                        "\nThis is "
-                        (emacs-version)
-                        "\n"
-                        :face '(variable-pitch (:height 0.8))
-                        emacs-copyright
-                        "\n")
-    (and auto-save-list-file-prefix
-        ;; Don't signal an error if the
-        ;; directory for auto-save-list files
-        ;; does not yet exist.
-        (file-directory-p (file-name-directory
-                           auto-save-list-file-prefix))
-        (directory-files
-         (file-name-directory auto-save-list-file-prefix)
-         nil
-         (concat "\\`"
-                 (regexp-quote (file-name-nondirectory
-                                auto-save-list-file-prefix)))
-         t)
-        (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"))
-                             "\nto recover"
-                             " the files you were editing."))
-
-    (when concise
-      (fancy-splash-insert
-       :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 "checked.xpm"
-                                    nil nil :ascent 'center))
-             (unchecked (create-image "unchecked.xpm"
-                                      nil nil :ascent 'center)))
-         (insert-button
-          " "
-          :on-glyph checked
-          :off-glyph unchecked
-          'checked nil 'display unchecked 'follow-link t
-          'action (lambda (button)
-                    (if (overlay-get button 'checked)
-                        (progn (overlay-put button 'checked nil)
-                               (overlay-put button 'display
-                                            (overlay-get button :off-glyph))
-                               (setq startup-screen-inhibit-startup-screen
-                                     nil))
-                      (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))
-                            " Never show it again.")))))
+     :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 "checked.xpm"
+                                  nil nil :ascent 'center))
+           (unchecked (create-image "unchecked.xpm"
+                                    nil nil :ascent 'center)))
+       (insert-button
+        " "
+        :on-glyph checked
+        :off-glyph unchecked
+        'checked nil 'display unchecked 'follow-link t
+        'action (lambda (button)
+                  (if (overlay-get button 'checked)
+                      (progn (overlay-put button 'checked nil)
+                             (overlay-put button 'display
+                                          (overlay-get button :off-glyph))
+                             (setq startup-screen-inhibit-startup-screen
+                                   nil))
+                    (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))
+                          " Never show it again."))))
 
 (defun exit-splash-screen ()
   "Stop displaying the splash screen buffer."
@@ -1672,11 +1675,7 @@ splash screen in another window."
     (save-selected-window
       (select-frame frame)
       (switch-to-buffer "*About GNU Emacs*")
-      (setq buffer-undo-list t
-           mode-line-format
-           (concat "----"
-                   (propertize "%b" 'face 'mode-line-buffer-id)
-                   "%-"))
+      (setq buffer-undo-list t)
       (let ((inhibit-read-only t))
        (erase-buffer)
        (if pure-space-overflow
@@ -1739,9 +1738,6 @@ splash screen in another window."
       (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)
-              (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
 
       (if pure-space-overflow
          (insert pure-space-overflow-message))
@@ -1938,36 +1934,36 @@ If you have no Meta key, you may instead type ESC followed by the character.)")
         "
 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
        (insert-button "full details"
-                      'action (lambda (button) (describe-no-warranty))
+                      'action (lambda (_button) (describe-no-warranty))
                       'follow-link t)
        (insert ".
 Emacs is Free Software--Free as in Freedom--so you can redistribute copies
 of Emacs and modify it; type C-h C-c to see ")
        (insert-button "the conditions"
-                      'action (lambda (button) (describe-copying))
+                      'action (lambda (_button) (describe-copying))
                       'follow-link t)
        (insert ".
 Type C-h C-d for information on ")
        (insert-button "getting the latest version"
-                      'action (lambda (button) (describe-distribution))
+                      'action (lambda (_button) (describe-distribution))
                       'follow-link t)
        (insert "."))
     (insert (substitute-command-keys
             "
 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
     (insert-button "full details"
-                  'action (lambda (button) (describe-no-warranty))
+                  'action (lambda (_button) (describe-no-warranty))
                   'follow-link t)
     (insert (substitute-command-keys ".
 Emacs is Free Software--Free as in Freedom--so you can redistribute copies
 of Emacs and modify it; type \\[describe-copying] to see "))
     (insert-button "the conditions"
-                  'action (lambda (button) (describe-copying))
+                  'action (lambda (_button) (describe-copying))
                   'follow-link t)
     (insert (substitute-command-keys".
 Type \\[describe-distribution] for information on "))
     (insert-button "getting the latest version"
-                  'action (lambda (button) (describe-distribution))
+                  'action (lambda (_button) (describe-distribution))
                   'follow-link t)
     (insert ".")))