]> code.delx.au - gnu-emacs/blobdiff - lisp/startup.el
Add a new function `svg-embed'
[gnu-emacs] / lisp / startup.el
index 3c9ada682d3d385006015eb6e981049fccab33db..761e69e03b1da8a6d833cb56806d101b0533393b 100644 (file)
@@ -1,6 +1,6 @@
 ;;; 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
@@ -76,17 +76,28 @@ once you are familiar with the contents of the startup screen."
 
 (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:
- (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
+ (eval \\='(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
 Thus, someone else using a copy of your init file will see the
 startup message unless he personally acts to inhibit it."
   :type '(choice (const :tag "Don't inhibit")
@@ -114,7 +125,7 @@ the remaining command-line args are in the variable `command-line-args-left'.")
 
 (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)
@@ -428,7 +439,7 @@ Warning Warning!!!  Pure space overflow    !!!Warning Warning
   :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'."
@@ -544,7 +555,11 @@ It is the default value of the variable `top-level'."
            (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
@@ -581,7 +596,7 @@ It is the default value of the variable `top-level'."
         (set (make-local-variable 'window-point-insertion-type) t)
         ;; Give *Messages* the same default-directory as *scratch*,
         ;; just to keep things predictable.
-       (setq default-directory dir)))
+       (setq default-directory (or dir (expand-file-name "~/")))))
     ;; `user-full-name' is now known; reset its standard-value here.
     (put 'user-full-name 'standard-value
         (list (default-value 'user-full-name)))
@@ -590,11 +605,12 @@ It is the default value of the variable `top-level'."
       (and (stringp pwd)
           ;; Use FOO/., so that if FOO is a symlink, file-attributes
           ;; describes the directory linked to, not FOO itself.
-          (or (equal (file-attributes
+          (or (and default-directory
+                   (equal (file-attributes
                       (concat (file-name-as-directory pwd) "."))
                      (file-attributes
                       (concat (file-name-as-directory default-directory)
-                              ".")))
+                              "."))))
               (setq process-environment
                     (delete (concat "PWD=" pwd)
                             process-environment)))))
@@ -609,12 +625,15 @@ It is the default value of the variable `top-level'."
                (mapcar (lambda (dir)
                          (decode-coding-string dir coding t))
                        charset-map-path))))
-    (setq default-directory (abbreviate-file-name default-directory))
+    (if default-directory
+       (setq default-directory (abbreviate-file-name default-directory))
+      (display-warning 'initialization "Error setting default-directory"))
     (let ((old-face-font-rescale-alist face-font-rescale-alist))
       (unwind-protect
          (command-line)
        ;; Do this again, in case .emacs defined more abbreviations.
-       (setq default-directory (abbreviate-file-name default-directory))
+       (if default-directory
+           (setq default-directory (abbreviate-file-name default-directory)))
        ;; Specify the file for recording all the auto save files of this session.
        ;; This is used by recover-session.
        (or auto-save-list-file-name
@@ -716,7 +735,7 @@ Window system startup files should add their own function to this
 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)
@@ -799,6 +818,62 @@ to prepare for opening the first frame (e.g. open a connection to an X server)."
 (defvar server-name)
 (defvar server-process)
 
+(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'.
 Amongst another things, it parses the command-line arguments."
@@ -1013,6 +1088,10 @@ please check its value")
                                '("no" "off" "false" "0")))))
     (setq no-blinking-cursor t))
 
+  (unless noninteractive
+    (startup--setup-quote-display)
+    (setq internal--text-quoting-flag t))
+
   ;; Re-evaluate predefined variables whose initial value depends on
   ;; the runtime context.
   (mapc 'custom-reevaluate-setting
@@ -1103,8 +1182,9 @@ please check its value")
                              "~/.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'")
+                             (push `(initialization
+                                     ,(format-message
+                                       "`_emacs' init file is deprecated, please use `.emacs'"))
                                    delayed-warnings-list)
                              "~/_emacs")
                             (t ;; But default to .emacs if _emacs does not exist.
@@ -1163,25 +1243,19 @@ please check its value")
                (funcall inner)
                (setq init-file-had-error nil))
            (error
-            ;; Postpone displaying the warning until all hooks
-            ;; in `after-init-hook' like `desktop-read' will finalize
-            ;; possible changes in the window configuration.
-            (add-hook
-             'after-init-hook
-             (lambda ()
-               (display-warning
-                'initialization
-                (format "An error occurred while loading `%s':\n\n%s%s%s\n\n\
+            (display-warning
+             'initialization
+             (format-message "\
+An error occurred while loading `%s':\n\n%s%s%s\n\n\
 To ensure normal operation, you should investigate and remove the
 cause of the error in your initialization file.  Start Emacs with
 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) ", "))
-                :warning))
-             t)
+                     user-init-file
+                     (get (car error) 'error-message)
+                     (if (cdr error) ": " "")
+                     (mapconcat (lambda (s) (prin1-to-string s t))
+                                (cdr error) ", "))
+             :warning)
             (setq init-file-had-error t))))
 
       (if (and deactivate-mark transient-mark-mode)
@@ -1264,7 +1338,10 @@ the `--debug-init' option to view a complete error backtrace."
        (package-initialize))
 
   (setq after-init-time (current-time))
-  (run-hooks 'after-init-hook)
+  ;; Display any accumulated warnings after all functions in
+  ;; `after-init-hook' like `desktop-read' have finalized possible
+  ;; changes in the window configuration.
+  (run-hooks 'after-init-hook 'delayed-warnings-hook)
 
   ;; If *scratch* exists and init file didn't change its mode, initialize it.
   (if (get-buffer "*scratch*")
@@ -1304,7 +1381,8 @@ the `--debug-init' option to view a complete error backtrace."
                         (expand-file-name user-emacs-directory))
           (setq warned t)
           (display-warning 'initialization
-                           (format "Your `load-path' seems to contain
+                           (format-message "\
+Your `load-path' seems to contain\n\
 your `.emacs.d' directory: %s\n\
 This is likely to cause problems...\n\
 Consider using a subdirectory instead, e.g.: %s"
@@ -1363,12 +1441,11 @@ settings will be marked as \"CHANGED outside of Customize\"."
       (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 C-x C-f,
-;; 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 message displayed in *scratch* buffer at startup.
+  "Initial documentation displayed in *scratch* buffer at startup.
 If this is nil, no message will be displayed."
   :type '(choice (text :tag "Message")
                 (const :tag "none" nil))
@@ -1813,10 +1890,12 @@ we put it on this frame."
       (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)))))))
 
 
