xemacs-beta: lisp/startup.el comparison

comparison lisp/startup.el @ 438:84b14dcb0985 r21-2-27

Import from CVS: tag r21-2-27

author	cvs
date	Mon, 13 Aug 2007 11:32:25 +0200
parents	3ecd8885ac67
children	8de8e3f6228a

comparison

equal deleted inserted replaced

-:e2a4e8b94b82
+:84b14dcb0985
 ;;; Commentary:
 ;; This file is dumped with XEmacs.
 ;; -batch, -t, and -nw are processed by main() in emacs.c and are
 ;; never seen by lisp code.
 ;; -version and -help are special-cased as well: they imply -batch,
 ;; but are left on the list for lisp code to process.
 			   (and (getenv "EMACSDEBUGPATHS")
 				t))))
 (setq emacs-roots (paths-find-emacs-roots invocation-directory
 						invocation-name))
 (if debug-paths
 	  (princ (format "emacs-roots:\n%S\n" emacs-roots)
 		 'external-debugging-output))
 (if (null emacs-roots)
 	  (startup-find-roots-warning)
 	(startup-setup-paths emacs-roots
 			     user-init-directory
 			     inhibit-early-packages
 (if (and (not inhibit-autoloads)
 	     lisp-directory)
 	(load (expand-file-name (file-name-sans-extension autoload-file-name)
 				lisp-directory) nil t))
 (if (not inhibit-autoloads)
 	(progn
 	  (if (not inhibit-early-packages)
 	      (packages-load-package-auto-autoloads early-package-load-path))
 	  (packages-load-package-auto-autoloads late-package-load-path)
 ;;		   (and (not (equal string "")) string))
 ;;		 (let ((string (getenv "LANG")))
 ;;		   (and (not (equal string "")) string)))))
 ;;	(and ctype
 ;;	     (string-match iso-8859-1-locale-regexp ctype)))
 ;;      (progn
 ;;	(standard-display-european t)
 ;;	(require 'iso-syntax)))
 (setq load-user-init-file-p (not (noninteractive)))
 ;; to kill XEmacs for it.)
 ;;
 ;;; Load init files.
 (load-init-file)
 (with-current-buffer (get-buffer "*scratch*")
 (erase-buffer)
 ;; (insert initial-scratch-message)
 (set-buffer-modified-p nil)
 (when (eq major-mode 'fundamental-mode)
 ;; until after the splash screen.
 (setq inhibit-warning-display nil)
 ;; If -batch, terminate after processing the command options.
 (when (noninteractive) (kill-emacs t))))
 (defun load-terminal-library ()
 (when term-file-prefix
 (let ((term (getenv "TERM"))
 	  hyphend)
 (while (and term
 		  (not (load (concat term-file-prefix term) t t)))
 	 ;; This is worthless; the `unixoid' way is "./file". -jwz
 	 ((or (string= arg "-") (string= arg "--"))
 	  (setq end-of-options t))
 	 (t
 	  (setq file-p t)))
 	(when file-p
 	  (setq file-p nil)
 	  (incf file-count)
 	  (setq arg (expand-file-name arg dir))
 	  (cond
 	     (let ((map e)
 		   (overriding-local-map (indirect-function e)))
 	       (setq e (read-key-sequence
 			(let ((p (keymap-prompt map t)))
 			  (cond ((symbolp map)
 				 (if p
 				     (format "%s %s " map p)
 				   (format "%s " map)))
 				(p)
 				(t
 				 (prin1-to-string map))))))
 (error "WTF!?"))))
 (defun startup-center-spaces (glyph)
 ;; Return the number of spaces to insert in order to center
 ;; the given glyph (may be a string or a pixmap).
 ;; Assume spaces are as wide as avg-pixwidth.
 ;; Won't be quite right for proportional fonts, but it's the best we can do.
 ;; Maybe the new redisplay will export something a glyph-width function.
 ;;; #### Yes, there is a glyph-width function but it isn't quite what
 ;;; #### this was expecting.  Or is it?
 ;; (An alternate way to get avg-pixwidth would be to use x-font-properties
 ;; and calculate RESOLUTION_X * AVERAGE_WIDTH / 722.7, but it's no better.)
 ;; This function is used in about.el too.
 (let* ((avg-pixwidth     (round (/ (frame-pixel-width) (frame-width))))
 	 (fill-area-width  (* avg-pixwidth (- fill-column left-margin)))
 	 (glyph-pixwidth   (cond ((stringp glyph)
 				  (* avg-pixwidth (length glyph)))
 				 ;; #### the pixmap option should be removed
 				 ;;((pixmapp glyph)
 				 ;; (pixmap-width glyph))
 				 ((glyphp glyph)
 "Please visit the XEmacs website at http://www.xemacs.org !\n\n"
 ,@(if (featurep 'sparcworks)
 	   `( "\
 Sun provides support for the WorkShop/XEmacs integration package only.
 All other XEmacs packages are provided to you \"AS IS\".\n"
 	      ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES")
 				(getenv "LANG"))))
 		  (if (and
 		       (not (featurep 'mule)) ;; Already got mule?
 		       ;; No Mule support on tty's yet
 		       (not (eq 'tty (console-type)))
 		       lang ;; Non-English locale?
 		       (not (string= lang "C"))
 		       (not (string-match "^en" lang))
 		       ;; Comes with Sun WorkShop
 		       (locate-file "xemacs-mule" exec-path))
 This version of XEmacs has been built with support for Latin-1 languages only.
 To handle other languages you need to run a Multi-lingual (`Mule') version of
 XEmacs, by either running the command `xemacs-mule', or by using the X resource
 `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.
 \n")))))
 ((key describe-no-warranty)
 ": "(face (red bold) "XEmacs comes with ABSOLUTELY NO WARRANTY\n"))
 ((key describe-copying)
 ": conditions to give out copies of XEmacs\n")
 ((key describe-distribution)
 ": how to get the latest version\n")
 Copyright (C) 1985-1999 Free Software Foundation, Inc.
 Copyright (C) 1990-1994 Lucid, Inc.
 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
 Copyright (C) 1994-1996 Board of Trustees, University of Illinois
 Copyright (C) 1995-1996 Ben Wing\n"))
 ((face (blue bold underline) "\nInformation, on-line help:\n\n")
 "XEmacs comes with plenty of documentation...\n\n"
 ,@(if (string-match "beta" emacs-version)
 	   `((key describe-beta)
 	     ": " (face (red bold)
 			"This is an Experimental version of XEmacs.\n"))
 	 `( "\n"))
 ((key xemacs-local-faq)
 ": read the XEmacs FAQ (a " (face underline "capital") " F!)\n")
 ;; I really hate global variables, oh well.
 ;(defvar xemacs-startup-logo-function nil
 ;  "If non-nil, function called to provide the startup logo.
 ;This function should return an initialized glyph if it is used.")
-;; This will hopefully go away when gettext is functionnal.
+;; This will hopefully go away when gettext is functional.
 (defconst splash-frame-static-body
 `(,(emacs-version) "\n\n"
 (face italic "`C-' means the control key,`M-' means the meta key\n\n")))
 (setq Info-directory-list
 	(paths-construct-info-path roots
 				   early-packages late-packages last-packages))
 (if debug-paths
 (princ (format "Info-directory-list:\n%S\n" Info-directory-list)
 	     'external-debugging-output))
 (if (boundp 'lock-directory)
 (progn
 	(setq lock-directory (paths-find-lock-directory roots))
 	(setq superlock-file (paths-find-superlock-file lock-directory))
 	(if debug-paths
 	    (progn
 	      (princ (format "lock-directory:\n%S\n" lock-directory)
 		     'external-debugging-output)
 	      (princ (format "superlock-file:\n%S\n" superlock-file)
 				   early-packages late-packages last-packages))
 (if debug-paths
 (princ (format "exec-path:\n%S\n" exec-path)
 	     'external-debugging-output))
 (setq doc-directory (paths-find-doc-directory roots))
 (if debug-paths
 (princ (format "doc-directory:\n%S\n" doc-directory)
 	     'external-debugging-output))

Mercurial > hg > xemacs-beta

comparison lisp/startup.el @ 438:84b14dcb0985 r21-2-27