comparison lisp/prim/startup.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 27bc7f280385
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
825 (t 825 (t
826 (error "startup-center-spaces: bad arg"))))) 826 (error "startup-center-spaces: bad arg")))))
827 (+ left-margin 827 (+ left-margin
828 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) 828 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
829 829
830 (defun startup-splash-frame () 830 (defun startup-splash-frame-body ()
831 (let ((p (point))) 831 `("\n" ,(emacs-version) "\n"
832 (if (eq 'x (console-type (selected-console))) (insert "\n")) 832 (face bold-italic "\
833 (indent-to (startup-center-spaces xemacs-logo)) 833 Copyright (C) 1985-1996 Free Software Foundation, Inc.
834 (set-extent-begin-glyph (make-extent (point) (point)) xemacs-logo)
835 (if (eq 'x (console-type (selected-console)))
836 (insert "\n\n")
837 (insert "\n"))
838 (splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
839
840 (insert "\n" (emacs-version) "\n")
841 (let ((after-change-functions nil) ; no font-lock, thank you
842 (l `((face bold-italic
843 "Copyright (C) 1985-1996 Free Software Foundation, Inc.
844 Copyright (C) 1990-1994 Lucid, Inc. 834 Copyright (C) 1990-1994 Lucid, Inc.
845 Copyright (C) 1993-1996 Sun Microsystems, Inc. All Rights Reserved. 835 Copyright (C) 1993-1996 Sun Microsystems, Inc. All Rights Reserved.
846 Copyright (C) 1994-1996 Board of Trustees, University of Illinois 836 Copyright (C) 1994-1996 Board of Trustees, University of Illinois
847 Copyright (C) 1995-1996 Ben Wing.") 837 Copyright (C) 1995-1996 Ben Wing\n\n")
848 ,@(if (featurep 'sparcworks) '( 838
849 "\n\nSunSoft provides support for the SPARCworks/XEmacs EOS integration package 839 ,@(if (featurep 'sparcworks)
850 only. All other XEmacs packages are provided to you \"AS IS\".")) 840 `( "\
851 "\n\nType " (key describe-no-warranty) " to refer to the GPL " 841 Sun provides support for the WorkShop/XEmacs integration package only.
852 "Version 2, dated June 1991, for full details.\n" 842 All other XEmacs packages are provided to you \"AS IS\".
853 "You may give out copies of XEmacs; type " 843 For full details, type " (key describe-no-warranty)
854 (key describe-copying) " to see the conditions.\n" 844 " to refer to the GPL Version 2, dated June 1991.\n\n"
855 "Type " (key describe-distribution) 845 ,@(let ((lang (or (getenv "LANG") (getenv "LC_ALL"))))
856 " for information on getting the latest version." 846 (if (and
857 847 (not (featurep 'mule)) ; Already got mule?
858 "\n\nType " (key help-command) " for help; " 848 (not (eq 'tty (console-type))) ; No Mule support on tty's yet
859 (key advertised-undo) 849 lang ; Non-English locale?
860 " to undo changes. (`C-' means use the CTRL key.)\n" 850 (not (string-equal lang "C"))
861 "To get out of XEmacs, type " (key save-buffers-kill-emacs) ".\n" 851 (not (string-match "^en" lang))
862 "Type " (key help-with-tutorial) 852 (locate-file "xemacs-mule" exec-path)) ; Comes with Sun WorkShop
863 " for a tutorial on using XEmacs.\n" 853 '( "\
864 "Type " (key info) " to enter Info, " 854 This version of XEmacs has been built with support for Latin-1 languages only.
865 "which you can use to read documentation.\n\n" 855 To handle other languages you need to run a Multi-lingual (`Mule') version of
866 (face (bold red) 856 XEmacs, by either running the command `xemacs-mule', or by using the X resource
867 ( 857 `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.\n\n"))))
868 "For tips and answers to frequently asked questions, see the XEmacs FAQ.\n" 858
869 "(It's on the Help menu, or type " 859 '("XEmacs comes with ABSOLUTELY NO WARRANTY; type "
870 (key xemacs-local-faq) " [a capital F!].)"))))) 860 (key describe-no-warranty) " for full details.\n"))
871 (while l 861
872 (splash-frame-present (car l)) 862 "You may give out copies of XEmacs; type "
873 (setq l (cdr l)))) 863 (key describe-copying) " to see the conditions.\n"
864 "Type " (key describe-distribution)
865 " for information on getting the latest version.\n\n"
866
867 "Type " (key help-command) " or use the " (face bold "Help") " menu to get help.\n"
868 "Type " (key advertised-undo) " to undo changes (`C-' means use the Control key).\n"
869 "To get out of XEmacs, type " (key save-buffers-kill-emacs) ".\n"
870 "Type " (key help-with-tutorial) " for a tutorial on using XEmacs.\n"
871 "Type " (key info) " to enter Info, "
872 "which you can use to read online documentation.\n\n"
873 (face (bold red) ( "\
874 For tips and answers to frequently asked questions, see the XEmacs FAQ.
875 \(It's on the Help menu, or type " (key xemacs-local-faq) " [a capital F!].\)"))))
876
877 (defun startup-splash-frame ()
878 (let ((p (point))
879 (cramped-p (eq 'tty (console-type))))
880 (unless cramped-p (insert "\n"))
881 (indent-to (startup-center-spaces xemacs-logo))
882 (set-extent-begin-glyph (make-extent (point) (point)) xemacs-logo)
883 (insert (if cramped-p "\n" "\n\n"))
884 (splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
885
886 (let ((after-change-functions nil)) ; no font-lock, thank you
887 (dolist (l (startup-splash-frame-body))
888 (splash-frame-present l)))
889 (set-buffer-modified-p nil))
890
874 ; (let ((present-file 891 ; (let ((present-file
875 ; #'(lambda (f) 892 ; #'(lambda (f)
876 ; (splash-frame-present 893 ; (splash-frame-present
877 ; (list 'funcall 894 ; (list 'funcall
878 ; (list 'find-file-other-window 895 ; (list 'find-file-other-window
881 ; (insert "For customization examples, see the files ") 898 ; (insert "For customization examples, see the files ")
882 ; (funcall present-file "sample.emacs") 899 ; (funcall present-file "sample.emacs")
883 ; (insert " and ") 900 ; (insert " and ")
884 ; (funcall present-file "sample.Xdefaults") 901 ; (funcall present-file "sample.Xdefaults")
885 ; (insert (format "\nin the directory %s." data-directory))) 902 ; (insert (format "\nin the directory %s." data-directory)))
886 (set-buffer-modified-p nil)) 903
887 904
888 ;;;; Computing the default load-path, etc. 905 ;;;; Computing the default load-path, etc.
889 ;;; 906 ;;;
890 ;;; This stuff is a complete mess and isn't nearly as general as it 907 ;;; This stuff is a complete mess and isn't nearly as general as it
891 ;;; thinks it is. It should be rethunk. In particular, too much logic 908 ;;; thinks it is. It should be rethunk. In particular, too much logic