X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/49f70d46ea38ceb7a501594db7f6ea35e19681aa..3e88618b122996ad420a490527b19ffac8802b31:/lisp/startup.el?ds=sidebyside diff --git a/lisp/startup.el b/lisp/startup.el index 775d2f7305..41056f3907 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,11 +1,10 @@ -;;; startup.el --- process Emacs shell arguments +;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*- -;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1992, 1994-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -42,8 +41,9 @@ (defcustom initial-buffer-choice nil "Buffer to show after starting Emacs. If the value is nil and `inhibit-startup-screen' is nil, show the -startup screen. If the value is string, visit the specified file or -directory using `find-file'. If t, open the `*scratch*' buffer." +startup screen. If the value is string, visit the specified file +or directory using `find-file'. If t, open the `*scratch*' +buffer." :type '(choice (const :tag "Startup screen" nil) (directory :tag "Directory" :value "~/") @@ -99,11 +99,17 @@ the remaining command-line args are in the variable `command-line-args-left'.") "List of command-line args not yet processed.") (defvaralias 'argv 'command-line-args-left + ;; FIXME: Bad name for a dynamically bound variable. "List of command-line args not yet processed. This is a convenience alias, so that one can write \(pop argv\) inside of --eval command line arguments in order to access following arguments.") +(with-no-warnings + ;; FIXME: Bad name for a dynamically bound variable + (defvar argi nil + "Current command-line argument.")) + (defvar command-line-functions nil ;; lrs 7/31/89 "List of functions to process unrecognized command-line arguments. Each function should access the dynamically bound variables @@ -199,47 +205,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) @@ -327,7 +333,7 @@ this variable usefully is to set it while building and dumping Emacs." :type '(choice (const :tag "none" nil) string) :group 'initialization :initialize 'custom-initialize-default - :set (lambda (variable value) + :set (lambda (_variable _value) (error "Customizing `site-run-file' does not work"))) (defcustom mail-host-address nil @@ -393,8 +399,17 @@ Warning Warning!!! Pure space overflow !!!Warning Warning :type 'directory :initialize 'custom-initialize-delay) +(defconst package-subdirectory-regexp + "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" + "Regular expression matching the name of a package subdirectory. +The first subexpression is the package name. +The second subexpression is the version string. + +The regexp should not contain a starting \"\\`\" or a trailing + \"\\'\"; those are added automatically by callers.") + (defun normal-top-level-add-subdirs-to-load-path () - "Add all subdirectories of current directory to `load-path'. + "Add all subdirectories of `default-directory' to `load-path'. More precisely, this uses only the subdirectories whose names start with letters or digits; it excludes any subdirectory named `RCS' or `CVS', and any subdirectory that contains a file named `.nosearch'." @@ -410,34 +425,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 +477,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 +626,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 +794,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,38 +888,50 @@ 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" "Foreground"))) + (when color + (put 'cursor 'theme-face + `((changed ((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 emacs-basic-display (and (memq window-system '(x w32 ns)) (not (member (x-get-resource "cursorBlink" "CursorBlink") - '("off" "false"))))) + '("no" "off" "false" "0"))))) (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 @@ -921,7 +943,7 @@ opening the first frame (e.g. open a connection to an X server).") (normal-erase-is-backspace-setup-frame) ;; Register default TTY colors for the case the terminal hasn't a - ;; terminal init file. We do this regardles of whether the terminal + ;; terminal init file. We do this regardless of whether the terminal ;; supports colors or not and regardless the current display type, ;; since users can connect to color-capable terminals and also ;; switch color support on or off in mid-session by setting the @@ -1001,19 +1023,22 @@ opening the first frame (e.g. open a connection to an X server).") (if init-file-user (let ((user-init-file-1 (cond - ((eq system-type 'ms-dos) - (concat "~" init-file-user "/_emacs")) - ((eq system-type 'windows-nt) - ;; Prefer .emacs on Windows. - (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") - "~/.emacs" - ;; Also support _emacs for compatibility. - (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") - "~/_emacs" - ;; But default to .emacs if _emacs does not exist. - "~/.emacs"))) - (t - (concat "~" init-file-user "/.emacs"))))) + ((eq system-type 'ms-dos) + (concat "~" init-file-user "/_emacs")) + ((not (eq system-type 'windows-nt)) + (concat "~" init-file-user "/.emacs")) + ;; Else deal with the Windows situation + ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") + ;; Prefer .emacs on Windows. + "~/.emacs") + ((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") + ;; Also support _emacs for compatibility, but warn about it. + (push '(initialization + "`_emacs' init file is deprecated, please use `.emacs'") + delayed-warnings-list) + "~/_emacs") + (t ;; But default to .emacs if _emacs does not exist. + "~/.emacs")))) ;; This tells `load' to store the file name found ;; into user-init-file. (setq user-init-file t) @@ -1077,7 +1102,8 @@ the `--debug-init' option to view a complete error backtrace." user-init-file (get (car error) 'error-message) (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", ")) + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) :warning) (setq init-file-had-error t)))) @@ -1106,7 +1132,7 @@ the `--debug-init' option to view a complete error backtrace." (eq orig-enable-multibyte (default-value 'enable-multibyte-characters))) ;; Init file changed to unibyte. Reset existing multibyte - ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*). + ;; buffers (probably *scratch*, *Messages*, *Minibuf-0*). ;; Arguably this should only be done if they're free of ;; multibyte characters. (mapc (lambda (buffer) @@ -1166,6 +1192,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)) + (string-match + (concat "\\`" package-subdirectory-regexp "\\'") + subdir)) + (throw 'package-dir-found t))))))) + (package-initialize)) + (setq after-init-time (current-time)) (run-hooks 'after-init-hook) @@ -1248,25 +1299,25 @@ If this is nil, no message will be displayed." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst fancy-startup-text - '((:face (variable-pitch (:foreground "red")) + `((:face (variable-pitch font-lock-comment-face) "Welcome to " :link ("GNU Emacs" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) + ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) "Browse http://www.gnu.org/software/emacs/") ", one component of the " :link - (lambda () + ,(lambda () (if (eq system-type 'gnu/linux) - '("GNU/Linux" - (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) + `("GNU/Linux" + ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - '("GNU" (lambda (button) (describe-gnu-project)) + `("GNU" ,(lambda (_button) (describe-gnu-project)) "Display info on the GNU project"))) " operating system.\n\n" :face variable-pitch - :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) + :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) "\tLearn basic keystroke commands" - (lambda () + ,(lambda () (let* ((en "TUTORIAL") (tut (or (get-language-info current-language-environment 'tutorial) @@ -1284,19 +1335,20 @@ If this is nil, no message will be displayed." (concat " (" title ")")))) "\n" :link ("Emacs Guided Tour" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")) + ,(lambda (_button) + (browse-url "http://www.gnu.org/software/emacs/tour/")) "Browse http://www.gnu.org/software/emacs/tour/") "\tOverview of Emacs features at gnu.org\n" - :link ("View Emacs Manual" (lambda (button) (info-emacs-manual))) + :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual))) "\tView the Emacs manual using Info\n" - :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) + :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty))) "\tGNU Emacs comes with " :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch - :link ("Copying Conditions" (lambda (button) (describe-copying))) + :link ("Copying Conditions" ,(lambda (_button) (describe-copying))) "\tConditions for redistributing and changing Emacs\n" - :link ("Ordering Manuals" (lambda (button) (view-order-manuals))) + :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals))) "\tPurchasing printed copies of manuals\n" "\n")) "A list of texts to show in the middle part of splash screens. @@ -1304,61 +1356,58 @@ Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") (defconst fancy-about-text - '((:face (variable-pitch (:foreground "red")) + `((:face (variable-pitch font-lock-comment-face) "This is " :link ("GNU Emacs" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) + ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) "Browse http://www.gnu.org/software/emacs/") ", one component of the " :link - (lambda () + ,(lambda () (if (eq system-type 'gnu/linux) - '("GNU/Linux" - (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) + `("GNU/Linux" + ,(lambda (_button) + (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - '("GNU" (lambda (button) (describe-gnu-project)) + `("GNU" ,(lambda (_button) (describe-gnu-project)) "Display info on the GNU project."))) " operating system.\n" - :face (lambda () - (list 'variable-pitch - (list :foreground - (if (eq (frame-parameter nil 'background-mode) 'dark) - "cyan" "darkblue")))) + :face (variable-pitch font-lock-builtin-face) "\n" - (lambda () (emacs-version)) + ,(lambda () (emacs-version)) "\n" :face (variable-pitch (:height 0.8)) - (lambda () emacs-copyright) + ,(lambda () emacs-copyright) "\n\n" :face variable-pitch :link ("Authors" - (lambda (button) + ,(lambda (_button) (view-file (expand-file-name "AUTHORS" data-directory)) (goto-char (point-min)))) "\tMany people have contributed code included in GNU Emacs\n" :link ("Contributing" - (lambda (button) + ,(lambda (_button) (view-file (expand-file-name "CONTRIBUTE" data-directory)) (goto-char (point-min)))) "\tHow to contribute improvements to Emacs\n" "\n" - :link ("GNU and Freedom" (lambda (button) (describe-gnu-project))) + :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project))) "\tWhy we developed GNU Emacs, and the GNU operating system\n" - :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) + :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty))) "\tGNU Emacs comes with " :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch - :link ("Copying Conditions" (lambda (button) (describe-copying))) + :link ("Copying Conditions" ,(lambda (_button) (describe-copying))) "\tConditions for redistributing and changing Emacs\n" - :link ("Getting New Versions" (lambda (button) (describe-distribution))) + :link ("Getting New Versions" ,(lambda (_button) (describe-distribution))) "\tHow to obtain the latest version of Emacs\n" - :link ("Ordering Manuals" (lambda (button) (view-order-manuals))) + :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals))) "\tBuying printed manuals from the FSF\n" "\n" - :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) + :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) "\tLearn basic Emacs keystroke commands" - (lambda () + ,(lambda () (let* ((en "TUTORIAL") (tut (or (get-language-info current-language-environment 'tutorial) @@ -1376,10 +1425,10 @@ Each element in the list should be a list of strings or pairs (concat " (" title ")")))) "\n" :link ("Emacs Guided Tour" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")) + ,(lambda (_button) + (browse-url "http://www.gnu.org/software/emacs/tour/")) "Browse http://www.gnu.org/software/emacs/tour/") - "\tSee an overview of Emacs features at gnu.org" - )) + "\tSee an overview of Emacs features at gnu.org")) "A list of texts to show in the middle part of the About screen. Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") @@ -1401,8 +1450,8 @@ Each element in the list should be a list of strings or pairs (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) - (define-key map "\C-?" 'scroll-down) - (define-key map " " 'scroll-up) + (define-key map "\C-?" 'scroll-down-command) + (define-key map " " 'scroll-up-command) (define-key map "q" 'exit-splash-screen) map) "Keymap for splash screen buffer.") @@ -1483,96 +1532,97 @@ a face or button specification." (make-button (prog1 (point) (insert-image img)) (point) 'face 'default 'help-echo "mouse-2, RET: Browse http://www.gnu.org/" - 'action (lambda (button) (browse-url "http://www.gnu.org/")) + 'action (lambda (_button) (browse-url "http://www.gnu.org/")) 'follow-link t) (insert "\n\n"))))) (defun fancy-startup-tail (&optional concise) "Insert the tail part of the splash screen into the current buffer." - (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) - "cyan" "darkblue"))) - (unless concise - (fancy-splash-insert - :face 'variable-pitch - "\nTo start... " - :link '("Open a File" - (lambda (button) (call-interactively 'find-file)) - "Specify a new file's name, to edit the file") - " " - :link '("Open Home Directory" - (lambda (button) (dired "~")) - "Open your home directory, to operate on its files") - " " - :link '("Customize Startup" - (lambda (button) (customize-group 'initialization)) - "Change initialization settings including this screen") - "\n")) + (unless concise + (fancy-splash-insert + :face 'variable-pitch + "\nTo start... " + :link `("Open a File" + ,(lambda (_button) (call-interactively 'find-file)) + "Specify a new file's name, to edit the file") + " " + :link `("Open Home Directory" + ,(lambda (_button) (dired "~")) + "Open your home directory, to operate on its files") + " " + :link `("Customize Startup" + ,(lambda (_button) (customize-group 'initialization)) + "Change initialization settings including this screen") + "\n")) + (fancy-splash-insert + :face 'variable-pitch "To quit a partially entered command, type " + :face 'default "Control-g" + :face 'variable-pitch ".\n") + (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face) + "\nThis is " + (emacs-version) + "\n" + :face '(variable-pitch (:height 0.8)) + emacs-copyright + "\n") + (and auto-save-list-file-prefix + ;; Don't signal an error if the + ;; directory for auto-save-list files + ;; does not yet exist. + (file-directory-p (file-name-directory + auto-save-list-file-prefix)) + (directory-files + (file-name-directory auto-save-list-file-prefix) + nil + (concat "\\`" + (regexp-quote (file-name-nondirectory + auto-save-list-file-prefix))) + t) + (fancy-splash-insert :face '(variable-pitch font-lock-comment-face) + "\nIf an Emacs session crashed recently, " + "type " + :face '(fixed-pitch font-lock-comment-face) + "Meta-x recover-session RET" + :face '(variable-pitch font-lock-comment-face) + "\nto recover" + " the files you were editing.")) + + (when concise (fancy-splash-insert - :face 'variable-pitch "To quit a partially entered command, type " - :face 'default "Control-g" - :face 'variable-pitch ".\n") - (fancy-splash-insert :face `(variable-pitch (:foreground ,fg)) - "\nThis is " - (emacs-version) - "\n" - :face '(variable-pitch (:height 0.8)) - emacs-copyright - "\n") - (and auto-save-list-file-prefix - ;; Don't signal an error if the - ;; directory for auto-save-list files - ;; does not yet exist. - (file-directory-p (file-name-directory - auto-save-list-file-prefix)) - (directory-files - (file-name-directory auto-save-list-file-prefix) - nil - (concat "\\`" - (regexp-quote (file-name-nondirectory - auto-save-list-file-prefix))) - t) - (fancy-splash-insert :face '(variable-pitch (:foreground "red")) - "\nIf an Emacs session crashed recently, " - "type " - :face '(fixed-pitch :foreground "red") - "Meta-x recover-session RET" - :face '(variable-pitch (:foreground "red")) - "\nto recover" - " the files you were editing.")) - - (when concise - (fancy-splash-insert - :face 'variable-pitch "\n" - :link '("Dismiss this startup screen" - (lambda (button) - (when startup-screen-inhibit-startup-screen - (customize-set-variable 'inhibit-startup-screen t) - (customize-mark-to-save 'inhibit-startup-screen) - (custom-save-all)) - (let ((w (get-buffer-window "*GNU Emacs*"))) - (and w (not (one-window-p)) (delete-window w))) - (kill-buffer "*GNU Emacs*"))) - " ") - (when (or user-init-file custom-file) - (let ((checked (create-image "\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))) - (insert-button - " " :on-glyph checked :off-glyph unchecked 'checked nil - 'display unchecked 'follow-link t - 'action (lambda (button) - (if (overlay-get button 'checked) - (progn (overlay-put button 'checked nil) - (overlay-put button 'display (overlay-get button :off-glyph)) - (setq startup-screen-inhibit-startup-screen nil)) - (overlay-put button 'checked t) - (overlay-put button 'display (overlay-get button :on-glyph)) - (setq startup-screen-inhibit-startup-screen t))))) - (fancy-splash-insert :face '(variable-pitch (:height 0.9)) - " Never show it again."))))) + :face 'variable-pitch "\n" + :link `("Dismiss this startup screen" + ,(lambda (_button) + (when startup-screen-inhibit-startup-screen + (customize-set-variable 'inhibit-startup-screen t) + (customize-mark-to-save 'inhibit-startup-screen) + (custom-save-all)) + (let ((w (get-buffer-window "*GNU Emacs*"))) + (and w (not (one-window-p)) (delete-window w))) + (kill-buffer "*GNU Emacs*"))) + " ") + (when (or user-init-file custom-file) + (let ((checked (create-image "checked.xpm" + nil nil :ascent 'center)) + (unchecked (create-image "unchecked.xpm" + nil nil :ascent 'center))) + (insert-button + " " + :on-glyph checked + :off-glyph unchecked + 'checked nil 'display unchecked 'follow-link t + 'action (lambda (button) + (if (overlay-get button 'checked) + (progn (overlay-put button 'checked nil) + (overlay-put button 'display + (overlay-get button :off-glyph)) + (setq startup-screen-inhibit-startup-screen + nil)) + (overlay-put button 'checked t) + (overlay-put button 'display + (overlay-get button :on-glyph)) + (setq startup-screen-inhibit-startup-screen t))))) + (fancy-splash-insert :face '(variable-pitch (:height 0.9)) + " Never show it again.")))) (defun exit-splash-screen () "Stop displaying the splash screen buffer." @@ -1625,11 +1675,7 @@ splash screen in another window." (save-selected-window (select-frame frame) (switch-to-buffer "*About GNU Emacs*") - (setq buffer-undo-list t - mode-line-format - (concat "----" - (propertize "%b" 'face 'mode-line-buffer-id) - "%-")) + (setq buffer-undo-list t) (let ((inhibit-read-only t)) (erase-buffer) (if pure-space-overflow @@ -1692,9 +1738,6 @@ splash screen in another window." (erase-buffer) (setq default-directory command-line-default-directory) (set (make-local-variable 'tab-width) 8) - (if (not startup) - (set (make-local-variable 'mode-line-format) - (propertize "---- %b %-" 'face 'mode-line-buffer-id))) (if pure-space-overflow (insert pure-space-overflow-message)) @@ -1763,37 +1806,37 @@ To quit a partially entered command, type Control-g.\n") (insert "\nImportant Help menu items:\n") (insert-button "Emacs Tutorial" - 'action (lambda (button) (help-with-tutorial)) + 'action (lambda (_button) (help-with-tutorial)) 'follow-link t) (insert "\t\tLearn basic Emacs keystroke commands\n") (insert-button "Read the Emacs Manual" - 'action (lambda (button) (info-emacs-manual)) + 'action (lambda (_button) (info-emacs-manual)) 'follow-link t) (insert "\tView the Emacs manual using Info\n") (insert-button "\(Non)Warranty" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") (insert-button "Copying Conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert "\tConditions for redistributing and changing Emacs\n") (insert-button "More Manuals / Ordering Manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert " How to order printed manuals from the FSF\n") (insert "\nUseful tasks:\n") (insert-button "Visit New File" - 'action (lambda (button) (call-interactively 'find-file)) + 'action (lambda (_button) (call-interactively 'find-file)) 'follow-link t) (insert "\t\tSpecify a new file's name, to edit the file\n") (insert-button "Open Home Directory" - 'action (lambda (button) (dired "~")) + 'action (lambda (_button) (dired "~")) 'follow-link t) (insert "\tOpen your home directory, to operate on its files\n") (insert-button "Customize Startup" - 'action (lambda (button) (customize-group 'initialization)) + 'action (lambda (_button) (customize-group 'initialization)) 'follow-link t) (insert "\tChange initialization settings including this screen\n") @@ -1827,20 +1870,20 @@ To quit a partially entered command, type Control-g.\n") (where (key-description where)) (t "M-x help"))))) (insert-button "Emacs manual" - 'action (lambda (button) (info-emacs-manual)) + 'action (lambda (_button) (info-emacs-manual)) 'follow-link t) (insert (substitute-command-keys"\t \\[info-emacs-manual]\t")) (insert-button "Browse manuals" - 'action (lambda (button) (Info-directory)) + 'action (lambda (_button) (Info-directory)) 'follow-link t) (insert (substitute-command-keys "\t \\[info]\n")) (insert-button "Emacs tutorial" - 'action (lambda (button) (help-with-tutorial)) + 'action (lambda (_button) (help-with-tutorial)) 'follow-link t) (insert (substitute-command-keys "\t \\[help-with-tutorial]\tUndo changes\t \\[undo]\n")) (insert-button "Buy manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert (substitute-command-keys "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]"))) @@ -1848,7 +1891,7 @@ To quit a partially entered command, type Control-g.\n") ;; Say how to use the menu bar with the keyboard. (insert "\n") (insert-button "Activate menubar" - 'action (lambda (button) (tmm-menubar)) + 'action (lambda (_button) (tmm-menubar)) 'follow-link t) (if (and (eq (key-binding "\M-`") 'tmm-menubar) (eq (key-binding [f10]) 'tmm-menubar)) @@ -1864,21 +1907,21 @@ If you have no Meta key, you may instead type ESC followed by the character.)") (insert "\nUseful tasks:\n") (insert-button "Visit New File" - 'action (lambda (button) (call-interactively 'find-file)) + 'action (lambda (_button) (call-interactively 'find-file)) 'follow-link t) (insert "\t\t\t") (insert-button "Open Home Directory" - 'action (lambda (button) (dired "~")) + 'action (lambda (_button) (dired "~")) 'follow-link t) (insert "\n") (insert-button "Customize Startup" - 'action (lambda (button) (customize-group 'initialization)) + 'action (lambda (_button) (customize-group 'initialization)) 'follow-link t) (insert "\t\t") (insert-button "Open *scratch* buffer" - 'action (lambda (button) (switch-to-buffer - (get-buffer-create "*scratch*"))) + 'action (lambda (_button) (switch-to-buffer + (get-buffer-create "*scratch*"))) 'follow-link t) (insert "\n") (insert "\n" (emacs-version) "\n" emacs-copyright "\n") @@ -1891,36 +1934,36 @@ If you have no Meta key, you may instead type ESC followed by the character.)") " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ") (insert-button "full details" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type C-h C-c to see ") (insert-button "the conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert ". Type C-h C-d for information on ") (insert-button "getting the latest version" - 'action (lambda (button) (describe-distribution)) + 'action (lambda (_button) (describe-distribution)) 'follow-link t) (insert ".")) (insert (substitute-command-keys " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) (insert-button "full details" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert (substitute-command-keys ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type \\[describe-copying] to see ")) (insert-button "the conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert (substitute-command-keys". Type \\[describe-distribution] for information on ")) (insert-button "getting the latest version" - 'action (lambda (button) (describe-distribution)) + 'action (lambda (_button) (describe-distribution)) 'follow-link t) (insert "."))) @@ -1931,7 +1974,7 @@ Type \\[describe-distribution] for information on ")) (insert-button "Authors" 'action - (lambda (button) + (lambda (_button) (view-file (expand-file-name "AUTHORS" data-directory)) (goto-char (point-min))) 'follow-link t) @@ -1939,34 +1982,34 @@ Type \\[describe-distribution] for information on ")) (insert-button "Contributing" 'action - (lambda (button) + (lambda (_button) (view-file (expand-file-name "CONTRIBUTE" data-directory)) (goto-char (point-min))) 'follow-link t) (insert "\tHow to contribute improvements to Emacs\n\n") (insert-button "GNU and Freedom" - 'action (lambda (button) (describe-gnu-project)) + 'action (lambda (_button) (describe-gnu-project)) 'follow-link t) (insert "\t\tWhy we developed GNU Emacs and the GNU system\n") (insert-button "Absence of Warranty" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") (insert-button "Copying Conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert "\tConditions for redistributing and changing Emacs\n") (insert-button "Getting New Versions" - 'action (lambda (button) (describe-distribution)) + 'action (lambda (_button) (describe-distribution)) 'follow-link t) (insert "\tHow to get the latest version of GNU Emacs\n") (insert-button "More Manuals / Ordering Manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert "\tBuying printed manuals from the FSF\n")) @@ -1982,7 +2025,7 @@ Type \\[describe-distribution] for information on ")) (defun display-startup-echo-area-message () (let ((resize-mini-windows t)) - (or noninteractive ;(input-pending-p) init-file-had-error + (or noninteractive ;(input-pending-p) init-file-had-error ;; t if the init file says to inhibit the echo area startup message. (and inhibit-startup-echo-area-message user-init-file @@ -1992,24 +2035,21 @@ Type \\[describe-distribution] for information on ")) (user-login-name) init-file-user))) ;; Wasn't set with custom; see if .emacs has a setq. - (let ((buffer (get-buffer-create " *temp*"))) - (prog1 - (condition-case nil - (with-current-buffer buffer - (insert-file-contents user-init-file) - (re-search-forward - (concat - "([ \t\n]*setq[ \t\n]+" - "inhibit-startup-echo-area-message[ \t\n]+" - (regexp-quote - (prin1-to-string - (if (equal init-file-user "") - (user-login-name) - init-file-user))) - "[ \t\n]*)") - nil t)) - (error nil)) - (kill-buffer buffer))))) + (condition-case nil + (with-temp-buffer + (insert-file-contents user-init-file) + (re-search-forward + (concat + "([ \t\n]*setq[ \t\n]+" + "inhibit-startup-echo-area-message[ \t\n]+" + (regexp-quote + (prin1-to-string + (if (equal init-file-user "") + (user-login-name) + init-file-user))) + "[ \t\n]*)") + nil t)) + (error nil)))) (message "%s" (startup-echo-area-message))))) (defun display-startup-screen (&optional concise) @@ -2035,7 +2075,7 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'about-emacs 'display-about-screen) (defalias 'display-splash-screen 'display-startup-screen) -(defun command-line-1 (command-line-args-left) +(defun command-line-1 (args-left) (display-startup-echo-area-message) (when (and pure-space-overflow (not noninteractive)) @@ -2046,14 +2086,12 @@ A fancy display is used on graphic displays, normal otherwise." :warning)) (let ((file-count 0) + (command-line-args-left args-left) first-file-buffer) (when command-line-args-left ;; We have command args; process them. - ;; Note that any local variables in this function affect the - ;; ability of -f batch-byte-compile to detect free variables. - ;; So we give some of them with common names a cl1- prefix. - (let ((cl1-dir command-line-default-directory) - cl1-tem + (let ((dir command-line-default-directory) + tem ;; This approach loses for "-batch -L DIR --eval "(require foo)", ;; if foo is intended to be found in DIR. ;; @@ -2076,8 +2114,8 @@ A fancy display is used on graphic displays, normal otherwise." "--find-file" "--visit" "--file" "--no-desktop") (mapcar (lambda (elt) (concat "-" (car elt))) command-switch-alist))) - (cl1-line 0) - (cl1-column 0)) + (line 0) + (column 0)) ;; Add the long X options to longopts. (dolist (tem command-line-x-option-alist) @@ -2118,12 +2156,12 @@ A fancy display is used on graphic displays, normal otherwise." argi orig-argi))))) ;; Execute the option. - (cond ((setq cl1-tem (assoc argi command-switch-alist)) + (cond ((setq tem (assoc argi command-switch-alist)) (if argval (let ((command-line-args-left (cons argval command-line-args-left))) - (funcall (cdr cl1-tem) argi)) - (funcall (cdr cl1-tem) argi))) + (funcall (cdr tem) argi)) + (funcall (cdr tem) argi))) ((equal argi "-no-splash") (setq inhibit-startup-screen t)) @@ -2132,22 +2170,22 @@ A fancy display is used on graphic displays, normal otherwise." "-funcall" "-e")) ; what the source used to say (setq inhibit-startup-screen t) - (setq cl1-tem (intern (or argval (pop command-line-args-left)))) - (if (commandp cl1-tem) - (command-execute cl1-tem) - (funcall cl1-tem))) + (setq tem (intern (or argval (pop command-line-args-left)))) + (if (commandp tem) + (command-execute tem) + (funcall tem))) ((member argi '("-eval" "-execute")) (setq inhibit-startup-screen t) (eval (read (or argval (pop command-line-args-left))))) ((member argi '("-L" "-directory")) - (setq cl1-tem (expand-file-name + (setq tem (expand-file-name (command-line-normalize-file-name (or argval (pop command-line-args-left))))) - (cond (splice (setcdr splice (cons cl1-tem (cdr splice))) + (cond (splice (setcdr splice (cons tem (cdr splice))) (setq splice (cdr splice))) - (t (setq load-path (cons cl1-tem load-path) + (t (setq load-path (cons tem load-path) splice load-path)))) ((member argi '("-l" "-load")) @@ -2171,10 +2209,10 @@ A fancy display is used on graphic displays, normal otherwise." ((equal argi "-insert") (setq inhibit-startup-screen t) - (setq cl1-tem (or argval (pop command-line-args-left))) - (or (stringp cl1-tem) + (setq tem (or argval (pop command-line-args-left))) + (or (stringp tem) (error "File name omitted from `-insert' option")) - (insert-file-contents (command-line-normalize-file-name cl1-tem))) + (insert-file-contents (command-line-normalize-file-name tem))) ((equal argi "-kill") (kill-emacs t)) @@ -2187,42 +2225,47 @@ A fancy display is used on graphic displays, normal otherwise." (message "\"--no-desktop\" ignored because the Desktop package is not loaded")) ((string-match "^\\+[0-9]+\\'" argi) - (setq cl1-line (string-to-number argi))) + (setq line (string-to-number argi))) ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) - (setq cl1-line (string-to-number (match-string 1 argi)) - cl1-column (string-to-number (match-string 2 argi)))) + (setq line (string-to-number (match-string 1 argi)) + column (string-to-number (match-string 2 argi)))) - ((setq cl1-tem (assoc orig-argi command-line-x-option-alist)) + ((setq tem (assoc orig-argi command-line-x-option-alist)) ;; Ignore X-windows options and their args if not using X. (setq command-line-args-left - (nthcdr (nth 1 cl1-tem) command-line-args-left))) + (nthcdr (nth 1 tem) command-line-args-left))) - ((setq cl1-tem (assoc orig-argi command-line-ns-option-alist)) + ((setq tem (assoc orig-argi command-line-ns-option-alist)) ;; Ignore NS-windows options and their args if not using NS. (setq command-line-args-left - (nthcdr (nth 1 cl1-tem) command-line-args-left))) + (nthcdr (nth 1 tem) command-line-args-left))) ((member argi '("-find-file" "-file" "-visit")) (setq inhibit-startup-screen t) ;; An explicit option to specify visiting a file. - (setq cl1-tem (or argval (pop command-line-args-left))) - (unless (stringp cl1-tem) + (setq tem (or argval (pop command-line-args-left))) + (unless (stringp tem) (error "File name omitted from `%s' option" argi)) (setq file-count (1+ file-count)) (let ((file (expand-file-name - (command-line-normalize-file-name cl1-tem) - cl1-dir))) + (command-line-normalize-file-name tem) + dir))) (if (= file-count 1) (setq first-file-buffer (find-file file)) (find-file-other-window file))) - (unless (zerop cl1-line) + (unless (zerop line) (goto-char (point-min)) - (forward-line (1- cl1-line))) - (setq cl1-line 0) - (unless (< cl1-column 1) - (move-to-column (1- cl1-column))) - (setq cl1-column 0)) + (forward-line (1- line))) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq 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)) @@ -2245,32 +2288,32 @@ A fancy display is used on graphic displays, normal otherwise." (let ((file (expand-file-name (command-line-normalize-file-name orig-argi) - cl1-dir))) + dir))) (cond ((= file-count 1) (setq first-file-buffer (find-file file))) (inhibit-startup-screen (find-file-other-window file)) (t (find-file file)))) - (unless (zerop cl1-line) + (unless (zerop line) (goto-char (point-min)) - (forward-line (1- cl1-line))) - (setq cl1-line 0) - (unless (< cl1-column 1) - (move-to-column (1- cl1-column))) - (setq cl1-column 0)))))) + (forward-line (1- line))) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)))))) ;; In unusual circumstances, the execution of Lisp code due ;; to command-line options can cause the last visible frame ;; to be deleted. In this case, kill emacs to avoid an ;; abort later. (unless (frame-live-p (selected-frame)) (kill-emacs nil)))))) - (when initial-buffer-choice - (cond ((eq initial-buffer-choice t) - (switch-to-buffer (get-buffer-create "*scratch*"))) - ((stringp initial-buffer-choice) - (find-file initial-buffer-choice)))) + (when (eq initial-buffer-choice t) + ;; When initial-buffer-choice equals t make sure that *scratch* + ;; exists. + (get-buffer-create "*scratch*")) ;; If *scratch* exists and is empty, insert initial-scratch-message. + ;; Do this before switching to *scratch* below to handle bug#9605. (and initial-scratch-message (get-buffer "*scratch*") (with-current-buffer "*scratch*" @@ -2278,6 +2321,12 @@ A fancy display is used on graphic displays, normal otherwise." (insert initial-scratch-message) (set-buffer-modified-p nil)))) + (when initial-buffer-choice + (cond ((eq initial-buffer-choice t) + (switch-to-buffer (get-buffer-create "*scratch*"))) + ((stringp initial-buffer-choice) + (find-file initial-buffer-choice)))) + (if (or inhibit-startup-screen initial-buffer-choice noninteractive @@ -2342,5 +2391,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