Mercurial > hg > xemacs-beta
annotate lisp/startup.el @ 5075:868a9ffcc37b
Normally return a compiled function if one argument, #'constantly.
2010-02-24 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (constantly):
Normally return a compiled function from #'constantly if we are
handed a single argument. Shouldn't actually matter, the overhead
for returning a single constant in a lambda form vs. in a compiled
function is minuscule, but using compiled functions as much as
possible is good style in XEmacs, our interpreter is not stellar
(nor indeed should it need to be).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 24 Feb 2010 17:17:13 +0000 |
| parents | fd36a980d701 |
| children | 5efbd1253905 |
| 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 | |
| 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 | |
| 3360 | 177 ;; #### called `site-run-file' in GNU Emacs |
| 428 | 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) | |
|
4448
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
237 ("--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
|
238 ("-script" . command-line-do-script) |
| 444 | 239 ("-insert" . command-line-do-insert) |
| 240 ("-i" . command-line-do-insert) | |
| 241 ("-kill" . command-line-do-kill) | |
| 771 | 242 ("-eol" . command-line-do-enable-eol-detection) |
| 776 | 243 ("-enable-eol-detection" . command-line-do-enable-eol-detection) |
| 444 | 244 ;; Options like +35 are handled specially. |
| 245 ;; Window-system, site, or package-specific code might add to this. | |
| 246 ;; X11 handles its options by letting Xt remove args from this list. | |
| 247 ) | |
| 428 | 248 "Alist of command-line switches. |
| 249 Elements look like (SWITCH-STRING . HANDLER-FUNCTION). | |
| 250 HANDLER-FUNCTION receives switch name as sole arg; | |
| 251 remaining command-line args are in the variable `command-line-args-left'.") | |
| 252 | |
| 253 ;;; default switches | |
| 254 ;;; Note: these doc strings are semi-magical. | |
| 255 | |
| 256 (defun command-line-do-help (arg) | |
| 257 "Print the XEmacs usage message and exit." | |
| 258 (let ((standard-output 'external-debugging-output)) | |
| 259 (princ (concat "\n" (emacs-version) "\n\n")) | |
| 260 (princ | |
| 261 (if (featurep 'x) | |
| 262 (concat "When creating a window on an X display, " | |
| 263 (emacs-name) | |
| 264 " accepts all standard X Toolkit | |
| 265 command line options plus the following: | |
| 266 -iconname <title> Use title as the icon name. | |
| 267 -mc <color> Use color as the mouse color. | |
| 268 -cr <color> Use color as the text-cursor foregound color. | |
| 269 -private Install a private colormap. | |
| 270 | |
| 271 In addition, the") | |
| 272 "The")) | |
| 771 | 273 (let ((l command-switch-alist) |
| 274 (options " following options are accepted: | |
| 275 | |
| 276 Display options: | |
| 277 | |
| 278 -nw Open the initial frame on the current TTY, instead of | |
| 279 a window system. | |
| 280 -t <device> Use TTY <device> instead of the current TTY for input | |
| 281 and output. This implies the -nw option. | |
| 282 -display <display> Standard X option, to specify the display connection. | |
| 283 If this option is given, or if the environment | |
| 284 variable DISPLAY is set, an initial X frame will be | |
| 285 created. Otherwise, an initial Windows frame will be | |
| 286 created if Windows support exists and neither -nw nor | |
| 287 -t is given. Otherwise, a TTY frame is created. | |
| 288 -unmapped Do not display the initial frame. Useful to create | |
| 289 a \"server\" that can accept `gnuclient' connections. | |
| 3360 | 290 -tty Create the initial frame on the given window system. |
| 291 -x (Requesting an unsupported window system, or giving | |
| 292 -gtk conflicting window systems, is a fatal error.) | |
| 293 -gnome | |
| 294 -msw | |
| 771 | 295 |
| 296 Noninteractive options: | |
| 297 | |
| 298 {-help} | |
| 299 {-version} | |
| 300 {-V} | |
| 301 -batch Execute noninteractively (messages go to stderr, no | |
| 302 initial frame created). | |
| 303 {-funcall} | |
| 304 (The function may parse the rest of the command line | |
| 305 for its arguments.) | |
| 306 {-f} | |
| 307 {-eval} | |
| 308 {-load} | |
| 309 {-l} | |
| 310 {-insert} | |
| 311 {-i} | |
| 312 {-kill} | |
| 446 | 313 -sd Show dump ID. Ignored when configured without --pdump. |
| 314 -nd Don't load the dump file. Roughly like old temacs. | |
| 315 Ignored when configured without --pdump. | |
| 771 | 316 |
| 317 Initialization files: | |
| 318 | |
| 319 -no-init-file Do not load the user-specific init file. | |
| 320 -q Same as -no-init-file. | |
| 428 | 321 -debug-init Enter the debugger if an error in the init file occurs. |
| 771 | 322 -user-init-file <file> |
| 323 Use <file> as init file. | |
| 324 -user-init-directory <directory> | |
| 325 Use <directory> as init directory. | |
| 326 -user <user> Load user's init file instead of your own. | |
| 327 -u <user> Same as -user. | |
| 328 -no-site-file Do not load the site-specific init file | |
| 329 (site-start.el). | |
| 330 | |
| 331 Package/module options: | |
| 332 | |
| 333 -vanilla Equivalent to -q -no-site-file -no-early-packages. | |
| 776 | 334 Useful if you think some user-init or site-init code |
| 335 is messing things up, or when running XEmacs in | |
| 336 batch mode. | |
| 428 | 337 -no-autoloads Do not load global symbol files (auto-autoloads) at |
| 338 startup. Also implies `-vanilla'. | |
| 776 | 339 -no-packages Pretend like the packages don't exist. Don't put |
| 340 any packages in the load path or set up any package | |
| 969 | 341 autoloads. Also implies `-vanilla'. Use this when |
| 776 | 342 running XEmacs in batch mode when you aren't using |
| 343 any functionality in packages and want to make sure | |
| 344 that you get no interference from packages | |
| 345 (e.g. Lisp files that shadow core Lisp files). | |
| 346 -no-early-packages Do not process early packages. | |
| 771 | 347 -debug-paths Display info about the runtime values of various |
| 348 directory variables (e.g. for loading packages). | |
| 349 -no-site-modules Do not search site-modules directories for modules | |
| 350 at startup. Only applies when modules support is | |
| 351 compiled into XEmacs. | |
| 352 | |
| 353 Encoding options: | |
| 354 | |
| 355 -eol Turn on EOL detection (only applies to Unix, no | |
| 356 international support; otherwise EOL detection is | |
| 357 already on). | |
| 358 -nuni Under MS Windows, disable use of the Unicode versions | |
| 359 of API calls. Not for Windows 95/98/ME. This is | |
| 360 mostly only useful for debugging purposes. | |
| 361 | |
| 362 Misc: | |
| 363 | |
| 364 +N <file> Start displaying <file> at line N. | |
| 365 ") | |
| 428 | 366 (insert (lambda (&rest x) |
| 367 (let ((len 2)) | |
| 368 (while x | |
| 369 (princ (car x)) | |
| 370 (incf len (length (car x))) | |
| 371 (setq x (cdr x))) | |
| 372 (when (>= len 24) | |
| 373 (terpri) (setq len 0)) | |
| 374 (while (< len 24) | |
| 375 (princ " ") | |
| 376 (incf len)))))) | |
| 771 | 377 (princ |
| 378 (with-temp-buffer | |
| 379 (insert options) | |
| 380 (while l | |
| 381 (let ((name (car (car l))) | |
| 382 (fn (cdr (car l))) | |
| 383 doc arg cons) | |
| 384 (cond | |
| 385 ((and (symbolp fn) (get fn 'undocumented)) nil) | |
| 386 (t | |
| 387 (setq doc (documentation fn)) | |
| 388 (if (member doc '(nil "")) (setq doc "(undocumented)")) | |
| 389 (cond ((string-match "\n\\(<.*>\\)\n?\\'" doc) | |
| 390 ;; Doc of the form "The frobber switch\n<arg1> <arg2>" | |
| 391 (setq arg (substring doc (match-beginning 1) (match-end 1)) | |
| 392 doc (substring doc 0 (match-beginning 0)))) | |
| 393 ((string-match "\n+\\'" doc) | |
| 394 (setq doc (substring doc 0 (match-beginning 0))))) | |
| 395 (if (and (setq cons (rassq fn command-switch-alist)) | |
| 396 (not (eq cons (car l)))) | |
| 397 (setq doc (format "Same as %s." (car cons)))) | |
| 398 (goto-char (point-min)) | |
| 399 (when (search-forward (format "{%s}" name) nil t) | |
| 400 (delete-region (match-beginning 0) (match-end 0)) | |
| 401 (let ((standard-output (current-buffer))) | |
| 402 (if arg | |
| 403 (funcall insert name " " arg) | |
| 404 (funcall insert name)) | |
| 405 (princ doc)))))) | |
| 406 (setq l (cdr l))) | |
| 407 (buffer-string)))) | |
| 428 | 408 (princ (concat "\ |
| 409 | |
| 410 Anything else is considered a file name, and is placed into a buffer for | |
| 411 editing. | |
| 412 | |
| 413 " (emacs-name) " has an online tutorial and manuals. Type ^Ht (Control-h t) after | |
| 414 starting XEmacs to run the tutorial. Type ^Hi to enter the manual browser. | |
| 771 | 415 Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")) |
| 428 | 416 |
| 771 | 417 (kill-emacs 0) |
| 418 )) | |
| 428 | 419 |
| 420 (defun command-line-do-funcall (arg) | |
| 421 "Invoke the named lisp function with no arguments. | |
| 422 <function>" | |
| 423 (funcall (intern (pop command-line-args-left)))) | |
| 424 (fset 'command-line-do-funcall-1 'command-line-do-funcall) | |
| 425 (put 'command-line-do-funcall-1 'undocumented t) | |
| 426 | |
| 427 (defun command-line-do-eval (arg) | |
| 428 "Evaluate the lisp form. Quote it carefully. | |
| 429 <form>" | |
| 430 (eval (read (pop command-line-args-left)))) | |
| 431 | |
| 432 (defun command-line-do-load (arg) | |
| 433 "Load the named file of Lisp code into XEmacs. | |
| 434 <file>" | |
| 435 (let ((file (pop command-line-args-left))) | |
| 436 ;; Take file from default dir if it exists there; | |
| 437 ;; otherwise let `load' search for it. | |
| 438 (if (file-exists-p (expand-file-name file)) | |
| 439 (setq file (expand-file-name file))) | |
| 440 (load file nil t))) | |
| 441 | |
|
4448
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
442 (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
|
443 "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
|
444 <file>" |
|
fd8a9a4d81d9
Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4347
diff
changeset
|
445 (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
|
446 (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
|
447 |
| 428 | 448 (defun command-line-do-insert (arg) |
| 449 "Insert file into the current buffer. | |
| 450 <file>" | |
| 451 (insert-file-contents (pop command-line-args-left))) | |
| 452 | |
| 453 (defun command-line-do-kill (arg) | |
| 454 "Exit XEmacs." | |
| 455 (kill-emacs t)) | |
| 456 | |
| 457 (defun command-line-do-version (arg) | |
| 458 "Print version info and exit." | |
| 459 (princ (concat (emacs-version) "\n")) | |
| 460 (kill-emacs 0)) | |
| 461 | |
| 771 | 462 (defun command-line-do-enable-eol-detection (arg) |
| 463 "Turn on EOL detection (only applies to Unix)." | |
| 464 (set-eol-detection t)) | |
| 465 | |
| 428 | 466 |
| 467 ;;; Processing the command line and loading various init files | |
| 468 | |
| 469 (defun early-error-handler (&rest debugger-args) | |
| 470 "You should probably not be using this." | |
| 471 ;; Used as the debugger during XEmacs initialization; if an error occurs, | |
| 472 ;; print some diagnostics, and kill XEmacs. | |
| 473 | |
| 474 ;; output the contents of the warning buffer, since it won't be seen | |
| 475 ;; otherwise. | |
| 476 ;; #### kludge! The call to Feval forces the pending warnings to | |
| 477 ;; get output. There definitely needs to be a better way. | |
| 478 (let ((buffer (eval (get-buffer-create "*Warnings*")))) | |
| 479 (princ (buffer-substring (point-min buffer) (point-max buffer) buffer) | |
| 480 'external-debugging-output)) | |
| 481 | |
| 482 (let ((string "Initialization error") | |
| 483 (error (nth 1 debugger-args)) | |
| 484 (debug-on-error nil) | |
| 485 (stream 'external-debugging-output)) | |
| 486 (if (null error) | |
| 487 (princ string stream) | |
| 488 (princ (concat "\n" string ": ") stream) | |
| 489 (condition-case () | |
| 490 (display-error error stream) | |
| 491 (error (princ "<<< error printing error message >>>" stream))) | |
| 492 (princ "\n" stream) | |
| 493 (if (memq (car-safe error) '(void-function void-variable)) | |
| 494 (princ " | |
| 495 This probably means that XEmacs is picking up an old version of | |
| 496 the lisp library, or that some .elc files are not up-to-date.\n" | |
| 497 stream))) | |
| 498 (when (not suppress-early-error-handler-backtrace) | |
| 499 (let ((print-length 1000) | |
| 500 (print-level 1000) | |
| 501 (print-escape-newlines t) | |
| 502 (print-readably nil)) | |
| 503 (when (getenv "EMACSLOADPATH") | |
| 504 (princ (format "\n$EMACSLOADPATH is %s" (getenv "EMACSLOADPATH")) | |
| 505 stream)) | |
| 506 (princ (format "\nexec-directory is %S" exec-directory) stream) | |
| 507 (princ (format "\ndata-directory is %S" data-directory) stream) | |
| 508 (princ (format "\ndata-directory-list is %S" data-directory-list) stream) | |
| 509 (princ (format "\ndoc-directory is %S" doc-directory) stream) | |
| 510 (princ (format "\nload-path is %S" load-path) stream) | |
| 511 (princ "\n\n" stream))) | |
| 512 (when (not suppress-early-error-handler-backtrace) | |
| 513 (backtrace stream t))) | |
| 778 | 514 (if-fboundp 'mswindows-message-box |
| 442 | 515 (mswindows-message-box "Initialization error")) |
| 428 | 516 (kill-emacs -1)) |
| 517 | |
| 518 (defun normal-top-level () | |
| 519 (if command-line-processed | |
| 520 (message "Back to top level.") | |
| 521 (setq command-line-processed t) | |
| 771 | 522 ;; Do this first for maximum likelihood of catching errors. The main |
| 523 ;; purpose of this is so that debug-on-error can be set to catch errors | |
| 524 ;; during normal noninteractive running. | |
| 525 (when (getenv "XEMACSDEBUG") | |
| 526 (eval (read (getenv "XEMACSDEBUG")))) | |
| 428 | 527 ;; Canonicalize HOME (PWD is canonicalized by init_buffer in buffer.c) |
| 528 (let ((value (user-home-directory))) | |
| 529 (if (and value | |
| 530 (< (length value) (length default-directory)) | |
| 531 (equal (file-attributes default-directory) | |
| 532 (file-attributes value))) | |
| 533 (setq default-directory (file-name-as-directory value)))) | |
| 534 (setq default-directory (abbreviate-file-name default-directory)) | |
| 535 (initialize-xemacs-paths) | |
| 536 | |
| 537 (startup-set-invocation-environment) | |
| 1330 | 538 (startup-setup-paths (cond (inhibit-all-packages t) |
| 539 (inhibit-early-packages '(early)) | |
| 540 (t nil)) | |
| 541 nil) | |
| 542 (startup-setup-paths-warning) | |
| 428 | 543 |
| 1232 | 544 ;; Either we need to inhibit messages from do_autoloads, or this |
| 545 ;; should go into (command-line) after the initialization of the | |
| 546 ;; frame? | |
| 528 | 547 (startup-load-autoloads) |
| 428 | 548 |
| 866 | 549 (let (error-data) |
| 1123 | 550 ;; if noninteractive, an error will kill us. by catching and |
| 551 ;; resignalling, we don't accomplish much, but do make it difficult | |
| 552 ;; to determine where the error really occurred. when interactive, | |
| 553 ;; however, an error processing the command line does NOT kill us; | |
| 554 ;; instead, the error handler tries to display an error on the frame. | |
| 555 ;; In that case, we must make sure that all the remaining initialization | |
| 556 ;; gets done!!! | |
| 557 ;; | |
| 558 ;; #### A better solution in the interactive case is to use | |
| 559 ;; call-with-condition-handler, which would let us do the rest of | |
| 560 ;; the initialization AND allow the user to get an accurate backtrace. | |
| 561 (if (noninteractive) | |
| 866 | 562 (command-line) |
| 1123 | 563 (condition-case data |
| 564 (command-line) | |
| 565 ;; catch non-error signals, especially quit | |
| 566 (t (setq error-data data)))) | |
| 452 | 567 ;; Do this again, in case the init file defined more abbreviations. |
| 428 | 568 (setq default-directory (abbreviate-file-name default-directory)) |
| 569 ;; Specify the file for recording all the auto save files of | |
| 570 ;; this session. This is used by recover-session. | |
| 444 | 571 (if auto-save-list-file-prefix |
| 572 (setq auto-save-list-file-name | |
| 573 (expand-file-name | |
| 574 (format "%s%d-%s" | |
| 575 auto-save-list-file-prefix | |
| 576 (emacs-pid) | |
| 577 (system-name))))) | |
| 428 | 578 (run-hooks 'emacs-startup-hook) |
| 579 (and term-setup-hook | |
| 580 (run-hooks 'term-setup-hook)) | |
| 581 (setq term-setup-hook nil) | |
| 452 | 582 ;; ;; Modify the initial frame based on what the init file puts into |
| 428 | 583 ;; ;; ...-frame-alist. |
| 584 (frame-notice-user-settings) | |
| 3360 | 585 ;; ;;#### GNU Emacs junk |
| 428 | 586 ;; ;; Now we know the user's default font, so add it to the menu. |
| 587 ;; (if (fboundp 'font-menu-add-default) | |
| 588 ;; (font-menu-add-default)) | |
| 589 (when window-setup-hook | |
| 590 (run-hooks 'window-setup-hook)) | |
| 863 | 591 (setq window-setup-hook nil) |
| 592 (if error-data | |
| 593 ;; re-signal, and don't allow continuation as that will probably | |
| 594 ;; wipe out the user's .emacs if she hasn't migrated yet! | |
| 595 (signal-error (car error-data) (cdr error-data)))) | |
| 442 | 596 |
| 597 (if load-user-init-file-p | |
| 598 (maybe-migrate-user-init-file)) | |
| 3360 | 599 ;; GNU calls precompute-menubar-bindings. We don't mix menubars |
| 611 | 600 ;; and keymaps. |
| 428 | 601 )) |
| 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) |
| 725 (if (featurep 'infodock) | |
| 726 (require 'id-x-toolbar) | |
| 727 (init-toolbar))) | |
| 728 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4448
diff
changeset
|
729 ;; 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
|
730 ;; 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
|
731 (make-device initial-device-type nil nil) |
| 428 | 732 |
| 733 ;; When not in batch mode, this creates the first visible frame, | |
| 734 ;; and deletes the stdio device. | |
| 735 (frame-initialize)) | |
| 736 | |
| 440 | 737 ;; Reinitialize faces if necessary. This function changes face if |
| 738 ;; it is created during auto-autoloads loading. Otherwise, it | |
| 739 ;; does nothing. | |
| 740 (startup-initialize-custom-faces) | |
| 741 | |
| 771 | 742 ;; A couple of other things need to be initted. |
| 743 ;; (RMS writes about internally using hooks for this, in reference | |
| 744 ;; to frame-initialize and frame-notice-user-settings: | |
| 745 ;; | |
| 746 ;; These are now called explicitly at the proper times, | |
| 747 ;; since that is easier to understand. | |
| 748 ;; Actually using hooks within Emacs is bad for future maintenance. --rms. | |
| 749 ;; | |
| 750 ;; In this case, I completely agree. --ben | |
| 811 | 751 (if (featurep 'menubar) |
| 752 (init-menubar-at-startup)) | |
| 428 | 753 ;; |
| 754 ;; We have normality, I repeat, we have normality. Anything you still | |
| 755 ;; can't cope with is therefore your own problem. (And we don't need | |
| 756 ;; to kill XEmacs for it.) | |
| 757 ;; | |
| 758 | |
| 759 ;;; Load init files. | |
| 760 (load-init-file) | |
| 438 | 761 |
| 428 | 762 (with-current-buffer (get-buffer "*scratch*") |
| 763 (erase-buffer) | |
| 764 ;; (insert initial-scratch-message) | |
| 765 (set-buffer-modified-p nil) | |
| 766 (when (eq major-mode 'fundamental-mode) | |
| 2756 | 767 (funcall initial-major-mode)) |
| 768 ;; The docstring for font-lock-set-defaults says that major modes that | |
| 769 ;; have any font-lock defaults specified should call the function | |
| 770 ;; after initialising the `major-mode' variable. None of them do, | |
| 771 ;; however, and any font locking that is ever put in place is done as | |
| 772 ;; a result of `font-lock-set-defaults' being in find-file-hook and | |
| 773 ;; various other places. We could make *scratch* honour the user's | |
| 774 ;; choice of whether font-locking is in place by adding a call to | |
| 775 ;; font-lock-set-defaults in `lisp-interaction-mode'; but that'll | |
| 776 ;; break if `intial-major-mode' is anything else. | |
| 777 ;; | |
| 778 ;; So, despite what `font-lock-set-defaults'' docstring says, this | |
| 779 ;; *is* where we should call it to have the user's choice of font-lock | |
| 780 ;; level take effect in *scratch*. If the modes are rewritten to do | |
| 781 ;; the right then, we're okay too, the function is idempotent. | |
| 782 (font-lock-set-defaults)) | |
| 428 | 783 |
| 784 ;; Load library for our terminal type. | |
| 785 ;; User init file can set term-file-prefix to nil to prevent this. | |
| 786 ;; Note that for any TTY's opened subsequently, the TTY init | |
| 787 ;; code will run this. | |
| 788 (when (and (eq 'tty (console-type)) | |
| 789 (not (noninteractive))) | |
| 790 (load-terminal-library)) | |
| 791 | |
| 792 ;; Process the remaining args. | |
| 793 (command-line-1) | |
| 794 | |
| 795 ;; it was turned on by default so that the warnings don't get displayed | |
| 796 ;; until after the splash screen. | |
| 797 (setq inhibit-warning-display nil) | |
| 798 ;; If -batch, terminate after processing the command options. | |
| 799 (when (noninteractive) (kill-emacs t)))) | |
| 800 | |
| 438 | 801 (defun load-terminal-library () |
| 428 | 802 (when term-file-prefix |
| 803 (let ((term (getenv "TERM")) | |
| 804 hyphend) | |
| 805 (while (and term | |
| 806 (not (load (concat term-file-prefix term) t t))) | |
| 807 ;; Strip off last hyphen and what follows, then try again | |
| 808 (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) | |
| 809 (setq term (substring term 0 hyphend)) | |
| 810 (setq term nil)))))) | |
| 811 | |
| 1330 | 812 (defun find-init-file-1 (dir base-list) |
| 813 (catch 'found | |
| 814 (dolist (file base-list) | |
| 815 (let ((expanded (expand-file-name file dir))) | |
| 816 (if (string-match "el$" expanded) | |
| 817 (let* ((elc (concat expanded "c")) | |
| 818 (el-ok (file-readable-p expanded)) | |
| 819 (elc-ok (file-readable-p elc))) | |
| 820 (cond | |
| 821 ((and el-ok elc-ok (file-newer-than-file-p expanded elc)) | |
| 822 (lwarn 'initialization 'warning | |
| 823 "\ | |
| 824 The compiled initialization file `%s' exists | |
| 825 but is out-of-date with respect to the uncompiled initialization | |
| 826 file `%s'. XEmacs will load the uncompiled | |
| 827 version. You should correct the problem as soon as possible by | |
| 828 loading the uncompiled version and compiling it using | |
| 829 `M-x byte-compile-file' (or `Lisp->Byte-Compile This File' on | |
| 830 the menubar)." | |
| 831 elc expanded) | |
| 832 (throw 'found expanded)) | |
| 833 (elc-ok (throw 'found elc)) | |
| 834 (el-ok (throw 'found expanded)))) | |
| 835 (when (file-readable-p | |
| 836 (when (file-readable-p expanded) | |
| 837 (throw 'found expanded))))))))) | |
| 838 | |
| 442 | 839 (defun find-user-init-directory-init-file (&optional init-directory) |
| 840 "Determine the user's init file if in the init directory." | |
| 1330 | 841 (find-init-file-1 (or init-directory user-init-directory) |
| 842 user-init-file-base-list)) | |
| 442 | 843 |
| 844 (defun find-user-home-directory-init-file (&optional home-directory) | |
| 845 "Determine the user's init file if in the home directory." | |
| 1330 | 846 (find-init-file-1 (or home-directory "~") |
| 847 user-home-init-file-base-list)) | |
| 442 | 848 |
| 849 (defun find-user-init-file (&optional init-directory home-directory) | |
| 440 | 850 "Determine the user's init file." |
| 442 | 851 (if load-home-init-file |
| 852 (find-user-home-directory-init-file home-directory) | |
| 853 (or (find-user-init-directory-init-file init-directory) | |
| 854 (find-user-home-directory-init-file home-directory)))) | |
| 855 | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
856 (defun ask-about-user-init-file-migration-p () |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
857 "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
|
858 (and (not load-home-init-file) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
859 (not (find-user-init-directory-init-file user-init-directory)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
860 (stringp user-init-file) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
861 (file-readable-p user-init-file))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
862 |
| 442 | 863 (defun maybe-migrate-user-init-file () |
| 864 "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
|
865 (if (ask-about-user-init-file-migration-p) |
| 442 | 866 (if (with-output-to-temp-buffer (help-buffer-name nil) |
| 867 (progn | |
| 868 (princ "XEmacs recommends that the initialization code in | |
| 869 ") | |
| 870 (princ user-init-file) | |
| 871 (princ " | |
| 872 be migrated to the ") | |
| 873 (princ user-init-directory) | |
| 874 (princ " directory. XEmacs can | |
| 875 perform the migration automatically. | |
| 876 | |
| 877 After the migration, init.el/init.elc holds user-written | |
| 878 initialization code. Moreover the customize settings will be in | |
| 879 custom.el. | |
| 880 | |
| 452 | 881 You can undo the migration at any time with |
| 882 M-x maybe-unmigrate-user-init-file. | |
| 883 | |
| 442 | 884 If you choose not to do this now, XEmacs will not ask you this |
| 885 question in the future. However, you can still make XEmacs | |
| 886 perform the migration at any time with M-x migrate-user-init-file.") | |
| 887 (show-temp-buffer-in-current-frame standard-output) | |
| 888 (yes-or-no-p-minibuf (concat "Migrate init file to " | |
| 889 user-init-directory | |
| 890 "? ")))) | |
| 4111 | 891 |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
892 (progn |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
893 (migrate-user-init-file) |
| 4111 | 894 (with-output-to-temp-buffer (help-buffer-name nil) |
| 895 (progn | |
| 896 (princ "The initialization code has now been migrated to the ") | |
| 897 (princ user-init-directory) | |
| 898 (princ "directory. | |
| 899 | |
| 900 For backwards compatibility with, for example, older versions of XEmacs, | |
| 901 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
|
902 directory which will load the relocated initialization code. |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
903 |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
904 NOTE THAT THIS WILL OVERWRITE YOUR EXISTING .emacs FILE!") |
| 4111 | 905 (show-temp-buffer-in-current-frame standard-output) |
| 906 (maybe-create-compatibility-dot-emacs)))) | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
907 (set-load-home-init-file user-init-file t)))) |
| 442 | 908 |
| 452 | 909 (defun maybe-create-compatibility-dot-emacs () |
| 910 "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
|
911 (if (yes-or-no-p-minibuf "Create compatibility .emacs?") |
| 452 | 912 (create-compatibility-dot-emacs))) |
| 913 | |
| 442 | 914 (defun migrate-user-init-file () |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
915 "Migrate the init file from the home directory." |
| 442 | 916 (interactive) |
| 917 (if (not (file-exists-p user-init-directory)) | |
| 918 (progn | |
| 919 (message "Creating %s directory..." user-init-directory) | |
| 920 (make-directory user-init-directory))) | |
| 921 (message "Migrating custom file...") | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
922 (set-load-home-init-file user-init-file nil) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
923 (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
|
924 (custom-save-all) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
925 (message "Copying init file...") |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
926 (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
|
927 user-init-directory))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
928 (copy-file user-init-file new-user-init-file) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
929 (setq user-init-file new-user-init-file)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
930 (message "Migration done.")) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
931 |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
932 (defun set-load-home-init-file (filename val) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
933 "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
|
934 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
|
935 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
|
936 (save-excursion |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
937 (set-buffer (find-file-noselect filename)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
938 (goto-char (point-min)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
939 (condition-case nil |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
940 (block find-existing |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
941 (while (not (eobp)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
942 (forward-sexp 1) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
943 (backward-sexp 1) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
944 (let* ((beginning (point)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
945 (sexp (read (current-buffer)))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
946 (if (and (consp sexp) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
947 (consp (cdr sexp)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
948 (eq 'setq (car sexp)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
949 (eq 'load-home-init-file (cadr sexp))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
950 (progn |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
951 (forward-line 1) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
952 (delete-region beginning (point)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
953 (return-from find-existing nil)) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
954 (forward-sexp 1))))) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
955 (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
|
956 (if val |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
957 (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
|
958 (save-buffer))) |
| 440 | 959 |
| 452 | 960 (defun create-compatibility-dot-emacs () |
| 961 "Create .emacs compatibility file for migrated setup." | |
| 962 (message "Creating .emacs compatibility file.") | |
| 963 (with-temp-file (expand-file-name ".emacs" "~") | |
| 964 (insert ";;; XEmacs backwards compatibility file\n") | |
| 965 (insert "(setq user-init-file\n") | |
| 966 (insert " (expand-file-name \"init.el\"\n") | |
| 967 (insert " (expand-file-name \".xemacs\" \"~\")))\n") | |
| 968 (insert "(setq custom-file\n") | |
| 969 (insert " (expand-file-name \"custom.el\"\n") | |
| 970 (insert " (expand-file-name \".xemacs\" \"~\")))\n") | |
| 971 (insert "\n") | |
| 972 (insert "(load-file user-init-file)\n") | |
| 973 (insert "(load-file custom-file)")) | |
| 974 (message "Created .emacs compatibility file.")) | |
| 975 | |
| 976 (defun maybe-unmigrate-user-init-file () | |
| 977 "Possibly unmigrate the user's init and custom files." | |
| 978 (interactive) | |
| 979 (let ((dot-emacs-file-name (expand-file-name ".emacs" "~"))) | |
| 980 (if (and (not load-home-init-file) | |
| 981 (or (not (file-exists-p dot-emacs-file-name)) | |
| 982 (yes-or-no-p-minibuf (concat "Overwrite " dot-emacs-file-name | |
| 983 "? ")))) | |
| 984 (unmigrate-user-init-file dot-emacs-file-name)))) | |
| 985 | |
| 986 (defun unmigrate-user-init-file (&optional target-file-name) | |
| 987 "Unmigrate the user's init and custom files." | |
| 988 (interactive) | |
| 989 (let ((target-file-name | |
| 990 (or target-file-name (expand-file-name ".emacs" "~")))) | |
| 991 (rename-file user-init-file target-file-name 'ok-if-already-exists) | |
| 992 (setq user-init-file target-file-name) | |
| 993 (let ((old-custom-file custom-file)) | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
994 (setq custom-file target-file-name) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
995 (custom-save-all) |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
996 (set-load-home-init-file user-init-file t) |
| 452 | 997 (delete-file old-custom-file)))) |
| 998 | |
| 428 | 999 (defun load-user-init-file () |
| 442 | 1000 "This function actually reads the init file." |
| 428 | 1001 (if (not user-init-file) |
| 442 | 1002 (setq user-init-file |
| 1003 (find-user-init-file user-init-directory))) | |
| 470 | 1004 (if (not custom-file) |
| 1005 (setq custom-file (make-custom-file-name user-init-file))) | |
| 442 | 1006 (if (and user-init-file |
| 1007 (file-readable-p user-init-file)) | |
| 1008 (load user-init-file t t t)) | |
| 1009 (if (and custom-file | |
| 1010 (or (not user-init-file) | |
| 1011 (not (string= custom-file user-init-file))) | |
| 1012 (file-readable-p custom-file)) | |
| 1013 (load custom-file t t t)) | |
| 428 | 1014 (unless inhibit-default-init |
| 1015 (let ((inhibit-startup-message nil)) | |
| 1016 ;; Users are supposed to be told their rights. | |
| 1017 ;; (Plus how to get help and how to undo.) | |
| 1018 ;; Don't you dare turn this off for anyone except yourself. | |
| 1019 (load "default" t t)))) | |
| 1020 | |
| 2030 | 1021 ;;; #### move this comment into a docstring. See site-init-file for some |
| 1022 ;;; description of what it does. Substitute a pointer to this function in | |
| 1023 ;;; site-init-file's docstring. | |
| 428 | 1024 ;;; Load user's init file and default ones. |
| 1025 (defun load-init-file () | |
| 1026 (run-hooks 'before-init-hook) | |
| 1027 | |
| 1028 ;; Run the site-start library if it exists. The point of this file is | |
| 2030 | 1029 ;; that it is run before the user's init file. There is no point in |
| 1030 ;; doing this after the user's init file; that is useless. | |
| 428 | 1031 (when site-start-file |
| 1032 (load site-start-file t t)) | |
| 1033 | |
| 1034 ;; Sites should not disable this. Only individuals should disable | |
| 1035 ;; the startup message. | |
| 1036 (setq inhibit-startup-message nil) | |
| 1037 | |
| 1038 (let (debug-on-error-from-init-file | |
| 1039 debug-on-error-should-be-set | |
| 1040 (debug-on-error-initial | |
| 1041 (if (eq init-file-debug t) 'startup init-file-debug))) | |
| 1042 (let ((debug-on-error debug-on-error-initial)) | |
| 1043 (if (and load-user-init-file-p init-file-debug) | |
| 442 | 1044 (progn |
| 1045 ;; Do this without a condition-case if the user wants to debug. | |
| 1046 (load-user-init-file)) | |
| 793 | 1047 (condition-case nil |
| 1048 (call-with-condition-handler | |
|
4806
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1049 ((macro |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1050 . (lambda (lambda-expression) |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1051 ;; Be serious about information hiding here: |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1052 (nsublis |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1053 '((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
|
1054 lambda-expression))) |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1055 #'(lambda (load-init-handler-arg) |
| 793 | 1056 (let ((errstr (error-message-string |
|
4806
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1057 load-init-handler-arg))) |
| 793 | 1058 (message "Error in init file: %s" errstr) |
| 1059 (lwarn 'initialization 'error | |
| 1060 "\ | |
| 428 | 1061 An error has occurred while loading %s: |
| 1062 | |
| 1063 %s | |
| 1064 | |
| 793 | 1065 Backtrace follows: |
| 1066 | |
| 1067 %s | |
| 1068 | |
| 428 | 1069 To ensure normal operation, you should investigate the cause of the error |
| 1070 in your initialization file and remove it. Use the `-debug-init' option | |
| 793 | 1071 to XEmacs to enter the debugger when the error occurs and investigate the |
| 1072 exact problem." | |
| 1073 user-init-file errstr | |
| 1074 (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
|
1075 'load-init-handler-arg))) |
|
fd36a980d701
Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4664
diff
changeset
|
1076 (setq init-file-had-error t))) |
| 793 | 1077 #'(lambda () |
| 1078 (if load-user-init-file-p | |
| 1079 (load-user-init-file)) | |
| 1080 (setq init-file-had-error nil))) | |
| 1081 (error nil))) | |
| 428 | 1082 ;; If we can tell that the init file altered debug-on-error, |
| 1083 ;; arrange to preserve the value that it set up. | |
| 1084 (or (eq debug-on-error debug-on-error-initial) | |
| 1085 (setq debug-on-error-should-be-set t | |
| 1086 debug-on-error-from-init-file debug-on-error))) | |
| 1087 (when debug-on-error-should-be-set | |
| 1088 (setq debug-on-error debug-on-error-from-init-file))) | |
| 1089 | |
| 1090 (setq init-file-loaded t) | |
| 1091 | |
| 1092 ;; Do this here in case the init file sets mail-host-address. | |
| 1093 ;; Don't do this here unless noninteractive, it is frequently wrong. -sb | |
| 1094 ;; (or user-mail-address | |
| 1095 (when noninteractive | |
| 1096 (setq user-mail-address (concat (user-login-name) "@" | |
| 1097 (or mail-host-address | |
| 1098 (system-name))))) | |
| 1099 | |
| 1100 (run-hooks 'after-init-hook) | |
| 1101 nil) | |
| 1102 | |
| 1103 (defun load-options-file (filename) | |
| 1104 "Load the file of saved options (from the Options menu) called FILENAME. | |
| 1105 Currently this does nothing but call `load', but it might be redefined | |
| 1106 in the future to support automatically converting older options files to | |
| 1107 a new format, when variables have changed, etc." | |
| 1108 (load filename)) | |
| 1109 | |
| 1110 (defun command-line-1 () | |
| 1111 (cond | |
| 1112 ((null command-line-args-left) | |
| 1113 (unless noninteractive | |
| 1114 ;; If there are no switches to process, run the term-setup-hook | |
| 1115 ;; before displaying the copyright notice; there may be some need | |
| 1116 ;; to do it before doing any output. If we're not going to | |
| 1117 ;; display a copyright notice (because other options are present) | |
| 1118 ;; then this is run after those options are processed. | |
| 1119 (run-hooks 'term-setup-hook) | |
| 1120 ;; Don't let the hook be run twice. | |
| 1121 (setq term-setup-hook nil) | |
| 1122 | |
| 1123 ;; Don't clobber a non-scratch buffer if init file | |
| 1124 ;; has selected it. | |
|
4347
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
1125 (when (and (string= (buffer-name) "*scratch*") |
|
6b571dc4ba3f
Rework init-file migration.
Mike Sperber <sperber@deinprogramm.de>
parents:
4111
diff
changeset
|
1126 (not (ask-about-user-init-file-migration-p))) |
| 428 | 1127 (unless (or inhibit-startup-message |
| 1128 (input-pending-p)) | |
| 2505 | 1129 (let (tmout) |
| 428 | 1130 (unwind-protect |
| 1131 ;; Guts of with-timeout | |
| 1132 (catch 'tmout | |
| 1133 (setq tmout (add-timeout startup-message-timeout | |
| 1134 (lambda (ignore) | |
| 1135 (condition-case nil | |
| 1136 (throw 'tmout t) | |
| 1137 (error nil))) | |
| 1138 nil)) | |
| 2505 | 1139 (display-splash-screen) |
| 428 | 1140 (or nil;; (pos-visible-in-window-p (point-min)) |
| 1141 (goto-char (point-min))) | |
| 1142 (sit-for 0) | |
| 1143 (setq unread-command-event (next-command-event))) | |
| 2505 | 1144 (when tmout (disable-timeout tmout))))) |
| 428 | 1145 (with-current-buffer (get-buffer "*scratch*") |
| 1146 ;; In case the XEmacs server has already selected | |
| 1147 ;; another buffer, erase the one our message is in. | |
| 1148 (erase-buffer) | |
| 1149 (when (stringp initial-scratch-message) | |
| 1150 (insert initial-scratch-message)) | |
| 1151 (set-buffer-modified-p nil))))) | |
| 1152 | |
| 1153 (t | |
| 1154 ;; Command-line-options exist | |
| 1155 (let ((dir command-line-default-directory) | |
| 1156 (file-count 0) | |
| 1157 (line nil) | |
| 1158 (end-of-options nil) | |
| 442 | 1159 file-p arg tem) |
| 428 | 1160 (while command-line-args-left |
| 1161 (setq arg (pop command-line-args-left)) | |
| 1162 (cond | |
| 1163 (end-of-options | |
| 1164 (setq file-p t)) | |
| 1165 ((setq tem (when (eq (aref arg 0) ?-) | |
| 1166 (or (assoc arg command-switch-alist) | |
| 1167 (assoc (substring arg 1) | |
| 1168 command-switch-alist)))) | |
| 1169 (funcall (cdr tem) arg)) | |
| 1170 ((string-match "\\`\\+[0-9]+\\'" arg) | |
| 1171 (setq line (string-to-int arg))) | |
| 1172 ;; "- file" means don't treat "file" as a switch | |
| 1173 ;; ("+0 file" has the same effect; "-" added | |
| 1174 ;; for unixoidiality). | |
| 1175 ;; This is worthless; the `unixoid' way is "./file". -jwz | |
| 1176 ((or (string= arg "-") (string= arg "--")) | |
| 1177 (setq end-of-options t)) | |
| 1178 (t | |
| 1179 (setq file-p t))) | |
| 438 | 1180 |
| 428 | 1181 (when file-p |
| 1182 (setq file-p nil) | |
| 1183 (incf file-count) | |
| 1184 (setq arg (expand-file-name arg dir)) | |
| 1185 (cond | |
| 442 | 1186 ((= file-count 1) |
| 1187 (find-file arg)) | |
| 428 | 1188 (noninteractive (find-file arg)) |
| 1189 (t (find-file-other-window arg))) | |
| 1190 (when line | |
| 1191 (goto-line line) | |
| 1192 (setq line nil)))))))) | |
| 1193 | |
| 2505 | 1194 |
| 428 | 1195 (defun startup-presentation-hack-help (e) |
| 1196 (setq e (extent-property e 'startup-presentation-hack)) | |
| 2505 | 1197 (symbol-name e)) |
| 1198 | |
| 1199 (defun startup-presentation-activate (ev ex) | |
| 1200 (call-interactively (extent-property ex 'startup-presentation-hack))) | |
| 428 | 1201 |
| 2505 | 1202 (defun splash-screen-present-hack (e v) |
| 1203 ; (set-extent-property e 'mouse-face 'highlight) | |
| 1204 ; (set-extent-property e 'startup-presentation-hack v) | |
| 1205 ; (set-extent-property e 'help-echo | |
| 1206 ; 'startup-presentation-hack-help) | |
| 1207 ; (set-extent-property e 'activate-function 'startup-presentation-activate) | |
| 428 | 1208 ) |
| 1209 | |
| 1210 (defun splash-hack-version-string () | |
| 1211 (save-excursion | |
| 1212 (save-restriction | |
| 1213 (goto-char (point-min)) | |
| 1214 (re-search-forward "^XEmacs" nil t) | |
| 1215 (narrow-to-region (point-at-bol) (point-at-eol)) | |
| 1216 (goto-char (point-min)) | |
| 1217 (when (re-search-forward " \\[Lucid\\]" nil t) | |
| 1218 (delete-region (match-beginning 0) (match-end 0))) | |
| 1219 (when (re-search-forward "[^(][^)]*-[^)]*-" nil t) | |
| 1220 (delete-region (1+ (match-beginning 0)) (match-end 0)) | |
| 1221 (insert "(")) | |
| 1222 (goto-char (point-max)) | |
| 1223 (search-backward " " nil t) | |
| 1224 (when (search-forward "." nil t) | |
| 1225 (delete-region (1- (point)) (point-max)))))) | |
| 1226 | |
| 2505 | 1227 ;; parse one page description (see `splash-screen-body') and display |
| 1228 ;; at point. | |
| 1229 (defun splash-screen-present (l) | |
| 428 | 1230 (cond ((stringp l) |
| 1231 (insert l)) | |
| 1232 ((eq (car-safe l) 'face) | |
| 1233 ;; (face name string) | |
| 1234 (let ((p (point))) | |
| 2505 | 1235 (splash-screen-present (elt l 2)) |
| 1236 (set-extent-face (make-extent p (point)) | |
| 1237 (elt l 1)))) | |
| 428 | 1238 ((eq (car-safe l) 'key) |
| 1239 (let* ((c (elt l 1)) | |
| 1240 (p (point)) | |
| 1241 (k (where-is-internal c nil t))) | |
| 1242 (insert (if k (key-description k) | |
| 1243 (format "M-x %s" c))) | |
| 2505 | 1244 (let ((e (make-extent p (point)))) |
| 1245 (set-extent-face e 'bold) | |
| 1246 (splash-screen-present-hack e c)))) | |
| 428 | 1247 ((eq (car-safe l) 'funcall) |
| 1248 ;; (funcall (fun . args) string) | |
| 1249 (let ((p (point))) | |
| 2505 | 1250 (splash-screen-present (elt l 2)) |
| 1251 (splash-screen-present-hack (make-extent p (point)) | |
| 1252 (elt l 1)))) | |
| 428 | 1253 ((consp l) |
| 2505 | 1254 (mapcar 'splash-screen-present l)) |
| 428 | 1255 (t |
| 1256 (error "WTF!?")))) | |
| 1257 | |
| 1258 (defun startup-center-spaces (glyph) | |
| 1259 ;; Return the number of spaces to insert in order to center | |
| 1260 ;; the given glyph (may be a string or a pixmap). | |
| 438 | 1261 ;; Assume spaces are as wide as avg-pixwidth. |
| 428 | 1262 ;; Won't be quite right for proportional fonts, but it's the best we can do. |
| 1263 ;; Maybe the new redisplay will export something a glyph-width function. | |
| 1264 ;;; #### Yes, there is a glyph-width function but it isn't quite what | |
| 1265 ;;; #### this was expecting. Or is it? | |
| 1266 ;; (An alternate way to get avg-pixwidth would be to use x-font-properties | |
| 1267 ;; and calculate RESOLUTION_X * AVERAGE_WIDTH / 722.7, but it's no better.) | |
| 1268 | |
| 1269 ;; This function is used in about.el too. | |
| 1270 (let* ((avg-pixwidth (round (/ (frame-pixel-width) (frame-width)))) | |
| 1271 (fill-area-width (* avg-pixwidth (- fill-column left-margin))) | |
| 438 | 1272 (glyph-pixwidth (cond ((stringp glyph) |
| 428 | 1273 (* avg-pixwidth (length glyph))) |
| 1274 ((glyphp glyph) | |
| 1275 (glyph-width glyph)) | |
| 1276 (t | |
| 1277 (error "startup-center-spaces: bad arg"))))) | |
| 1278 (+ left-margin | |
| 1279 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) | |
| 1280 | |
| 2505 | 1281 ;; the splash screen originated in 19.10 as splash-screen-*. When |
| 1282 ;; Chuck made the global screen->frame change for 19.12, he | |
| 1283 ;; accidentally changed these too. This randomness is getting on my | |
| 1284 ;; nerves, so let's fix it and provide minimal aliases for the | |
| 1285 ;; `locale' mule package. --ben | |
| 1286 | |
| 1287 ;; returns either of vector of page descriptions, each describing one | |
| 1288 ;; screenful of information, or just one such page descriptions Each | |
| 1289 ;; page description is a list of textual elements describing how to | |
| 1290 ;; display a section of text. The elements are processed in turn and | |
| 1291 ;; the results inserted one after the previous in a buffer. Each | |
| 1292 ;; textual element is either: | |
| 1293 | |
| 1294 ;; -- a string, inserted as-is with no decoration. | |
| 1295 ;; -- a list of (face FACES "text"), where FACES is the name of a face | |
| 1296 ;; or a list of such names, and specifies the face(s) used when | |
| 1297 ;; displaying the text. | |
| 1298 ;; -- a list of (key COMMAND-NAME); the key sequence corresponding to | |
| 1299 ;; the command will be inserted, in boldface. | |
| 1300 ;; -- a list of textual elements. | |
| 1301 | |
| 1302 (defun splash-screen-window-body () | |
| 1303 `( | |
| 1304 (face (blue bold underline) | |
| 1305 "Useful Help-menu entries:\n\n") | |
| 1306 ,@(if (string-match "beta" emacs-version) | |
| 1307 `((face bold "Beta Info:") | |
| 1308 (face (red bold) | |
| 1309 " This is an Experimental version of XEmacs.\n")) | |
| 1310 `( "")) | |
| 1311 (face bold "XEmacs FAQ:") | |
| 1312 " Read the XEmacs FAQ.\n" | |
| 1313 (face bold "Info (Online Docs):") | |
| 1314 " Read the on-line documentation.\n" | |
| 1315 (face bold "Tutorial:") | |
| 1316 " XEmacs tutorial.\n" | |
| 1317 (face bold "Samples->View Sample init.el:") | |
| 1318 " A useful initialization file.\n" | |
| 1319 (face bold "About XEmacs:") | |
| 1320 " See who's developing XEmacs.\n" | |
| 1321 "\n" | |
| 1322 (face (bold blue) "XEmacs website:") | |
| 1323 " http://www.xemacs.org/\n\n" | |
| 428 | 1324 ,@(if (featurep 'sparcworks) |
| 1325 `( "\ | |
| 1326 Sun provides support for the WorkShop/XEmacs integration package only. | |
| 1327 All other XEmacs packages are provided to you \"AS IS\".\n" | |
| 438 | 1328 ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") |
| 428 | 1329 (getenv "LANG")))) |
| 1330 (if (and | |
| 1331 (not (featurep 'mule)) ;; Already got mule? | |
| 1332 lang ;; Non-English locale? | |
| 1333 (not (string= lang "C")) | |
| 1334 (not (string-match "^en" lang)) | |
| 1335 ;; Comes with Sun WorkShop | |
| 1336 (locate-file "xemacs-mule" exec-path)) | |
| 1337 '( "\ | |
| 1338 This version of XEmacs has been built with support for Latin-1 languages only. | |
| 1339 To handle other languages you need to run a Multi-lingual (`Mule') version of | |
| 1340 XEmacs, by either running the command `xemacs-mule', or by using the X resource | |
| 1341 `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop. | |
| 1342 \n"))))) | |
| 1343 (face italic "\ | |
| 1344 Copyright (C) 1985-1999 Free Software Foundation, Inc. | |
| 1345 Copyright (C) 1990-1994 Lucid, Inc. | |
| 1346 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. | |
| 2505 | 1347 Copyright (C) 1994-1996 Board of Trustees, University of Illinois. |
| 1348 Copyright (C) 1995-2005 Ben Wing.\n") | |
| 1349 )) | |
| 438 | 1350 |
| 2505 | 1351 (defun splash-screen-tty-body () |
| 1352 `( | |
| 1353 (face italic "[`C-' means the control key, `M-' means the meta key]\n\n") | |
| 428 | 1354 ,@(if (string-match "beta" emacs-version) |
| 438 | 1355 `((key describe-beta) |
| 428 | 1356 ": " (face (red bold) |
| 1357 "This is an Experimental version of XEmacs.\n")) | |
| 1358 `( "\n")) | |
| 1359 ((key xemacs-local-faq) | |
| 2505 | 1360 ": Read the XEmacs FAQ. (A " (face underline "capital") " F!)\n") |
| 1361 ((key info) ": Read the on-line documentation.\n") | |
| 428 | 1362 ((key help-command) |
| 2505 | 1363 ": Get help on using XEmacs.\n") |
| 1364 ((key help-with-tutorial) | |
| 1365 ": Read the XEmacs tutorial.\n") | |
| 1366 ((key view-sample-init-el) | |
| 1367 ": View the sample init.el file.\n") | |
| 1368 ((key about-xemacs) ": See who's developing XEmacs.\n") | |
| 1369 ((key save-buffers-kill-emacs) | |
| 1370 ": exit XEmacs\n") | |
| 1371 "\n" | |
| 1372 (face (bold blue) "XEmacs website: ") | |
| 1373 "http://www.xemacs.org/\n\n" | |
| 1374 (face italic "\ | |
| 1375 Copyright (C) 1985-1999 Free Software Foundation, Inc. | |
| 1376 Copyright (C) 1990-1994 Lucid, Inc. | |
| 1377 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. | |
| 1378 Copyright (C) 1994-1996 Board of Trustees, University of Illinois. | |
| 1379 Copyright (C) 1995-2004 Ben Wing.") | |
| 1380 ; ((key find-file) ": visit a file; ") | |
| 1381 ; ((key save-buffer) ": save changes; ") | |
| 1382 ; ((key undo) ": undo changes; ") | |
| 1383 )) | |
| 428 | 1384 |
| 1385 ;; I really hate global variables, oh well. | |
| 1386 ;(defvar xemacs-startup-logo-function nil | |
| 1387 ; "If non-nil, function called to provide the startup logo. | |
| 1388 ;This function should return an initialized glyph if it is used.") | |
| 1389 | |
| 438 | 1390 ;; This will hopefully go away when gettext is functional. |
| 2505 | 1391 (defconst splash-screen-static-body |
| 1392 `(,(emacs-version) "\n\n")) | |
| 1393 ;; temporary support for old locale files. | |
| 1394 (define-obsolete-variable-alias 'splash-frame-static-body | |
| 1395 'splash-screen-static-body) | |
| 428 | 1396 |
| 2505 | 1397 (defun display-splash-screen () |
| 1398 ;; display the splash screen in the current buffer and put it in the | |
| 1399 ;; current window. | |
| 428 | 1400 (let ((logo xemacs-logo) |
| 1401 (buffer-read-only nil) | |
| 2505 | 1402 (tty (eq 'tty (console-type)))) |
| 1403 (unless tty | |
| 1404 (insert "\n") | |
| 1405 (indent-to (startup-center-spaces logo)) | |
| 1406 (set-extent-begin-glyph (make-extent (point) (point)) logo) | |
| 1407 ;;(splash-screen-present-hack (make-extent p (point)) 'about-xemacs)) | |
| 1408 (insert "\n\n")) | |
| 1409 (splash-screen-present splash-screen-static-body) | |
| 428 | 1410 (splash-hack-version-string) |
| 1411 (goto-char (point-max)) | |
| 1412 (let* ((after-change-functions nil) ; no font-lock, thank you | |
| 2505 | 1413 (elements (cond (tty (splash-screen-tty-body)) |
| 1414 (t (splash-screen-window-body))))) | |
| 1415 (splash-screen-present elements) | |
| 1416 (set-buffer-modified-p nil)))) | |
| 1417 | |
| 1418 (defun xemacs-splash-buffer () | |
| 1419 "Display XEmacs splash screen in a buffer." | |
| 1420 (interactive) | |
| 1421 (let ((buffer (get-buffer-create "*Splash*"))) | |
| 1422 (set-buffer buffer) | |
| 1423 (setq buffer-read-only nil) | |
| 1424 (erase-buffer buffer) | |
| 3643 | 1425 (pop-to-buffer buffer) |
| 1426 (delete-other-windows) | |
| 2505 | 1427 (display-splash-screen))) |
| 428 | 1428 |
| 1429 ;; (let ((present-file | |
| 1430 ;; #'(lambda (f) | |
| 2505 | 1431 ;; (splash-screen-present |
| 428 | 1432 ;; (list 'funcall |
| 1433 ;; (list 'find-file-other-window | |
| 1434 ;; (expand-file-name f data-directory)) | |
| 1435 ;; f))))) | |
| 1436 ;; (insert "For customization examples, see the files ") | |
| 2505 | 1437 ;; (funcall present-file "sample.init.el") |
| 428 | 1438 ;; (insert " and ") |
| 1389 | 1439 ;; (funcall present-file "sample.Xresources") |
| 428 | 1440 ;; (insert (format "\nin the directory %s." data-directory))) |
| 1441 | |
| 2505 | 1442 |
| 428 | 1443 (defun startup-set-invocation-environment () |
| 1444 ;; XEmacs -- Steven Baur says invocation directory is nil if you | |
| 1445 ;; try to use XEmacs as a login shell. | |
| 1446 (or invocation-directory (setq invocation-directory default-directory)) | |
| 1447 (setq invocation-directory | |
| 1448 ;; don't let /tmp_mnt/... get into the load-path or exec-path. | |
| 1449 (abbreviate-file-name invocation-directory))) | |
| 1450 | |
| 2456 | 1451 ;;; High-level functions to set up the paths. |
| 1452 | |
| 1453 (defun startup-find-load-path (&optional inhibit-packages | |
| 1454 set-global-package-paths) | |
| 1455 "Determine the value for `load-path'. | |
| 1456 INHIBIT-PACKAGES says which types of packages, if any, to omit from the | |
| 1457 returned value. It can be `t' (omit all), one of the symbols `early', | |
| 1458 `late', or `last', or a list of one or more of the symbols. | |
| 1459 | |
| 1460 If SET-GLOBAL-PACKAGE-PATHS is non-nil, initialize the global package path | |
| 1461 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
|
1462 \(`early-package-hierarchies', `early-package-load-path', |
| 2456 | 1463 `late-package-hierarchies', `late-package-load-path', |
| 1464 `last-package-hierarchies', `last-package-load-path')." | |
| 1465 (let (earlyp latep lastp earlyp-lp latep-lp lastp-lp) | |
| 1466 (apply #'(lambda (early late last) | |
| 1467 (setq earlyp (and (not (memq 'early inhibit-packages)) early)) | |
| 1468 (setq latep (and (not (memq 'late inhibit-packages)) late)) | |
| 1469 (setq lastp (and (not (memq 'last inhibit-packages)) last))) | |
| 1470 (packages-find-all-package-hierarchies | |
| 1471 emacs-data-roots)) | |
| 1472 | |
| 1473 (setq earlyp-lp (packages-find-package-load-path earlyp)) | |
| 1474 (setq latep-lp (packages-find-package-load-path latep)) | |
| 1475 (setq lastp-lp (packages-find-package-load-path lastp)) | |
| 1476 | |
| 1477 (when set-global-package-paths | |
| 1478 (setq early-package-hierarchies earlyp | |
| 1479 late-package-hierarchies latep | |
| 1480 last-package-hierarchies lastp | |
| 1481 early-package-load-path earlyp-lp | |
| 1482 late-package-load-path latep-lp | |
| 1483 last-package-load-path lastp-lp)) | |
| 1484 | |
| 1485 (paths-construct-load-path emacs-roots earlyp-lp latep-lp lastp-lp | |
| 1486 lisp-directory site-directory | |
| 1487 mule-lisp-directory))) | |
| 1488 | |
| 1489 (defun startup-setup-paths (&optional inhibit-packages called-early) | |
| 1490 "Setup all the various paths. | |
| 1491 INHIBIT-PACKAGES says which types of packages, if any, to omit from the | |
| 1492 returned value. It can be `t' (omit all), one of the symbols `early', | |
| 1493 `late', or `last', or a list of one or more of the symbols. | |
| 1494 | |
| 1495 This function is idempotent, so call this as often as you like!" | |
| 1496 | |
| 1497 (setq debug-paths (or debug-paths | |
| 1498 (and (getenv "EMACSDEBUGPATHS") | |
| 1499 t))) | |
| 1500 | |
| 1501 (setq emacs-roots (paths-find-emacs-roots invocation-directory invocation-name | |
| 4093 | 1502 #'paths-emacs-root-p)) |
| 2456 | 1503 |
| 1504 (setq emacs-data-roots (paths-find-emacs-roots invocation-directory invocation-name | |
| 1505 #'paths-emacs-data-root-p)) | |
| 1506 | |
| 1507 (if (null emacs-roots) | |
| 1508 (save-excursion | |
| 1509 (set-buffer (get-buffer-create " *warning-tmp*")) | |
| 1510 (erase-buffer) | |
| 1511 (buffer-disable-undo (current-buffer)) | |
| 1512 | |
| 1513 (insert "Couldn't find an obvious default for the root of the\n" | |
| 1514 "XEmacs hierarchy.") | |
| 1515 | |
| 1516 (princ "\nWARNING:\n" 'external-debugging-output) | |
| 1517 (princ (buffer-string) 'external-debugging-output))) | |
| 1518 | |
| 1519 (if (eq inhibit-packages t) | |
| 1520 (setq inhibit-packages '(early late last))) | |
| 1521 (if (not (listp inhibit-packages)) | |
| 1522 (setq inhibit-packages (list inhibit-packages))) | |
| 1523 | |
| 1524 (when debug-paths | |
| 1525 (princ (format | |
| 1526 "startup-setup-paths arguments: | |
| 1527 inhibit-packages: %S | |
| 1528 inhibit-site-lisp: %S | |
| 1529 called-early: %S | |
| 1530 " inhibit-packages inhibit-site-lisp called-early) | |
| 1531 'external-debugging-output) | |
| 1532 (princ (format | |
|
4662
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1533 "invocation-directory: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1534 invocation-name: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1535 configure-prefix-directory: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1536 configure-exec-prefix-directory: %S |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1537 emacs-roots: |
| 2456 | 1538 %S |
| 1539 emacs-data-roots: | |
| 1540 %S | |
| 1541 user-init-directory: %S | |
| 1542 configure-package-path: %S | |
|
4662
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1543 " invocation-directory invocation-name |
|
a597b89c2db9
Print a few more variables upon --debug-paths.
Mike Sperber <sperber@deinprogramm.de>
parents:
4477
diff
changeset
|
1544 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
|
1545 emacs-roots emacs-data-roots user-init-directory configure-package-path) |
| 2456 | 1546 'external-debugging-output) |
| 1547 ) | |
| 1548 | |
|
4664
d71d2cefa42d
Use `emacs-data-roots' instead of `emacs-roots' where appropriate.
Mike Sperber <sperber@deinprogramm.de>
parents:
4662
diff
changeset
|
1549 (setq lisp-directory (paths-find-lisp-directory emacs-data-roots)) |
| 2456 | 1550 |
| 1551 (if debug-paths | |
| 3985 | 1552 (princ (format "configure-lisp-directory and lisp-directory:\n%S\n%S\n" |
| 1553 configure-lisp-directory lisp-directory) | |
| 2456 | 1554 'external-debugging-output)) |
| 1555 | |
| 1556 (if (featurep 'mule) | |
| 1557 (progn | |
| 1558 (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
|
1559 (paths-find-mule-lisp-directory emacs-data-roots |
| 2456 | 1560 lisp-directory)) |
| 1561 (if debug-paths | |
| 3985 | 1562 (princ (format "configure-mule-lisp-directory and mule-lisp-directory:\n%S\n%S\n" |
| 1563 configure-mule-lisp-directory mule-lisp-directory) | |
| 2456 | 1564 'external-debugging-output))) |
| 1565 (setq mule-lisp-directory '())) | |
| 1566 | |
| 1567 (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
|
1568 (paths-find-site-lisp-directory emacs-data-roots))) |
| 2456 | 1569 |
| 1570 (if (and debug-paths (null inhibit-site-lisp)) | |
| 3985 | 1571 (princ (format "configure-site-directory and site-directory:\n%S\n%S\n" |
| 1572 configure-site-directory site-directory) | |
| 2456 | 1573 'external-debugging-output)) |
| 1574 | |
| 1575 (setq load-path (startup-find-load-path inhibit-packages t)) | |
| 1576 | |
| 1577 (when debug-paths | |
| 3985 | 1578 (princ (format "configure-early-package-directories, early-package-hierarchies and early-package-load-path:\n%S\n%S\n%S\n" |
| 1579 configure-early-package-directories early-package-hierarchies early-package-load-path) | |
| 2456 | 1580 'external-debugging-output) |
| 3985 | 1581 (princ (format "configure-late-package-directories, late-package-hierarchies and late-package-load-path:\n%S\n%S\n" |
| 1582 configure-late-package-directories late-package-hierarchies late-package-load-path) | |
| 2456 | 1583 'external-debugging-output) |
| 3985 | 1584 (princ (format "configure-last-package-directories, last-package-hierarchies and last-package-load-path:\n%S\n%S\n" |
| 1585 configure-last-package-directories last-package-hierarchies last-package-load-path) | |
| 2456 | 1586 'external-debugging-output)) |
| 1587 | |
| 1588 (if debug-paths | |
| 1589 (princ (format "load-path:\n%S\n" load-path) | |
| 1590 'external-debugging-output)) | |
| 1591 (setq module-directory (paths-find-module-directory emacs-roots)) | |
| 1592 (if debug-paths | |
| 3985 | 1593 (princ (format "configure-module-directory and module-directory:\n%S\n" |
| 1594 configure-module-directory module-directory) | |
| 2456 | 1595 'external-debugging-output)) |
| 1596 (setq site-module-directory (and (null inhibit-site-modules) | |
| 1597 (paths-find-site-module-directory | |
| 1598 emacs-roots))) | |
| 1599 (if (and debug-paths (null inhibit-site-modules)) | |
| 3985 | 1600 (princ (format "configure-site-module-directory and site-module-directory:\n%S\n%S\n" |
| 1601 configure-site-module-directory site-module-directory) | |
| 2456 | 1602 'external-debugging-output)) |
| 1603 | |
| 1604 (setq module-load-path (paths-construct-module-load-path | |
| 1605 emacs-roots | |
| 1606 module-directory | |
| 1607 site-module-directory)) | |
| 1608 | |
| 1609 (unless called-early | |
| 1610 (setq Info-directory-list | |
| 1611 (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
|
1612 emacs-data-roots |
| 2456 | 1613 early-package-hierarchies late-package-hierarchies last-package-hierarchies)) |
| 1614 | |
| 1615 (if debug-paths | |
| 3985 | 1616 (princ (format "configure-info-directory, configure-info-path and Info-directory-list:\n%S\n%S\n%S\n" |
| 1617 configure-info-directory configure-info-path Info-directory-list) | |
| 2456 | 1618 'external-debugging-output)) |
| 1619 | |
| 1620 (setq exec-directory (paths-find-exec-directory emacs-roots)) | |
| 1621 | |
| 1622 (if debug-paths | |
| 3985 | 1623 (princ (format "configure-exec-directory and exec-directory:\n%S\n%S\n" |
| 1624 configure-exec-directory exec-directory) | |
| 2456 | 1625 'external-debugging-output)) |
| 1626 | |
| 1627 (setq exec-path | |
| 1628 (paths-construct-exec-path emacs-roots exec-directory | |
| 1629 early-package-hierarchies late-package-hierarchies | |
| 1630 last-package-hierarchies)) | |
| 1631 | |
| 1632 (if debug-paths | |
| 1633 (princ (format "exec-path:\n%S\n" exec-path) | |
| 1634 'external-debugging-output)) | |
| 1635 | |
| 1636 (setq doc-directory (paths-find-doc-directory emacs-roots)) | |
| 1637 | |
| 1638 (if debug-paths | |
| 3985 | 1639 (princ (format "configure-doc-directory and doc-directory:\n%S\n%S\n" |
| 1640 configure-doc-directory doc-directory) | |
| 2456 | 1641 'external-debugging-output)) |
| 1642 | |
|
4664
d71d2cefa42d
Use `emacs-data-roots' instead of `emacs-roots' where appropriate.
Mike Sperber <sperber@deinprogramm.de>
parents:
4662
diff
changeset
|
1643 (setq data-directory (paths-find-data-directory emacs-data-roots)) |
| 2456 | 1644 |
| 1645 (if debug-paths | |
| 3985 | 1646 (princ (format "configure-data-directory and data-directory:\n%S\n%S\n" |
| 1647 configure-data-directory data-directory) | |
| 2456 | 1648 'external-debugging-output)) |
| 1649 | |
| 1650 (setq data-directory-list (paths-construct-data-directory-list | |
| 1651 data-directory early-package-hierarchies | |
| 1652 late-package-hierarchies last-package-hierarchies)) | |
| 1653 (if debug-paths | |
| 1654 (princ (format "data-directory-list:\n%S\n" data-directory-list) | |
| 1655 'external-debugging-output)))) | |
| 1656 | |
| 1657 (defun startup-find-load-path-for-packages (packages) | |
| 1658 "Return a suitable load-path for PACKAGES. | |
| 1659 PACKAGES is a list of package names (strings). This looks for package | |
| 1660 directories in the load path whose last component is one of the members of | |
| 1661 PACKAGES." | |
| 1662 (mapcan | |
| 1663 #'(lambda (package) | |
| 1664 (and (member (file-name-nondirectory (directory-file-name package)) | |
| 1665 packages) | |
| 1666 (list package))) | |
| 1667 (startup-find-load-path))) | |
| 1668 | |
| 1669 ; (defun startup-set-basic-packages-load-path () | |
| 1670 ; "#### This is a hack. When recompiling .el files, we use -no-packages | |
| 1671 ; to avoid problems with packages shadowing standard Lisp files | |
| 1672 ; (e.g. unicode.el), but we really still need the stuff in xemacs-base and | |
| 1673 ; xemacs-devel." | |
| 1674 ; (setq load-path (startup-find-load-path-for-packages | |
| 1675 ; '("xemacs-base" "xemacs-devel")))) | |
| 1676 | |
| 428 | 1677 (defun startup-setup-paths-warning () |
| 442 | 1678 (let ((warnings '())) |
| 428 | 1679 (cond |
| 1680 ((null (and lisp-directory exec-directory data-directory doc-directory | |
| 442 | 1681 load-path)) |
| 428 | 1682 (save-excursion |
| 1683 (set-buffer (get-buffer-create " *warning-tmp*")) | |
| 1684 (erase-buffer) | |
| 1685 (buffer-disable-undo (current-buffer)) | |
| 1686 (if (null lisp-directory) (push "lisp-directory" warnings)) | |
| 460 | 1687 (if (and (featurep 'mule) |
| 1688 (null mule-lisp-directory)) | |
| 1689 (push "mule-lisp-directory" warnings)) | |
| 428 | 1690 (if (null exec-directory) (push "exec-directory" warnings)) |
| 1691 (if (null data-directory) (push "data-directory" warnings)) | |
| 1692 (if (null doc-directory) (push "doc-directory" warnings)) | |
| 1693 (if (null load-path) (push "load-path" warnings)) | |
| 1694 | |
| 1695 (insert "Couldn't find obvious defaults for:\n") | |
| 1696 (while warnings | |
| 1697 (insert (car warnings) "\n") | |
| 1698 (setq warnings (cdr warnings))) | |
| 1699 (insert "Perhaps some directories don't exist, " | |
| 1700 "or the XEmacs executable,\n" (concat invocation-directory | |
| 1701 invocation-name) | |
| 1702 "\nis in a strange place?") | |
| 1703 | |
| 1704 (princ "\nWARNING:\n" 'external-debugging-output) | |
| 1705 (princ (buffer-string) 'external-debugging-output) | |
| 1706 (erase-buffer) | |
| 1707 t))))) | |
| 1708 | |
| 2456 | 1709 |
| 1710 ;;; Now actually set the paths up, for bootstrapping purposes. This is run | |
| 1711 ;;; at early dump time and in certain cases where we use a minimal temacs | |
| 1712 ;;; to do useful things, like rebuild DOC. | |
| 1713 | |
| 1714 (startup-setup-paths (if inhibit-all-packages t '(early last)) t) | |
| 1715 | |
| 1716 | |
| 528 | 1717 (defun startup-load-autoloads () |
| 1232 | 1718 (when (and (not inhibit-autoloads) lisp-directory) |
| 1719 (load (expand-file-name (file-name-sans-extension autoload-file-name) | |
| 1720 lisp-directory) | |
| 1721 nil t) | |
| 1722 (when (featurep 'mule) | |
| 528 | 1723 (load (expand-file-name (file-name-sans-extension autoload-file-name) |
| 1232 | 1724 (file-name-as-directory |
| 1725 (expand-file-name "mule" lisp-directory))) | |
| 1726 nil t))) | |
| 528 | 1727 |
| 996 | 1728 ;; Hey! Let's use a packages-* function for a non-package purpose! |
| 1232 | 1729 (when (and (not inhibit-autoloads) (featurep 'modules)) |
| 1730 (packages-load-package-auto-autoloads module-load-path)) | |
| 996 | 1731 |
| 1232 | 1732 (unless (or inhibit-autoloads inhibit-all-packages) |
| 1733 (unless inhibit-early-packages | |
| 1734 (packages-load-package-auto-autoloads early-package-load-path)) | |
| 1735 (packages-load-package-auto-autoloads late-package-load-path) | |
| 1736 (packages-load-package-auto-autoloads last-package-load-path))) | |
| 528 | 1737 |
| 428 | 1738 ;;; startup.el ends here |