Mercurial > hg > xemacs-beta

comparison lisp/startup.el @ 410:de805c49cfc1 r21-2-35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-35
author cvs
date Mon, 13 Aug 2007 11:19:21 +0200
parents 501cfd01ee6d
children 697ef44129c6
comparison
equal deleted inserted replaced
409:301b9ebbdf3b 410:de805c49cfc1
105 "List of plausible roots of the XEmacs hierarchy.") 105 "List of plausible roots of the XEmacs hierarchy.")
106 106
107 (defvar user-init-directory-base ".xemacs" 107 (defvar user-init-directory-base ".xemacs"
108 "Base of directory where user-installed init files may go.") 108 "Base of directory where user-installed init files may go.")
109 109
110 (defvar user-init-file-base-list (append
111 '(".emacs.elc" ".emacs.el" ".emacs")
112 (and (eq system-type 'windows-nt)
113 '("_emacs.elc" "_emacs.el" "_emacs")))
114 "List of allowed init files. The first one found takes precedence.")
115
116 (defvar user-init-directory 110 (defvar user-init-directory
117 (file-name-as-directory 111 (file-name-as-directory
118 (paths-construct-path (list "~" user-init-directory-base))) 112 (paths-construct-path (list "~" user-init-directory-base)))
119 "Directory where user-installed init files may go.") 113 "Directory where user-installed init files may go.")
114
115 (defvar user-init-file-base "init.el"
116 "Default name of the user init file if uncompiled.
117 This should be used for migration purposes only.")
118
119 (defvar user-init-file-base-list '("init.elc" "init.el")
120 "List of allowed init files in the user's init directory.
121 The first one found takes precedence.")
122
123 (defvar user-home-init-file-base-list
124 (append '(".emacs.elc" ".emacs.el" ".emacs")
125 (and (eq system-type 'windows-nt)
126 '("_emacs.elc" "_emacs.el" "_emacs")))
127 "List of allowed init files in the user's home directory.
128 The first one found takes precedence.")
129
130 (defvar load-home-init-file nil
131 "Non-nil if XEmacs should load the init file from the home directory.
132 Otherwise, XEmacs will offer migration to the init directory.")
120 133
121 (defvar load-user-init-file-p t 134 (defvar load-user-init-file-p t
122 "Non-nil if XEmacs should load the user's init file.") 135 "Non-nil if XEmacs should load the user's init file.")
123 136
124 ;; #### called `site-run-file' in FSFmacs 137 ;; #### called `site-run-file' in FSFmacs
445 ;; (if (fboundp 'font-menu-add-default) 458 ;; (if (fboundp 'font-menu-add-default)
446 ;; (font-menu-add-default)) 459 ;; (font-menu-add-default))
447 (when window-setup-hook 460 (when window-setup-hook
448 (run-hooks 'window-setup-hook)) 461 (run-hooks 'window-setup-hook))
449 (setq window-setup-hook nil)) 462 (setq window-setup-hook nil))
463
464 (if load-user-init-file-p
465 (maybe-migrate-user-init-file))
450 ;;####FSFmacs junk 466 ;;####FSFmacs junk
451 ;; (or menubar-bindings-done 467 ;; (or menubar-bindings-done
452 ;; (precompute-menubar-bindings)) 468 ;; (precompute-menubar-bindings))
453 )) 469 ))
454 470
528 (setq user-init-directory (file-name-as-directory (pop args)))) 544 (setq user-init-directory (file-name-as-directory (pop args))))
529 ((or (string= arg "-u") 545 ((or (string= arg "-u")
530 (string= arg "-user")) 546 (string= arg "-user"))
531 (let* ((user (pop args)) 547 (let* ((user (pop args))
532 (home-user (concat "~" user))) 548 (home-user (concat "~" user)))
533 (setq user-init-file (find-user-init-file home-user) 549 (setq user-init-directory (file-name-as-directory
534 user-init-directory (file-name-as-directory
535 (paths-construct-path 550 (paths-construct-path
536 (list home-user user-init-directory-base)))))) 551 (list home-user user-init-directory-base))))
552 (setq user-init-file
553 (find-user-init-file user-init-directory home-user))
554 (setq custom-file
555 (make-custom-file-name user-init-file))))
537 ((string= arg "-debug-init") 556 ((string= arg "-debug-init")
538 (setq init-file-debug t)) 557 (setq init-file-debug t))
539 ((string= arg "-unmapped") 558 ((string= arg "-unmapped")
540 (setq initial-frame-unmapped-p t)) 559 (setq initial-frame-unmapped-p t))
541 ((or (string= arg "-debug-paths") 560 ((or (string= arg "-debug-paths")
635 ;; Strip off last hyphen and what follows, then try again 654 ;; Strip off last hyphen and what follows, then try again
636 (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) 655 (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
637 (setq term (substring term 0 hyphend)) 656 (setq term (substring term 0 hyphend))
638 (setq term nil)))))) 657 (setq term nil))))))
639 658
640 (defun find-user-init-file (&optional directory) 659 (defun find-user-init-directory-init-file (&optional init-directory)
660 "Determine the user's init file if in the init directory."
661 (let ((init-directory (or init-directory user-init-directory)))
662 (catch 'found
663 (dolist (file user-init-file-base-list)
664 (let ((expanded (expand-file-name file init-directory)))
665 (when (file-exists-p expanded)
666 (throw 'found expanded)))))))
667
668 (defun find-user-home-directory-init-file (&optional home-directory)
669 "Determine the user's init file if in the home directory."
670 (let ((home-directory (or home-directory "~")))
671 (catch 'found
672 (dolist (file user-home-init-file-base-list)
673 (let ((expanded (expand-file-name file home-directory)))
674 (when (file-exists-p expanded)
675 (throw 'found expanded))))
676 nil)))
677
678 (defun find-user-init-file (&optional init-directory home-directory)
641 "Determine the user's init file." 679 "Determine the user's init file."
642 (unless directory 680 (if load-home-init-file
643 (setq directory "~")) 681 (find-user-home-directory-init-file home-directory)
644 (dolist (file user-init-file-base-list) 682 (or (find-user-init-directory-init-file init-directory)
645 (let ((expanded (paths-construct-path (list directory file)))) 683 (find-user-home-directory-init-file home-directory))))
646 (when (file-exists-p expanded) 684
647 (return expanded))))) 685 (defun maybe-migrate-user-init-file ()
686 "Ask user if she wants to migrate the init file(s) to new location."
687 (if (and (not load-home-init-file)
688 (not (find-user-init-directory-init-file user-init-directory))
689 (file-exists-p user-init-file))
690 (if (with-output-to-temp-buffer (help-buffer-name nil)
691 (progn
692 (princ "XEmacs recommends that the initialization code in
693 ")
694 (princ user-init-file)
695 (princ "
696 be migrated to the ")
697 (princ user-init-directory)
698 (princ " directory. XEmacs can
699 perform the migration automatically.
700
701 After the migration, init.el/init.elc holds user-written
702 initialization code. Moreover the customize settings will be in
703 custom.el.
704
705 If you choose not to do this now, XEmacs will not ask you this
706 question in the future. However, you can still make XEmacs
707 perform the migration at any time with M-x migrate-user-init-file.")
708 (show-temp-buffer-in-current-frame standard-output)
709 (yes-or-no-p-minibuf (concat "Migrate init file to "
710 user-init-directory
711 "? "))))
712 (migrate-user-init-file)
713 (customize-save-variable 'load-home-init-file t))))
714
715 (defun migrate-user-init-file ()
716 "Migrate the init file from the home directory."
717 (interactive)
718 (if (not (file-exists-p user-init-directory))
719 (progn
720 (message "Creating %s directory..." user-init-directory)
721 (make-directory user-init-directory)))
722 (message "Migrating custom file...")
723 (custom-migrate-custom-file (make-custom-file-name user-init-file
724 'force-new))
725 (message "Moving init file...")
726 (rename-file user-init-file
727 (expand-file-name user-init-file-base
728 user-init-directory))
729 (message "Migration done."))
648 730
649 (defun load-user-init-file () 731 (defun load-user-init-file ()
650 "This function actually reads the init file, .emacs." 732 "This function actually reads the init file."
651 (if (or user-init-file 733 (if (or user-init-file
652 (setq user-init-file (find-user-init-file))) 734 (setq user-init-file (find-user-init-file user-init-directory)))
653 (load user-init-file t t t)) 735 (load user-init-file t t t))
736 (if (not custom-file)
737 (setq custom-file (make-custom-file-name user-init-file)))
738 (if (and (not (string= custom-file user-init-file))
739 (file-exists-p custom-file))
740 (load custom-file t t t))
654 (unless inhibit-default-init 741 (unless inhibit-default-init
655 (let ((inhibit-startup-message nil)) 742 (let ((inhibit-startup-message nil))
656 ;; Users are supposed to be told their rights. 743 ;; Users are supposed to be told their rights.
657 ;; (Plus how to get help and how to undo.) 744 ;; (Plus how to get help and how to undo.)
658 ;; Don't you dare turn this off for anyone except yourself. 745 ;; Don't you dare turn this off for anyone except yourself.
676 debug-on-error-should-be-set 763 debug-on-error-should-be-set
677 (debug-on-error-initial 764 (debug-on-error-initial
678 (if (eq init-file-debug t) 'startup init-file-debug))) 765 (if (eq init-file-debug t) 'startup init-file-debug)))
679 (let ((debug-on-error debug-on-error-initial)) 766 (let ((debug-on-error debug-on-error-initial))
680 (if (and load-user-init-file-p init-file-debug) 767 (if (and load-user-init-file-p init-file-debug)
681 ;; Do this without a condition-case if the user wants to debug. 768 (progn
682 (load-user-init-file) 769 ;; Do this without a condition-case if the user wants to debug.
770 (load-user-init-file))
683 (condition-case error 771 (condition-case error
684 (progn 772 (progn
685 (if load-user-init-file-p 773 (if load-user-init-file-p
686 (load-user-init-file)) 774 (load-user-init-file))
687 (setq init-file-had-error nil)) 775 (setq init-file-had-error nil))