[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/startup.el,v [EMACS_22_BASE]
|
From: |
Juri Linkov |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/startup.el,v [EMACS_22_BASE] |
|
Date: |
Sat, 10 Nov 2007 21:18:50 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Branch: EMACS_22_BASE
Changes by: Juri Linkov <jurta> 07/11/10 21:18:49
Index: startup.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/startup.el,v
retrieving revision 1.436.2.5
retrieving revision 1.436.2.6
diff -u -b -r1.436.2.5 -r1.436.2.6
--- startup.el 12 Oct 2007 02:49:58 -0000 1.436.2.5
+++ startup.el 10 Nov 2007 21:18:48 -0000 1.436.2.6
@@ -38,9 +38,9 @@
(defgroup initialization nil
"Emacs start-up procedure."
- :group 'internal)
+ :group 'environment)
-(defcustom inhibit-splash-screen nil
+(defcustom inhibit-startup-screen nil
"Non-nil inhibits the startup screen.
It also inhibits display of the initial message in the `*scratch*' buffer.
@@ -49,7 +49,10 @@
:type 'boolean
:group 'initialization)
-(defvaralias 'inhibit-startup-message 'inhibit-splash-screen)
+(defvaralias 'inhibit-splash-screen 'inhibit-startup-screen)
+(defvaralias 'inhibit-startup-message 'inhibit-startup-screen)
+
+(defvar startup-screen-inhibit-startup-screen nil)
(defcustom inhibit-startup-echo-area-message nil
"*Non-nil inhibits the initial startup echo area message.
@@ -295,6 +298,10 @@
(defvar pure-space-overflow nil
"Non-nil if building Emacs overflowed pure space.")
+(defvar pure-space-overflow-message "\
+Warning Warning!!! Pure space overflow !!!Warning Warning
+\(See the node Pure Storage in the Lisp manual for details.)\n")
+
(defun normal-top-level-add-subdirs-to-load-path ()
"Add all subdirectories of current directory to `load-path'.
More precisely, this uses only the subdirectories whose names
@@ -823,8 +830,8 @@
(load site-run-file t t))
;; Sites should not disable this. Only individuals should disable
- ;; the startup message.
- (setq inhibit-startup-message nil)
+ ;; the startup screen.
+ (setq inhibit-startup-screen nil)
;; Warn for invalid user name.
(when init-file-user
@@ -918,7 +925,7 @@
(setq user-init-file source))))
(unless inhibit-default-init
- (let ((inhibit-startup-message nil))
+ (let ((inhibit-startup-screen nil))
;; Users are supposed to be told their rights.
;; (Plus how to get help and how to undo.)
;; Don't you dare turn this off for anyone
@@ -1117,7 +1124,7 @@
")
"Initial message displayed in *scratch* buffer at startup.
If this is nil, no message will be displayed.
-If `inhibit-splash-screen' is non-nil, then no message is displayed,
+If `inhibit-startup-screen' is non-nil, then no message is displayed,
regardless of the value of this variable."
:type '(choice (text :tag "Message")
(const :tag "none" nil))
@@ -1128,10 +1135,27 @@
;;; Fancy splash screen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar fancy-splash-text
- '((:face (variable-pitch :weight bold)
- "Important Help menu items:\n"
- :face variable-pitch
+(defvar fancy-startup-text
+ '((:face (variable-pitch :foreground "red")
+ "Welcome to "
+ :link ("GNU Emacs"
+ (lambda (button) (browse-url "http://www.gnu.org/software/emacs/";))
+ "Browse http://www.gnu.org/software/emacs/";)
+ ", one component of the "
+ :link
+ (lambda ()
+ (if (eq system-type 'gnu/linux)
+ '("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-project))
+ "Display info on the GNU project")))
+ " operating system.\n"
+ :face variable-pitch "To quit a partially entered command, type "
+ :face default "Control-g"
+ :face variable-pitch ".\n\n"
+ :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+ "\tLearn basic keystroke commands"
(lambda ()
(let* ((en "TUTORIAL")
(tut (or (get-language-info current-language-environment
@@ -1145,48 +1169,97 @@
(buffer-substring (point-min) (1- (point))))))
;; If there is a specific tutorial for the current language
;; environment and it is not English, append its title.
- (concat
- "Emacs Tutorial\t\tLearn how to use Emacs efficiently"
(if (string= en tut)
""
- (concat " (" title ")"))
- "\n")))
- :face variable-pitch "\
-Emacs FAQ\t\tFrequently asked questions and answers
-View Emacs Manual\t\tView the Emacs manual using Info
-Absence of Warranty\tGNU Emacs comes with "
+ (concat " (" title ")"))))
+ "\n"
+ :face variable-pitch
+ :link ("Emacs Guided Tour"
+ (lambda (button) (browse-url
"http://www.gnu.org/software/emacs/tour/";))
+ "Browse http://www.gnu.org/software/emacs/tour/";)
+ "\tOverview of Emacs features\n"
+ :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)))
+ "\tGNU Emacs comes with "
:face (variable-pitch :slant oblique)
"ABSOLUTELY NO WARRANTY\n"
:face variable-pitch
- "\
-Copying Conditions\t\tConditions for redistributing and changing Emacs
-Getting New Versions\tHow to obtain the latest version of Emacs
-More Manuals / Ordering Manuals Buying printed manuals from the FSF\n")
- (:face variable-pitch
- "\nTo quit a partially entered command, type "
- :face default
- "Control-g"
- :face variable-pitch
- ".
-
-Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/
+ :link ("Copying Conditions" (lambda (button) (describe-copying)))
+ "\tConditions for redistributing and changing Emacs\n"
+ :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.
+Each element in the list should be a list of strings or pairs
+`:face FACE', like `fancy-splash-insert' accepts them.")
-"
- :face (variable-pitch :weight bold)
- "Useful File menu items:\n"
- :face variable-pitch
- "Exit Emacs\t\t(Or type "
- :face default
- "Control-x"
+(defvar fancy-about-text
+ '((:face (variable-pitch :foreground "red")
+ "This is "
+ :link ("GNU Emacs"
+ (lambda (button) (browse-url "http://www.gnu.org/software/emacs/";))
+ "Browse http://www.gnu.org/software/emacs/";)
+ ", one component of the "
+ :link
+ (lambda ()
+ (if (eq system-type 'gnu/linux)
+ '("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-project))
+ "Display info on the GNU project.")))
+ " operating system.\n"
+ :face (lambda ()
+ (list 'variable-pitch :foreground
+ (if (eq (frame-parameter nil 'background-mode) 'dark)
+ "cyan" "darkblue")))
+ "\n"
+ (lambda () (emacs-version))
+ "\n"
+ :face (variable-pitch :height 0.5)
+ (lambda () emacs-copyright)
+ "\n\n"
:face variable-pitch
- " followed by "
- :face default
- "Control-c"
+ :link ("GNU and Freedom" (lambda (button) (describe-project)))
+ "\tWhy we developed GNU Emacs, and the GNU operating system\n"
+ :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
- ")
-Recover Crashed Session\tRecover files you were editing before a crash\n"
+ :link ("Copying Conditions" (lambda (button) (describe-copying)))
+ "\tConditions for redistributing and changing Emacs\n"
+ :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)))
+ "\tBuying printed manuals from the FSF\n"
+ "\n"
+ :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+ "\tLearn basic Emacs keystroke commands"
+ (lambda ()
+ (let* ((en "TUTORIAL")
+ (tut (or (get-language-info current-language-environment
+ 'tutorial)
+ en))
+ (title (with-temp-buffer
+ (insert-file-contents
+ (expand-file-name tut data-directory)
+ nil 0 256)
+ (search-forward ".")
+ (buffer-substring (point-min) (1- (point))))))
+ ;; If there is a specific tutorial for the current language
+ ;; environment and it is not English, append its title.
+ (if (string= en tut)
+ ""
+ (concat " (" title ")"))))
+ "\n"
+ :link ("Emacs Guided Tour"
+ (lambda (button) (browse-url
"http://www.gnu.org/software/emacs/tour/";))
+ "Browse http://www.gnu.org/software/emacs/tour/";)
+ "\tSee an overview of the many facilities of GNU Emacs"
))
- "A list of texts to show in the middle part of splash screens.
+ "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.")
@@ -1196,20 +1269,6 @@
:version "21.1"
:group 'initialization)
-
-(defcustom fancy-splash-delay 7
- "*Delay in seconds between splash screens."
- :group 'fancy-splash-screen
- :type 'integer)
-
-
-(defcustom fancy-splash-max-time 30
- "*Show splash screens for at most this number of seconds.
-Values less than twice `fancy-splash-delay' are ignored."
- :group 'fancy-splash-screen
- :type 'integer)
-
-
(defcustom fancy-splash-image nil
"*The image to show in the splash screens, or nil for defaults."
:group 'fancy-splash-screen
@@ -1217,30 +1276,54 @@
(file :tag "File")))
+(defvar splash-screen-keymap
+ (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 "q" 'exit-splash-screen)
+ map)
+ "Keymap for splash screen buffer.")
+
;; These are temporary storage areas for the splash screen display.
-(defvar fancy-current-text nil)
(defvar fancy-splash-help-echo nil)
-(defvar fancy-splash-stop-time nil)
-(defvar fancy-splash-outer-buffer nil)
-(defvar fancy-splash-last-input-event nil)
(defun fancy-splash-insert (&rest args)
"Insert text into the current buffer, with faces.
-Arguments from ARGS should be either strings, functions called
-with no args that return a string, or pairs `:face FACE',
-where FACE is a valid face specification, as it can be used with
-`put-text-property'."
+Arguments from ARGS should be either strings; functions called
+with no args that return a string; pairs `:face FACE', where FACE
+is a face specification usable with `put-text-property'; or pairs
+`:link LINK' where LINK is a list of arguments to pass to
+`insert-button', of the form (LABEL ACTION [HELP-ECHO]), which
+specifies the button's label, `action' property and help-echo string.
+FACE and LINK can also be functions, which are evaluated to obtain
+a face or button specification."
(let ((current-face nil))
(while args
- (if (eq (car args) :face)
+ (cond ((eq (car args) :face)
(setq args (cdr args) current-face (car args))
- (insert (propertize (let ((it (car args)))
+ (if (functionp current-face)
+ (setq current-face (funcall current-face))))
+ ((eq (car args) :link)
+ (setq args (cdr args))
+ (let ((spec (car args)))
+ (if (functionp spec)
+ (setq spec (funcall spec)))
+ (insert-button (car spec)
+ 'face (list 'link current-face)
+ 'action (cadr spec)
+ 'help-echo (concat "mouse-2, RET: "
+ (or (nth 2 spec)
+ "Follow this link"))
+ 'follow-link t)))
+ (t (insert (propertize (let ((it (car args)))
(if (functionp it)
(funcall it)
it))
'face current-face
- 'help-echo fancy-splash-help-echo)))
+ 'help-echo fancy-splash-help-echo))))
(setq args (cdr args)))))
@@ -1270,52 +1353,41 @@
(eq (frame-parameter nil 'background-mode) 'dark))
(setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
- ;; Insert the image with a help-echo and a keymap.
- (let ((map (make-sparse-keymap))
- (help-echo "mouse-2: browse http://www.gnu.org/";))
- (define-key map [mouse-2]
- (lambda ()
- (interactive)
- (browse-url "http://www.gnu.org/";)
- (throw 'exit nil)))
- (define-key map [down-mouse-2] 'ignore)
- (define-key map [up-mouse-2] 'ignore)
- (insert-image img (propertize "xxx" 'help-echo help-echo
- 'keymap map)))
- (insert "\n"))))
- (fancy-splash-insert
- :face '(variable-pitch :foreground "red")
- (if (eq system-type 'gnu/linux)
- "GNU Emacs is one component of the GNU/Linux operating system."
- "GNU Emacs is one component of the GNU operating system."))
- (insert "\n")
- (fancy-splash-insert
- :face 'variable-pitch
- "You can do basic editing with the menu bar and scroll bar \
-using the mouse.\n\n")
- (when fancy-splash-outer-buffer
- (fancy-splash-insert
- :face 'variable-pitch
- "Type "
- :face 'default
- "Control-l"
- :face 'variable-pitch
- " to begin editing"
- (if (equal (buffer-name fancy-splash-outer-buffer)
- "*scratch*")
- ".\n"
- " your file.\n"))))
+ ;; Insert the image with a help-echo and a link.
+ (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/";))
+ 'follow-link t)
+ (insert "\n\n")))))
-(defun fancy-splash-tail ()
+(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"))
(fancy-splash-insert :face `(variable-pitch :foreground ,fg)
"\nThis is "
(emacs-version)
"\n"
:face '(variable-pitch :height 0.5)
- "Copyright (C) 2007 Free Software Foundation, Inc.")
+ emacs-copyright
+ "\n")
(and auto-save-list-file-prefix
;; Don't signal an error if the
;; directory for auto-save-list files
@@ -1330,151 +1402,120 @@
auto-save-list-file-prefix)))
t)
(fancy-splash-insert :face '(variable-pitch :foreground "red")
- "\n\nIf an Emacs session crashed recently, "
+ "\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."))))
+ " the files you were editing."))
-(defun fancy-splash-screens-1 (buffer)
- "Timer function displaying a splash screen."
- (when (> (float-time) fancy-splash-stop-time)
- (throw 'stop-splashing nil))
- (unless fancy-current-text
- (setq fancy-current-text fancy-splash-text))
- (let ((text (car fancy-current-text)))
- (set-buffer buffer)
+ (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.")))))
+
+(defun exit-splash-screen ()
+ "Stop displaying the splash screen buffer."
+ (interactive)
+ (quit-window t))
+
+(defun fancy-startup-screen (&optional concise)
+ "Display fancy startup screen.
+If CONCISE is non-nil, display a concise version of the
+splash screen in another window."
+ (let ((splash-buffer (get-buffer-create "*GNU Emacs*")))
+ (with-current-buffer splash-buffer
+ (let ((inhibit-read-only t))
(erase-buffer)
+ (make-local-variable 'startup-screen-inhibit-startup-screen)
(if pure-space-overflow
- (insert "\
-Warning Warning!!! Pure space overflow !!!Warning Warning
-\(See the node Pure Storage in the Lisp manual for details.)\n"))
- (fancy-splash-head)
+ (insert pure-space-overflow-message))
+ (unless concise
+ (fancy-splash-head))
+ (dolist (text fancy-startup-text)
(apply #'fancy-splash-insert text)
- (fancy-splash-tail)
- (unless (current-message)
- (message fancy-splash-help-echo))
+ (insert "\n"))
+ (skip-chars-backward "\n")
+ (delete-region (point) (point-max))
+ (insert "\n")
+ (fancy-startup-tail concise))
+ (use-local-map splash-screen-keymap)
+ (setq tab-width 22
+ buffer-read-only t)
(set-buffer-modified-p nil)
+ (if (and view-read-only (not view-mode))
+ (view-mode-enter nil 'kill-buffer))
(goto-char (point-min))
- (force-mode-line-update)
- (setq fancy-current-text (cdr fancy-current-text))))
-
-
-(defun fancy-splash-default-action ()
- "Stop displaying the splash screen buffer.
-This is an internal function used to turn off the splash screen after
-the user caused an input event by hitting a key or clicking with the
-mouse."
- (interactive)
- (if (and (memq 'down (event-modifiers last-command-event))
- (eq (posn-window (event-start last-command-event))
- (selected-window)))
- ;; This is a mouse-down event in the spash screen window.
- ;; Ignore it and consume the corresponding mouse-up event.
- (read-event)
- (push last-command-event unread-command-events))
- (throw 'exit nil))
-
-(defun fancy-splash-special-event-action ()
- "Save the last event and stop displaying the splash screen buffer.
-This is an internal function used to turn off the splash screen after
-the user caused an input event that is bound in `special-event-map'"
- (interactive)
- (setq fancy-splash-last-input-event last-input-event)
- (throw 'exit nil))
-
+ (forward-line (if concise 2 4)))
+ (if concise
+ (progn
+ (display-buffer splash-buffer)
+ ;; If the splash screen is in a split window, fit it.
+ (let ((window (get-buffer-window splash-buffer t)))
+ (or (null window)
+ (eq window (selected-window))
+ (eq window (next-window window))
+ (fit-window-to-buffer window))))
+ (switch-to-buffer splash-buffer))))
-(defun fancy-splash-screens (&optional hide-on-input)
- "Display fancy splash screens when Emacs starts."
- (if hide-on-input
- (let ((old-hourglass display-hourglass)
- (fancy-splash-outer-buffer (current-buffer))
- splash-buffer
- (old-minor-mode-map-alist minor-mode-map-alist)
- (old-emulation-mode-map-alists emulation-mode-map-alists)
- (old-special-event-map special-event-map)
- (frame (fancy-splash-frame))
- timer)
+(defun fancy-about-screen ()
+ "Display fancy About screen."
+ (let ((frame (fancy-splash-frame)))
(save-selected-window
(select-frame frame)
- (switch-to-buffer " GNU Emacs")
- (make-local-variable 'cursor-type)
- (setq splash-buffer (current-buffer))
- (catch 'stop-splashing
- (unwind-protect
- (let ((map (make-sparse-keymap))
- (cursor-type nil))
- (use-local-map map)
- (define-key map [switch-frame] 'ignore)
- (define-key map [t] 'fancy-splash-default-action)
- (define-key map [mouse-movement] 'ignore)
- (define-key map [mode-line t] 'ignore)
- ;; Temporarily bind special events to
- ;; fancy-splash-special-event-action so as to stop
- ;; displaying splash screens with such events.
- ;; Otherwise, drag-n-drop into splash screens may
- ;; leave us in recursive editing with invisible
- ;; cursors for a while.
- (setq special-event-map (make-sparse-keymap))
- (map-keymap
- (lambda (key def)
- (define-key special-event-map (vector key)
- (if (eq def 'ignore)
- 'ignore
- 'fancy-splash-special-event-action)))
- old-special-event-map)
- (setq display-hourglass nil
- minor-mode-map-alist nil
- emulation-mode-map-alists nil
- buffer-undo-list t
+ (switch-to-buffer "*About GNU Emacs*")
+ (setq buffer-undo-list t
mode-line-format (propertize "---- %b %-"
- 'face 'mode-line-buffer-id)
- fancy-splash-stop-time (+ (float-time)
- fancy-splash-max-time)
- timer (run-with-timer 0 fancy-splash-delay
- #'fancy-splash-screens-1
- splash-buffer))
- (message "%s" (startup-echo-area-message))
- (recursive-edit))
- (cancel-timer timer)
- (setq display-hourglass old-hourglass
- minor-mode-map-alist old-minor-mode-map-alist
- emulation-mode-map-alists old-emulation-mode-map-alists
- special-event-map old-special-event-map)
- (kill-buffer splash-buffer)
- (when fancy-splash-last-input-event
- (setq last-input-event fancy-splash-last-input-event
- fancy-splash-last-input-event nil)
- (command-execute (lookup-key special-event-map
- (vector last-input-event))
- nil (vector last-input-event) t))))))
- ;; If hide-on-input is nil, don't hide the buffer on input.
- (if (or (window-minibuffer-p)
- (window-dedicated-p (selected-window)))
- (pop-to-buffer (current-buffer))
- (switch-to-buffer "*About GNU Emacs*"))
- (setq buffer-read-only nil)
+ 'face 'mode-line-buffer-id))
+ (let ((inhibit-read-only t))
(erase-buffer)
(if pure-space-overflow
- (insert "\
-Warning Warning!!! Pure space overflow !!!Warning Warning
-\(See the node Pure Storage in the Lisp manual for details.)\n"))
- (let (fancy-splash-outer-buffer)
+ (insert pure-space-overflow-message))
(fancy-splash-head)
- (dolist (text fancy-splash-text)
+ (dolist (text fancy-about-text)
(apply #'fancy-splash-insert text)
(insert "\n"))
- (skip-chars-backward "\n")
- (delete-region (point) (point-max))
- (insert "\n")
- (fancy-splash-tail)
+ (unless (current-message)
+ (message fancy-splash-help-echo))
(set-buffer-modified-p nil)
+ (goto-char (point-min))
+ (force-mode-line-update))
+ (use-local-map splash-screen-keymap)
+ (setq tab-width 22)
+ (message "%s" (startup-echo-area-message))
(setq buffer-read-only t)
- (if (and view-read-only (not view-mode))
- (view-mode-enter nil 'kill-buffer))
- (goto-char (point-min)))))
+ (goto-char (point-min))
+ (forward-line 3))))
(defun fancy-splash-frame ()
"Return the frame to use for the fancy splash screen.
@@ -1508,203 +1549,305 @@
(> frame-height (+ image-height 19)))))))
-(defun normal-splash-screen (&optional hide-on-input)
- "Display splash screen when Emacs starts."
+(defun normal-splash-screen (&optional startup)
+ "Display non-graphic splash screen.
+If optional argument STARTUP is non-nil, display the startup screen
+after Emacs starts. If STARTUP is nil, display the About screen."
(let ((prev-buffer (current-buffer)))
- (unwind-protect
- (with-current-buffer (get-buffer-create "GNU Emacs")
+ (with-current-buffer (get-buffer-create "*About GNU Emacs*")
(setq buffer-read-only nil)
(erase-buffer)
(set (make-local-variable 'tab-width) 8)
- (if hide-on-input
+ (if (not startup)
(set (make-local-variable 'mode-line-format)
(propertize "---- %b %-" 'face 'mode-line-buffer-id)))
(if pure-space-overflow
- (insert "\
-Warning Warning!!! Pure space overflow !!!Warning Warning
-\(See the node Pure Storage in the Lisp manual for details.)\n"))
+ (insert pure-space-overflow-message))
;; The convention for this piece of code is that
;; each piece of output starts with one or two newlines
;; and does not end with any newlines.
- (insert "Welcome to GNU Emacs")
+ (insert (if startup "Welcome to GNU Emacs" "This is GNU Emacs"))
(insert
(if (eq system-type 'gnu/linux)
", one component of the GNU/Linux operating system.\n"
", a part of the GNU operating system.\n"))
- (if hide-on-input
- (insert (substitute-command-keys
- (concat
- "\nType \\[recenter] to begin editing"
- (if (equal (buffer-name prev-buffer) "*scratch*")
- ".\n"
- " your file.\n")))))
-
+ (if startup
(if (display-mouse-p)
;; The user can use the mouse to activate menus
;; so give help in terms of menu items.
- (progn
+ (normal-mouse-startup-screen)
+
+ ;; No mouse menus, so give help using kbd commands.
+ (normal-no-mouse-startup-screen))
+
+ (normal-about-screen))
+
+ ;; The rest of the startup screen is the same on all
+ ;; kinds of terminals.
+
+ ;; Give information on recovering, if there was a crash.
+ (and startup
+ 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)
+ (insert "\n\nIf an Emacs session crashed recently, "
+ "type Meta-x recover-session RET\nto recover"
+ " the files you were editing.\n"))
+
+ (use-local-map splash-screen-keymap)
+
+ ;; Display the input that we set up in the buffer.
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (if (and view-read-only (not view-mode))
+ (view-mode-enter nil 'kill-buffer))
+ (switch-to-buffer "*About GNU Emacs*")
+ (if startup (rename-buffer "*GNU Emacs*" t))
+ (goto-char (point-min)))))
+
+(defun normal-mouse-startup-screen ()
+ ;; The user can use the mouse to activate menus
+ ;; so give help in terms of menu items.
(insert "\
-You can do basic editing with the menu bar and scroll bar using the mouse.
-To quit a partially entered command, type Control-g.
+To follow a link, click Mouse-1 on it, or move to it and type RET.
+To quit a partially entered command, type Control-g.\n")
-Useful File menu items:
-Exit Emacs (or type Control-x followed by Control-c)
-Recover Crashed Session Recover files you were editing before a crash
-
-Important Help menu items:
-Emacs Tutorial Learn how to use Emacs efficiently
-Emacs FAQ Frequently asked questions and answers
-Read the Emacs Manual View the Emacs manual using Info
-\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
-Copying Conditions Conditions for redistributing and changing Emacs
-Getting New Versions How to obtain the latest version of Emacs
-More Manuals / Ordering Manuals How to order printed manuals from the FSF
-")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2007 Free Software Foundation, Inc."))
+ (insert "\nImportant Help menu items:\n")
+ (insert-button "Emacs 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))
+ 'follow-link t)
+ (insert "\tView the Emacs manual using Info\n")
+ (insert-button "\(Non)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))
+ 'follow-link t)
+ (insert "\tConditions for redistributing and changing Emacs\n")
+ (insert-button "More Manuals / Ordering 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))
+ '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 "~"))
+ 'follow-link t)
+ (insert "\tOpen your home directory, to operate on its files\n")
+ (insert-button "Customize Startup"
+ 'action (lambda (button) (customize-group 'initialization))
+ 'follow-link t)
+ (insert "\tChange initialization settings including this screen\n")
- ;; No mouse menus, so give help using kbd commands.
+ (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.
(if (and (eq (key-binding "\C-h") 'help-command)
(eq (key-binding "\C-xu") 'advertised-undo)
- (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
+ (eq (key-binding "\C-x\C-c") 'save-buffers-kill-terminal)
(eq (key-binding "\C-ht") 'help-with-tutorial)
(eq (key-binding "\C-hi") 'info)
(eq (key-binding "\C-hr") 'info-emacs-manual)
(eq (key-binding "\C-h\C-n") 'view-emacs-news))
+ (progn
(insert "
-Get help C-h (Hold down CTRL and press h)
-Emacs manual C-h r
-Emacs tutorial C-h t Undo changes C-x u
-Buy manuals C-h C-m Exit Emacs C-x C-c
-Browse manuals C-h i")
+Get help\t C-h (Hold down CTRL and press h)
+")
+ (insert-button "Emacs manual"
+ 'action (lambda (button) (info-emacs-manual))
+ 'follow-link t)
+ (insert " C-h r\t")
+ (insert-button "Browse manuals"
+ 'action (lambda (button) (Info-directory))
+ 'follow-link t)
+ (insert "\t C-h i
+")
+ (insert-button "Emacs tutorial"
+ 'action (lambda (button) (help-with-tutorial))
+ 'follow-link t)
+ (insert " C-h t\tUndo changes\t C-x u
+")
+ (insert-button "Buy manuals"
+ 'action (lambda (button) (view-order-manuals))
+ 'follow-link t)
+ (insert "\t C-h C-m\tExit Emacs\t C-x C-c"))
- (insert (substitute-command-keys
- (format "\n
-Get help %s
-Emacs manual \\[info-emacs-manual]
-Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
-Buy manuals \\[view-order-manuals]\tExit
Emacs\t\\[save-buffers-kill-emacs]
-Browse manuals \\[info]"
+ (insert (format "
+Get help\t %s
+"
(let ((where (where-is-internal
'help-command nil t)))
(if where
(key-description where)
- "M-x help"))))))
+ "M-x help"))))
+ (insert-button "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))
+ 'follow-link t)
+ (insert (substitute-command-keys "\t \\[info]
+"))
+ (insert-button "Emacs tutorial"
+ 'action (lambda (button) (help-with-tutorial))
+ 'follow-link t)
+ (insert (substitute-command-keys
+ "\t \\[help-with-tutorial]\tUndo changes\t \\[advertised-undo]
+"))
+ (insert-button "Buy 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]")))
;; Say how to use the menu bar with the keyboard.
+ (insert "\n")
+ (insert-button "Activate menubar"
+ 'action (lambda (button) (tmm-menubar))
+ 'follow-link t)
(if (and (eq (key-binding "\M-`") 'tmm-menubar)
(eq (key-binding [f10]) 'tmm-menubar))
- (insert "
-Activate menubar F10 or ESC ` or M-`")
- (insert (substitute-command-keys "
-Activate menubar \\[tmm-menubar]")))
+ (insert " F10 or ESC ` or M-`")
+ (insert (substitute-command-keys " \\[tmm-menubar]")))
;; Many users seem to have problems with these.
(insert "
\(`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.)")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2007 Free Software Foundation, Inc.")
+ ;; Insert links to useful tasks
+ (insert "\nUseful tasks:\n")
+
+ (insert-button "Visit New File"
+ 'action (lambda (button) (call-interactively 'find-file))
+ 'follow-link t)
+ (insert "\t\t\t")
+ (insert-button "Open Home Directory"
+ 'action (lambda (button) (dired "~"))
+ 'follow-link t)
+ (insert "\n")
+
+ (insert-button "Customize Startup"
+ '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*")))
+ '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
- "\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
+ "
+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 the conditions.
-Type C-h C-d for information on getting the latest version.")
+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
- "\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for
full details.
+ "
+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 ".
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
-of Emacs and modify it; type \\[describe-copying] to see the conditions.
-Type \\[describe-distribution] for information on getting the latest
version."))))
-
- ;; The rest of the startup screen is the same on all
- ;; kinds of terminals.
-
- ;; Give information on recovering, if there was a crash.
- (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)
- (insert "\n\nIf an Emacs session crashed recently, "
- "type Meta-x recover-session RET\nto recover"
- " the files you were editing."))
-
- ;; Display the input that we set up in the buffer.
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (if (and view-read-only (not view-mode))
- (view-mode-enter nil 'kill-buffer))
- (goto-char (point-min))
- (if hide-on-input
- (if (or (window-minibuffer-p)
- (window-dedicated-p (selected-window)))
- ;; If hide-on-input is nil, creating a new frame will
- ;; generate enough events that the subsequent `sit-for'
- ;; will immediately return anyway.
- nil ;; (pop-to-buffer (current-buffer))
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (sit-for 120)))
- (condition-case nil
- (switch-to-buffer (current-buffer))
- ;; In case the window is dedicated or something.
- (error (pop-to-buffer (current-buffer))))))
- ;; Unwind ... ensure splash buffer is killed
- (if hide-on-input
- (kill-buffer "GNU Emacs")
- (switch-to-buffer "GNU Emacs")
- (rename-buffer "*About GNU Emacs*" t)))))
-
+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".
+Type \\[describe-distribution] for information on "))
+ (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 "To follow a link, click Mouse-1 on it, or move to it and type
RET.\n\n")
+
+ (insert-button "GNU and Freedom"
+ 'action (lambda (button) (describe-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))
+ 'follow-link t)
+ (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
+
+ (insert-button "Copying Conditions"
+ '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))
+ '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))
+ 'follow-link t)
+ (insert "\tBuying printed manuals from the FSF\n"))
(defun startup-echo-area-message ()
(if (eq (key-binding "\C-h\C-p") 'describe-project)
- "For information about the GNU system and GNU/Linux, type C-h C-p."
+ "For information about GNU Emacs and the GNU system, type C-h C-a."
(substitute-command-keys
- "For information about the GNU system and GNU/Linux, type \
-\\[describe-project].")))
+ "For information about GNU Emacs and the GNU system, type \
+\\[about-emacs].")))
(defun display-startup-echo-area-message ()
(let ((resize-mini-windows t))
- (message "%s" (startup-echo-area-message))))
-
-
-(defun display-splash-screen (&optional hide-on-input)
- "Display splash screen according to display.
-Fancy splash screens are used on graphic displays,
-normal otherwise.
-With a prefix argument, any user input hides the splash screen."
- (interactive "P")
- (if (use-fancy-splash-screens-p)
- (fancy-splash-screens hide-on-input)
- (normal-splash-screen hide-on-input)))
-
-
-(defun command-line-1 (command-line-args-left)
- (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
@@ -1733,16 +1876,33 @@
nil t))
(error nil))
(kill-buffer buffer)))))
- ;; display-splash-screen at the end of command-line-1 calls
- ;; use-fancy-splash-screens-p. This can cause image.el to be
- ;; loaded, putting "Loading image... done" in the echo area.
- ;; This hides startup-echo-area-message. So
- ;; use-fancy-splash-screens-p is called here simply to get the
- ;; loading of image.el (if needed) out of the way before
- ;; display-startup-echo-area-message runs.
- (progn
- (use-fancy-splash-screens-p)
- (display-startup-echo-area-message)))
+ (message "%s" (startup-echo-area-message)))))
+
+(defun display-startup-screen (&optional concise)
+ "Display startup screen according to display.
+A fancy display is used on graphic displays, normal otherwise.
+
+If CONCISE is non-nil, display a concise version of the startup
+screen."
+ ;; Prevent recursive calls from server-process-filter.
+ (if (not (get-buffer "*GNU Emacs*"))
+ (if (use-fancy-splash-screens-p)
+ (fancy-startup-screen concise)
+ (normal-splash-screen t))))
+
+(defun display-about-screen ()
+ "Display the *About GNU Emacs* buffer.
+A fancy display is used on graphic displays, normal otherwise."
+ (interactive)
+ (if (use-fancy-splash-screens-p)
+ (fancy-about-screen)
+ (normal-splash-screen nil)))
+
+(defalias 'about-emacs 'display-about-screen)
+(defalias 'display-splash-screen 'display-startup-screen)
+
+(defun command-line-1 (command-line-args-left)
+ (display-startup-echo-area-message)
;; Delay 2 seconds after an init file error message
;; was displayed, so user can read it.
@@ -1756,11 +1916,11 @@
"Building Emacs overflowed pure space. (See the node Pure Storage in the
Lisp manual for details.)"
:warning))
+ (let ((file-count 0)
+ first-file-buffer)
(when command-line-args-left
;; We have command args; process them.
(let ((dir command-line-default-directory)
- (file-count 0)
- first-file-buffer
tem
;; This approach loses for "-batch -L DIR --eval "(require foo)",
;; if foo is intended to be found in DIR.
@@ -1831,17 +1991,19 @@
(funcall (cdr tem) argi)))
((equal argi "-no-splash")
- (setq inhibit-startup-message t))
+ (setq inhibit-startup-screen t))
((member argi '("-f" ; what the manual claims
"-funcall"
"-e")) ; what the source used to say
+ (setq inhibit-startup-screen t)
(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"))
@@ -1873,6 +2035,7 @@
(load file-ex nil t t)))
((equal argi "-insert")
+ (setq inhibit-startup-screen t)
(setq tem (or argval (pop command-line-args-left)))
(or (stringp tem)
(error "File name omitted from `-insert' option"))
@@ -1901,6 +2064,7 @@
(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 tem (or argval (pop command-line-args-left)))
(unless (stringp tem)
@@ -1923,7 +2087,7 @@
(t
;; We have almost exhausted our options. See if the
;; user has made any other command-line options available
- (let ((hooks command-line-functions) ;; lrs 7/31/89
+ (let ((hooks command-line-functions)
(did-hook nil))
(while (and hooks
(not (setq did-hook (funcall (car hooks)))))
@@ -1933,14 +2097,18 @@
(progn
(if (string-match "\\`-" argi)
(error "Unknown option `%s'" argi))
+ (unless window-system
+ (setq inhibit-startup-screen t))
(setq file-count (1+ file-count))
(let ((file
(expand-file-name
(command-line-normalize-file-name orig-argi)
dir)))
- (if (= file-count 1)
- (setq first-file-buffer (find-file file))
- (find-file-other-window file)))
+ (cond ((= file-count 1)
+ (setq first-file-buffer (find-file file)))
+ (inhibit-startup-screen
+ (find-file-other-window file))
+ (t (find-file file))))
(or (zerop line)
(goto-line line))
(setq line 0)
@@ -1951,20 +2119,20 @@
;; 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))))
+ (unless (frame-live-p (selected-frame)) (kill-emacs nil))))))
- ;; If 3 or more files visited, and not all visible,
- ;; show user what they all are. But leave the last one current.
+ (if (or inhibit-startup-screen
+ noninteractive
+ emacs-quick-startup)
+
+ ;; Not displaying a startup screen. If 3 or more files
+ ;; visited, and not all visible, show user what they all are.
(and (> file-count 2)
(not noninteractive)
(not inhibit-startup-buffer-menu)
(or (get-buffer-window first-file-buffer)
- (list-buffers)))))
+ (list-buffers)))
- ;; Maybe display a startup screen.
- (unless (or inhibit-startup-message
- noninteractive
- emacs-quick-startup)
;; Display a startup screen, after some preparations.
;; If there are no switches to process, we might as well
@@ -1990,12 +2158,12 @@
;; Don't let the hook be run twice.
(setq window-setup-hook nil))
- ;; Do this now to avoid an annoying delay if the user
- ;; clicks the menu bar during the sit-for.
- (when (display-popup-menus-p)
- (precompute-menubar-bindings))
- (with-no-warnings
- (setq menubar-bindings-done t))
+ ;; ;; Do this now to avoid an annoying delay if the user
+ ;; ;; clicks the menu bar during the sit-for.
+ ;; (when (display-popup-menus-p)
+ ;; (precompute-menubar-bindings))
+ ;; (with-no-warnings
+ ;; (setq menubar-bindings-done t))
;; If *scratch* exists and is empty, insert initial-scratch-message.
(and initial-scratch-message
@@ -2005,11 +2173,9 @@
(insert initial-scratch-message)
(set-buffer-modified-p nil))))
- ;; If user typed input during all that work,
- ;; abort the startup screen. Otherwise, display it now.
- (unless (input-pending-p)
- (display-splash-screen t))))
-
+ (if (> file-count 0)
+ (display-startup-screen t)
+ (display-startup-screen nil)))))
(defun command-line-normalize-file-name (file)
"Collapse multiple slashes to one, to handle non-Emacs file names."
- [Emacs-diffs] Changes to emacs/lisp/startup.el,v [EMACS_22_BASE],
Juri Linkov <=