Mercurial > hg > xemacs-beta

comparison lisp/startup.el @ 2505:3e5a2d0d57e1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-01-26 04:56:17 by ben] The splash screen change startup.el: Rename "splash-frame" -> "splash-screen" (its change long ago from screen to frame happened during the general screen->frame sub and was a mistake). Compress all info onto one screen rather than cycling through 3 of them. Update copyright years and some other random stuff. menubar-items.el: Removed. frame->screen and rewrite to fix bugginess. Add menu items for beta and distribution info.
author ben
date Wed, 26 Jan 2005 04:56:18 +0000
parents f4e405a9d18d
children 96036853a107
comparison
equal deleted inserted replaced
2504:e17beacca645 2505:3e5a2d0d57e1
1 ;;; startup.el --- process XEmacs shell arguments 1 ;;; startup.el --- process XEmacs shell arguments
2 2
3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc. 4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois 5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
6 ;; Copyright (C) 2001, 2002, 2003 Ben Wing. 6 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Ben Wing.
7 7
8 ;; Maintainer: XEmacs Development Team 8 ;; Maintainer: XEmacs Development Team
9 ;; Keywords: internal, dumped 9 ;; Keywords: internal, dumped
10 10
11 ;; This file is part of XEmacs. 11 ;; This file is part of XEmacs.
70 (setq top-level '(normal-top-level)) 70 (setq top-level '(normal-top-level))
71 71
72 (defvar command-line-processed nil "t once command line has been processed") 72 (defvar command-line-processed nil "t once command line has been processed")
73 73
74 (defconst startup-message-timeout 12000) ; More or less disable the timeout 74 (defconst startup-message-timeout 12000) ; More or less disable the timeout
75 (defconst splash-frame-timeout 7) ; interval between splash frame elements
76 75
77 (defconst inhibit-startup-message nil 76 (defconst inhibit-startup-message nil
78 "*Non-nil inhibits the initial startup message. 77 "*Non-nil inhibits the initial startup message.
79 This is for use in your personal init file, once you are familiar 78 This is for use in your personal init file, once you are familiar
80 with the contents of the startup message.") 79 with the contents of the startup message.")
1057 ;; Don't clobber a non-scratch buffer if init file 1056 ;; Don't clobber a non-scratch buffer if init file
1058 ;; has selected it. 1057 ;; has selected it.
1059 (when (string= (buffer-name) "*scratch*") 1058 (when (string= (buffer-name) "*scratch*")
1060 (unless (or inhibit-startup-message 1059 (unless (or inhibit-startup-message
1061 (input-pending-p)) 1060 (input-pending-p))
1062 (let (tmout circ-tmout) 1061 (let (tmout)
1063 (unwind-protect 1062 (unwind-protect
1064 ;; Guts of with-timeout 1063 ;; Guts of with-timeout
1065 (catch 'tmout 1064 (catch 'tmout
1066 (setq tmout (add-timeout startup-message-timeout 1065 (setq tmout (add-timeout startup-message-timeout
1067 (lambda (ignore) 1066 (lambda (ignore)
1068 (condition-case nil 1067 (condition-case nil
1069 (throw 'tmout t) 1068 (throw 'tmout t)
1070 (error nil))) 1069 (error nil)))
1071 nil)) 1070 nil))
1072 (setq circ-tmout (display-splash-frame)) 1071 (display-splash-screen)
1073 (or nil;; (pos-visible-in-window-p (point-min)) 1072 (or nil;; (pos-visible-in-window-p (point-min))
1074 (goto-char (point-min))) 1073 (goto-char (point-min)))
1075 (sit-for 0) 1074 (sit-for 0)
1076 (setq unread-command-event (next-command-event))) 1075 (setq unread-command-event (next-command-event)))
1077 (when tmout (disable-timeout tmout)) 1076 (when tmout (disable-timeout tmout)))))
1078 (when circ-tmout (disable-timeout circ-tmout)))))
1079 (with-current-buffer (get-buffer "*scratch*") 1077 (with-current-buffer (get-buffer "*scratch*")
1080 ;; In case the XEmacs server has already selected 1078 ;; In case the XEmacs server has already selected
1081 ;; another buffer, erase the one our message is in. 1079 ;; another buffer, erase the one our message is in.
1082 (erase-buffer) 1080 (erase-buffer)
1083 (when (stringp initial-scratch-message) 1081 (when (stringp initial-scratch-message)
1123 (t (find-file-other-window arg))) 1121 (t (find-file-other-window arg)))
1124 (when line 1122 (when line
1125 (goto-line line) 1123 (goto-line line)
1126 (setq line nil)))))))) 1124 (setq line nil))))))))
1127 1125
1128 (defvar startup-presentation-hack-keymap 1126
1129 (let ((map (make-sparse-keymap)))
1130 (set-keymap-name map 'startup-presentation-hack-keymap)
1131 (define-key map '[button1] 'startup-presentation-hack)
1132 (define-key map '[button2] 'startup-presentation-hack)
1133 map)
1134 "Putting yesterday in the future tomorrow.")
1135
1136 (defun startup-presentation-hack ()
1137 (interactive)
1138 (let ((e last-command-event))
1139 (and (button-press-event-p e)
1140 (setq e (extent-at (event-point e)
1141 (event-buffer e)
1142 'startup-presentation-hack))
1143 (setq e (extent-property e 'startup-presentation-hack))
1144 (if (consp e)
1145 (apply (car e) (cdr e))
1146 (while (keymapp (indirect-function e))
1147 (let ((map e)
1148 (overriding-local-map (indirect-function e)))
1149 (setq e (read-key-sequence
1150 (let ((p (keymap-prompt map t)))
1151 (cond ((symbolp map)
1152 (if p
1153 (format "%s %s " map p)
1154 (format "%s " map)))
1155 (p)
1156 (t
1157 (prin1-to-string map))))))
1158 (if (and (button-release-event-p (elt e 0))
1159 (null (key-binding e)))
1160 (setq e map) ; try again
1161 (setq e (key-binding e)))))
1162 (call-interactively e)))))
1163
1164 (defun startup-presentation-hack-help (e) 1127 (defun startup-presentation-hack-help (e)
1165 (setq e (extent-property e 'startup-presentation-hack)) 1128 (setq e (extent-property e 'startup-presentation-hack))
1166 (if (consp e) 1129 (symbol-name e))
1167 (format "Evaluate %S" e) 1130
1168 (symbol-name e))) 1131 (defun startup-presentation-activate (ev ex)
1169 1132 (call-interactively (extent-property ex 'startup-presentation-hack)))
1170 (defun splash-frame-present-hack (e v) 1133
1171 ;; (set-extent-property e 'mouse-face 'highlight) 1134 (defun splash-screen-present-hack (e v)
1172 ;; (set-extent-property e 'keymap 1135 ; (set-extent-property e 'mouse-face 'highlight)
1173 ;; startup-presentation-hack-keymap) 1136 ; (set-extent-property e 'startup-presentation-hack v)
1174 ;; (set-extent-property e 'startup-presentation-hack v) 1137 ; (set-extent-property e 'help-echo
1175 ;; (set-extent-property e 'help-echo 1138 ; 'startup-presentation-hack-help)
1176 ;; 'startup-presentation-hack-help) 1139 ; (set-extent-property e 'activate-function 'startup-presentation-activate)
1177 ) 1140 )
1178 1141
1179 (defun splash-hack-version-string () 1142 (defun splash-hack-version-string ()
1180 (save-excursion 1143 (save-excursion
1181 (save-restriction 1144 (save-restriction
1191 (goto-char (point-max)) 1154 (goto-char (point-max))
1192 (search-backward " " nil t) 1155 (search-backward " " nil t)
1193 (when (search-forward "." nil t) 1156 (when (search-forward "." nil t)
1194 (delete-region (1- (point)) (point-max)))))) 1157 (delete-region (1- (point)) (point-max))))))
1195 1158
1196 (defun splash-frame-present (l) 1159 ;; parse one page description (see `splash-screen-body') and display
1160 ;; at point.
1161 (defun splash-screen-present (l)
1197 (cond ((stringp l) 1162 (cond ((stringp l)
1198 (insert l)) 1163 (insert l))
1199 ((eq (car-safe l) 'face) 1164 ((eq (car-safe l) 'face)
1200 ;; (face name string) 1165 ;; (face name string)
1201 (let ((p (point))) 1166 (let ((p (point)))
1202 (splash-frame-present (elt l 2)) 1167 (splash-screen-present (elt l 2))
1203 (if (fboundp 'set-extent-face) 1168 (set-extent-face (make-extent p (point))
1204 (set-extent-face (make-extent p (point)) 1169 (elt l 1))))
1205 (elt l 1)))))
1206 ((eq (car-safe l) 'key) 1170 ((eq (car-safe l) 'key)
1207 (let* ((c (elt l 1)) 1171 (let* ((c (elt l 1))
1208 (p (point)) 1172 (p (point))
1209 (k (where-is-internal c nil t))) 1173 (k (where-is-internal c nil t)))
1210 (insert (if k (key-description k) 1174 (insert (if k (key-description k)
1211 (format "M-x %s" c))) 1175 (format "M-x %s" c)))
1212 (if (fboundp 'set-extent-face) 1176 (let ((e (make-extent p (point))))
1213 (let ((e (make-extent p (point)))) 1177 (set-extent-face e 'bold)
1214 (set-extent-face e 'bold) 1178 (splash-screen-present-hack e c))))
1215 (splash-frame-present-hack e c)))))
1216 ((eq (car-safe l) 'funcall) 1179 ((eq (car-safe l) 'funcall)
1217 ;; (funcall (fun . args) string) 1180 ;; (funcall (fun . args) string)
1218 (let ((p (point))) 1181 (let ((p (point)))
1219 (splash-frame-present (elt l 2)) 1182 (splash-screen-present (elt l 2))
1220 (if (fboundp 'set-extent-face) 1183 (splash-screen-present-hack (make-extent p (point))
1221 (splash-frame-present-hack (make-extent p (point)) 1184 (elt l 1))))
1222 (elt l 1)))))
1223 ((consp l) 1185 ((consp l)
1224 (mapcar 'splash-frame-present l)) 1186 (mapcar 'splash-screen-present l))
1225 (t 1187 (t
1226 (error "WTF!?")))) 1188 (error "WTF!?"))))
1227 1189
1228 (defun startup-center-spaces (glyph) 1190 (defun startup-center-spaces (glyph)
1229 ;; Return the number of spaces to insert in order to center 1191 ;; Return the number of spaces to insert in order to center
1239 ;; This function is used in about.el too. 1201 ;; This function is used in about.el too.
1240 (let* ((avg-pixwidth (round (/ (frame-pixel-width) (frame-width)))) 1202 (let* ((avg-pixwidth (round (/ (frame-pixel-width) (frame-width))))
1241 (fill-area-width (* avg-pixwidth (- fill-column left-margin))) 1203 (fill-area-width (* avg-pixwidth (- fill-column left-margin)))
1242 (glyph-pixwidth (cond ((stringp glyph) 1204 (glyph-pixwidth (cond ((stringp glyph)
1243 (* avg-pixwidth (length glyph))) 1205 (* avg-pixwidth (length glyph)))
1244 ;; #### the pixmap option should be removed
1245 ;;((pixmapp glyph)
1246 ;; (pixmap-width glyph))
1247 ((glyphp glyph) 1206 ((glyphp glyph)
1248 (glyph-width glyph)) 1207 (glyph-width glyph))
1249 (t 1208 (t
1250 (error "startup-center-spaces: bad arg"))))) 1209 (error "startup-center-spaces: bad arg")))))
1251 (+ left-margin 1210 (+ left-margin
1252 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) 1211 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
1253 1212
1254 (defun splash-frame-body () 1213 ;; the splash screen originated in 19.10 as splash-screen-*. When
1255 `[((face (blue bold underline) 1214 ;; Chuck made the global screen->frame change for 19.12, he
1256 "\nDistribution, copying license, warranty:\n\n") 1215 ;; accidentally changed these too. This randomness is getting on my
1257 "Please visit the XEmacs website at http://www.xemacs.org/ !\n\n" 1216 ;; nerves, so let's fix it and provide minimal aliases for the
1217 ;; `locale' mule package. --ben
1218
1219 ;; returns either of vector of page descriptions, each describing one
1220 ;; screenful of information, or just one such page descriptions Each
1221 ;; page description is a list of textual elements describing how to
1222 ;; display a section of text. The elements are processed in turn and
1223 ;; the results inserted one after the previous in a buffer. Each
1224 ;; textual element is either:
1225
1226 ;; -- a string, inserted as-is with no decoration.
1227 ;; -- a list of (face FACES "text"), where FACES is the name of a face
1228 ;; or a list of such names, and specifies the face(s) used when
1229 ;; displaying the text.
1230 ;; -- a list of (key COMMAND-NAME); the key sequence corresponding to
1231 ;; the command will be inserted, in boldface.
1232 ;; -- a list of textual elements.
1233
1234 (defun splash-screen-window-body ()
1235 `(
1236 (face (blue bold underline)
1237 "Useful Help-menu entries:\n\n")
1238 ,@(if (string-match "beta" emacs-version)
1239 `((face bold "Beta Info:")
1240 (face (red bold)
1241 " This is an Experimental version of XEmacs.\n"))
1242 `( ""))
1243 (face bold "XEmacs FAQ:")
1244 " Read the XEmacs FAQ.\n"
1245 (face bold "Info (Online Docs):")
1246 " Read the on-line documentation.\n"
1247 (face bold "Tutorial:")
1248 " XEmacs tutorial.\n"
1249 (face bold "Samples->View Sample init.el:")
1250 " A useful initialization file.\n"
1251 (face bold "About XEmacs:")
1252 " See who's developing XEmacs.\n"
1253 "\n"
1254 (face (bold blue) "XEmacs website:")
1255 " http://www.xemacs.org/\n\n"
1258 ,@(if (featurep 'sparcworks) 1256 ,@(if (featurep 'sparcworks)
1259 `( "\ 1257 `( "\
1260 Sun provides support for the WorkShop/XEmacs integration package only. 1258 Sun provides support for the WorkShop/XEmacs integration package only.
1261 All other XEmacs packages are provided to you \"AS IS\".\n" 1259 All other XEmacs packages are provided to you \"AS IS\".\n"
1262 ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") 1260 ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES")
1263 (getenv "LANG")))) 1261 (getenv "LANG"))))
1264 (if (and 1262 (if (and
1265 (not (featurep 'mule)) ;; Already got mule? 1263 (not (featurep 'mule)) ;; Already got mule?
1266 ;; No Mule support on tty's yet
1267 (not (eq 'tty (console-type)))
1268 lang ;; Non-English locale? 1264 lang ;; Non-English locale?
1269 (not (string= lang "C")) 1265 (not (string= lang "C"))
1270 (not (string-match "^en" lang)) 1266 (not (string-match "^en" lang))
1271 ;; Comes with Sun WorkShop 1267 ;; Comes with Sun WorkShop
1272 (locate-file "xemacs-mule" exec-path)) 1268 (locate-file "xemacs-mule" exec-path))
1274 This version of XEmacs has been built with support for Latin-1 languages only. 1270 This version of XEmacs has been built with support for Latin-1 languages only.
1275 To handle other languages you need to run a Multi-lingual (`Mule') version of 1271 To handle other languages you need to run a Multi-lingual (`Mule') version of
1276 XEmacs, by either running the command `xemacs-mule', or by using the X resource 1272 XEmacs, by either running the command `xemacs-mule', or by using the X resource
1277 `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop. 1273 `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.
1278 \n"))))) 1274 \n")))))
1279 ((key describe-no-warranty)
1280 ": "(face (red bold) "XEmacs comes with ABSOLUTELY NO WARRANTY\n"))
1281 ((key describe-copying)
1282 ": conditions to give out copies of XEmacs\n")
1283 ((key describe-distribution)
1284 ": how to get the latest version\n")
1285 "\n--\n"
1286 (face italic "\ 1275 (face italic "\
1287 Copyright (C) 1985-1999 Free Software Foundation, Inc. 1276 Copyright (C) 1985-1999 Free Software Foundation, Inc.
1288 Copyright (C) 1990-1994 Lucid, Inc. 1277 Copyright (C) 1990-1994 Lucid, Inc.
1289 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. 1278 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
1290 Copyright (C) 1994-1996 Board of Trustees, University of Illinois 1279 Copyright (C) 1994-1996 Board of Trustees, University of Illinois.
1291 Copyright (C) 1995-1996 Ben Wing\n")) 1280 Copyright (C) 1995-2005 Ben Wing.\n")
1292 1281 ))
1293 ((face (blue bold underline) "\nInformation, on-line help:\n\n") 1282
1294 "XEmacs comes with plenty of documentation...\n\n" 1283 (defun splash-screen-tty-body ()
1284 `(
1285 (face italic "[`C-' means the control key, `M-' means the meta key]\n\n")
1295 ,@(if (string-match "beta" emacs-version) 1286 ,@(if (string-match "beta" emacs-version)
1296 `((key describe-beta) 1287 `((key describe-beta)
1297 ": " (face (red bold) 1288 ": " (face (red bold)
1298 "This is an Experimental version of XEmacs.\n")) 1289 "This is an Experimental version of XEmacs.\n"))
1299 `( "\n")) 1290 `( "\n"))
1300 ((key xemacs-local-faq) 1291 ((key xemacs-local-faq)
1301 ": read the XEmacs FAQ (a " (face underline "capital") " F!)\n") 1292 ": Read the XEmacs FAQ. (A " (face underline "capital") " F!)\n")
1293 ((key info) ": Read the on-line documentation.\n")
1294 ((key help-command)
1295 ": Get help on using XEmacs.\n")
1302 ((key help-with-tutorial) 1296 ((key help-with-tutorial)
1303 ": read the XEmacs tutorial (also available through the " 1297 ": Read the XEmacs tutorial.\n")
1304 (face bold "Help") " menu)\n") 1298 ((key view-sample-init-el)
1305 ((key help-command) 1299 ": View the sample init.el file.\n")
1306 ": get help on using XEmacs (also available through the " 1300 ((key about-xemacs) ": See who's developing XEmacs.\n")
1307 (face bold "Help") " menu)\n") 1301 ((key save-buffers-kill-emacs)
1308 ((key info) ": read the on-line documentation\n\n") 1302 ": exit XEmacs\n")
1309 ((key describe-project) ": read about the GNU project\n") 1303 "\n"
1310 ((key about-xemacs) ": see who's developing XEmacs\n")) 1304 (face (bold blue) "XEmacs website: ")
1311 1305 "http://www.xemacs.org/\n\n"
1312 ((face (blue bold underline) "\nUseful stuff:\n\n") 1306 (face italic "\
1313 "Things that you should learn rather quickly...\n\n" 1307 Copyright (C) 1985-1999 Free Software Foundation, Inc.
1314 ((key find-file) ": visit a file\n") 1308 Copyright (C) 1990-1994 Lucid, Inc.
1315 ((key save-buffer) ": save changes\n") 1309 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
1316 ((key undo) ": undo changes\n") 1310 Copyright (C) 1994-1996 Board of Trustees, University of Illinois.
1317 ((key save-buffers-kill-emacs) ": exit XEmacs\n")) 1311 Copyright (C) 1995-2004 Ben Wing.")
1318 ]) 1312 ; ((key find-file) ": visit a file; ")
1313 ; ((key save-buffer) ": save changes; ")
1314 ; ((key undo) ": undo changes; ")
1315 ))
1319 1316
1320 ;; I really hate global variables, oh well. 1317 ;; I really hate global variables, oh well.
1321 ;(defvar xemacs-startup-logo-function nil 1318 ;(defvar xemacs-startup-logo-function nil
1322 ; "If non-nil, function called to provide the startup logo. 1319 ; "If non-nil, function called to provide the startup logo.
1323 ;This function should return an initialized glyph if it is used.") 1320 ;This function should return an initialized glyph if it is used.")
1324 1321
1325 ;; This will hopefully go away when gettext is functional. 1322 ;; This will hopefully go away when gettext is functional.
1326 (defconst splash-frame-static-body 1323 (defconst splash-screen-static-body
1327 `(,(emacs-version) "\n\n" 1324 `(,(emacs-version) "\n\n"))
1328 (face italic "`C-' means the control key,`M-' means the meta key\n\n"))) 1325 ;; temporary support for old locale files.
1329 1326 (define-obsolete-variable-alias 'splash-frame-static-body
1330 1327 'splash-screen-static-body)
1331 (defun circulate-splash-frame-elements (client-data) 1328
1332 (with-current-buffer (aref client-data 2) 1329 (defun display-splash-screen ()
1333 (let ((buffer-read-only nil) 1330 ;; display the splash screen in the current buffer and put it in the
1334 (elements (aref client-data 3)) 1331 ;; current window.
1335 (indice (aref client-data 0)))
1336 (goto-char (aref client-data 1))
1337 (delete-region (point) (point-max))
1338 (splash-frame-present (aref elements indice))
1339 (set-buffer-modified-p nil)
1340 (aset client-data 0
1341 (if (= indice (- (length elements) 1))
1342 0
1343 (1+ indice )))
1344 )))
1345
1346 ;; #### This function now returns the (possibly nil) timeout circulating the
1347 ;; splash-frame elements
1348 (defun display-splash-frame ()
1349 (let ((logo xemacs-logo) 1332 (let ((logo xemacs-logo)
1350 (buffer-read-only nil) 1333 (buffer-read-only nil)
1351 (cramped-p (eq 'tty (console-type)))) 1334 (tty (eq 'tty (console-type))))
1352 (unless cramped-p (insert "\n")) 1335 (unless tty
1353 (indent-to (startup-center-spaces logo)) 1336 (insert "\n")
1354 (set-extent-begin-glyph (make-extent (point) (point)) logo) 1337 (indent-to (startup-center-spaces logo))
1355 ;;(splash-frame-present-hack (make-extent p (point)) 'about-xemacs)) 1338 (set-extent-begin-glyph (make-extent (point) (point)) logo)
1356 (insert "\n\n") 1339 ;;(splash-screen-present-hack (make-extent p (point)) 'about-xemacs))
1357 (splash-frame-present splash-frame-static-body) 1340 (insert "\n\n"))
1341 (splash-screen-present splash-screen-static-body)
1358 (splash-hack-version-string) 1342 (splash-hack-version-string)
1359 (goto-char (point-max)) 1343 (goto-char (point-max))
1360 (let* ((after-change-functions nil) ; no font-lock, thank you 1344 (let* ((after-change-functions nil) ; no font-lock, thank you
1361 (elements (splash-frame-body)) 1345 (elements (cond (tty (splash-screen-tty-body))
1362 (client-data `[ 1 ,(point) ,(current-buffer) ,elements ]) 1346 (t (splash-screen-window-body)))))
1363 tmout) 1347 (pop-to-buffer (current-buffer))
1364 (if (listp elements) ;; A single element to display 1348 (delete-other-windows)
1365 (splash-frame-present (splash-frame-body)) 1349 (splash-screen-present elements)
1366 ;; several elements to rotate 1350 (set-buffer-modified-p nil))))
1367 (splash-frame-present (aref elements 0)) 1351
1368 (setq tmout (add-timeout splash-frame-timeout 1352 (defun xemacs-splash-buffer ()
1369 'circulate-splash-frame-elements 1353 "Display XEmacs splash screen in a buffer."
1370 client-data splash-frame-timeout))) 1354 (interactive)
1371 (set-buffer-modified-p nil) 1355 (let ((buffer (get-buffer-create "*Splash*")))
1372 tmout))) 1356 (set-buffer buffer)
1357 (setq buffer-read-only nil)
1358 (erase-buffer buffer)
1359 (display-splash-screen)))
1373 1360
1374 ;; (let ((present-file 1361 ;; (let ((present-file
1375 ;; #'(lambda (f) 1362 ;; #'(lambda (f)
1376 ;; (splash-frame-present 1363 ;; (splash-screen-present
1377 ;; (list 'funcall 1364 ;; (list 'funcall
1378 ;; (list 'find-file-other-window 1365 ;; (list 'find-file-other-window
1379 ;; (expand-file-name f data-directory)) 1366 ;; (expand-file-name f data-directory))
1380 ;; f))))) 1367 ;; f)))))
1381 ;; (insert "For customization examples, see the files ") 1368 ;; (insert "For customization examples, see the files ")
1382 ;; (funcall present-file "sample.emacs") 1369 ;; (funcall present-file "sample.init.el")
1383 ;; (insert " and ") 1370 ;; (insert " and ")
1384 ;; (funcall present-file "sample.Xresources") 1371 ;; (funcall present-file "sample.Xresources")
1385 ;; (insert (format "\nin the directory %s." data-directory))) 1372 ;; (insert (format "\nin the directory %s." data-directory)))
1386 1373
1374
1387 (defun startup-set-invocation-environment () 1375 (defun startup-set-invocation-environment ()
1388 ;; XEmacs -- Steven Baur says invocation directory is nil if you 1376 ;; XEmacs -- Steven Baur says invocation directory is nil if you
1389 ;; try to use XEmacs as a login shell. 1377 ;; try to use XEmacs as a login shell.
1390 (or invocation-directory (setq invocation-directory default-directory)) 1378 (or invocation-directory (setq invocation-directory default-directory))
1391 (setq invocation-directory 1379 (setq invocation-directory