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