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