diff options
Diffstat (limited to 'lisp/startup.el')
| -rw-r--r-- | lisp/startup.el | 239 |
1 files changed, 139 insertions, 100 deletions
diff --git a/lisp/startup.el b/lisp/startup.el index 471b688fbff..c413a29bc66 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -199,47 +200,47 @@ and VALUE is the value which is given to that frame parameter ;;("-bw" . x-handle-numeric-switch) ;;("-d" . x-handle-display) ;;("-display" . x-handle-display) - ("-name" 1 ns-handle-name-switch) - ("-title" 1 ns-handle-switch title) - ("-T" 1 ns-handle-switch title) - ("-r" 0 ns-handle-switch reverse t) - ("-rv" 0 ns-handle-switch reverse t) - ("-reverse" 0 ns-handle-switch reverse t) - ("-fn" 1 ns-handle-switch font) - ("-font" 1 ns-handle-switch font) - ("-ib" 1 ns-handle-numeric-switch internal-border-width) + ("-name" 1 x-handle-name-switch) + ("-title" 1 x-handle-switch title) + ("-T" 1 x-handle-switch title) + ("-r" 0 x-handle-switch reverse t) + ("-rv" 0 x-handle-switch reverse t) + ("-reverse" 0 x-handle-switch reverse t) + ("-fn" 1 x-handle-switch font) + ("-font" 1 x-handle-switch font) + ("-ib" 1 x-handle-numeric-switch internal-border-width) ;;("-g" . x-handle-geometry) ;;("-geometry" . x-handle-geometry) - ("-fg" 1 ns-handle-switch foreground-color) - ("-foreground" 1 ns-handle-switch foreground-color) - ("-bg" 1 ns-handle-switch background-color) - ("-background" 1 ns-handle-switch background-color) -; ("-ms" 1 ns-handle-switch mouse-color) - ("-itype" 0 ns-handle-switch icon-type t) - ("-i" 0 ns-handle-switch icon-type t) - ("-iconic" 0 ns-handle-iconic icon-type t) + ("-fg" 1 x-handle-switch foreground-color) + ("-foreground" 1 x-handle-switch foreground-color) + ("-bg" 1 x-handle-switch background-color) + ("-background" 1 x-handle-switch background-color) +; ("-ms" 1 x-handle-switch mouse-color) + ("-itype" 0 x-handle-switch icon-type t) + ("-i" 0 x-handle-switch icon-type t) + ("-iconic" 0 x-handle-iconic icon-type t) ;;("-xrm" . x-handle-xrm-switch) - ("-cr" 1 ns-handle-switch cursor-color) - ("-vb" 0 ns-handle-switch vertical-scroll-bars t) - ("-hb" 0 ns-handle-switch horizontal-scroll-bars t) - ("-bd" 1 ns-handle-switch) - ;; ("--border-width" 1 ns-handle-numeric-switch border-width) + ("-cr" 1 x-handle-switch cursor-color) + ("-vb" 0 x-handle-switch vertical-scroll-bars t) + ("-hb" 0 x-handle-switch horizontal-scroll-bars t) + ("-bd" 1 x-handle-switch) + ;; ("--border-width" 1 x-handle-numeric-switch border-width) ;; ("--display" 1 ns-handle-display) - ("--name" 1 ns-handle-name-switch) - ("--title" 1 ns-handle-switch title) - ("--reverse-video" 0 ns-handle-switch reverse t) - ("--font" 1 ns-handle-switch font) - ("--internal-border" 1 ns-handle-numeric-switch internal-border-width) + ("--name" 1 x-handle-name-switch) + ("--title" 1 x-handle-switch title) + ("--reverse-video" 0 x-handle-switch reverse t) + ("--font" 1 x-handle-switch font) + ("--internal-border" 1 x-handle-numeric-switch internal-border-width) ;; ("--geometry" 1 ns-handle-geometry) - ("--foreground-color" 1 ns-handle-switch foreground-color) - ("--background-color" 1 ns-handle-switch background-color) - ("--mouse-color" 1 ns-handle-switch mouse-color) - ("--icon-type" 0 ns-handle-switch icon-type t) - ("--iconic" 0 ns-handle-iconic) + ("--foreground-color" 1 x-handle-switch foreground-color) + ("--background-color" 1 x-handle-switch background-color) + ("--mouse-color" 1 x-handle-switch mouse-color) + ("--icon-type" 0 x-handle-switch icon-type t) + ("--iconic" 0 x-handle-iconic) ;; ("--xrm" 1 ns-handle-xrm-switch) - ("--cursor-color" 1 ns-handle-switch cursor-color) - ("--vertical-scroll-bars" 0 ns-handle-switch vertical-scroll-bars t) - ("--border-color" 1 ns-handle-switch border-width)) + ("--cursor-color" 1 x-handle-switch cursor-color) + ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t) + ("--border-color" 1 x-handle-switch border-width)) "Alist of NS options. Each element has the form (NAME NUMARGS HANDLER FRAME-PARAM VALUE) @@ -410,34 +411,31 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (default-directory this-dir) (canonicalized (if (fboundp 'untranslated-canonical-name) (untranslated-canonical-name this-dir)))) - ;; The Windows version doesn't report meaningful inode - ;; numbers, so use the canonicalized absolute file name of the - ;; directory instead. + ;; The Windows version doesn't report meaningful inode numbers, so + ;; use the canonicalized absolute file name of the directory instead. (setq attrs (or canonicalized (nthcdr 10 (file-attributes this-dir)))) (unless (member attrs normal-top-level-add-subdirs-inode-list) (push attrs normal-top-level-add-subdirs-inode-list) (dolist (file contents) - ;; The lower-case variants of RCS and CVS are for DOS/Windows. - (unless (member file '("." ".." "RCS" "CVS" "rcs" "cvs")) - (when (and (string-match "\\`[[:alnum:]]" file) - ;; Avoid doing a `stat' when it isn't necessary - ;; because that can cause trouble when an NFS server - ;; is down. - (not (string-match "\\.elc?\\'" file)) - (file-directory-p file)) - (let ((expanded (expand-file-name file))) - (unless (file-exists-p (expand-file-name ".nosearch" - expanded)) - (setq pending (nconc pending (list expanded))))))))))) + (and (string-match "\\`[[:alnum:]]" file) + ;; The lower-case variants of RCS and CVS are for DOS/Windows. + (not (member file '("RCS" "CVS" "rcs" "cvs"))) + ;; Avoid doing a `stat' when it isn't necessary because + ;; that can cause trouble when an NFS server is down. + (not (string-match "\\.elc?\\'" file)) + (file-directory-p file) + (let ((expanded (expand-file-name file))) + (or (file-exists-p (expand-file-name ".nosearch" expanded)) + (setq pending (nconc pending (list expanded)))))))))) (normal-top-level-add-to-load-path (cdr (nreverse dirs))))) -;; This function is called from a subdirs.el file. -;; It assumes that default-directory is the directory -;; in which the subdirs.el file exists, -;; and it adds to load-path the subdirs of that directory -;; as specified in DIRS. Normally the elements of DIRS are relative. (defun normal-top-level-add-to-load-path (dirs) + "This function is called from a subdirs.el file. +It assumes that `default-directory' is the directory in which the +subdirs.el file exists, and it adds to `load-path' the subdirs of +that directory as specified in DIRS. Normally the elements of +DIRS are relative." (let ((tail load-path) (thisdir (directory-file-name default-directory))) (while (and tail @@ -465,9 +463,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; `user-full-name' is now known; reset its standard-value here. (put 'user-full-name 'standard-value (list (default-value 'user-full-name))) - ;; For root, preserve owner and group when editing files. - (if (equal (user-uid) 0) - (setq backup-by-copying-when-mismatch t)) ;; Look in each dir in load-path for a subdirs.el file. ;; If we find one, load it, which will add the appropriate subdirs ;; of that dir into load-path, @@ -617,8 +612,8 @@ function to this list. The function should take no arguments, and initialize the window system environment to prepare for opening the first frame (e.g. open a connection to an X server).") -;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) + "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc." (let (rest) (message "%S" args) (while (and args @@ -785,15 +780,16 @@ opening the first frame (e.g. open a connection to an X server).") argi (match-string 1 argi))) (when (string-match "\\`--." orig-argi) (let ((completion (try-completion argi longopts))) - (if (eq completion t) - (setq argi (substring argi 1)) - (if (stringp completion) - (let ((elt (assoc completion longopts))) - (or elt - (error "Option `%s' is ambiguous" argi)) - (setq argi (substring (car elt) 1))) - (setq argval nil - argi orig-argi))))) + (cond ((eq completion t) + (setq argi (substring argi 1))) + ((stringp completion) + (let ((elt (assoc completion longopts))) + (unless elt + (error "Option `%s' is ambiguous" argi)) + (setq argi (substring (car elt) 1)))) + (t + (setq argval nil + argi orig-argi))))) (cond ;; The --display arg is handled partly in C, partly in Lisp. ;; When it shows up here, we just put it back to be handled @@ -878,10 +874,40 @@ opening the first frame (e.g. open a connection to an X server).") (run-hooks 'before-init-hook) - ;; Under X Window, this creates the X frame and deletes the terminal frame. + ;; Under X, this creates the X frame and deletes the terminal frame. (unless (daemonp) + + ;; If X resources are available, use them to initialize the values + ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of + ;; `no-blinking-cursor' and the `cursor' face. + (cond + ((or noninteractive emacs-basic-display) + (setq menu-bar-mode nil + tool-bar-mode nil + no-blinking-cursor t)) + ((memq initial-window-system '(x w32 ns)) + (let ((no-vals '("no" "off" "false" "0"))) + (if (member (x-get-resource "menuBar" "MenuBar") no-vals) + (setq menu-bar-mode nil)) + (if (member (x-get-resource "toolBar" "ToolBar") no-vals) + (setq tool-bar-mode nil)) + (if (member (x-get-resource "cursorBlink" "CursorBlink") + no-vals) + (setq no-blinking-cursor t))) + ;; If the cursorColor X resource exists, alter the `cursor' face + ;; spec, but mark it as changed outside of Customize. + (let ((color (x-get-resource "cursorColor" "CursorColor"))) + (when color + (face-spec-set 'cursor `((t (:background ,color)))) + (put 'cursor 'face-modified t))))) (frame-initialize)) + (when (fboundp 'x-create-frame) + ;; Set up the tool-bar (even in tty frames, since Emacs might open a + ;; graphical frame later). + (unless noninteractive + (tool-bar-setup))) + ;; Turn off blinking cursor if so specified in X resources. This is here ;; only because all other settings of no-blinking-cursor are here. (unless (or noninteractive @@ -891,25 +917,6 @@ opening the first frame (e.g. open a connection to an X server).") '("off" "false"))))) (setq no-blinking-cursor t)) - ;; If frame was created with a menu bar, set menu-bar-mode on. - (unless (or noninteractive - emacs-basic-display - (and (memq initial-window-system '(x w32)) - (<= (frame-parameter nil 'menu-bar-lines) 0))) - (menu-bar-mode 1)) - - (unless (or noninteractive (not (fboundp 'tool-bar-mode))) - ;; Set up the tool-bar. Do this even in tty frames, so that there - ;; is a tool-bar if Emacs later opens a graphical frame. - (if (or emacs-basic-display - (and (numberp (frame-parameter nil 'tool-bar-lines)) - (<= (frame-parameter nil 'tool-bar-lines) 0))) - ;; On a graphical display with the toolbar disabled via X - ;; resources, set up the toolbar without enabling it. - (tool-bar-setup) - ;; Otherwise, enable tool-bar-mode. - (tool-bar-mode 1))) - ;; Re-evaluate predefined variables whose initial value depends on ;; the runtime context. (mapc 'custom-reevaluate-setting @@ -1166,6 +1173,31 @@ the `--debug-init' option to view a complete error backtrace." (eq face-ignored-fonts old-face-ignored-fonts)) (clear-face-cache))) + ;; If any package directory exists, initialize the package system. + (and user-init-file + package-enable-at-startup + (catch 'package-dir-found + (let (dirs) + (if (boundp 'package-directory-list) + (setq dirs package-directory-list) + (dolist (f load-path) + (and (stringp f) + (equal (file-name-nondirectory f) "site-lisp") + (push (expand-file-name "elpa" f) dirs)))) + (push (if (boundp 'package-user-dir) + package-user-dir + (locate-user-emacs-file "elpa")) + dirs) + (dolist (dir dirs) + (when (file-directory-p dir) + (dolist (subdir (directory-files dir)) + (when (and (file-directory-p (expand-file-name subdir dir)) + ;; package-subdirectory-regexp from package.el + (string-match "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" + subdir)) + (throw 'package-dir-found t))))))) + (package-initialize)) + (setq after-init-time (current-time)) (run-hooks 'after-init-hook) @@ -1554,22 +1586,25 @@ a face or button specification." (kill-buffer "*GNU Emacs*"))) " ") (when (or user-init-file custom-file) - (let ((checked (create-image "\300\300\141\143\067\076\034\030" - 'xbm t :width 8 :height 8 :background "grey75" - :foreground "black" :relief -2 :ascent 'center)) - (unchecked (create-image (make-string 8 0) - 'xbm t :width 8 :height 8 :background "grey75" - :foreground "black" :relief -2 :ascent 'center))) + (let ((checked (create-image "checked.xpm" + nil nil :ascent 'center)) + (unchecked (create-image "unchecked.xpm" + nil nil :ascent 'center))) (insert-button - " " :on-glyph checked :off-glyph unchecked 'checked nil - 'display unchecked 'follow-link t + " " + :on-glyph checked + :off-glyph unchecked + 'checked nil 'display unchecked 'follow-link t 'action (lambda (button) (if (overlay-get button 'checked) (progn (overlay-put button 'checked nil) - (overlay-put button 'display (overlay-get button :off-glyph)) - (setq startup-screen-inhibit-startup-screen nil)) + (overlay-put button 'display + (overlay-get button :off-glyph)) + (setq startup-screen-inhibit-startup-screen + nil)) (overlay-put button 'checked t) - (overlay-put button 'display (overlay-get button :on-glyph)) + (overlay-put button 'display + (overlay-get button :on-glyph)) (setq startup-screen-inhibit-startup-screen t))))) (fancy-splash-insert :face '(variable-pitch (:height 0.9)) " Never show it again."))))) @@ -2224,6 +2259,11 @@ A fancy display is used on graphic displays, normal otherwise." (move-to-column (1- cl1-column))) (setq cl1-column 0)) + ;; These command lines now have no effect. + ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi) + (display-warning 'initialization + (format "Ignoring obsolete arg %s" argi))) + ((equal argi "--") (setq just-files t)) (t @@ -2342,5 +2382,4 @@ A fancy display is used on graphic displays, normal otherwise." (setq file (replace-match "/" t t file))) file)) -;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db ;;; startup.el ends here |