comparison lisp/startup.el @ 278:90d73dddcdc4 r21-0b37

Import from CVS: tag r21-0b37
author cvs
date Mon, 13 Aug 2007 10:31:29 +0200
parents 6330739388db
children c42ec1d1cded
comparison
equal deleted inserted replaced
277:cfdf3ff11843 278:90d73dddcdc4
393 inhibit-early-packages 393 inhibit-early-packages
394 inhibit-site-lisp 394 inhibit-site-lisp
395 debug-paths)) 395 debug-paths))
396 (startup-setup-paths-warning)) 396 (startup-setup-paths-warning))
397 397
398 (if (not inhibit-autoloads) 398 (if (and (not inhibit-autoloads)
399 lisp-directory)
399 (load (expand-file-name (file-name-sans-extension autoload-file-name) 400 (load (expand-file-name (file-name-sans-extension autoload-file-name)
400 lisp-directory) nil t)) 401 lisp-directory) nil t))
401 402
402 (if (not inhibit-autoloads) 403 (if (not inhibit-autoloads)
403 (progn 404 (progn
1130 (save-excursion 1131 (save-excursion
1131 (set-buffer (get-buffer-create " *warning-tmp*")) 1132 (set-buffer (get-buffer-create " *warning-tmp*"))
1132 (erase-buffer) 1133 (erase-buffer)
1133 (buffer-disable-undo (current-buffer)) 1134 (buffer-disable-undo (current-buffer))
1134 1135
1135 (insert "Couldn't find an obvious default for the root of the " 1136 (insert "Couldn't find an obvious default for the root of the\n"
1136 "XEmacs hierarchy.") 1137 "XEmacs hierarchy.")
1137
1138 (let ((fill-column 76))
1139 (fill-region (point-min) (point-max)))
1140 1138
1141 (princ "\nWARNING:\n" 'external-debugging-output) 1139 (princ "\nWARNING:\n" 'external-debugging-output)
1142 (princ (buffer-string) 'external-debugging-output))) 1140 (princ (buffer-string) 'external-debugging-output)))
1143 1141
1144 (defun startup-setup-paths-warning () 1142 (defun startup-setup-paths-warning ()
1145 (let ((lock (if (boundp 'lock-directory) lock-directory 't)) 1143 (let ((lock (if (boundp 'lock-directory) lock-directory 't))
1146 warnings message) 1144 (warnings '()))
1147 (if (and (stringp lock) (null (file-directory-p lock))) 1145 (if (and (stringp lock) (null (file-directory-p lock)))
1148 (setq lock nil)) 1146 (setq lock nil))
1149 (cond 1147 (cond
1150 ((null (and exec-directory data-directory doc-directory load-path lock)) 1148 ((null (and lisp-directory exec-directory data-directory doc-directory
1149 load-path
1150 lock))
1151 (save-excursion 1151 (save-excursion
1152 (set-buffer (get-buffer-create " *warning-tmp*")) 1152 (set-buffer (get-buffer-create " *warning-tmp*"))
1153 (erase-buffer) 1153 (erase-buffer)
1154 (buffer-disable-undo (current-buffer)) 1154 (buffer-disable-undo (current-buffer))
1155 (if (null lisp-directory) (push "lisp-directory" warnings))
1155 (if (null lock) (push "lock-directory" warnings)) 1156 (if (null lock) (push "lock-directory" warnings))
1156 (if (null exec-directory) (push "exec-directory" warnings)) 1157 (if (null exec-directory) (push "exec-directory" warnings))
1157 (if (null data-directory) (push "data-directory" warnings)) 1158 (if (null data-directory) (push "data-directory" warnings))
1158 (if (null doc-directory) (push "doc-directory" warnings)) 1159 (if (null doc-directory) (push "doc-directory" warnings))
1159 (if (null load-path) (push "load-path" warnings)) 1160 (if (null load-path) (push "load-path" warnings))
1160 (cond ((cdr (cdr warnings)) 1161
1161 (setq message (apply 'format "%s, %s, and %s" warnings))) 1162 (insert "Couldn't find obvious defaults for:\n")
1162 ((cdr warnings) 1163 (while warnings
1163 (setq message (apply 'format "%s and %s" warnings))) 1164 (insert (car warnings) "\n")
1164 (t (setq message (format "variable %s" (car warnings))))) 1165 (setq warnings (cdr warnings)))
1165 (insert "couldn't find an obvious default for " message 1166 (insert "Perhaps some directories don't exist, "
1166 ", and there were no defaults specified in paths.h when " 1167 "or the XEmacs executable,\n" (concat invocation-directory
1167 "XEmacs was built. Perhaps some directories don't exist, "
1168 "or the XEmacs executable, " (concat invocation-directory
1169 invocation-name) 1168 invocation-name)
1170 " is in a strange place?") 1169 "\nis in a strange place?")
1171
1172 (let ((fill-column 76))
1173 (fill-region (point-min) (point-max)))
1174 1170
1175 (princ "\nWARNING:\n" 'external-debugging-output) 1171 (princ "\nWARNING:\n" 'external-debugging-output)
1176 (princ (buffer-string) 'external-debugging-output) 1172 (princ (buffer-string) 'external-debugging-output)
1177 (erase-buffer) 1173 (erase-buffer)
1178 t))))) 1174 t)))))