@@ -1875,7 +1954,7 @@ splash screen in another window."
                                   auto-save-list-file-prefix)))
            t)
           (insert "\n\nIf an Emacs session crashed recently, "
-                  "type Meta-x recover-session RET\nto recover"
+                  "type M-x recover-session RET\nto recover"
                   " the files you were editing.\n"))
 
       (use-local-map splash-screen-keymap)
@@ -1907,7 +1986,7 @@ To quit a partially entered command, type Control-g.\n")
                 '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")
@@ -1924,7 +2003,8 @@ To quit a partially entered command, type Control-g.\n")
   (insert-button "Visit New 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 (substitute-command-keys
+          "\t\tSpecify a new file's name, to edit the file\n"))
   (insert-button "Open Home Directory"
                 'action (lambda (_button) (dired "~"))
                 'follow-link t)
@@ -1990,9 +2070,9 @@ To quit a partially entered command, type Control-g.\n")
     (insert (substitute-command-keys "   \\[tmm-menubar]")))
 
   ;; Many users seem to have problems with these.
-  (insert "
+  (insert (substitute-command-keys "
 \(`C-' means use the CTRL key.  `M-' means use the Meta (or Alt) key.
-If you have no Meta key, you may instead type ESC followed by the character.)")
+If you have no Meta key, you may instead type ESC followed by the character.)"))
 
   ;; Insert links to useful tasks
   (insert "\nUseful tasks:\n")
@@ -2153,9 +2233,12 @@ A fancy display is used on graphic displays, normal otherwise."
   ;; which includes files parsed from the command line arguments and
   ;; `initial-buffer-choice'.  All of the display logic happens at the
   ;; end of this `let'.  As files as processed from the command line
-  ;; arguments, their buffers are prepended to `displayable-buffers'
-  ;; but they are not displayed until command line parsing has
-  ;; finished.
+  ;; arguments, their buffers are prepended to `displayable-buffers'.
+  ;; In order for options like "--eval" to work with the "--file" arg,
+  ;; the file buffers are set as the current buffer as they are seen
+  ;; on the command line (so "emacs --batch --file a --file b
+  ;; --eval='(message "%s" (buffer-name))'" will print "b"), but this
+  ;; does not affect the final displayed state of the buffers.
   (let ((displayable-buffers nil))
     ;; This `let' processes the command line arguments.
     (let ((command-line-args-left args-left))
@@ -2186,19 +2269,29 @@ A fancy display is used on graphic displays, normal otherwise."
                                 command-switch-alist)))
                (line 0)
                (column 0)
-               ;; `process-file-arg' opens a file buffer for `name'
-               ;; without switching to the buffer, adds the buffer to
+               ;; `process-file-arg' opens a file buffer for `name',
+               ;; sets that buffer as the current buffer without
+               ;; displaying it, adds the buffer to
                ;; `displayable-buffers', and puts the point at
-               ;; `line':`column'. `line' and `column' are both reset
+               ;; `line':`column'.  `line' and `column' are both reset
                ;; to zero when `process-file-arg' returns.
                (process-file-arg
                 (lambda (name)
-                  (let* ((file (expand-file-name
-                                (command-line-normalize-file-name name)
-                                dir))
-                         (buf (find-file-noselect file)))
-                    (setq displayable-buffers (cons buf displayable-buffers))
-                    (with-current-buffer buf
+                 ;; This can only happen if PWD is deleted.
+                 (if (not (or dir (file-name-absolute-p name)))
+                     (message "Ignoring relative file name (%s) due to \
+nil default-directory" name)
+                   (let* ((file (expand-file-name
+                                 (command-line-normalize-file-name name)
+                                 dir))
+                          (buf (find-file-noselect file)))
+                     (setq displayable-buffers (cons buf displayable-buffers))
+                      ;; Set the file buffer to the current buffer so
+                      ;; that it will be used with "--eval" and
+                      ;; similar options.
+                      (set-buffer buf)
+                      ;; Put the point at `line':`column' in the file
+                      ;; buffer, and reset `line' and `column' to 0.
                       (unless (zerop line)
                         (goto-char (point-min))
                         (forward-line (1- line)))
@@ -2390,7 +2483,7 @@ A fancy display is used on graphic displays, normal otherwise."
         (get-buffer "*scratch*")
         (with-current-buffer "*scratch*"
           (when (zerop (buffer-size))
-            (insert initial-scratch-message)
+            (insert (substitute-command-keys initial-scratch-message))
             (set-buffer-modified-p nil))))
 
     ;; Prepend `initial-buffer-choice' to `displayable-buffers'.