Mercurial > hg > xemacs-beta

comparison lisp/startup.el @ 267:966663fcf606 r20-5b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b32
author cvs
date Mon, 13 Aug 2007 10:26:29 +0200
parents 727739f917cb
children b2472a1930f2
comparison
equal deleted inserted replaced
266:18d185df8c54 267:966663fcf606
367 (equal (file-attributes default-directory) 367 (equal (file-attributes default-directory)
368 (file-attributes value))) 368 (file-attributes value)))
369 (setq default-directory (file-name-as-directory value))))) 369 (setq default-directory (file-name-as-directory value)))))
370 (setq default-directory (abbreviate-file-name default-directory)) 370 (setq default-directory (abbreviate-file-name default-directory))
371 (initialize-xemacs-paths) 371 (initialize-xemacs-paths)
372
373 (startup-set-invocation-environment)
374
375 (let ((roots (paths-find-emacs-roots invocation-directory
376 invocation-name)))
377 (startup-setup-paths roots
378 inhibit-package-init
379 inhibit-site-lisp)
380 (startup-setup-paths-warning))
381
382 (if (not inhibit-package-init)
383 (progn
384 (packages-load-package-auto-autoloads early-package-load-path)
385 (packages-load-package-auto-autoloads late-package-load-path)))
386
372 (unwind-protect 387 (unwind-protect
373 (command-line) 388 (command-line)
374 ;; Do this again, in case .emacs defined more abbreviations. 389 ;; Do this again, in case .emacs defined more abbreviations.
375 (setq default-directory (abbreviate-file-name default-directory)) 390 (setq default-directory (abbreviate-file-name default-directory))
376 ;; Specify the file for recording all the auto save files of 391 ;; Specify the file for recording all the auto save files of
502 (defun command-line () 517 (defun command-line ()
503 (let ((command-line-args-left (cdr command-line-args))) 518 (let ((command-line-args-left (cdr command-line-args)))
504 519
505 (let ((debugger 'early-error-handler) 520 (let ((debugger 'early-error-handler)
506 (debug-on-error t)) 521 (debug-on-error t))
507 (set-default-load-path)
508 522
509 ;; Process magic command-line switches like -q and -u. Do this 523 ;; Process magic command-line switches like -q and -u. Do this
510 ;; before creating the first frame because some of these switches 524 ;; before creating the first frame because some of these switches
511 ;; may affect that. I think it's ok to do this before establishing 525 ;; may affect that. I think it's ok to do this before establishing
512 ;; the X connection, and maybe someday things like -nw can be 526 ;; the X connection, and maybe someday things like -nw can be
982 ;; (funcall present-file "sample.emacs") 996 ;; (funcall present-file "sample.emacs")
983 ;; (insert " and ") 997 ;; (insert " and ")
984 ;; (funcall present-file "sample.Xdefaults") 998 ;; (funcall present-file "sample.Xdefaults")
985 ;; (insert (format "\nin the directory %s." data-directory))) 999 ;; (insert (format "\nin the directory %s." data-directory)))
986 1000
987 1001 (defun startup-set-invocation-environment ()
988 ;;;; Computing the default load-path, etc.
989 ;;;
990 ;;; This stuff is a complete mess and isn't nearly as general as it
991 ;;; thinks it is. It should be rethunk. In particular, too much logic
992 ;;; is duplicated between the code that looks around for the various
993 ;;; directories, and the code which suggests where to create the various
994 ;;; directories once it decides they are missing.
995
996 ;;; The source directory has this layout:
997 ;;;
998 ;;; BUILD_ROOT/src/xemacs* argv[0]
999 ;;; BUILD_ROOT/xemacs* argv[0], possibly
1000 ;;; BUILD_ROOT/lisp/
1001 ;;; BUILD_ROOT/etc/ data-directory
1002 ;;; BUILD_ROOT/info/
1003 ;;; BUILD_ROOT/lib-src/ exec-directory, doc-directory
1004 ;;; BUILD_ROOT/lock/
1005 ;;;
1006 ;;; The default tree created by "make install" has this layout:
1007 ;;;
1008 ;;; PREFIX/bin/xemacs* argv[0]
1009 ;;; PREFIX/lib/xemacs-VERSION/lisp/
1010 ;;; PREFIX/lib/xemacs-VERSION/etc/ data-directory
1011 ;;; PREFIX/lib/xemacs-VERSION/info/
1012 ;;; PREFIX/lib/xemacs-VERSION/CONFIGURATION/ exec-directory, doc-directory
1013 ;;; PREFIX/lib/xemacs/lock/
1014 ;;; PREFIX/lib/xemacs/site-lisp/
1015 ;;;
1016 ;;; The binary packages we ship have that layout, except that argv[0] has
1017 ;;; been moved one level deeper under the bin directory:
1018 ;;;
1019 ;;; PREFIX/bin/CONFIGURATION/xemacs*
1020 ;;;
1021 ;;; The following code has to deal with at least the above three situations,
1022 ;;; and it should be possible for it to deal with more. Though perhaps that
1023 ;;; does cover it all? The trick is, when something is missing, realizing
1024 ;;; which of those three layouts is mostly in place, so that we can suggest
1025 ;;; the right directories in the error message.
1026
1027
1028 ;; extremely low-tech debugging, since this happens so early in startup.
1029 ;;(or (fboundp 'orig-file-directory-p)
1030 ;; (fset 'orig-file-directory-p (symbol-function 'file-directory-p)))
1031 ;;(defun file-directory-p (path)
1032 ;; (send-string-to-terminal (format "PROBING %S" path))
1033 ;; (let ((v (orig-file-directory-p path)))
1034 ;; (send-string-to-terminal (format " -> %S\n" v))
1035 ;; v))
1036
1037 (defun startup-make-version-dir ()
1038 (let ((version (and (string-match "\\`[^0-9]*\\([0-9]+\\.[0-9]+\\)"
1039 emacs-version)
1040 (substring emacs-version
1041 (match-beginning 1) (match-end 1)))))
1042 (if (string-match "(beta *\\([0-9]+\\))" emacs-version)
1043 (setq version (concat version "-b"
1044 (substring emacs-version (match-beginning 1)
1045 (match-end 1)))))
1046 (if (string-match "(alpha *\\([0-9]+\\))" emacs-version)
1047 (setq version (concat version "-a"
1048 (substring emacs-version (match-beginning 1)
1049 (match-end 1)))))
1050 (concat "lib/xemacs-" version)))
1051
1052 (defun find-emacs-root-internal-1 (path lisp-p)
1053 ;; (prin1 (format "f-e-r-i-1: %s\n" path))
1054 (let ((dir (file-name-directory path)))
1055 (or
1056 ;;
1057 ;; If this directory is a plausible root of the XEmacs tree, return it.
1058 ;;
1059 (and (or (not lisp-p)
1060 (file-directory-p (expand-file-name "lisp" dir)))
1061 (or (file-directory-p (expand-file-name "lib-src" dir))
1062 (file-directory-p (expand-file-name system-configuration dir)))
1063 dir)
1064 ;;
1065 ;; If the parent of this directory is a plausible root, use it.
1066 ;; (But don't do so recursively!)
1067 ;;
1068 (and (or (not lisp-p)
1069 (file-directory-p (expand-file-name "../lisp" dir)))
1070 (or (file-directory-p (expand-file-name
1071 (format "../%s" system-configuration)
1072 dir))
1073 (file-directory-p (expand-file-name "../lib-src" dir)))
1074 (expand-file-name "../" dir))
1075
1076 ;;
1077 ;; (--run-in-place) Same thing, but from one directory level deeper.
1078 ;;
1079 (and (or (not lisp-p)
1080 (file-directory-p (expand-file-name "../../lisp" dir)))
1081 (or (file-directory-p (expand-file-name
1082 (format "../%s" system-configuration)
1083 dir))
1084 (file-directory-p
1085 (expand-file-name
1086 (format "../../lib-src/%s" system-configuration) dir)))
1087 (expand-file-name "../.." dir))
1088
1089 ;; If ../lib/xemacs-<version> exists check it.
1090 ;; This is of the form "xemacs-19.10/" or "xemacs-19.10-b7/".
1091 ;;
1092 (let ((ver-dir (concat "../" (startup-make-version-dir))))
1093 (and (or (not lisp-p)
1094 (file-directory-p (expand-file-name
1095 (format "%s/lisp" ver-dir)
1096 dir)))
1097 (or (file-directory-p (expand-file-name
1098 (format "%s/%s" ver-dir
1099 system-configuration)
1100 dir))
1101 (file-directory-p (expand-file-name
1102 (format "%s/lib-src" ver-dir)
1103 dir)))
1104 (expand-file-name (file-name-as-directory ver-dir) dir)))
1105 ;;
1106 ;; Same thing, but one higher: ../../lib/xemacs-<version>.
1107 ;;
1108 (let ((ver-dir (concat "../../" (startup-make-version-dir))))
1109 (and (or (not lisp-p)
1110 (file-directory-p (expand-file-name
1111 (format "%s/lisp" ver-dir)
1112 dir)))
1113 (or (file-directory-p (expand-file-name
1114 (format "%s/%s" ver-dir
1115 system-configuration)
1116 dir))
1117 (file-directory-p (expand-file-name
1118 (format "%s/lib-src" ver-dir)
1119 dir)))
1120 (expand-file-name (file-name-as-directory ver-dir) dir)))
1121 ;;
1122 ;; If that doesn't work, and the XEmacs executable is a symlink, then
1123 ;; chase the link and try again there.
1124 ;;
1125 (and (setq path (file-symlink-p path))
1126 (find-emacs-root-internal-1 (expand-file-name path dir) lisp-p))
1127 ;;
1128 ;; Otherwise, this directory just doesn't cut it.
1129 ;; Some bozos think they can use the 18.59 lisp directory with 19.*.
1130 ;; This is because they're not using their brains. But it might be
1131 ;; nice to notice that that is happening and point them in the
1132 ;; general direction of a clue.
1133 ;;
1134 nil)))
1135
1136 (defun find-emacs-root-internal (path)
1137 ;; (send-string-to-terminal (format "FINDING ROOT FOR %S\n" path))
1138 ;; first look for lisp and lib-src; then just look for lib-src.
1139 ;; XEmacs can run (kind of) if the lisp directory is omitted, which
1140 ;; some people might want to do for space reasons.
1141 (or (find-emacs-root-internal-1 path t)
1142 ;; (find-emacs-root-internal-1 path nil)
1143 ;; If we don't succeed we are going to crash and burn for sure.
1144 ;; Try some paths relative to prefix-directory if it isn't nil.
1145 ;; This is definitely necessary in cases such as when we're used
1146 ;; as a login shell since we can't determine the invocation
1147 ;; directory in that case.
1148
1149 (find-emacs-root-internal-1
1150 (format "%s/bin/%s" prefix-directory invocation-name) t)
1151 (find-emacs-root-internal-1
1152 (format "%s/bin/%s" prefix-directory invocation-name) nil)
1153 (find-emacs-root-internal-1
1154 (format "%s/lib/%s" prefix-directory invocation-name) t)
1155 (find-emacs-root-internal-1
1156 (format "%s/lib/%s" prefix-directory invocation-name) nil)
1157
1158 ;; We're desperate -- try the prefix-directory correctly.
1159 (find-emacs-root-internal-1
1160 (format "%s/%s/foo" prefix-directory (startup-make-version-dir)) t)
1161 (find-emacs-root-internal-1
1162 (format "%s/%s/foo" prefix-directory (startup-make-version-dir)) nil)
1163 ))
1164
1165 (defun set-default-load-path ()
1166 ;; XEmacs -- Steven Baur says invocation directory is nil if you 1002 ;; XEmacs -- Steven Baur says invocation directory is nil if you
1167 ;; try to use XEmacs as a login shell. 1003 ;; try to use XEmacs as a login shell.
1168 (or invocation-directory (setq invocation-directory default-directory)) 1004 (or invocation-directory (setq invocation-directory default-directory))
1169 (setq invocation-directory 1005 (setq invocation-directory
1170 ;; don't let /tmp_mnt/... get into the load-path or exec-path. 1006 ;; don't let /tmp_mnt/... get into the load-path or exec-path.
1171 (abbreviate-file-name invocation-directory)) 1007 (abbreviate-file-name invocation-directory)))
1172 1008
1173 ;; #### FSFmacs recognizes environment vars EMACSLOCKDIR, etc. 1009 (defun startup-setup-paths (roots &optional inhibit-packages inhibit-site-lisp)
1174 (let* ((root (find-emacs-root-internal (concat invocation-directory 1010 "Setup all the various paths.
1175 invocation-name))) 1011 ROOTS is a list of plausible roots of the XEmacs directory hierarchy.
1176 (lisp (and root 1012 If INHIBIT-PACKAGES is non-NIL, don't do packages.
1177 (let ((f (expand-file-name "lisp" root))) 1013 If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp.
1178 (and (file-directory-p f) f)))) 1014 It's idempotent, so call this as often as you like!"
1179 (site-lisp 1015
1180 (and root 1016 (setq package-path (packages-find-package-path roots))
1181 (or 1017
1182 (let ((f (expand-file-name "xemacs/site-lisp" root))) 1018 (let ((stuff (packages-find-packages package-path inhibit-packages)))
1183 (and (file-directory-p f) f)) 1019 (setq early-packages (car stuff))
1184 (let ((f (expand-file-name "../xemacs/site-lisp" root))) 1020 (setq late-packages (cdr stuff)))
1185 (and (file-directory-p f) f)) 1021
1186 ;; the next two are for --run-in-place 1022 (setq early-package-load-path (packages-find-package-load-path early-packages))
1187 (let ((f (expand-file-name "site-lisp" root))) 1023 (setq late-package-load-path (packages-find-package-load-path late-packages))
1188 (and (file-directory-p f) f)) 1024
1189 (let ((f (expand-file-name "lisp/site-lisp" root))) 1025 (setq load-path (paths-construct-load-path roots
1190 (and (file-directory-p f) f)) 1026 early-package-load-path
1191 ))) 1027 late-package-load-path
1192 (lib-src 1028 inhibit-site-lisp))
1193 (and root 1029
1194 (or 1030 (setq info-path (paths-construct-info-path roots early-packages late-packages))
1195 (let ((f (expand-file-name 1031
1196 (concat "lib-src/" system-configuration) 1032 (if (boundp 'lock-directory)
1197 root))) 1033 (progn
1198 (and (file-directory-p f) f)) 1034 (setq lock-directory (paths-find-lock-directory roots))
1199 (let ((f (expand-file-name "lib-src" root))) 1035 (setq superlock-file (paths-find-superlock-file lock-directory))))
1200 (and (file-directory-p f) f)) 1036
1201 (let ((f (expand-file-name system-configuration root))) 1037 (setq exec-directory (paths-find-exec-directory roots))
1202 (and (file-directory-p f) f))))) 1038
1203 (etc 1039 (setq exec-path (paths-construct-exec-path roots exec-directory
1204 (and root 1040 early-packages late-packages))
1205 (let ((f (expand-file-name "etc" root))) 1041
1206 (and (file-directory-p f) f)))) 1042 (setq doc-directory (paths-find-doc-directory roots))
1207 (info 1043
1208 (and root 1044 (setq data-directory (paths-find-data-directory roots))
1209 (let ((f (expand-file-name "info" root))) 1045
1210 (and (file-directory-p f) (file-name-as-directory f))))) 1046 (setq data-directory-list (paths-construct-data-directory-list data-directory
1211 (packages 1047 early-packages
1212 (and root 1048 late-packages)))
1213 (let ((f (expand-file-name "packages" root))) 1049
1214 (and (file-directory-p f) (file-name-as-directory f))))) 1050 (defun startup-setup-paths-warning ()
1215 (lock
1216 (and root
1217 (boundp 'lock-directory)
1218 (if (and lock-directory (file-directory-p lock-directory))
1219 (file-name-as-directory lock-directory)
1220 (or
1221 (let ((f (expand-file-name "xemacs/lock" root)))
1222 (and (file-directory-p f)
1223 (file-name-as-directory f)))
1224 (let ((f (expand-file-name "../xemacs/lock" root)))
1225 (and (file-directory-p f)
1226 (file-name-as-directory f)))
1227 (let ((f (expand-file-name "lock" root)))
1228 (and (file-directory-p f)
1229 (file-name-as-directory f)))
1230 ;; if none of them exist, make the "guess" be
1231 ;; the one that set-default-load-path-warning
1232 ;; will suggest.
1233 (file-name-as-directory
1234 (expand-file-name "../xemacs/lock" root))
1235 )))))
1236
1237 ;; 1996/12/6 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
1238 ;; define `default-load-path' for file-detect.el
1239 (setq default-load-path load-path)
1240
1241 ;; add site-lisp dir to load-path
1242 (when site-lisp
1243 ;; If the site-lisp dir isn't on the load-path, add it to the end.
1244 (or (member site-lisp load-path)
1245 (setq load-path (append load-path
1246 (list (file-name-as-directory site-lisp)))))
1247 ;; Also add any direct subdirectories of the site-lisp directory
1248 ;; to the load-path. But don't add dirs whose names begin
1249 ;; with dot or hyphen.
1250 (let ((files (directory-files site-lisp nil "^[^-.]" nil 'dirs-only))
1251 file)
1252 (while files
1253 (setq file (car files))
1254 (if (and (not (member file '("RCS" "CVS" "SCCS")))
1255 (setq file (expand-file-name file site-lisp))
1256 (not (member file load-path)))
1257 (setq load-path
1258 (nconc load-path
1259 (list (file-name-as-directory file)))))
1260 (setq files (cdr files)))))
1261
1262 ;; add lisp dir to load-path
1263 (when lisp
1264 ;; If the lisp dir isn't on the load-path, add it to the end.
1265 (or (member lisp load-path)
1266 (setq load-path (append load-path
1267 (list (file-name-as-directory lisp)))))
1268 ;; Also add any direct subdirectories of the lisp directory
1269 ;; to the load-path. But don't add dirs whose names begin
1270 ;; with dot or hyphen.
1271 (let ((files (directory-files lisp nil "^[^-.]" nil 'dirs-only))
1272 file)
1273 (while files
1274 (setq file (car files))
1275 (when (and (not (member file '("RCS" "CVS" "SCCS")))
1276 (setq file (expand-file-name file lisp))
1277 (not (member file load-path)))
1278 (setq load-path
1279 (nconc load-path
1280 (list (file-name-as-directory file)))))
1281 (setq files (cdr files)))))
1282
1283 ;; 1996/12/6 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
1284 ;; define `default-load-path' for file-detect.el
1285 (setq default-load-path
1286 (append default-load-path
1287 (if site-lisp
1288 (list site-lisp))
1289 (if lisp
1290 (list lisp)
1291 )
1292 ))
1293
1294 ;; 1997/03/06 by Jeff Miller <jmiller@bayserve.net>
1295 ;; initialize 'site-directory'. This is the site-lisp dir used by
1296 ;; XEmacs
1297 (if site-lisp
1298 (setq site-directory (file-name-as-directory site-lisp))
1299 )
1300 ;; If running from the build directory, always prefer the exec-directory
1301 ;; that is here over to the one that came from paths.h.
1302 (when (or (and (null exec-directory) lib-src)
1303 (and (string= lib-src (expand-file-name "lib-src" root))
1304 (not (string= exec-directory lib-src))))
1305 (setq exec-directory (file-name-as-directory lib-src)))
1306 (when (or (and (null doc-directory) lib-src)
1307 (and (string= lib-src (expand-file-name "lib-src" root))
1308 (not (string= doc-directory lib-src))))
1309 (setq doc-directory (file-name-as-directory lib-src)))
1310
1311 (when exec-directory
1312 (or (member exec-directory exec-path)
1313 (setq exec-path (append exec-path (list exec-directory)))))
1314 (when (or (and (null data-directory) etc)
1315 (and (string= etc (expand-file-name "etc" root))
1316 (not (string= data-directory etc))))
1317 (setq data-directory (file-name-as-directory etc)))
1318
1319 ;; If `configure' specified an info dir, use it.
1320 ;; #### The above comment is suspect.
1321 (or (boundp 'Info-default-directory-list)
1322 (setq Info-default-directory-list nil))
1323
1324 ;; Add additional system directories.
1325 (setq Info-default-directory-list
1326 (append Info-default-directory-list
1327 (split-string infopath-internal ":")))
1328
1329 (let ((infopath (getenv "INFOPATH")))
1330 (when infopath
1331 (setq Info-default-directory-list
1332 (append Info-default-directory-list
1333 (split-string infopath ":")))))
1334
1335 (cond (configure-info-directory
1336 (setq configure-info-directory (file-name-as-directory
1337 configure-info-directory))
1338 (or (member configure-info-directory Info-default-directory-list)
1339 (setq Info-default-directory-list
1340 (append (list configure-info-directory)
1341 Info-default-directory-list)))))
1342 ;; If we've guessed the info dir, use that (too).
1343 (when (and info (not (member info Info-default-directory-list)))
1344 (setq Info-default-directory-list
1345 (append (list info) Info-default-directory-list)))
1346
1347 ;; Default the lock dir to being a sibling of the data-directory.
1348 ;; If superlock isn't set, or is set to a file in a nonexistent
1349 ;; directory, derive it from the lock dir.
1350 (when (boundp 'lock-directory)
1351 (setq lock-directory lock)
1352 (cond ((null lock-directory)
1353 (setq superlock-file nil))
1354 ((or (null superlock-file)
1355 (not (file-directory-p
1356 (file-name-directory superlock-file))))
1357 (setq superlock-file
1358 (expand-file-name "!!!SuperLock!!!"
1359 lock-directory)))))
1360
1361 (set-default-load-path-warning)
1362 (when (and (null (running-temacs-p))
1363 data-directory
1364 Info-default-directory-list)
1365 (setq data-directory-list (list data-directory))
1366 (packages-find-packages package-path nil))))
1367
1368
1369 (defun set-default-load-path-warning ()
1370 (let ((lock (if (boundp 'lock-directory) lock-directory 't)) 1051 (let ((lock (if (boundp 'lock-directory) lock-directory 't))
1371 warnings message guess) 1052 warnings message)
1372 (when (and (stringp lock) (not (file-directory-p lock))) 1053 (if (and (stringp lock) (null (file-directory-p lock)))
1373 (setq lock nil)) 1054 (setq lock nil))
1374 (cond 1055 (cond
1375 ((not (and exec-directory data-directory doc-directory load-path lock)) 1056 ((null (and exec-directory data-directory doc-directory load-path lock))
1376 (save-excursion 1057 (save-excursion
1377 (set-buffer (get-buffer-create " *warning-tmp*")) 1058 (set-buffer (get-buffer-create " *warning-tmp*"))
1378 (erase-buffer) 1059 (erase-buffer)
1379 (buffer-disable-undo (current-buffer)) 1060 (buffer-disable-undo (current-buffer))
1380 (when (null lock) (push "lock-directory" warnings)) 1061 (if (null lock) (push "lock-directory" warnings))
1381 (when (null exec-directory) (push "exec-directory" warnings)) 1062 (if (null exec-directory) (push "exec-directory" warnings))
1382 (when (null data-directory) (push "data-directory" warnings)) 1063 (if (null data-directory) (push "data-directory" warnings))
1383 (when (null doc-directory) (push "doc-directory" warnings)) 1064 (if (null doc-directory) (push "doc-directory" warnings))
1384 (when (null load-path) (push "load-path" warnings)) 1065 (if (null load-path) (push "load-path" warnings))
1385 (cond ((cdr (cdr warnings)) 1066 (cond ((cdr (cdr warnings))
1386 (setq message (apply 'format "%s, %s, and %s" warnings))) 1067 (setq message (apply 'format "%s, %s, and %s" warnings)))
1387 ((cdr warnings) 1068 ((cdr warnings)
1388 (setq message (apply 'format "%s and %s" warnings))) 1069 (setq message (apply 'format "%s and %s" warnings)))
1389 (t (setq message (format "variable %s" (car warnings))))) 1070 (t (setq message (format "variable %s" (car warnings)))))
1391 ", and there were no defaults specified in paths.h when " 1072 ", and there were no defaults specified in paths.h when "
1392 "XEmacs was built. Perhaps some directories don't exist, " 1073 "XEmacs was built. Perhaps some directories don't exist, "
1393 "or the XEmacs executable, " (concat invocation-directory 1074 "or the XEmacs executable, " (concat invocation-directory
1394 invocation-name) 1075 invocation-name)
1395 " is in a strange place?") 1076 " is in a strange place?")
1396 (setq guess (or exec-directory 1077
1397 data-directory 1078 (if (fboundp 'fill-region)
1398 doc-directory 1079 ;; Might not be bound in the cold load environment...
1399 (car load-path) 1080 (let ((fill-column 76))
1400 (and (string-match "/[^/]+\\'" invocation-directory) 1081 (fill-region (point-min) (point-max))))
1401 (substring invocation-directory 0
1402 (match-beginning 0)))))
1403 (when (and guess
1404 (or
1405 ;; parent of a terminal bin/<configuration> pair (hack hack).
1406 (string-match (concat "/bin/"
1407 (regexp-quote system-configuration)
1408 "/?\\'")
1409 guess)
1410 ;; parent of terminal src, lib-src, etc, or lisp dir.
1411 (string-match
1412 "/\\(bin\\|src\\|lib-src\\|etc\\|lisp\\)[^/]*/?\\'"
1413 guess)))
1414 (setq guess (substring guess 0 (match-beginning 0))))
1415
1416 ;; If neither the exec nor lisp dirs are around, then "guess" that
1417 ;; the new configure-style lib dir should be used. Otherwise, if
1418 ;; only one of them appears to be missing, or it's just lock,
1419 ;; then guess it to be a sibling of whatever already exists.
1420 (when (and (null exec-directory) (null load-path))
1421 (setq guess (expand-file-name (startup-make-version-dir) guess)))
1422
1423 (when (or (null exec-directory) (null load-path))
1424 (insert
1425 "\n\nWithout both exec-directory and load-path, XEmacs will "
1426 "be very broken. "))
1427 (when (and (null exec-directory) guess)
1428 (insert
1429 "Consider making a symbolic link from "
1430 (expand-file-name system-configuration guess)
1431 " to wherever the appropriate XEmacs exec-directory "
1432 "directory is"))
1433 (when (and (null data-directory) guess)
1434 (insert
1435 (if exec-directory
1436 "\n\nConsider making a symbolic link " ", and ")
1437 "from "
1438 (expand-file-name "etc" (if load-path
1439 (file-name-directory
1440 (directory-file-name
1441 (car load-path)))
1442 guess))
1443 " to wherever the appropriate XEmacs data-directory is"))
1444 (when (and (null load-path) guess)
1445 (insert
1446 (if (and exec-directory data-directory)
1447 "Consider making a symbolic link "
1448 ", and ")
1449 "from "
1450 (expand-file-name "lisp" guess)
1451 " to wherever the appropriate XEmacs lisp library is"))
1452 (insert ".")
1453
1454 (when (null lock)
1455 (insert
1456 "\n\nWithout lock-directory set, file locking won't work. ")
1457 (when guess
1458 (insert
1459 "Consider creating "
1460 (expand-file-name "../xemacs/lock"
1461 (or (find-emacs-root-internal
1462 (concat invocation-directory
1463 invocation-name))
1464 guess))
1465 " as a directory or symbolic link for use as the lock "
1466 "directory. (This directory must be globally writable.)"
1467 )))
1468
1469 (when (fboundp 'fill-region)
1470 ;; Might not be bound in the cold load environment...
1471 (let ((fill-column 76))
1472 (fill-region (point-min) (point-max))))
1473 (goto-char (point-min)) 1082 (goto-char (point-min))
1474 (princ "\nWARNING:\n" 'external-debugging-output) 1083 (princ "\nWARNING:\n" 'external-debugging-output)
1475 (princ (buffer-string) 'external-debugging-output) 1084 (princ (buffer-string) 'external-debugging-output)
1476 (erase-buffer) 1085 (erase-buffer)
1477 t))))) 1086 t)))))