;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-2015 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1992, 1994-2016 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
(defvar startup-screen-inhibit-startup-screen nil)
-;; FIXME? Why does this get such weirdly extreme treatment, when the
-;; more important inhibit-startup-screen does not.
+;; The mechanism used to ensure that only end users can disable this
+;; message is not complex. Clearly, it is possible for a determined
+;; system administrator to inhibit this message anyway, but at least
+;; they will do so with knowledge of why the Emacs developers think
+;; this is a bad idea.
(defcustom inhibit-startup-echo-area-message nil
"Non-nil inhibits the initial startup echo area message.
-Setting this variable takes effect
-only if you do it with the customization buffer
-or if your init file contains a line of this form:
+
+The startup message is in the echo area as it provides information
+about GNU Emacs and the GNU system in general, which we want all
+users to see. As this is the least intrusive startup message,
+this variable gets specialized treatment to prevent the message
+from being disabled site-wide by systems administrators, while
+still allowing individual users to do so.
+
+Setting this variable takes effect only if you do it with the
+customization buffer or if your init file contains a line of this
+form:
(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
If your init file is byte-compiled, use the following form
instead:
(defvaralias 'argv 'command-line-args-left
"List of command-line args not yet processed.
-This is a convenience alias, so that one can write \(pop argv\)
+This is a convenience alias, so that one can write \(pop argv)
inside of --eval command line arguments in order to access
following arguments.")
(internal-make-var-non-special 'argv)
:initialize #'custom-initialize-delay)
(defun normal-top-level-add-subdirs-to-load-path ()
- "Add all subdirectories of `default-directory' to `load-path'.
+ "Recursively 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'."
(set-buffer elt)
(if default-directory
(setq default-directory
- (decode-coding-string default-directory coding t)))))
+ (if (eq system-type 'windows-nt)
+ ;; Convert backslashes to forward slashes.
+ (expand-file-name
+ (decode-coding-string default-directory coding t))
+ (decode-coding-string default-directory coding t))))))
;; Decode all the important variables and directory lists, now
;; that we know the locale's encoding. This is because the
method, which should parse the command line arguments. Those
pertaining to the window system should be processed and removed
from the returned command line.")
-(cl-defmethod handle-args-function (args &context (window-system (eql nil)))
+(cl-defmethod handle-args-function (args &context (window-system nil))
(tty-handle-args args))
(cl-defgeneric window-system-initialization (&optional _display)
(defvar server-name)
(defvar server-process)
-(defun startup--setup-quote-display ()
- "Display ASCII approximations on user request or if curved quotes don't work."
- (when (memq text-quoting-style '(nil grave straight))
- (dolist (char-repl '((?‘ . ?\`) (?’ . ?\') (?“ . ?\") (?” . ?\")))
- (let ((char (car char-repl))
- (repl (cdr char-repl)))
- (when (or text-quoting-style (not (char-displayable-p char)))
- (when (and (eq repl ?\`) (eq text-quoting-style 'straight))
- (setq repl ?\'))
- (unless standard-display-table
- (setq standard-display-table (make-display-table)))
- (aset standard-display-table char
- (vector (make-glyph-code repl 'shadow))))))))
+(defun startup--setup-quote-display (&optional style)
+ "If needed, display ASCII approximations to curved quotes.
+Do this by modifying `standard-display-table'. Optional STYLE
+specifies the desired quoting style, as in `text-quoting-style'.
+If STYLE is nil, display appropriately for the terminal."
+ (let ((repls (let ((style-repls (assq style '((grave . "`'\"\"")
+ (straight . "''\"\"")))))
+ (if style-repls (cdr style-repls) (make-vector 4 nil))))
+ glyph-count)
+ ;; REPLS is a sequence of the four replacements for "‘’“”", respectively.
+ ;; If STYLE is nil, infer REPLS from terminal characteristics.
+ (unless style
+ ;; On a terminal that supports glyph codes,
+ ;; GLYPH-COUNT[i] is the number of times that glyph code I
+ ;; represents either an ASCII character or one of the 4
+ ;; quote characters. This assumes glyph codes are valid
+ ;; Elisp characters, which is a safe assumption in practice.
+ (when (integerp (internal-char-font nil (max-char)))
+ (setq glyph-count (make-char-table nil 0))
+ (dotimes (i 132)
+ (let ((glyph (internal-char-font
+ nil (if (< i 128) i (aref "‘’“”" (- i 128))))))
+ (when (<= 0 glyph)
+ (aset glyph-count glyph (1+ (aref glyph-count glyph)))))))
+ (dotimes (i 2)
+ (let ((lq (aref "‘“" i)) (rq (aref "’”" i))
+ (lr (aref "`\"" i)) (rr (aref "'\"" i))
+ (i2 (* i 2)))
+ (unless (if glyph-count
+ ;; On a terminal that supports glyph codes, use
+ ;; ASCII replacements unless both quotes are displayable.
+ ;; If not using ASCII replacements, highlight
+ ;; quotes unless they are both unique among the
+ ;; 128 + 4 characters of concern.
+ (let ((lglyph (internal-char-font nil lq))
+ (rglyph (internal-char-font nil rq)))
+ (when (and (<= 0 lglyph) (<= 0 rglyph))
+ (setq lr lq rr rq)
+ (and (= 1 (aref glyph-count lglyph))
+ (= 1 (aref glyph-count rglyph)))))
+ ;; On a terminal that does not support glyph codes, use
+ ;; ASCII replacements unless both quotes are displayable.
+ (and (char-displayable-p lq)
+ (char-displayable-p rq)))
+ (aset repls i2 lr)
+ (aset repls (1+ i2) rr)))))
+ (dotimes (i 4)
+ (let ((char (aref "‘’“”" i))
+ (repl (aref repls i)))
+ (if repl
+ (aset (or standard-display-table
+ (setq standard-display-table (make-display-table)))
+ char (vector (make-glyph-code repl 'escape-glyph)))
+ (when standard-display-table
+ (aset standard-display-table char nil)))))))
(defun command-line ()
"A subroutine of `normal-top-level'.
;; unibyte (display table, terminal coding system &c).
(set-language-environment current-language-environment)))
- ;; Setup quote display again, if the init file sets
- ;; text-quoting-style to a non-nil value.
- (when (and (not noninteractive) text-quoting-style)
- (startup--setup-quote-display))
-
;; Do this here in case the init file sets mail-host-address.
(if (equal user-mail-address "")
(setq user-mail-address (or (getenv "EMAIL")
(put 'cursor 'face-modified t))))
(defcustom initial-scratch-message (purecopy "\
-;; This buffer is for notes you don't want to save, and for Lisp evaluation.
-;; If you want to create a file, visit that file with \\[find-file],
-;; then enter the text in that file's own buffer.
+;; This buffer is for text that is not saved, and for Lisp evaluation.
+;; To create a file, visit it with \\[find-file] and enter text in its buffer.
")
"Initial documentation displayed in *scratch* buffer at startup.
(when frame
(let* ((img (create-image (fancy-splash-image-file)))
(image-height (and img (cdr (image-size img nil frame))))
- ;; We test frame-height so that, if the frame is split
- ;; by displaying a warning, that doesn't cause the normal
- ;; splash screen to be used.
- (frame-height (1- (frame-height frame))))
+ ;; We test frame-height and not window-height so that,
+ ;; if the frame is split by displaying a warning, that
+ ;; doesn't cause the normal splash screen to be used.
+ ;; We subtract 2 from frame-height to account for the
+ ;; echo area and the mode line.
+ (frame-height (- (frame-height frame) 2)))
(> frame-height (+ image-height 19)))))))
'action (lambda (_button) (info-emacs-manual))
'follow-link t)
(insert "\tView the Emacs manual using Info\n")
- (insert-button "\(Non)Warranty"
+ (insert-button "(Non)Warranty"
'action (lambda (_button) (describe-no-warranty))
'follow-link t)
(insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")