;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(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 a string, visit the specified file
-or directory using `find-file'. If t, open the `*scratch*'
-buffer.
+startup screen. If the value is a string, switch to a buffer
+visiting the file or directory specified by that string. If the
+value is a function, switch to the buffer returned by that
+function. If t, open the `*scratch*' buffer.
A string value also causes emacsclient to open the specified file
or directory when no target file is specified."
(const :tag "Startup screen" nil)
(directory :tag "Directory" :value "~/")
(file :tag "File" :value "~/.emacs")
+ (const :tag "Notes buffer" remember-notes)
+ (function :tag "Function")
(const :tag "Lisp scratch buffer" t))
- :version "23.1"
+ :version "24.4"
:group 'initialization)
(defcustom inhibit-startup-screen nil
(defvar no-blinking-cursor nil)
-(defvar default-frame-background-mode)
-
(defvar pure-space-overflow nil
"Non-nil if building Emacs overflowed pure space.")
: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.")
+(defvar package--builtin-versions
+ ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
+ (purecopy `((emacs . ,(version-to-list emacs-version))))
+ "Alist giving the version of each versioned builtin package.
+I.e. each element of the list is of the form (NAME . VERSION) where
+NAME is the package name as a symbol, and VERSION is its version
+as a list.")
+
+(defun package--description-file (dir)
+ (concat (let ((subdir (file-name-nondirectory
+ (directory-file-name dir))))
+ (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
+ (match-string 1 subdir) subdir))
+ "-pkg.el"))
(defun normal-top-level-add-subdirs-to-load-path ()
"Add all subdirectories of `default-directory' to `load-path'.
(let* ((this-dir (car dirs))
(contents (directory-files this-dir))
(default-directory this-dir)
- (canonicalized (if (fboundp 'untranslated-canonical-name)
- (untranslated-canonical-name this-dir))))
+ (canonicalized (if (fboundp 'w32-untranslated-canonical-name)
+ (w32-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.
(setq attrs (or canonicalized
(setq command-line-processed t)
(let ((dir default-directory))
(with-current-buffer "*Messages*"
+ (messages-buffer-mode)
;; Make it easy to do like "tail -f".
(set (make-local-variable 'window-point-insertion-type) t)
;; Give *Messages* the same default-directory as *scratch*,
default-frame-alist))
(t
(push argi rest)))))
- (nreverse rest)))
+ (nconc (nreverse rest) args)))
(declare-function x-get-resource "frame.c"
(attribute class &optional component subclass))
(locate-file "simple" load-path (get-load-suffixes)))
lisp-dir)
;; Don't abort if simple.el cannot be found, but print a warning.
+ ;; Although in most usage we are going to cryptically abort a moment
+ ;; later anyway, due to missing required bidi data files (eg bug#13430).
(if (null simple-file-name)
- (progn
- (princ "Warning: Could not find simple.el nor simple.elc"
- 'external-debugging-output)
- (terpri 'external-debugging-output))
+ (let ((standard-output 'external-debugging-output)
+ (lispdir (expand-file-name "../lisp" data-directory)))
+ (princ "Warning: Could not find simple.el or simple.elc")
+ (terpri)
+ (when (getenv "EMACSLOADPATH")
+ (princ "The EMACSLOADPATH environment variable is set, \
+please check its value")
+ (terpri))
+ (unless (file-readable-p lispdir)
+ (princ (format "Lisp directory %s not readable?" lispdir))
+ (terpri)))
(setq lisp-dir (file-truename (file-name-directory simple-file-name)))
(setq load-history
(mapcar (lambda (elt)
(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))
+ (when (let ((subdir (expand-file-name subdir dir)))
+ (and (file-directory-p subdir)
+ (file-exists-p
+ (expand-file-name
+ (package--description-file subdir)
+ subdir))))
(throw 'package-dir-found t)))))))
(package-initialize))
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
(define-key map "\C-?" 'scroll-down-command)
+ (define-key map [?\S-\ ] 'scroll-down-command)
(define-key map " " 'scroll-up-command)
(define-key map "q" 'exit-splash-screen)
map)
(t "splash.pbm")))
(img (create-image image-file))
(image-width (and img (car (image-size img))))
- (window-width (window-width (selected-window))))
+ (window-width (window-width)))
(when img
(when (> window-width image-width)
;; Center the image in the window.
: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 auto-save-list-file-prefix
+ (let ((dir (file-name-directory auto-save-list-file-prefix))
+ (name (file-name-nondirectory auto-save-list-file-prefix))
+ files)
+ ;; Don't warn if the directory for auto-save-list files does not
+ ;; yet exist.
+ (and (file-directory-p dir)
+ (setq files (directory-files dir nil (concat "\\`" name) t))
+ (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
+ (if (= (length files) 1)
+ "\nAn auto-save file list was found. "
+ "\nAuto-save file lists were found. ")
+ "If an Emacs session crashed recently,\ntype "
+ :link `("M-x recover-session RET"
+ ,(lambda (_button)
+ (call-interactively
+ 'recover-session)))
+ " to recover the files you were editing."))))
(when concise
(fancy-splash-insert
(insert "\n" (emacs-version)
"\n" emacs-copyright))
-;; No mouse menus, so give help using kbd commands.
(defun normal-no-mouse-startup-screen ()
-
- ;; If keys have their default meanings,
- ;; use precomputed string to save lots of time.
+ "Show a splash screen suitable for displays without mouse support."
(let* ((c-h-accessible
;; If normal-erase-is-backspace is used on a tty, there's
;; no way to invoke C-h and you have to use F1 instead.
'follow-link t)
(insert "\n")
(insert "\n" (emacs-version) "\n" emacs-copyright "\n")
-
- (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
- (eq (key-binding "\C-h\C-d") 'describe-distribution)
- (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
- (progn
- (insert
- "
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
- (insert-button "full details"
- '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))
- 'follow-link t)
- (insert ".
-Type C-h C-d for information on ")
- (insert-button "getting the latest version"
- 'action (lambda (_button) (describe-distribution))
- 'follow-link t)
- (insert "."))
- (insert (substitute-command-keys
- "
+ (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))
- 'follow-link t)
- (insert (substitute-command-keys ".
+ (insert-button "full details"
+ '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))
- 'follow-link t)
- (insert (substitute-command-keys".
+ (insert-button "the conditions"
+ '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))
- 'follow-link t)
- (insert ".")))
+ (insert-button "getting the latest version"
+ 'action (lambda (_button) (describe-distribution))
+ 'follow-link t)
+ (insert "."))
(defun normal-about-screen ()
(insert "\n" (emacs-version) "\n" emacs-copyright "\n\n")
(insert "\tBuying printed manuals from the FSF\n"))
(defun startup-echo-area-message ()
- (cond ((daemonp)
- "Starting Emacs daemon.")
- ((eq (key-binding "\C-h\C-a") 'about-emacs)
- "For information about GNU Emacs and the GNU system, type C-h C-a.")
- (t
- (substitute-command-keys
- "For information about GNU Emacs and the GNU system, type \
-\\[about-emacs]."))))
+ (if (daemonp)
+ "Starting Emacs daemon."
+ (substitute-command-keys
+ "For information about GNU Emacs and the GNU system, type \
+\\[about-emacs].")))
(defun display-startup-echo-area-message ()
(let ((resize-mini-windows t))
(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))))
+ (let ((buf
+ (cond ((stringp initial-buffer-choice)
+ (find-file-noselect initial-buffer-choice))
+ ((functionp initial-buffer-choice)
+ (funcall initial-buffer-choice)))))
+ (switch-to-buffer
+ (if (buffer-live-p buf) buf (get-buffer-create "*scratch*"))
+ 'norecord)))
(if (or inhibit-startup-screen
initial-buffer-choice
;; Use arg 1 so that we don't collapse // at the start of the file name.
;; That is significant on some systems.
;; However, /// at the beginning is supposed to mean just /, not //.
- (if (string-match "^///+" file)
+ (if (string-match
+ (if (memq system-type '(ms-dos windows-nt))
+ "^\\([\\/][\\/][\\/]\\)+"
+ "^///+")
+ file)
(setq file (replace-match "/" t t file)))
- (and (memq system-type '(ms-dos windows-nt))
- (string-match "^[A-Za-z]:\\(\\\\[\\\\/]\\)" file) ; C:\/ or C:\\
- (setq file (replace-match "/" t t file 1)))
- (while (string-match "//+" file 1)
- (setq file (replace-match "/" t t file)))
+ (if (memq system-type '(ms-dos windows-nt))
+ (while (string-match "\\([\\/][\\/]\\)+" file 1)
+ (setq file (replace-match "/" t t file)))
+ (while (string-match "//+" file 1)
+ (setq file (replace-match "/" t t file))))
file))
;;; startup.el ends here
HCoop / bpt / emacs.git / blobdiff