Mercurial > hg > xemacs-beta
annotate lisp/startup.el @ 5938:699264ac20f1 cygwin
tls.h (why?) and skip-ascii.h added
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Wed, 08 Dec 2021 18:43:18 +0000 |
| parents | b09e3b1b7424 |
| children | bbe4146603db |
| rev | line source |
|---|---|
| 428 | 1 ;;; startup.el --- process XEmacs shell arguments |
| 2 | |
| 3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc. | |
| 5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois | |
| 2505 | 6 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Ben Wing. |
| 428 | 7 |
| 8 ;; Maintainer: XEmacs Development Team | |
| 9 ;; Keywords: internal, dumped | |
| 10 | |
| 11 ;; This file is part of XEmacs. | |
| 12 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
13 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
14 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
15 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
16 ;; option) any later version. |
| 428 | 17 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
18 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
21 ;; for more details. |
| 428 | 22 |
| 23 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
24 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 25 |
| 26 ;;; Synched up with: FSF 19.34. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 502 | 32 ;; It handles the all aspects of startup once the C code has finished |
| 33 ;; initializing itself. Entry from C is through the function set in | |
| 34 ;; the `top-level' variable, which is normally `normal-top-level'. At | |
| 35 ;; the point that `normal-top-level' has been invoked: | |
| 36 ;; | |
| 37 ;; (1) the dumped Elisp files are available. Either they were loaded | |
| 38 ;; during this invocation of temacs and it was then converted to | |
| 39 ;; XEmacs using the run-temacs mechanism, or (more likely) the | |
| 40 ;; loadup and dumping occurred at some point in the past and we | |
| 41 ;; just read in the dumped data. | |
| 42 ;; | |
| 43 ;; (2) All C subsystems have been initialized. | |
| 44 ;; | |
| 45 ;; (3) A "stream" device has been created, which does I/O over stdin | |
| 46 ;; and stdout. This is the only device we have available and our | |
| 47 ;; only means of communication, other than disk files. | |
| 48 ;; | |
| 49 ;; (4) The command-line arguments have been sorted according to | |
| 50 ;; priority specs (this implies that the names of all arguments | |
| 51 ;; must be hard-coded into emacs.c), and certain low-level | |
| 52 ;; arguments such as -sd, -t, -nd, -nw, -batch, etc. have been | |
| 53 ;; processed by main_1() and removed. (NOTE: main_1() is the name | |
| 54 ;; in the source code, but in the object file it has some other | |
| 55 ;; name, such as xemacs_21_2_34_mips_sgi_irix6().) Certain other | |
| 56 ;; arguments such as -version and -help are partially-processed, | |
| 57 ;; triggering some special behavior but being left on the list for | |
| 58 ;; further processing by the Lisp code. | |
| 59 ;; | |
| 60 ;; The job of the code here is to process the remaining command-line | |
| 61 ;; args, set up the various paths, locate where all the packages are | |
| 62 ;; and set things up for them (initialize the load path, read in the | |
| 63 ;; autoloads, etc.), read in the init files, display the splash | |
| 64 ;; screen, and set up any remaining environment-dependent variables. | |
| 428 | 65 |
| 66 ;;; Code: | |
| 67 | |
| 68 (setq top-level '(normal-top-level)) | |
| 69 | |
| 70 (defvar command-line-processed nil "t once command line has been processed") | |
| 71 | |
| 72 (defconst startup-message-timeout 12000) ; More or less disable the timeout | |
| 73 | |
| 74 (defconst inhibit-startup-message nil | |
| 75 "*Non-nil inhibits the initial startup message. | |
| 76 This is for use in your personal init file, once you are familiar | |
| 77 with the contents of the startup message.") | |
| 78 | |
| 79 ;; #### FSFmacs randomness | |
| 80 ;;(defconst inhibit-startup-echo-area-message nil | |
| 81 ;; "*Non-nil inhibits the initial startup echo area message. | |
| 82 ;;Inhibition takes effect only if your `.emacs' file contains | |
| 83 ;;a line of this form: | |
| 84 ;; (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\") | |
| 85 ;;If your `.emacs' file is byte-compiled, use the following form instead: | |
| 86 ;; (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")) | |
| 87 ;;Thus, someone else using a copy of your `.emacs' file will see | |
| 88 ;;the startup message unless he personally acts to inhibit it.") | |
| 89 | |
| 90 (defconst inhibit-default-init nil | |
| 91 "*Non-nil inhibits loading the `default' library.") | |
| 92 | |
| 93 (defvar command-line-args-left nil | |
| 94 "List of command-line args not yet processed.") ; bound by `command-line' | |
| 95 | |
| 96 (defvar command-line-default-directory nil | |
| 97 "Default directory to use for command line arguments. | |
| 98 This is normally copied from `default-directory' when XEmacs starts.") | |
| 99 | |
| 100 (defvar before-init-hook nil | |
| 101 "Functions to call after handling urgent options but before init files. | |
| 102 The frame system uses this to open frames to display messages while | |
| 103 XEmacs loads the user's initialization file.") | |
| 104 | |
| 105 (defvar after-init-hook nil | |
| 452 | 106 "*Functions to call after loading the init file. |
| 428 | 107 The call is not protected by a condition-case, so you can set `debug-on-error' |
| 452 | 108 in the init file, and put all the actual code on `after-init-hook'.") |
| 428 | 109 |
| 110 (defvar term-setup-hook nil | |
| 111 "*Functions to be called after loading terminal-specific Lisp code. | |
| 112 See `run-hooks'. This variable exists for users to set, so as to | |
| 113 override the definitions made by the terminal-specific file. XEmacs | |
| 114 never sets this variable itself.") | |
| 115 | |
| 116 (defvar keyboard-type nil | |
| 117 "The brand of keyboard you are using. | |
| 118 This variable is used to define the proper function and keypad keys | |
| 119 for use under X. It is used in a fashion analogous to the environment | |
| 120 value TERM.") | |
| 121 | |
| 122 (defvar window-setup-hook nil | |
| 123 "Normal hook run to initialize window system display. | |
| 124 XEmacs runs this hook after processing the command line arguments and loading | |
| 125 the user's init file.") | |
| 126 | |
| 127 (defconst initial-major-mode 'lisp-interaction-mode | |
| 128 "Major mode command symbol to use for the initial *scratch* buffer.") | |
| 2456 | 129 |
| 130 ;;; Path-related variables. | |
| 131 ;;; NOTE: Many of them (`lisp-directory', `data-directory', etc.) are | |
| 132 ;;; built-in. | |
| 428 | 133 |
| 2456 | 134 (defvar emacs-roots nil |
| 135 "List of plausible roots of the XEmacs hierarchy. | |
| 136 This is a list of plausible directories in which to search for the important | |
| 137 directories used by XEmacs at run-time, for example `exec-directory', | |
| 138 `data-directory' and `lisp-directory'. | |
| 139 | |
| 140 Normally set at startup by calling `paths-find-emacs-roots'.") | |
| 141 | |
| 142 (defvar emacs-data-roots nil | |
| 143 "List of plausible data roots of the XEmacs hierarchy.") | |
| 144 | |
| 145 (defvar user-init-directory-base ".xemacs" | |
| 146 "Base of directory where user-installed init files may go.") | |
| 147 | |
| 148 (defvar user-init-directory | |
| 149 (file-name-as-directory | |
| 150 (paths-construct-path (list "~" user-init-directory-base))) | |
| 151 "Directory where user-installed init files may go.") | |
| 152 | |
| 153 (defvar user-init-file-base "init.el" | |
| 154 "Default name of the user init file if uncompiled. | |
| 155 This should be used for migration purposes only.") | |
| 156 | |
| 157 (defvar user-init-file-base-list '("init.el") | |
| 158 "List of allowed init files in the user's init directory. | |
| 159 The first one found takes precedence. .elc files do not need to be listed.") | |
| 160 | |
| 161 (defvar user-home-init-file-base-list | |
| 162 (append '(".emacs.el" ".emacs") | |
| 163 (and (eq system-type 'windows-nt) | |
| 164 '("_emacs.el" "_emacs"))) | |
| 165 "List of allowed init files in the user's home directory. | |
| 166 The first one found takes precedence. .elc files do not need to be listed.") | |
| 167 | |
| 168 (defvar load-home-init-file nil | |
| 169 "Non-nil if XEmacs should load the init file from the home directory. | |
| 170 Otherwise, XEmacs will offer migration to the init directory.") | |
| 171 | |
| 172 (defvar load-user-init-file-p t | |
| 173 "Non-nil if XEmacs should load the user's init file.") | |
| 174 | |
| 3360 | 175 ;; #### called `site-run-file' in GNU Emacs |
| 428 | 176 |
| 444 | 177 (defvar site-start-file "site-start" |
| 428 | 178 "File containing site-wide run-time initializations. |
| 2030 | 179 It is loaded at run-time before the user's init file (see `user-init-file'). |
| 180 It contains inits that need to be in place for the entire site, but | |
| 428 | 181 which, due to their higher incidence of change, don't make sense to |
| 2030 | 182 load into XEmacs's dumped image. Thus, the run-time load order is: |
| 428 | 183 |
| 184 1. file described in this variable, if non-nil; | |
| 2030 | 185 2. the file computed by `find-user-init-file'; |
| 428 | 186 3. `/path/to/xemacs/lisp/default.el'. |
| 187 | |
| 188 Don't use the `site-start.el' file for things some users may not like. | |
| 189 Put them in `default.el' instead, so that users can more easily | |
| 190 override them. Users can prevent loading `default.el' with the `-q' | |
| 191 option or by setting `inhibit-default-init' in their own init files, | |
| 192 but inhibiting `site-start.el' requires `--no-site-file', which | |
| 193 is less convenient.") | |
| 194 | |
| 195 ;;(defconst iso-8859-1-locale-regexp "8859[-_]?1" | |
| 196 ;; "Regexp that specifies when to enable the ISO 8859-1 character set. | |
| 197 ;;We do that if this regexp matches the locale name | |
| 198 ;;specified by the LC_ALL, LC_CTYPE and LANG environment variables.") | |
| 199 | |
| 442 | 200 (defcustom mail-host-address nil |
| 201 "*Name of this machine, for purposes of naming users." | |
| 202 :type 'string | |
| 203 :group 'mail) | |
| 428 | 204 |
| 442 | 205 (defcustom user-mail-address nil |
| 428 | 206 "*Full mailing address of this user. |
| 207 This is initialized based on `mail-host-address', | |
| 442 | 208 after your init file is read, in case it sets `mail-host-address'." |
| 209 :type 'string | |
| 210 :group 'mail) | |
| 428 | 211 |
| 212 (defvar init-file-debug nil) | |
| 213 | |
| 214 (defvar init-file-had-error nil) | |
| 215 | |
| 216 (defvar init-file-loaded nil | |
| 217 "True after the user's init file has been loaded (or suppressed with -q). | |
| 218 This will be true when `after-init-hook' is run and at all times | |
| 219 after, and will not be true at any time before.") | |
| 220 | |
| 221 (defvar initial-frame-unmapped-p nil) | |
| 222 | |
| 223 | |
| 224 | |
| 225 (defvar command-switch-alist | |
| 444 | 226 '(("-help" . command-line-do-help) |
| 771 | 227 ("-version" . command-line-do-version) |
| 444 | 228 ("-V" . command-line-do-version) |
| 771 | 229 ("-funcall" . command-line-do-funcall) |
| 444 | 230 ("-f" . command-line-do-funcall) |
| 231 ("-e" . command-line-do-funcall-1) | |
| 232 ("-eval" . command-line-do-eval) | |
| 233 ("-load" . command-line-do-load) | |
| 234 ("-l" . command-line-do-load) | |
|
4448
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
235 ("--script" . command-line-do-script) |
|
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
236 ("-script" . command-line-do-script) |
| 444 | 237 ("-insert" . command-line-do-insert) |
| 238 ("-i" . command-line-do-insert) | |
| 239 ("-kill" . command-line-do-kill) | |
| 771 | 240 ("-eol" . command-line-do-enable-eol-detection) |
| 776 | 241 ("-enable-eol-detection" . command-line-do-enable-eol-detection) |
| 444 | 242 ;; Options like +35 are handled specially. |
| 243 ;; Window-system, site, or package-specific code might add to this. | |
| 244 ;; X11 handles its options by letting Xt remove args from this list. | |
| 245 ) | |
| 428 | 246 "Alist of command-line switches. |
| 247 Elements look like (SWITCH-STRING . HANDLER-FUNCTION). | |
| 248 HANDLER-FUNCTION receives switch name as sole arg; | |
| 249 remaining command-line args are in the variable `command-line-args-left'.") | |
| 250 | |
| 251 ;;; default switches | |
| 252 ;;; Note: these doc strings are semi-magical. | |
| 253 | |
| 254 (defun command-line-do-help (arg) | |
| 255 "Print the XEmacs usage message and exit." | |
| 256 (let ((standard-output 'external-debugging-output)) | |
| 257 (princ (concat "\n" (emacs-version) "\n\n")) | |
| 258 (princ | |
| 259 (if (featurep 'x) | |
| 260 (concat "When creating a window on an X display, " | |
| 261 (emacs-name) | |
| 262 " accepts all standard X Toolkit | |
| 263 command line options plus the following: | |
| 264 -iconname <title> Use title as the icon name. | |
| 265 -mc <color> Use color as the mouse color. | |
| 266 -cr <color> Use color as the text-cursor foregound color. | |
| 267 -private Install a private colormap. | |
| 268 | |
| 269 In addition, the") | |
| 270 "The")) | |
| 771 | 271 (let ((l command-switch-alist) |
| 272 (options " following options are accepted: | |
| 273 | |
| 274 Display options: | |
| 275 | |
| 276 -nw Open the initial frame on the current TTY, instead of | |
| 277 a window system. | |
| 278 -t <device> Use TTY <device> instead of the current TTY for input | |
| 279 and output. This implies the -nw option. | |
| 280 -display <display> Standard X option, to specify the display connection. | |
| 281 If this option is given, or if the environment | |
| 282 variable DISPLAY is set, an initial X frame will be | |
| 283 created. Otherwise, an initial Windows frame will be | |
| 284 created if Windows support exists and neither -nw nor | |
| 285 -t is given. Otherwise, a TTY frame is created. | |
| 286 -unmapped Do not display the initial frame. Useful to create | |
| 287 a \"server\" that can accept `gnuclient' connections. | |
| 3360 | 288 -tty Create the initial frame on the given window system. |
| 289 -x (Requesting an unsupported window system, or giving | |
| 290 -gtk conflicting window systems, is a fatal error.) | |
| 291 -gnome | |
| 292 -msw | |
| 771 | 293 |
| 294 Noninteractive options: | |
| 295 | |
| 296 {-help} | |
| 297 {-version} | |
| 298 {-V} | |
| 299 -batch Execute noninteractively (messages go to stderr, no | |
| 300 initial frame created). | |
| 301 {-funcall} | |
| 302 (The function may parse the rest of the command line | |
| 303 for its arguments.) | |
| 304 {-f} | |
| 305 {-eval} | |
| 306 {-load} | |
| 307 {-l} | |
| 308 {-insert} | |
| 309 {-i} | |
| 310 {-kill} | |
| 446 | 311 -sd Show dump ID. Ignored when configured without --pdump. |
| 312 -nd Don't load the dump file. Roughly like old temacs. | |
| 313 Ignored when configured without --pdump. | |
| 771 | 314 |
| 315 Initialization files: | |
| 316 | |
| 317 -no-init-file Do not load the user-specific init file. | |
| 318 -q Same as -no-init-file. | |
| 428 | 319 -debug-init Enter the debugger if an error in the init file occurs. |
| 771 | 320 -user-init-file <file> |
| 321 Use <file> as init file. | |
| 322 -user-init-directory <directory> | |
| 323 Use <directory> as init directory. | |
| 324 -user <user> Load user's init file instead of your own. | |
| 325 -u <user> Same as -user. | |
| 326 -no-site-file Do not load the site-specific init file | |
| 327 (site-start.el). | |
| 328 | |
| 329 Package/module options: | |
| 330 | |
| 331 -vanilla Equivalent to -q -no-site-file -no-early-packages. | |
| 776 | 332 Useful if you think some user-init or site-init code |
| 333 is messing things up, or when running XEmacs in | |
| 334 batch mode. | |
| 428 | 335 -no-autoloads Do not load global symbol files (auto-autoloads) at |
| 336 startup. Also implies `-vanilla'. | |
| 776 | 337 -no-packages Pretend like the packages don't exist. Don't put |
| 338 any packages in the load path or set up any package | |
| 969 | 339 autoloads. Also implies `-vanilla'. Use this when |
| 776 | 340 running XEmacs in batch mode when you aren't using |
| 341 any functionality in packages and want to make sure | |
| 342 that you get no interference from packages | |
| 343 (e.g. Lisp files that shadow core Lisp files). | |
| 344 -no-early-packages Do not process early packages. | |
| 771 | 345 -debug-paths Display info about the runtime values of various |
| 346 directory variables (e.g. for loading packages). | |
| 347 -no-site-modules Do not search site-modules directories for modules | |
| 348 at startup. Only applies when modules support is | |
| 349 compiled into XEmacs. | |
| 350 | |
| 351 Encoding options: | |
| 352 | |
| 353 -eol Turn on EOL detection (only applies to Unix, no | |
| 354 international support; otherwise EOL detection is | |
| 355 already on). | |
| 356 -nuni Under MS Windows, disable use of the Unicode versions | |
| 357 of API calls. Not for Windows 95/98/ME. This is | |
| 358 mostly only useful for debugging purposes. | |
| 359 | |
| 360 Misc: | |
| 361 | |
| 362 +N <file> Start displaying <file> at line N. | |
| 363 ") | |
| 428 | 364 (insert (lambda (&rest x) |
| 365 (let ((len 2)) | |
| 366 (while x | |
| 367 (princ (car x)) | |
| 368 (incf len (length (car x))) | |
| 369 (setq x (cdr x))) | |
| 370 (when (>= len 24) | |
| 371 (terpri) (setq len 0)) | |
| 372 (while (< len 24) | |
| 373 (princ " ") | |
| 374 (incf len)))))) | |
| 771 | 375 (princ |
| 376 (with-temp-buffer | |
| 377 (insert options) | |
| 378 (while l | |
| 379 (let ((name (car (car l))) | |
| 380 (fn (cdr (car l))) | |
| 381 doc arg cons) | |
| 382 (cond | |
| 383 ((and (symbolp fn) (get fn 'undocumented)) nil) | |
| 384 (t | |
| 385 (setq doc (documentation fn)) | |
| 386 (if (member doc '(nil "")) (setq doc "(undocumented)")) | |
| 387 (cond ((string-match "\n\\(<.*>\\)\n?\\'" doc) | |
| 388 ;; Doc of the form "The frobber switch\n<arg1> <arg2>" | |
| 389 (setq arg (substring doc (match-beginning 1) (match-end 1)) | |
| 390 doc (substring doc 0 (match-beginning 0)))) | |
| 391 ((string-match "\n+\\'" doc) | |
| 392 (setq doc (substring doc 0 (match-beginning 0))))) | |
| 393 (if (and (setq cons (rassq fn command-switch-alist)) | |
| 394 (not (eq cons (car l)))) | |
| 395 (setq doc (format "Same as %s." (car cons)))) | |
| 396 (goto-char (point-min)) | |
| 397 (when (search-forward (format "{%s}" name) nil t) | |
| 398 (delete-region (match-beginning 0) (match-end 0)) | |
| 399 (let ((standard-output (current-buffer))) | |
| 400 (if arg | |
| 401 (funcall insert name " " arg) | |
| 402 (funcall insert name)) | |
| 403 (princ doc)))))) | |
| 404 (setq l (cdr l))) | |
| 405 (buffer-string)))) | |
| 428 | 406 (princ (concat "\ |
| 407 | |
| 408 Anything else is considered a file name, and is placed into a buffer for | |
| 409 editing. | |
| 410 | |
| 411 " (emacs-name) " has an online tutorial and manuals. Type ^Ht (Control-h t) after | |
| 412 starting XEmacs to run the tutorial. Type ^Hi to enter the manual browser. | |
| 771 | 413 Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")) |
| 428 | 414 |
| 771 | 415 (kill-emacs 0) |
| 416 )) | |
| 428 | 417 |
| 418 (defun command-line-do-funcall (arg) | |
| 419 "Invoke the named lisp function with no arguments. | |
| 420 <function>" | |
| 421 (funcall (intern (pop command-line-args-left)))) | |
| 422 (fset 'command-line-do-funcall-1 'command-line-do-funcall) | |
| 423 (put 'command-line-do-funcall-1 'undocumented t) | |
| 424 | |
| 425 (defun command-line-do-eval (arg) | |
| 426 "Evaluate the lisp form. Quote it carefully. | |
| 427 <form>" | |
| 428 (eval (read (pop command-line-args-left)))) | |
| 429 | |
| 430 (defun command-line-do-load (arg) | |
| 431 "Load the named file of Lisp code into XEmacs. | |
| 432 <file>" | |
| 433 (let ((file (pop command-line-args-left))) | |
| 434 ;; Take file from default dir if it exists there; | |
| 435 ;; otherwise let `load' search for it. | |
| 436 (if (file-exists-p (expand-file-name file)) | |
| 437 (setq file (expand-file-name file))) | |
| 438 (load file nil t))) | |
| 439 | |
|
4448
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
440 (defun command-line-do-script (arg) |
|
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
441 "Load the named file of Lisp code into XEmacs. |
|
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
442 <file>" |
|
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
443 (let ((file (pop command-line-args-left))) |
|
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
444 (load file nil t t))) |
|
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
445 |
| 428 | 446 (defun command-line-do-insert (arg) |
| 447 "Insert file into the current buffer. | |
| 448 <file>" | |
| 449 (insert-file-contents (pop command-line-args-left))) | |
| 450 | |
| 451 (defun command-line-do-kill (arg) | |
| 452 "Exit XEmacs." | |
| 453 (kill-emacs t)) | |
| 454 | |
| 455 (defun command-line-do-version (arg) | |
| 456 "Print version info and exit." | |
| 457 (princ (concat (emacs-version) "\n")) | |
| 458 (kill-emacs 0)) | |
| 459 | |
| 771 | 460 (defun command-line-do-enable-eol-detection (arg) |
| 461 "Turn on EOL detection (only applies to Unix)." | |
| 462 (set-eol-detection t)) | |
| 463 | |
| 428 | 464 |
| 465 ;;; Processing the command line and loading various init files | |
| 466 | |
| 467 (defun early-error-handler (&rest debugger-args) | |
| 468 "You should probably not be using this." | |
| 469 ;; Used as the debugger during XEmacs initialization; if an error occurs, | |
| 470 ;; print some diagnostics, and kill XEmacs. | |
| 471 | |
| 472 ;; output the contents of the warning buffer, since it won't be seen | |
| 473 ;; otherwise. | |
| 474 ;; #### kludge! The call to Feval forces the pending warnings to | |
| 475 ;; get output. There definitely needs to be a better way. | |
| 476 (let ((buffer (eval (get-buffer-create "*Warnings*")))) | |
| 477 (princ (buffer-substring (point-min buffer) (point-max buffer) buffer) | |
| 478 'external-debugging-output)) | |
| 479 | |
| 480 (let ((string "Initialization error") | |
| 481 (error (nth 1 debugger-args)) | |
| 482 (debug-on-error nil) | |
| 483 (stream 'external-debugging-output)) | |
| 484 (if (null error) | |
| 485 (princ string stream) | |
| 486 (princ (concat "\n" string ": ") stream) | |
| 487 (condition-case () | |
| 488 (display-error error stream) | |
| 489 (error (princ "<<< error printing error message >>>" stream))) | |
| 490 (princ "\n" stream) | |
| 491 (if (memq (car-safe error) '(void-function void-variable)) | |
| 492 (princ " | |
| 493 This probably means that XEmacs is picking up an old version of | |
| 494 the lisp library, or that some .elc files are not up-to-date.\n" | |
| 495 stream))) | |
| 496 (when (not suppress-early-error-handler-backtrace) | |
| 497 (let ((print-length 1000) | |
| 498 (print-level 1000) | |
| 499 (print-escape-newlines t) | |
| 500 (print-readably nil)) | |
| 501 (when (getenv "EMACSLOADPATH") | |
| 502 (princ (format "\n$EMACSLOADPATH is %s" (getenv "EMACSLOADPATH")) | |
| 503 stream)) | |
| 504 (princ (format "\nexec-directory is %S" exec-directory) stream) | |
| 505 (princ (format "\ndata-directory is %S" data-directory) stream) | |
| 506 (princ (format "\ndata-directory-list is %S" data-directory-list) stream) | |
| 507 (princ (format "\ndoc-directory is %S" doc-directory) stream) | |
| 508 (princ (format "\nload-path is %S" load-path) stream) | |
| 509 (princ "\n\n" stream))) | |
| 510 (when (not suppress-early-error-handler-backtrace) | |
| 511 (backtrace stream t))) | |
| 778 | 512 (if-fboundp 'mswindows-message-box |
| 442 | 513 (mswindows-message-box "Initialization error")) |
| 428 | 514 (kill-emacs -1)) |
| 515 | |
| 516 (defun normal-top-level () | |
| 517 (if command-line-processed | |
| 518 (message "Back to top level.") | |
| 519 (setq command-line-processed t) | |
| 771 | 520 ;; Do this first for maximum likelihood of catching errors. The main |
| 521 ;; purpose of this is so that debug-on-error can be set to catch errors | |
| 522 ;; during normal noninteractive running. | |
| 523 (when (getenv "XEMACSDEBUG") | |
| 524 (eval (read (getenv "XEMACSDEBUG")))) | |
| 428 | 525 ;; Canonicalize HOME (PWD is canonicalized by init_buffer in buffer.c) |
| 526 (let ((value (user-home-directory))) | |
| 527 (if (and value | |
| 528 (< (length value) (length default-directory)) | |
| 529 (equal (file-attributes default-directory) | |
| 530 (file-attributes value))) | |
| 531 (setq default-directory (file-name-as-directory value)))) | |
| 532 (setq default-directory (abbreviate-file-name default-directory)) | |
| 533 (initialize-xemacs-paths) | |
| 534 | |
| 535 (startup-set-invocation-environment) | |
| 1330 | 536 (startup-setup-paths (cond (inhibit-all-packages t) |
| 537 (inhibit-early-packages '(early)) | |
| 538 (t nil)) | |
| 539 nil) | |
| 540 (startup-setup-paths-warning) | |
| 428 | 541 |
| 1232 | 542 ;; Either we need to inhibit messages from do_autoloads, or this |
| 543 ;; should go into (command-line) after the initialization of the | |
| 544 ;; frame? | |
| 528 | 545 (startup-load-autoloads) |
| 428 | 546 |
|
5754
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
547 (macrolet |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
548 ((replace-ntl-buffer (&body body) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
549 ;; Create a dynamic variable that won't escape outside this |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
550 ;; function (which will not be called recursively, and so won't |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
551 ;; shadow itself) and doesn't require consing a closure at |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
552 ;; runtime: |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
553 (cons 'progn (subst '#:ntl-buffer 'ntl-buffer body :test #'eq)))) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
554 (replace-ntl-buffer |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
555 (let ((ntl-buffer (current-buffer))) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
556 (labels ((after-command-line (&optional error-data) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
557 (with-current-buffer ntl-buffer |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
558 ;; Do this again, in case the init file defined more |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
559 ;; abbreviations. |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
560 (setq default-directory |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
561 (abbreviate-file-name default-directory)) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
562 ;; Specify the file for recording all the auto save |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
563 ;; files of this session. This is used by |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
564 ;; recover-session. |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
565 (if auto-save-list-file-prefix |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
566 (setq auto-save-list-file-name |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
567 (expand-file-name |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
568 (format "%s%d-%s" |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
569 auto-save-list-file-prefix |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
570 (emacs-pid) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
571 (system-name))))) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
572 (run-hooks 'emacs-startup-hook) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
573 (and term-setup-hook |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
574 (run-hooks 'term-setup-hook)) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
575 (setq term-setup-hook nil) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
576 ;; Modify the initial frame based on what the init file |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
577 ;; puts into ...-frame-alist. |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
578 (frame-notice-user-settings) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
579 (when window-setup-hook |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
580 (run-hooks 'window-setup-hook)) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
581 (setq window-setup-hook nil)))) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
582 (call-with-condition-handler |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
583 (if (noninteractive) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
584 #'ignore |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
585 ;; If noninteractive, an error will kill us. When |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
586 ;; interactive, however, an error processing the command |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
587 ;; line does NOT kill us; instead, the error handler tries |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
588 ;; to display an error on the frame. In that case, we must |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
589 ;; make sure that all the remaining initialization gets |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
590 ;; done. |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
591 #'after-command-line) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
592 #'command-line) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
593 |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
594 ;; If we're here, we haven't errored, and the function still needs |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
595 ;; to be called. |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
596 (after-command-line))))) |
| 442 | 597 |
| 598 (if load-user-init-file-p | |
|
5754
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
599 (maybe-migrate-user-init-file)))) |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
600 ;; GNU calls precompute-menubar-bindings. We don't mix menubars |
|
b09e3b1b7424
Use #'call-with-condition-handler, #'normal-top-level, instead of resignalling
Aidan Kehoe <kehoea@parhasard.net>
parents:
5584
diff
changeset
|
601 ;; and keymaps. |
| 428 | 602 |
| 603 (defun command-line-early (args) | |
| 604 ;; This processes those switches which need to be processed before | |
| 605 ;; starting up the window system. | |
| 606 | |
| 607 (setq command-line-default-directory default-directory) | |
| 608 | |
| 609 ;; See if we should import version-control from the environment variable. | |
| 610 (let ((vc (getenv "VERSION_CONTROL"))) | |
| 611 (cond ((eq vc nil)) ;don't do anything if not set | |
| 612 ((or (string= vc "t") | |
| 613 (string= vc "numbered")) | |
| 614 (setq version-control t)) | |
| 615 ((or (string= vc "nil") | |
| 616 (string= vc "existing")) | |
| 617 (setq version-control nil)) | |
| 618 ((or (string= vc "never") | |
| 619 (string= vc "simple")) | |
| 620 (setq version-control 'never)))) | |
| 621 | |
| 3360 | 622 ;;#### GNU Emacs |
| 428 | 623 ;; (if (let ((ctype |
| 624 ;; ;; Use the first of these three envvars that has a nonempty value. | |
| 625 ;; (or (let ((string (getenv "LC_ALL"))) | |
| 626 ;; (and (not (equal string "")) string)) | |
| 627 ;; (let ((string (getenv "LC_CTYPE"))) | |
| 628 ;; (and (not (equal string "")) string)) | |
| 629 ;; (let ((string (getenv "LANG"))) | |
| 630 ;; (and (not (equal string "")) string))))) | |
| 631 ;; (and ctype | |
| 632 ;; (string-match iso-8859-1-locale-regexp ctype))) | |
| 438 | 633 ;; (progn |
| 428 | 634 ;; (standard-display-european t) |
| 635 ;; (require 'iso-syntax))) | |
| 776 | 636 |
| 637 (if vanilla-inhibiting ;; set in main_1() | |
| 638 (setq load-user-init-file-p nil | |
| 639 site-start-file nil) | |
| 640 (setq load-user-init-file-p (not (noninteractive)))) | |
| 641 | |
| 428 | 642 ;; Allow (at least) these arguments anywhere in the command line |
| 776 | 643 (macrolet ((long-argmatch (match) |
| 644 ;; use a macro to avoid lots of concatting at runtime | |
| 645 `(or (string= arg ,match) | |
| 646 (string= arg ,(concat "-" match))))) | |
| 647 (let ((new-args nil) | |
| 648 (arg nil)) | |
| 649 (while args | |
| 650 (setq arg (pop args)) | |
| 428 | 651 (cond |
| 652 ((or (string= arg "-q") | |
| 776 | 653 (long-argmatch "-no-init-file")) |
| 428 | 654 (setq load-user-init-file-p nil)) |
| 776 | 655 ((long-argmatch "-no-site-file") |
| 428 | 656 (setq site-start-file nil)) |
| 776 | 657 ((long-argmatch "-user-init-file") |
| 428 | 658 (setq user-init-file (pop args))) |
| 776 | 659 ((long-argmatch "-user-init-directory") |
| 428 | 660 (setq user-init-directory (file-name-as-directory (pop args)))) |
| 661 ((or (string= arg "-u") | |
| 776 | 662 (long-argmatch "-user")) |
| 428 | 663 (let* ((user (pop args)) |
| 664 (home-user (concat "~" user))) | |
| 442 | 665 (setq user-init-directory (file-name-as-directory |
| 440 | 666 (paths-construct-path |
| 442 | 667 (list home-user user-init-directory-base)))) |
| 668 (setq user-init-file | |
| 669 (find-user-init-file user-init-directory home-user)) | |
| 670 (setq custom-file | |
| 671 (make-custom-file-name user-init-file)))) | |
| 776 | 672 ((long-argmatch "-debug-init") |
| 428 | 673 (setq init-file-debug t)) |
| 776 | 674 ((long-argmatch "-unmapped") |
| 428 | 675 (setq initial-frame-unmapped-p t)) |
| 676 ((or (string= arg "--") (string= arg "-")) | |
| 677 (while args | |
| 678 (push (pop args) new-args))) | |
| 679 (t (push arg new-args)))) | |
| 680 | |
| 502 | 681 (with-obsolete-variable 'init-file-user |
| 682 (setq init-file-user (and load-user-init-file-p ""))) | |
| 428 | 683 |
| 776 | 684 (nreverse new-args)))) |
| 428 | 685 |
| 686 (defconst initial-scratch-message "\ | |
| 687 ;; This buffer is for notes you don't want to save, and for Lisp evaluation. | |
| 688 ;; If you want to create a file, first visit that file with C-x C-f, | |
| 502 | 689 ;; then enter the text in that file's own buffer. (C-x is the standard |
| 684 | 690 ;; XEmacs abbreviation for `Control+x', i.e. hold down the Control key |
| 691 ;; while hitting the x key.) | |
| 502 | 692 ;; |
| 693 ;; For Lisp evaluation, type an expression, move to the end and hit C-j. | |
| 428 | 694 |
| 695 " | |
| 696 "Initial message displayed in *scratch* buffer at startup. | |
| 697 If this is nil, no message will be displayed.") | |
| 698 | |
| 699 (defun command-line () | |
| 700 (let ((command-line-args-left (cdr command-line-args))) | |
| 701 | |
| 702 (let ((debugger 'early-error-handler) | |
| 703 (debug-on-error t)) | |
| 704 | |
| 705 ;; Process magic command-line switches like -q and -u. Do this | |
| 706 ;; before creating the first frame because some of these switches | |
| 707 ;; may affect that. I think it's ok to do this before establishing | |
| 708 ;; the X connection, and maybe someday things like -nw can be | |
| 709 ;; handled here instead of down in C. | |
| 710 (setq command-line-args-left (command-line-early command-line-args-left)) | |
| 711 | |
| 611 | 712 (when (eq system-type 'windows-nt) |
| 776 | 713 (declare-fboundp (init-mswindows-at-startup))) |
| 611 | 714 |
| 428 | 715 ;; Setup the toolbar icon directory |
| 716 (when (featurep 'toolbar) | |
| 717 (init-toolbar-location)) | |
| 718 | |
| 2699 | 719 ;; Setup coding systems and Unicode support--needs to be before X11 |
| 720 ;; initialisation in case of keysyms of the form UABCD. | |
| 721 (when (featurep 'mule) | |
| 722 (declare-fboundp (init-mule-at-startup))) | |
| 723 | |
| 487 | 724 (if (featurep 'toolbar) |
|
5228
5efbd1253905
Remove all support for InfoDock.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4806
diff
changeset
|
725 (init-toolbar)) |
| 487 | 726 |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4448
diff
changeset
|
727 ;; Create the initial device (which may be the already-created stdio |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4448
diff
changeset
|
728 ;; device, if we're noninteractive). |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4448
diff
changeset
|
729 (make-device initial-device-type nil nil) |
| 428 | 730 |
| 731 ;; When not in batch mode, this creates the first visible frame, | |
| 732 ;; and deletes the stdio device. | |
| 733 (frame-initialize)) | |
| 734 | |
| 440 | 735 ;; Reinitialize faces if necessary. This function changes face if |
| 736 ;; it is created during auto-autoloads loading. Otherwise, it | |
| 737 ;; does nothing. | |
| 738 (startup-initialize-custom-faces) | |
| 739 | |
| 771 | 740 ;; A couple of other things need to be initted. |
| 741 ;; (RMS writes about internally using hooks for this, in reference | |
| 742 ;; to frame-initialize and frame-notice-user-settings: | |
| 743 ;; | |
| 744 ;; These are now called explicitly at the proper times, | |
| 745 ;; since that is easier to understand. | |
| 746 ;; Actually using hooks within Emacs is bad for future maintenance. --rms. | |
| 747 ;; | |
| 748 ;; In this case, I completely agree. --ben | |
| 811 | 749 (if (featurep 'menubar) |
| 750 (init-menubar-at-startup)) | |
| 428 | 751 ;; |
| 752 ;; We have normality, I repeat, we have normality. Anything you still | |
| 753 ;; can't cope with is therefore your own problem. (And we don't need | |
| 754 ;; to kill XEmacs for it.) | |
| 755 ;; | |
| 756 | |
| 757 ;;; Load init files. | |
| 758 (load-init-file) | |
| 438 | 759 |
| 428 | 760 (with-current-buffer (get-buffer "*scratch*") |
| 761 (erase-buffer) | |
| 762 ;; (insert initial-scratch-message) | |
| 763 (set-buffer-modified-p nil) | |
| 764 (when (eq major-mode 'fundamental-mode) | |
| 2756 | 765 (funcall initial-major-mode)) |
| 766 ;; The docstring for font-lock-set-defaults says that major modes that | |
| 767 ;; have any font-lock defaults specified should call the function | |
| 768 ;; after initialising the `major-mode' variable. None of them do, | |
| 769 ;; however, and any font locking that is ever put in place is done as | |
| 770 ;; a result of `font-lock-set-defaults' being in find-file-hook and | |
| 771 ;; various other places. We could make *scratch* honour the user's | |
| 772 ;; choice of whether font-locking is in place by adding a call to | |
| 773 ;; font-lock-set-defaults in `lisp-interaction-mode'; but that'll | |
|
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
5228
diff
changeset
|
774 ;; break if `initial-major-mode' is anything else. |
| 2756 | 775 ;; |
| 776 ;; So, despite what `font-lock-set-defaults'' docstring says, this | |
| 777 ;; *is* where we should call it to have the user's choice of font-lock | |
| 778 ;; level take effect in *scratch*. If the modes are rewritten to do | |
| 779 ;; the right then, we're okay too, the function is idempotent. | |
| 780 (font-lock-set-defaults)) | |
| 428 | 781 |
| 782 ;; Load library for our terminal type. | |
| 783 ;; User init file can set term-file-prefix to nil to prevent this. | |
| 784 ;; Note that for any TTY's opened subsequently, the TTY init | |
| 785 ;; code will run this. | |
| 786 (when (and (eq 'tty (console-type)) | |
| 787 (not (noninteractive))) | |
| 788 (load-terminal-library)) | |
| 789 | |
| 790 ;; Process the remaining args. | |
| 791 (command-line-1) | |
| 792 | |
| 793 ;; it was turned on by default so that the warnings don't get displayed | |
| 794 ;; until after the splash screen. | |
| 795 (setq inhibit-warning-display nil) | |
| 796 ;; If -batch, terminate after processing the command options. | |
| 797 (when (noninteractive) (kill-emacs t)))) | |
| 798 | |
| 438 | 799 (defun load-terminal-library () |
| 428 | 800 (when term-file-prefix |
|
5584
d469c668462e
#'load-terminal-library; load term files correctly for gnuclient consoles.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
801 (let ((term (console-tty-terminal-type)) |
| 428 | 802 hyphend) |
| 803 (while (and term | |
| 804 (not (load (concat term-file-prefix term) t t))) | |
| 805 ;; Strip off last hyphen and what follows, then try again | |
| 806 (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) | |
| 807 (setq term (substring term 0 hyphend)) | |
| 808 (setq term nil)))))) | |
| 809 | |
| 1330 | 810 (defun find-init-file-1 (dir base-list) |
| 811 (catch 'found | |
| 812 (dolist (file base-list) | |
| 813 (let ((expanded (expand-file-name file dir))) | |
| 814 (if (string-match "el$" expanded) | |
| 815 (let* ((elc (concat expanded "c")) | |
| 816 (el-ok (file-readable-p expanded)) | |
| 817 (elc-ok (file-readable-p elc))) | |
| 818 (cond | |
| 819 ((and el-ok elc-ok (file-newer-than-file-p expanded elc)) | |
| 820 (lwarn 'initialization 'warning | |
| 821 "\ | |
| 822 The compiled initialization file `%s' exists | |
| 823 but is out-of-date with respect to the uncompiled initialization | |
| 824 file `%s'. XEmacs will load the uncompiled | |
| 825 version. You should correct the problem as soon as possible by | |
| 826 loading the uncompiled version and compiling it using | |
| 827 `M-x byte-compile-file' (or `Lisp->Byte-Compile This File' on | |
| 828 the menubar)." | |
| 829 elc expanded) | |
| 830 (throw 'found expanded)) | |
| 831 (elc-ok (throw 'found elc)) | |
| 832 (el-ok (throw 'found expanded)))) | |
| 833 (when (file-readable-p | |
| 834 (when (file-readable-p expanded) | |
| 835 (throw 'found expanded))))))))) | |
| 836 | |
| 442 | 837 (defun find-user-init-directory-init-file (&optional init-directory) |
| 838 "Determine the user's init file if in the init directory." | |
| 1330 | 839 (find-init-file-1 (or init-directory user-init-directory) |
| 840 user-init-file-base-list)) | |
| 442 | 841 |
| 842 (defun find-user-home-directory-init-file (&optional home-directory) | |
| 843 "Determine the user's init file if in the home directory." | |
| 1330 | 844 (find-init-file-1 (or home-directory "~") |
| 845 user-home-init-file-base-list)) | |
| 442 | 846 |
| 847 (defun find-user-init-file (&optional init-directory home-directory) | |
| 440 | 848 "Determine the user's init file." |
| 442 | 849 (if load-home-init-file |
| 850 (find-user-home-directory-init-file home-directory) | |
| 851 (or (find-user-init-directory-init-file init-directory) | |
| 852 (find-user-home-directory-init-file home-directory)))) | |
| 853 | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
854 (defun ask-about-user-init-file-migration-p () |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
855 "Check whether we want to ask the user if she wants to migrate the init file." |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
856 (and (not load-home-init-file) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
857 (not (find-user-init-directory-init-file user-init-directory)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
858 (stringp user-init-file) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
859 (file-readable-p user-init-file))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
860 |
| 442 | 861 (defun maybe-migrate-user-init-file () |
| 862 "Ask user if she wants to migrate the init file(s) to new location." | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
863 (if (ask-about-user-init-file-migration-p) |
| 442 | 864 (if (with-output-to-temp-buffer (help-buffer-name nil) |
| 865 (progn | |
| 866 (princ "XEmacs recommends that the initialization code in | |
| 867 ") | |
| 868 (princ user-init-file) | |
| 869 (princ " | |
| 870 be migrated to the ") | |
| 871 (princ user-init-directory) | |
| 872 (princ " directory. XEmacs can | |
| 873 perform the migration automatically. | |
| 874 | |
| 875 After the migration, init.el/init.elc holds user-written | |
| 876 initialization code. Moreover the customize settings will be in | |
| 877 custom.el. | |
| 878 | |
| 452 | 879 You can undo the migration at any time with |
| 880 M-x maybe-unmigrate-user-init-file. | |
| 881 | |
| 442 | 882 If you choose not to do this now, XEmacs will not ask you this |
| 883 question in the future. However, you can still make XEmacs | |
| 884 perform the migration at any time with M-x migrate-user-init-file.") | |
| 885 (show-temp-buffer-in-current-frame standard-output) | |
| 886 (yes-or-no-p-minibuf (concat "Migrate init file to " | |
| 887 user-init-directory | |
| 888 "? ")))) | |
| 4111 | 889 |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
890 (progn |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
891 (migrate-user-init-file) |
| 4111 | 892 (with-output-to-temp-buffer (help-buffer-name nil) |
| 893 (progn | |
| 894 (princ "The initialization code has now been migrated to the ") | |
| 895 (princ user-init-directory) | |
| 896 (princ "directory. | |
| 897 | |
| 898 For backwards compatibility with, for example, older versions of XEmacs, | |
| 899 XEmacs can create a special old-style .emacs file in your home | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
900 directory which will load the relocated initialization code. |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
901 |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
902 NOTE THAT THIS WILL OVERWRITE YOUR EXISTING .emacs FILE!") |
| 4111 | 903 (show-temp-buffer-in-current-frame standard-output) |
| 904 (maybe-create-compatibility-dot-emacs)))) | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
905 (set-load-home-init-file user-init-file t)))) |
| 442 | 906 |
| 452 | 907 (defun maybe-create-compatibility-dot-emacs () |
| 908 "Ask user if she wants to create a .emacs compatibility file." | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
909 (if (yes-or-no-p-minibuf "Create compatibility .emacs?") |
| 452 | 910 (create-compatibility-dot-emacs))) |
| 911 | |
| 442 | 912 (defun migrate-user-init-file () |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
913 "Migrate the init file from the home directory." |
| 442 | 914 (interactive) |
| 915 (if (not (file-exists-p user-init-directory)) | |
| 916 (progn | |
| 917 (message "Creating %s directory..." user-init-directory) | |
| 918 (make-directory user-init-directory))) | |
| 919 (message "Migrating custom file...") | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
920 (set-load-home-init-file user-init-file nil) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
921 (setq custom-file (make-custom-file-name user-init-file 'force-new)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
922 (custom-save-all) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
923 (message "Copying init file...") |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
924 (let ((new-user-init-file (expand-file-name user-init-file-base |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
925 user-init-directory))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
926 (copy-file user-init-file new-user-init-file) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
927 (setq user-init-file new-user-init-file)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
928 (message "Migration done.")) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
929 |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
930 (defun set-load-home-init-file (filename val) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
931 "Put code in `filename' to set `load-home-init-file' to `val'. |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
932 More precisely, remove the first `setq' form for `load-home-init-file', |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
933 and replace it by (setq load-home-init-file t) if `val' is non-nil." |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
934 (save-excursion |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
935 (set-buffer (find-file-noselect filename)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
936 (goto-char (point-min)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
937 (condition-case nil |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
938 (block find-existing |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
939 (while (not (eobp)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
940 (forward-sexp 1) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
941 (backward-sexp 1) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
942 (let* ((beginning (point)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
943 (sexp (read (current-buffer)))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
944 (if (and (consp sexp) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
945 (consp (cdr sexp)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
946 (eq 'setq (car sexp)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
947 (eq 'load-home-init-file (cadr sexp))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
948 (progn |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
949 (forward-line 1) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
950 (delete-region beginning (point)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
951 (return-from find-existing nil)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
952 (forward-sexp 1))))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
953 (error nil)) ; ignore if there are no sexprs in the file |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
954 (if val |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
955 (insert "(setq load-home-init-file t) ; don't load init file from ~/.xemacs/init.el\n")) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
956 (save-buffer))) |
| 440 | 957 |
| 452 | 958 (defun create-compatibility-dot-emacs () |
| 959 "Create .emacs compatibility file for migrated setup." | |
| 960 (message "Creating .emacs compatibility file.") | |
| 961 (with-temp-file (expand-file-name ".emacs" "~") | |
| 962 (insert ";;; XEmacs backwards compatibility file\n") | |
| 963 (insert "(setq user-init-file\n") | |
| 964 (insert " (expand-file-name \"init.el\"\n") | |
| 965 (insert " (expand-file-name \".xemacs\" \"~\")))\n") | |
| 966 (insert "(setq custom-file\n") | |
| 967 (insert " (expand-file-name \"custom.el\"\n") | |
| 968 (insert " (expand-file-name \".xemacs\" \"~\")))\n") | |
| 969 (insert "\n") | |
| 970 (insert "(load-file user-init-file)\n") | |
| 971 (insert "(load-file custom-file)")) | |
| 972 (message "Created .emacs compatibility file.")) | |
| 973 | |
| 974 (defun maybe-unmigrate-user-init-file () | |
| 975 "Possibly unmigrate the user's init and custom files." | |
| 976 (interactive) | |
| 977 (let ((dot-emacs-file-name (expand-file-name ".emacs" "~"))) | |
| 978 (if (and (not load-home-init-file) | |
| 979 (or (not (file-exists-p dot-emacs-file-name)) | |
| 980 (yes-or-no-p-minibuf (concat "Overwrite " dot-emacs-file-name | |
| 981 "? ")))) | |
| 982 (unmigrate-user-init-file dot-emacs-file-name)))) | |
| 983 | |
| 984 (defun unmigrate-user-init-file (&optional target-file-name) | |
| 985 "Unmigrate the user's init and custom files." | |
| 986 (interactive) | |
| 987 (let ((target-file-name | |
| 988 (or target-file-name (expand-file-name ".emacs" "~")))) | |
| 989 (rename-file user-init-file target-file-name 'ok-if-already-exists) | |
| 990 (setq user-init-file target-file-name) | |
| 991 (let ((old-custom-file custom-file)) | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
992 (setq custom-file target-file-name) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
993 (custom-save-all) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
994 (set-load-home-init-file user-init-file t) |
| 452 | 995 (delete-file old-custom-file)))) |
| 996 | |
| 428 | 997 (defun load-user-init-file () |
| 442 | 998 "This function actually reads the init file." |
| 428 | 999 (if (not user-init-file) |
| 442 | 1000 (setq user-init-file |
| 1001 (find-user-init-file user-init-directory))) | |
| 470 | 1002 (if (not custom-file) |
| 1003 (setq custom-file (make-custom-file-name user-init-file))) | |
| 442 | 1004 (if (and user-init-file |
| 1005 (file-readable-p user-init-file)) | |
| 1006 (load user-init-file t t t)) | |
| 1007 (if (and custom-file | |
| 1008 (or (not user-init-file) | |
| 1009 (not (string= custom-file user-init-file))) | |
| 1010 (file-readable-p custom-file)) | |
| 1011 (load custom-file t t t)) | |
| 428 | 1012 (unless inhibit-default-init |
| 1013 (let ((inhibit-startup-message nil)) | |
| 1014 ;; Users are supposed to be told their rights. | |
| 1015 ;; (Plus how to get help and how to undo.) | |
| 1016 ;; Don't you dare turn this off for anyone except yourself. | |
| 1017 (load "default" t t)))) | |
| 1018 | |
| 2030 | 1019 ;;; #### move this comment into a docstring. See site-init-file for some |
| 1020 ;;; description of what it does. Substitute a pointer to this function in | |
| 1021 ;;; site-init-file's docstring. | |
| 428 | 1022 ;;; Load user's init file and default ones. |
| 1023 (defun load-init-file () | |
| 1024 (run-hooks 'before-init-hook) | |
| 1025 | |
| 1026 ;; Run the site-start library if it exists. The point of this file is | |
| 2030 | 1027 ;; that it is run before the user's init file. There is no point in |
| 1028 ;; doing this after the user's init file; that is useless. | |
| 428 | 1029 (when site-start-file |
| 1030 (load site-start-file t t)) | |
| 1031 | |
| 1032 ;; Sites should not disable this. Only individuals should disable | |
| 1033 ;; the startup message. | |
| 1034 (setq inhibit-startup-message nil) | |
| 1035 | |
| 1036 (let (debug-on-error-from-init-file | |
| 1037 debug-on-error-should-be-set | |
| 1038 (debug-on-error-initial | |
| 1039 (if (eq init-file-debug t) 'startup init-file-debug))) | |
| 1040 (let ((debug-on-error debug-on-error-initial)) | |
| 1041 (if (and load-user-init-file-p init-file-debug) | |
| 442 | 1042 (progn |
| 1043 ;; Do this without a condition-case if the user wants to debug. | |
| 1044 (load-user-init-file)) | |
| 793 | 1045 (condition-case nil |
| 1046 (call-with-condition-handler | |
|
4806
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1047 ((macro |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1048 . (lambda (lambda-expression) |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1049 ;; Be serious about information hiding here: |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1050 (nsublis |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1051 '((load-init-handler-arg . #:load-init-gZK6A36gTed)) |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1052 lambda-expression))) |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1053 #'(lambda (load-init-handler-arg) |
| 793 | 1054 (let ((errstr (error-message-string |
|
4806
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1055 load-init-handler-arg))) |
| 793 | 1056 (message "Error in init file: %s" errstr) |
| 1057 (lwarn 'initialization 'error | |
| 1058 "\ | |
| 428 | 1059 An error has occurred while loading %s: |
| 1060 | |
| 1061 %s | |
| 1062 | |
| 793 | 1063 Backtrace follows: |
| 1064 | |
| 1065 %s | |
| 1066 | |
| 428 | 1067 To ensure normal operation, you should investigate the cause of the error |
| 1068 in your initialization file and remove it. Use the `-debug-init' option | |
| 793 | 1069 to XEmacs to enter the debugger when the error occurs and investigate the |
| 1070 exact problem." | |
| 1071 user-init-file errstr | |
| 1072 (backtrace-in-condition-handler-eliminating-handler | |
|
4806
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1073 'load-init-handler-arg))) |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1074 (setq init-file-had-error t))) |
| 793 | 1075 #'(lambda () |
| 1076 (if load-user-init-file-p | |
| 1077 (load-user-init-file)) | |
| 1078 (setq init-file-had-error nil))) | |
| 1079 (error nil))) | |
| 428 | 1080 ;; If we can tell that the init file altered debug-on-error, |
| 1081 ;; arrange to preserve the value that it set up. | |
| 1082 (or (eq debug-on-error debug-on-error-initial) | |
| 1083 (setq debug-on-error-should-be-set t | |
| 1084 debug-on-error-from-init-file debug-on-error))) | |
| 1085 (when debug-on-error-should-be-set | |
| 1086 (setq debug-on-error debug-on-error-from-init-file))) | |
| 1087 | |
| 1088 (setq init-file-loaded t) | |
| 1089 | |
| 1090 ;; Do this here in case the init file sets mail-host-address. | |
| 1091 ;; Don't do this here unless noninteractive, it is frequently wrong. -sb | |
| 1092 ;; (or user-mail-address | |
| 1093 (when noninteractive | |
| 1094 (setq user-mail-address (concat (user-login-name) "@" | |
| 1095 (or mail-host-address | |
| 1096 (system-name))))) | |
| 1097 | |
| 1098 (run-hooks 'after-init-hook) | |
| 1099 nil) | |
| 1100 | |
| 1101 (defun load-options-file (filename) | |
| 1102 "Load the file of saved options (from the Options menu) called FILENAME. | |
| 1103 Currently this does nothing but call `load', but it might be redefined | |
| 1104 in the future to support automatically converting older options files to | |
| 1105 a new format, when variables have changed, etc." | |
| 1106 (load filename)) | |
| 1107 | |
| 1108 (defun command-line-1 () | |
| 1109 (cond | |
| 1110 ((null command-line-args-left) | |
| 1111 (unless noninteractive | |
| 1112 ;; If there are no switches to process, run the term-setup-hook | |
| 1113 ;; before displaying the copyright notice; there may be some need | |
| 1114 ;; to do it before doing any output. If we're not going to | |
| 1115 ;; display a copyright notice (because other options are present) | |
| 1116 ;; then this is run after those options are processed. | |
| 1117 (run-hooks 'term-setup-hook) | |
| 1118 ;; Don't let the hook be run twice. | |
| 1119 (setq term-setup-hook nil) | |
| 1120 | |
| 1121 ;; Don't clobber a non-scratch buffer if init file | |
| 1122 ;; has selected it. | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
1123 (when (and (string= (buffer-name) "*scratch*") |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
1124 (not (ask-about-user-init-file-migration-p))) |
| 428 | 1125 (unless (or inhibit-startup-message |
| 1126 (input-pending-p)) | |
| 2505 | 1127 (let (tmout) |
| 428 | 1128 (unwind-protect |
| 1129 ;; Guts of with-timeout | |
| 1130 (catch 'tmout | |
| 1131 (setq tmout (add-timeout startup-message-timeout | |
| 1132 (lambda (ignore) | |
| 1133 (condition-case nil | |
| 1134 (throw 'tmout t) | |
| 1135 (error nil))) | |
| 1136 nil)) | |
| 2505 | 1137 (display-splash-screen) |
| 428 | 1138 (or nil;; (pos-visible-in-window-p (point-min)) |
| 1139 (goto-char (point-min))) | |
| 1140 (sit-for 0) | |
| 1141 (setq unread-command-event (next-command-event))) | |
| 2505 | 1142 (when tmout (disable-timeout tmout))))) |
| 428 | 1143 (with-current-buffer (get-buffer "*scratch*") |
| 1144 ;; In case the XEmacs server has already selected | |
| 1145 ;; another buffer, erase the one our message is in. | |
| 1146 (erase-buffer) | |
| 1147 (when (stringp initial-scratch-message) | |
| 1148 (insert initial-scratch-message)) | |
| 1149 (set-buffer-modified-p nil))))) | |
| 1150 | |
| 1151 (t | |
| 1152 ;; Command-line-options exist | |
| 1153 (let ((dir command-line-default-directory) | |
| 1154 (file-count 0) | |
| 1155 (line nil) | |
| 1156 (end-of-options nil) | |
| 442 | 1157 file-p arg tem) |
| 428 | 1158 (while command-line-args-left |
| 1159 (setq arg (pop command-line-args-left)) | |
| 1160 (cond | |
| 1161 (end-of-options | |
| 1162 (setq file-p t)) | |
| 1163 ((setq tem (when (eq (aref arg 0) ?-) | |
| 1164 (or (assoc arg command-switch-alist) | |
| 1165 (assoc (substring arg 1) | |
| 1166 command-switch-alist)))) | |
| 1167 (funcall (cdr tem) arg)) | |
| 1168 ((string-match "\\`\\+[0-9]+\\'" arg) | |
| 1169 (setq line (string-to-int arg))) | |
| 1170 ;; "- file" means don't treat "file" as a switch | |
| 1171 ;; ("+0 file" has the same effect; "-" added | |
| 1172 ;; for unixoidiality). | |
| 1173 ;; This is worthless; the `unixoid' way is "./file". -jwz | |
| 1174 ((or (string= arg "-") (string= arg "--")) | |
| 1175 (setq end-of-options t)) | |
| 1176 (t | |
| 1177 (setq file-p t))) | |
| 438 | 1178 |
| 428 | 1179 (when file-p |
| 1180 (setq file-p nil) | |
| 1181 (incf file-count) | |
| 1182 (setq arg (expand-file-name arg dir)) | |
| 1183 (cond | |
| 442 | 1184 ((= file-count 1) |
| 1185 (find-file arg)) | |
| 428 | 1186 (noninteractive (find-file arg)) |
| 1187 (t (find-file-other-window arg))) | |
| 1188 (when line | |
| 1189 (goto-line line) | |
| 1190 (setq line nil)))))))) | |
| 1191 | |
| 2505 | 1192 |
| 428 | 1193 (defun startup-presentation-hack-help (e) |
| 1194 (setq e (extent-property e 'startup-presentation-hack)) | |
| 2505 | 1195 (symbol-name e)) |
| 1196 | |
| 1197 (defun startup-presentation-activate (ev ex) | |
| 1198 (call-interactively (extent-property ex 'startup-presentation-hack))) | |
| 428 | 1199 |
| 2505 | 1200 (defun splash-screen-present-hack (e v) |
| 1201 ; (set-extent-property e 'mouse-face 'highlight) | |
| 1202 ; (set-extent-property e 'startup-presentation-hack v) | |
| 1203 ; (set-extent-property e 'help-echo | |
| 1204 ; 'startup-presentation-hack-help) | |
| 1205 ; (set-extent-property e 'activate-function 'startup-presentation-activate) | |
| 428 | 1206 ) |
| 1207 | |
| 1208 (defun splash-hack-version-string () | |
| 1209 (save-excursion | |
| 1210 (save-restriction | |
| 1211 (goto-char (point-min)) | |
| 1212 (re-search-forward "^XEmacs" nil t) | |
| 1213 (narrow-to-region (point-at-bol) (point-at-eol)) | |
| 1214 (goto-char (point-min)) | |
| 1215 (when (re-search-forward " \\[Lucid\\]" nil t) | |
| 1216 (delete-region (match-beginning 0) (match-end 0))) | |
| 1217 (when (re-search-forward "[^(][^)]*-[^)]*-" nil t) | |
| 1218 (delete-region (1+ (match-beginning 0)) (match-end 0)) | |
| 1219 (insert "(")) | |
| 1220 (goto-char (point-max)) | |
| 1221 (search-backward " " nil t) | |
| 1222 (when (search-forward "." nil t) | |
| 1223 (delete-region (1- (point)) (point-max)))))) | |
| 1224 | |
| 2505 | 1225 ;; parse one page description (see `splash-screen-body') and display |
| 1226 ;; at point. | |
| 1227 (defun splash-screen-present (l) | |
| 428 | 1228 (cond ((stringp l) |
| 1229 (insert l)) | |
| 1230 ((eq (car-safe l) 'face) | |
| 1231 ;; (face name string) | |
| 1232 (let ((p (point))) | |
| 2505 | 1233 (splash-screen-present (elt l 2)) |
| 1234 (set-extent-face (make-extent p (point)) | |
| 1235 (elt l 1)))) | |
| 428 | 1236 ((eq (car-safe l) 'key) |
| 1237 (let* ((c (elt l 1)) | |
| 1238 (p (point)) | |
| 1239 (k (where-is-internal c nil t))) | |
| 1240 (insert (if k (key-description k) | |
| 1241 (format "M-x %s" c))) | |
| 2505 | 1242 (let ((e (make-extent p (point)))) |
| 1243 (set-extent-face e 'bold) | |
| 1244 (splash-screen-present-hack e c)))) | |
| 428 | 1245 ((eq (car-safe l) 'funcall) |
| 1246 ;; (funcall (fun . args) string) | |
| 1247 (let ((p (point))) | |
| 2505 | 1248 (splash-screen-present (elt l 2)) |
| 1249 (splash-screen-present-hack (make-extent p (point)) | |
| 1250 (elt l 1)))) | |
| 428 | 1251 ((consp l) |
| 2505 | 1252 (mapcar 'splash-screen-present l)) |
| 428 | 1253 (t |
| 1254 (error "WTF!?")))) | |
| 1255 | |
| 1256 (defun startup-center-spaces (glyph) | |
| 1257 ;; Return the number of spaces to insert in order to center | |
| 1258 ;; the given glyph (may be a string or a pixmap). | |
| 438 | 1259 ;; Assume spaces are as wide as avg-pixwidth. |
| 428 | 1260 ;; Won't be quite right for proportional fonts, but it's the best we can do. |
| 1261 ;; Maybe the new redisplay will export something a glyph-width function. | |
| 1262 ;;; #### Yes, there is a glyph-width function but it isn't quite what | |
| 1263 ;;; #### this was expecting. Or is it? | |
| 1264 ;; (An alternate way to get avg-pixwidth would be to use x-font-properties | |
| 1265 ;; and calculate RESOLUTION_X * AVERAGE_WIDTH / 722.7, but it's no better.) | |
| 1266 | |
| 1267 ;; This function is used in about.el too. | |
| 1268 (let* ((avg-pixwidth (round (/ (frame-pixel-width) (frame-width)))) | |
| 1269 (fill-area-width (* avg-pixwidth (- fill-column left-margin))) | |
| 438 | 1270 (glyph-pixwidth (cond ((stringp glyph) |
| 428 | 1271 (* avg-pixwidth (length glyph))) |
| 1272 ((glyphp glyph) | |
| 1273 (glyph-width glyph)) | |
| 1274 (t | |
| 1275 (error "startup-center-spaces: bad arg"))))) | |
| 1276 (+ left-margin | |
| 1277 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) | |
| 1278 | |
| 2505 | 1279 ;; the splash screen originated in 19.10 as splash-screen-*. When |
| 1280 ;; Chuck made the global screen->frame change for 19.12, he | |
| 1281 ;; accidentally changed these too. This randomness is getting on my | |
| 1282 ;; nerves, so let's fix it and provide minimal aliases for the | |
| 1283 ;; `locale' mule package. --ben | |
| 1284 | |
| 1285 ;; returns either of vector of page descriptions, each describing one | |
| 1286 ;; screenful of information, or just one such page descriptions Each | |
| 1287 ;; page description is a list of textual elements describing how to | |
| 1288 ;; display a section of text. The elements are processed in turn and | |
| 1289 ;; the results inserted one after the previous in a buffer. Each | |
| 1290 ;; textual element is either: | |
| 1291 | |
| 1292 ;; -- a string, inserted as-is with no decoration. | |
| 1293 ;; -- a list of (face FACES "text"), where FACES is the name of a face | |
| 1294 ;; or a list of such names, and specifies the face(s) used when | |
| 1295 ;; displaying the text. | |
| 1296 ;; -- a list of (key COMMAND-NAME); the key sequence corresponding to | |
| 1297 ;; the command will be inserted, in boldface. | |
| 1298 ;; -- a list of textual elements. | |
| 1299 | |
| 1300 (defun splash-screen-window-body () | |
| 1301 `( | |
| 1302 (face (blue bold underline) | |
| 1303 "Useful Help-menu entries:\n\n") | |
| 1304 ,@(if (string-match "beta" emacs-version) | |
| 1305 `((face bold "Beta Info:") | |
| 1306 (face (red bold) | |
| 1307 " This is an Experimental version of XEmacs.\n")) | |
| 1308 `( "")) | |
| 1309 (face bold "XEmacs FAQ:") | |
| 1310 " Read the XEmacs FAQ.\n" | |
| 1311 (face bold "Info (Online Docs):") | |
| 1312 " Read the on-line documentation.\n" | |
| 1313 (face bold "Tutorial:") | |
| 1314 " XEmacs tutorial.\n" | |
| 1315 (face bold "Samples->View Sample init.el:") | |
| 1316 " A useful initialization file.\n" | |
| 1317 (face bold "About XEmacs:") | |
| 1318 " See who's developing XEmacs.\n" | |
| 1319 "\n" | |
| 1320 (face (bold blue) "XEmacs website:") | |
| 1321 " http://www.xemacs.org/\n\n" | |
| 428 | 1322 ,@(if (featurep 'sparcworks) |
| 1323 `( "\ | |
| 1324 Sun provides support for the WorkShop/XEmacs integration package only. | |
| 1325 All other XEmacs packages are provided to you \"AS IS\".\n" | |
| 438 | 1326 ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") |
| 428 | 1327 (getenv "LANG")))) |
| 1328 (if (and | |
| 1329 (not (featurep 'mule)) ;; Already got mule? | |
| 1330 lang ;; Non-English locale? | |
| 1331 (not (string= lang "C")) | |
| 1332 (not (string-match "^en" lang)) | |
| 1333 ;; Comes with Sun WorkShop | |
| 1334 (locate-file "xemacs-mule" exec-path)) | |
| 1335 '( "\ | |
| 1336 This version of XEmacs has been built with support for Latin-1 languages only. | |
| 1337 To handle other languages you need to run a Multi-lingual (`Mule') version of | |
| 1338 XEmacs, by either running the command `xemacs-mule', or by using the X resource | |
| 1339 `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop. | |
| 1340 \n"))))) | |
| 1341 (face italic "\ | |
| 1342 Copyright (C) 1985-1999 Free Software Foundation, Inc. | |
| 1343 Copyright (C) 1990-1994 Lucid, Inc. | |
| 1344 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. | |
| 2505 | 1345 Copyright (C) 1994-1996 Board of Trustees, University of Illinois. |
| 1346 Copyright (C) 1995-2005 Ben Wing.\n") | |
| 1347 )) | |
| 438 | 1348 |
| 2505 | 1349 (defun splash-screen-tty-body () |
| 1350 `( | |
| 1351 (face italic "[`C-' means the control key, `M-' means the meta key]\n\n") | |
| 428 | 1352 ,@(if (string-match "beta" emacs-version) |
| 438 | 1353 `((key describe-beta) |
| 428 | 1354 ": " (face (red bold) |
| 1355 "This is an Experimental version of XEmacs.\n")) | |
| 1356 `( "\n")) | |
| 1357 ((key xemacs-local-faq) | |
| 2505 | 1358 ": Read the XEmacs FAQ. (A " (face underline "capital") " F!)\n") |
| 1359 ((key info) ": Read the on-line documentation.\n") | |
| 428 | 1360 ((key help-command) |
| 2505 | 1361 ": Get help on using XEmacs.\n") |
| 1362 ((key help-with-tutorial) | |
| 1363 ": Read the XEmacs tutorial.\n") | |
| 1364 ((key view-sample-init-el) | |
| 1365 ": View the sample init.el file.\n") | |
| 1366 ((key about-xemacs) ": See who's developing XEmacs.\n") | |
| 1367 ((key save-buffers-kill-emacs) | |
| 1368 ": exit XEmacs\n") | |
| 1369 "\n" | |
| 1370 (face (bold blue) "XEmacs website: ") | |
| 1371 "http://www.xemacs.org/\n\n" | |
| 1372 (face italic "\ | |
| 1373 Copyright (C) 1985-1999 Free Software Foundation, Inc. | |
| 1374 Copyright (C) 1990-1994 Lucid, Inc. | |
| 1375 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. | |
| 1376 Copyright (C) 1994-1996 Board of Trustees, University of Illinois. | |
| 1377 Copyright (C) 1995-2004 Ben Wing.") | |
| 1378 ; ((key find-file) ": visit a file; ") | |
| 1379 ; ((key save-buffer) ": save changes; ") | |
| 1380 ; ((key undo) ": undo changes; ") | |
| 1381 )) | |
| 428 | 1382 |
| 1383 ;; I really hate global variables, oh well. | |
| 1384 ;(defvar xemacs-startup-logo-function nil | |
| 1385 ; "If non-nil, function called to provide the startup logo. | |
| 1386 ;This function should return an initialized glyph if it is used.") | |
| 1387 | |
| 438 | 1388 ;; This will hopefully go away when gettext is functional. |
| 2505 | 1389 (defconst splash-screen-static-body |
| 1390 `(,(emacs-version) "\n\n")) | |
| 1391 ;; temporary support for old locale files. | |
| 1392 (define-obsolete-variable-alias 'splash-frame-static-body | |
| 1393 'splash-screen-static-body) | |
| 428 | 1394 |
| 2505 | 1395 (defun display-splash-screen () |
| 1396 ;; display the splash screen in the current buffer and put it in the | |
| 1397 ;; current window. | |
| 428 | 1398 (let ((logo xemacs-logo) |
| 1399 (buffer-read-only nil) | |
| 2505 | 1400 (tty (eq 'tty (console-type)))) |
| 1401 (unless tty | |
| 1402 (insert "\n") | |
| 1403 (indent-to (startup-center-spaces logo)) | |
| 1404 (set-extent-begin-glyph (make-extent (point) (point)) logo) | |
| 1405 ;;(splash-screen-present-hack (make-extent p (point)) 'about-xemacs)) | |
| 1406 (insert "\n\n")) | |
| 1407 (splash-screen-present splash-screen-static-body) | |
| 428 | 1408 (splash-hack-version-string) |
| 1409 (goto-char (point-max)) | |
| 1410 (let* ((after-change-functions nil) ; no font-lock, thank you | |
| 2505 | 1411 (elements (cond (tty (splash-screen-tty-body)) |
| 1412 (t (splash-screen-window-body))))) | |
| 1413 (splash-screen-present elements) | |
| 1414 (set-buffer-modified-p nil)))) | |
| 1415 | |
| 1416 (defun xemacs-splash-buffer () | |
| 1417 "Display XEmacs splash screen in a buffer." | |
| 1418 (interactive) | |
| 1419 (let ((buffer (get-buffer-create "*Splash*"))) | |
| 1420 (set-buffer buffer) | |
| 1421 (setq buffer-read-only nil) | |
| 1422 (erase-buffer buffer) | |
| 3643 | 1423 (pop-to-buffer buffer) |
| 1424 (delete-other-windows) | |
| 2505 | 1425 (display-splash-screen))) |
| 428 | 1426 |
| 1427 ;; (let ((present-file | |
| 1428 ;; #'(lambda (f) | |
| 2505 | 1429 ;; (splash-screen-present |
| 428 | 1430 ;; (list 'funcall |
| 1431 ;; (list 'find-file-other-window | |
| 1432 ;; (expand-file-name f data-directory)) | |
| 1433 ;; f))))) | |
| 1434 ;; (insert "For customization examples, see the files ") | |
| 2505 | 1435 ;; (funcall present-file "sample.init.el") |
| 428 | 1436 ;; (insert " and ") |
| 1389 | 1437 ;; (funcall present-file "sample.Xresources") |
| 428 | 1438 ;; (insert (format "\nin the directory %s." data-directory))) |
| 1439 | |
| 2505 | 1440 |
| 428 | 1441 (defun startup-set-invocation-environment () |
| 1442 ;; XEmacs -- Steven Baur says invocation directory is nil if you | |
| 1443 ;; try to use XEmacs as a login shell. | |
| 1444 (or invocation-directory (setq invocation-directory default-directory)) | |
| 1445 (setq invocation-directory | |
| 1446 ;; don't let /tmp_mnt/... get into the load-path or exec-path. | |
| 1447 (abbreviate-file-name invocation-directory))) | |
| 1448 | |
| 2456 | 1449 ;;; High-level functions to set up the paths. |
| 1450 | |
| 1451 (defun startup-find-load-path (&optional inhibit-packages | |
| 1452 set-global-package-paths) | |
| 1453 "Determine the value for `load-path'. | |
| 1454 INHIBIT-PACKAGES says which types of packages, if any, to omit from the | |
| 1455 returned value. It can be `t' (omit all), one of the symbols `early', | |
| 1456 `late', or `last', or a list of one or more of the symbols. | |
| 1457 | |
| 1458 If SET-GLOBAL-PACKAGE-PATHS is non-nil, initialize the global package path | |
| 1459 variables referring to the particular types of packages | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4448
diff
changeset
|
1460 \(`early-package-hierarchies', `early-package-load-path', |
| 2456 | 1461 `late-package-hierarchies', `late-package-load-path', |
| 1462 `last-package-hierarchies', `last-package-load-path')." | |
| 1463 (let (earlyp latep lastp earlyp-lp latep-lp lastp-lp) | |
| 1464 (apply #'(lambda (early late last) | |
| 1465 (setq earlyp (and (not (memq 'early inhibit-packages)) early)) | |
| 1466 (setq latep (and (not (memq 'late inhibit-packages)) late)) | |
| 1467 (setq lastp (and (not (memq 'last inhibit-packages)) last))) | |
| 1468 (packages-find-all-package-hierarchies | |
| 1469 emacs-data-roots)) | |
| 1470 | |
| 1471 (setq earlyp-lp (packages-find-package-load-path earlyp)) | |
| 1472 (setq latep-lp (packages-find-package-load-path latep)) | |
| 1473 (setq lastp-lp (packages-find-package-load-path lastp)) | |
| 1474 | |
| 1475 (when set-global-package-paths | |
| 1476 (setq early-package-hierarchies earlyp | |
| 1477 late-package-hierarchies latep | |
| 1478 last-package-hierarchies lastp | |
| 1479 early-package-load-path earlyp-lp | |
| 1480 late-package-load-path latep-lp | |
| 1481 last-package-load-path lastp-lp)) | |
| 1482 | |
| 1483 (paths-construct-load-path emacs-roots earlyp-lp latep-lp lastp-lp | |
| 1484 lisp-directory site-directory | |
| 1485 mule-lisp-directory))) | |
| 1486 | |
| 1487 (defun startup-setup-paths (&optional inhibit-packages called-early) | |
| 1488 "Setup all the various paths. | |
| 1489 INHIBIT-PACKAGES says which types of packages, if any, to omit from the | |
| 1490 returned value. It can be `t' (omit all), one of the symbols `early', | |
| 1491 `late', or `last', or a list of one or more of the symbols. | |
| 1492 | |
| 1493 This function is idempotent, so call this as often as you like!" | |
| 1494 | |
| 1495 (setq debug-paths (or debug-paths | |
| 1496 (and (getenv "EMACSDEBUGPATHS") | |
| 1497 t))) | |
| 1498 | |
| 1499 (setq emacs-roots (paths-find-emacs-roots invocation-directory invocation-name | |
| 4093 | 1500 #'paths-emacs-root-p)) |
| 2456 | 1501 |
| 1502 (setq emacs-data-roots (paths-find-emacs-roots invocation-directory invocation-name | |
| 1503 #'paths-emacs-data-root-p)) | |
| 1504 | |
| 1505 (if (null emacs-roots) | |
| 1506 (save-excursion | |
| 1507 (set-buffer (get-buffer-create " *warning-tmp*")) | |
| 1508 (erase-buffer) | |
| 1509 (buffer-disable-undo (current-buffer)) | |
| 1510 | |
| 1511 (insert "Couldn't find an obvious default for the root of the\n" | |
| 1512 "XEmacs hierarchy.") | |
| 1513 | |
| 1514 (princ "\nWARNING:\n" 'external-debugging-output) | |
| 1515 (princ (buffer-string) 'external-debugging-output))) | |
| 1516 | |
| 1517 (if (eq inhibit-packages t) | |
| 1518 (setq inhibit-packages '(early late last))) | |
| 1519 (if (not (listp inhibit-packages)) | |
| 1520 (setq inhibit-packages (list inhibit-packages))) | |
| 1521 | |
| 1522 (when debug-paths | |
| 1523 (princ (format | |
| 1524 "startup-setup-paths arguments: | |
| 1525 inhibit-packages: %S | |
| 1526 inhibit-site-lisp: %S | |
| 1527 called-early: %S | |
| 1528 " inhibit-packages inhibit-site-lisp called-early) | |
| 1529 'external-debugging-output) | |
| 1530 (princ (format | |
|
4662
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1531 "invocation-directory: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1532 invocation-name: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1533 configure-prefix-directory: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1534 configure-exec-prefix-directory: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1535 emacs-roots: |
| 2456 | 1536 %S |
| 1537 emacs-data-roots: | |
| 1538 %S | |
| 1539 user-init-directory: %S | |
| 1540 configure-package-path: %S | |
|
4662
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1541 " invocation-directory invocation-name |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1542 configure-prefix-directory configure-exec-prefix-directory |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1543 emacs-roots emacs-data-roots user-init-directory configure-package-path) |
| 2456 | 1544 'external-debugging-output) |
| 1545 ) | |
| 1546 | |
|
4664
d71d2cefa42d
Use `emacs-data-roots' instead of `emacs-roots' where appropriate.
Mike Sperber <sperber@deinprogramm.de>
parents:
4662
diff
changeset
|
1547 (setq lisp-directory (paths-find-lisp-directory emacs-data-roots)) |
| 2456 | 1548 |
| 1549 (if debug-paths | |
| 3985 | 1550 (princ (format "configure-lisp-directory and lisp-directory:\n%S\n%S\n" |
| 1551 configure-lisp-directory lisp-directory) | |
| 2456 | 1552 'external-debugging-output)) |
| 1553 | |
| 1554 (if (featurep 'mule) | |
| 1555 (progn | |
| 1556 (setq mule-lisp-directory | |
|
4664
d71d2cefa42d
Use `emacs-data-roots' instead of `emacs-roots' where appropriate.
Mike Sperber <sperber@deinprogramm.de>
parents:
4662
diff
changeset
|
1557 (paths-find-mule-lisp-directory emacs-data-roots |
| 2456 | 1558 lisp-directory)) |
| 1559 (if debug-paths | |
| 3985 | 1560 (princ (format "configure-mule-lisp-directory and mule-lisp-directory:\n%S\n%S\n" |
| 1561 configure-mule-lisp-directory mule-lisp-directory) | |
| 2456 | 1562 'external-debugging-output))) |
| 1563 (setq mule-lisp-directory '())) | |
| 1564 | |
| 1565 (setq site-directory (and (null inhibit-site-lisp) | |
|
4664
d71d2cefa42d
Use `emacs-data-roots' instead of `emacs-roots' where appropriate.
Mike Sperber <sperber@deinprogramm.de>
parents:
4662
diff
changeset
|
1566 (paths-find-site-lisp-directory emacs-data-roots))) |
| 2456 | 1567 |
| 1568 (if (and debug-paths (null inhibit-site-lisp)) | |
| 3985 | 1569 (princ (format "configure-site-directory and site-directory:\n%S\n%S\n" |
| 1570 configure-site-directory site-directory) | |
| 2456 | 1571 'external-debugging-output)) |
| 1572 | |
| 1573 (setq load-path (startup-find-load-path inhibit-packages t)) | |
| 1574 | |
| 1575 (when debug-paths | |
| 3985 | 1576 (princ (format "configure-early-package-directories, early-package-hierarchies and early-package-load-path:\n%S\n%S\n%S\n" |
| 1577 configure-early-package-directories early-package-hierarchies early-package-load-path) | |
| 2456 | 1578 'external-debugging-output) |
| 3985 | 1579 (princ (format "configure-late-package-directories, late-package-hierarchies and late-package-load-path:\n%S\n%S\n" |
| 1580 configure-late-package-directories late-package-hierarchies late-package-load-path) | |
| 2456 | 1581 'external-debugging-output) |
| 3985 | 1582 (princ (format "configure-last-package-directories, last-package-hierarchies and last-package-load-path:\n%S\n%S\n" |
| 1583 configure-last-package-directories last-package-hierarchies last-package-load-path) | |
| 2456 | 1584 'external-debugging-output)) |
| 1585 | |
| 1586 (if debug-paths | |
| 1587 (princ (format "load-path:\n%S\n" load-path) | |
| 1588 'external-debugging-output)) | |
| 1589 (setq module-directory (paths-find-module-directory emacs-roots)) | |
| 1590 (if debug-paths | |
| 3985 | 1591 (princ (format "configure-module-directory and module-directory:\n%S\n" |
| 1592 configure-module-directory module-directory) | |
| 2456 | 1593 'external-debugging-output)) |
| 1594 (setq site-module-directory (and (null inhibit-site-modules) | |
| 1595 (paths-find-site-module-directory | |
| 1596 emacs-roots))) | |
| 1597 (if (and debug-paths (null inhibit-site-modules)) | |
| 3985 | 1598 (princ (format "configure-site-module-directory and site-module-directory:\n%S\n%S\n" |
| 1599 configure-site-module-directory site-module-directory) | |
| 2456 | 1600 'external-debugging-output)) |
| 1601 | |
| 1602 (setq module-load-path (paths-construct-module-load-path | |
| 1603 emacs-roots | |
| 1604 module-directory | |
| 1605 site-module-directory)) | |
| 1606 | |
| 1607 (unless called-early | |
| 1608 (setq Info-directory-list | |
| 1609 (paths-construct-info-path | |
|
4664
d71d2cefa42d
Use `emacs-data-roots' instead of `emacs-roots' where appropriate.
Mike Sperber <sperber@deinprogramm.de>
parents:
4662
diff
changeset
|
1610 emacs-data-roots |
| 2456 | 1611 early-package-hierarchies late-package-hierarchies last-package-hierarchies)) |
| 1612 | |
| 1613 (if debug-paths | |
| 3985 | 1614 (princ (format "configure-info-directory, configure-info-path and Info-directory-list:\n%S\n%S\n%S\n" |
| 1615 configure-info-directory configure-info-path Info-directory-list) | |
| 2456 | 1616 'external-debugging-output)) |
| 1617 | |
| 1618 (setq exec-directory (paths-find-exec-directory emacs-roots)) | |
| 1619 | |
| 1620 (if debug-paths | |
| 3985 | 1621 (princ (format "configure-exec-directory and exec-directory:\n%S\n%S\n" |
| 1622 configure-exec-directory exec-directory) | |
| 2456 | 1623 'external-debugging-output)) |
| 1624 | |
| 1625 (setq exec-path | |
| 1626 (paths-construct-exec-path emacs-roots exec-directory | |
| 1627 early-package-hierarchies late-package-hierarchies | |
| 1628 last-package-hierarchies)) | |
| 1629 | |
| 1630 (if debug-paths | |
| 1631 (princ (format "exec-path:\n%S\n" exec-path) | |
| 1632 'external-debugging-output)) | |
| 1633 | |
| 1634 (setq doc-directory (paths-find-doc-directory emacs-roots)) | |
| 1635 | |
| 1636 (if debug-paths | |
| 3985 | 1637 (princ (format "configure-doc-directory and doc-directory:\n%S\n%S\n" |
| 1638 configure-doc-directory doc-directory) | |
| 2456 | 1639 'external-debugging-output)) |
| 1640 | |
|
4664
d71d2cefa42d
Use `emacs-data-roots' instead of `emacs-roots' where appropriate.
Mike Sperber <sperber@deinprogramm.de>
parents:
4662
diff
changeset
|
1641 (setq data-directory (paths-find-data-directory emacs-data-roots)) |
| 2456 | 1642 |
| 1643 (if debug-paths | |
| 3985 | 1644 (princ (format "configure-data-directory and data-directory:\n%S\n%S\n" |
| 1645 configure-data-directory data-directory) | |
| 2456 | 1646 'external-debugging-output)) |
| 1647 | |
| 1648 (setq data-directory-list (paths-construct-data-directory-list | |
| 1649 data-directory early-package-hierarchies | |
| 1650 late-package-hierarchies last-package-hierarchies)) | |
| 1651 (if debug-paths | |
| 1652 (princ (format "data-directory-list:\n%S\n" data-directory-list) | |
| 1653 'external-debugging-output)))) | |
| 1654 | |
| 1655 (defun startup-find-load-path-for-packages (packages) | |
| 1656 "Return a suitable load-path for PACKAGES. | |
| 1657 PACKAGES is a list of package names (strings). This looks for package | |
| 1658 directories in the load path whose last component is one of the members of | |
| 1659 PACKAGES." | |
| 1660 (mapcan | |
| 1661 #'(lambda (package) | |
| 1662 (and (member (file-name-nondirectory (directory-file-name package)) | |
| 1663 packages) | |
| 1664 (list package))) | |
| 1665 (startup-find-load-path))) | |
| 1666 | |
| 1667 ; (defun startup-set-basic-packages-load-path () | |
| 1668 ; "#### This is a hack. When recompiling .el files, we use -no-packages | |
| 1669 ; to avoid problems with packages shadowing standard Lisp files | |
| 1670 ; (e.g. unicode.el), but we really still need the stuff in xemacs-base and | |
| 1671 ; xemacs-devel." | |
| 1672 ; (setq load-path (startup-find-load-path-for-packages | |
| 1673 ; '("xemacs-base" "xemacs-devel")))) | |
| 1674 | |
| 428 | 1675 (defun startup-setup-paths-warning () |
| 442 | 1676 (let ((warnings '())) |
| 428 | 1677 (cond |
| 1678 ((null (and lisp-directory exec-directory data-directory doc-directory | |
| 442 | 1679 load-path)) |
| 428 | 1680 (save-excursion |
| 1681 (set-buffer (get-buffer-create " *warning-tmp*")) | |
| 1682 (erase-buffer) | |
| 1683 (buffer-disable-undo (current-buffer)) | |
| 1684 (if (null lisp-directory) (push "lisp-directory" warnings)) | |
| 460 | 1685 (if (and (featurep 'mule) |
| 1686 (null mule-lisp-directory)) | |
| 1687 (push "mule-lisp-directory" warnings)) | |
| 428 | 1688 (if (null exec-directory) (push "exec-directory" warnings)) |
| 1689 (if (null data-directory) (push "data-directory" warnings)) | |
| 1690 (if (null doc-directory) (push "doc-directory" warnings)) | |
| 1691 (if (null load-path) (push "load-path" warnings)) | |
| 1692 | |
| 1693 (insert "Couldn't find obvious defaults for:\n") | |
| 1694 (while warnings | |
| 1695 (insert (car warnings) "\n") | |
| 1696 (setq warnings (cdr warnings))) | |
| 1697 (insert "Perhaps some directories don't exist, " | |
| 1698 "or the XEmacs executable,\n" (concat invocation-directory | |
| 1699 invocation-name) | |
| 1700 "\nis in a strange place?") | |
| 1701 | |
| 1702 (princ "\nWARNING:\n" 'external-debugging-output) | |
| 1703 (princ (buffer-string) 'external-debugging-output) | |
| 1704 (erase-buffer) | |
| 1705 t))))) | |
| 1706 | |
| 2456 | 1707 |
| 1708 ;;; Now actually set the paths up, for bootstrapping purposes. This is run | |
| 1709 ;;; at early dump time and in certain cases where we use a minimal temacs | |
| 1710 ;;; to do useful things, like rebuild DOC. | |
| 1711 | |
| 1712 (startup-setup-paths (if inhibit-all-packages t '(early last)) t) | |
| 1713 | |
| 1714 | |
| 528 | 1715 (defun startup-load-autoloads () |
| 1232 | 1716 (when (and (not inhibit-autoloads) lisp-directory) |
| 1717 (load (expand-file-name (file-name-sans-extension autoload-file-name) | |
| 1718 lisp-directory) | |
| 1719 nil t) | |
| 1720 (when (featurep 'mule) | |
| 528 | 1721 (load (expand-file-name (file-name-sans-extension autoload-file-name) |
| 1232 | 1722 (file-name-as-directory |
| 1723 (expand-file-name "mule" lisp-directory))) | |
| 1724 nil t))) | |
| 528 | 1725 |
| 996 | 1726 ;; Hey! Let's use a packages-* function for a non-package purpose! |
| 1232 | 1727 (when (and (not inhibit-autoloads) (featurep 'modules)) |
| 1728 (packages-load-package-auto-autoloads module-load-path)) | |
| 996 | 1729 |
| 1232 | 1730 (unless (or inhibit-autoloads inhibit-all-packages) |
| 1731 (unless inhibit-early-packages | |
| 1732 (packages-load-package-auto-autoloads early-package-load-path)) | |
| 1733 (packages-load-package-auto-autoloads late-package-load-path) | |
| 1734 (packages-load-package-auto-autoloads last-package-load-path))) | |
| 528 | 1735 |
| 428 | 1736 ;;; startup.el ends here |