(defvar command-line-processed nil "t once command line has been processed")
(defconst startup-message-timeout 12000) ; More or less disable the timeout
+(defconst splash-frame-timeout 7) ; interval between splash frame elements
(defconst inhibit-startup-message nil
"*Non-nil inhibits the initial startup message.
(princ (concat "\n" (emacs-version) "\n\n"))
(princ
(if (featurep 'x)
- (concat (emacs-name)
- " accepts all standard X Toolkit command line options.\n"
- "In addition, the")
+ (concat "When creating a window on an X display, "
+ (emacs-name)
+ " accepts all standard X Toolkit
+command line options plus the following:
+ -iconname <title> Use title as the icon name.
+ -mc <color> Use color as the mouse color.
+ -cr <color> Use color as the text-cursor foregound color.
+ -private Install a private colormap.
+
+In addition, the")
"The"))
(princ " following options are accepted:
-
-t <device> Use TTY <device> instead of the terminal for input
and output. This implies the -nw option.
-nw Inhibit the use of any window-system-specific
(message "Back to top level.")
(setq command-line-processed t)
;; Canonicalize HOME (PWD is canonicalized by init_buffer in buffer.c)
- (unless (eq system-type 'vax-vms)
- (let ((value (user-home-directory)))
- (if (and value
- (< (length value) (length default-directory))
- (equal (file-attributes default-directory)
- (file-attributes value)))
- (setq default-directory (file-name-as-directory value)))))
+ (let ((value (user-home-directory)))
+ (if (and value
+ (< (length value) (length default-directory))
+ (equal (file-attributes default-directory)
+ (file-attributes value)))
+ (setq default-directory (file-name-as-directory value))))
(setq default-directory (abbreviate-file-name default-directory))
(initialize-xemacs-paths)
(if (not inhibit-autoloads)
(progn
- (packages-load-package-auto-autoloads last-package-load-path)
- (packages-load-package-auto-autoloads late-package-load-path)
(if (not inhibit-early-packages)
- (packages-load-package-auto-autoloads early-package-load-path))))
+ (packages-load-package-auto-autoloads early-package-load-path))
+ (packages-load-package-auto-autoloads late-package-load-path)
+ (packages-load-package-auto-autoloads last-package-load-path)))
(unwind-protect
(command-line)
(message "Error in init file: %s" (error-message-string error))
(display-warning 'initialization
(format "\
-An error has occured while loading %s:
+An error has occurred while loading %s:
%s
(when (string= (buffer-name) "*scratch*")
(unless (or inhibit-startup-message
(input-pending-p))
- (let ((timeout nil))
+ (let (tmout circ-tmout)
(unwind-protect
;; Guts of with-timeout
- (catch 'timeout
- (setq timeout (add-timeout startup-message-timeout
- (lambda (ignore)
- (condition-case nil
- (throw 'timeout t)
- (error nil)))
- nil))
- (startup-splash-frame)
+ (catch 'tmout
+ (setq tmout (add-timeout startup-message-timeout
+ (lambda (ignore)
+ (condition-case nil
+ (throw 'tmout t)
+ (error nil)))
+ nil))
+ (setq circ-tmout (display-splash-frame))
(or nil;; (pos-visible-in-window-p (point-min))
(goto-char (point-min)))
(sit-for 0)
(setq unread-command-event (next-command-event)))
- (when timeout (disable-timeout timeout)))))
+ (when tmout (disable-timeout tmout))
+ (when circ-tmout (disable-timeout circ-tmout)))))
(with-current-buffer (get-buffer "*scratch*")
;; In case the XEmacs server has already selected
;; another buffer, erase the one our message is in.
(symbol-name e)))
(defun splash-frame-present-hack (e v)
- ;; (set-extent-property e 'mouse-face 'highlight)
- ;; (set-extent-property e 'keymap
- ;; startup-presentation-hack-keymap)
- ;; (set-extent-property e 'startup-presentation-hack v)
- ;; (set-extent-property e 'help-echo
- ;; 'startup-presentation-hack-help))
+ ;; (set-extent-property e 'mouse-face 'highlight)
+ ;; (set-extent-property e 'keymap
+ ;; startup-presentation-hack-keymap)
+ ;; (set-extent-property e 'startup-presentation-hack v)
+ ;; (set-extent-property e 'help-echo
+ ;; 'startup-presentation-hack-help)
)
(defun splash-hack-version-string ()
(+ left-margin
(round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
-(defun startup-splash-frame-body ()
- `("\n" ,(emacs-version) "\n"
- ,@(if (string-match "beta" emacs-version)
- `( (face (bold blue) ( "This is an Experimental version of XEmacs. "
- " Type " (key describe-beta)
- " to see what this means.\n")))
- `( "\n"))
- (face bold-italic "\
-Copyright (C) 1985-1997 Free Software Foundation, Inc.
-Copyright (C) 1990-1994 Lucid, Inc.
-Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
-Copyright (C) 1994-1996 Board of Trustees, University of Illinois
-Copyright (C) 1995-1996 Ben Wing\n\n")
-
- ,@(if (featurep 'sparcworks)
- `( "\
+(defun splash-frame-body ()
+ `[((face (blue bold underline)
+ "\nDistribution, copying license, warranty:\n\n")
+ "Please visit the XEmacs website at http://www.xemacs.org !\n\n"
+ ,@(if (featurep 'sparcworks)
+ `( "\
Sun provides support for the WorkShop/XEmacs integration package only.
-All other XEmacs packages are provided to you \"AS IS\".
-For full details, type " (key describe-no-warranty)
-" to refer to the GPL Version 2, dated June 1991.\n\n"
-,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG"))))
- (if (and
- (not (featurep 'mule)) ; Already got mule?
- (not (eq 'tty (console-type))) ; No Mule support on tty's yet
- lang ; Non-English locale?
- (not (string= lang "C"))
- (not (string-match "^en" lang))
- (locate-file "xemacs-mule" exec-path)) ; Comes with Sun WorkShop
- '( "\
+All other XEmacs packages are provided to you \"AS IS\".\n"
+ ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES")
+ (getenv "LANG"))))
+ (if (and
+ (not (featurep 'mule)) ;; Already got mule?
+ ;; No Mule support on tty's yet
+ (not (eq 'tty (console-type)))
+ lang ;; Non-English locale?
+ (not (string= lang "C"))
+ (not (string-match "^en" lang))
+ ;; Comes with Sun WorkShop
+ (locate-file "xemacs-mule" exec-path))
+ '( "\
This version of XEmacs has been built with support for Latin-1 languages only.
To handle other languages you need to run a Multi-lingual (`Mule') version of
XEmacs, by either running the command `xemacs-mule', or by using the X resource
-`ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.\n\n"))))
-
- '("XEmacs comes with ABSOLUTELY NO WARRANTY; type "
- (key describe-no-warranty) " for full details.\n"))
+`ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.
+\n")))))
+ ((key describe-no-warranty)
+ ": "(face (red bold) "XEmacs comes with ABSOLUTELY NO WARRANTY\n"))
+ ((key describe-copying)
+ ": conditions to give out copies of XEmacs\n")
+ ((key describe-distribution)
+ ": how to get the latest version\n")
+ "\n--\n"
+ (face italic "\
+Copyright (C) 1985-1999 Free Software Foundation, Inc.
+Copyright (C) 1990-1994 Lucid, Inc.
+Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
+Copyright (C) 1994-1996 Board of Trustees, University of Illinois
+Copyright (C) 1995-1996 Ben Wing\n"))
- "You may give out copies of XEmacs; type "
- (key describe-copying) " to see the conditions.\n"
- "Type " (key describe-distribution)
- " for information on getting the latest version.\n\n"
-
- "Type " (key help-command) " or use the " (face bold "Help") " menu to get help.\n"
- "Type " (key advertised-undo) " to undo changes (`C-' means use the Control key).\n"
- "To get out of XEmacs, type " (key save-buffers-kill-emacs) ".\n"
- "Type " (key help-with-tutorial) " for a tutorial on using XEmacs.\n"
- "Type " (key info) " to enter Info, "
- "which you can use to read online documentation.\n"
- (face (bold red) ( "\
-For tips and answers to frequently asked questions, see the XEmacs FAQ.
-\(It's on the Help menu, or type " (key xemacs-local-faq) " [a capital F!].\)"))))
+ ((face (blue bold underline) "\nInformation, on-line help:\n\n")
+ "XEmacs comes with plenty of documentation...\n\n"
+ ,@(if (string-match "beta" emacs-version)
+ `((key describe-beta)
+ ": " (face (red bold)
+ "This is an Experimental version of XEmacs.\n"))
+ `( "\n"))
+ ((key xemacs-local-faq)
+ ": read the XEmacs FAQ (a " (face underline "capital") " F!)\n")
+ ((key help-with-tutorial)
+ ": read the XEmacs tutorial (also available through the "
+ (face bold "Help") " menu)\n")
+ ((key help-command)
+ ": get help on using XEmacs (also available through the "
+ (face bold "Help") " menu)\n")
+ ((key info) ": read the on-line documentation\n\n")
+ ((key describe-project) ": read about the GNU project\n")
+ ((key about-xemacs) ": see who's developing XEmacs\n"))
+
+ ((face (blue bold underline) "\nUseful stuff:\n\n")
+ "Things that you should know rather quickly...\n\n"
+ ((key find-file) ": visit a file\n")
+ ((key save-buffer) ": save changes\n")
+ ((key advertised-undo) ": undo changes\n")
+ ((key save-buffers-kill-emacs) ": exit XEmacs\n"))
+ ])
;; I really hate global variables, oh well.
;(defvar xemacs-startup-logo-function nil
; "If non-nil, function called to provide the startup logo.
;This function should return an initialized glyph if it is used.")
-(defun startup-splash-frame ()
- (let ((p (point))
-; (logo (cond (xemacs-startup-logo-function
-; (funcall xemacs-startup-logo-function))
-; (t xemacs-logo)))
- (logo xemacs-logo)
+;; This will hopefully go away when gettext is functionnal.
+(defconst splash-frame-static-body
+ `(,(emacs-version) "\n\n"
+ (face italic "`C-' means the control key,`M-' means the meta key\n\n")))
+
+
+(defun circulate-splash-frame-elements (client-data)
+ (with-current-buffer (aref client-data 2)
+ (let ((buffer-read-only nil)
+ (elements (aref client-data 3))
+ (indice (aref client-data 0)))
+ (goto-char (aref client-data 1))
+ (delete-region (point) (point-max))
+ (splash-frame-present (aref elements indice))
+ (set-buffer-modified-p nil)
+ (aset client-data 0
+ (if (= indice (- (length elements) 1))
+ 0
+ (1+ indice )))
+ )))
+
+;; ### This function now returns the (possibly nil) timeout circulating the
+;; splash-frame elements
+(defun display-splash-frame ()
+ (let ((logo xemacs-logo)
+ (buffer-read-only nil)
(cramped-p (eq 'tty (console-type))))
(unless cramped-p (insert "\n"))
(indent-to (startup-center-spaces logo))
(set-extent-begin-glyph (make-extent (point) (point)) logo)
- (insert (if cramped-p "\n" "\n\n"))
- (splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
-
- (let ((after-change-functions nil)) ; no font-lock, thank you
- (dolist (l (startup-splash-frame-body))
- (splash-frame-present l)))
- (splash-hack-version-string)
- (set-buffer-modified-p nil))
+ ;;(splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
+ (insert "\n\n")
+ (splash-frame-present splash-frame-static-body)
+ (splash-hack-version-string)
+ (goto-char (point-max))
+ (let* ((after-change-functions nil) ; no font-lock, thank you
+ (elements (splash-frame-body))
+ (client-data `[ 1 ,(point) ,(current-buffer) ,elements ])
+ tmout)
+ (if (listp elements) ;; A single element to display
+ (splash-frame-present (splash-frame-body))
+ ;; several elements to rotate
+ (splash-frame-present (aref elements 0))
+ (setq tmout (add-timeout splash-frame-timeout
+ 'circulate-splash-frame-elements
+ client-data splash-frame-timeout)))
+ (set-buffer-modified-p nil)
+ tmout)))
;; (let ((present-file
;; #'(lambda (f)
projects / chise / xemacs-chise.git.1 / blobdiff