/[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.314 by rms, Sun Feb 23 15:16:29 2003 UTC revision 1.315 by swift, Wed Feb 26 10:59:58 2003 UTC
# Line 580  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 680  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 700  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 726  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 750  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 759  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 784  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 t))
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 850  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 872  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 957  or `CVS', and any subdirectory that cont Line 944  or `CVS', and any subdirectory that cont
944                                (sit-for 1))                                (sit-for 1))
945                              (setq user-init-file source))))                              (setq user-init-file source))))
946    
947                        (when (and (stringp custom-file)                        (when (stringp custom-file)
948                                   (not (assoc custom-file load-history)))                          (unless (assoc custom-file load-history)
949                          ;; If the .emacs file has set `custom-file' but hasn't                            ;; If the .emacs file has set `custom-file' but hasn't
950                          ;; loaded the file yet, let's load it.                            ;; loaded the file yet, let's load it.
951                          (load custom-file t t))                            (load custom-file t t)))
952    
953                        (or inhibit-default-init                        (unless inhibit-default-init
954                            (let ((inhibit-startup-message nil))                          (let ((inhibit-startup-message nil))
955                              ;; Users are supposed to be told their rights.                            ;; Users are supposed to be told their rights.
956                              ;; (Plus how to get help and how to undo.)                            ;; (Plus how to get help and how to undo.)
957                              ;; Don't you dare turn this off for anyone                            ;; Don't you dare turn this off for anyone
958                              ;; except yourself.                            ;; except yourself.
959                              (load "default" t t)))))))))                            (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 1055  or `CVS', and any subdirectory that cont Line 1042  or `CVS', and any subdirectory that cont
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    ;; Update the out-of-memory error message based on user's key bindings
1059    ;; for save-some-buffers.    ;; for save-some-buffers.
# Line 1079  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 1528  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 1544  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 1555  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 (arrayp (symbol-function 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 1789  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.314  
changed lines
  Added in v.1.315

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