/[emacs]/emacs/lisp/startup.el
ViewVC logotype

Diff of /emacs/lisp/startup.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.298 by walters, Mon May 27 02:00:54 2002 UTC revision 1.298.2.1 by miles, Fri Apr 4 06:20:11 2003 UTC
# Line 241  This is normally copied from `default-di Line 241  This is normally copied from `default-di
241      ("--cursor-color" 1 x-handle-switch cursor-color)      ("--cursor-color" 1 x-handle-switch cursor-color)
242      ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)      ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
243      ("--line-spacing" 1 x-handle-numeric-switch line-spacing)      ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
244      ("--border-color" 1 x-handle-switch border-width)      ("--border-color" 1 x-handle-switch border-color)
245      ("--smid" 1 x-handle-smid))      ("--smid" 1 x-handle-smid))
246    "Alist of X Windows options.    "Alist of X Windows options.
247  Each element has the form  Each element has the form
# Line 270  It also follows `emacs-startup-hook'.  T Line 270  It also follows `emacs-startup-hook'.  T
270  so as to override the definitions made by the terminal-specific file.  so as to override the definitions made by the terminal-specific file.
271  Emacs never sets this variable itself.")  Emacs never sets this variable itself.")
272    
273    (defvar inhibit-startup-hooks nil
274      "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
275    This is because we already did so.")
276    
277  (defvar keyboard-type nil  (defvar keyboard-type nil
278    "The brand of keyboard you are using.    "The brand of keyboard you are using.
279  This variable is used to define  This variable is used to define
# Line 326  is less convenient." Line 330  is less convenient."
330    :type '(choice (const nil) string)    :type '(choice (const nil) string)
331    :group 'mail)    :group 'mail)
332    
333  (defcustom user-mail-address nil  (defcustom user-mail-address (if command-line-processed
334                                     (concat (user-login-name) "@"
335                                             (or mail-host-address
336                                                 (system-name)))
337                                   ;; Empty string means "not set yet".
338                                   "")
339    "*Full mailing address of this user.    "*Full mailing address of this user.
340  This is initialized based on `mail-host-address',  This is initialized based on `mail-host-address',
341  after your init file is read, in case it sets `mail-host-address'."  after your init file is read, in case it sets `mail-host-address'."
# Line 361  from being initialized." Line 370  from being initialized."
370  More precisely, this uses only the subdirectories whose names  More precisely, this uses only the subdirectories whose names
371  start with letters or digits; it excludes any subdirectory named `RCS'  start with letters or digits; it excludes any subdirectory named `RCS'
372  or `CVS', and any subdirectory that contains a file named `.nosearch'."  or `CVS', and any subdirectory that contains a file named `.nosearch'."
373    (let (dirs    (let (dirs
374          attrs          attrs
375          (pending (list default-directory)))          (pending (list default-directory)))
376      ;; This loop does a breadth-first tree walk on DIR's subtree,      ;; This loop does a breadth-first tree walk on DIR's subtree,
# Line 424  or `CVS', and any subdirectory that cont Line 433  or `CVS', and any subdirectory that cont
433        (save-excursion        (save-excursion
434          (set-buffer (get-buffer "*Messages*"))          (set-buffer (get-buffer "*Messages*"))
435          (setq default-directory dir)))          (setq default-directory dir)))
436        ;; `user-full-name' is now known; reset its standard-value here.
437        (put 'user-full-name 'standard-value
438             (list (default-value 'user-full-name)))
439      ;; For root, preserve owner and group when editing files.      ;; For root, preserve owner and group when editing files.
440      (if (equal (user-uid) 0)      (if (equal (user-uid) 0)
441          (setq backup-by-copying-when-mismatch t))          (setq backup-by-copying-when-mismatch t))
# Line 477  or `CVS', and any subdirectory that cont Line 489  or `CVS', and any subdirectory that cont
489                                (make-directory                                (make-directory
490                                 (file-name-directory auto-save-list-file-prefix)                                 (file-name-directory auto-save-list-file-prefix)
491                                 t)                                 t)
492                                (concat                                (concat
493                                 (make-temp-name                                 (make-temp-name
494                                  (expand-file-name                                  (expand-file-name
495                                   auto-save-list-file-prefix))                                   auto-save-list-file-prefix))
# Line 488  or `CVS', and any subdirectory that cont Line 500  or `CVS', and any subdirectory that cont
500                                         auto-save-list-file-prefix                                         auto-save-list-file-prefix
501                                         (emacs-pid)                                         (emacs-pid)
502                                         (system-name))))))))                                         (system-name))))))))
503          (run-hooks 'emacs-startup-hook)          (unless inhibit-startup-hooks
504          (and term-setup-hook            (run-hooks 'emacs-startup-hook)
505               (run-hooks 'term-setup-hook))            (and term-setup-hook
506                   (run-hooks 'term-setup-hook)))
507    
508          ;; Don't do this if we failed to create the initial frame,          ;; Don't do this if we failed to create the initial frame,
509          ;; for instance due to a dense colormap.          ;; for instance due to a dense colormap.
# Line 567  or `CVS', and any subdirectory that cont Line 580  or `CVS', and any subdirectory that cont
580  (defvar tool-bar-originally-present nil  (defvar tool-bar-originally-present nil
581    "Non-nil if tool-bars are present before user and site init files are read.")    "Non-nil if tool-bars are present before user and site init files are read.")
582    
583  ;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.  ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
584  (defun tty-handle-args (args)  (defun tty-handle-args (args)
585    (let ((rest nil))    (let (rest)
586      (message "%s" args)      (message "%s" args)
587      (while (and args      (while (and args
588                  (not (equal (car args) "--")))                  (not (equal (car args) "--")))
589        (let* ((this (car args))        (let* ((argi (pop args))
590               (orig-this this)               (orig-argi argi)
591               completion argval)               argval completion)
         (setq args (cdr args))  
592          ;; Check for long options with attached arguments          ;; Check for long options with attached arguments
593          ;; and separate out the attached option argument into argval.          ;; and separate out the attached option argument into argval.
594          (if (string-match "^--[^=]*=" this)          (when (string-match "^\\(--[^=]*\\)=" argi)
595              (setq argval (substring this (match-end 0))            (setq argval (substring argi (match-end 0))
596                    this (substring this 0 (1- (match-end 0)))))                  argi (match-string 1 argi)))
597          (when (string-match "^--" this)          (when (string-match "^--" argi)
598            (setq completion (try-completion this tty-long-option-alist))            (setq completion (try-completion argi tty-long-option-alist))
599            (if (eq completion t)            (if (eq completion t)
600                ;; Exact match for long option.                ;; Exact match for long option.
601                (setq this (cdr (assoc this tty-long-option-alist)))                (setq argi (cdr (assoc argi tty-long-option-alist)))
602              (if (stringp completion)              (if (stringp completion)
603                  (let ((elt (assoc completion tty-long-option-alist)))                  (let ((elt (assoc completion tty-long-option-alist)))
604                    ;; Check for abbreviated long option.                    ;; Check for abbreviated long option.
605                    (or elt                    (or elt
606                        (error "Option `%s' is ambiguous" this))                        (error "Option `%s' is ambiguous" argi))
607                    (setq this (cdr elt)))                    (setq argi (cdr elt)))
608                ;; Check for a short option.                ;; Check for a short option.
609                (setq argval nil this orig-this))))                (setq argval nil
610          (cond ((or (string= this "-fg") (string= this "-foreground"))                      argi orig-argi))))
611                 (or argval (setq argval (car args) args (cdr args)))          (cond ((member argi '("-fg" "-foreground"))
612                 (setq default-frame-alist                 (push (cons 'foreground-color (or argval (pop args)))
613                       (cons (cons 'foreground-color argval)                       default-frame-alist))
614                             default-frame-alist)))                ((member argi '("-bg" "-background"))
615                ((or (string= this "-bg") (string= this "-background"))                 (push (cons 'background-color (or argval (pop args)))
616                 (or argval (setq argval (car args) args (cdr args)))                       default-frame-alist))
617                 (setq default-frame-alist                ((member argi '("-T" "-name"))
618                       (cons (cons 'background-color argval)                 (unless argval (setq argval (pop args)))
619                             default-frame-alist)))                 (push (cons 'title
620                ((or (string= this "-T") (string= this "-name"))                             (if (stringp argval)
621                 (or argval (setq argval (car args) args (cdr args)))                                 argval
622                 (setq default-frame-alist                               (let ((case-fold-search t)
623                       (cons                                     i)
624                        (cons 'title                                 (setq argval (invocation-name))
625                              (if (stringp argval)  
626                                  argval                                 ;; Change any . or * characters in name to
627                                (let ((case-fold-search t)                                 ;; hyphens, so as to emulate behavior on X.
628                                      i)                                 (while
629                                  (setq argval (invocation-name))                                     (setq i (string-match "[.*]" argval))
630                                     (aset argval i ?-))
631                                  ;; Change any . or * characters in name to                                 argval)))
632                                  ;; hyphens, so as to emulate behavior on X.                       default-frame-alist))
633                                  (while                ((member argi '("-r" "-rv" "-reverse"))
634                                      (setq i (string-match "[.*]" argval))                 (push '(reverse . t)
635                                    (aset argval i ?-))                       default-frame-alist))
636                                  argval)))                ((equal argi "-color")
637                        default-frame-alist)))                 (unless argval (setq argval 8)) ; default --color means 8 ANSI colors
638                ((or (string= this "-r")                 (push (cons 'tty-color-mode
639                     (string= this "-rv")                             (cond
640                     (string= this "-reverse"))                              ((numberp argval) argval)
641                 (setq default-frame-alist                              ((string-match "-?[0-9]+" argval)
642                       (cons '(reverse . t)                               (string-to-number argval))
643                             default-frame-alist)))                              (t (intern argval))))
644                ((string= this "-color")                       default-frame-alist))
645                 (if (null argval)                (t
646                     (setq argval 8))     ; default --color means 8 ANSI colors                 (push argi rest)))))
647                 (setq default-frame-alist      (nreverse rest)))
                      (cons (cons 'tty-color-mode  
                                  (cond  
                                   ((numberp argval) argval)  
                                   ((string-match "-?[0-9]+" argval)  
                                    (string-to-number argval))  
                                   (t (intern argval))))  
                            default-frame-alist)))  
               (t (setq rest (cons this rest))))))  
       (nreverse rest)))  
648    
649  (defun command-line ()  (defun command-line ()
650    (setq command-line-default-directory default-directory)    (setq command-line-default-directory default-directory)
# Line 667  or `CVS', and any subdirectory that cont Line 670  or `CVS', and any subdirectory that cont
670    ;; See if we should import version-control from the environment variable.    ;; See if we should import version-control from the environment variable.
671    (let ((vc (getenv "VERSION_CONTROL")))    (let ((vc (getenv "VERSION_CONTROL")))
672      (cond ((eq vc nil))                 ;don't do anything if not set      (cond ((eq vc nil))                 ;don't do anything if not set
673            ((or (string= vc "t")            ((member vc '("t" "numbered"))
                (string= vc "numbered"))  
674             (setq version-control t))             (setq version-control t))
675            ((or (string= vc "nil")            ((member vc '("nil" "existing"))
                (string= vc "existing"))  
676             (setq version-control nil))             (setq version-control nil))
677            ((or (string= vc "never")            ((member vc '("never" "simple"))
                (string= vc "simple"))  
678             (setq version-control 'never))))             (setq version-control 'never))))
679    
680    ;;! This has been commented out; I currently find the behavior when    ;;! This has been commented out; I currently find the behavior when
# Line 687  or `CVS', and any subdirectory that cont Line 687  or `CVS', and any subdirectory that cont
687    ;; end-of-line formats that aren't native to this platform.    ;; end-of-line formats that aren't native to this platform.
688    (cond    (cond
689     ((memq system-type '(ms-dos windows-nt emx))     ((memq system-type '(ms-dos windows-nt emx))
690      (setq eol-mnemonic-unix "(Unix)")      (setq eol-mnemonic-unix "(Unix)"
691      (setq eol-mnemonic-mac  "(Mac)"))            eol-mnemonic-mac  "(Mac)"))
692     ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the     ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the
693     ;; abbreviated strings `/' and `:' set in coding.c for them.     ;; abbreviated strings `/' and `:' set in coding.c for them.
694     ((eq system-type 'macos)     ((eq system-type 'macos)
695      (setq eol-mnemonic-dos  "(DOS)"))      (setq eol-mnemonic-dos  "(DOS)"))
696     (t   ; this is for Unix/GNU/Linux systems     (t                                   ; this is for Unix/GNU/Linux systems
697      (setq eol-mnemonic-dos  "(DOS)")      (setq eol-mnemonic-dos  "(DOS)"
698      (setq eol-mnemonic-mac  "(Mac)")))            eol-mnemonic-mac  "(Mac)")))
699    
700    ;; Read window system's init file if using a window system.    ;; Read window system's init file if using a window system.
701    (condition-case error    (condition-case error
# Line 713  or `CVS', and any subdirectory that cont Line 713  or `CVS', and any subdirectory that cont
713            (apply 'concat (cdr error))            (apply 'concat (cdr error))
714          (if (memq 'file-error (get (car error) 'error-conditions))          (if (memq 'file-error (get (car error) 'error-conditions))
715              (format "%s: %s"              (format "%s: %s"
716                       (nth 1 error)                      (nth 1 error)
717                       (mapconcat (lambda (obj) (prin1-to-string obj t))                      (mapconcat (lambda (obj) (prin1-to-string obj t))
718                                  (cdr (cdr error)) ", "))                                 (cdr (cdr error)) ", "))
719            (format "%s: %s"            (format "%s: %s"
720                     (get (car error) 'error-message)                    (get (car error) 'error-message)
721                     (mapconcat (lambda (obj) (prin1-to-string obj t))                    (mapconcat (lambda (obj) (prin1-to-string obj t))
722                                (cdr error) ", "))))                               (cdr error) ", "))))
723        'external-debugging-output)        'external-debugging-output)
724       (terpri 'external-debugging-output)       (terpri 'external-debugging-output)
725       (setq window-system nil)       (setq window-system nil)
726       (kill-emacs)))       (kill-emacs)))
727    
728    ;; Windowed displays do this inside their *-win.el.    ;; Windowed displays do this inside their *-win.el.
729    (when (and (not (display-graphic-p))    (unless (or (display-graphic-p) noninteractive)
              (not noninteractive))  
730      (setq command-line-args (tty-handle-args command-line-args)))      (setq command-line-args (tty-handle-args command-line-args)))
731    
732    (set-locale-environment nil)    (set-locale-environment nil)
# Line 737  or `CVS', and any subdirectory that cont Line 736  or `CVS', and any subdirectory that cont
736      (while args      (while args
737        (setcar args        (setcar args
738                (decode-coding-string (car args) locale-coding-system t))                (decode-coding-string (car args) locale-coding-system t))
739        (setq args (cdr args))))        (pop args)))
740    
741    (let ((done nil)    (let ((done nil)
742          (args (cdr command-line-args)))          (args (cdr command-line-args)))
# Line 746  or `CVS', and any subdirectory that cont Line 745  or `CVS', and any subdirectory that cont
745      ;; either from the environment or from the options.      ;; either from the environment or from the options.
746      (setq init-file-user (if noninteractive nil (user-login-name)))      (setq init-file-user (if noninteractive nil (user-login-name)))
747      ;; If user has not done su, use current $HOME to find .emacs.      ;; If user has not done su, use current $HOME to find .emacs.
748      (and init-file-user (string= init-file-user (user-real-login-name))      (and init-file-user
749             (equal init-file-user (user-real-login-name))
750           (setq init-file-user ""))           (setq init-file-user ""))
751    
752      ;; Process the command-line args, and delete the arguments      ;; Process the command-line args, and delete the arguments
753      ;; processed.  This is consistent with the way main in emacs.c      ;; processed.  This is consistent with the way main in emacs.c
754      ;; does things.      ;; does things.
755      (while (and (not done) args)      (while (and (not done) args)
756        (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")        (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
757                          ("--debug-init") ("--iconic") ("--icon-type")))                           ("--debug-init") ("--iconic") ("--icon-type")))
758              (argi (pop args))               (argi (pop args))
759              (argval nil))               (orig-argi argi)
760                 argval)
761          ;; Handle --OPTION=VALUE format.          ;; Handle --OPTION=VALUE format.
762          (when (and (string-match "\\`--" argi)          (when (string-match "^\\(--[^=]*\\)=" argi)
                    (string-match "=" argi))  
763            (setq argval (substring argi (match-end 0))            (setq argval (substring argi (match-end 0))
764                  argi (substring argi 0 (match-beginning 0))))                  argi (match-string 1 argi)))
765          (unless (equal argi "--")          (unless (equal argi "--")
766            (let ((completion (try-completion argi longopts)))            (let ((completion (try-completion argi longopts)))
767              (if (eq completion t)              (if (eq completion t)
# Line 771  or `CVS', and any subdirectory that cont Line 771  or `CVS', and any subdirectory that cont
771                      (or elt                      (or elt
772                          (error "Option `%s' is ambiguous" argi))                          (error "Option `%s' is ambiguous" argi))
773                      (setq argi (substring (car elt) 1)))                      (setq argi (substring (car elt) 1)))
774                  (setq argval nil)))))                  (setq argval nil
775                          argi orig-argi)))))
776          (cond          (cond
777           ((member argi '("-q" "-no-init-file"))           ((member argi '("-q" "-no-init-file"))
778            (setq init-file-user nil))            (setq init-file-user nil))
779           ((member argi '("-u" "-user"))           ((member argi '("-u" "-user"))
780            (or argval            (setq init-file-user (or argval (pop args))
               (setq argval (pop args)))  
           (setq init-file-user argval  
781                  argval nil))                  argval nil))
782           ((string-equal argi "-no-site-file")           ((equal argi "-no-site-file")
783            (setq site-run-file nil))            (setq site-run-file nil))
784           ((string-equal argi "-debug-init")           ((equal argi "-debug-init")
785            (setq init-file-debug t))            (setq init-file-debug t))
786           ((string-equal argi "-iconic")           ((equal argi "-iconic")
787            (push '(visibility . icon) initial-frame-alist))            (push '(visibility . icon) initial-frame-alist))
788           ((or (string-equal argi "-icon-type")           ((member argi '("-icon-type" "-i" "-itype"))
               (string-equal argi "-i")  
               (string-equal argi "-itype"))  
789            (push '(icon-type . t) default-frame-alist))            (push '(icon-type . t) default-frame-alist))
790           ;; Push the popped arg back on the list of arguments.           ;; Push the popped arg back on the list of arguments.
791           (t (push argi args) (setq done t)))           (t
792              (push argi args)
793              (setq done t)))
794          ;; Was argval set but not used?          ;; Was argval set but not used?
795          (and argval          (and argval
796               (error "Option `%s' doesn't allow an argument" argi))))               (error "Option `%s' doesn't allow an argument" argi))))
797    
798      ;; Re-attach the program name to the front of the arg list.      ;; Re-attach the program name to the front of the arg list.
799      (and command-line-args (setcdr command-line-args args)))      (and command-line-args
800             (setcdr command-line-args args)))
801    
802    ;; Under X Windows, this creates the X frame and deletes the terminal frame.    ;; Under X Windows, this creates the X frame and deletes the terminal frame.
803    (when (fboundp 'frame-initialize)    (when (fboundp 'frame-initialize)
804      (frame-initialize))      (frame-initialize))
805    
806    ;; If frame was created with a menu bar, set menu-bar-mode on.    ;; If frame was created with a menu bar, set menu-bar-mode on.
807    (if (and (not noninteractive)    (unless (or noninteractive
808             (or (not (memq window-system '(x w32)))                (and (memq window-system '(x w32))
809                 (> (frame-parameter nil 'menu-bar-lines) 0)))                     (<= (frame-parameter nil 'menu-bar-lines) 0)))
810        (menu-bar-mode t))      (menu-bar-mode 1))
811    
812    ;; If frame was created with a tool bar, switch tool-bar-mode on.    ;; If frame was created with a tool bar, switch tool-bar-mode on.
813    (when (and (not noninteractive)    (unless (or noninteractive
814               (display-graphic-p)                (not (display-graphic-p))
815               (> (frame-parameter nil 'tool-bar-lines) 0))                (<= (frame-parameter nil 'tool-bar-lines) 0))
816      (tool-bar-mode 1))      (tool-bar-mode 1))
817    
818    ;; Can't do this init in defcustom because window-system isn't set.    ;; Can't do this init in defcustom because window-system isn't set.
819    (when (and (not noninteractive)    (unless (or noninteractive
820               (not (eq system-type 'ms-dos))                (eq system-type 'ms-dos)
821               (memq window-system '(x w32)))                (not (memq window-system '(x w32))))
822      (setq-default blink-cursor t)      (setq-default blink-cursor t)
823      (blink-cursor-mode 1))      (blink-cursor-mode 1))
824    
# Line 837  or `CVS', and any subdirectory that cont Line 837  or `CVS', and any subdirectory that cont
837        (setq-default normal-erase-is-backspace t)        (setq-default normal-erase-is-backspace t)
838        (normal-erase-is-backspace-mode 1)))        (normal-erase-is-backspace-mode 1)))
839    
840    (when (and (not noninteractive)    (unless (or noninteractive
841               (display-graphic-p)                (not (display-graphic-p))
842               (fboundp 'x-show-tip))                (not (fboundp 'x-show-tip)))
843      (setq-default tooltip-mode t)      (setq-default tooltip-mode t)
844      (tooltip-mode 1))      (tooltip-mode 1))
845    
846    ;; Register default TTY colors for the case the terminal hasn't a    ;; Register default TTY colors for the case the terminal hasn't a
847    ;; terminal init file.    ;; terminal init file.
848    (or (memq window-system '(x w32))    (unless (memq window-system '(x w32))
849        ;; We do this regardles of whether the terminal supports colors      ;; We do this regardles of whether the terminal supports colors
850        ;; or not, since they can switch that support on or off in      ;; or not, since they can switch that support on or off in
851        ;; mid-session by setting the tty-color-mode frame parameter.      ;; mid-session by setting the tty-color-mode frame parameter.
852        (tty-register-default-colors))      (tty-register-default-colors))
853    
854    ;; Record whether the tool-bar is present before the user and site    ;; Record whether the tool-bar is present before the user and site
855    ;; init files are processed.  frame-notice-user-settings uses this    ;; init files are processed.  frame-notice-user-settings uses this
# Line 859  or `CVS', and any subdirectory that cont Line 859  or `CVS', and any subdirectory that cont
859      (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)      (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
860                                (assq 'tool-bar-lines default-frame-alist))))                                (assq 'tool-bar-lines default-frame-alist))))
861        (setq tool-bar-originally-present        (setq tool-bar-originally-present
862              (not (or (null tool-bar-lines)              (and tool-bar-lines
863                       (null (cdr tool-bar-lines))                   (cdr tool-bar-lines)
864                       (eq 0 (cdr tool-bar-lines)))))))                   (not (eq 0 (cdr tool-bar-lines)))))))
865    
866    (let ((old-scalable-fonts-allowed scalable-fonts-allowed)    (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
867          (old-font-list-limit font-list-limit)          (old-font-list-limit font-list-limit)
# Line 872  or `CVS', and any subdirectory that cont Line 872  or `CVS', and any subdirectory that cont
872      ;; Run the site-start library if it exists.  The point of this file is      ;; Run the site-start library if it exists.  The point of this file is
873      ;; that it is run before .emacs.  There is no point in doing this after      ;; that it is run before .emacs.  There is no point in doing this after
874      ;; .emacs; that is useless.      ;; .emacs; that is useless.
875      (if site-run-file      (if site-run-file
876          (load site-run-file t t))          (load site-run-file t t))
877    
878      ;; Sites should not disable this.  Only individuals should disable      ;; Sites should not disable this.  Only individuals should disable
# Line 899  or `CVS', and any subdirectory that cont Line 899  or `CVS', and any subdirectory that cont
899                               (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")                               (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
900                                   "~/.emacs"                                   "~/.emacs"
901                                 "~/_emacs"))                                 "~/_emacs"))
902                              ((eq system-type 'vax-vms)                              ((eq system-type 'vax-vms)
903                               "sys$login:.emacs")                               "sys$login:.emacs")
904                              (t                              (t
905                               (concat "~" init-file-user "/.emacs")))))                               (concat "~" init-file-user "/.emacs")))))
# Line 907  or `CVS', and any subdirectory that cont Line 907  or `CVS', and any subdirectory that cont
907                        ;; into user-init-file.                        ;; into user-init-file.
908                        (setq user-init-file t)                        (setq user-init-file t)
909                        (load user-init-file-1 t t)                        (load user-init-file-1 t t)
910                          
911                        ;; If we did not find the user's init file,                        (when (eq user-init-file t)
912                        ;; set user-init-file conclusively to nil;                          ;; If we did not find ~/.emacs, try
913                        ;; don't let it be set from default.el.                          ;; ~/.emacs.d/.emacs.
914                        (if (eq user-init-file t)                          (let ((otherfile
915                            (setq user-init-file user-init-file-1))                                 (expand-file-name
916                                                          (file-name-nondirectory user-init-file-1)
917                                    (file-name-as-directory
918                                     (expand-file-name
919                                      ".emacs.d"
920                                      (file-name-directory user-init-file-1))))))
921                              (load otherfile t t)
922    
923                              ;; If we did not find the user's init file,
924                              ;; set user-init-file conclusively.
925                              ;; Don't let it be set from default.el.
926                              (when (eq user-init-file t)
927                                (setq user-init-file user-init-file-1))))
928    
929                        ;; If we loaded a compiled file, set                        ;; If we loaded a compiled file, set
930                        ;; `user-init-file' to the source version if that                        ;; `user-init-file' to the source version if that
931                        ;; exists.                        ;; exists.
# Line 931  or `CVS', and any subdirectory that cont Line 943  or `CVS', and any subdirectory that cont
943                                         source user-init-file)                                         source user-init-file)
944                                (sit-for 1))                                (sit-for 1))
945                              (setq user-init-file source))))                              (setq user-init-file source))))
946                          
947                        (or inhibit-default-init                        (when (stringp custom-file)
948                            (let ((inhibit-startup-message nil))                          (unless (assoc custom-file load-history)
949                              ;; Users are supposed to be told their rights.                            ;; If the .emacs file has set `custom-file' but hasn't
950                              ;; (Plus how to get help and how to undo.)                            ;; loaded the file yet, let's load it.
951                              ;; Don't you dare turn this off for anyone                            (load custom-file t t)))
952                              ;; except yourself.  
953                              (load "default" t t)))))))))                        (unless inhibit-default-init
954                            (let ((inhibit-startup-message nil))
955                              ;; Users are supposed to be told their rights.
956                              ;; (Plus how to get help and how to undo.)
957                              ;; Don't you dare turn this off for anyone
958                              ;; except yourself.
959                              (load "default" t t)))))))))
960          (if init-file-debug          (if init-file-debug
961              ;; Do this without a condition-case if the user wants to debug.              ;; Do this without a condition-case if the user wants to debug.
962              (funcall inner)              (funcall inner)
# Line 956  or `CVS', and any subdirectory that cont Line 974  or `CVS', and any subdirectory that cont
974                           (format "%s%s%s"                           (format "%s%s%s"
975                                   (get (car error) 'error-message)                                   (get (car error) 'error-message)
976                                   (if (cdr error) ": " "")                                   (if (cdr error) ": " "")
977                                   (mapconcat 'prin1-to-string (cdr error) ", "))                                   (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", "))
978                           "\n\n"                           "\n\n"
979                           "To ensure normal operation, you should investigate the cause\n"                           "To ensure normal operation, you should investigate and remove the\n"
980                           "of the error in your initialization file and remove it.  Start\n"                           "cause of the error in your initialization file.  Start Emacs with\n"
981                           "Emacs with the `--debug-init' option to view a complete error\n"                           "the `--debug-init' option to view a complete error backtrace.\n\n"))
                          "backtrace\n"))  
982                 (message "Error in init file: %s%s%s"                 (message "Error in init file: %s%s%s"
983                          (get (car error) 'error-message)                          (get (car error) 'error-message)
984                          (if (cdr error) ": " "")                          (if (cdr error) ": " "")
985                          (mapconcat 'prin1-to-string (cdr error) ", "))                          (mapconcat 'prin1-to-string (cdr error) ", "))
986                 (pop-to-buffer "*Messages*")                 (let ((pop-up-windows nil))
987                     (pop-to-buffer "*Messages*"))
988                 (setq init-file-had-error t)))))                 (setq init-file-had-error t)))))
989    
990          ;; If the user has a file of abbrevs, read it.          ;; If the user has a file of abbrevs, read it.
# Line 999  or `CVS', and any subdirectory that cont Line 1017  or `CVS', and any subdirectory that cont
1017          ;; originally done before unibyte was set and is sensitive to          ;; originally done before unibyte was set and is sensitive to
1018          ;; unibyte (display table, terminal coding system &c).          ;; unibyte (display table, terminal coding system &c).
1019          (set-language-environment current-language-environment)))          (set-language-environment current-language-environment)))
1020        
1021      ;; Do this here in case the init file sets mail-host-address.      ;; Do this here in case the init file sets mail-host-address.
1022      (or user-mail-address      (if (equal user-mail-address "")
1023          (setq user-mail-address (concat (user-login-name) "@"          (setq user-mail-address (concat (user-login-name) "@"
1024                                          (or mail-host-address                                          (or mail-host-address
1025                                              (system-name)))))                                              (system-name)))))
# Line 1013  or `CVS', and any subdirectory that cont Line 1031  or `CVS', and any subdirectory that cont
1031                   (eq font-list-limit old-font-list-limit)                   (eq font-list-limit old-font-list-limit)
1032                   (eq face-ignored-fonts old-face-ignored-fonts))                   (eq face-ignored-fonts old-face-ignored-fonts))
1033        (clear-face-cache)))        (clear-face-cache)))
1034        
1035    (run-hooks 'after-init-hook)    (run-hooks 'after-init-hook)
1036    
1037    ;; If *scratch* exists and init file didn't change its mode, initialize it.    ;; If *scratch* exists and init file didn't change its mode, initialize it.
1038    (if (get-buffer "*scratch*")    (if (get-buffer "*scratch*")
1039        (save-excursion        (with-current-buffer "*scratch*"
         (set-buffer "*scratch*")  
1040          (if (eq major-mode 'fundamental-mode)          (if (eq major-mode 'fundamental-mode)
1041              (funcall initial-major-mode))))              (funcall initial-major-mode))))
1042      
1043    ;; Load library for our terminal type.    ;; Load library for our terminal type.
1044    ;; User init file can set term-file-prefix to nil to prevent this.    ;; User init file can set term-file-prefix to nil to prevent this.
1045    (and term-file-prefix (not noninteractive) (not window-system)    (unless (or noninteractive
1046         (let ((term (getenv "TERM"))                window-system
1047               hyphend)                (null term-file-prefix))
1048           (while (and term      (let ((term (getenv "TERM"))
1049                       (not (load (concat term-file-prefix term) t t)))            hyphend)
1050             ;; Strip off last hyphen and what follows, then try again        (while (and term
1051             (if (setq hyphend (string-match "[-_][^-_]+$" term))                    (not (load (concat term-file-prefix term) t t)))
1052                 (setq term (substring term 0 hyphend))          ;; Strip off last hyphen and what follows, then try again
1053               (setq term nil)))))          (setq term
1054                  (if (setq hyphend (string-match "[-_][^-_]+$" term))
1055                      (substring term 0 hyphend)
1056                    nil)))))
1057    
1058      ;; Update the out-of-memory error message based on user's key bindings
1059      ;; for save-some-buffers.
1060      (setq memory-signal-data
1061            (list 'error
1062                  (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs")))
1063    
1064    ;; Process the remaining args.    ;; Process the remaining args.
1065    (command-line-1 (cdr command-line-args))    (command-line-1 (cdr command-line-args))
# Line 1043  or `CVS', and any subdirectory that cont Line 1069  or `CVS', and any subdirectory that cont
1069    
1070    ;; Run emacs-session-restore (session management) if started by    ;; Run emacs-session-restore (session management) if started by
1071    ;; the session manager and we have a session manager connection.    ;; the session manager and we have a session manager connection.
1072    (if (and (boundp 'x-session-previous-id) (stringp x-session-previous-id))    (if (and (boundp 'x-session-previous-id)
1073               (stringp x-session-previous-id))
1074        (emacs-session-restore x-session-previous-id)))        (emacs-session-restore x-session-previous-id)))
1075    
1076  (defcustom initial-scratch-message (purecopy "\  (defcustom initial-scratch-message (purecopy "\
# Line 1072  using the mouse.\n\n" Line 1099  using the mouse.\n\n"
1099             :face variable-pitch "\             :face variable-pitch "\
1100  Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently  Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently
1101  Emacs FAQ\tFrequently asked questions and answers  Emacs FAQ\tFrequently asked questions and answers
1102    Read the Emacs Manual\tView the Emacs manual using Info
1103  \(Non)Warranty\tGNU Emacs comes with "  \(Non)Warranty\tGNU Emacs comes with "
1104             :face (variable-pitch :slant oblique)             :face (variable-pitch :slant oblique)
1105             "ABSOLUTELY NO WARRANTY\n"             "ABSOLUTELY NO WARRANTY\n"
1106             :face variable-pitch             :face variable-pitch
1107             "\             "\
1108  Copying Conditions\tConditions for redistributing and changing Emacs  Copying Conditions\tConditions for redistributing and changing Emacs
1109  Ordering Manuals\tHow to order Emacs manuals from the Free Software Foundation\n")  More Manuals / Ordering Manuals       Buying printed manuals from the FSF\n")
1110    (:face variable-pitch    (:face variable-pitch
1111             "You can do basic editing with the menu bar and scroll bar \             "You can do basic editing with the menu bar and scroll bar \
1112  using the mouse.\n\n"  using the mouse.\n\n"
# Line 1090  Recover Session\tRecover files you were Line 1118  Recover Session\tRecover files you were
1118    
1119    
1120    
1121    
1122  "  "
1123             ))             ))
1124    "A list of texts to show in the middle part of splash screens.    "A list of texts to show in the middle part of splash screens.
# Line 1184  where FACE is a valid face specification Line 1213  where FACE is a valid face specification
1213            (insert-image img (propertize "xxx" 'help-echo help-echo            (insert-image img (propertize "xxx" 'help-echo help-echo
1214                                          'keymap map)))                                          'keymap map)))
1215          (insert "\n"))))          (insert "\n"))))
1216    (if (eq system-type 'gnu/linux)    (fancy-splash-insert
1217        (fancy-splash-insert     :face '(variable-pitch :foreground "red")
1218         :face '(variable-pitch :foreground "red")     (if (eq system-type 'gnu/linux)
1219         "GNU Emacs is one component of a Linux-based GNU system.")         "GNU Emacs is one component of the GNU/Linux operating system."
     (fancy-splash-insert  
      :face '(variable-pitch :foreground "red")  
1220       "GNU Emacs is one component of the GNU operating system."))       "GNU Emacs is one component of the GNU operating system."))
1221    (insert "\n")    (insert "\n")
1222    (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*")    (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*")
# Line 1260  where FACE is a valid face specification Line 1287  where FACE is a valid face specification
1287          (fancy-splash-outer-buffer (current-buffer))          (fancy-splash-outer-buffer (current-buffer))
1288          splash-buffer          splash-buffer
1289          (old-minor-mode-map-alist minor-mode-map-alist)          (old-minor-mode-map-alist minor-mode-map-alist)
1290            (frame (fancy-splash-frame))
1291          timer)          timer)
1292      (switch-to-buffer "GNU Emacs")      (save-selected-window
1293      (setq tab-width 20)        (select-frame frame)
1294      (setq splash-buffer (current-buffer))        (switch-to-buffer "GNU Emacs")
1295      (catch 'stop-splashing        (setq tab-width 20)
1296        (unwind-protect        (setq splash-buffer (current-buffer))
1297            (let ((map (make-sparse-keymap)))        (catch 'stop-splashing
1298              (use-local-map map)          (unwind-protect
1299              (define-key map [t] 'fancy-splash-default-action)              (let ((map (make-sparse-keymap)))
1300              (define-key map [mouse-movement] 'ignore)                (use-local-map map)
1301              (define-key map [mode-line t] 'ignore)                (define-key map [switch-frame] 'ignore)
1302              (setq cursor-type nil                (define-key map [t] 'fancy-splash-default-action)
1303                    display-hourglass nil                (define-key map [mouse-movement] 'ignore)
1304                    minor-mode-map-alist nil                (define-key map [mode-line t] 'ignore)
1305                    buffer-undo-list t                (setq cursor-type nil
1306                    mode-line-format (propertize "---- %b %-"                      display-hourglass nil
1307                                                 'face '(:weight bold))                      minor-mode-map-alist nil
1308                    fancy-splash-stop-time (+ (float-time)                      buffer-undo-list t
1309                                              (max 60 fancy-splash-max-time))                      mode-line-format (propertize "---- %b %-"
1310                    timer (run-with-timer 0 fancy-splash-delay                                                   'face '(:weight bold))
1311                                          #'fancy-splash-screens-1                      fancy-splash-stop-time (+ (float-time)
1312                                          splash-buffer))                                                (max 60 fancy-splash-max-time))
1313              (recursive-edit))                      timer (run-with-timer 0 fancy-splash-delay
1314                                              #'fancy-splash-screens-1
1315                                              splash-buffer))
1316                  (recursive-edit))
1317            (cancel-timer timer)            (cancel-timer timer)
1318            (setq display-hourglass old-hourglass            (setq display-hourglass old-hourglass
1319                  minor-mode-map-alist old-minor-mode-map-alist)                  minor-mode-map-alist old-minor-mode-map-alist)
1320            (kill-buffer splash-buffer)))))            (kill-buffer splash-buffer))))))
1321    
1322    (defun fancy-splash-frame ()
1323      "Return the frame to use for the fancy splash screen.
1324    Returning non-nil does not mean we should necessarily
1325    use the fancy splash screen, but if we do use it,
1326    we put it on this frame."
1327      (let (chosen-frame)
1328        (dolist (frame (append (frame-list) (list (selected-frame))))
1329          (if (and (frame-visible-p frame)
1330                   (not (window-minibuffer-p (frame-selected-window frame))))
1331              (setq chosen-frame frame)))
1332        chosen-frame))
1333    
1334  (defun use-fancy-splash-screens-p ()  (defun use-fancy-splash-screens-p ()
1335    "Return t if fancy splash screens should be used."    "Return t if fancy splash screens should be used."
1336    (when (or (and (display-color-p)    (when (or (and (display-color-p)
1337                   (image-type-available-p 'xpm))                   (image-type-available-p 'xpm))
1338              (image-type-available-p 'pbm))              (image-type-available-p 'pbm))
1339      (let* ((img (create-image (or fancy-splash-image      (let ((frame (fancy-splash-frame)))
1340                                    (if (and (display-color-p)        (when frame
1341                                             (image-type-available-p 'xpm))          (let* ((img (create-image (or fancy-splash-image
1342                                        "splash.xpm" "splash.pbm"))))                                        (if (and (display-color-p)
1343             (image-height (and img (cdr (image-size img))))                                                 (image-type-available-p 'xpm))
1344             (window-height (1- (window-height (selected-window)))))                                            "splash.xpm" "splash.pbm"))))
1345        (> window-height (+ image-height 19)))))                 (image-height (and img (cdr (image-size img))))
1346                   (window-height (1- (window-height (frame-selected-window frame)))))
1347              (> window-height (+ image-height 19)))))))
1348    
1349    
1350  (defun normal-splash-screen ()  (defun normal-splash-screen ()
1351    "Display splash screen when Emacs starts."    "Display splash screen when Emacs starts."
1352    (with-current-buffer (get-buffer-create "GNU Emacs")    (let ((prev-buffer (current-buffer)))
1353      (let ((tab-width 8)      (unwind-protect
1354            (mode-line-format (propertize "---- %b %-"          (with-current-buffer (get-buffer-create "GNU Emacs")
1355                                          'face '(:weight bold))))            (let ((tab-width 8)
1356                    (mode-line-format (propertize "---- %b %-"
1357        ;; The convention for this piece of code is that                                                'face '(:weight bold))))
1358        ;; each piece of output starts with one or two newlines  
1359        ;; and does not end with any newlines.              ;; The convention for this piece of code is that
1360        (insert "Welcome to GNU Emacs")              ;; each piece of output starts with one or two newlines
1361        (if (eq system-type 'gnu/linux)              ;; and does not end with any newlines.
1362            (insert ", one component of a Linux-based GNU system."))              (insert "Welcome to GNU Emacs")
1363        (insert "\n")              (insert
1364                 (if (eq system-type 'gnu/linux)
1365        (unless (equal (buffer-name (current-buffer)) "*scratch*")                   ", one component of the GNU/Linux operating system.\n"
1366          (insert (substitute-command-keys                 ", a part of the GNU operating system.\n"))
1367                   "\nType \\[recenter] to begin editing your file.\n")))  
1368                (unless (equal (buffer-name prev-buffer) "*scratch*")
1369        (if (display-mouse-p)                (insert (substitute-command-keys
1370            ;; The user can use the mouse to activate menus                         "\nType \\[recenter] to begin editing your file.\n")))
1371            ;; so give help in terms of menu items.  
1372            (progn              (if (display-mouse-p)
1373              (insert "\                  ;; The user can use the mouse to activate menus
1374                    ;; so give help in terms of menu items.
1375                    (progn
1376                      (insert "\
1377  You can do basic editing with the menu bar and scroll bar using the mouse.  You can do basic editing with the menu bar and scroll bar using the mouse.
1378    
1379  Useful File menu items:  Useful File menu items:
# Line 1336  Recover Session                recover files you were Line 1383  Recover Session                recover files you were
1383  Important Help menu items:  Important Help menu items:
1384  Emacs Tutorial          Learn-by-doing tutorial for using Emacs efficiently.  Emacs Tutorial          Learn-by-doing tutorial for using Emacs efficiently.
1385  Emacs FAQ               Frequently asked questions and answers  Emacs FAQ               Frequently asked questions and answers
1386    Read the Emacs Manual   View the Emacs manual using Info
1387  \(Non)Warranty          GNU Emacs comes with ABSOLUTELY NO WARRANTY  \(Non)Warranty          GNU Emacs comes with ABSOLUTELY NO WARRANTY
1388  Copying Conditions      Conditions for redistributing and changing Emacs.  Copying Conditions      Conditions for redistributing and changing Emacs.
1389  Getting New Versions    How to obtain the latest version of Emacs.  Getting New Versions    How to obtain the latest version of Emacs.
1390  Ordering Manuals        How to order manuals from the FSF.  More Manuals / Ordering Manuals    How to order printed manuals from the FSF.
1391  ")  ")
1392              (insert "\n\n" (emacs-version)                    (insert "\n\n" (emacs-version)
1393                              "                            "
1394  Copyright (C) 2002 Free Software Foundation, Inc."))  Copyright (C) 2002 Free Software Foundation, Inc."))
1395    
1396          ;; No mouse menus, so give help using kbd commands.                ;; No mouse menus, so give help using kbd commands.
1397    
1398          ;; If keys have their default meanings,                ;; If keys have their default meanings,
1399          ;; use precomputed string to save lots of time.                ;; use precomputed string to save lots of time.
1400          (if (and (eq (key-binding "\C-h") 'help-command)                (if (and (eq (key-binding "\C-h") 'help-command)
1401                   (eq (key-binding "\C-xu") 'advertised-undo)                         (eq (key-binding "\C-xu") 'advertised-undo)
1402                   (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)                         (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
1403                   (eq (key-binding "\C-ht") 'help-with-tutorial)                         (eq (key-binding "\C-ht") 'help-with-tutorial)
1404                   (eq (key-binding "\C-hi") 'info)                         (eq (key-binding "\C-hi") 'info)
1405                   (eq (key-binding "\C-h\C-n") 'view-emacs-news))                         (eq (key-binding "\C-hr") 'info-emacs-manual)
1406              (insert "                         (eq (key-binding "\C-h\C-n") 'view-emacs-news))
1407                      (insert "
1408  Get help           C-h  (Hold down CTRL and press h)  Get help           C-h  (Hold down CTRL and press h)
1409  Undo changes       C-x u       Exit Emacs               C-x C-c  Emacs manual       C-h r
1410  Get a tutorial     C-h t       Use Info to read docs    C-h i  Emacs tutorial     C-h t           Undo changes     C-x u
1411  Ordering manuals   C-h RET")  Buy manuals        C-h C-m         Exit Emacs       C-x C-c
1412            (insert (substitute-command-keys  Browse manuals     C-h i")
1413                     (format "\n  
1414                    (insert (substitute-command-keys
1415                             (format "\n
1416  Get help           %s  Get help           %s
1417  Undo changes       \\[advertised-undo]  Emacs manual       \\[info-emacs-manual]
1418  Exit Emacs         \\[save-buffers-kill-emacs]  Emacs tutorial     \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
1419  Get a tutorial     \\[help-with-tutorial]  Buy manuals        \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
1420  Use Info to read docs   \\[info]  Browse manuals     \\[info]"
1421  Ordering manuals   \\[view-order-manuals]"                                   (let ((where (where-is-internal
1422                             (let ((where (where-is-internal                                                 'help-command nil t)))
1423                                           'help-command nil t)))                                     (if where
1424                               (if where                                         (key-description where)
1425                                   (key-description where)                                       "M-x help"))))))
1426                                 "M-x help"))))))  
1427                  ;; Say how to use the menu bar with the keyboard.
1428          ;; Say how to use the menu bar with the keyboard.                (if (and (eq (key-binding "\M-`") 'tmm-menubar)
1429          (if (and (eq (key-binding "\M-`") 'tmm-menubar)                         (eq (key-binding [f10]) 'tmm-menubar))
1430                   (eq (key-binding [f10]) 'tmm-menubar))                    (insert "
             (insert "  
1431  Activate menubar   F10  or  ESC `  or   M-`")  Activate menubar   F10  or  ESC `  or   M-`")
1432            (insert (substitute-command-keys "                  (insert (substitute-command-keys "
1433  Activate menubar     \\[tmm-menubar]")))  Activate menubar     \\[tmm-menubar]")))
1434    
1435          ;; Many users seem to have problems with these.                ;; Many users seem to have problems with these.
1436          (insert "                (insert "
1437  \(`C-' means use the CTRL key.  `M-' means use the Meta (or Alt) key.  \(`C-' means use the CTRL key.  `M-' means use the Meta (or Alt) key.
1438  If you have no Meta key, you may instead type ESC followed by the character.)")  If you have no Meta key, you may instead type ESC followed by the character.)")
1439    
1440          (insert "\n\n" (emacs-version)                (insert "\n\n" (emacs-version)
1441                          "                        "
1442  Copyright (C) 2002 Free Software Foundation, Inc.")  Copyright (C) 2002 Free Software Foundation, Inc.")
1443    
1444          (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)                (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
1445                   (eq (key-binding "\C-h\C-d") 'describe-distribution)                         (eq (key-binding "\C-h\C-d") 'describe-distribution)
1446                   (eq (key-binding "\C-h\C-w") 'describe-no-warranty))                         (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
1447              (insert                    (insert
1448                       "\n                     "\n
1449  GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.  GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
1450  Emacs is Free Software--Free as in Freedom--so you can redistribute copies  Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1451  of Emacs and modify it; type C-h C-c to see the conditions.  of Emacs and modify it; type C-h C-c to see the conditions.
1452  Type C-h C-d for information on getting the latest version.")  Type C-h C-d for information on getting the latest version.")
1453            (insert (substitute-command-keys                  (insert (substitute-command-keys
1454                     "\n                           "\n
1455  GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.  GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
1456  Emacs is Free Software--Free as in Freedom--so you can redistribute copies  Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1457  of Emacs and modify it; type \\[describe-copying] to see the conditions.  of Emacs and modify it; type \\[describe-copying] to see the conditions.
1458  Type \\[describe-distribution] for information on getting the latest version."))))  Type \\[describe-distribution] for information on getting the latest version."))))
1459    
1460        ;; The rest of the startup screen is the same on all              ;; The rest of the startup screen is the same on all
1461        ;; kinds of terminals.              ;; kinds of terminals.
1462    
1463                ;; Give information on recovering, if there was a crash.
1464                (and auto-save-list-file-prefix
1465                     ;; Don't signal an error if the
1466                     ;; directory for auto-save-list files
1467                     ;; does not yet exist.
1468                     (file-directory-p (file-name-directory
1469                                        auto-save-list-file-prefix))
1470                     (directory-files
1471                      (file-name-directory auto-save-list-file-prefix)
1472                      nil
1473                      (concat "\\`"
1474                              (regexp-quote (file-name-nondirectory
1475                                             auto-save-list-file-prefix)))
1476                      t)
1477                     (insert "\n\nIf an Emacs session crashed recently, "
1478                             "type M-x recover-session RET\nto recover"
1479                             " the files you were editing."))
1480    
1481                ;; Display the input that we set up in the buffer.
1482                (set-buffer-modified-p nil)
1483                (goto-char (point-min))
1484                (save-window-excursion
1485                  (switch-to-buffer (current-buffer))
1486                  (sit-for 120))))
1487          ;; Unwind ... ensure splash buffer is killed
1488          (kill-buffer "GNU Emacs"))))
1489    
       ;; Give information on recovering, if there was a crash.  
       (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)  
            (insert "\n\nIf an Emacs session crashed recently, "  
                    "type M-x recover-session RET\nto recover"  
                    " the files you were editing."))  
   
       ;; Display the input that we set up in the buffer.  
       (set-buffer-modified-p nil)  
       (goto-char (point-min))  
       (save-window-excursion  
         (switch-to-buffer (current-buffer))  
         (sit-for 120))))  
   (kill-buffer "GNU Emacs"))  
1490    
1491  (defun startup-echo-area-message ()  (defun startup-echo-area-message ()
1492    (if (eq (key-binding "\C-h\C-p") 'describe-project)    (if (eq (key-binding "\C-h\C-p") 'describe-project)
# Line 1467  normal otherwise." Line 1519  normal otherwise."
1519             user-init-file             user-init-file
1520             (or (and (get 'inhibit-startup-echo-area-message 'saved-value)             (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
1521                      (equal inhibit-startup-echo-area-message                      (equal inhibit-startup-echo-area-message
1522                             (if (string= init-file-user "")                             (if (equal init-file-user "")
1523                                 (user-login-name)                                 (user-login-name)
1524                               init-file-user)))                               init-file-user)))
1525                 ;; Wasn't set with custom; see if .emacs has a setq.                 ;; Wasn't set with custom; see if .emacs has a setq.
# Line 1483  normal otherwise." Line 1535  normal otherwise."
1535                               "inhibit-startup-echo-area-message[ \t\n]+"                               "inhibit-startup-echo-area-message[ \t\n]+"
1536                               (regexp-quote                               (regexp-quote
1537                                (prin1-to-string                                (prin1-to-string
1538                                 (if (string= init-file-user "")                                 (if (equal init-file-user "")
1539                                     (user-login-name)                                     (user-login-name)
1540                                   init-file-user)))                                   init-file-user)))
1541                               "[ \t\n]*)")                               "[ \t\n]*)")
# Line 1494  normal otherwise." Line 1546  normal otherwise."
1546    
1547    ;; Delay 2 seconds after an init file error message    ;; Delay 2 seconds after an init file error message
1548    ;; was displayed, so user can read it.    ;; was displayed, so user can read it.
1549    (if init-file-had-error    (when init-file-had-error
1550        (sit-for 2))      (sit-for 2))
1551    
1552    (if command-line-args-left    (when command-line-args-left
1553        ;; We have command args; process them.      ;; We have command args; process them.
1554        (let ((dir command-line-default-directory)      (let ((dir command-line-default-directory)
1555              (file-count 0)            (file-count 0)
1556              first-file-buffer            first-file-buffer
1557              tem            tem
1558              just-files ;; t if this follows the magic -- option.            ;; The directories listed in --directory/-L options will *appear*
1559              ;; This includes our standard options' long versions            ;; at the front of `load-path' in the order they appear on the
1560              ;; and long versions of what's on command-switch-alist.            ;; command-line.  We cannot do this by *placing* them at the front
1561              (longopts            ;; in the order they appear, so we need this variable to hold them,
1562               (append '(("--funcall") ("--load") ("--insert") ("--kill")            ;; temporarily.
1563                         ("--directory") ("--eval") ("--execute") ("--no-splash")            extra-load-path
1564                         ("--find-file") ("--visit") ("--file"))            just-files ;; t if this follows the magic -- option.
1565                       (mapcar (lambda (elt)            ;; This includes our standard options' long versions
1566                                 (list (concat "-" (car elt))))            ;; and long versions of what's on command-switch-alist.
1567                               command-switch-alist)))            (longopts
1568              (line 0)             (append '(("--funcall") ("--load") ("--insert") ("--kill")
1569              (column 0))                       ("--directory") ("--eval") ("--execute") ("--no-splash")
1570                         ("--find-file") ("--visit") ("--file"))
1571          ;; Add the long X options to longopts.                     (mapcar (lambda (elt)
1572          (dolist (tem command-line-x-option-alist)                               (list (concat "-" (car elt))))
1573            (if (string-match "^--" (car tem))                             command-switch-alist)))
1574                (push (list (car tem)) longopts)))            (line 0)
1575              (column 0))
1576          ;; Loop, processing options.  
1577          (while (and command-line-args-left)        ;; Add the long X options to longopts.
1578            (let* ((argi (car command-line-args-left))        (dolist (tem command-line-x-option-alist)
1579                   (orig-argi argi)          (if (string-match "^--" (car tem))
1580                   argval completion              (push (list (car tem)) longopts)))
1581                   ;; List of directories specified in -L/--directory,  
1582                   ;; in reverse of the order specified.        ;; Loop, processing options.
1583                   extra-load-path        (while command-line-args-left
1584                   (initial-load-path load-path))          (let* ((argi (car command-line-args-left))
1585              (setq command-line-args-left (cdr command-line-args-left))                 (orig-argi argi)
1586                   argval completion)
1587              ;; Do preliminary decoding of the option.            (setq command-line-args-left (cdr command-line-args-left))
1588              (if just-files  
1589                  ;; After --, don't look for options; treat all args as files.            ;; Do preliminary decoding of the option.
1590                  (setq argi "")            (if just-files
1591                ;; Convert long options to ordinary options                ;; After --, don't look for options; treat all args as files.
1592                ;; and separate out an attached option argument into argval.                (setq argi "")
1593                (if (string-match "^--[^=]*=" argi)              ;; Convert long options to ordinary options
1594                    (setq argval (substring argi (match-end 0))              ;; and separate out an attached option argument into argval.
1595                          argi (substring argi 0 (1- (match-end 0)))))              (when (string-match "^\\(--[^=]*\\)=" argi)
1596                (if (equal argi "--")                (setq argval (substring argi (match-end 0))
1597                    (setq completion nil)                      argi (match-string 1 argi)))
1598                  (setq completion (try-completion argi longopts)))              (if (equal argi "--")
1599                (if (eq completion t)                  (setq completion nil)
1600                    (setq argi (substring argi 1))                (setq completion (try-completion argi longopts)))
1601                  (if (stringp completion)              (if (eq completion t)
1602                      (let ((elt (assoc completion longopts)))                  (setq argi (substring argi 1))
1603                        (or elt                (if (stringp completion)
1604                            (error "Option `%s' is ambiguous" argi))                    (let ((elt (assoc completion longopts)))
1605                        (setq argi (substring (car elt) 1)))                      (or elt
1606                    (setq argval nil argi orig-argi))))                          (error "Option `%s' is ambiguous" argi))
1607                        (setq argi (substring (car elt) 1)))
1608              ;; Execute the option.                  (setq argval nil
1609              (cond ((setq tem (assoc argi command-switch-alist))                        argi orig-argi))))
1610                     (if argval  
1611                         (let ((command-line-args-left            ;; Execute the option.
1612                                (cons argval command-line-args-left)))            (cond ((setq tem (assoc argi command-switch-alist))
1613                           (funcall (cdr tem) argi))                   (if argval
1614                       (funcall (cdr tem) argi)))                       (let ((command-line-args-left
1615                                (cons argval command-line-args-left)))
1616                    ((string-equal argi "-no-splash")                         (funcall (cdr tem) argi))
1617                     (setq inhibit-startup-message t))                     (funcall (cdr tem) argi)))
1618    
1619                    ((member argi '("-f"  ;what the manual claims                  ((equal argi "-no-splash")
1620                                    "-funcall"                   (setq inhibit-startup-message t))
1621                                    "-e")) ; what the source used to say  
1622                     (if argval                  ((member argi '("-f"    ; what the manual claims
1623                         (setq tem (intern argval))                                  "-funcall"
1624                       (setq tem (intern (car command-line-args-left)))                                  "-e"))  ; what the source used to say
1625                       (setq command-line-args-left (cdr command-line-args-left)))                   (setq tem (intern (or argval (pop command-line-args-left))))
1626                     (if (arrayp (symbol-function tem))                   (if (commandp tem)
1627                         (command-execute tem)                       (command-execute tem)
1628                       (funcall tem)))                     (funcall tem)))
1629    
1630                    ((member argi '("-eval" "-execute"))                  ((member argi '("-eval" "-execute"))
1631                     (if argval                   (eval (read (or argval (pop command-line-args-left)))))
1632                         (setq tem argval)                  ;; Set the default directory as specified in -L.
1633                       (setq tem (car command-line-args-left))  
1634                       (setq command-line-args-left (cdr command-line-args-left)))                  ((member argi '("-L" "-directory"))
1635                     (eval (read tem)))                   (setq tem (or argval (pop command-line-args-left)))
1636                    ;; Set the default directory as specified in -L.                   ;; We will reverse `extra-load-path' and prepend it to
1637                     ;; `load-path' after all the arguments have been processed.
1638                    ((member argi '("-L" "-directory"))                   (push
1639                     (if argval                    (expand-file-name (command-line-normalize-file-name tem))
1640                         (setq tem argval)                    extra-load-path))
1641                       (setq tem (car command-line-args-left)  
1642                             command-line-args-left (cdr command-line-args-left)))                  ((member argi '("-l" "-load"))
1643                     (setq tem (command-line-normalize-file-name tem))                   (let* ((file (command-line-normalize-file-name
1644                     (setq extra-load-path                                 (or argval (pop command-line-args-left))))
1645                           (cons (expand-file-name tem) extra-load-path))                          ;; Take file from default dir if it exists there;
1646                     (setq load-path (append (nreverse extra-load-path)                          ;; otherwise let `load' search for it.
1647                                             initial-load-path)))                          (file-ex (expand-file-name file)))
1648                       (when (file-exists-p file-ex)
1649                    ((member argi '("-l" "-load"))                       (setq file file-ex))
1650                     (if argval                     (load file nil t)))
1651                         (setq tem argval)  
1652                       (setq tem (car command-line-args-left)                  ((equal argi "-insert")
1653                             command-line-args-left (cdr command-line-args-left)))                   (setq tem (or argval (pop command-line-args-left)))
1654                     (let ((file (command-line-normalize-file-name tem)))                   (or (stringp tem)
1655                       ;; Take file from default dir if it exists there;                       (error "File name omitted from `-insert' option"))
1656                       ;; otherwise let `load' search for it.                   (insert-file-contents (command-line-normalize-file-name tem)))
1657                       (if (file-exists-p (expand-file-name file))  
1658                           (setq file (expand-file-name file)))                  ((equal argi "-kill")
1659                       (load file nil t)))                   (kill-emacs t))
1660    
1661                    ((string-equal argi "-insert")                  ((string-match "^\\+[0-9]+\\'" argi)
1662                     (if argval                   (setq line (string-to-int argi)))
1663                         (setq tem argval)  
1664                       (setq tem (car command-line-args-left)                  ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
1665                             command-line-args-left (cdr command-line-args-left)))                   (setq line (string-to-int (match-string 1 argi))
1666                     (or (stringp tem)                         column (string-to-int (match-string 2 argi))))
1667                         (error "File name omitted from `-insert' option"))  
1668                     (insert-file-contents (command-line-normalize-file-name tem)))                  ((setq tem (assoc argi command-line-x-option-alist))
1669                     ;; Ignore X-windows options and their args if not using X.
1670                    ((string-equal argi "-kill")                   (setq command-line-args-left
1671                     (kill-emacs t))                         (nthcdr (nth 1 tem) command-line-args-left)))
1672    
1673                    ((string-match "^\\+[0-9]+\\'" argi)                  ((member argi '("-find-file" "-file" "-visit"))
1674                     (setq line (string-to-int argi)))                   ;; An explicit option to specify visiting a file.
1675                     (setq tem (or argval (pop command-line-args-left)))
1676                    ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)                   (unless (stringp tem)
1677                     (setq line (string-to-int (match-string 1 argi))                     (error "File name omitted from `%s' option" argi))
1678                           column (string-to-int (match-string 2 argi))))                   (setq file-count (1+ file-count))
1679                     (let ((file (expand-file-name
1680                    ((setq tem (assoc argi command-line-x-option-alist))                                (command-line-normalize-file-name tem) dir)))
1681                     ;; Ignore X-windows options and their args if not using X.                     (if (= file-count 1)
1682                     (setq command-line-args-left                         (setq first-file-buffer (find-file file))
1683                           (nthcdr (nth 1 tem) command-line-args-left)))                       (find-file-other-window file)))
1684                     (or (zerop line)
1685                    ((member argi '("-find-file" "-file" "-visit"))                       (goto-line line))
1686                     ;; An explicit option to specify visiting a file.                   (setq line 0)
1687                     (if argval                   (unless (< column 1)
1688                         (setq tem argval)                     (move-to-column (1- column)))
1689                       (setq tem (car command-line-args-left)                   (setq column 0))
1690                             command-line-args-left (cdr command-line-args-left)))  
1691                     (unless (stringp tem)                  ((equal argi "--")
1692                       (error "File name omitted from `%s' option" argi))                   (setq just-files t))
1693                     (setq file-count (1+ file-count))                  (t
1694                     (let ((file (expand-file-name                   ;; We have almost exhausted our options. See if the
1695                                  (command-line-normalize-file-name tem) dir)))                   ;; user has made any other command-line options available
1696                       (if (= file-count 1)                   (let ((hooks command-line-functions) ;; lrs 7/31/89
1697                           (setq first-file-buffer (find-file file))                         (did-hook nil))
1698                         (find-file-other-window file)))                     (while (and hooks
1699                     (or (zerop line)                                 (not (setq did-hook (funcall (car hooks)))))
1700                         (goto-line line))                       (setq hooks (cdr hooks)))
1701                     (setq line 0)                     (if (not did-hook)
1702                     (unless (< column 1)                         ;; Presume that the argument is a file name.
1703                       (move-to-column (1- column)))                         (progn
1704                     (setq column 0))                           (if (string-match "\\`-" argi)
1705                                 (error "Unknown option `%s'" argi))
1706                    ((equal argi "--")                           (setq file-count (1+ file-count))
1707                     (setq just-files t))                           (let ((file
1708                    (t                                  (expand-file-name
1709                     ;; We have almost exhausted our options. See if the                                   (command-line-normalize-file-name orig-argi)
1710                     ;; user has made any other command-line options available                                   dir)))
1711                     (let ((hooks command-line-functions) ;; lrs 7/31/89                             (if (= file-count 1)
1712                           (did-hook nil))                                 (setq first-file-buffer (find-file file))
1713                       (while (and hooks                               (find-file-other-window file)))
1714                                   (not (setq did-hook (funcall (car hooks)))))                           (or (zerop line)
1715                         (setq hooks (cdr hooks)))                               (goto-line line))
1716                       (if (not did-hook)                           (setq line 0)
1717                         ;; Ok, presume that the argument is a file name                           (unless (< column 1)
1718                           (progn                             (move-to-column (1- column)))
1719                             (if (string-match "\\`-" argi)                           (setq column 0))))))))
1720                                 (error "Unknown option `%s'" argi))  
1721                             (setq file-count (1+ file-count))        ;; See --directory/-L option above.
1722                             (let ((file        (when extra-load-path
1723                                    (expand-file-name          (setq load-path (append (nreverse extra-load-path) load-path)))
1724                                     (command-line-normalize-file-name orig-argi)  
1725                                     dir)))        ;; If 3 or more files visited, and not all visible,
1726                               (if (= file-count 1)        ;; show user what they all are.  But leave the last one current.
1727                                   (setq first-file-buffer (find-file file))        (and (> file-count 2)
1728                                 (find-file-other-window file)))             (not noninteractive)
1729                             (or (zerop line)             (not inhibit-startup-buffer-menu)
1730                                 (goto-line line))             (or (get-buffer-window first-file-buffer)
1731                             (setq line 0)                 (list-buffers)))))
                            (unless (< column 1)  
                              (move-to-column (1- column)))  
                            (setq column 0))))))))  
         ;; If 3 or more files visited, and not all visible,  
         ;; show user what they all are.  But leave the last one current.  
         (and (> file-count 2)  
              (not noninteractive)  
              (not inhibit-startup-buffer-menu)  
              (or (get-buffer-window first-file-buffer)  
                  (list-buffers)))))  
1732    
1733    ;; Maybe display a startup screen.    ;; Maybe display a startup screen.
1734    (when (and (not inhibit-startup-message) (not noninteractive)    (when (and (not inhibit-startup-message) (not noninteractive)
# Line 1699  normal otherwise." Line 1741  normal otherwise."
1741      ;; If there are no switches to process, we might as well      ;; If there are no switches to process, we might as well
1742      ;; run this hook now, and there may be some need to do it      ;; run this hook now, and there may be some need to do it
1743      ;; before doing any output.      ;; before doing any output.
1744        (run-hooks 'emacs-startup-hook)
1745      (and term-setup-hook      (and term-setup-hook
1746           (run-hooks 'term-setup-hook))           (run-hooks 'term-setup-hook))
1747      ;; Don't let the hook be run twice.      (setq inhibit-startup-hooks t)
     (setq term-setup-hook nil)  
1748    
1749      ;; It's important to notice the user settings before we      ;; It's important to notice the user settings before we
1750      ;; display the startup message; otherwise, the settings      ;; display the startup message; otherwise, the settings
# Line 1728  normal otherwise." Line 1770  normal otherwise."
1770      ;; If *scratch* is selected and it is empty, insert an      ;; If *scratch* is selected and it is empty, insert an
1771      ;; initial message saying not to create a file there.      ;; initial message saying not to create a file there.
1772      (when (and initial-scratch-message      (when (and initial-scratch-message
1773                 (string= (buffer-name) "*scratch*")                 (equal (buffer-name) "*scratch*")
1774                 (= 0 (buffer-size)))                 (= 0 (buffer-size)))
1775        (insert initial-scratch-message)        (insert initial-scratch-message)
1776        (set-buffer-modified-p nil))        (set-buffer-modified-p nil))

Legend:
Removed from v.1.298  
changed lines
  Added in v.1.298.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26