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) |
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 |
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 |
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) |
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))) |
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) |
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 |
|
|
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 |
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) |
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) |
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. |
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 "\ |
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. |
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]*)") |
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) |
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)) |