Mercurial > emacs
comparison lisp/startup.el @ 82396:71b7e41a7415
(initialization): Change parent group from `internal'
to `environment'.
(initial-buffer-choice): New variable.
(command-line): Revert 2007-07-02 change that sets
buffer-offer-save in *scratch* and enables auto-save in it.
(fancy-splash-text): Add links to existing items. Add new items
with links for useful tasks. Move information about Control-g to
fancy-splash-head. Move "Emacs Guided Tour" to the end.
(fancy-splash-keymap): New variable.
(fancy-splash-last-input-event): Remove variable.
(fancy-splash-insert): Add processing of `:link' element.
(fancy-splash-head): Replace "Type Control-l to begin editing"
with "Type `q' to exit".
(fancy-splash-screens-1): Let-bind inhibit-read-only to t.
(fancy-splash-default-action, fancy-splash-special-event-action):
Remove functions.
(fancy-splash-quit): New function.
(fancy-splash-screens): Rename input arg from `hide-on-input' to
`static' and reverse the condition of its usage. Don't preserve
original values of `minor-mode-map-alist',
`emulation-mode-map-alists', `special-event-map'.
Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs".
Rename about-buffer from " GNU Emacs" to " About GNU Emacs".
Remove processing of special events. Use local key map
`fancy-splash-keymap'. Set buffer to read-only.
(normal-splash-screen): Rename input arg from `hide-on-input' to
`static' and reverse the condition of its usage.
Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs".
Rename about-buffer from " GNU Emacs" to " About GNU Emacs".
Add links to existing items. Add new items with links for useful
tasks. Use local key map `fancy-splash-keymap'.
(display-splash-screen): Rename input arg from `hide-on-input' to
`static'.
(about-emacs): Add alias to display-splash-screen.
(command-line-1): Use `initial-buffer-choice'.
author | Juri Linkov <juri@jurta.org> |
---|---|
date | Wed, 15 Aug 2007 23:22:43 +0000 |
parents | b8c796068320 |
children | 4f98fbdaf9ce |
comparison
equal
deleted
inserted
replaced
82395:9d202ec7bccf | 82396:71b7e41a7415 |
---|---|
36 (defvar command-line-processed nil | 36 (defvar command-line-processed nil |
37 "Non-nil once command line has been processed.") | 37 "Non-nil once command line has been processed.") |
38 | 38 |
39 (defgroup initialization nil | 39 (defgroup initialization nil |
40 "Emacs start-up procedure." | 40 "Emacs start-up procedure." |
41 :group 'internal) | 41 :group 'environment) |
42 | |
43 (defcustom initial-buffer-choice nil | |
44 "Buffer to show after starting Emacs. | |
45 If the value is nil and `inhibit-splash-screen' is nil, show the | |
46 startup screen. If the value is string, visit the specified file or | |
47 directory using `find-file'. If t, open the `*scratch*' buffer." | |
48 :type '(choice | |
49 (const :tag "Splash screen" nil) | |
50 (directory :tag "Directory" :value "~/") | |
51 (file :tag "File" :value "~/file.txt") | |
52 (const :tag "Lisp scratch buffer" t)) | |
53 :version "23.1" | |
54 :group 'initialization) | |
42 | 55 |
43 (defcustom inhibit-splash-screen nil | 56 (defcustom inhibit-splash-screen nil |
44 "Non-nil inhibits the startup screen. | 57 "Non-nil inhibits the startup screen. |
45 It also inhibits display of the initial message in the `*scratch*' buffer. | 58 It also inhibits display of the initial message in the `*scratch*' buffer. |
46 | 59 |
1053 | 1066 |
1054 ;; If *scratch* exists and init file didn't change its mode, initialize it. | 1067 ;; If *scratch* exists and init file didn't change its mode, initialize it. |
1055 (if (get-buffer "*scratch*") | 1068 (if (get-buffer "*scratch*") |
1056 (with-current-buffer "*scratch*" | 1069 (with-current-buffer "*scratch*" |
1057 (if (eq major-mode 'fundamental-mode) | 1070 (if (eq major-mode 'fundamental-mode) |
1058 (funcall initial-major-mode)) | 1071 (funcall initial-major-mode)))) |
1059 ;; Don't lose text that users type in *scratch*. | |
1060 (setq buffer-offer-save t) | |
1061 (auto-save-mode 1))) | |
1062 | 1072 |
1063 ;; Load library for our terminal type. | 1073 ;; Load library for our terminal type. |
1064 ;; User init file can set term-file-prefix to nil to prevent this. | 1074 ;; User init file can set term-file-prefix to nil to prevent this. |
1065 (unless (or noninteractive | 1075 (unless (or noninteractive |
1066 window-system | 1076 window-system |
1129 | 1139 |
1130 (defvar fancy-splash-text | 1140 (defvar fancy-splash-text |
1131 '((:face (variable-pitch :weight bold) | 1141 '((:face (variable-pitch :weight bold) |
1132 "Important Help menu items:\n" | 1142 "Important Help menu items:\n" |
1133 :face variable-pitch | 1143 :face variable-pitch |
1144 :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) | |
1145 "\t\tLearn how to use Emacs efficiently" | |
1134 (lambda () | 1146 (lambda () |
1135 (let* ((en "TUTORIAL") | 1147 (let* ((en "TUTORIAL") |
1136 (tut (or (get-language-info current-language-environment | 1148 (tut (or (get-language-info current-language-environment |
1137 'tutorial) | 1149 'tutorial) |
1138 en)) | 1150 en)) |
1142 nil 0 256) | 1154 nil 0 256) |
1143 (search-forward ".") | 1155 (search-forward ".") |
1144 (buffer-substring (point-min) (1- (point)))))) | 1156 (buffer-substring (point-min) (1- (point)))))) |
1145 ;; If there is a specific tutorial for the current language | 1157 ;; If there is a specific tutorial for the current language |
1146 ;; environment and it is not English, append its title. | 1158 ;; environment and it is not English, append its title. |
1147 (concat | 1159 (if (string= en tut) |
1148 "Emacs Tutorial\t\tLearn how to use Emacs efficiently" | 1160 "" |
1149 (if (string= en tut) | 1161 (concat " (" title ")")))) |
1150 "" | 1162 "\n" |
1151 (concat " (" title ")")) | 1163 :face variable-pitch |
1152 "\n"))) | 1164 :link ("Emacs FAQ" (lambda (button) (view-emacs-FAQ))) |
1153 :face variable-pitch "\ | 1165 "\t\tFrequently asked questions and answers\n" |
1154 Emacs FAQ\t\tFrequently asked questions and answers | 1166 :link ("View Emacs Manual" (lambda (button) (info-emacs-manual))) |
1155 View Emacs Manual\t\tView the Emacs manual using Info | 1167 "\t\tView the Emacs manual using Info\n" |
1156 Absence of Warranty\tGNU Emacs comes with " | 1168 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) |
1169 "\tGNU Emacs comes with " | |
1157 :face (variable-pitch :slant oblique) | 1170 :face (variable-pitch :slant oblique) |
1158 "ABSOLUTELY NO WARRANTY\n" | 1171 "ABSOLUTELY NO WARRANTY\n" |
1159 :face variable-pitch | 1172 :face variable-pitch |
1160 "\ | 1173 :link ("Copying Conditions" (lambda (button) (describe-copying))) |
1161 Copying Conditions\t\tConditions for redistributing and changing Emacs | 1174 "\t\tConditions for redistributing and changing Emacs\n" |
1162 Getting New Versions\tHow to obtain the latest version of Emacs | 1175 :link ("Getting New Versions" (lambda (button) (describe-distribution))) |
1163 More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") | 1176 "\tHow to obtain the latest version of Emacs\n" |
1164 (:face variable-pitch | 1177 :link ("More Manuals / Ordering Manuals" (lambda (button) (view-order-manuals))) |
1165 "\nTo quit a partially entered command, type " | 1178 " Buying printed manuals from the FSF\n") |
1166 :face default | 1179 (:face (variable-pitch :weight bold) |
1167 "Control-g" | |
1168 :face variable-pitch | |
1169 ". | |
1170 | |
1171 Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/ | |
1172 | |
1173 " | |
1174 :face (variable-pitch :weight bold) | |
1175 "Useful File menu items:\n" | 1180 "Useful File menu items:\n" |
1176 :face variable-pitch | 1181 :face variable-pitch |
1177 "Exit Emacs\t\t(Or type " | 1182 :link ("Exit Emacs" (lambda (button) (save-buffers-kill-emacs))) |
1183 "\t\t(Or type " | |
1178 :face default | 1184 :face default |
1179 "Control-x" | 1185 "Control-x" |
1180 :face variable-pitch | 1186 :face variable-pitch |
1181 " followed by " | 1187 " followed by " |
1182 :face default | 1188 :face default |
1183 "Control-c" | 1189 "Control-c" |
1184 :face variable-pitch | 1190 :face variable-pitch |
1185 ") | 1191 ")\n" |
1186 Recover Crashed Session\tRecover files you were editing before a crash\n" | 1192 :link ("Recover Crashed Session" (lambda (button) (recover-session))) |
1187 )) | 1193 "\tRecover files you were editing before a crash\n\n" |
1194 | |
1195 :face (variable-pitch :weight bold) | |
1196 "Useful tasks:\n" | |
1197 :face variable-pitch | |
1198 :link ("Visit New File" | |
1199 (lambda (button) (call-interactively 'find-file))) | |
1200 " Specify a new file's name, to edit the file\n" | |
1201 :link ("Open Home Directory" | |
1202 (lambda (button) (dired "~"))) | |
1203 " Open your home directory, to operate on its files\n" | |
1204 :link ("Open *scratch* buffer" | |
1205 (lambda (button) (switch-to-buffer (get-buffer-create "*scratch*")))) | |
1206 " Open buffer for notes you don't want to save\n" | |
1207 :link ("Customize Startup" | |
1208 (lambda (button) (customize-group 'initialization))) | |
1209 " Change initialization settings including this screen\n" | |
1210 | |
1211 "\nEmacs Guided Tour\t\tSee " | |
1212 :link ("http://www.gnu.org/software/emacs/tour/" | |
1213 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))) | |
1214 | |
1215 )) | |
1188 "A list of texts to show in the middle part of splash screens. | 1216 "A list of texts to show in the middle part of splash screens. |
1189 Each element in the list should be a list of strings or pairs | 1217 Each element in the list should be a list of strings or pairs |
1190 `:face FACE', like `fancy-splash-insert' accepts them.") | 1218 `:face FACE', like `fancy-splash-insert' accepts them.") |
1191 | 1219 |
1192 | 1220 |
1214 :group 'fancy-splash-screen | 1242 :group 'fancy-splash-screen |
1215 :type '(choice (const :tag "Default" nil) | 1243 :type '(choice (const :tag "Default" nil) |
1216 (file :tag "File"))) | 1244 (file :tag "File"))) |
1217 | 1245 |
1218 | 1246 |
1247 (defvar fancy-splash-keymap | |
1248 (let ((map (make-sparse-keymap))) | |
1249 (suppress-keymap map) | |
1250 (set-keymap-parent map button-buffer-map) | |
1251 | |
1252 (define-key map " " 'fancy-splash-quit) | |
1253 (define-key map "q" 'fancy-splash-quit) | |
1254 map) | |
1255 "Keymap for splash screen buffer.") | |
1256 | |
1219 ;; These are temporary storage areas for the splash screen display. | 1257 ;; These are temporary storage areas for the splash screen display. |
1220 | 1258 |
1221 (defvar fancy-current-text nil) | 1259 (defvar fancy-current-text nil) |
1222 (defvar fancy-splash-help-echo nil) | 1260 (defvar fancy-splash-help-echo nil) |
1223 (defvar fancy-splash-stop-time nil) | 1261 (defvar fancy-splash-stop-time nil) |
1224 (defvar fancy-splash-outer-buffer nil) | 1262 (defvar fancy-splash-outer-buffer nil) |
1225 (defvar fancy-splash-last-input-event nil) | |
1226 | 1263 |
1227 (defun fancy-splash-insert (&rest args) | 1264 (defun fancy-splash-insert (&rest args) |
1228 "Insert text into the current buffer, with faces. | 1265 "Insert text into the current buffer, with faces. |
1229 Arguments from ARGS should be either strings, functions called | 1266 Arguments from ARGS should be either strings, functions called |
1230 with no args that return a string, or pairs `:face FACE', | 1267 with no args that return a string, or pairs `:face FACE', |
1231 where FACE is a valid face specification, as it can be used with | 1268 where FACE is a valid face specification, as it can be used with |
1232 `put-text-property'." | 1269 `put-text-property'." |
1233 (let ((current-face nil)) | 1270 (let ((current-face nil)) |
1234 (while args | 1271 (while args |
1235 (if (eq (car args) :face) | 1272 (cond ((eq (car args) :face) |
1236 (setq args (cdr args) current-face (car args)) | 1273 (setq args (cdr args) current-face (car args))) |
1237 (insert (propertize (let ((it (car args))) | 1274 ((eq (car args) :link) |
1238 (if (functionp it) | 1275 (setq args (cdr args)) |
1239 (funcall it) | 1276 (let ((spec (car args))) |
1240 it)) | 1277 (insert-button (car spec) |
1241 'face current-face | 1278 'face (list 'link current-face) |
1242 'help-echo fancy-splash-help-echo))) | 1279 'action (cadr spec) |
1280 'follow-link t))) | |
1281 (t (insert (propertize (let ((it (car args))) | |
1282 (if (functionp it) | |
1283 (funcall it) | |
1284 it)) | |
1285 'face current-face | |
1286 'help-echo fancy-splash-help-echo)))) | |
1243 (setq args (cdr args))))) | 1287 (setq args (cdr args))))) |
1244 | 1288 |
1245 | 1289 |
1246 (defun fancy-splash-head () | 1290 (defun fancy-splash-head () |
1247 "Insert the head part of the splash screen into the current buffer." | 1291 "Insert the head part of the splash screen into the current buffer." |
1277 (interactive) | 1321 (interactive) |
1278 (browse-url "http://www.gnu.org/") | 1322 (browse-url "http://www.gnu.org/") |
1279 (throw 'exit nil))) | 1323 (throw 'exit nil))) |
1280 (define-key map [down-mouse-2] 'ignore) | 1324 (define-key map [down-mouse-2] 'ignore) |
1281 (define-key map [up-mouse-2] 'ignore) | 1325 (define-key map [up-mouse-2] 'ignore) |
1282 (insert-image img (propertize "xxx" 'help-echo help-echo | 1326 (insert-image img (propertize "[image]" 'help-echo help-echo |
1283 'keymap map))) | 1327 'keymap map))) |
1284 (insert "\n")))) | 1328 (insert "\n")))) |
1285 (fancy-splash-insert | 1329 (fancy-splash-insert |
1286 :face '(variable-pitch :foreground "red") | 1330 :face '(variable-pitch :foreground "red") |
1287 (if (eq system-type 'gnu/linux) | 1331 (if (eq system-type 'gnu/linux) |
1289 "GNU Emacs is one component of the GNU operating system.")) | 1333 "GNU Emacs is one component of the GNU operating system.")) |
1290 (insert "\n") | 1334 (insert "\n") |
1291 (fancy-splash-insert | 1335 (fancy-splash-insert |
1292 :face 'variable-pitch | 1336 :face 'variable-pitch |
1293 "You can do basic editing with the menu bar and scroll bar \ | 1337 "You can do basic editing with the menu bar and scroll bar \ |
1294 using the mouse.\n\n") | 1338 using the mouse.\n" |
1339 :face 'variable-pitch | |
1340 "To quit a partially entered command, type " | |
1341 :face 'default | |
1342 "Control-g" | |
1343 :face 'variable-pitch | |
1344 "." | |
1345 "\n\n") | |
1295 (when fancy-splash-outer-buffer | 1346 (when fancy-splash-outer-buffer |
1296 (fancy-splash-insert | 1347 (fancy-splash-insert |
1297 :face 'variable-pitch | 1348 :face 'variable-pitch |
1298 "Type " | 1349 "Type " |
1299 :face 'default | 1350 :face 'default |
1300 "Control-l" | 1351 "`q'" |
1301 :face 'variable-pitch | 1352 :face 'variable-pitch |
1302 " to begin editing" | 1353 " to exit from this screen.\n"))) |
1303 (if (equal (buffer-name fancy-splash-outer-buffer) | |
1304 "*scratch*") | |
1305 ".\n" | |
1306 " your file.\n")))) | |
1307 | 1354 |
1308 (defun fancy-splash-tail () | 1355 (defun fancy-splash-tail () |
1309 "Insert the tail part of the splash screen into the current buffer." | 1356 "Insert the tail part of the splash screen into the current buffer." |
1310 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) | 1357 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) |
1311 "cyan" "darkblue"))) | 1358 "cyan" "darkblue"))) |
1341 "Timer function displaying a splash screen." | 1388 "Timer function displaying a splash screen." |
1342 (when (> (float-time) fancy-splash-stop-time) | 1389 (when (> (float-time) fancy-splash-stop-time) |
1343 (throw 'stop-splashing nil)) | 1390 (throw 'stop-splashing nil)) |
1344 (unless fancy-current-text | 1391 (unless fancy-current-text |
1345 (setq fancy-current-text fancy-splash-text)) | 1392 (setq fancy-current-text fancy-splash-text)) |
1346 (let ((text (car fancy-current-text))) | 1393 (let ((text (car fancy-current-text)) |
1394 (inhibit-read-only t)) | |
1347 (set-buffer buffer) | 1395 (set-buffer buffer) |
1348 (erase-buffer) | 1396 (erase-buffer) |
1349 (if pure-space-overflow | 1397 (if pure-space-overflow |
1350 (insert "\ | 1398 (insert "\ |
1351 Warning Warning!!! Pure space overflow !!!Warning Warning | 1399 Warning Warning!!! Pure space overflow !!!Warning Warning |
1358 (set-buffer-modified-p nil) | 1406 (set-buffer-modified-p nil) |
1359 (goto-char (point-min)) | 1407 (goto-char (point-min)) |
1360 (force-mode-line-update) | 1408 (force-mode-line-update) |
1361 (setq fancy-current-text (cdr fancy-current-text)))) | 1409 (setq fancy-current-text (cdr fancy-current-text)))) |
1362 | 1410 |
1363 | 1411 (defun fancy-splash-quit () |
1364 (defun fancy-splash-default-action () | 1412 "Stop displaying the splash screen buffer." |
1365 "Stop displaying the splash screen buffer. | |
1366 This is an internal function used to turn off the splash screen after | |
1367 the user caused an input event by hitting a key or clicking with the | |
1368 mouse." | |
1369 (interactive) | 1413 (interactive) |
1370 (if (and (memq 'down (event-modifiers last-command-event)) | 1414 (if fancy-splash-outer-buffer |
1371 (eq (posn-window (event-start last-command-event)) | 1415 (throw 'exit nil) |
1372 (selected-window))) | 1416 (kill-buffer (current-buffer)))) |
1373 ;; This is a mouse-down event in the spash screen window. | 1417 |
1374 ;; Ignore it and consume the corresponding mouse-up event. | 1418 (defun fancy-splash-screens (&optional static) |
1375 (read-event) | |
1376 (push last-command-event unread-command-events)) | |
1377 (throw 'exit nil)) | |
1378 | |
1379 (defun fancy-splash-special-event-action () | |
1380 "Save the last event and stop displaying the splash screen buffer. | |
1381 This is an internal function used to turn off the splash screen after | |
1382 the user caused an input event that is bound in `special-event-map'" | |
1383 (interactive) | |
1384 (setq fancy-splash-last-input-event last-input-event) | |
1385 (throw 'exit nil)) | |
1386 | |
1387 | |
1388 (defun fancy-splash-screens (&optional hide-on-input) | |
1389 "Display fancy splash screens when Emacs starts." | 1419 "Display fancy splash screens when Emacs starts." |
1390 (if hide-on-input | 1420 (if (not static) |
1391 (let ((old-hourglass display-hourglass) | 1421 (let ((old-hourglass display-hourglass) |
1392 (fancy-splash-outer-buffer (current-buffer)) | 1422 (fancy-splash-outer-buffer (current-buffer)) |
1393 splash-buffer | 1423 splash-buffer |
1394 (old-minor-mode-map-alist minor-mode-map-alist) | |
1395 (old-emulation-mode-map-alists emulation-mode-map-alists) | |
1396 (old-special-event-map special-event-map) | |
1397 (frame (fancy-splash-frame)) | 1424 (frame (fancy-splash-frame)) |
1398 timer) | 1425 timer) |
1399 (save-selected-window | 1426 (save-selected-window |
1400 (select-frame frame) | 1427 (select-frame frame) |
1401 (switch-to-buffer " GNU Emacs") | 1428 (switch-to-buffer " About GNU Emacs") |
1402 (make-local-variable 'cursor-type) | 1429 (make-local-variable 'cursor-type) |
1403 (setq splash-buffer (current-buffer)) | 1430 (setq splash-buffer (current-buffer)) |
1404 (catch 'stop-splashing | 1431 (catch 'stop-splashing |
1405 (unwind-protect | 1432 (unwind-protect |
1406 (let ((map (make-sparse-keymap)) | 1433 (let ((cursor-type nil)) |
1407 (cursor-type nil)) | |
1408 (use-local-map map) | |
1409 (define-key map [switch-frame] 'ignore) | |
1410 (define-key map [t] 'fancy-splash-default-action) | |
1411 (define-key map [mouse-movement] 'ignore) | |
1412 (define-key map [mode-line t] 'ignore) | |
1413 ;; Temporarily bind special events to | |
1414 ;; fancy-splash-special-event-action so as to stop | |
1415 ;; displaying splash screens with such events. | |
1416 ;; Otherwise, drag-n-drop into splash screens may | |
1417 ;; leave us in recursive editing with invisible | |
1418 ;; cursors for a while. | |
1419 (setq special-event-map (make-sparse-keymap)) | |
1420 (map-keymap | |
1421 (lambda (key def) | |
1422 (define-key special-event-map (vector key) | |
1423 (if (eq def 'ignore) | |
1424 'ignore | |
1425 'fancy-splash-special-event-action))) | |
1426 old-special-event-map) | |
1427 (setq display-hourglass nil | 1434 (setq display-hourglass nil |
1428 minor-mode-map-alist nil | |
1429 emulation-mode-map-alists nil | |
1430 buffer-undo-list t | 1435 buffer-undo-list t |
1431 mode-line-format (propertize "---- %b %-" | 1436 mode-line-format (propertize "---- %b %-" |
1432 'face 'mode-line-buffer-id) | 1437 'face 'mode-line-buffer-id) |
1433 fancy-splash-stop-time (+ (float-time) | 1438 fancy-splash-stop-time (+ (float-time) |
1434 fancy-splash-max-time) | 1439 fancy-splash-max-time) |
1435 timer (run-with-timer 0 fancy-splash-delay | 1440 timer (run-with-timer 0 fancy-splash-delay |
1436 #'fancy-splash-screens-1 | 1441 #'fancy-splash-screens-1 |
1437 splash-buffer)) | 1442 splash-buffer)) |
1443 (use-local-map fancy-splash-keymap) | |
1438 (message "%s" (startup-echo-area-message)) | 1444 (message "%s" (startup-echo-area-message)) |
1445 (setq buffer-read-only t) | |
1439 (recursive-edit)) | 1446 (recursive-edit)) |
1440 (cancel-timer timer) | 1447 (cancel-timer timer) |
1441 (setq display-hourglass old-hourglass | 1448 (setq display-hourglass old-hourglass) |
1442 minor-mode-map-alist old-minor-mode-map-alist | 1449 (kill-buffer splash-buffer))))) |
1443 emulation-mode-map-alists old-emulation-mode-map-alists | 1450 ;; If static is non-nil, don't show fancy splash screen. |
1444 special-event-map old-special-event-map) | |
1445 (kill-buffer splash-buffer) | |
1446 (when fancy-splash-last-input-event | |
1447 (setq last-input-event fancy-splash-last-input-event | |
1448 fancy-splash-last-input-event nil) | |
1449 (command-execute (lookup-key special-event-map | |
1450 (vector last-input-event)) | |
1451 nil (vector last-input-event) t)))))) | |
1452 ;; If hide-on-input is nil, don't hide the buffer on input. | |
1453 (if (or (window-minibuffer-p) | 1451 (if (or (window-minibuffer-p) |
1454 (window-dedicated-p (selected-window))) | 1452 (window-dedicated-p (selected-window))) |
1455 (pop-to-buffer (current-buffer)) | 1453 (pop-to-buffer (current-buffer)) |
1456 (switch-to-buffer "*About GNU Emacs*")) | 1454 (switch-to-buffer " GNU Emacs")) |
1457 (setq buffer-read-only nil) | 1455 (setq buffer-read-only nil) |
1458 (erase-buffer) | 1456 (erase-buffer) |
1459 (if pure-space-overflow | 1457 (if pure-space-overflow |
1460 (insert "\ | 1458 (insert "\ |
1461 Warning Warning!!! Pure space overflow !!!Warning Warning | 1459 Warning Warning!!! Pure space overflow !!!Warning Warning |
1467 (insert "\n")) | 1465 (insert "\n")) |
1468 (skip-chars-backward "\n") | 1466 (skip-chars-backward "\n") |
1469 (delete-region (point) (point-max)) | 1467 (delete-region (point) (point-max)) |
1470 (insert "\n") | 1468 (insert "\n") |
1471 (fancy-splash-tail) | 1469 (fancy-splash-tail) |
1470 (use-local-map fancy-splash-keymap) | |
1472 (set-buffer-modified-p nil) | 1471 (set-buffer-modified-p nil) |
1473 (setq buffer-read-only t) | 1472 (setq buffer-read-only t) |
1474 (if (and view-read-only (not view-mode)) | 1473 (if (and view-read-only (not view-mode)) |
1475 (view-mode-enter nil 'kill-buffer)) | 1474 (view-mode-enter nil 'kill-buffer)) |
1476 (goto-char (point-min))))) | 1475 (goto-char (point-min))))) |
1505 ;; splash screen to be used. | 1504 ;; splash screen to be used. |
1506 (frame-height (1- (frame-height frame)))) | 1505 (frame-height (1- (frame-height frame)))) |
1507 (> frame-height (+ image-height 19))))))) | 1506 (> frame-height (+ image-height 19))))))) |
1508 | 1507 |
1509 | 1508 |
1510 (defun normal-splash-screen (&optional hide-on-input) | 1509 (defun normal-splash-screen (&optional static) |
1511 "Display splash screen when Emacs starts." | 1510 "Display splash screen when Emacs starts." |
1512 (let ((prev-buffer (current-buffer))) | 1511 (let ((prev-buffer (current-buffer))) |
1513 (unwind-protect | 1512 (unwind-protect |
1514 (with-current-buffer (get-buffer-create "GNU Emacs") | 1513 (with-current-buffer (get-buffer-create " About GNU Emacs") |
1515 (setq buffer-read-only nil) | 1514 (setq buffer-read-only nil) |
1516 (erase-buffer) | 1515 (erase-buffer) |
1517 (set (make-local-variable 'tab-width) 8) | 1516 (set (make-local-variable 'tab-width) 8) |
1518 (if hide-on-input | 1517 (if (not static) |
1519 (set (make-local-variable 'mode-line-format) | 1518 (set (make-local-variable 'mode-line-format) |
1520 (propertize "---- %b %-" 'face 'mode-line-buffer-id))) | 1519 (propertize "---- %b %-" 'face 'mode-line-buffer-id))) |
1521 | 1520 |
1522 (if pure-space-overflow | 1521 (if pure-space-overflow |
1523 (insert "\ | 1522 (insert "\ |
1531 (insert | 1530 (insert |
1532 (if (eq system-type 'gnu/linux) | 1531 (if (eq system-type 'gnu/linux) |
1533 ", one component of the GNU/Linux operating system.\n" | 1532 ", one component of the GNU/Linux operating system.\n" |
1534 ", a part of the GNU operating system.\n")) | 1533 ", a part of the GNU operating system.\n")) |
1535 | 1534 |
1536 (if hide-on-input | 1535 (if (not static) |
1537 (insert (substitute-command-keys | 1536 (insert (substitute-command-keys |
1538 (concat | 1537 (concat |
1539 "\nType \\[recenter] to begin editing" | 1538 "\nType \\[recenter] to quit from this screen.\n")))) |
1540 (if (equal (buffer-name prev-buffer) "*scratch*") | |
1541 ".\n" | |
1542 " your file.\n"))))) | |
1543 | 1539 |
1544 (if (display-mouse-p) | 1540 (if (display-mouse-p) |
1545 ;; The user can use the mouse to activate menus | 1541 ;; The user can use the mouse to activate menus |
1546 ;; so give help in terms of menu items. | 1542 ;; so give help in terms of menu items. |
1547 (progn | 1543 (progn |
1548 (insert "\ | 1544 (insert "\ |
1549 You can do basic editing with the menu bar and scroll bar using the mouse. | 1545 You can do basic editing with the menu bar and scroll bar using the mouse. |
1550 To quit a partially entered command, type Control-g. | 1546 To quit a partially entered command, type Control-g.\n") |
1551 | 1547 |
1552 Useful File menu items: | 1548 (insert "\nImportant Help menu items:\n") |
1553 Exit Emacs (or type Control-x followed by Control-c) | 1549 (insert-button "Emacs Tutorial" |
1554 Recover Crashed Session Recover files you were editing before a crash | 1550 'action (lambda (button) (help-with-tutorial)) |
1555 | 1551 'follow-link t) |
1556 Important Help menu items: | 1552 (insert " Learn how to use Emacs efficiently\n") |
1557 Emacs Tutorial Learn how to use Emacs efficiently | 1553 (insert-button "Emacs FAQ" |
1558 Emacs FAQ Frequently asked questions and answers | 1554 'action (lambda (button) (view-emacs-FAQ)) |
1559 Read the Emacs Manual View the Emacs manual using Info | 1555 'follow-link t) |
1560 \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY | 1556 (insert " Frequently asked questions and answers\n") |
1561 Copying Conditions Conditions for redistributing and changing Emacs | 1557 (insert-button "Read the Emacs Manual" |
1562 Getting New Versions How to obtain the latest version of Emacs | 1558 'action (lambda (button) (info-emacs-manual)) |
1563 More Manuals / Ordering Manuals How to order printed manuals from the FSF | 1559 'follow-link t) |
1564 ") | 1560 (insert " View the Emacs manual using Info\n") |
1565 (insert "\n\n" (emacs-version) | 1561 (insert-button "\(Non)Warranty" |
1562 'action (lambda (button) (describe-no-warranty)) | |
1563 'follow-link t) | |
1564 (insert " GNU Emacs comes with ABSOLUTELY NO WARRANTY\n") | |
1565 (insert-button "Copying Conditions" | |
1566 'action (lambda (button) (describe-copying)) | |
1567 'follow-link t) | |
1568 (insert " Conditions for redistributing and changing Emacs\n") | |
1569 (insert-button "Getting New Versions" | |
1570 'action (lambda (button) (describe-distribution)) | |
1571 'follow-link t) | |
1572 (insert " How to obtain the latest version of Emacs\n") | |
1573 (insert-button "More Manuals / Ordering Manuals" | |
1574 'action (lambda (button) (view-order-manuals)) | |
1575 'follow-link t) | |
1576 (insert " How to order printed manuals from the FSF\n") | |
1577 | |
1578 (insert "\nUseful File menu items:\n") | |
1579 (insert-button "Exit Emacs" | |
1580 'action (lambda (button) (save-buffers-kill-emacs)) | |
1581 'follow-link t) | |
1582 (insert " (or type Control-x followed by Control-c)\n") | |
1583 (insert-button "Recover Crashed Session" | |
1584 'action (lambda (button) (recover-session)) | |
1585 'follow-link t) | |
1586 (insert " Recover files you were editing before a crash\n") | |
1587 | |
1588 (insert "\nUseful tasks:\n") | |
1589 (insert-button "Visit New File" | |
1590 'action (lambda (button) (call-interactively 'find-file)) | |
1591 'follow-link t) | |
1592 (insert " Specify a new file's name, to edit the file\n") | |
1593 (insert-button "Open Home Directory" | |
1594 'action (lambda (button) (dired "~")) | |
1595 'follow-link t) | |
1596 (insert " Open your home directory, to operate on its files\n") | |
1597 (insert-button "Open *scratch* buffer" | |
1598 'action (lambda (button) (switch-to-buffer | |
1599 (get-buffer-create "*scratch*"))) | |
1600 'follow-link t) | |
1601 (insert " Open buffer for notes you don't want to save\n") | |
1602 (insert-button "Customize Startup" | |
1603 'action (lambda (button) (customize-group 'initialization)) | |
1604 'follow-link t) | |
1605 (insert " Change initialization settings including this screen\n") | |
1606 | |
1607 (insert "\n" (emacs-version) | |
1566 "\n" emacs-copyright)) | 1608 "\n" emacs-copyright)) |
1567 | 1609 |
1568 ;; No mouse menus, so give help using kbd commands. | 1610 ;; No mouse menus, so give help using kbd commands. |
1569 | 1611 |
1570 ;; If keys have their default meanings, | 1612 ;; If keys have their default meanings, |
1607 ;; Many users seem to have problems with these. | 1649 ;; Many users seem to have problems with these. |
1608 (insert " | 1650 (insert " |
1609 \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. | 1651 \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. |
1610 If you have no Meta key, you may instead type ESC followed by the character.)") | 1652 If you have no Meta key, you may instead type ESC followed by the character.)") |
1611 | 1653 |
1612 (insert "\n\n" (emacs-version) | 1654 ;; Insert links to useful tasks |
1655 (insert "\n\nUseful tasks (move point to the link and press RET):\n") | |
1656 (insert-button "Visit New File" | |
1657 'action (lambda (button) (call-interactively 'find-file)) | |
1658 'follow-link t) | |
1659 (insert " Specify a new file's name, to edit the file\n") | |
1660 (insert-button "Open Home Directory" | |
1661 'action (lambda (button) (dired "~")) | |
1662 'follow-link t) | |
1663 (insert " Open your home directory, to operate on its files\n") | |
1664 (insert-button "Open *scratch* buffer" | |
1665 'action (lambda (button) (switch-to-buffer | |
1666 (get-buffer-create "*scratch*"))) | |
1667 'follow-link t) | |
1668 (insert " Open buffer for notes you don't want to save\n") | |
1669 (insert-button "Customize Startup" | |
1670 'action (lambda (button) (customize-group 'initialization)) | |
1671 'follow-link t) | |
1672 (insert " Change initialization settings including this screen\n") | |
1673 | |
1674 (insert "\n" (emacs-version) | |
1613 "\n" emacs-copyright) | 1675 "\n" emacs-copyright) |
1614 | 1676 |
1615 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) | 1677 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) |
1616 (eq (key-binding "\C-h\C-d") 'describe-distribution) | 1678 (eq (key-binding "\C-h\C-d") 'describe-distribution) |
1617 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) | 1679 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) |
1645 (regexp-quote (file-name-nondirectory | 1707 (regexp-quote (file-name-nondirectory |
1646 auto-save-list-file-prefix))) | 1708 auto-save-list-file-prefix))) |
1647 t) | 1709 t) |
1648 (insert "\n\nIf an Emacs session crashed recently, " | 1710 (insert "\n\nIf an Emacs session crashed recently, " |
1649 "type Meta-x recover-session RET\nto recover" | 1711 "type Meta-x recover-session RET\nto recover" |
1650 " the files you were editing.")) | 1712 " the files you were editing.\n")) |
1713 | |
1714 (use-local-map button-buffer-map) | |
1651 | 1715 |
1652 ;; Display the input that we set up in the buffer. | 1716 ;; Display the input that we set up in the buffer. |
1653 (set-buffer-modified-p nil) | 1717 (set-buffer-modified-p nil) |
1654 (setq buffer-read-only t) | 1718 (setq buffer-read-only t) |
1655 (if (and view-read-only (not view-mode)) | 1719 (if (and view-read-only (not view-mode)) |
1656 (view-mode-enter nil 'kill-buffer)) | 1720 (view-mode-enter nil 'kill-buffer)) |
1657 (goto-char (point-min)) | 1721 (goto-char (point-min)) |
1658 (if hide-on-input | 1722 (if (not static) |
1659 (if (or (window-minibuffer-p) | 1723 (if (or (window-minibuffer-p) |
1660 (window-dedicated-p (selected-window))) | 1724 (window-dedicated-p (selected-window))) |
1661 ;; If hide-on-input is nil, creating a new frame will | 1725 ;; If static is nil, creating a new frame will |
1662 ;; generate enough events that the subsequent `sit-for' | 1726 ;; generate enough events that the subsequent `sit-for' |
1663 ;; will immediately return anyway. | 1727 ;; will immediately return anyway. |
1664 nil ;; (pop-to-buffer (current-buffer)) | 1728 nil ;; (pop-to-buffer (current-buffer)) |
1665 (save-window-excursion | 1729 (save-window-excursion |
1666 (switch-to-buffer (current-buffer)) | 1730 (switch-to-buffer (current-buffer)) |
1668 (condition-case nil | 1732 (condition-case nil |
1669 (switch-to-buffer (current-buffer)) | 1733 (switch-to-buffer (current-buffer)) |
1670 ;; In case the window is dedicated or something. | 1734 ;; In case the window is dedicated or something. |
1671 (error (pop-to-buffer (current-buffer)))))) | 1735 (error (pop-to-buffer (current-buffer)))))) |
1672 ;; Unwind ... ensure splash buffer is killed | 1736 ;; Unwind ... ensure splash buffer is killed |
1673 (if hide-on-input | 1737 (if (not static) |
1674 (kill-buffer "GNU Emacs") | 1738 (kill-buffer " About GNU Emacs") |
1675 (switch-to-buffer "GNU Emacs") | 1739 (switch-to-buffer " About GNU Emacs") |
1676 (rename-buffer "*About GNU Emacs*" t))))) | 1740 (rename-buffer " GNU Emacs" t))))) |
1677 | 1741 |
1678 | 1742 |
1679 (defun startup-echo-area-message () | 1743 (defun startup-echo-area-message () |
1680 (if (eq (key-binding "\C-h\C-p") 'describe-project) | 1744 (if (eq (key-binding "\C-h\C-p") 'describe-project) |
1681 "For information about the GNU system and GNU/Linux, type C-h C-p." | 1745 "For information about the GNU system and GNU/Linux, type C-h C-p." |
1687 (defun display-startup-echo-area-message () | 1751 (defun display-startup-echo-area-message () |
1688 (let ((resize-mini-windows t)) | 1752 (let ((resize-mini-windows t)) |
1689 (message "%s" (startup-echo-area-message)))) | 1753 (message "%s" (startup-echo-area-message)))) |
1690 | 1754 |
1691 | 1755 |
1692 (defun display-splash-screen (&optional hide-on-input) | 1756 (defun display-splash-screen (&optional static) |
1693 "Display splash screen according to display. | 1757 "Display splash screen according to display. |
1694 Fancy splash screens are used on graphic displays, | 1758 Fancy splash screens are used on graphic displays, |
1695 normal otherwise. | 1759 normal otherwise. |
1696 With a prefix argument, any user input hides the splash screen." | 1760 With a prefix argument, any user input hides the splash screen." |
1697 (interactive "P") | 1761 (interactive "P") |
1698 (if (use-fancy-splash-screens-p) | 1762 (if (use-fancy-splash-screens-p) |
1699 (fancy-splash-screens hide-on-input) | 1763 (fancy-splash-screens static) |
1700 (normal-splash-screen hide-on-input))) | 1764 (normal-splash-screen static))) |
1701 | 1765 |
1766 (defalias 'about-emacs 'display-splash-screen) | |
1702 | 1767 |
1703 (defun command-line-1 (command-line-args-left) | 1768 (defun command-line-1 (command-line-args-left) |
1704 (or noninteractive (input-pending-p) init-file-had-error | 1769 (or noninteractive (input-pending-p) init-file-had-error |
1705 ;; t if the init file says to inhibit the echo area startup message. | 1770 ;; t if the init file says to inhibit the echo area startup message. |
1706 (and inhibit-startup-echo-area-message | 1771 (and inhibit-startup-echo-area-message |
1956 (not noninteractive) | 2021 (not noninteractive) |
1957 (not inhibit-startup-buffer-menu) | 2022 (not inhibit-startup-buffer-menu) |
1958 (or (get-buffer-window first-file-buffer) | 2023 (or (get-buffer-window first-file-buffer) |
1959 (list-buffers))))) | 2024 (list-buffers))))) |
1960 | 2025 |
2026 (when initial-buffer-choice | |
2027 (cond ((eq initial-buffer-choice t) | |
2028 (switch-to-buffer (get-buffer-create "*scratch*"))) | |
2029 ((stringp initial-buffer-choice) | |
2030 (find-file initial-buffer-choice)))) | |
2031 | |
1961 ;; Maybe display a startup screen. | 2032 ;; Maybe display a startup screen. |
1962 (unless (or inhibit-startup-message | 2033 (unless (or inhibit-startup-message |
2034 initial-buffer-choice | |
1963 noninteractive | 2035 noninteractive |
1964 emacs-quick-startup) | 2036 emacs-quick-startup) |
1965 ;; Display a startup screen, after some preparations. | 2037 ;; Display a startup screen, after some preparations. |
1966 | 2038 |
1967 ;; If there are no switches to process, we might as well | 2039 ;; If there are no switches to process, we might as well |